C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: PREPOBS_PREPDATA
C   PRGMMR: Keyser                ORG: NP22   DATE: 2017-10-20
C
C ABSTRACT: PREPARES DATA FOR USE IN ANALYSES FOR THE NDAS, NAM, GDAS,
C   GFS, RAP (RAPID REFRESH), RTMA, AND URMA NETWORKS.  ALL ANALYSES
C   ARE GSI.  ALSO RUNS IN HOURLY NETWORK TO PROCESS GOES CLOUD DATA
C  (ONLY).  WRITES DATA TO PREPBUFR FILE WHICH CONTAINS 10000-BYTE BUFR
C   MESSAGES. HERE A "REPORT" IS SEPARATED INTO MASS AND WIND PIECES.
C
C PROGRAM HISTORY LOG:
C 1984-05-30  G. D. DIMEGO (W/NMC22)
C 1985-10-21  G. D. DIMEGO -- UNIFIED CODE FOR REGIONAL AND GLOBAL OI
C 1986-04-28  G. D. DIMEGO -- ADDED SWITCHES TO DATA CARD NAMELIST
C 1986-06-18  G. D. DIMEGO -- REMOVED RADIATION CORRECTION SUBROUTINES
C 1987-01-12  D. A. KEYSER -- MODIFIED TO PROCESS NOAA-10 TOVS DATA
C 1987-03-10  D. A. KEYSER -- CODE STREAMLINED, QUALITY MARK CHANGES
C 1987-06-14  D. A. KEYSER -- ADDED CAPABILITY TO PROCESS VAS, DMSP
C 1987-12-29  D. A. KEYSER -- DELETE MASS REPORTS FROM INDIAN RAOBS
C 1988-04-11  D. A. KEYSER -- ADDED NAMELIST SWITCH, NEW  WIND INTERP.
C 1988-08-24  D. A. KEYSER -- ADDED DMSP F-9, NHC SATWNDS; CHG TOVS R.T.
C 1988-09-14  D. A. KEYSER -- ADDED TOVS PHYSICAL RETR, SPLASH-LVL DROPS
C 1988-10-25  D. A. KEYSER -- ADDED WV WND,SATWND SWITCHES;RMV ON29 TOVS
C 1988-12-22  D. A. KEYSER -- STREAMLINED 'SFCDTA'; NEW SFC SWITCHES
C 1989-01-25  D. A. KEYSER -- CORRECTED CAT. 2 PSFC ERROR WHEN MISSING
C 1989-02-16  D. A. KEYSER -- NEW SUBR. LNDCHK & SWITCHES FOR SFC & UAIR
C 1989-03-15  D. A. KEYSER -- NEW Q.M. IN 'ISPMRK'; ADDED SUBR. 'ISFMRK'
C 1989-04-17  D. A. KEYSER -- ADDED 'SPCIAL';STRMLINED 'MSTBOG'&'MANDOB'
C 1989-04-24  D. A. KEYSER -- CHKS TOVS FILTER FLG;B-LINE CHK U-AIR RPTS
C 1989-05-12  D. A. KEYSER -- NADIR PROX. INDIC. ADDED TO TOVS STN. ID
C 1989-06-15  G. J. DIMEGO -- TIGHTER LIMITS TO HYDRO. CHECK IN 'SMERGE'
C 1989-12-13  D. A. KEYSER -- ADDED BASELINE CHK; ADDED MASS PROCESSING
C    FOR AIRCFT & SATWND; U-AIR RPT TOSSED IF MAND. MASS/WIND LEVELS
C    MONITOR PURGED
C 1990-01-11  D. A. KEYSER -- COMP. IN FORTRAN77 (RESTRUCTURED); ADDED
C    DUPL. WIND LVL CHECK
C 1990-02-06  D. A. KEYSER -- ADDED SWITCH 'PHISWN' & PRINT TBL SATWNDS
C 1990-07-11  D  A. KEYSER -- HONORS NEW AIRCFT Q. MARKS
C 1990-09-19  D  A. KEYSER -- DVAL TEST ON U-AIR CAT.2 LVL1 PRES, FAIL
C    ASSUMES NOT PSTN
C 1990-10-25  D. A. KEYSER -- SUBR. 'PWATER' TO PROC. RAOB, SSM/I,
C    TOVS PWATER; FCN. 'PWCLC' TO CALC. RAOB PWATER; TOSSES DEF. CAT
C    SAT. MBOGUS; SUBR. 'UNPO29' + ENTRIES TO UNPACK RPTS FROM ON29
C    D-SETS; PROCESSES SSM/I WSPD/PWATER
C 1991-01-03  D. A. KEYSER -- MISPLACED INSAT RPTS (N OF 40N) TOSSED;
C    PMSL BOGUS R. TYPE EXPANDED
C 1991-01-23  D. A. KEYSER -- SWITCH 'FILL' EXPANDED TO 'FILLZ/T/P/W/M',
C    SUBR. 'FILLIN' SPLIT INTO 'FILWND' AND 'FILDPT'
C 1991-05-14  D. A. KEYSER -- HONORS OPC PMSL AND WIND Q.M. FOR MARINE
C    SFC RPTS; MARINE RPTS NOT TOSSED IF ONLY TEMP IS BAD; G. LAKES SFC
C    MARINE W/ GOOD ELEV SET R. TYPE=183 & W/ ELEV=0 TOSSED
C 1991-06-07  D. A. KEYSER -- ADDED PROCESSING OF PROFILER DATA
C 1991-09-10  D. A. KEYSER -- PROCESSES GBL-SSI, NOT GBL-OI; SUBR.
C    MANDOB REMOVED); W3FI64 REPL W3AI02; ASYNCH. READS REMOVED; ATLAS
C    BUOY TEST MORE STRINGENT; SUBR. ENCDTE & LL2XY REPL W/ IW3DAT &
C    W3FB04, RESP; W3FS15 REPL W/ W3FS21 & W3FS22 FOR DATE CHECKS
C    RELATED TO HIST. RERUNS
C 1991-11-19  D. A. KEYSER -- ADDED SUBR. 'CFL' & SWITCH 'WNDADJ' TO
C    ALLOW MOORED BUOY WSPD BUOYS W/ ANEMOMETER HGHT < 10M TO BE
C    ADJUSTED TO 10M HGHT; TOSSES SSM/I WSPD OR PW W/ Q.MARK .GT. LIMIT
C 1992-01-27  D. A. KEYSER -- CHG IN BASELNE CHK; 925 MB MAND. LVL DATA
C    PROCESSED FROM CAT. 8 (Z), 2, 3; HANDLES CLASS SNDGS (ON29 R.TYPE
C    =13, OI/SSI R.TYPE=122/222)
C 1992-06-10  D. A. KEYSER -- ADDED SUBR. 'MARKN' TO HANDLE NEW ON29
C    Q. MARKS OUTPUT BY NEW CQC CHK; SPCIAL & ALL FILL SWITCHES SET TO
C    FALSE FOR SAT. RETR.  (ALL TYPES); TOSSES ALL DATA ON ANY CAT. 2
C    OR 3 LVL IF PRESS > PSFC (1ST LVL); U-AIR PRESS. ROUNDED RATHER
C    THAN TRUNCATED
C 1992-07-01  D. A. KEYSER -- ADDED PROCESSING OF NESDIS GRADIENT WINDS
C 1992-07-09  D. A. KEYSER -- MACHINE INDEPENDENT (NAS/CRAY); ADDED
C    CALLS TO 3 NEW W3 ROUTINES TO GET MACHINE WORD LG, AND CONVERSIONS
C    TO/FROM IBM INT*2; ON85 HDR FOR PREPDA INDICATES MACHINE; SEQ'L
C    FIXED GRID FILE WITH NEW MASK FOR CONUS (PLUS N.H./S.H. LAND/SEA);
C    PARM FLD REPLACED WITH N-LIST "&PARM" IN DATA CARDS (IUNIT); STOP
C    19 & 29 ADDED FOR PROBLEM READING DATE FROM ADPUPA OR PROD. DATE
C    FILE, RESP.; SUBR. "BUBBLE" REPL. W/ "SHELL" (MORE EFFICIENT);
C    REPL. SUBPR. FCN "QFRMTP" W/ IN-LINE FCN STMNT.; 925 MB LVL NOT
C    PROC. AS CAT. 2 OR 3 IF MAND. LVL; NOBS ARRAY NOT FILLED W/
C    VARIABLE IF .GT. 32767
C 1992-08-07  D. A. KEYSER -- Q.MARK FOR BOTH TEMP & WIND FOR CONV'L/
C    AMDAR AIRCFT FROM PROD AIRCFT ON29 D-SET NOW OBTAINED FROM 1ST
C    BYTE RATHER THAN FROM 2'ND OR 4'TH BYTE FOR TEMP & WIND, RESP.;
C    TEST FOR AMDAR ACFT RPTS LOOKS ONLY FOR 'Z' IN 6'TH BYTE OF STNID
C    (NO MORE 'A'); ATLAS BUOY TEST MORE STRINGENT; ADDED GEOGRAPHICAL
C    TEST TO N-LIST SWITCH "AWINDO" (BASED ON IN/OUT CONUS); ADDED
C    SWITCH "PGAFUS" TO ALLOW CONV'L AIREP/ PIREP ACFT FLT LVL RPTS
C    OVER CONUS TO BE TOSSED IF > 100 MDCRS RPTS HERE; STOP 69 ADDED
C    FOR OVERFLOW PACKING FULL-WORD ARRAY TO 16-BIT ARRAY (& LOG MSG.)
C 1992-09-08  D. A. KEYSER -- ADDED CALL TO W3AI39 TO CONVERT STN. ID
C    FROM ASCII TO EBCDIC ON CRAY PRIOR TO WRITE; STN. ID PKED INTO RPT
C    HEADER IN SUBR. FILLX NOT RPTLBL
C 1992-12-02  D. A. KEYSER -- CALLS W3FI77 NOT W3FI60 TO UNPACK PROFLR
C    RPTS DIRECTLY FROM SEQ'L BUFR FILES; DEFAULT FOR 'IUNIT' ARRAY
C    CHGED SINCE BUFR TABLEB/TABLED HARDWIRED IN UNIT 20/21; U-AIR CAT.
C    4 CALC. PRESSURES SET TO NEAREST INTEGER (WERE TRUNCATED); PROFLR
C    RPTS CAN ALSO BE INPUT IN ADPUPA FILE (ON29 CAT.4); IMPROVED
C    PRINTOUT FOR CAT. 6 MASS/WIND RPTS W/ BAD/MSG DATA; ACFT RPTS W/
C    BAD/MSG TEMP NO LONGER PROCESS MASS PIECE; MDCRS RPTS USE NEW,
C    EXPAND. Q.M., CHGS. SSI/OI Q.M. ON MDCRS WIND FROM 2 TO 1
C 1993-02-10  D. A. KEYSER -- MODIFIED TO CALL NEWEST VERSION OF W3FI77
C 1993-03-17  D. A. KEYSER -- MODIFIED TO CALL NEWEST VERSION OF W3FI77;
C    INPUT QUALITY INDICATOR TO FCN 'MARKP' CAN BE FROM EITHER EDTN. 0
C    OR 2 BUFR MSGS; DIAG. PRINTOUT WHEN CAT. 0 MOIST. BGS. RPT FOUND
C    AND TOSSED (AGREES W/ GESS OR INDETERMINATE); AFTER 00Z 4/1/93
C    CAT. 7 & 8 MOIST. BGS. PROCESSED EVERYWHERE (NO LONGER MEAN
C    "DEFAULT")
C 1993-04-01  D. A. KEYSER -- ADDED COND. CODES 18, 99; ADDED SWITCHES
C    "NHWRD" & "NLWRD" TO DEFINE STRUCTURE OF NOBS ARRAY
C 1993-05-12  D. A. KEYSER -- WORD 2 FOR EACH MASS/WIND LVL IS PRESS.
C    X 10MB, NEW WORD 5 FOR EACH LEVEL CONTAINS 4 PACKED "PREPBUFR TBL
C    VALUES" WHICH CAN RANGE FROM 0-15 AND CORRESPOND TO ON29 Q.
C    MARKERS OR PREPRO-GENERATED Q. MARKERS OR ON29 CAT. NO.; ALL
C    NON-MISSING DATA ARE NOW PACKED INTO PREPBUFR REGARDLESS OF
C    QUALITY; IN INTERNAL PROCESSING MISSING DATA GET PREPBUFR TABLE
C    VALUE OF 16 NOT 10; VERT. COORDINATE INDICATOR ADDED TO PREPDA
C    TABLE VALUE LIST FOR VARIABLES; SUBR. "TWOBIT" REPL. BY W3LIB
C    ROUTINE "GBYTES"; IN SUBR. GETC06, HIGH LVL PRESS (MB * 10)
C    ROUNDED TO NEAREST WHOLE NUMBER (WAS TRUNCATED) WHEN CONVERTED TO
C    INTEGER
C 1993-05-31  D. A. KEYSER -- ADDED SUBR. "SATBFR" TO PROCESS TOVS
C    RETR. FROM INPUT BUFR FILES, CURRENTLY PROCESSES ONLY NESDIS
C    40-LVL(80KM) RETR. (LATER INTERACTIVE), "SATBFR" CALLS NEW W3LIB
C    "W3FI80" TO DECODE; RENAMED SWITCH "TIROST" TO "TOVEDS", ADDED
C    SWITCH "TOVBFR"; RENAMED SUBR. "SATSND" TO "SATEDS"; NEW SUBR.
C    "SNDTBL" PRINTOUT OF COUNTS FOR ALL SAT. RETR. TYPES ; INCR. MAX
C    VALUE FOR SWITCH "KTOP" FROM 20 (1.0 MB) TO 22 (0.1 MB), "KTOP"
C    NOW APPLIES TO ALL VAR. AND TO MAND. & SIG. LVLS FOR ALL SAT.
C    RETR. TYPES; ADDED PRINTOUT FOR TOVS(BUFR) COUNTS {BOTH NO.
C    PROCESSED & NO. SKIPPED (BY REASON)} IN SUMMARY AT END; CHANGED
C    DEF. VALUES & ORDER FOR SWITCH "IUNIT", ADDING IUNIT(7) TO POINT
C    TO TOVS(BUFR) FILES; REDEFINED OI/SSI R. TYPES FOR SATELLITE
C    RETR., ADDED NEW R. TYPE (286) FOR ERS1 SCATTEROMETER WINDS,
C    REDEFINED & ADDED NEW R. TYPES FOR SATWNDS (MASS/WIND); SWITCH
C    "IRTRV" EXPANDED TO 3-DIM. W/ 3'RD DIM REFERRING TO SAT./RETR.
C    TYPE (ALLOWS DIFF. SWITCHES FOR NESDIS 40-LVL RETR. VS.
C    INTERACTIVE); MODIFIED SWITCHES "SWINDO", "SWNLND", "JSWIND",
C    "JSMASS" TO BE 3-DIM. TO BETTER ORGANIZE SATWND RPTS. BY
C    PRODUCER/SAT/PRODUCT COMBINATION; IMPROVED PRINTOUT FOR TBL OF
C    SATWND COUNTS
C 1993-07-28  D. A. KEYSER -- NEW SWITCH "OBUFR" ADDED TO PASS FILLED
C    REPORTS IN "NOBS" ARRAY THRU INTERFACE TO ENCODE IN PREPBUFR FILE
C    (=TRUE) (=FALSE WRITES TO RECORDS IN PREPDA FILE AS BEFORE),
C    INTERFACE NOT YET READY; N-LIST "PARM" INCLUDES IUNIT(13), UNIT
C    NO. FOR PREPBUFR D-SET; R. TYPE 183 NOW EST. PSTN FROM RPTED PMSL
C    & TEMP RATHER THAN FROM STD. ATMS.; R.TYPE 151-153 PWATER NOW
C    STORED IN MM*10 RATHER THAN MM; SWITCHES "JPSSMI" & "XWINDO" NOW
C    2-DIM ARRAYS W/ 1ST DIM INDICATING LAT. BAND (CAN PROCESS/NO
C    PROCESS FOR 6 LAT. BANDS); TABLE IN SUBR. GETSMI SUMMARIZES SSM/I
C    COUNTS BY LAT. BAND
C 1993-09-14  D. A. KEYSER -- ADDED SWITCH "TVIRT" TO OUTPUT TEMP. AS
C    VIRTUAL (=TRUE, DEFAULT) OR AS SENSIBLE (=FALSE) FOR RAOB, RECCO/
C    DROPS, CLASS & SFC DATA; IF VIRT. TEMP > 375K (>325K ABOVE 100 MB)
C    STORES SENS. TEMP WITH "FAILED" Q.M. AND SETS DWPT TEMP TO MSG FOR
C    U-AIR REPORTS; CALLS LIBRARY FCN 'EXIT' WHEN NON-ZERO STOP
C    CONDITION OCCURS -- ALLOWS FOREGROUND EXIT STATUS IN UNIX TO MATCH
C    FORTRAN COND. CODE
C 1993-10-07  D. A. KEYSER -- PGM COMPL. W/ C.CODE=04 IF EITHER ADPUPA
C    OR ADPSFC CONTAIN NO RPTS; MSG VALUE IN NOBS ARRAY IS 99999,
C    ACTUAL HEIGHT (NO D-VAL) STORED IN NOBS ARRAY, STREAMLNED W3FIZZ
C    W/ MORE VARIABLES PASSED THRU COMMON; ORDER FOR PROCESSING SFC
C    DATA REARRANGED S.T.: 1ST ALL LAND TYPES, NEXT ALL MARINE TYPES,
C    FINALLY ALL PMSL BOGUS TYPES; READING & UNPKING OF ON29 RPTS
C    STREAMLINED BY REPL. READING OF REC. & CALL TO W3FI64 W/ CALL TO
C    IW3GAD (ALSO ALLOWS FOR DIFFERENT VERSIONS OF IW3GAD WHICH MAY NOT
C    NECESSARILY POINT TO ON29 FORMAT D-SET)
C 1993-11-02  D. A. KEYSER -- ADDED SWITCH 'RECSLM' TO PROCESS/NO PROC.
C    (T/F) CAT. 6 RECCO MASS LEVELS (DEF=T); ALL CAT. 6 LEVEL DATA NOW
C    STORE ON29 CAT. IN MOIST. TBL VAL. SLOT; FOLLOWING PERTAINS TO
C    SINGLE-LVL CAT. 1 RECCOS: NO LONGER O-PUT SFC. PRESS. (ONLY) IN
C    1ST LVL OF MASS/WIND RPT; NOW PROCESSED IN SUBR. 'GETC06'; MAND.
C    P-LVL STILL INCL. GEOPOT. BUT TEMP, MOIST., WIND & ELEV NOW
C    TREATED ON 2ND LVL LIKE CAT. 6 (PRESS. EST. FROM GEOPOT., ELEV,
C    AND TEMP); STORE ON29 R.TYPE AND INSTR. TYPE IN WORDS 9 & 10 OF
C    OUTPUT RPT HDR, RESP. AND THEN ENCODE IN BUFR; MONITOR PURGE ON
C    ALL U-AIR MAND. LVL WINDS/HGHTS-TEMPS NOW PUTS SAME TBL. VALUE ON
C    ALL SIG. LVL WINDS/TEMPS AND CAT. 4 HGHTS IF MONITOR PURGE ON
C    MAND-LVL HGHTS; SWITCHES PG4243, PGAFUS, AIRLND, SWNLND, MARLND,
C    LFMAX & IRTRV NOW DO NOT TOSS REPORTS BUT RATHER FLAG ALL
C    VARIABLES W/ PREPBUFR T. VAL =15; NEW SWITCH 'IPRINT' CONTROLS AMT.
C    OF PRINTOUT FOR TOSSED/FLAGGED REPORTS; FOR SATBFR=T CAN NOW
C    PROCESS MIXTURE OF NESDIS 40-LVL & I/A RETR., RETR. SUMMARY TABLE
C    EXPANDED TO INCL. COUNTS FROM BOTH RETR. SOURCES; WILL NOW PRODUCE
C    'OLD-FMT' PREPDA D-SET FROM EACH PROCESSED RPT
C 1993-12-21  D. A. KEYSER -- ADDED SUBR. FIZZ02 TO MAKE AN OLD I*2
C    PREPDA DATA SET FROM NOBS ARRAY; W/ DUPL. LVLS IN SUBR. WNDBYP/
C    WNDBYZ NOW ENSURES THAT BEST TEMP IS KEPT REGARDLESS OF HGHT TBL.
C    VAL. & WILL NOT TRANSF. DWPT TO LVL WHERE MSG UNLESS FILLM=T OR
C    TEMP. HAS BEEN TRANSF.; IN SUBR. WNDBYZ HGHTS MUST AGREE TO
C    NEAREST 100'TH M TO BE DUPL.; THE ON29 CAT. STORED W/ U-AIR WIND
C    LVLS NOW PRECISELY IDENT. AS CAT. 3 OR CAT. 4; IN SUBR. WNDBYZ NO
C    LONGER SET 2 LVLS W/I 1 MB OF EACH OTHER TO SAME PRESSURE; CAT. 4
C    & 6 WIND LVLS NOW HOLD P-ALT IN WORD 1 OF LVL INFO (NOBS) W/ TBL.
C    VAL. IN POS. 3 OF WORD 5 (BOTH WERE MSG); FOR SFC DATA IF PMSL
C    T.V. BAD, SET PSTN T.V. TO 15 (AND VICE VERSA), ALSO IF PSTN MADE
C    FROM PMSL VIA FCN, SET ITS TBL. VAL. TO MAX OF 8 OR PMSL TBL.
C    VAL.;; INCR. MAX NO. LVLS THAT CAN BE PROCESSED FROM 200 TO 300;
C    ONLY TOVS I/A RETR. SET PSTN (1ST LVL) TO PBOT VALUE RETURNED FROM
C    W3FI80, NESDIS 40-LVL RETR. CAN'T GET A PSTN
C 1994-07-19  D. A. KEYSER -- ATLAS BUOYS HAVE ON29 R. TYPE 562 NOT
C    561 AFTER 2/23/94, ALSO TIGHTENED LAT TEST; FOLLOWING PERTAINS TO
C    SINGLE-LVL CAT. 2/3 RECCOS: NO LONGER O-PUT SFC. PRESS. (ONLY) IN
C    1ST LVL OF MASS/WIND RPT; NOW PROCESSED IN SUBR. 'GETC06'; PSTN-
C    LVL STILL INCL. BUT GEOPOT. NOW ZERO RATHER THAN 'ELEV' ALSO TEMP,
C    MOIST., WIND & ELEV NOW TREATED ON 2ND LVL LIKE CAT. 6 (PRESS.
C    EST. FROM GEOPOT., ELEV, TEMP)
C 1994-08-11  D. A. KEYSER -- ADDED PROCESSING OF TOVS VIA INPUT FILE
C    WHICH RETURNS UNPACKED ON29 (NOT OPER'L), INVOKED IF TOVS DCTY
C    FILE EMPTY; PROCESSES CAT. 4 LVLS EVEN IF NO. OF CAT. 4 LVLS < SUM
C    OF CAT. 1,3,5 LVLS; ANY CAT. 2 OR 3 LVL > (BELOW) SFC. PRESSURE NO
C    LONGER SKIPPED, ALL VARIABLES ON LVL FLAGGED; C.CODE=18 REMOVED;
C    SWITCHES 'NHWRD', 'NLWRD' & 'KMAX' REMOVED, HARDWIRED IN CODE;
C    STORE ELEV IN WORD 11 OF NOBS RPT HDR AND ENCODE IN BUFR); ADDED
C    PARAMETER NAMES TO ALLOW FOR CHANGING ARRAY SIZES; SWITCH 'TVIRT'
C    REMOVED; VIRT. TEMP NOW CALC. IN SUBR. 'STOROB' PRIOR TO WRITING
C    TO NOBS ARRAY; WORDS 6 AND 7 OF MASS(WIND) LVL NOW CONTAIN VIRT.
C    TEMP (WIND DIR) AND DWPT TEMP(WSD), RESP., ALSO WORD 3 OF MASS LVL
C    NOW CONTAINS "REPORTED" TEMP; RPT SEQ. NUMBER STORED IN WORD 12 OF
C    NOBS HEADER; RPT. SEQ. NO., VIRT. /RPTED/DWPT TEMP, WIND DIR. &
C    SPEED ALL ENCODED IN BUFR; RAOBS FAILING B-LINE CHK NOW FLAG ALL
C    CAT. 4 LVLS BELOW TOP SPANNING PRESS. (BEFORE LVLS NOT PROCESSED);
C    WSPD & DIR ENCODED TO BUFR; ADDED ENTRY CMDDFF TO SUBR. 'UV' TO
C    CONVERT WIND U- & V-COMP BACK TO SPEED/DIR; ALL DUPL. PRESS.
C    CHECKS NOW REQUIRE PRESS. TO AGREE TO NEAREST 10'TH OF A MB TO BE
C    A DUPL. (WAS NEAREST WHOLE MB); CALC. CAT. 4 PRESS. NOW STORED TO
C    NEAREST 10'TH OF A MB (WAS NEAREST WHOLE MB); ADDED SWITCH
C    'IREANL'; SWITCH 'MARLND' NOW APPLIES TO OCEAN STN U-AIR (RAOB,
C    PIBAL) RPTS AS WELL AS TO MARINE SFC RPTS; ADDED COND. CODE 22, IF
C    CHAR. ON MACHINE NOT ASCII OR EBCDIC; NOW DETERMINES MACHINE CHAR.
C    TYPE RATHER THAN ASSUMING ASCII; TEST FOR MISSING LAT/LON EXPANDED
C    TO INCL. LAT/ LON OUTSIDE POSS. RANGE; SUBR. 'TOVSID' REWRITTEN TO
C    INCR. EFFICIENCY; INCR. STNID FROM 6 TO 8 CHAR; AIRCFT AIREP/PIREP
C    RTPS NOW GET 7'TH CHAR. (FROM ON29 RES. CHAR) ADDED TO STNID AND
C    THE CARRIER ID IS CORRECTED BASED ON INPUT ID; ADDED SWITCH
C    'IACARL' TO INDICATE FLOOR FOR MDCRS; CONV'L/ AMDAR QCACFT WSPD
C    INCR. Q.M. NOW KEPT IN COMMON FOR RPT; RCPT TIME, RPT SUB-TYPE AND
C    QCACFT WSPD INCR. Q.M. (CONV'L/AMDAR AIRCFT WIND RPTS ONLY)
C    ENCODED INTO RPT HEADER IN PREPBUFR
C 1994-08-30  D. A. KEYSER -- NEW SUBR. 'INTERP' INTERPS. TOVS I/A
C    RETR. TEMP AND SPEC. HUMIDITY TO MANDATORY LEVELS
C 1995-07-12  D. A. KEYSER -- ADDED SUBR. 'GOESDG' & SWITCHES 'GOESND'
C    & 'GOESPW' TO PROCESS GOES SOUNDINGS & 4-LAYERS PWATER; ADDED
C    IUNIT(14) FOR OUTPUT REWRITES OF GOES BUFR MSGS; CALLS TO SUBR.
C    'UFBQCD' TO ENCODE PGM CODE FOR PREPDATA INTO PREPBUFR; CAN
C    PROCESS RGL PREPBUFR (TEMPORARILY DIFFERS FROM GBL PREPBUFR);
C    REMOVED LOGIC TO PROCESS VAS RETR.; CAN PROCESS SSM/I 7-CHN
C    BRIGHT. TEMPS.; PWATER NOBS PROCESSING MODIFIED TO HANDLE > 1 LVL,
C    P-SLOT VALUE IDENTIFIES PWATER TYPE; R.TYPES 151- 159 USED FOR
C    PWATER TYPES, SATWND TEMPS HI- & LO-LVL NOW COMBINED IN R. TYPES
C    140-149, CLIMATOLOGY R.T. REMOVED; GOES-EVN & -ODD SATWND (MASS/
C    WIND) R.TYPES NOW SEPARATE; ADDED SWITCH "PHIACF", DEFINES LAT.
C    BANDS FOR SELECTING ACFT RPTS; EXPAND. SWITCHES "AIRLND",
C    "JAWIND", "JAMASS" TO (6,4) ARRAYS TO SELECT BY LAT. BAND; ADDED
C    TABLE SUMMARIZING ACFT COUNTS BY LAT. BAND; DATA SEARCH GRID NO
C    LONGER APPLIES TO ACFT RPTS; ADDED SWITCHES 'VADWND' & 'MWINDO' TO
C    PROCESS VAD (NEXRAD) WINDS; ADDED IUNIT(15) FOR OUTPUT REWRITES OF
C    VAD BUFR MSGS; NOW RETAINS PRESS. IF > 1075 MB FOR U-AIR RPTS BUT
C    FLAGS PRESS Q.M., SAME FOR U-AIR SFC. PRESS. OUTSIDE DVAL LIMIT;
C    SUBR. SMERGE, WNDBYP, WNDBYZ, FILWND, FILDPT CHECK PRESS. Q.M. FOR
C    SPANNING LVL, IF BAD INTERP. VALUE IS BAD; SPEC. HUM. SET TO MSG
C    IF PRESS. Q.M. BAD; ACCOUNTED FOR CHANGES/FIXES TO RECCO DECODER
C    (AUG. 95) BY REFORMATTING BACK TO OLD FORMAT SINCE EXISTING LOGIC
C    WILL CORRECT ERRORS; MNEMONIC 'TSB' (REPORT SUB-TYPE) NOW USED TO
C    HOLD INDICATOR FOR MISSING PHASE OF FLIGHT FOR ACFT AMDAR REPORTS
C 1995-08-24  D. A. KEYSER -- FOR 925 MB MAND. LVL PREPBUFR TBL VAL FOR
C    VERT. COORD. (PRESS) INIT. TO DEFAULT (7), BEFORE INIT. TO 16; R.T
C    182 NOW INCLUDES RECCOS W/ EST. PMSL; CHGD DEF. VALUE FOR SWITCH
C    "FWINDO(5)" FROM 300. TO 600.; R.T. 132 DROPS SFC. DATA ALL
C    FLAGGED FOR NON-USE BY ANAL. (USED LATER AS R.T 182), SAME FOR
C    CAT. 2 SNGL-LVL RECCOS SFC. DATA (PMSL, Z); R.T. 182 RECCOS W/
C    EST. PMSL CORRECTED TO GET SFC. HGHT OF ZERO RATHER THAN FROM
C    RPTED ELEV (P-ALT); DVAL CHECK ON R.T. 182 PRESS. CHGD FROM LOW-
C    LIMIT OF -75MB TO -215MB TO ACCEPT PRESS. IN HURRICANE SITUATIONS;
C    R.T. 182'S NOW NOT PROCESSED IF CAT. 2 SFC PRESS. MSG (UNLESS CAT.
C    3 SFC PRESS. AVAIL), OR IF CAT. 2 SFC PRESS. IS < 1MB; GOES SNDG
C    SFC DATA (T,Q,Z) PREPBUFR TABLE VALUES SET TO AT BEST SUSPECT
C 1996-02-07  D. A. KEYSER -- SWITCHES 'JSMASS' AND 'JSWIND' NOW HAVE
C    MORE POSSIBLE VALUES THAN 0 OR 9999, ALLOWS CERTAIN COMBINATIONS
C    OF SAT PRODUCERS/PRODUCTS AND EVEN CERTAIN GOES-EVEN AND ODD SAT
C    NUMBERS TO BE PROCESSED BUT FLAGGED FOR NON-USE BY ANALYSIS; NOW
C    RECOGNIZES THAT GOES SATWND STNID SUFFIX CHARACTER DIFFERS FOR
C    EVERY-OTHER ODD OR EVEN SATELLITE; FOR RGL PREPBUFR OUTPUT:
C    ORIGINAL TESTS FOR OLD PREPDA PROC. OF CAT. 4 LVLS AND PROC. OF
C    CAT. 3 WINDS ON LVLS ABOVE LAST NON-MISSING HGHT AND TEMP. LEVELS
C    RETAINED (TO MAKE PREPBUFR FILE CONTAIN DATA EXPECTED BY FERR PGM
C    AND OI ANALYSIS)
C 1996-03-04  D. A. KEYSER -- FOR RGL PREPBUFR OUTPUT: MORE FIXES TO
C    MAKE PREPBUFR FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C    (SEE SUBR. DOCBLOCKS); REPORT SEQ. NUMBER STORED IN HDR(11) FOR
C    ALL "ADPUPA" RPTS AND LATER ENCODED IN PREPBUFR FILE; ALL SFC RPTS
C    SET HGHT Q.M. TO PSTN Q.M. VALUE PRIOR TO STORING RPT IN NOBS
C    ARRAY & SUBSEQ. ENCODING IN PREPBUFR (USED TO ALWAYS ASSIGN HGHT A
C    NEUTRAL Q.M.); ALL SFC MARINE RPTS NOW CONVERT ON29 Q.M. 'H' OR
C    'P' ON PMSL TO EQUIV. PREPBUFR T. V. FOR BOTH PMSL & PSTN (USED TO
C    CONVERT TO ONLY PMSL TBL VAL) (ALLOWS THESE OPC Q.M.'S TO BE
C    HONORED FOR RPTS W/ VALID PSTN, WHOSE ON29 Q.M. IS ALWAYS BLANK-
C    NEUTRAL)
C 1996-09-03  D. A. KEYSER -- CAN NOW RETURN NMCEDS FORMAT FOR TOVS
C    RETR. IN NEW BUFR DUMP FILES (SWITCH IEDSTP, NEW SUBR. W3TOVEDS);
C    CAN PROCESS RETR. FROM GOES-ODD SAT (AS WAS FOR GOES-EVEN SAT); E-
C    O-F ON FIXED LAND/SEA/U.S. MASK FILE NOW STOPS W/ C.CODE 49 (USED
C    TO IGNORE MASKS); ADDED PROCESSING FOR NESDIS HI-DENSITY SAT.
C    WINDS (SWITCHES "SWINDO", "SWNLND", "JSWIND", "JSMASS" EXPANDED),
C    R.TYPES EXPANDED; PROCESSING OF TOVS RADIANCES PARTIALLY DONE
C    (SWITCH "TOVRAD"); ADDED SWITCH "MSGPSF" TO PROCESS SFC LAND RPTS
C    W/ MISSING PSTN AND PMSL (STD. ATMS. PSTN USED) (NOT PROC. IN
C    OPERATIONS); ALLOW BUFR EDIT. 3 WIND PROFILER MSGS TO BE
C    PROCESSED; WIND PROFILER LVLS WITH Q. CODE INDICATOR 2 (IN EDIT. 2
C    OR >, SHEAR CHK AND/OR MEDIAN CHK NOT PERFORMED OR INCONCL.) NOW
C    GET PREPBUFR TBL. VAL. 11 (BAD), BEFORE SUCH LVLS WERE OF NEUTRAL
C    QUALITY; CAN READ WSPD IN M/S X 10 FROM ON29 CAT.8, C.FIG. 924 IF
C    AVAILABLE
C 1996-10-24  D. A. KEYSER -- LOGIC ADDED TO PROCESS TOVS RADIANCES
C    FROM BUFR DUMP FILE AND ENCODE THEM INTO PREPBUFR FILE, CALL TO
C    W3FI80 REPLACED BY W3TOVUNP, N-LIST SWITCHES "TOVRAD" AND "TOVRTV"
C    ADDED TO PROCESS RADIANCES AND RETRIEVALS RESP.; LOGIC RELATED TO
C    INTERACTIVE RETR. PROCESSING REMOVED, SUBR. "INTERP" REMOVED;
C    HARDWIRED TO NO LONGER WRITE TO SEQ'L. 16-BIT PREPDA DATA SET;
C    ADDED CALL TO BUFRLIB "DATEBF" TO RETURN CENTER DATE FOR TOVS BUFR
C    DATA DUMP FILES (SIMPLIFIES OTHER TIME-CHECKING PROCEDURES);
C    STREAMLINED PARTS OF SUBR. "SATEDS", NOW PRINTS COUNT OF RPTS.
C    OUTSIDE TIME WINDOW; DEFAULT FOR N-LIST SWITCH "IDELEV" UP'D FROM
C    20 TO 30 (METERS), FOR U-AIR REPORT FAILING B-LINE CHK ANY
C    VARIABLES WITH AN EXISTING KEEP FLAG ON THEM WILL NOT BE FLAGGED
C    AS BAD OR SUSPECT; ADDED LOGIC TO PROCESS ERS SCATTEROMETER WIND
C    REPORTS (R.TYPE=286) AND ENCODE IN PREPBUFR D-SET (USED TO BE
C    APPENDED LATER), NEW SUBR. "GETERS" CALLS NEW W3LIB "W3ERSUNP",
C    NEW N-LIST SWITCHES JPERSD(6) & IEWNDO(2), CAN WRITE TIMELY BUFR
C    MESSAGES TO IUNIT(16); REORGANIZED/STREAMLINED COMMON BLOCKS;
C    CORRECTED ERROR IN ENCODING OF INITIAL VALUES FOR HEADER MNEMONICS
C    "RQM", "DUP", "PRG", "SRC", AND "RUD" (ONLY USED FOR REANALYSIS
C    VERSION)
C 1997-01-31  D. A. KEYSER -- ADDED CALL TO NEW SUBR. "W3UNPK77" AND
C    ADDED N-LIST SWITCHES "IACFTL" (REPL. "IACARL"), "AIFNOW", AND
C    "IPRFTP" [THE FIRST TWO ALLOW AIRCRAFT DATA TO BE FLAGGED OR
C    TOSSED IF BELOW "FLOOR" OR WIND IS MISSING, THE THIRD SELECTS THE
C    TYPE OF INPUT FILE FOR WIND PROFILER DATA (WMO BUFR VS. BUFR
C    DUMPS)] - ALL OF THIS IS TO ALLOW THIS PROGRAM TO READ OBS. DATA
C    EITHER FROM OLD NAS9000 PROCESSING OR NEW CRAY/BUFR INGEST
C    PROCESSING
C 1997-05-01  D. A. KEYSER -- AT END OF SUBR. WNDBYZ WILL NOW ALWAYS
C    RESORT ALL REPORTS BY PRESSURE TO ENSURE THAT ALL REPORTS IN THE
C    PREPBUFR FILE WILL BE ARRANGED IN DECREASING PRESSURE (ERRONEOUS
C    REPORTS MAY CONTAIN HEIGHTS THAT ARE OUT OF ORDER NOW); EXPANDED
C    ARRAYS NOBS, DAT, TMP TO HOLD P,T,q,W REASON CODES; EST. REASON
C    CODES FOR UPPER-AIR DATA TYPES (CURRENTLY JUST 100, 101-103, 105
C    TO IDENTIFY INTERPOLATED DATA FOR CQCBUFR PGM); CHGS IN LVL ON29
C    CATEGORY INDICATORS: SPEC. LVLS GET CAT=7 RATHER THAN 6, TROP CAT=
C    5 EXPLICITLY IDENTIFED IN ALL CASES, SAME W/ CAT 2-4; STDOUT
C    EXPANDED TO INCL. REASON CODES; REASON CODES ENCODED INTO
C    PREPBUFR; SUBR. 'STOROB' NO LONGER CALLED AND REMOVED, SUBR.
C    'STORXX' RENAMED TO 'STOROB'; ALL REFERENCES TO NAS/HDS REMOVED
C 1997-06-02  D. A. KEYSER -- REMOVED A LOT OF LOGIC TESTING FOR
C    SEQNTL=F, OBUFR=F & NLWRD=4 SINCE THESE ARE NO LONGER OPTIONS;
C    REMOVED FCN MARARC SINCE NO LONGER CALLED; THE REPORT D-TIME
C    {HDR(4)} CHGED FROM HRS*100 TO HRS*1000 (CURRENTLY ONLY MDCRS CAN
C    BE THIS PRECISE); BUFR MNEMONIC "DHR" (REPORT D-TIME) SCALE CHGED
C    FROM 10**2 TO 10**3 FOR MORE PRECISION IN RPT TIME; FOR AMDAR
C    ACFT: CHAR. 1 & 2 OF TRUE STNID NOW READ FROM UNPKED ON29 CAT. 8
C    C. FIG. 917, CHAR. 3 & 4 OF TRUE STNID NOW READ FROM UNPKED ON29
C    CAT. 8 C. FIG. 918, AND CHAR. 5 & 6 OF TRUE STNID NOW READ FROM
C    UNPKED ON29 CAT. 8 C. FIG. 919; FOR AMDAR AND MDCRS ACFT: CHAR. 7
C    & 8 OF TRUE STNID NOW READ FROM UNPKED ON29 CAT. 8 C. FIG. 920;
C    FOR MDCRS ACFT: RPT. TIME TO NEAREST 1000'TH HOUR NOW READ FROM
C    UNPKED ON29 CAT. 8 C. FIG. 921; ADDED N-LIST SWITCH "IVADTP" TO
C    SELECT THE TYPE OF INPUT FILE FOR NEXRAD (VAD) WIND DATA (WMO BUFR
C    VS. BUFR DATA DUMP) TO ALLOW THIS PROGRAM TO READ THIS DATA EITHER
C    FROM OLD NAS9000 PROCESSING OR NEW CRAY/BUFR INGEST PROCESSING;
C    ADDED N-LIST SWITCH "FLDMGS" TO FLAG MOISTURE DATA ON ALL LEVELS
C    FOR GULF STREAM DROPS (IF TRUE)
C 1997-07-02  D. A. KEYSER -- REMOVED MORE LOGIC TESTING FOR SEQNTL=F,
C    OBUFR=F, NLWRD=4 AND ALSO KMAX=12 SINCE THESE ARE NO LONGER
C    OPTIONS; MODIFIED THE PROCESSING OF GOES DATA TO READ FROM A
C    SINGLE BUFR DATA DUMP FILE USING W3LIB ROUTINE W3UNPK77 (RATHER
C    THAN OLD READ FROM 2 WMO BUFR FILES WHICH USED W3FI77), ALSO READS
C    IN AND PROCESSES 18-CHANNELS OF BRIGHTNESS TEMPERATURE (IF
C    REQUESTED FROM NEW N-LIST SWITCH "GOESRD"); QUAL. MARKER FOR VAD
C    WIND LEVELS WITH INPUT RMS VECTOR ERROR TAG OF "B" (3.9 KNOTS)
C    DOWNGRADED FROM NEUTRAL TO SUSPECT (AT REQUEST OF NOAA/FSL);
C    STREAMLINED DO LOOP PROCESSING IN PLACES TO SPEED UP PROGRAM A
C    BIT; REMOVED SUBR. "TAB"; FOR U.S. SATWNDS: CHAR. 7 & 8 OF STNID
C    NOW READ FROM UNPKED ON29 CAT. 8 C. FIG. 920; PROFLR AND VADWND
C    GENERATE SPECIAL LEVELS BASED ON "SPCIAL" SWITCH (BEFORE,
C    HARDWIRED TO ALWAYS GENERATE SPECIAL LEVELS)
C 1997-07-22  D. A. KEYSER -- ESTABLISHED NEW BUFR TABLE A MESSAGE TYPE
C    "GOESND" TO HOLD GOES RADIANCES/RETRIEVALS (BEFORE THEY WERE
C    COMBINED WITH TOVS IN "SATEMP"); CORRECTED SOME COMMON BLOCK AND
C    SUBR. ARGUMENT INCONSISTENCIES THAT MAY HAVE CONTRIBUTED TO
C    STORAGE BEING "CLOBBERED"; NAMELIST SWITCH "IWINDO" FOR GOES DATA
C    (LAST 10 WORDS) REDEFINED FROM WHOLE HOURS TO HOURS * 100 TO GIVE
C    MORE PRECISION IN DEFINING GOES TIME WINDOW
C 1997-08-28  D. A. KEYSER -- CORRECTS FOR GOES CALC. NEGATIVE TOP
C    LAYER P. WATER WHICH CAN NOW OCCUR DUE TO ROUND-OFF ERROR IN INPUT
C    BUFR DUMP FILE - SETS TO 0 IF > -1 MM, ELSE TOSSES PWATER REPORT;
C    TOSSES GOES PWATER RPT IF ANY OF THE LAYER VALUES ARE MISSING OR
C    < ZERO
C 1997-09-18  D. A. KEYSER -- REMOVED CALL TO "ERRSET"; ADDED "W3FS22"
C    IN-LINE TO DIAGNOSE DATA CLOBBERING; REDEFINED N-LIST SWITCH
C    "MSGPSF=T" TO USE ALTIMETER SETTING FOR PMSL WHEN OBS. SURFACE
C    LAND PMSL & PSTN ARE MISSING; CAN STORE ALTIM. SETTING IN
C    PREPBUFR; STORES SKIN TEMP., CLOUD AMT., SOLAR ZENITH ANG., AND
C    SAT. ZENITH ANG. IN PREPBUFR WHEN PROCESSING GOES RADIANCES
C 1997-10-06  D. A. KEYSER -- ADDED LOGIC TO PROCESS NEW TYPES OF
C    NESDIS HI-DENS SATWNDS, ALONG WITH NEW R.TYPES {ALSO N-LIST ARRAYS
C    SWINDO, SWNLND, JSWIND, JSMASS EXPANDED FROM (6,5,7) TO (6,5,10)};
C    N-LIST SWITCHES LNDHRY AND BUOHRY REMOVED AS IS ALL LOGIC RE:
C    PROCESSING OF ASYNPOTIC SFC REPORTS (OBSOLETE); N-LIST SWITCHES
C    FILLP, SEQNTL, OBUFR, LIMITA, LIMDAY AND LIMON ALL REMOVED
C    (OBSOLETE); ENCODES FOV# AS 'ACAV' INTO PREPBUFR FOR GOES REPORTS
C 1998-02-17  D. A. KEYSER -- REMOVED LOTS OF OBSOLETE LOGIC, MUCH
C    PERTAINING TO UNPACKED ON29 INPUT; INCREASED EFFICIF. OF CODE BY
C    REPLACING CALLS TO IW3GAD WITH IW3UNPBF WHICH RETURNS REPORTS FROM
C    BUFR IN UPDATED FMT; ADDED SEVERAL OTHER INTERFACE REPLACEMENT
C    CODES INCL. W3UNPKB7 (REPL. W3UNPK77), W3ERSUNB (REPL. W3ERSUNP),
C    AND NEW VERSION OF W3FA07 - ALL ARE CURRENTLY IN-LINE; MORE
C    PRECISION IN ENCODED REPORT TIME, WIND SPEED IN PREPBUFR; TROP.
C    LVLS WITH WSPD=0 FLAGGED AS BAD
C 1998-03-16  D. A. KEYSER -- CRISIS FIX TO BUMP UP ARRAY SIZE FOR
C    UNPACKED REPORT FROM IW3UNPBF/IW3GAD TO 2500 (WAS 1608 BUT
C    IW3UNPBF FILLS MORE WORDS THAN DID IW3GAD)
C 1998-05-15  D. A. KEYSER -- ADDED PROCESSING OF RTOVS DATA BASED ON
C    NEW NAMELIST SWITCH "RTOVS", NEW IN-LINE ROUTINES W3RTVUNP AND
C    W3RTVEDS ADDED FOR INTERFACE WITH RTOVS DATA (RETURNING 40-LVL/
C    RADIANCES AND PARTIAL NMCEDS FORMAT, RESP.), 250 KM RTOVS SAMPLING
C    ACCOMPL. VIA PROCESSING ONLY EVERY 4'TH RETRIEVAL; ADDED KOUNTS
C    FOR REJECTED TOVS/RTOVS NMCEDS DATA PROCESSING, SUMMARIZED IN
C    STDOUT PRINT AT END OF PROGRAM; FLAGGING OF TROP LVLS WITH WSPD=0
C    MOVED FROM SUBR. GETUPA TO STOROB BECAUSE SOME CALM TROP WINDS
C    WEREN'T BEING IDENTIFIED
C 1998-06-14  D. A. KEYSER -- NEW LOGICAL N-LIST SWITCH "FLGOES" IS A
C    4-WORD ARRAY WHICH ALLOWS ALL SNDG/RETR DATA FROM EVERY OTHER EVEN
C    OR ODD GOES SATELLITE TO BE FLAGGED FOR NON-USE BY THE ANALYSIS
C    (NEEDED WHEN 2 EVENS OR ODDS ARE PRODUCING DATA BUT ONLY ONE IS
C    USED OPERATIONALLY), CHAR. 6 OF GOES STNID IS NOW UNIQUE FOR TWO
C    DIFFERENT, BUT CONSECUTIVE, EVEN OR ODD SATELLITES)
C 1998-06-15  D. A. KEYSER -- INCR. Y2K-COMPL. BY REPL. CALL TO IW3GAD
C    W/ IW3UNP29 (APPLIES ONLY TO SPSSMI FILE; SEE W3LIB ROUTINE
C    IW3UNP29 FOR PSEUDO-ON85 FMT); INCL. THE OLD PREVENTS PROGRAM,
C    MERGED IN AS A SUBR., CONTROLLED BY N-LIST SWITCH 'PREVEN'; ADDED
C    N-LIST 'PREVDATA' WITH SWITCHES FOR PREVENTS PROCESSING; MODIFIED
C    ARRANGEMENT OF INPUT DATA SET UNIT NOS. (CONTROLLED BY SWITCH
C    'IUNIT' IN NAMELIST 'PARM'); PREVENTS OUTPUTS A DATA FILTERING
C    EVENTS SUMMARY FILE; REMOVED OBSOLETE R.H. MNEMONICS & 'SFCBOG'
C    TABLE A ENTRY; SUBR. W3FIZZ STREAMLINED TO NO LONGER SEPARATE
C    SINGLE- & MULTI-LVL TABLE A TYPES; NOBS ARRAY REMOVED - DATA FOR A
C    RPT NOW STORED IN HEADER ARRAY (HDR) & LVL DATA ARRAY (MOBS) -
C    MOBS 3-DIM TO HANDLE VARIABLE SUBTYPE (OBS, T.V., R.C.), VARIABLE,
C    & LVL; LAT, LON, OBS. TIME & RCPT TIME IN HEADER NOW STORED IN
C    WHOLE DEG. & HRS TO STREAMLINE INTERFACE BETWEEN DATA DUMPS &
C    PREPBUFR FILE; STREAMLINED THE PROCESSING OF CAT. 6 FLT-LVL RECCOS
C    W/ EITHER MAND LVL GEOPOT. OBS OR MEAN SEA-LVL PRESS. OBS; REMOVED
C    ALL LOGIC PERTAINING TO TOVS PROCESSING (SUBR. 'TOVSID' & 'TDEW'
C    NO LONGER CALLED - REMOVED, N-LIST SWITCH 'RTOVS' REMOVED; N*/
C    PTLY-CLDY PATH NO LONGER POSSIBLE); ENCODES SOLAR & IR RAD.
C    CORRECTION INDICATOR INTO PREPBUFR FILE AS MNEMONIC 'SIRC' (FOR
C    "ADPUPA" TYPES W/ VALID INSTR. TYPE), READ CAT. 8 C.F. 353; RTOVS
C    250KM SUB-SAMPLING NOW DEPENDS UPON VALUE IN FILTER FLAG AS WAS
C    THE CASE FOR TOVS (FIX BY NESDIS) (BEFORE 250KM SUB-SAMPLING WAS
C    EST. BY PROCESSING EVERY 4'TH RTOVS REPORT)
C 1998-09-21  D. A. KEYSER -- THIS PROGRAM IS NOW Y2K AND FORTRAN 90
C    COMPLIANT; COMMENTED OUT CALL TO PREVENTS SINCE PREVENTS
C    PROCESSING IS STILL DONE IN SEPARATE PROGRAM
C 1998-10-09  D. A. KEYSER -- CORRECTED ERROR IN RETURNING GOES CAT. 8
C    DATA IN W3UNPKB7 WHEN GREATER THAN 9 "LEVELS" ARE PRESENT; ADDED
C    SECONDS TO DECODED REPORT DATE IN W3ERSUNB (ONLY USED IN PRINTS OF
C    REPORT DATE)
C 1998-12-11  D. A. KEYSER -- REPLACED CALL TO "ABORT" WITH CALL TO
C    "BORT" (BUFRLIB ROUTINE); NO LONGER ENCODES ERS SCATTEROMETER
C    INCIDENT ANGLE, AZIMUTH ANGLE, BACKSCATTER AND ERROR ESTIMATE IN
C    PREPBUFR FILE (WERE ALWAYS SET TO ZERO AND NEVER USED) - SAVES A
C    LOT OF SPACE IN THE PREPBUFR FILES
C 1999-01-20  D. A. KEYSER -- INCORPORATED BOB KISTLER'S CHANGES NEEDED
C    TO PORT THE CODE TO THE IBM SP; ADDED N-LIST SWITCHES "IVADFL" AND
C    "IVADSP" TO SELECT VAD WIND RMSVE TOLERANCE; REPL. N-LIST SWITCH
C    "SATLND" WITH NEW SWITCHES "ISATLS" AND "JSATLS" TO HANDLE LAND/
C    SEA SELECTION FOR SATELLITE SNDGS/RADIANCES AND GOES PW RETR.
C    SEPARATELY (ALSO CAN NOW SELECT JUST LAND AS WELL AS JUST SEA OR
C    EVERYWHERE); N-LIST SWITCHES "RECCON" AND "RWINDO" NOW APPLY ONLY
C    TO RECCO DATA, NEW SWITCHES "DROPSN" AND "DWINDO" NOW APPLY TO
C    DROPS; ADDED N-LIST SWITCH "FLDMAF" WHICH CAN FLAG MOISTURE DATA
C    ON ALL LEVELS FOR USAF DROPS (IF TRUE)
C 1999-08-04  D. A. KEYSER -- MODIFIED TO READ BOTH REPROCESSED SSM/I
C    (SPSSMI) AND ERS WIND (ERSCAT) DATA FROM "JACK WOOLLEN" BUFR FILES
C    RATHER THAN FROM ON29 AND WMO BUFR FILES, RESP., REMOVED SUBR.
C    W3ERSUNB AND CALL TO IT, REMOVED SUBR. UNPREP AND CALL TO IT,
C    SUBR. IW3UNPBF (VIA SUBR. UNPREPBF) AND W3UNPKB7 MOD. TO HANDLE
C    SSM/I AND ERS REPROC. DATA (RESP.) IN "JACK" BUFR, INPUT TABLEB
C    AND TABLED FILES REMOVED; REMOVED ENCODING OF 'RQM', 'DUP', 'PRG',
C    'SRC', 'RUD' AS THEY WERE ALWAYS MISSING (REANALYSIS RELATED) AND
C    WASTED LOTS OF SPACE; ADDED ENCODING OF PHASE OF FLIGHT ('POAF')
C    FOR ALL ACFT TYPES AND DEGREE OF TURBULENCE ('DGOT') FOR NON-MDCRS
C    ACFT TYPES (REQUESTED BY NCDC); UPDATED LOGIC TO PROPERLY PROCESS
C    AUSTRALIAN SEA-LEVEL PRESSURE BOGUS DATA (PAOBS); ADDED PROCESSING
C    OF MDCRS MOISTURE DATA BUT THEY ARE FLAGGED FOR ALL REPORTS;
C    RADIOSONDE BALLOON DRIFT LAT/LON NOW CALCULATED ON EACH LEVEL AND
C    ENCODED INTO PREPBUFR FILE WITH MNEMONICS "YDR" AND "XDR"; FOREIGN
C    SATWND SWITCHES NOW CONTROL IR C-DRFT AND VIS. C-DRFT SEPARATELY
C    (STILL SAME R.TYPES); ADDED PROCESSING OF FOREIGN WATER VAPOR
C    SATWNDS WITH NEW R.TYPES 250 (GMS), 254 (EUMETSAT), AND 256
C    (INSAT); REPLACED CALL TO SUBROUTINE "PREVENTS" WITH CALL TO W3LIB
C    ROUTINE "GBLEVENTS"; REPLACED SORT ROUTINE "SHELL" (IN-LINE
C    SUBROUTINE) WITH W3LIB ROUTINE "ORDERS", MORE EFFICIENT AND ALLOWS
C    MULTIPLE ORDER SORT KEYS; ADDED CALL TO SUBROUTINE WORDLENGTH TO
C    DETERMINE REAL AND INTEGER MACHINE WORDLENGTH SO PROPER SORT KEY
C    WORD LENGTH IS ALWAYS PASSED INTO W3LIB ROUTINE ORDERS, CALL TO
C    W3LIB ROUTINE "W3FI04" REMOVED; STOP COND. CODE "22" COULD NEVER
C    HAPPEN AND WAS REMOVED; THE LOGIC THAT ALLOWS PROFILER DATA FROM
C    EITHER 1-HR PREV OR 1-HR LATER TO BE USED IF ONLY A SINGLE TIME
C    SELECTED AND NO DATA AT THAT TIME FOUND CONFINED TO ONLY OI RUNS
C    (WAS FOR ALL TYPES); R.C. =4 NOW OCCURS IF EITHER NO ADPUPA OR
C    ADPSFC REPORTS WERE PROCESSED INTO PREPBUFR FILE, BEFORE IT
C    OCCURRED ONLY IF EITHER NO ADPUPA OR ADPSFC REPORTS WERE READ IN;
C    SWITCH "PREVEN" MOVED FROM NAMELIST "LDTA" TO "GBLEVN" - IF
C    NAMELIST GBLEVN NOT FOUND IN DATA CARDS, PREVEN DEFAULTS TO FALSE
C    - THIS ALLOWS FOR CONTROL OF CALL TO W3LIB ROUTINE "GBLEVENTS" TO
C    BE AT THE SCRIPT LEVEL
C 2000-02-17  D. A. KEYSER -- CHANGES TO MAKE CODE MORE PORTABLE; CAT.
C    4 U-AIR LEVELS NOW SET WIND Q.M. TO AT LEAST 2 ONLY IF WIND DOES
C    NOT HAVE AN SDM KEEP FLAG (I.E., THE KEEP FLAG ON CAT. 4 WINDS IS
C    HONORED); BUFR MNEMONIC TABLE REVISED TO REDUCE SIZE OF PREPBUFR
C    FILE BY REMOVING THE ENCODING OF SOME MNEMONICS WHICH ARE ALWAYS
C    MISSING; SWITCHES "FWINDO", "JSURFM" AND "JSURFW" ARE NOW ABLE TO
C    ACT ON SURFACE LAND SYNOPTIC AND METAR DATA SEPARATELY; CAN NOW
C    SKIP OVER INPUT BUFR MESSAGES IN DATA DUMP FILES IF THE BUFR TYPE/
C    SUBTYPE IS SET TO BE EXCLUDED (BEFORE EXCLUSION OCCURRED ONLY
C    AFTER REPORT WAS DECODED FROM DUMP FILE), THIS MAKES THIS PROGRAM
C    MORE EFFICIENT IN THESE CASES (NOTE: APPLIES ONLY TO U-AIR AND
C    SURFACE LAND DATA READ IN VIA FUNCTION IW3UNPBF); MNEMONIC "TFC"
C    NOW ENCODED IN PREPBUFR FILE FOR VAD WIND REPORTS (NEEDED BY
C    FUTURE VERSION OF CQCVAD PROGRAM); SUBR. W3RTVUNP RENAMED TO
C    W3RTOVSUNP, W3CNVTOV RENAMED TO W3CNVXTOVS (HANDLES RTOVS AND NEW
C    ATOVS), W3RTVEDS RENAMED TO W3XTOVSEDS (HANDLES RTOVS AND NEW
C    ATOVS), AND W3TOVMND RENAMED TO W3XTOVSMND (HANDLES RTOVS AND
C    ATOVS); CAN NOW PROCESS ATOVS DATA VIA NEW SUBR. W3ATOVSUNP (40-
C    LVL/35 RADIANCES) AND SUBR. W3XTOVSEDS (NMCEDS FORMAT); N-LIST
C    SWITCHES "TOVEDS" AND "TOVBFR" EXPANDED TO LENGTH 2 ARRAYS TO
C    DIFFERENTIATE BETWEEN RTOVS (=1) AND NEW ATOVS (=2) SAT. RETR.;
C    FOR SAT. RETR. OUTPUT IN NMCEDS FORMAT, CHAR. 7 OF STNID NOW
C    INDICATES RTOVS (='R') OR ATOVS (='A') (WAS BLANK); SPEC.
C    HUMIDITY AND VIRT. TEMPERATURE ARE NOW CALCULATED AS "VIRTMP"
C    EVENTS IN W3LIB GBLEVENTS WHEN SPEC. HUMIDITY QUAL. MARKER IS BAD
C    (SUBJECT TO A SANITY CHECK), HOWEVER THE VIRT. TEMPERATURE GETS A
C    BAD QUAL. MARKER (8); ADDED ENCODING OF NESDIS RECURSIVE FILTER
C    FLAG FOR SATWND (GOES) TYPES; MOVED GOES SATWND Q.M. ASSIGNMENT
C    BASED ON RFFL FROM SUBROUTINE IW3UNPBF TO INLINE SUBROUTINE
C    GETC06; EXPANDED BALLOON DRIFT PROCESSING TO INCL. PIBALS; UPDATED
C    DEL-TIME ON UPPER-AIR RAOB AND PIBAL LVLS (ALREADY CALC. BASED ON
C    BALLOON DRIFT) AND ENCODED INTO PREPBUFR FILE W/ MNEMONIC "HRDR";
C    LAUNCH TIME NOW READ FROM CAT. 8 CODE FIG. 104 IN ORDER TO ASSIGN
C    A CBASE TIME TO FIRST DATA LEVEL; LAUNCH TIME USED TO "CORRECT"
C    OBS. TIME FOR ADPUPA RPTS IN "DHR"; ADDED MNEMONICS "RPT" (ORIG.
C    OBS. TIME) AND "TCOR" (IND. FOR CORRECTED OBS. TIME IN"DHR")
C    ENCODED INTO PREPBUFR FILE; IMPR. CHECKING IN RAOB/PIBAL BALLOON
C    DRIFT LAT/LON/TIME CALC.; NOW CALLS SUBR. FILWND FOR RAOBS AND
C    PIBALS EVEN WHEN FILLW=F TO GET INTERP. WIND LEVELS FOR BALLOON
C    DRIFT LAT/LON CALC. (DISCARDS THEM PRIOR TO WRITE TO PREPBUFR FILE
C    WHEN FILLW=F); IF FILTER FLAG=-99 AND TR80KM=F, PROCESS ONLY EVERY
C    4'TH UNPACKED RTOVS RETRIEVAL TO SIMULATE 250 KM SUB-SAMPLING
C    (RTOVS DUMP FILE PRIOR TO 7/1/1998 - NO FILTER FLAG INFORMATION
C    AVAILABLE - NEEDED FOR HISTORICAL CDAS RUNS)
C 2000-09-22  D. A. KEYSER -- ADDED THE PROCESSING OF QUIKSCAT SCATTER-
C     OMETER WINDS (ALONG WITH NEW N-LIST SWITCHES "JPQKSD", "IQWNDO",
C     "IQKSLM" & "IQKSSP"), A TEMPORARY INSERTION IS THE THINNING OF
C     THE DATA BY PROCESSING ONLY EVERY-OTHER UNPACKED REPORT; SUBR.
C     GETERS CHANGED TO GETSCATT SINCE IT PROCESSES BOTH ERS AND
C     QUIKSCAT SCATTEROMETER REPORTS; ADDED ABILITY TO APPEND DATA TO
C     AN EXISTING PREPBUFR FILE VIA NEW N-LIST SWITCH "APPEND" (WHEN
C     APPENDING, THE INTERNAL BUFR MNEM. TBL. IN THE EXISTING PREPBUFR
C     FILE IS USED, R.C.=4 NOT VALID FOR APPEND=T, NEW R.C.=30 VALID
C     ONLY WHEN APPEND=T AND EXISTING FILE DATE DOES NOT MATCH EXPECTED
C     (PRODUCTION) DATE; ADDED PROCESSING OF AUTOMATED TIDE GAUGE STN
C     DATA (SFC MARINE TYPE, ON29 R.T. 533), N-LIST SWITCHES "FWINDO",
C     "JSURFM" AND "JSURFW" EXPANDED FROM 8 TO 9 WORDS; REMOVED
C     OBSOLETE LOGIC DEALING WITH OLD OI PROCESSING; CHANGED DEFAULT
C     FOR N-LIST SWITCHES "FILLZ", "FILLT", "FILLW" AND "FILLM" FROM
C     "TRUE" TO "FALSE", AND FOR "IRNMRK" FROM "2" TO "-99"
C 2000-12-05  D. A. KEYSER -- CHANGED ON29 REPORT TYPE (T29) FOR SFC
C     MARINE AUTOMATED TIDE GAUGE REPORTS FROM 533 TO 532 SO THEY AGREE
C     WITH REPORT TYPE IN QUIPS PROCESSING; N-LIST SWITCH "MSGPSF"
C     REPL. BY SWITCH "PFRALT" WHICH PROCESSES METARS W/ MISSING
C     PRESSURE BY CALC. PSTN FROM ALTIMETER, THESE GET NEW R.T.
C     187/287; RECOGNIZES SATWIND REPORTS WITH NEW 8-CHAR. STNID
C     FORMAT; RECOGNIZES GOES SNDG/RAD REPORTS WITH NEW 8-CHAR. STNID
C     FORMAT; RECOGNIZES ERS AND QUIKSCAT REPORTS WITH NEW 8-CHAR.
C     STNID FORMAT; ALL CAT. 6 TYPES NOW STORE SPEC. HUMIDITY AS
C     MOISTURE VARIABLE RATHER THAN DEWPOINT DEPR.; NEW N-LIST SWITCH
C     "FLACMS", WHEN TRUE (DEF.) FLAGS ALL MDCRS MOISTURE DATA (WAS
C     HARDWIRED AS FLAGGED); METARS W/ MISSING WDIR & WSPD .LE. 3M/S
C     ENCODE WSPD OBS/QM IN NEW MNEM. "SOB" AND "SQM"; FOR IRNMRK=4
C     (RUC) ALL BUOYS W/ MISSING PRESSURE BUT VALID WIND ARE PROC.
C     W/ R.T. 282 (PRESS. SET TO 1013.3MB, JUST LIKE ATLAS BUOYS);
C     WIND PROFILERS WHICH COME IN DISGUISED AS PIBALS ARE CHANGED TO
C     R.T. 223 SO THEY WILL BE PROCESSED AS WIND PROFILERS (DETERMINED
C     BY STNID)
C 2001-04-06  D. A. KEYSER -- NAMELIST SWITCH IQKSLM NOW 2-WORD ARRAY
C     (WORD 2 - QUIKSCAT P.O.R. THESHOLD FOR SUSPECT Q.M.); PRINTS
C     DIAG. IF TDEW < TDLIM FOR NON-ADPUPA DATA TYPES); CAN HANDLE
C     WIND PROFILERS ORIG. FROM PILOT (PIBAL) BULL. IN "PROFLR" DUMP
C     FILE; ADDED UK PROFILER ID 03501 TO LIST OF PROFILERS WHICH MAY
C     COME IN DISGUISED AS PIBALS PRIOR TO DECODER CHANGE (GETS R.TYPE
C     223); SUBR. "PWATER" RENAMED TO "GETPWATER", NOW RETURNS IERF=1
C     IF REPORT NOT ENCODED INTO PREPBUFR FILE (INSTEAD OF MST=0); NOW
C     PROCESSES SSM/I RAIN RATE UNDER R.TYP 150; SUBR. "GETSMI"
C     STREAMLINED; ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES RAD.
C     AS K (PRECISE TO 10**2) RATHER THAN K*100; ACCOUNTS FOR SUBR.
C     W3UNPKB7 OUTPUTTING GOES PWATER AS AS MM (PRECISE TO 10**2)
C     RATHER THAN MM*100; ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES
C     SKIN TEMP AS K (PRECISE TO 10**2) RATHER THAN K*100; ACCOUNTS
C     FOR SUBR. W3UNPKB7 OUTPUTTING GOES SOLAR AND SAT. ZENITH ANGLE
C     AS DEGREES (PRECISE TO 10**2) RATHER THAN DEG*100; ACCOUNTS
C     FOR SUBR. IW3UNPBF OUTPUTTING SSM/I WIND SPEED IN M/SEC (PRECISE
C     TO 10**1) RATHER THAN M/SEC*10; ACCOUNTS FOR SUBR. IW3UNPBF
C     OUTPUTTING SSM/I TPW IN MM (PRECISE TO 10**1) RATHER THAN MM*10;
C     ACCOUNTS FOR SUBR. IW3UNPBF OUTPUTTING SSM/I BRIGHTNESS TEMPS IN
C     K (PRECISE TO 10**2) RATHER THAN K*100; FOR ALL SATELLITE TYPES
C     EXCEPT SSM/I SUPEROBED PRODUCTS, NOW READS SATELLITE ID FROM
C     WORD 6 OF HEADER RETURNED FROM BOTH SUBR. IW3UNPBF AND W3UNPB7
C     AND ENCODES AS "SAID" IN PREPBUFR FILE; N-LIST SWITCH SWINDO
C     SPLIT INTO SWINDO_e (EARLIEST TIME WINDOW) AND SWINDO_l (LATEST
C     TIME WINDOW) FOR SATWND REPORTS ("-" PRIOR TO CYCLE TIME, "+"
C     AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE); SUBR. "RPTLBL" NOW
C     HAS INPUT ARGS. "TIMWIN_e" (EARLIEST TIME WINDOW) AND "TIMWIN_l"
C     (LATEST TIME WINDOW) REPL. "TIMWIN" (+/- TIME WINDOW) ("-" PRIOR
C     TO CYCLE TIME, "+" AFTER CYCLE TIME), ALLOWS THE 2 TO BE
C     DIFFERENT; WIND PROFILERS COMING IN DISGUISED AS PIBALS
C     (DETERMINED BY STNID) IN THE "ADPUPA" FILE ARE NO LONGER SUBJECT
C     TO POSSIBLE REPORT TIME ALTERATION AND LAUNCH TIME CALC. (THIS
C     WAS AN OVERSIGHT IN LAST IMPL. WHICH GAVE THEM R.T.223 - THE
C     POINT WILL SOON BE MUTE IN PRODUCTION SINCE THESE WILL BE IN
C     "PROFLR" FILE, BUT STILL NEEDED FOR HISTORICAL RERUNS); READS IN
C     THE 4 MDCRS TURBULENCE INDECES AND ENCODES THEM INTO THE PREPBUFR
C     FILE UNDER MNEMONICS "TRBX10", "TRBX21", "TRBX32" AND "TRBX43";
C     READS IN GOES SFC PRESSURE (FROM CAT. 8, CF 262) AND ENCODES IT
C     INTO PREPBUFR FILE UNDER MNEMONIC "PRSS" FOR GOES PW RETR.
C     REPORTS
C 2001-06-19  D. A. KEYSER -- CAN NOW PROCESS GOES 1x1 FOV CLOUD TOP
C     REPORTS INTO PREPBUFR FILE UNDER R.T. 151 (MNEMONICS ARE "CDTP"/
C     CLOUD TOP PRESSURE, "TOCC"/CLOUD COVER, "GCDTT"/CLOUD TOP TEMP.);
C     NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK SEPARATE FROM "RPTLBL";
C     SUBR. "GOESDG" STREAMLINED, WITH NEW SUBR. "GOESCHK" NOW
C     PERFORMING CHECKS ON SEPARATE RPT TYPES BEING PROCESSED; N-LIST
C     SWITCHES "GOESND", "GOESPW", "GOESRD" AND NEW "GOESCT" NOW LENGTH
C     2 TO PROCESS THE 4 GOESND TYPES FORM EITHER 5X5 OR 1X1 FOV;
C     N-LIST SWITCHES "IWINDO", "SATMST", "ISATLS", "IRTRV" AND "KTOP"
C     NOW MORE SPECIFIC TO POINT TO PAIRS OF EVEN OR ODD GOES SATS. AND
C     TO THE 4 POSSIBLE REPORT TYPES THAT CAN BE GENERATED FROM RTOVS/
C     ATOVS AND GOES SNDG/RAD/RETR. DATA (OLD SWITCHES "JSATLS" AND
C     "FLGOES" NO LONGER NEEDED AND REMOVED); SUBR. "SNDTBL"
C     STREAMLINED TO PRESENT IMPROVED TABLES, INPUT ARG. "IDSAT" OF
C     LENGTH 4 REPL. OLD ARG. "IEVSAT" AND "IODSAT"; SET GOES PW REPORT
C     REASON CODES TO 100 (WERE MISSING); SET SSM/I PW REPORT REASON
C     CODE TO 100 (WAS MISSING); SET SSM/I RAINFALL RATE REASON CODE TO
C     100 (WAS MISSING)
C 2001-08-01  D. A. KEYSER -- N-LIST SWITCH IRNMRK CAN NOW HAVE A
C     VALUE OF 7 TO DESIGNATE CDAS-REANLYSIS/SSI RUNS (BEFORE THESE
C     RECEIVED IRNMRK=5, RESERVED FOR FNL-GDAS/SSI RUNS); WELCOME PRINT
C     NOW IDENTIFIES PARTICULAR RUN; N-LIST SWITCH IWINDO SPLIT INTO
C     IWINDO_e (EARLIEST TIME WINDOW) AND IWINDO_l (LATEST TIME WINDOW)
C     FOR SATELLITE SOUNDING/RETRIEVAL/RADIANCE REPORTS ("-" PRIOR TO
C     CYCLE TIME, "+" AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE); IN
C     RESPONSE TO CHANGE TO SUBR. W3ATOVSUNP, NOW PASSES IER=0 INTO
C     SUBR. UPON FIRST CALL FOR ATOVS DATA (SIGNALS INPUT BUFR FILE
C     IS A DATA DUMP)
C 2001-09-14  D. A. KEYSER -- CORRECTED AN ERROR IN CALCULATING
C     RADIOSONDE BALLOON DRIFT D-TIME ("HRDR") FOR WIND REPORT
C     PRESSURE LEVELS THAT ARE ALSO FOUND IN THE CORRESPONDING MASS
C     REPORT ("HRDR" IS CALCULATED CORRECTLY FOR THE MASS REPORT
C     LEVELS); REPORT SEQ. NUMBER STORED IN HDR(11) FOR SURFACE LAND
C     AND SURFACE MARINE REPORTS LATER ENCODED IN PREPBUFR FILE UNDER
C     MESSAGE TYPES "ADPSFC" AND "SFCSHP", FOR SATELLITE-DERIVED WIND
C     REPORTS LATER ENCODED UNDER MESSAGE TYPE "SATWND", AND FOR
C     RECCOS LATER ENCODED UNDER MESSAGE TYPE "ADPUPA" (RECCO SEQ.
C     NUMBER WILL BEGIN WHERE RAOBS/PIBALS/DROPS LEFT OFF IN "ADPUPA")
C 2001-10-10  D. A. KEYSER -- NEW N-LIST "TASK" READ IN WITH SWITCH
C     "MP_PROCESS" WHICH IDENTIFIES PROCESS NUMBER FROM THE MPI RUN,
C     ENCODED IN PREPBUFR UNDER MNEMONIC "PROCN"; N-LIST SWITCHES
C     "IQKSLM" AND "IQKSSP" NO LONGER READ AND REMOVED AS QUIKSCAT
C     Q.C. WRT PROB. OF RAIN AND SWATH EDGE NOW PERFORMED IN UPSTREAM
C     PGM "WAVE_DCODQUIKSCAT";  RECOGNIZES QUIKSCAT SUPEROBS (NOW
C     GENERATED IN "WAVE_DCODQUIKSCAT") WITH "S" IN CHAR. 2 OF REPORT
C     ID; NO LONGER THINS QUIKSCAT DATA BY PROCESSING ONLY EVERY OTHER
C     REPORT ("WAVE_DCODQUIKSCAT" NOW HAS OPTION TO SUPEROB); MODIFIED
C     TO NOW PASS TWO SPANNING GLOBAL SIGMA GUESS FILES INTO W3LIB
C     ROUTINE GBLEVENTS IN SITUATIONS WHERE THE CENTER DATE FOR THE
C     PREPBUFR FILE HAS AN HOUR THAT IS NOT A MULTIPLE OF 3 (SEE
C     2001-10-10 CHANGES TO GBLEVENTS); ENCODES SATELLITE ID ("SAID")
C     FOR RTOVS/ATOVS RETRIEVALS (FROM BOTH 40-LEVEL BUFR OR NMCEDS
C     FMT) (WAS MISSING)
C 2002-01-14  D. A. KEYSER -- ADDED N-LIST SWITCH "IACFTH" WHICH ALLOWS
C     AIRCRAFT DATA TO BE FLAGGED IF ABOVE A LIMITING ALTITUDE (DEFAULT
C     IS 18000 M FOR AIREP/PIREP AND AMDAR AND 16500 FOR MDCRS); LEVELS
C     WITH REPORTED/CALC. DWPT < "TDLIM" VALUE NOW CALC./RETAIN SPEC.
C     HUM AND RETAIN/CALC. DWPT IN PREPBUFR FILE, BUT MOISTURE PREPDA
C     TABLE VALUE IS FLAGGED WITH Q.M.=15 (BEFORE, SPEC. HUM. AND DWPT
C     SET TO MISSING) VIRT. TEMP. CALC. IN THIS CASE (BEFORE, SET TO
C     SENSIBLE TEMP.)
C 2002-01-28  D. A. KEYSER -- READS PRECISION OF TEMP. OBS. OUT OF
C     "AIRCAR" AND "AIRCFT" DUMP FILES (CAT. 8, CODE FIG. 915) AND
C     ENCODES THIS INTO PREPBUFR FILE UNDER MNEMONIC "PCAT" (ONLY
C     AVAIL. FOR AMDAR AND MDCRS); CORRECTED ERROR INTRODUCED ~1/9/2001
C     WHICH RESULTED IN NO MASS REPORTS BEING ENCODED INTO THE RUC
C     VERSION OF THE PREPBUFR FILE FOR MOORED AND DRIFTING BUOYS
C     (AFFECTED ONLY THE RUC AND ONLY THESE DATA TYPES); NOW RECOGNIZES
C     THAT W3UNPKB7 CAN RETURN A VAD WIND Q.M. OF 12 (MEANING ON REJECT
C     LIST) OR 14 (MEANING SDM PURGED) ALONG WITH EXISTING Q.M.
C     GENERATED FROM RMS VECTOR ERROR; NOW RECOGNIZES THAT W3UNPKB7 CAN
C     RETURN A WIND PROFILER "QUALITY CODE" OF 14 (MEANING EITHER ON
C     WIND REJECT LIST OR SDM PURGED) ALONG WITH EXISTING Q. CODES FROM
C     FSL/HUB
C 2003-07-10  D. A. KEYSER -- NOW RETURNS NEW ARRAY "OBS2" OUT OF
C     CALL TO IWUNPBF, CURRENTLY JUST 2-WORDS WHERE WORD 1 IS
C     "RESTRICTIONS ON REDISTRIBUTION" (BUFR F.T. 0-35-200) AND WORD
C     2 IS "EXPIRATION OF RESTRICTIONS ON REDISTRIBUTION" (HRS),
C     THESE ARE ENCODED INTO PREPBUFR FILE UNDER NEW MNEMONICS
C     "RSRD" AND "EXPRSRD", RESP.
C 2003-08-22  D. A. KEYSER -- CORRECTED BUG WHICH STARTED CALCULATING
C     RADIOSONDE/PIBAL BALLOON DRIFT TIME FROM FIRST REPORTING HEIGHT
C     LEVEL RATHER THAN SURFACE LEVEL (STARTED AT 1000 MB MAND. LEVEL
C     BELOW GROUND), DRIFT LAT/LON VALUES WERE OKAY
C 2004-01-09  D. A. KEYSER -- ADDED NEW NAMELIST SWITCH SUBSKP
C     DIMENSIONED (0:12,0:200) DEFINED AS EXISTING VARIABLE SUBSKP
C     {IDENTIFIES THOSE BUFR TYPES/SUBTYPES FOR WHICH THE BUFR
C     MESSAGES SHOULD BE SKIPPED OVER (WITHOUT DECODING REPORTS) IF
C     TRUE} (DEFAULT=.FALSE.), THIS IS PASSED INTO IW3UNPBF AS BEFORE,
C     BUT SECOND DIMENSION CHANGED FROM 1:200 TO 0:200 TO ACCOUNT FOR
C     REPORTS WITH BUFR SUBTYPE 000 (CURRENTLY ONLY WMO RES. 40
C     SYNOPS)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF GPS-IPW DATA, READ
C     FROM "GPSIPW" DUMP FILE DUMP R. TYPE 74, GET PREPBUFR R. TYPE
C     153, PROCESSED BY NEW SUBR. "GETGPSIPW" INTO PREPBUFR FILE UNDER
C     NEW TBL A ENTRY "GPSIPW" {NEW NAMELIST SWITCH JPGPSD (PROCESS/
C     DON'T PROCESS)}; ADDED PROCESSING OF NPN OR CAP RASS DATA READ
C     FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R. TYPE 77,
C     GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE UNDER NEW
C     TBL A ENTRY "RASSDA" {NEW NAMELIST SWITCHES TWINDO (TIME WINDOW
C     ABOUT CYCLE TIME FOR ACCEPTING)} & RASS (PROCESS/DON'T PROCESS);
C     ADDED PROCESSING OF EAMDAR ACFT RPTS NOW POSSIBLY INCL. IN
C     "AIRCFT" DUMP FILE DUMP R. TYPE 41, SUBTYPE 6, INCL. WITH
C     EXISTING PREPBUFR R. TYPES 131/231, PROCESSED INTO PREPBUFR FILE
C     UNDER EXISTING TBL A ENTRY "AIRCFT"; ADDED PROCESSING OF CAP AND
C     JAPANESE WIND PROFILERS NOW POSSIBLY INCL. IN "PROFLR" DUMP FILE
C     DUMP R. TYPES 75 AND 76, RESP., GETS PREPBUFR R. TYPES 227 AND
C     228, RESP., PROCESSED INTO PREPBUFR FILE UNDER EXISTING TBL A
C     ENTRY "PROFLR", WIND PROFILER RPTS ORIGINATING FROM PILOT (PIBAL)
C     BULLETINS NOW GET A UNIQUE PREPBUFR R. TYPE OF 229 {NAMELIST
C     SWITCHES PROFIL (PROCESS/DON'T PROCESS) CHANGED TO PRFLER AND
C     NWINDO (EARLIEST/LATEST TIME RELATIVE TO CYCLE TIME FOR
C     ACCEPTING) REPL. WITH PWINDO (TIME WINDOW ABOUT CYCLE TIME FOR
C     ACCEPTING)}; FOR VAD WINDS NAMELIST SWITCH VADWND CHANGED TO
C     VADWIN (PROCESS/DON'T PROCESS) AND NAMELIST SWITCH MWINDO
C     (EARLIEST/LATEST TIME RELATIVE TO CYCLE TIME FOR ACCEPTING) REPL.
C     WITH VWINDO (TIME WINDOW ABOUT CYCLE TIME FOR ACCEPTING); ADDED
C     PROCESSING OF MESONET DATA, READ FROM "MSONET" DUMP FILE DUMP R.
C     TYPE 540, GET PREPBUFR R. TYPE 188/288, PROCESSED INTO PREPBUFR
C     FILE UNDER NEW TBL A ENTRY "MSONET" {INCL, ENCODING OF ID STRINGS
C     FOR PROVIDER (MNEMONIC "PRVSTG") AND SUB-PROVIDER (MNEMONIC
C     "SPRVSTG")}, THESE CAN HAVE AN ELEVATION Q.M. - IF IT'S POOR SET
C     PSTN AND PMSL (IF PRESENT) Q.M. TO 15 (BAD), IF IT'S FAIR SET
C     PSTN AND PMSL (IF PRESENT) Q.M. TO 3 (SUSPECT); EXPANDED NAMELIST
C     SWITCHES FWINDO, JSURFM AND JSURFW FROM 9-WORDS TO 11-WORDS TO
C     ADD MESONET IN WORD 9 AND MOBILE SYNOPTIC LAND IN WORD 10; IF
C     MESONET REPORT HAS A MISSING PSTN (PMSL ALWAYS MISSING) BUT A
C     VALID ALTIMETER SETTING, GENERATE PSTN FROM OBSERVED ALTIMETER
C     AND ELEV. (CHAR. 8 OF STNID IS SET TO 'a' TO IDENTIFY THESE); IF
C     MESONET REPORT HAS A MISSING PSTN (PMSL ALWAYS MISSING) AND A
C     MISSING ALTIMETER SETTING, GENERATE PSTN FROM STD. ATMOS. PMSL,
C     OBSERVED TEMP. AND ELEV. (CHAR. 8 OF STNID IS SET TO 'x' TO
C     IDENTIFY THESE); ADDED PROCESSING OF MOBILE SFC SYNOPTIC LAND
C     RPTS NOW POSSIBLY INCL. IN "ADPSFC" DUMP FILE DUMP R. TYPE 514,
C     INCL. WITH EXISTING PREPBUFR R. TYPES 181/183/281/284, PROCESSED
C     INTO PREPBUFR FILE UNDER EXISTING TBL A ENTRY "ADPSFC";
C     INITIALIZES INSTRUMENT TYPE AS MISSING INSTEAD OF "99"; NOW
C     PRINTS "*" (FORMAT OVERFLOW) FOR MISSING QUALITY MARKS (BEFORE
C     SET THEM TO "15"); CORRECTED BUG IN QUIKSCAT PROCESSING WHICH
C     WOULD HAVE STORED ALONG-TRACK ROW NUMBER INTO INSTRUMENT TYPE
C     LOCATION (NOW STORES MISSING); NOW ENCODES MDCRS FLIGHT NUMBER
C     (MNEMONIC "ACID") INTO MDCRS REPORTS; REPLACED CALL TO BUFRLIB
C     ROUTINE "BORT" WITH CALL TO W3LIB ROUTINE ERREXIT, WITH CONDITION
C     CODE 59 IF THERE ARE MORE THAN "MXBLVL" LEVELS IN A REPORT AT THE
C     TIME IT IS ABOUT TO BE ENCODED INTO THE PREPBUFR FILE; ARRAY
C     SUBSKP BUMPED UP FROM (0:12,0:200) TO (0:255,0:200); ADDED NEW
C     IRNMRK VALUE 8 FOR HOURLY (GOES CLOUD DATA) RUNS; RAIN RATE
C     (SSM/I) IS NOW ENCODED WITH STANDARD MNEMONIC REQV INSTEAD OF
C     LOCAL MNEMONIC REQ6 (STILL HIGH PRECISION, BUFRTABLE HAS OPERATOR
C     DESCRIPTORS); ADDED LOGIC IN SUBR. W3FIZZ (CURRENTLY NOT INVOKED)
C     TO SEPARATE METAR REPORTS INTO THEIR OWN MESSAGES IN THE ADPSFC
C     MESSAGE TYPE, BUT WITH A UNIQUE MESSAGE SUB-TYPE OF 7 (SEE
C     COMMENTS IN SUBROUTINE); ADDED PROCESSING OF NASA/MODIS POES AQUA/
C     TERRA SATELLITE-DERIVED WINDS, NOW POSSIBLY INCL. IN "SATWND" DUMP
C     FILE EXISTING DUMP R. TYPE 63, GET PREPBUFR R. TYPES 257 (IR), 258
C     (W.VAPOR IMGR CLOUD-TOP) AND 259 (W.WAPOR IMGR DEEP LAYER),
C     PROCESSED INTO PREPBUFR FILE UNDER EXISTING TBL A ENTRY "SATWND";
C     NOW RETURNS 41-WORD (RATHER THAN 2-WORD) ARRAY "OBS2" OUT OF CALL
C     TO IW3UNPBF, WHERE WORDS 3-41 CONTAIN ALTIMETER SETTING (WHICH HAD
C     BEEN RETURNED IN CAT. 8, C.F. 20, NOW ONLY ALTIMETER TBL. VAL.
C     RETURNED FROM HERE), SEA-SURFACE TEMPERATURE, SINGLE-LEVEL
C     SENSIBLE WEATHER ELEMENTS AND SST TABLE VALUE (Q.M.); RETURNS NEW
C     ARRAY ARGUMENTS "OBS3" {(5,MXBLVL,5)} AND "NOBS3" {(5)} OUT OF
C     CALL TO IW3UNPBF WHERE OBS3 CONTAINS MULTIPLE-LEVEL SENSIBLE
C     WEATHER ELEMENTS AND NOBS3 DEFINES THE NUMBER OF LEVELS OF DATA IN
C     THE OBS3(X,Y,1) TO OBS3(X,Y,5) ARRAYS (SEE IW3UNPBF DOCBLOCK FOR
C     MORE INFO); ALL NEW PARAMETERS (I.E., SST AND SENSIBLE WEATHER
C     ELEMENTS) IN OBS2 AND OBS3 ARE ENCODED INTO PREPBUFR FILE, BUT
C     ONLY IN THE MASS "PIECE" OF A REPORT (UNLESS THERE IS NO MASS
C     PIECE, THEN THEY ARE ENCODED INTO WIND PIECE; WILL NOW CALC. Q AND
C     Tv IN STOROB IF PQM IS 15 (BUTS SETS QQM TO 15) (E.G., FOR DROPs
C     WITH PRESS FAILING D-VAL, BEFORE Q MISSING BUT LATER CALC. IN
C     VIRTMP STEP)
C 2005-07-01  D. A. KEYSER -- NOW STORES A VALUE 2 INTO REPORT SUBTYPE
C     FOR DROPWINSONDE REPORTS AND A VALUE OF 1 INTO REPORT SUBTYPE FOR
C     RECCO REPORTS, THIS GETS ENCODED INTO PREPBUFR UNDER MNEMONIC
C     "TSB" AND ALLOWS DROPS AND RECCOS TO BE DIFFERENTIATED IN
C     PREPBUFR SINCE BOTH HAVE SAME PREPBUFR REPORT TYPE (132/232) AND
C     INPUT/DUMP REPORT TYPE (031)
C 2006-07-14  D. A. KEYSER -- NO LONGER FAILS IF LIMIT OF "MXBLVL"
C     OUTPUT LEVELS IN PREPBUFR REPORT IS HIT, NOW PROCESSES BOTTOM
C     "MXBLVL" LEVELS AND SENDS DIAGNOSTIC TO JOBLOG; BUMP UP ARRAY
C     SIZE FOR UNPACKED REPORT FROM IW3UNPBF FROM 2500 TO 3000; ADDED
C     IRNMRK=9 FOR REAL TIME MESOSCALE ANALYSIS (RTMA) NETWORK
C 2006-08-17  D. A. KEYSER -- MODIFIED THE FUNCTION WHICH CALC. PSTN
C     FROM ALTIMETER SETTING BASED ON REQUEST BY JOHN DERBER; EXPANDED
C     DEGREE OF DIAG. PRINT IN BALLOON DRIFT CALC. IF IPRT(2)=1; MOVED
C     BALLOON DRIFT PROCESSING OUT OF SUBR. STOROB (TWO PLACES - IN
C     MASS AND WIND PROC.) INTO NEW SUBR. BALLOON_DRIFT; CORRECTED
C     LOGIC ERRORS IN BALLOON DRIFT PROCESSING WHICH HAD RESULTED IN
C     OCASSIONAL ARRAY OVERFLOWS AND LEVEL INDEXING MIS-MATCHES (AMONG
C     OTHER THINGS RESULTED IN SUDDEN JUMP IN THE DRIFT TIME BETWEEN
C     ADJACENT LEVELS > 3 HOURS!), WILL NOW CONTINUE TO CALC. DRIFT
C     TIME AND LAT/LON IF A SMALL (< 5 SEC) NEGATIVE TIME DIFF. IS
C     FOUND BETWEEN ADJACENT LEVELS (USED TO REVERT TO LAST "GOOD"
C     LEVEL ALL THE WAY UP THE PROFILE); NOW PRINTS WARNING AND SENDS
C     DIAGNOSTIC TO JOBLOG IF SUBR. STOROB FINDS NUMBER OF PROCESSED
C     MASS AND WIND LEVELS SENT TO SUBR. FILLX ARE NOT THE SAME (SHOULD
C     ALWAYS BE THE SAME!); WIND QM SET TO 15 IN SUBR. STOROB IF A
C     REPORTED WIND IS FOUND ON A LEVEL WHICH IS BELOW GROUND
C 2006-11-29  D. A. KEYSER -- MODIFIED EUMETSAT PROCESSING TO CONSIDER
C     "ODD" AND "EVEN" SATELLITES SEPARATELY FOR PROCESS/NO-PROCESS/
C     FLAG ALL/FLAG EVERY-OTHER (N-LIST SWITCHES "JSMASS"/"JSWIND"),
C     TIME WINDOW ("SWINDO_e"/"SWINDO_l"), LAND/NO-LAND ("SWNLND"), ALL
C     BY LAT BAND AND PRODUCT TYPE
C 2007-09-14  D. A. KEYSER -- MODIFIED TO RECOGNIZE HIGH-DENSITY JMA
C     SATELLITE WINDS DERIVED FROM BUFR BULLETINS IN NC005044-NC005046
C     WHICH MAY NOW BE IN INPUT "satwnd" DUMP FILE IN PLACE OF LOW-
C     DENSITY JMA WINDS DERIVED FROM SATOB BULLETINS IN NC005041-
C     NC005043 (EITHER BUFR OR SATOB WILL BE PROCESSED); ACCOUNTS FOR
C     HIGH-DENSITY JMA SATELLITE WINDS DERIVED FROM BUFR BULLETINS IN
C     NC005044-NC005046 CONTAINING RFF QUALITY INDICATOR, THE Q.C.
C     TESTS FOR RFF ARE LIMITED ONLY TO THE NESDIS GOES AND NASA/POES
C     SATWINDS AT THIS TIME; MODIFIED TO PROCESS TAMDAR AND CANADIAN
C     AMDAR AIRCRAFT REPORTS (FORMER GET PREPBUFR REPORT TYPE 134/234
C     AND ENCODES NEW PARAMETERS "TRBX" AND "ROLF" INTO PREPBUFR FILE;
C     LATTER GET PREPBUFR REPORT TYPE 135/235); IF AIFNOW=FALSE, NOW
C     FLAGS ALL ACFT REPORTS AS BAD IF WIND IS MISSING BUT TEMP IS
C     PRESENT (USED TO FLAG ONLY MDCRS HERE AND TOSS ALL OTHER TYPES DUE
C     TO CONCERN ABOUT PREPACQC), POINT IS MOOT BECAUSE AIFNOW NOW SET
C     TO TRUE TO PROCESS ALL ACFT TYPE TEMP REPORTS WHEN WIND DATA ARE
C     MISSING; NOW FLAGS ALL ACFT REPORTS BELOW "FLOOR" LEVEL (USED TO
C     FLAG ONLY MDCRS MDCRS HERE AND TOSS ALL OTHER TYPES DUE TO CONCERN
C     ABOUT PREPACQC); REPLACED CALL TO BUFRLIB ROUTINE OVRBS1 WITH CALL
C     TO BUFRLIB ROUTINE PKBS1 (OVRBS1 OBSOLETE WITH 1/31/2006 VERSION
C     OF BUFRLIB) (THIS IS CURRENTLY NEVER CALLED IN PREPDATA);
C     INCREASED SIZE OF COMMON BLOCK /BITBUF/ ARRAYS IBAY AND MBAY FROM
C     (5000) AND (5000,32) TO (12500) AND (12500,32), RESP. TO MATCH
C     SIZES IN THIS COMMON BLOCK IN 1/31/2006 VERSION OF BUFRLIB;
C     REDEFINES MANY BUFR TABLE DESCRIPTORS FOR TABLE A/D ENTRIES TO
C     AVOID TABLE A/D CONFLICTS WITH OTHER BUFR TABLES; MODIFIED TO
C     PROCESS WINDSAT SCATTEROMETER REPORTS, READ FROM NEW "WDSATR" DUMP
C     FILE (GETS PREPBUFR REPORT TYPE 289 AND ENCODES NEW PARAMETERS
C     MRWVC, MRLWC, WSST, MWD10, MWS10, WSEQC1, CHSQ, PHER, SPDE, SSTE,
C     CLDE AND VPRE IN PREPBUFR FILE UNDER NEW MESSAGE TYPE "WDSATR);
C     NOW HANDLES SATWINDS FROM NEW INDIAN KALPANA SATELLITE (REPORTS
C     HAVE SUFFIX CHARACTER "K" IN STATION ID); MODIFIED TO HANDLE
C     RETURN OF NEW ARGUMENT "RDATA2" FROM CALLS TO W3UNPKB7 [1-DIM 21-
C     WORD ARRAY WHICH HOLDS ADDITIONAL VALUES DECODED DIRECTLY FROM
C     BUFR (AND NOT IN "RDATA" ARRAY), FOR SOME PARAMETERS REPLACING
C     WHAT HAD BEEN RETURNED IN "RDATA" ARRAY (IN THE HEADER)]; BUMP UP
C     ARRAY SIZE FOR UNPACKED REPORT FROM IW3UNPBF FROM 3000 TO 3500;
C     ACCOUNTS FOR EUMETSAT MSG (METEOSAT-8 AND UP) SATWINDS CONTAINING
C     RFF QUALITY INDICATOR; ADDED READING IN, LISTING AND ENCODING OF
C     PERCENT CONFIDENCE BASED ON - EUMETSAT QUALITY INDEX WITH FORECAST
C     CONSISTENCY TEST (READ FROM CAT. 8 CODE TABLE 356, ENCODED USING
C     MNEMONIC "QIFY"), EUMETSAT QUALITY INDEX WITHOUT FORECAST
C     CONSISTENCY TEST (READ FROM CAT. 8 CODE TABLE 357, ENCODED USING
C     MNEMONIC "QIFN") AND NESDIS EXPECTED ERROR (READ FROM CAT. 8 CODE
C     TABLE 358, ENCODED USING MNEMONIC "EEQF") FOR SATWND TYPES; FIXED
C     BUG WHICH STORED BALLOON DRIFT COORDINATES FROM PREVIOUS RAOB/
C     PIBAL REPORT INTO DROPWINSONDE REPORT (DROPS SHOULD HAVE MISSING
C     BALLOON DRIFT COORDINATES); CASES WHERE OBS ARE SET TO QM=15 IN
C     ORDER TO FLAG A REPORT FOR NON-USE BY ANALYSIS (EVEN THOUGH OBS
C     MAY NOT NECESSARILY BE BAD) NOW FIRST CHECK TO MAKE SURE OBS QM
C     ISN'T ALREADY "BAD" (> 3 AND < 15) (PREVENTS GSI FROM MONITORING
C     TRULY BAD OBS WHICH JUST HAPPEN TO BE IN REPORT GROUPS FLAGGED
C     FOR NON-USE BY ANALYSIS); CHANGED PROCESSING OF DROPSONDE
C     MOISTURE: ACFT USING SWITCH "FLDMGS" (ALL NOAA, INCL. P-3 AND
C     GULF STREAM) MORE PRECISELY DEFINED TO ENSURE THAT ONLY NOAA ACFT
C     ARE AFFECTED BY THIS SWITCH, SWITCH "FLDMAF" NOW REFERS
C     EXCLUSIVELY TO USAF ACFT (HAD REFERRED TO ALL NON-NOAA ACFT), NEW
C     SWITCH "FLDMFR" REFERS TO NON-US (NON-NOAA AND NON-USAF) ACFT
C     (DEFAULTS TO TRUE - FLAG MOISTURE DATA ON ALL LEVELS); EXPANDED
C     ARRAYS OBS3 FROM (5,255,5) TO (5,255,7) AND NOBS3 FROM (5) TO (7)
C     (RETURNED OUT OF CALL TO IW3UNPBF) TO ACCOUNT FOR PROCESSING OF
C     ADDITIONAL MULTIPLE-LEVEL SENSIBLE WEATHER ELEMENTS CONTAINING
C     AIRFRAME ICING (RECCOS, PIREPS, EAMDAR, CANADIAN AMDAR, TAMDAR),
C     ENCODED INTO PREPBUFR FILE IN NEW MNEMONICS "AFIC", "HBOI" AND
C     "HTOI" (TYPE OF ICING, HEIGHT OF BOTTOM AND TOP OF ICING LAYER),
C     AND DEGREE OF TURBULENCE (RECCOS AND ALL AIRCRAFT), ENCODED INTO
C     PREPBUFR FILE IN EXISTING MNEMONIC "DGOT" (DEGREE OF TURBULENCE)
C     AND NEW MNEMONICS "HBOT" AND "HTOT" (HEIGHT OF BOTTOM AND TOP OF
C     TURBULENCE LAYER), THE EXPANDED TURBULENCE INFORMATION REPLACES
C     THE SINGLE DEGREE OF TURBULENCE VALUE WHICH HAD BEEN RETURNED
C     FROM IW3UNPBF IN CAT. 8, CODE FIGURE 916; ADDED NEW N-LIST SWITCH
C     WRMISS (DEF=T) - IF TRUE, REPORTS WITH NO VALID OBS (WIND/TEMP)
C     LEVELS AND NO VALID BRIT. TEMP. CHANNELS, BUT WITH OTHER
C     ANCILLARY INFO (E.G., SENSIBLE WX ELEMENTS) ARE NOW ENCODED INTO
C     PREPBUFR FILE - CURRENTLY APPLIES ONLY TO AIRCRAFT REPORTS
C     (MAINLY PIREPS WITH TURB, ICING, CLOUD BUT NO TEMP OR WIND) -
C     BEFORE SUCH OBS WITHOUT ANY DATA USED BY ASSIMILATION WERE ALWAYS
C     SKIPPED; CAN NOW HANDLE GOES 1x1 SOUNDINGS/PW/RADIANCES IN
C     MESSAGE TYPE "NC003003"; GOES SOUNDINGS/PW/RADIANCES ONLY
C     PROCESSED IF MESSAGE TYPE IS "NC003001" (5x5) OR "NC003003" (1x1),
C     GOES CLOUD-TOP RETR ONLY PROCESSED IF MESSAGE TYPE IS "NC003002"
C     (NEEDED WHEN 1x1 SNDGS ARE STORED WITH CLOUD IN GOESND DUMP SINCE
C     FORMER ALSO CONTAIN CLOUD INFO WHICH WE DO NOT WANT TO PROCESS);
C     ADDED NAMELIST SWITCH "SKGP45", WHEN TRUE (DEFAULT) SKIPS ALL
C     GPS-IPW REPORTS WITH REPORT TIME MINUTES GREATER THAN 30 (xx:45
C     REPORTS CONSIDERED TO BE OF POORER QUALITY THAN xx:15 REPORTS);
C     ACCOUNTS FOR INCREASE IN PRECISION FOR "DHR" AND "RPT" FROM 10**3
C     TO 10**5 (HOURS)
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); INTERFACE ROUTINES WITH ATOVS SOUNDINGS
C     (W3ATOVSUNP AND W3XTOVSEDS CAN NOW HANDLE METOP-2 SATELLITE (CDAS
C     ONLY)
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 -- CAN NOW PROCESS ASCAT SCATTEROMETER
C     WIND DATA READING FROM REPROCESSED DUMP FILE IN UNIT 39, ENCODING
C     INTO NEW PREPBUFR REPORT TYPE 290 UNDER NEW PREPBUFR MESSAGE TYPE
C     "ASCATW" VIA NEW NAMELIST SWITCHES "JPASCD" (DEF=6*9999) AND
C     IAWNDO (DEF=-3,+3) (1-DIM ARRAY RDATA2 RETURNED FROM W3UNPKB7
C     INCREASED FROM 21 TO 24 WORDS TO HANDLE NEW ANCILLARY INFO
C     ENCODED WITH ASCAT REPORTS); CHANGES TO PREPBUFR ENCODING IN
C     PREPARATION FOR FUTURE DOWNSTREAM NRL AIRCRAFT Q.C. MODULE
C     (REPLACING CURRENT DOWNSTREAM PREPACQC AND ACARSQC MODULES) WHICH
C     WILL REPLICATE LEVEL DATA IN ITS GENERATION OF "PROFILES": SOME
C     MNEMONICS THAT WERE IN HEADER MOVED TO LEVEL INFO, CALL TO
C     BUFRLIB ROUTINE DRFINI TO ALLOW FOR POSSIBLE NESTED REPLICATION
C     OF LEVEL INFO SEQUENCES; 1-DIM ARRAY OBS2 RETURNED FROM IW3UNPBF
C     INCREASED FROM 41 TO 42 WORDS TO HOLD MOISTURE QUALITY (CODE
C     TABLE) FOR MDCRS REPORTS, ENCODED INTO PREPBUFR FILE (MNEMONIC
C     MSTQ) FOR USE BY FUTURE DOWNSTREAM NRL AIRCRAFT Q.C. MODULE;
C     UPPER LIMIT FOR STORING Q CHANGED FROM 32767 MG/KG TO 99999 MG/KG
C     TO ENSURE THAT LEVELS WITH VERY HIGH SPECIFIC HUMIDITY ARE
C     PROCESSED (THE 32767 LIMIT WAS A VESTIGE FROM THE OLD I*2 PREPDA
C     DAYS); IF NEAREST INTEGER FOR Q IS 0 MG/KG, IT IS RESET TO
C     1 MG/KG (.001 G/KG) TO ENSURE THAT LEVELS WITH VERY LOW SPECIFIC
C     HUMIDITY ARE PROCESSED (Q MUST BE > 0 TO BE PROCESSED)
C 2010-06-07  D. A. KEYSER -- NOW CHECKS FOR ALTIMETER Q.M. IN CODE
C     FIG. 20 OF CAT. 8 FOR METARS (AS WELL AS FOR MESONETS AS BEFORE)
C     SINCE IW3UNPBF IS ALSO MODIFIED HERE TO STORE THIS FOR METARS
C     (BUT ONLY IF Q.M. VALUE IS 12-REJECT or 14-PURGE); CORRECTED BUG
C     IN SUBR. SFCDTA WHICH WAS NOT PROPERLY INTERPRETING ALTIMETER
C     Q.M. IN CODE FIG. 20 OF CAT. 8 FOR MESONETS (MANY MESONET PRESS.
C     Q.M.'S WERE SET TO 2 OR 15 WHEN THEY SHOULD HAVE BEEN SET TO 3 OR
C     13, RESP.) (NOTE THAT MESONETS TO NOT REPORT PRESS. SO ALTIMETER
C     SETTING IS USED TO CALCULATE PRESS. AND THE ALTIMETER Q.M. IS
C     TRANSFERRED TO PRESS.)
C 2011-10-14  D. A. KEYSER -- RAP (RAPID REFRESH) NETWORK REPLACES
C     RUC2A (RAPID UPDATE CYCLE) IN NCEP MODEL RUN MARKER (IRNMRK) 4
C 2012-11-27  D. A. KEYSER -- INCREASED MAXIMUM POSSIBLE VALUE FOR SQN
C     (SEQUENCE NUMBER) ENCODED INTO PREPBUFR FILE FROM 99998 TO 524286
C     (NEEDED BECAUSE THERE CAN NOW BE > 99998 MDCRS REPORTS IN A
C     MONOLITHIC "AIRCAR" DUMP FILE - THIS CAUSES PREPACQC TO FAIL IN
C     SERIAL PREPBUFR PROCESSING RUNS, E.G. IN SDMEDIT)
C 2012-11-30  J. WOOLLEN  INITIAL PORT TO WCOSS; ADDED CALL TO BUFRLIB
C     ROUTINE SETBMISS(10E08_8) TO RESET BMISS TO A VALUE (10E08_8)
C     WHICH WILL NOT CAUSE INTEGER OVERFLOW WHICH CAN BE UNPREDICTABLE
C     (PRIOR BMISS VALUE WAS 10E10_8)
C 2013-02-14  D. A. KEYSER -- FINAL CHANGES TO RUN ON WCOSS: PASS BMISS
C     VIA COMMON BLOCK RATHER THAN HARDWIRING IT TO 10E08_8 IN MANY
C     DIFFERENT SUBROUTINES;  USE FORMATTED PRINT STATEMENTS WHERE
C     PREVIOUSLY UNFORMATTED PRINT WAS USED (WCOSS SPLITS UNFORMATTED
C     PRINT AT 80 CHARACTERS); IN SUBR. LNDCHK, FIXED BUG IN S.H.
C     KXI/KYJ CALCULATION WHICH LED TO ALL S.H. REPORTS NEVER HAVING
C     "ICHK" SATISFIED, MEANING ILAND WAS ALWAYS RETURNED AS 0 (E.G.,
C     FOR LAND/SEA CHECK, ALL S.H. REPORTS WERE DEEMED OVER WATER
C     REGARDLESS OF THEIR LOCATION), THIS ALSO CAUSED AN ARRAY OVERFLOW
C     SINCE KYJ COULD BE CALCULATED AS 38, 1 GREATER THAN THE LIMIT; IN
C     SUBR. LNDCHK  FIXED S.H. BUGS WHICH CAUSED AN OVERFLOW IN KXI FOR
C     ELON > 359.98 AND AN OVERFLOW IN KYJ FOR LAT > -0.01
C 2014-04-25  D. A. Keyser --
C          - For all satellite-derived wind reports, now encodes
C     PREPBUFR report sub-type (mnemonic "TSB", previously missing) as
C     BUFR satellite id times 10 plus "Satellite Derived Wind
C     Computation Method ("SWCM" - BUFR code table 0-02-023), allows
C     GSI to identify cloud-top vs. deep-layer WV winds and IR vs.
C     visible winds for METEOSAT and JMA since, unlike NESDIS, both
C     have same report types (250-JMA & 254-EUMETSAT for WV, 242/252-
C     JMA & 243/253-EUMETSAT for IR/VIS).
C          - 1-dim array OBS2 returned from IW3UNPBF increased from 42
C     to 43 words to hold satellite zenith angle (degrees, for all
C     SATWND types), encoded into PREPBUFR file (mnemonic SAZA) for use
C     by GSI (to possibly screen SATWNDS with high SAZA values).
C          -  Added IRNMRK=10 for UnRestricted Mesoscale Analysis (URMA)
C     network.
C          - No longer aborts with RC=99 if number of levels in a
C     report exceeds the limit of "MXLVL".  Instead, now skips the
C     offending report(s) and, at the very end, posts a message to the
C     JOBLOG file noting how many reports were skipped due to this
C     issue.
C 2014-04-25  S. Melchior  --
C          - Added processing of Coast Guard tide gauge data (read from
C     SFCSHP dump, dump report type 534). A 12'th word added to
C     following namelist switches to account for these new reports:
C     FWINDO, JSURFM, JSURFW.
C          - Added new namelist switch NPKRPT, if TRUE all of the below
C     occurs: will process reports that would otherwise be tossed due
C     to their having a missing pstn; these reports estimate pstn from
C     the reported or U.S. std. atmosphere pmsl, the reported or U.S.
C     std. atmosphere sensible temperature, and the reported elevation
C     (only marine reports > 7.5 m can have a reported pmsl and fall
C     into this category); this estimated pstn (POB) is used to
C     estimate q (QOB); both POB and QOB are assigned minimum q.m.'s
C     (PQM, QQM) of 3; estimated POB is encoded into PREPBUFR file;
C     these reports are then assigned new PREPBUFR report types 192/292
C     (SYNOP), 193/293 (METAR), 194/294 (marine), 195/295 (mesonet);
C     ATLAS buoy wind reports which also have missing pstn and pmsl
C     will continue to be processed as before (PREPBUFR report type 282
C     - note: this means that if an ATLAS buoy ever had T,q info, its
C     mass piece would still be tossed rather than getting into
C     PREPBUFR file under report type 194 (may need to fix this logic
C     someday); MESONETS will no longer have "x" in character 8 of id,
C     instead they will get PREPBUFR report types 195/295 rather than
C     188/288.
C          - Subroutine SFCDTA modified to trap reports whose wind
C     information exceeds the 32767 limit.  If the limit is exceeded,
C     the entire report will skip being encoded into the output
C     PREPBUFR file.
C          - Modified to always encode wind speed obs in m/sec ("SOB")
C     and wind direction obs ("DDO") for all types of surface reports
C     (even if one or the other are missing but also if both are
C     present); removed old logic which encoded "SOB" only for METAR
C     reports when direction was missing and speed was .LE. 3 m/sec
C     (direction was never encoded in any situation for surface
C     reports), also removed encoding of "SQM" (wind speed quality
C     mark) for these types of METAR reports - all surface reports now
C     encode wind qm as "WQM" regardless of whether or not it also
C     encodes direction, speed, u-comp or v-comp {note this change does
C     not affect non-surface reports which can still encode speed
C     in knots ("FFO") and direction ("DDO") when "UOB" and "VOB" are
C     also encoded.
C          - Added new mnemonic "PMIN" (mean sea-level pressure
C     indicator) which is encoded with a value of zero for all surface
C     reports with an observed mean sea-level pressure encoded in
C     "PMO".  "PMIN" will be encoded with a value of 1 in w3emc routine
C     GBLEVENTS for cases where a mean sea-level pressure is derived
C     (see docblock in GBLEVENTS for more information).
C          - Report type 183 now stores moisture quality mark no lower
C     than 3 (suspect) (before type 183 stored observed moisture
C     quality mark read from the ADPSFC dump file).
C 2014-04-25  Y. Ling      --
C          - Handles new VAD wind reports from Level 2 decoder.
C     Differentiates between these and existing Radar Coded Message
C     (RCM) VAD wind reports via use of report subtype (TSB=1 for RCM
C     and =2 for Level 2).  No conversion of winds from dir/speed to
C     u/v for VAD wind reports from Level 2 decoder since these are
C     already u/v and are stored in m/sec
C          - Increase the maximum number of levels that can be
C     processed from 300 to 600.  This allows runs that might include
C     interpolated levels (e.g., special AFOS graphics, IRNMRK=2) to
C     still work properly as more and more radiosonde levels become
C     available in the new RRS.
C 2014-07-10  D. A. Keyser --
C          - Added encoding of "DFQ" (wind dir/speed quality mark) for
C     all types that aleady encode "DDO" (wind dir) and either "FFO"
C     (wind speed kts) or "SOB" (wind speed m/s) {"DFQ" will now be
C     encoded with overall wind quality mark in both cases when "UOB"
C     and "VOB" are encoded (then "DFQ" same as "WQM") and cases when,
C     for surface reports, "UOB" and "VOB" are not encoded because
C     either dir or speed is missing}.  Prior to this, "DFQ" was always
C     missing and the overall wind quality mark was always encoded in
C     "WQM" even when, for surface reports, "UOB" and "VOB" were
C     missing but either wind dir or speed was not.  Now, the entire
C     "W__EVENT" sequence "[UOB VOB WQM WPC WRC]" is skipped for
C     surface reports when "UOB" and "VOB" are both missing.
C          - Added encoding of "DFP" (wind dir/speed program code) for
C     surface reports in both cases when "UOB" and "VOB" are encoded
C     (then "DFP" same as "WPC") and when "UOB" and "VOB" are not
C     encoded because either dir or speed is missing.  Prior to this,
C     "DFP" was always missing in this case.
C          - Added encoding of "DFR" (wind dir/speed reason code), if
C     it is non-missing, in both cases when "UOB" and "VOB" are encoded
C     (then "DFR" same as "WRC") and cases when, for surface reports,
C     "UOB" and "VOB" are not encoded because either dir or speed is
C     missing.  Prior to this, "DFR" was always missing in either case.
C 2014-07-10  S. Melchior  -- Added logic in subr. FIZZ01 to reset
C     longitude to 0.0 when it is very close to 360.0. This ensures
C     that array clobbering will not occur if a report (with high
C     precision native lat/lon) is right at Prime Meridian.
C 2014-11-25  D. A. Keyser -- Removed input argument "IDATE" (central
C     date) from call to subr. W3CNVXTOVS since year {IDATE(1)} is no
C     longer needed to obtain BUFR satellite ID.
C 2015-01-30  D. A. Keyser -- All references to IR satellite-derived
C     winds now expanded to refer to IR "long-wave" - this
C     differentiates them from IR "short-wave" winds which are now
C     produced from GOES but are not processed by this program. Skips
C     over the reading of reports in "satwnd" dump coming from tanks
C     NC005080 (AVHRR POES) and NC005090 (VIIRS POES) since these
C     cannot be processed by this program.
C 2015-03-09  D. A. Keyser -- In subr. UNPREPBF, accounts for new
C     output argument "CBULL" returned from IW3UNPBF for unpacked
C     reports (character*11 string containing WMO bulletin header and
C     originator - filled only for aircraft types right now).
C 2015-03-11  D. A. Keyser -- Fixed issues related to storage of SQN
C     (sequence number):
C         - Now initialized as 999990 instead of 99999.
C         - Corrected bug which was not encoding it properly for AIRCAR
C           type when SQN was > 99998.
C         - Now encoded as missing rather than 99999 for types which do
C           not store SQN.
C 2015-04-08  D. A. Keyser -- Encodes new, unique report subtype (TSB)
C     values into PREPBUFR file for AIRCAR types based on WMO bulletin
C     header/originator (1-U.S. MDCRS, 2-Mexican MDCRS, 3-ADS-C MDCRS,
C     99-default/unknown)
C 2015-04-10  D. A. Keyser -- Added new namelist switch TDMAX, defined
C     as the upper limit for acceptable dewpoint temperature obs (the
C     moisture on any level, for any report type, with dewpoint
C     temperature on that level > TDMAX will be flagged with QM=15 in
C     subr. FIZZ01 and encoded in the PREPBUFR file if it is not
C     already flagged as bad).
C 2015-04-16 JWhiting -- Fixed bug in GOES TOCC encoding in subr.
C     GOESDG; now populates CLTOP(1,2) with TOCC value directly from
C     RDATA2(25) passed from W3UNPKB7 (had looked for it in cat 8 c.f.
C     258 passed in from W3UNPKB7 in RDATA array but this was changed
C     long ago to hold cloud amount and not total cloud cover, and the
C     former is missing in GOES cloud reports). RDATA2 is expanded to
C     size 25 in W3UNPKB7 in order to store TOCC, and this is accounted
C     for here in prepdata.f.
C 2015-04-16  D. A. Keyser -- Updated land/sea check in subr. LNDCHK
C     for N.H. surface marine reports.  Now has option (under certain
C     conditions) to check 16 points around obs lat/lon location {4
C     inner points as before (which is still an option) plus also now
C     12 points in next, outer ring}.  If any one of the 16 points is
C     over water, the obs is deemed over water. On the mask boundary
C     (i.e., Prime Meridian or Equator), check reverts back to only
C     surrounding 4 points since 1 or more mask points are not stored
C     in outer 12 point ring in this case.  Several additional mask
C     points in key geographical locations known to be over water are
C     also converted from over land to over water (after being read
C     in). It is known that many valid N.H. marine ship and buoy
C     reports at the coastline are being flagged as over land (and not
C     used by the analysis) due to their imprecise lat/lon. This change
C     will allow these to now be used by the analysis, but it will
C     still flag reports with invalid lat or lon (when it results in
C     them being well inland).
C 2016-01-28 JWhiting -- Updated subr W3FIZZ to generate values for new
C     CEILING mnemonic. This new field is created from cloud base
C     (HOCB) content when available, for the lowest cloud layer that
C     has a cloud amount (CLAM) that is "either Broken (6-9 tenths sky
c     cover) or Overcast (10 tenths cover)", or is listed as fog
C     conditions (CLAM=9 or 10); Otherwise, CEILING is set to missing.
C     For clear conditions (less than broken and non-fog), the CEILING
C     is set to an "infinite" high value (arbitrarily chosen as 20000m).
C     Also, added a printout of the BUFRLIB version in use (though a
C     BVERS() subroutine call)
C 2016-08-15 JWhiting -- Updated to enable new GNSS/GPS-Met data feed
C     (message type NC012004 in dump file "gpsipw") with precip. water
C     & zenith total delay content:
C       Added new LDTA namelist switch SKGNSS (stored in existing common
C        block /GPSWCH/) to control the ability to toss new GNSS/GPS-Met
C        reports (i.e., those with subset NC012004) if they are NOT from
C        the U.S.-provider (ENI) {tosses when SKGNSS = T (default)};
C       In subr GETGPSIPW:
C         Set existing LDTA namelist switch SKGP45 to apply to reports
C          with subset NC012003 (old GSD-supplied GPS) only.
C         Added trap to toss reports w/ precipitable water value zero
C          regardless of GPS data stream (new or old).
C         Added logic to toss reports with subset NC012004 (new U.S.
C          ENI- and foreign GNSS-supplied GPS) if they are from a non-
C          ENI provider (i.e., characters 5-8 of report id not being
C          "GPSS") as GSI may not be able to handle these properly at
C          this time (controlled by SKGNSS).
C       In subr FIZZ01:
C         For all GPS data streams (i.e., NC012003-004), store zenith
C         total delay (m) and its error (m), along with hardwired
C         azimuth (0.0 deg) and elevation (90.0 deg) angles into holding
C         arrays for subsequent output.
C       In subr. W3FIZZ:
C         For all GPS data streams (i.e., NC012003-004), encode into
C         PREPBUFR file zenith total delay (when present) and its error,
C         represented by "atmospheric path delay in satellite signal"
C         (m) (mnemonic APDS) and "error in atmospheric path delay in
C         satellite signal" (m) (mnemonic APDE), resp., in association
C         with hardwired azimuth angle (mnemonic BEARAZ) of 0.0 (deg)
C         and hardwired elevation angle (mnemonic ELEV) of 90.0 (deg).
C 2016-08-15  D. A. Keyser -- In subr. FILLX, add zenith total delay and
C     its error to listings for GPS-IPW/ZTD reports in report type 153.
C 2016-09-01  D. A. Keyser -- New BUFRLIB routine NEMSPECS is
C     integrated into code.
C     BENEFIT: Facilitates easier handling of future precision
C              increases.
C 2016-09-05  S. Melchior --
C      - Processes two new aircraft data types in AIRCFT message type:
C        Korean AMDAR (BUFR) and Catch-all AMDAR (BUFR).  Either pre-
C        version 7 BUFR or new version 7 BUFR for Catch-All AMDAR,
C        MDCRS and E-AMDAR can be handled.
C          - The following arrays' dimensions were increased and
C            defaults adjusted: AWINDO, AIRLND, JAWIND, JAMASS, IACFTL,
C            IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC, KSKNOW,
C            INAC.
C        BENEFIT: Handles TAC to BUFR migration of AMDAR data and move
C                 to version 7 BUFR for those applicable aircraft
C                 types.
C      - Some diagnostic output print statements formatted to
C        accommodate increased precision now in latitude and longitude
C        (driven by new version 7 BUFR AMDAR data but also by hi-res lat
C        /lon found in reports in input dump files for other data
C        types).  These hi-res lat/lon values are now encoded into the
C        PREPBUFR files (via a change to fixed file
C        prepobs_prep.bufrtable).
C      - Fixed a bug which allowed an aircraft report "mass piece" to
C        be encoded into the PREPBUFR file in cases when everything was
C        missing other than the restriction indicators (mnemonics RSRD
C        and EXPRSRD).
C        BENEFIT: Prevents a failure downstream in PREPACQC.
C                 {Fortunately this has never occurred to date because
C                 AMDAR reports (only type restricted) have never had
C                 both a missing temperature and wind.}
C 2016-10-27  C. Hill --
C      - TAMDARB AIRCFT message type added to handle BUFR form of TAMDAR
C        reports.  Allows for older (pre-2011) and newer TAMDAR data to
C        be processed.  The array sizes of AWINDO, AIRLND, JAWIND,
C        JAMASS, IACFTL, IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC,
C        KSKNOW, and INAC were all increased to (6,9).
C 2016-11-25  D. A. Keyser --
C      - Changed nomenclature: ASDAR becomes AMDAR; E-ADAS becomes
C        EAMDAR; ACARS becomes MDCRS; TAMDAR from MADIS becomes TAMDARM;
C        TAMDAR from Panasonic/AirDAT (BUFR) becomes TAMDARB; CAN-AMDAR
C        becomes CAMDAR; KOR-AMDAR becomes KAMDAR.
C      - Reset default values for namelist switches AWINDO, JAWIND,
C        JAMASS, IACFTL and AIFNOW to more accurately reflect the values
C        read in from parm cards for most networks.
C      - Encodes instantaneous altitude rate (IALR) into PREPBUFR file
C        for TAMDARB reports in report type 134/234 (returned from c.f.
C        932 in call to IW3UNPBF).
C      - Flight number (returned from header reserve character word 2 in
C        call to IW3UNPBF) is now encoded into PREPBUFR file as ACID for
C        AMDARB reports (if non-missing).
C      - Corrected a bug in 2016-10-27 update: TAMDARB reports now get
C        proper report type 134/234 (were getting 131/231).
C      - Encode report subtype (TSB) of 1 for new Panasonic TAMDARB
C        reports (distinguishes them from legacy AirDAT TAMDAR BUFR
C        reports which had the default TSB value of 0).
C 2016-11-30  D. A. Keyser --
C      - Reads new output real, double-precision argument array OBS8_8
C        of length 2 in calls to IW3UNPBF and W3UNPKB7.  This returns
C        latitude and longitude for each report which is then carried
C        through code as R*8 variables ALAT_8 and ALON_8 before being
C        encoded into PREPBUFR file in mnemonics YOB (lat) and XOB
C        (lon) (and in lowest level drift lat/lon, YDR and XDR, resp.).
C        BENEFIT: Replaces lat/lon returned in RDATA(1:2) in calls to
C                 IW3UNPBF and W3UNPKB7 which are at machine precison,
C                 and HDR(2:3) carried through code also at machine
C                 precision (normally R*4). {RDATA(1:2) is still
C                 returned and will be used as input lat/lon only in
C                 rare event that OBS8_8(1:2) are missing.} Now that
C                 many reports in the dumps store lat/lon at 0.001 or
C                 even 0.00001 degree precision, and now that PREPBUFR
C                 encodes YOB/YDR and XOB/XDR at 0.00001 degree
C                 precision, this change will ensure that lat/lon is
C                 always accurate to 0.00001 degrees in PREPBUFR files.
C      - Additional diagnostic output print statements formatted to
C        accommodate increased precision in latitude and longitude.
C      - Replace machine length lat/lon {HDR(3), HDR(2)} with R*8 lat/
C        lon (ALAT_8, ALON_8) in some print statements.
C        BENEFIT: Values are now precise to 10**5 degrees (was not the
C                 case after 2016-09-05 change #2 above).
C 2017-01-11  C. Hill -- The default value for IACFTH(9) in BLOCK DATA
C        is changed from 3050 to 16500 meters to provide capability to
C        process the full vertical profile of TAMDARB reports (made
C        available by ARINC 01/17/2017).
C 2017-06-22 JWhiting - handles off hour (non-zero minute) cycles;
C         looks for optional 2nd line in input center (cycle) date file
C         specifying minutes (this could even be present as "00" for on-
C         hour cycles); new variable IDATMM in common/DATA/ to pass minutes
C         values; encode minutes value into section 1 of each output
C         BUFR message header if non-zero
C 2017-10-20  D. A. Keyser -- 
C      Changes in subroutine W3FIZZ:
C      - Added minutes to print statements invoked when a new message
C        type is opened in output PREPBUFR file or when no data is
C        written to PREPBUFR file (and a single ADPUPA message is
C        written just to store the date).
C        BENEFIT: Corrects a printout bug added in obsproc_prep.v5.0.0
C                 with the update to process 15 minute cycle RTMA_RU
C                 Rapid Update.
C      - Fixed a bug where minutes (if non-zero) were not encoded into
C        Section 1 of a newly opened BUFR message (via OPENMG) in some
C        logic that is currently not invoked.
C        BENEFIT: Ensures minutes will be encoded into Section 1 of
C                 messages if this logic is ever invoked.
C      Changes in subroutines PREP, UNPREPBF, GOESDG, GETSCATT, GETGPSIPW:
C      - Added minutes to every print statement that includes the
C        central dump time.  Central dump time minutes is obtained from
C        Section 1 of first (dummy) message of input dump file via call
C        to BUFRLIB routine IUPVS01. Fixed bug that did not test central
C        dump time minutes against center (cycle) PRPBUFR minutes in
C        date check (i.e., only YYYYMMDDHH were tested for a match).
C        BENEFIT: Until now, central dump time minutes was always zero.
C                 However, with the implementation of the new RTMA_RU,
C                 central dump time can now also have minutes = 15, 30
C                 or 45 (since the RTMA_RU runs 4 times per hour). This
C                 change allows the print statements to reflect this new
C                 center dump time format.  It also ensures that the
C                 dump vs. PREPBUFR center dates are correctly tested.
C      Change in subroutine GOESDG:
C      - Added minutes to print statement listing center (cycle) date in
C        PREPBUFR file.
C        BENEFIT: Accounts for possibility of center (cycle) date in
C                 PREPBUFR file not being zero with addition of new
C                 RTMA_RU where minutes here can be 15, 30 or 45.
C 2018-07-02  S.Melchior-- In function W3FIZZ, added call to UFBINT
C     routine to pull in HOVI (horizontal visibility) value for mesonet
C     message types (NC255).
C 2020-08-20  J. Dong --
C     - Added changes to handle new VAD wind data reported from other
C       countries (e.g. Europe, New Zealand) (NC002018) and Hong Kong
C       wind profiler data (NC002014). Future feature. 
C     - Added logic to differentiate between these and existing Radar
C       Coded Message (RCM) VAD wind reports via use of report subtype
C       (TSB=1 for RCM, =2 for Level 2 and =3 for other vadwnd). Future
C       feature.
C 2020-09-14  S. Melchior -- In subroutine PREP, added ability to
C       process new WMO BUFR sequence Meteosat AMV data from subsets:
C       005067, 005068, 005069.
C 2021-04-22  C. Hill / J. Woollen / J. Ator --
C       The BUFR library with dynamic memory allocation is invoked,
C       and the BUFR parameters MAXSS and MXMSGL are each increased to
C       600000 to accommodate the initial read of high-resolution
C       radiosonde/dropsonde data from the 'uprair' dump files.
C       ISETPRM calls are placed before the first BUFR library call,
C       to SETBMISS.
C 2022-05-15  I. Genkova -- In subroutine SATEDS, updated IDSAT(4) to 
C       IDSAT(8) to accomodate WCOSS2 compiler
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. 
C
C
C USAGE:
C   INPUT FILES:
C
C     UNIT 05  - STANDARD INPUT (DATA CARDS - SEE NAMELIST
C                DOCUMENTATION BELOW)
C
C              **  GROUP "AA" -- CENTER (CYCLE) DATE FILE **
C       (WHERE AA IS IUNIT(1) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT AA   - Line 1: CENTER (CYCLE) DATE IN THE FORM YYYYMMDDHH
C                 Line 2: (optional) CYCLE MINUTES (normally present
C                 only if cycle time is off-hr)
C
C                    **  GROUP "BB" -- BUFR TABLES  **
C       (WHERE BB IS IUNIT(2) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT BB   - FILE CONTAINING PREPBUFR MNEMONIC TABLES A/B/D
C     UNIT BB+1 - ** RESERVED FOR FUTURE USE **
C     UNIT BB+2 - ** RESERVED FOR FUTURE USE **
C
C                   **  GROUP "CC" -- FIXED FIELDS **
C       (WHERE CC IS IUNIT(3) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT CC   - SEQUENTIAL FILE HOLDING: N.H. 1 DEG. LAT/LON GRID
C                 LAND/SEA INDICATOR; S.H. 2.5 DEG. LAT/LON GRID
C                 LAND/SEA INDICATOR; N.H. U.S.-MAINLAND/CONUS YES/NO
C                 INDICATOR - 1 DEG. LAT/LON
C     UNIT CC+1 - ** RESERVED FOR FUTURE USE **
C
C        **  GROUP "DD" -- BACKGROUND FILES (FOR "GBLEVENTS") **
C       (WHERE DD IS IUNIT(4) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT DD   - FIRST SPECTRAL (GLOBAL) SIGMA FIRST GUESS FILE; IF
C                 HOUR IN CENTER DATE FOR PREPBUFR FILE IS A MULTIPLE
C                 OF 3 THEN THIS FILE IS VALID AT THE CENTER DATE OF
C                 THE PREPBUFR FILE, IF THE HOUR IN CENTER DATE FOR
C                 PREPBUFR FILE IS NOT A MULTIPLE OF 3 THEN THIS FILE
C                 IS VALID AT THE CLOSEST TIME PRIOR TO THE CENTER DATE
C                 OF THE PREPBUFR FILE THAT IS A MULTIPLE OF 3
C     UNIT DD+1 - SECOND SPECTRAL (GLOBAL) SIGMA FIRST GUESS FILE; IF
C                 HOUR IN CENTER DATE FOR PREPBUFR FILE IS A MULTIPLE
C                 OF 3 THEN THIS FILE IS EMPTY, IF THE HOUR IN CENTER
C                 DATE FOR PREPBUFR FILE IS NOT A MULTIPLE OF 3 THEN
C                 THIS FILE IS VALID AT THE CLOSEST TIME AFTER THE
C                 CENTER DATE OF THE PREPBUFR FILE THAT IS A MULTIPLE
C                 OF 3
C     UNIT DD+2 - OBSERVATION ERROR FILE
C
C            **  GROUP "EE" -- UPPER-AIR BUFR DATA DUMP FILES **
C       (WHERE EE IS IUNIT(5) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT EE   - 'ADPUPA' BUFR DATA DUMP FILE (RAOB/PIBAL/DROPS/RECCOS)
C     UNIT EE+1 - 'AIRCAR' BUFR DATA DUMP FILE (MDCRS AIRCRAFT)
C     UNIT EE+2 - 'AIRCFT' BUFR DATA DUMP FILE (ALL AIRCRAFT OTHER THAN
C                  MDCRS)
C     UNIT EE+3 - 'SATWND' BUFR DATA DUMP FILE (SATELLITE-DERIVED WINDS)
C     UNIT EE+4 - 'PROFLR' BUFR DATA DUMP FILE (WIND PROFILER)
C     UNIT EE+5 - 'VADWND' BUFR DATA DUMP FILE (NEXRAD VAD WINDS)
C     UNIT EE+6 - 'RASSDA' BUFR DATA DUMP FILE (RASS TEMPERATURES)
C     UNIT EE+7 - 'UPRAIR' BUFR DATA DUMP FILE (BUFR RAOB/PIBAL/DROPS)
C     UNIT EE+8 - ** RESERVED FOR FUTURE USE **
C     UNIT EE+9 - ** RESERVED FOR FUTURE USE **
C
C             **  GROUP "FF" -- SURFACE BUFR DATA DUMP FILES **
C       (WHERE FF IS IUNIT(6) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT FF   - 'ADPSFC' BUFR DATA DUMP FILE {SYNOPTIC (INCL. WMO RES.
C                  40)/METAR LAND SFC}
C     UNIT FF+1 - 'SFCSHP' BUFR DATA DUMP FILE (MARINE SURFACE)
C     UNIT FF+2 - 'SFCBOG' BUFR DATA DUMP FILE (MEAN SEA-LVL PRES BOGUS)
C     UNIT FF+3 - 'MSONET' BUFR DATA DUMP FILE (COOPERATIVE NETWORKS)
C     UNIT FF+4 - 'SPSSMI' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL SSM/I DATA DUMP - USUALLY CONTAINS TOTAL
C                 PRECIP. WATER, WIND SPEED AND MAYBE ALSO RAIN RATE)
C     UNIT FF+5 - 'ERS1DA' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL ERS SCATTEROMETER DATA DUMP - CONTAINS WIND
C                 INFORMATION)
C     UNIT FF+6 - 'QKSWND' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL QUIKSCAT SCATTEROMETER DATA DUMP - CONTAINS
C                 WIND INFORMATION)
C     UNIT FF+7 - 'WDSATR' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL WINDSAT SCATTEROMETER DATA DUMP - CONTAINS
C                 WIND, MOISTURE AND RAINRATE INFORMATION)
C     UNIT FF+8 - 'ASCATW' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL ASCAT SCATTEROMETER DATA DUMP - CONTAINS
C                 WIND INFORMATION)
C     UNIT FF+9 - ** RESERVED FOR FUTURE USE **
C
C   **  GROUP "GG" -- POLAR-ORBITING SATELLITE BUFR DATA DUMP FILES **
C       (WHERE GG IS IUNIT(7) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT GG   - RTOVS BUFR DATA FILE (SOUNDINGS/RETRIEVALS/RADIANCES)
C     UNIT GG+1 - ATOVS BUFR DATA FILE (SOUNDINGS/RETRIEVALS/RADIANCES)
C     UNIT GG+2 - ** RESERVED FOR FUTURE USE **
C     UNIT GG+3 - ** RESERVED FOR FUTURE USE **
C     UNIT GG+4 - ** RESERVED FOR FUTURE USE **
C
C                **  GROUP "HH" -- GOES BUFR DATA DUMP FILE **
C       (WHERE HH IS IUNIT(8) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT HH   - GOES BUFR DATA FILE (5x5 AND/OR 1x1 FOV SOUNDINGS/
C                 RETRIEVALS/RADIANCES)
C     UNIT HH+1 - ** RESERVED FOR FUTURE USE **
C
C      **  GROUP "II" -- OTHER SATELLITE BUFR DATA DUMP FILE **
C       (WHERE II IS IUNIT(9) IN NAMELIST "&PARM"  DESCRIPTION BELOW)
C     UNIT II   - 'GPSIPW' BUFR DUMP FILE (GPS INTEGRATED PRECIPITABLE
C                   WATER/ZENITH TOTAL DELAY)
C     UNIT II+1 - ** RESERVED FOR FUTURE USE **
C     UNIT II+2 - ** RESERVED FOR FUTURE USE **
C
C            **  GROUP "JJ" TO "OO" -- RESERVED FOR FUTURE USE  **
C       (WHERE JJ IS IUNIT(10) IN NAMELIST "&PARM"  DESCRIPTION BELOW;
C              KK IS IUNIT(11) IN NAMELIST "&PARM"  DESCRIPTION BELOW;
C              LL IS IUNIT(12) IN NAMELIST "&PARM"  DESCRIPTION BELOW;
C              MM IS IUNIT(13) IN NAMELIST "&PARM"  DESCRIPTION BELOW;
C              NN IS IUNIT(14) IN NAMELIST "&PARM"  DESCRIPTION BELOW;
C              OO IS IUNIT(15) IN NAMELIST "&PARM"  DESCRIPTION BELOW;
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C     UNIT PP  - PREPBUFR DATA SET
C              - (WHERE PP IS IUNIT(16) IN N-LIST "&PARM" DESCR. BELOW)
C     UNIT QQ  - "PREVENT" EVENTS DATA FILTERING SUMMARY PRINT FILE
C              - (WHERE QQ IS IUNIT(17) IN N-LIST "&PARM" DESCR. BELOW)
C
C   SUBPROGRAMS CALLED:
C     UNIQUE     - PREP       UNPREPBF   CHKREP     LL2IJ
C                  RPTLBL     TIMCHK     LNDCHK     GETUPA     UV
C                  SMERGE     SWNTBL     HSTATS     PSTATS
C                  WNDBYP     WNDBYZ     FILWND     FILDPT
C                  STOROB     BALLOON_DRIFT         FILLX      GETC06
C                  SATEDS     SNDPRP     GETPWATER  SFCDTA     GETSMI
C                  ISEL       ISSEL      SATBFR     GOESDG     GOESCHK
C                  SNDTBL     CMDDFF     GETSCATT   GETGPSIPW  W3FIZZ
C                  FIZZ01     WORDLENGTH IW3UNPBF   W3CNVXTOVS
C                  W3XTOVSMND W3UNPKB7   W3RTOVSUNP W3ATOVSUNP
C                  W3XTOVSEDS
C     LIBRARY:
C       SYSTEM   - SYSTEM
C       W3NCO    - W3TAGB     W3TAGE     W3LOCDAT   W3PRADAT   ERREXIT
C       W3EMC    - ORDERS     GBLEVENTS  W3FA03     W3FA04     W3FB04
C       BUFRLIB  - DATEBF     OPENBF     OPENMB     CLOSBF     STATUS
C                  UFBINT     WRITSB     UFBCNT     UFBQCD     DATELEN
C                  CLOSMG     OPENMG     PKBS1      SETBMISS   GETBMISS
C                  NEMSPECS   BVERS      MINIMG     iupvs01
C
C   EXIT STATES:
C     COND =   0 - SUCCESSFUL RUN
C     COND =  04 - APPEND=FALSE ONLY: ONE OF THE FOLLOWING DATA SETS
C                  CONTAINS NO REPORTS: ADPUPA OR ADPSFC (OR BOTH);
C                  PROGRAM RUNS TO COMPLETION
C     COND =  29 - ERROR READING CENTER (CYCLE) DATE FILE
C     COND =  30 - APPEND=TRUE ONLY: THE DATE FROM THE EXISTING
C                  PREPBUFR DATA SET DOES NOT MATCH THE EXPECTED
C                  (NCEP PRODUCTION) DATE
C     COND =  39 - A PROBLEM OCCURRED RETURNING A REPORT IN UNPACKED
C                  FORMAT VIA FCN IW3UNPBF, NO USEFUL INFO RETURNED
C     COND =  49 - ERROR OR END-OF-FILE READING FIXED LAND-SEA-U.S.
C                  MASK FILE IN UNIT IUNIT(3)
C     COND =  60-79 - RESERVED FOR W3EMC ROUTINE GBLEVENTS (SEE
C                      GBLEVENTS DOCBLOCK)
C
C REMARKS: SEE COMMENT CARDS FOLLOWING DOCBLOCK.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
CC
C    ***** VARIABLES IN NAMELIST TASK READ IN MAIN PROGRAM *****
CC
C    MP_PROCESS - PROCESS NUMBER FOR THIS MPI RUN (OBTAINED FROM SCRIPT)
C                                                            (DEFAULT=0)
CC
CC
C   ***** VARIABLES IN NAMELIST GBLEVN READ IN MAIN PROGRAM *****
CC
C    PREVEN - PERFORM THE GBLEVENTS (PREVENTS MODE) PROCESSING?
C              (SEE W3EMC ROUTINE GBLEVENTS)
C              PREVEN =.TRUE.  ---> YES, PERFORM GBLEVENTS PREVENTS
C              PREVEN =.FALSE. ---> NO, SKIP GBLEVENTS PREVENTS    (DEF)
CC
CC
C   ***** VARIABLES IN NAMELIST RGRID READ IN MAIN PROGRAM *****
CC
C  N O T E -- SEARCH GRID USED TO DEFINE AREA FOR DATA EXTRACTION
C              ALL DATA OUTSIDE THE SEARCH GRID ARE EXCLUDED
C          THE DIMENSIONS OF THE SEARCH GRID ARE SET BY IGRD, JGRD
C     =====> NOTE: THE SEARCH GRID DOES NOT APPLY TO AIRCRAFT REPORTS
C                  (ALL TYPES).  THEY ARE SELECTED ACCORDING TO
C                  LATITUDE BAND IN SWITCHES "JAMASS" AND "JAWIND".
C                  (PROGRAM PREPACQC WILL DETERMINE DOMAIN FOR THESE.)
CC
C    IGRD   - NO. OF SEARCH GRID POINTS IN EAST-WEST DIRECTION  (DEF=73)
C    JGRD   - NO. OF SEARCH GRID POINTS IN NORTH-SOUTH DIRECTION(DEF=37)
C    POLA   - TYPE OF SEARCH GRID
C              POLA  =.TRUE.  ---> POLAR STEROGRAPHIC
C              POLA  =.FALSE. ---> MERCATOR
C    NORTH  - HEMISPHERE SWITCH FOR POLAR STEREOGRAPHIC SEARCH GRID
C              NORTH =.TRUE.  ---> N. HEMISPHERE
C              NORTH =.FALSE. ---> S. HEMISPHERE
C              (APPLIES ONLY WHEN POLA = TRUE)
C    ALONVT - IF POLA=.TRUE.  ---> REFERENCE LONGITUDE (+W)
C             IF POLA=.FALSE. ---> STARTING (SOUTHERNMOST) LAT (+N,-S)
C    POLEI  - IF POLA=.TRUE.  ---> I INDEX OF POLE
C             IF POLA=.FALSE. ---> INCREMENT FOR LATITUDE (DEGREES)
C    POLEJ  - IF POLA=.TRUE.  ---> J INDEX OF POLE
C             IF POLA=.FALSE. ---> STARTING (WESTERNMOST) LONGITUDE
C                   (RANGE 0.01 TO 360.00 WEST; =360.00 FOR GREENWICH)
C    XMESHL - IF POLA=.TRUE.  ---> MESH LENGTH (KM) AT 60N
C             IF POLA=.FALSE. ---> INCREMENT FOR LONGITUDE (DEGREES)
CC
CC
C   ***** VARIABLES IN NAMELIST LDTA  READ IN MAIN PROGRAM *****
CC
CC
C    APPEND - APPEND BUFR MESSAGES TO EXISTING PREPBUFR FILE IN
C              UNIT PP?
C              APPEND =.TRUE.  ---> YES, ASSUMES OUTPUT FILE ALREADY
C                      CONTAINS DATA; ALL OUPUT BUFR MESSAGES WILL BE
C                      APPENDED TO IT USING THE INTERNAL BUFR MNEMONIC
C                      TABLE STORED IN THE FIRST SEVERAL BUFR MESSAGES
C                      AT THE TOP OF THE FILE
C              APPEND =.FALSE. ---> NO,  ASSUMES OUTPUT FILE IS NEW;
C                      ALL OUTPUT BUFR MESSAGES WILL BE WRITTEN TO IT
C                      USING THE EXTERNAL BUFR MNEMONIC TABLE IN
C                      UNIT BB                                 (DEFAULT)
C    IRNMRK - NCEP MODEL RUN MARKER
C              IRNMRK =  2 ---> SPECIAL AFOS GRAPHICS RUN
C              IRNMRK =  3 ---> GFS RUNS
C              IRNMRK =  4 ---> RAP (RAPID REFRESH) RUNS {PRIOR TO
C                               1 MAY 2012 THIS WAS RUC2A (RAPID UPDATE
C                               CYCLE)}
C              IRNMRK =  5 ---> GDAS RUNS
C              IRNMRK =  6 ---> NDAS OR NAM RUNS
C              IRNMRK =  7 ---> CDAS-REANALYSIS RUNS
C              IRNMRK =  8 ---> HOURLY (GOES CLOUD DATA) RUNS
C              IRNMRK =  9 ---> REAL TIME MESOSCALE ANAL (RTMA) RUNS
C              IRNMRK = 10 ---> UNRESTRICTED MESOSCALE ANAL (URMA) RUNS
C                                                          (DEFAULT=-99)
C    SUBSKP - LOGICAL (0:255,0:200) THAT IDENTIFIES THOSE BUFR TYPES/
C              SUBTYPES FOR WHICH THE BUFR MESSAGES SHOULD BE SKIPPED
C              OVER (WITHOUT DECODING REPORTS) IF TRUE (DEFAULT=.FALSE.)
C              (NOTE: THIS IS HONORED ONLY FOR THOSE TYPES/SUBSTYPES NOT
C                     SPECIFICALLY CONTROLLED BY SUBSEQUENT SWITCHES IN
C                     THIS NAMELIST (E.G., NEW TYPES/SUBTYPES IN DUMP
C                     FILES READ BY THIS PROGRAM BUT NOT RECOGNIZED BY
C                     IT)
C    WRMISS-  ENCODE SUBSETS WITH NO VALID OBS LEVELS OR BRIGHTNESS
C             TEMP CHANNELS INTO PREPBUFR FILE IF SUBSET HAS OTHER
C             ANCILLARY INFORMATION WHICH IS NOT DIRECTLY USED BY
C             ASSIMILATION BUT MIGHT BE USEFUL FOR VERIFICATION OR
C             IN OTHER WAYS (E.G., SENSIBLE WEATHER ELEMENTS)?
C                                                       (DEFAULT=.TRUE.)
C    SPCIAL - PROCESS "SPECIAL" 25/50 MB LVLS IN GETUPA (NORMALLY FALSE
C              FOR FOR ALL NETWORKS)?                    (DEFAULT=FALSE)
C              (NOTE:  ALL SATELLITE RETRIEVAL TYPES NEVER PROCESS)
C    TDLIM  - IF REPORTED/CALC. DWPT TEMP. IS .LT. THIS VALUE,
C              MOISTURE IS FLAGGED WITH PREPBUFR TABLE VALUE=15, ALSO
C                     vvvvv below needs to be verified!! vvvvv
C              TEMP. PREPBUFR TABLE VALUE IS AT BEST 2, AND VIRT. TEMP.
C              IS NOT ENCODED IN PREPBUFR FILE {APPLIES TO U-AIR CAT.1-5
C              (INCL. ALL SATELLITE RETRIEVAL TYPES EXCEPT RTOVS AND
C              ATOVS 40-LVL), ALL CAT.6, OR SFC RPTS}   (DEFAULT=215. K)
C    TDMAX  - IF REPORTED/CALC. DWPT TEMP. IS .GT. THIS VALUE,
C              MOISTURE IS FLAGGED WITH PREPBUFR TABLE VALUE=15
C              (APPLIES TO ALL DATA REPORT TYPES)
C                                    (DEFAULT=999. K, I.E., NOT INVOKED)
C    MARLND - ALLOW UPPER-AIR OCEAN STN AND SFC MARINE DATA OVER LAND?
C              MARLND =.TRUE.  ---> PROCESS SUCH REPORTS OVER LAND
C              MARLND =.FALSE. ---> PROCESS REPORTS OVER LAND
C                      BUT GIVE ALL VARIABLES A PREPBUFR TBL. VAL. 15
C                                                        (DEFAULT=FALSE)
CC
C    UWINDO - TIME WINDOW (+/-) FOR RAOB & PIBAL REPORTS (IN
C              HUNDREDTHS OF AN HR) - (MAX IS +/- 12 HRS) (DEFAULT=300.)
C    PG4243 - ALLOW INDIAN RAOB MASS REPORTS (BLOCK 42,43)?
C              PG4243 =.FALSE. ---> PROCESS THESE REPORTS
C              PG4243 =.TRUE.  ---> PROCESS THESE REPORTS BUT
C                      GIVE ALL MASS VARIABLES A PREPBUFR TBL. VAL. 15
C                                                       (DEFAULT=.TRUE.)
C
C  +++ NEXT 4 SWITCHES CAN APPLY TO UPPER-AIR DATA TYPES OTHER THAN
C      THAN SATELLITE RETRIEVALS WHICH RESET THESE AS FALSE
C
C    FILLZ  - INTERPOLATE HEIGHT TO LEVELS WHERE MISSING (BOTH CAT. 2
C              LVLS IN 'SMERGE' AND CAT. 3/SPEC. LVLS IN 'WNDBYP') AND
C              RETAIN CAT. 4/11 OR 15 HEIGHTS IN MASS REPORT (APPLIES
C              TO ADPUPA, PROFLR AND VADWND)
C              FILLZ=.TRUE. ---> YES
C              FILLZ=.FALSE. --> NO  (NORMALLY FOR OUTPUT TO GSI)
C                                                              (DEFAULT)
C    FILLW  - INTERPOLATE WINDS TO LEVELS WHERE MISSING (IN 'FILWND')
C              (APPLIES TO ADPUPA, PROFLR AND VADWND)
C              FILLW=.TRUE. ---> YES
C              FILLW=.FALSE. --> NO  (NORMALLY FOR OUTPUT TO GSI)
C                                                              (DEFAULT)
C
C    FILLT  - INTERPOLATE TEMPERATURE TO LEVELS WHERE MISSING (BOTH CAT.
C              3/SPEC. LVLS IN 'WNDBYP' AND CAT. 4/11 LVLS IN 'WNDBYZ')
C              (APPLIES TO ADPUPA)
C              FILLT=.TRUE. ---> YES
C              FILLT=.FALSE. --> NO  (NORMALLY FOR OUTPUT TO GSI)
C                                                              (DEFAULT)
C    FILLM  - INTERPOLATE MOISTURE TO LEVELS WHERE MISSING (IN 'FILDPT')
C              (APPLIES TO ADPUPA)
C              FILLM=.TRUE. ---> YES
C              FILLM=.FALSE. --> NO  (NORMALLY FOR OUTPUT TO GSI)
C                                                              (DEFAULT)
C
C    DWINDO - TIME WINDOW (+/-) FOR DROPWINSONDE REPORTS REPORTS (IN
C             HUNDREDTHS OF AN HR) - (MAX IS +/- 12 HRS)  (DEFAULT=300.)
C    RWINDO - TIME WINDOW (+/-) FOR RECONNAISSANCE REPORTS REPORTS (IN
C             HUNDREDTHS OF AN HR) - (MAX IS +/- 12 HRS)  (DEFAULT=300.)
C    DROPSN - PROCESS DROPWINSONDE REPORTS?             (DEFAULT=.TRUE.)
C    RECCON - PROCESS RECONNAISSANCE AIRCRAFT REPORTS?  (DEFAULT=.TRUE.)
C    RECSLM - PROCESS RECCO CAT. 6 MASS DATA?           (DEFAULT=.TRUE.)
C    FLDMGS - FLAG MOISTURE DATA ON ALL LEVELS FOR NOAA (P-3 OR GULF
C              STREAM) DROPS?
C              FLDMGS=.TRUE. ---> YES                          (DEFAULT)
C              FLDMGS=.FALSE. --> NO
C    FLDMAF - FLAG MOISTURE DATA ON ALL LEVELS FOR USAF DROPS?
C              FLDMAF=.TRUE. ---> YES                          (DEFAULT)
C              FLDMAF=.FALSE. --> NO
C    FLDMFR - FLAG MOISTURE DATA ON ALL LEVELS FOR NON-US (I.E., NON-
C              NOAA AND NON-USAF) OR UNKNOWN DROPS?
C              FLDMFR=.TRUE. ---> YES                          (DEFAULT)
C              FLDMFR=.FALSE. --> NO
C    KTEMP  -PROCESS MASS PIECE IF TEMP VALID BUT ALL HEIGHTS MISSING
C             OR BAD?
C              KTEMP=.TRUE. ---> YES
C              KTEMP=.FALSE. --> NO (IF WIND VALID,THEN PIBAL) (DEFAULT)
C              (NOTE: IF HGHT BAD/MSG & KTEMP=T; PIBAL DEFINITION CHGED)
C    LSWIND - CLASS SOUNDING WIND DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE               (DEFAULT - LSWIND/9999/)
C    LSMASS - CLASS SOUNDING MASS DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE               (DEFAULT - LSMASS/9999/)
C    CWINDO - TIME WINDOW (+/-) FOR CLASS SOUNDING REPORTS (IN
C              HUNDREDTHS OF AN HR) - (MAX IS +/- 12 HRS) (DEFAULT=300.)
CC
C  N O T E -- THE FOLLOWING (2,9) ARRAY REFERS TO THE 2 GEOGRAPHICAL
C              REGIONS & THE 9 AIRCRAFT FLIGHT LVL REPORT TYPES POSSIBLE
C                ** THE FIRST ELEMENT IDENTIFIED AS FOLLOWS:
C                     1 - OUTSIDE THE CONUS REGION
C                     2 - INSIDE THE CONUS REGION
C                ** THE SECOND ELEMENT IDENTIFIED AS FOLLOWS:
C                     1 - AIREP/PIREP FORMAT REPORTS (HEREAFTER CALLED
C                         "AIREP/PIREP" REPORTS FOR SIMPLICITY)
C                     2 - AMDAR REPORTS ORIGINALLY IN AMDAR FORMAT
C                         (HEREAFTER CALLED "AMDAR" REPORTS FOR
C                         SIMPLICITY)
C                     3 - EUROPEAN AMDAR REPORTS ORIGINALLY IN BUFR
C                         (HEREAFTER CALLED "EAMDAR" REPORTS FOR
C                         SIMPLICITY)
C                     4 - U.S. AMDAR (MDCRS) REPORTS ORIGINALLY IN BUFR
C                         (HEREAFTER CALLED "MDCRS" REPORTS FOR
C                         SIMPLICITY)
C                     5 - TAMDAR (TROPOSPHERIC AIRBORNE METEOROLOGICAL
C                         DATA REPORT) REPORTS FROM GSD MADIS FEED
C                         ORIGINALLY IN NetCDF FORMAT (HEREAFTER REFERRED
C                         TO AS "TAMDARM" REPORTS)
C                     6 - CANADIAN AMDAR REPORTS ORIGINALLY IN BUFR
C                         FORMAT (HEREAFTER CALLED CAMDAR" REPORTS FOR
C                         SIMPLICITY)
C                     7 - KOREAN AMDAR REPORTS ORIGINALLY IN BUFR FORMAT
C                         (HEREAFTER CALLED "KAMDAR" REPORTS FOR
C                         SIMPLICITY)
C                     8 - OTHER-THAN-ABOVE AMDAR REPORTS ORIGINALLY IN
C                         BUFR FORMAT (HEREAFTER CALLED "AMDARB" REPORTS
C                         FOR SIMPLICITY)
C                     9 - TAMDAR REPORTS ORIGINALLY IN BUFR FORMAT {FROM
C                         PANASONIC (nee AirDAT), HEREAFTER REFERRED TO
C                         AS "TAMDARB" REPORTS)
CC
C    AWINDO - TIME WINDOW (+/-) FOR ACFT RPTS (IN HUNDREDTHS OF AN HR)
C             - (MAX IS +/- 12 HRS)
C                         (DEFAULT - AWINDO(2,9)/6*325.,2*325.,10*325./)
CC
C    PHIACF - BOUNDARIES OF 6 LATITUDE BANDS FOR AIRCRAFT DATA
C                   (DEFAULT - PHIACF(7)/-90.,-70.,-20.,0.,20.,70.,90./)
C  N O T E -- THE FOLLOWING (6,9) ARRAYS REFER TO THE 6 LATITUDE
C              BANDS IN PHIACF (1ST ELEMENT) AND THE 9 ACFT FLIGHT LVL
C              RPT TYPES POSSIBLE (SEE SECOND ELEMENT DEFINITION ABOVE)
CC
C    AIRLND - ALLOW AIRCRAFT FLIGHT LEVEL DATA OVER LAND?
C              AIRLND =.TRUE.  ---> PROCESS REPORTS OVER LAND
C              AIRLND =.FALSE. ---> PROCESS REPORTS OVER LAND
C                      BUT GIVE ALL VARIABLES A PREPBUFR TBL. VAL. 15
C                                     (DEFAULT - AIRLND(6,9)/54*.TRUE./)
C    JAWIND - AIRCRAFT FLIGHT LEVEL WIND DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE          (DEFAULT - JAWIND(6,9)/54*0/)
C       = 9999  EXCLUDE THIS TYPE
C    JAMASS - AIRCRAFT FLIGHT LEVEL MASS DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE          (DEFAULT - JAMASS(6,9)/54*0/)
C       = 9999  EXCLUDE THIS TYPE
CC
C  N O T E -- THE FOLLOWING ARRAYS REFER TO THE 9 ACFT FLIGHT LEVEL
C              REPORT TYPES POSSIBLE (SEE DEFINITION ABOVE)
CC
C    IACFTL - LOWEST ALTITUDE (METERS) FOR WHICH ACFT DATA WILL BE
C              PROCESSED (BELOW THIS LEVEL ALL VARIABLES GET
C              PREPBUFR TBL. VAL. 15)   (DEFAULT - IACFTL(9)/100,8*-200)
C              (NOTE:  100 METERS IS  328 FEET)
C                     2286 METERS IS 7500 FEET)
C    IACFTH - HIGHEST ALTITUDE (METERS) FOR WHICH ACFT DATA WILL BE
C              PROCESSED (ABOVE THIS LEVEL ALL VARIABLES GET
C              PREPBUFR TBL. VAL. 15)
C                      (DEFAULT - IACFTH(9)/3*18000,16500,4*18000,16500)
C              (NOTE: 16500 METERS IS APPROXIMATELY  95 MB)
C                     18000 METERS IS APPROXIMATELY  75 MB)
C    AIFNOW - PROCESS ACFT FLIGHT LEVEL MASS REPORT "PIECE" IF WIND
C              DATA ARE MISSING (WIND RPT "PIECE" IS TOSSED)?
C              AIFNOW =.TRUE.  ---> PROCESS MASS REPORTS
C              AIFNOW =.FALSE. ---> PROCESS MASS REPORTS BUT GIVE
C                      ALL VARIABLES A PREPBUFR TBL. VAL. OF 15
C                                         (DEFAULT - AIFNOW(9)/9*.TRUE.)
C    FLACMS - FLAG AIRCRAFT MOISTURE (SET SPEC. HUMIDITY Q.M. TO 15)?
C              FLACMS =.TRUE.  ---> YES  (DEFAULT - FLACMS(9)/9*.TRUE./)
C              FLACMS =.FALSE. ---> NO
C          N O T E:  CURRENTLY ONLY MDCRS, EAMDAR AND TAMDAR(M/B)
C                    REPORTS HAVE MOISTURE
CC
C    PHISWN - BOUNDARIES OF 6 LAT. BANDS FOR SATELLITE (WIND) DATA
C                   (DEFAULT - PHISWN(7)/-90.,-70.,-20.,0.,20.,70.,90./)
C  N O T E -- THE FOLLOWING (6,8,10) ARRAYS REFER TO THE 6 LATITUDE
C              BANDS IN PHISWN (1ST ELEMENT), 8 PRODUCERS/SATELLITES
C              (2ND ELEMENT), AND 10 PRODUCTS (3RD ELEMENT)
C                ** THE SECOND ELEMENT IDENTIFIED AS FOLLOWS:
C                     1 - USA/NOAA/NESDIS / ODD  NUMBER GOES SATELLITE
C                     2 - USA/NOAA/NESDIS / EVEN NUMBER GOES SATELLITE
C                     3 - INDIA / ALL INSAT/KALPANA SATELLITES
C                     4 - JAPAN / ALL GMS/MTSAT SATELLITES, OR GOES-09
C                                 (IF GOES-09, STILL REFERRED TO AS GMS
C                                  IN THIS PROGRAM)
C                     5 - EUMETSAT / ODD  NUMBER METEOSAT SATELLITE
C                     6 - EUMETSAT / EVEN NUMBER METEOSAT SATELLITE
C                     7 - NASA/MODIS / AQUA SATELLITE
C                     8 - NASA/MODIS / TERRA SATELLITE
C                           (NOTE: 1-6 ARE GEOSTATIONARY SATELLITES,
C                                  7-8 ARE POLAR-ORBITING SATELLITES)
C                ** THE THIRD ELEMENT IDENTIFIED AS FOLLOWS:
C                     1 - CONVENTIONAL IR (LONG-WAVE) CLOUD-DRIFT WINDS/
C                         TEMPERATURE
C                     2 - CONVENTIONAL IMAGER WATER-VAPOR WINDS (DEEP-
C                         LAYER AND CLOUD TOP) (NO TEMPERATURE)
C                     3 - CONVENTIONAL VISIBLE CLOUD-DRIFT WINDS/TEMP
C                     4 - HIGH-DENSITY IMAGER IR (LONG-WAVE) CLOUD-
C                         DRIFT WINDS/TEMPERATURE
C                     5 - HIGH-DENSITY VIS CLOUD-DRIFT WINDS/TEMPERATURE
C                     6 - HIGH-DENSITY IMAGER CLOUD-TOP WATER VAPOR
C                         WINDS/TEMPERATURE
C                     7 - HIGH-DENSITY IMAGER DEEP-LAYER WATER VAPOR
C                         WINDS/TEMPERATURE
C                     8 - HIGH-DENSITY SOUNDER CLOUD-TOP WATER VAPOR
C                         WINDS/TEMPERATURE
C                     9 - HIGH-DENSITY SOUNDER DEEP-LAYER WATER VAPOR
C                         WINDS/TEMPERATURE
C                    10 - PICTURE TRIPLET CLOUD-DRIFT WINDS/TEMPERATURE
CC
C    SWINDO_e - EARLIEST TIME WINDOW FOR SAT. RPTS (RELATIVE TO CYCLE
C                TIME, "-" IS PRIOR, "+" IS AFTER; IN HUNDREDTHS OF AN
C                HR; MAXIMUM IS +/- 12 HOURS)
C     (DEF- SWINDO_e(6,8,10)/12*-300.,6*-700.,6*-300.,12*-300.,12*-300.,
C                            12*-300.,6*-700.,6*-300.,12*-300.,12*-300.,
C                            12*-300.,6*-700.,6*-300.,12*-300.,12*-300.,
C                            336*-300./)
C    SWINDO_l - LATEST TIME WINDOW FOR SAT. RPTS (RELATIVE TO CYCLE
C                TIME, "-" IS PRIOR, "+" IS AFTER; IN HUNDREDTHS OF AN
C                HR; MAXIMUM IS +/- 12 HOURS)
C     (DEF- SWINDO_l(6,8,10)/12*+300.,6*+700.,6*+300.,12*+300.,12*+300.,
C                            12*+300.,6*+700.,6*+300.,12*+300.,12*+300.,
C                            12*+300.,6*+700.,6*+300.,12*+300.,12*+300.,
C                            336*+300./)
C    SWNLND - ALLOW SATELLITE REPORTS DATA OVER LAND?
C              SWNLND =.TRUE.  ---> PROCESS REPORTS OVER LAND
C              SWNLND =.FALSE. ---> PROCESS REPORTS OVER LAND
C                      BUT GIVE ALL VARIABLES A PREPBUFR TBL. VAL. 15
C                                 (DEFAULT - SWNLND(6,8,10)/480*.TRUE./)
C    JSWIND - SATELLITE WIND REPORT SUB-TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       =   99  PROCESS THIS TYPE BUT GIVE ALL VARIABLES A PREPBUFR
C                 TABLE VALUE OF 15 SO REPORT ISN'T USED BY ANALYSIS
C       =  199  PROCESS THIS TYPE IF GOES-ODD SATELLITE AND SAT. NO.
C                 IS 253, 257, ... (PREFIX CHAR. 'C' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-ODD
C                 SATELLITE AND SAT. NO. IS 251, 255, ... (PREFIX CHAR.
C                 'A' IN STNID)  --> APPLIES TO 2'ND ELEM. =1 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF GOES-EVEN SATELLITE AND SAT. NO.
C                 IS 250, 254, ... (PREFIX CHAR. 'D' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-EVEN
C                 SATELLITE AND SAT. NO. IS 252, 256, ... (PREFIX CHAR.
C                 'B' IN STNID)  --> APPLIES TO 2'ND ELEM. =2 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-ODD SATELLITE AND SAT.
C                 NO. IS 53, 57, ... (PREFIX CHAR. 'Y' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 ODD SATELLITE AND SAT. NO. IS 51, 55, ... (PREFIX
C                  CHAR. 'W' IN STNID) -->  APPLIES TO 2'ND ELEM. =5
C                  ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-EVEN SATELLITE AND SAT.
C                 NO. IS 50, 54, ... (PREFIX CHAR. 'Z' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 EVEN SATELLITE AND SAT. NO. IS 52, 56, ... (PREFIX
C                  CHAR. 'X' IN STNID) -->  APPLIES TO 2'ND ELEM. =6
C                  ONLY
C       =  299  PROCESS THIS TYPE IF GOES-ODD SATELLITE AND SAT. NO.
C                 IS 251, 255, ... (PREFIX CHAR. 'A' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-ODD
C                 SATELLITE AND SAT. NO. IS 253, 257, ... (PREFIX CHAR.
C                 'C' IN STNID)  --> APPLIES TO 2'ND ELEM. =1 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF GOES-EVEN SATELLITE AND SAT. NO.
C                 IS 252, 256, ... (PREFIX CHAR. 'B' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-EVEN
C                 SATELLITE AND SAT. NO. IS 250, 254 ... (PREFIX CHAR.
C                 'D' IN STNID)  --> APPLIES TO 2'ND ELEM. =2 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-ODD SATELLITE AND SAT.
C                 NO. IS 51, 55, ... (PREFIX CHAR. 'W' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 ODD SATELLITE AND SAT. NO. IS 53, 57, ... (PREFIX
C                  CHAR. 'Y' IN STNID) -->  APPLIES TO 2'ND ELEM. =5
C                  ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-EVEN SATELLITE AND SAT.
C                 NO. IS 52, 56, ... (PREFIX CHAR. 'X' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 EVEN SATELLITE AND SAT. NO. IS 50, 54, ... (PREFIX
C                  CHAR. 'Z' IN STNID) -->  APPLIES TO 2'ND ELEM. =6
C                  ONLY
C       = 9999  EXCLUDE THIS TYPE
C    {NOTE: JSWIND SHOULD ALWAYS BE SET TO 9999 FOR ALL TYPES EXCEPT:
C                JSWIND(X,Y, 1) WHERE X=1-6; Y=3-6      AND
C                JSWIND(X,Y, 2) WHERE X=1-6; Y=3-6      AND
C                JSWIND(X,Y, 3) WHERE X=1-6; Y=3-6      AND
C                JSWIND(X,Y, 4) WHERE X=1-6; Y=1-2, 7-8 AND
C                JSWIND(X,Y, 5) WHERE X=1-6; Y=1-2      AND
C                JSWIND(X,Y, 6) WHERE X=1-6; Y=1-2, 7-8 AND
C                JSWIND(X,Y, 7) WHERE X=1-6; Y=1-2, 7-8 AND
C                JSWIND(X,Y, 8) WHERE X=1-6; Y=1-2      AND
C                JSWIND(X,Y, 9) WHERE X=1-6; Y=1-2      AND
C                JSWIND(X,Y,10) WHERE X=1-6; Y=1-2}
C    {NOTE: FOR JSWIND(X,Y,Z) = 99, 199, 299, JSMASS(X,Y,Z) MUST EITHER
C           BE 9999 OR BE THE SAME AS JSWIND(X,Y,Z) !!!}
C           (DEF- JSWIND(6,8,10)/12*9999,6*9999,6*0,12*0,12*9999,
C                                12*9999,6*9999,6*9999,12*9999,12*9999,
C                                12*9999,6*9999,6*0,12*0,12*9999,
C                                12*0,6*9999,6*9999,12*9999,12*9999,
C                                12*9999,6*9999,6*9999,12*9999,12*9999,
C                                12*0,6*9999,6*9999,12*9999,12*9999,
C                                12*9999,6*9999,6*9999,12*9999,12*9999,
C                                12*9999,6*9999,6*9999,12*9999,12*9999,
C                                12*9999,6*9999,6*9999,12*9999,12*9999,
C                                12*9999,6*9999,6*9999,12*9999,12*9999/)
C    JSMASS - SATELLITE MASS REPORT SUB-TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       =   99  PROCESS THIS TYPE BUT GIVE ALL VARIABLES A PREPBUFR
C                 TABLE VALUE OF 15 SO REPORT ISN'T USED BY ANALYSIS
C       =  199  PROCESS THIS TYPE IF GOES-ODD SATELLITE AND SAT. NO.
C                 IS 253, 257, ... (PREFIX CHAR. 'C' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-ODD
C                 SATELLITE AND SAT. NO. IS 251, 255, ... (PREFIX CHAR.
C                 'A' IN STNID)  --> APPLIES TO 2'ND ELEM. =1 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF GOES-EVEN SATELLITE AND SAT. NO.
C                 IS 250, 254, ... (PREFIX CHAR. 'D' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-EVEN
C                 SATELLITE AND SAT. NO. IS 252, 256, ... (PREFIX CHAR.
C                 'B' IN STNID)  --> APPLIES TO 2'ND ELEM. =2 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-ODD SATELLITE AND SAT.
C                 NO. IS 53, 57, ... (PREFIX CHAR. 'Y' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 ODD SATELLITE AND SAT. NO. IS 51, 55, ... (PREFIX
C                  CHAR. 'W' IN STNID) -->  APPLIES TO 2'ND ELEM. =5
C                  ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-EVEN SATELLITE AND SAT.
C                 NO. IS 50, 54, ... (PREFIX CHAR. 'Z' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 EVEN SATELLITE AND SAT. NO. IS 52, 56, ... (PREFIX
C                  CHAR. 'X' IN STNID) -->  APPLIES TO 2'ND ELEM. =6
C                  ONLY
C       =  299  PROCESS THIS TYPE IF GOES-ODD SATELLITE AND SAT. NO.
C                 IS 251, 255, ... (PREFIX CHAR. 'A' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-ODD
C                 SATELLITE AND SAT. NO. IS 253, 257, ... (PREFIX CHAR.
C                 'C' IN STNID)  --> APPLIES TO 2'ND ELEM. =1 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF GOES-EVEN SATELLITE AND SAT. NO.
C                 IS 252, 256, ... (PREFIX CHAR. 'B' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF GOES-EVEN
C                 SATELLITE AND SAT. NO. IS 250, 254 ... (PREFIX CHAR.
C                 'D' IN STNID)  --> APPLIES TO 2'ND ELEM. =2 ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-ODD SATELLITE AND SAT.
C                 NO. IS 51, 55, ... (PREFIX CHAR. 'W' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 ODD SATELLITE AND SAT. NO. IS 53, 57, ... (PREFIX
C                  CHAR. 'Y' IN STNID) -->  APPLIES TO 2'ND ELEM. =5
C                  ONLY
C                                 -- OR --
C               PROCESS THIS TYPE IF METEOSAT-EVEN SATELLITE AND SAT.
C                 NO. IS 52, 56, ... (PREFIX CHAR. 'X' IN STNID); GIVE
C                 ALL VARIABLES A PREPBUFR TABLE VALUE 15 IF METEOSAT-
C                 EVEN SATELLITE AND SAT. NO. IS 50, 54, ... (PREFIX
C                  CHAR. 'Z' IN STNID) -->  APPLIES TO 2'ND ELEM. =6
C                  ONLY
C       = 9999  EXCLUDE THIS TYPE
C    {NOTE: JSMASS SHOULD ALWAYS BE SET TO 9999 FOR ALL TYPES EXCEPT:
C                JSMASS(X,Y, 1) WHERE X=1-6; Y=3-6      AND
C                JSMASS(X,Y, 3) WHERE X=1-6; Y=3-6      AND
C                JSMASS(X,Y, 4) WHERE X=1-6; Y=1-2      AND
C                JSMASS(X,Y, 5) WHERE X=1-6; Y=1-2      AND
C                JSMASS(X,Y, 6) WHERE X=1-6; Y=1-2      AND
C                JSMASS(X,Y, 7) WHERE X=1-6; Y=1-2      AND
C                JSMASS(X,Y, 8) WHERE X=1-6; Y=1-2      AND
C                JSMASS(X,Y, 9) WHERE X=1-6; Y=1-2}
C    {NOTE: FOR JSMASS(X,Y,Z) = 99, 199, 299, JSWIND(X,Y,Z) MUST EITHER
C           BE 9999 OR BE THE SAME AS JSMASS(X,Y,Z) !!!}
C                                        (DEF- JSMASS(6,8,10)/480*9999/)
C
CC
C  N O T E -- THE FOLLOWING 5-WORD ARRAYS REFER TO THE 5 WIND PROFILER
C              REPORT TYPES POSSIBLE
C                     1 - NOAA PROFILER NETWORK (NPN)
C                     2 - PROFILERS ORIGINATING FROM PILOT (PIBAL)
C                         FORMAT BULLETINS
C                     3 - COOPERATIVE AGENCY PROFILERS (INCL. NOAA BLP)
C                     4 - JAPANESE METEOR. AGENCY (JMA) PROFILERS
C                     5 - OTHER PROFILER WINDS (E.G., FROM HONG KONG)
CC
C    PWINDO - TIME WINDOW (+/-) FOR WIND PROFILER REPORTS (IN
C              HUNDREDTHS OF AN HR) - (MAX IS +/- 12 HRS)   (DEF=5*300.)
C    PRFLER - PROCESS WIND PROFILER REPORTS?          (DEFAULT=5*.TRUE.)
CC
C    VWINDO - TIME WINDOW (+/-) FOR VAD WIND REPORTS (IN HUNDREDTHS OF
C              AN HR) - (MAX IS +/- 12 HRS)               (DEFAULT=300.)
C    IVADFL - LOWEST VAD WIND CONFIDENCE LEVEL FOR WHICH WIND ON
C             LEVEL WILL BE GIVEN A QUALITY MARK OF 13 (BAD) (DEFAULT=5)
C             (SEE SUBROUTINE W3UNPKB7 FOR DEF'N OF "CONFIDENCE LEVEL")
C             (NOTE: WINDS WITH C.L. .GE. IVADFL ARE GIVEN BAD Q.M.)
C    IVADSP - LOWEST VAD WIND CONFIDENCE LEVEL FOR WHICH WIND ON
C             LEVEL WILL BE GIVEN A QUALITY MARK OF 3 (SUSPECT)  (DEF=2)
C             (SEE SUBROUTINE W3UNPKB7 FOR DEF'N OF "CONFIDENCE LEVEL")
C             (NOTE: WINDS WITH C.L. .GE. IVADSP ARE GIVEN SUSPECT
C                    Q.M. UP TO VALUE OF IVADFL, AFTER WHICH WINDS ARE
C                    GIVEN A BAD Q.M.)
C             IMPORTANT: IVADSP MUST ALWAYS BE .LE. IVADFL
C    VADWIN - PROCESS VAD (NEXRAD) WIND REPORTS?       (DEFAULT=.FALSE.)
CC
C    TWINDO - TIME WINDOW (+/-) FOR RASS REPORTS (IN HUNDREDTHS OF AN
C              HR) - (MAX IS +/- 12 HRS)                  (DEFAULT=300.)
C    RASS   - PROCESS RASS TEMPERATURE REPORTS?        (DEFAULT=.FALSE.)
CC
CC
C  N O T E -- THE FOLLOWING 2-WORD ARRAYS (TOVEDS AND TOVBFR) REFER TO
C              RTOVS (1) AND ATOVS (2) DATA
CC
C    TOVEDS - PROCESS RTOVS OR ATOVS RETRIEVAL REPORTS (NO RADIANCES)
C              RETURNED IN UNPACKED NMCEDS FORMAT?    (DEFAULT=2*.TRUE.)
C    TOVBFR - PROCESS RTOVS OR ATOVS RADIANCES AND/OR 40-LVL RETRIEVAL
C              RPTS (SEE TOVRAD & TOVRTV BELOW)?     (DEFAULT=2*.FALSE.)
C    (NOTE: TOVEDS(I) AND TOVBFR(I) SHOULD  N E V E R  BOTH BE TRUE
C            REGARDLESS OF THE VALUE FOR "I")
C                  --  GIVEN THAT TOVBFR(I) = TRUE --
CC
C    TOVRAD - PROCESS RTOVS OR ATOVS RADIANCES FROM RPTS?  (DEF=.FALSE.)
C    TOVRTV - PROCESS RTOVS OR ATOVS 40-LEVEL RETRIEVALS FROM RPTS?
C                                                      (DEFAULT=.FALSE.)
C    TR80KM - RESOLUTION FOR RTOVS OR ATOVS REPORTS (ALL TYPES)
C              TR80KM =.TRUE.  --->  80 KM RTOVS/40 KM ATOVS (FULL
C                                    RESOLUTION)
C              TR80KM =.FALSE. ---> 250 KM                     (DEFAULT)
C             (NOTE: FOR RTOVS THIS IS DETERMINED BY A FILTER FLAG
C                    WHERE GOOD IS 250KM RESOLUTION AND GOOD+REDUNDANT
C                    IS 80KM RESOLUTION; FOR ATOVS 250KM RESOLUTION IS
C                    ESTIMATED BY SAMPLING EVERY 11'TH RETRIEVAL)
CC
C  N O T E -- THE FOLLOWING 2-WORD ARRAYS (GOESND, GOESPW, GOESRD AND
C              GOESCT) REFER TO LOW-RESOLUTION (5x5 FOV) AND HIGH-
C              RESOLUTION (1x1) DATA
CC
C    GOESND - PROCESS GOES SOUNDING (PROFILE) RPTS?  (DEFAULT=2*.FALSE.)
C    GOESPW - PROCESS GOES PRECIPITABLE WATER RPTS?  (DEFAULT=2*.FALSE.)
C    GOESRD - PROCESS GOES RADIANCE REPORTS          (DEFAULT=2*.FALSE.)
C    GOESCT - PROCESS GOES CLOUD TOP REPORTS?        (DEFAULT=2*.FALSE.)
CC
C    PHI    - BOUNDARIES OF 5 LAT BANDS FOR SATELLITE RADIANCE/RETR DATA
C                         (DEFAULT - PHI(6)/-90.,-70.,-20.,20.,74.,90./)
CC
C  N O T E -- THE FOLLOWING (5,4,4) ARRAYS REFER TO THE 5 LATITUDE
C              BANDS IN PHI (1ST ELEMENT), 4 SATELLITES (2ND ELEMENT),
C              AND 4 TYPES (3RD ELEMENT)
C       ** THE SECOND ELEMENT IDENTIFIED AS FOLLOWS:
C           1 - EVEN NUMBERED NOAA SATELLITE (FOR 3RD ELEM.=1)
C                             -- OR --
C               EVEN-1 NUMBERED GOES SATELLITE (FOR 3RD ELEM.=2,4)
C                {E.G., GOES-04(248), GOES-08(252), GOES-12(256), ... }
C                (SUFFIX CHARACTERS "I", "J" OR "K")
C           2 - ODD  NUMBERED NOAA SATELLITE (FOR 3RD ELEM.=1)
C                             -- OR --
C               ODD-1  NUMBERED GOES SATELLITE (FOR 3RD ELEM.=2,4)
C                {E.G., GOES-09(253), GOES-13(257), ... }
C                (SUFFIX CHARACTERS "L", "M" OR "N")
C           3 - EVEN-2 NUMBERED GOES SATELLITE (FOR 3RD ELEM.=2,4)
C                {E.G., GOES-06(250), GOES-10(254), GOES-14(258), ... }
C                (SUFFIX CHARACTERS "O", "P" OR "S")
C                (NOTE: DOES NOT APPLY FOR 3RD ELEM.=1)
C           4 - ODD-2  NUMBERED GOES SATELLITE (FOR 3RD ELEM.=2,4)
C                {E.G., GOES-07(251), GOES-11(255), GOES-15(259), ... }
C                (SUFFIX CHARACTERS "Q", "R" OR "T")
C                (NOTE: DOES NOT APPLY FOR 3RD ELEM.=1)
C       ** THE THIRD ELEMENT IDENTIFIED AS FOLLOWS:
C           1 - RTOVS/ATOVS SOUNDINGS/RADIANCES
C           2 - GOES SOUNDINGS/RADIANCES
C           3 - GOES PW RETRIEVALS
C           4 - GOES CLOUD TOP RETRIEVALS
C
CC
C    IWINDO_e - EARLIEST TIME WINDOW FOR SATELLITE RADIANCES/RETRIEVALS
C                (RELATIVE TO CYCLE TIME, "-" IS PRIOR, "+" IS AFTER)
C               -- FOR RTOVS OR ATOVS IN WHOLE HOURS
C               -- FOR GOES IN HOURS TIMES 100
C                (MAXIMUM IS +/- 12 HOURS)
C                              (DEFAULT- IWINDO_e(5,4,4)/20*-3,60*-300/)
C    IWINDO_l - LATEST TIME WINDOW FOR SATELLITE RADIANCES/RETRIEVALS
C                (RELATIVE TO CYCLE TIME, "-" IS PRIOR, "+" IS AFTER)
C               -- FOR RTOVS OR ATOVS IN WHOLE HOURS
C               -- FOR GOES IN HOURS TIMES 100
C                (MAXIMUM IS +/- 12 HOURS)
C                              (DEFAULT- IWINDO_l(5,4,4)/20*+3,60*+300/)
C    SATMST - PROCESS MOISTURE INFORMATION IN A SOUNDING?
C              SATMST =.TRUE.  ---> PROCESS MOISTURE INFORMATION
C              SATMST =.FALSE. ---> EXCLUDE MOISTURE INFORMATION
C                                  (DEFAULT - SATMST(5,4,4)/80*.FALSE./)
C              (NOTE: APPLIES ONLY TO THIRD ELEMENT = 1,2)
C    ISATLS - SATELLITE RADIANCE/RETRIEVAL REPORT LAND/SEA SWITCH
C              ISATLS =     0 ---> PROCESS REPORTS OVER LAND AND OCEAN
C              ISATLS =     1 ---> PROCESS REPORTS OVER LAND ONLY
C              ISATLS =     2 ---> PROCESS REPORTS OVER OCEAN ONLY
C                                        (DEFAULT - ISATLS(5,4,4)/80*2/)
C              (NOTE: IMPORTANT: ANY TYPE NOT PROCESSED IS TOSSED, IT
C                     IS NOT FLAGGED)
C    KTOP   - INDEX CORRESP. TO UPPER LIMITING MAND. PRESSURE LEVEL FOR
C              PROCESSING SAT. RETRIEVALS {DATA ON ALL LVLS ON & BELOW
C              PMAND(KTOP) PROCESSED}    (DEF - KTOP(5,4,4)/80*16/,10MB)
C              -- THE MAXIMUM VALUE IS 23 (CORRESPONDING TO 0.1 MB)
C              (NOTE: APPL. TO ALL VARIABLES ON THE LVL, INCL. MOISTURE)
C
C    IRTRV  - SATELLITE PATH TYPE SWITCH -
C       =    0  PROCESS ALL PATH TYPES
C       =    1  PROCESS ONLY CLEAR COLUMN PATH TYPES
C       =    2  RTOVS/ATOVS: PROCESS ONLY N* (PARTLY CLDY) PATH TYPES
C               GOES: DOES NOT APPLY
C       =    3  PROCESS ONLY CLOUDY TYPES
C       =    4  GOES: PROCESS ONLY UNKNOWN TYPES
C               RTOVS/ATOVS: DOES NOT APPLY
C       = 9999  EXCLUDE ALL TYPES
C       =  544  EXCLUDE CLOUDY TYPES
C       =  528  RTOVS/ATOVS: EXCLUDE N* (PARTLY CLOUDY) TYPES
C               GOES: DOES NOT APPLY TO GOES
C       =  272  EXCLUDE CLEAR COLUMN TYPES
C       =  118  EXCLUDE UNKNOWN TYPES
C
C    (NOTE 1: THIS DOES NOT APPLY TO RTOVS/ATOVS OR GOES RADIANCES;
C     NOTE 2: IMPORTANT: 'PROCESS' HERE MEANS THIS TYPE IS
C             NOT FLAGGED W/ PREPBUFR TBL VALUE=15 AND ALL OTHER TYPES
C             ARE FLAGGED;  'EXCLUDE' HERE MEANS THIS TYPE IS PROCESSED
C             BUT IS FLAGGED WITH PREPBUFR TABLE VALUE=15)
C                          (DEFAULT - IRTRV(5,4,4)/4(2*0,544,2*0),60*0/)
CC
C  N O T E -- THE FOLLOWING 12-WORD ARRAYS REFER TO THE 12 SURFACE
C              OBSERVATION TYPES POSSIBLE
C        1 - SYNOPTIC LAND (FIXED) (INCLUDING WMO RESOLUTION 40)
C        2 - MARINE SHIP (FIXED AND MOVING)
C        3 - OPC/NOS POINT MEAN SEA-LEVEL PRESSURE BOGUS (MARINE)
C        4 - MARINE BUOY (FIXED AND DRIFTING)
C        5 - MARINE SPLASH-LEVEL FROM DROPWINSONDES OR RECCOS WITH PMSL
C            OBS (MASS RPT)
C        6 - MARINE C-MAN PLATFORM
C        7 - AUSTRALIAN (PAOBS) MEAN SEA-LEVEL PRESSURE BOGUS (MARINE)
C        8 - METAR LAND
C        9 - MARINE AUTOMATED TIDE GAUGE STATIONS
C       10 - MESONET SURFACE (COOPERATIVE NETWORKS)
C       11 - SYNOPTIC LAND (MOBILE)
C       12 - COAST GUARD TIDE GAUGE STATIONS
CC
C    FWINDO - TIME WINDOW (+/-) FOR SURFACE RPTS (IN HUNDREDTHS OF AN
C              HR) - (MAX IS +/- 12 HRS)
C                            (DEF - FWINDO(12)/4*300.,600.,7*300./)
C    JSURFM - SURFACE MASS DATA TYPE SWITCH -
C       =    0  PROCESS MASS INFO FOR THIS TYPE
C       = 9999  EXCL. MASS INFO FOR THIS TYPE   (DEF - JSURFM(12)/12*0/)
C    JSURFW - SURFACE WIND DATA TYPE SWITCH -
C       =    0  PROCESS WIND INFO FOR THIS TYPE
C       = 9999  EXCLUDE WIND INFO FOR THIS TYPE
C                         (DEF - JSURFW(12)/2*0,9999,0,9999,0,9999,5*0/)
C    npkrpt - logical flag denoting whether or not to process surface
C              reports in the following situations:
C                1) non-mesonet land reports with a missing station
C                   pressure observation, a missing sea-level pressure
C                   observation, and pfralt=F;
C                2) non-mesonet land reports with a missing station
C                   pressure observation, a missing sea-level pressure
C                   observation, and a missing altimeter setting when
C                   pfralt=T;
C                3) marine reports with a missing station pressure
C                   observation and a missing sea-level pressure
C                   observation
C                4) marine reports with a missing station pressure
C                   observation a reported missing sea-level pressure
C                   observation and an elevation > 7.5 meters
C       =   .TRUE.   process the surface report in one of the above
C                    situations, store pstn estimated from reported
C                    info and possibly U.S. Std. Atmos., and give
C                    report a new report type (more on that later)
C       =   .FALSE.  toss the surface report in one of the above
C                    situations
C                         -- or --
C             logical flag denoting how to process surface mesonet
C              reports with a missing station pressure observation and
C              a missing altimeter setting (note: all mesonets have a
C              a missing sea-level pressure observation, and all have
C              hardwired pfralt=T)
C       =   .TRUE.   process the surface mesonet report, store pstn
C                    estimated from reported info and possibly U.S.
C                    Std. Atmos, and give report a new report type
C                    (more on that later)
C       =   .FALSE.  process the surface mesonet report, store pstn
C                    estimated from reported info and possibly U.S.
C                    Std. Atmos., and set character 8 of the stnid to
C                    "x" (instead of the usual blank) (these reports
C                    remain report type 188/288)
C                                        (def - npkrpt(12)/12*.false./)
C {NOTE: PMSL BOGUS (BOTH) & SPL-LVL REPORTS NEVER PROCESS A WIND PART)
CC
C    PFRALT - FOR NON-MESONET SURFACE LAND (ONLY) REPORTS WITH MISSING
C              STATION PRESSURE AND NON-MISSING ALTIMETER SETTING,
C              CALCULATE STATION PRESSURE FROM ALTIMETER AND GIVE THE
C              REPORTS A PREPBUFR REPORT TYPE OF 187/287 TO UNIQUELY
C              IDENTIFY THEM (SEE BELOW FOR INFO ON MESONET REPORTS)
C              PFRALT =.TRUE.  ---> YES
C              PFRALT =.FALSE. ---> NO                         (DEFAULT)
C             {NOTE1: THE FOLLOWING DOES NOT APPLY TO MESONET REPORTS:
C                     IN THE CASE OF PFRALT=F OR MISSING ALTIMETER
C                     SETTING, IF SURFACE LAND REPORTS HAVE MISSING
C                     STATION PRESSURE, THEN IT WILL BE ESTIMATED FROM
C                     PMSL IF ITS NON-MISSING AND ENCODED INTO PREPBUFR
C                     FILE, AND THE REPORTS WILL GET A PREPBUFR REPORT
C                     TYPE 183/284 (UNLESS ELEV IS < 7.5 M IN WHICH
C                     CASE PSTN IS SET TO PMSL AND PREPBUFR R.T. 181/
C                     281 IS ASSIGNED); IF PMSL IS ALSO MISSING, THEN
C                     ONE OF THE FOLLOWING WILL OCCUR:
C                      1) IF NPKRPT=T FOR THE SFC TYPE, PSTN IS
C                         ESTIMATED FROM U.S. STANDARD ATMOS. PMSL
C                         (1013.25 MB) AND ENCODED INTO PREPBUFR FILE,
C                         AND THE REPORTS WILL GET A PREPBUFR REPORT
C                         TYPE 192/292 IF SYNOPTIC AND PREPBUFR REPORT
C                         TYPE 193/193 IF METAR;
C                      2) IF NPKRPT=F FOR THE SFC TYPE, THE REPORT WILL
C                         BE SKIPPED}
C             (NOTE2: PFRALT=T WILL ALSO ENCODE ALTIMETER SETTING INTO
C                     PREPBUFR FILE FOR ALL SURFACE LAND REPORTS,
C                     REGARDLESS OF WHETHER OR NOT STATION PRESSURE IS
C                     MISSING - THE RUC2A HAD READ THE ALTIMETER
C                     SETTING, NOT STATION PRESSURE, FOR SURFACE LAND
C                     REPORTS - THIS IS NOT THE CASE FOR THE RAP)
C             (NOTE3: FOR MESONET REPORTS, PFRALT IS HARDWIRED TO TRUE:
C                     - IF PSTN IS NON-MISSING, IT IS ENCODED IN
C                       PREPBUFR FILE, AND CHARACTER 8 OF STNID REMAINS
C                       BLANK, THESE GET PREPBUFR REPORT TYPE 188/288;
C                     - IF PSTN IS MISSING BUT ALTIMETER SETTING IS
C                       NON-MISSING, IT IS USED TO ESTIMATE PSTN, PSTN
C                       IS ENCODED IN PREPBUFR FILE, AND CHARACTER 8 OF
C                       STNID IS SET TO 'a', THESE GET PREPBUFR REPORT
C                       TYPE 188/288;
C                     - IF BOTH PSTN AND ALTIMETER SETTING ARE MISSING,
C                       THEN ONE OF THE FOLLOWING WILL OCCUR:
C                        1) IF NPKRPT(10)=T, PSTN IS ESTIMATED FROM
C                           U.S. STANDARD ATMOS. PMSL (1013.25 MB) AND
C                           ENCODED INTO PREPBUFR FILE, THESE GET
C                           PREPBUFR REPORT TYPE 195/295;
C                        2) IF NPKRPT(10)=F, THE U.S. STANDARD
C                           ATMOSPHERE IS USED TO ESTIMATE PSTN, PSTN
C                           IS ENCODED INTO PREPBUFR WITH THIS VALUE,
C                           AND CHARACTER 8 OF STNID IS SET TO 'x',
C                           THESE GET PREPBUFR REPORT TYPE 188/288;
C                     NOTE THAT PMSL IS ALWAYS MISSING FOR MESONET
C                     REPORTS.)
CC
C  N O T E --  THE FOLLOWING DEFINES AN LFM GRID (POLAR STEREOGRAPHIC)
C               WHICH IS USED TO 'THIN' VOLUME OF SURFACE DATA PREPARED
C                 LFMAXI=0 TURNS OFF THE THINNING TESTS
C               THINNING MEANS FLAGGING ALL VARIABLES WITH
C                 PREPBUFR TABLE VALUE = 15
CC
C    LFMAXI - I DIMENSION OF LFM GRID                       (DEFAULT=53)
C    LFMAXJ - J DIMENSION OF LFM GRID                       (DEFAULT=45)
C    FMESHL - MESH LENGTH IN KM AT 60N                   (DEFAULT=190.5)
C    FLONVT - REFERENCE LONGITUDE((+W) OF LFM GRID        (DEFAULT=105.)
C    FPOLEI - I INDEX OF NORTH POLE                        (DEFAULT=27.)
C    FPOLEJ - J INDEX OF NORTH POLE                        (DEFAULT=49.)
CC
C  N O T E -- THE FOLLOWING (6,4) ARRAYS REFER TO 6 LATITUDE BANDS (90S
C              -70S,70S-20S,20S-0,0-20N,20N-70N,70N-90N) (1ST ELEMENT),
C              AND 4 SSM/I SATELLITE REPORT TYPES POSSIBLE (2ND ELEMENT)
C               ** THEN SECOND ELEMENT IDENTIFIED AS FOLLOWS:
C                     1 - SURFACE WIND SPEED (OVER OCEANS)
C                     2 - TOTAL COLUMN PRECIPITABLE WATER (OVER OCEANS)
C                     3 - RAIN RATE (OVER LAND AND OCEAN)
C                     4 - SEVEN-CHANNEL BRIGHTNESS TEMPERATURE
CC
C    XWINDO - TIME WINDOW (+/-) FOR SSM/I REPORTS (IN HUNDREDTHS OF AN
C             HR) - (MAX IS +/- 12 HRS) (DEFAULT - XWINDO(6,4)/24*300./)
CC
C    JPSSMI - SSM/I DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE       (DEFAULT - JPSSMI(6,4)/24*9999/)
CC
C  N O T E -- THE FOLLOWING 6-WORD ARRAYS REFER TO 6 LATITUDE BANDS
C              (90S-70S,70S-20S,20S-0,0-20N,20N-70N,70N-90N)
CC
C    JPERSD - ERS SCATTEROMETER WIND DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE          (DEFAULT - JPERSD(6)/6*9999/)
CC
C    JPQKSD - QUIKSCAT SCATTEROMETER WIND DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE          (DEFAULT - JPQKSD(6)/6*9999/)
CC
C    JPWDSD - WINDSAT SCATTEROMETER WIND DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE          (DEFAULT - JPWDSD(6)/6*9999/)
CC
C    JPASCD - ASCAT SCATTEROMETER WIND DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE          (DEFAULT - JPASCD(6)/6*9999/)
CC
C    IEWNDO(1) - EARLIEST TIME FOR ACCEPTING ERS SCATTEROMETER RPTS -
C             EXPRESSED AS NO. OF WHOLE HRS. RELATIVE TO CYCLE TIME
C             (NEGATIVE IF PRIOR TO CYCLE TIME; POSITIVE IF AFTER
C             CYCLE TIME) (E.G., IF CYCLE HR = 00Z THEN IEWNDO(1) = -3
C             MEANS EARLIEST ERS SCATT. REPORT IS AT 21Z)   (DEFAULT=-3)
C    IEWNDO(2) - LATEST TIME FOR ACCEPTING ERS SCATTEROMETER RPTS -
C             EXPRESSED AS FOR IEWNDO(1) (E.G., IF CYCLE HR = 12Z
C             THEN IEWNDO(2) = 2 MEANS LATEST  ERS SCATT. REPORT IS
C             AT 14Z)                                        (DEFAULT=3)
CC
C    IQWNDO(1) - EARLIEST TIME FOR ACCEPTING QUIKSCAT SCATTEROMETER
C             RPTS - EXPRESSED AS NO. OF WHOLE HRS. RELATIVE TO CYCLE
C             TIME (NEGATIVE IF PRIOR TO CYCLE TIME; POSITIVE IF AFTER
C             CYCLE TIME) (E.G., IF CYCLE HR = 00Z THEN IQWNDO(1) = -3
C             MEANS EARLIEST QUIKSCAT SCATT. REPORT IS AT 21Z)  (DEF=-3)
C    IQWNDO(2) - LATEST TIME FOR ACCEPTING QUIKSCAT SCATTEROMETER RPTS
C             - EXPRESSED AS FOR IQWNDO(1) (E.G., IF CYCLE HR = 12Z
C             THEN IQWNDO(2) = 2 MEANS LATEST QUIKSCAT SCATT. REPORT
C             IS AT 14Z)                                     (DEFAULT=3)
CC
C    IWWNDO(1) - EARLIEST TIME FOR ACCEPTING WINDSAT SCATTEROMETER RPTS
C             - EXPRESSED AS NO. OF WHOLE HRS. RELATIVE TO CYCLE TIME
C             (NEGATIVE IF PRIOR TO CYCLE TIME; POSITIVE IF AFTER CYCLE
C             TIME) (E.G., IF CYCLE HR = 00Z THEN IWWNDO(1) = -3 MEANS
C             EARLIEST WINDSAT SCATT. REPORT IS AT 21Z)     (DEFAULT=-3)
C    IWWNDO(2) - LATEST TIME FOR ACCEPTING WINDSAT SCATTEROMETER RPTS -
C             EXPRESSED AS FOR IWWNDO(1) (E.G., IF CYCLE HR = 12Z THEN
C             IWWNDO(2) = 2 MEANS LATEST  WINDSAT SCATT. REPORT IS AT
C             14Z)                                           (DEFAULT=3)
CC
C    IAWNDO(1) - EARLIEST TIME FOR ACCEPTING ASCAT SCATTEROMETER RPTS -
C             EXPRESSED AS NO. OF WHOLE HRS. RELATIVE TO CYCLE TIME
C             (NEGATIVE IF PRIOR TO CYCLE TIME; POSITIVE IF AFTER CYCLE
C             TIME) (E.G., IF CYCLE HR = 00Z THEN IAWNDO(1) = -3
C             MEANS EARLIEST ASCAT SCATTEROMETER RPT IS AT 21Z  (DEF=-3)
C    IAWNDO(2) - LATEST TIME FOR ACCEPTING ASCAT SCATTEROMETER RPTS -
C             EXPRESSED AS FOR IAWNDO(1) (E.G., IF CYCLE HR = 12Z THEN
C             IAWNDO(2) = 2 MEANS LATEST ASCAT SCATTEROMETER REPORT
C             IS AT 14Z)                                     (DEFAULT=3)
CC
C  N O T E -- THE FOLLOWING 6-WORD ARRAYS REFER TO 6 LATITUDE BANDS
C              (90S-70S,70S-20S,20S-0,0-20N,20N-70N,70N-90N)
CC
C    JPGPSD - GPS-IPW/TZD DATA TYPE SWITCH -
C       =    0  PROCESS THIS TYPE
C       = 9999  EXCLUDE THIS TYPE          (DEFAULT - JPGPSD(6)/6*9999/)
CC
C    GWINDO - TIME WINDOW (+/-) FOR GPS-IPW/TZD REPORTS (IN HUNDREDTHS
C              OF AN HR) - (MAX IS +/- 12 HRS)            (DEFAULT=300.)
C    SKGP45 - SKIP ALL GPS-IPW REPORTS WITH REPORT TIME MINUTES GREATER
C             THAN 30 (xx:45 REPORTS CONSIDERED TO BE OF POORER QUALITY
C             THAN xx:15 REPORTS)
C             --> This applies ONLY to older GSD-supplied GPS-IPW rpts
C                 (i.e., in subset NC012003 of "gpsipw" dump file)
C              SKGP45 =.TRUE.  ---> YES                        (DEFAULT)
C              SKGP45 =.FALSE. ---> NO
C    SKGNSS - LOGICAL SWITCH TO CONTROL SKIPPING OF Ground-based global
C             Navigation Satellite System (GNSS) REPORTS THAT ARE FROM
C             PROVIDERS OTHER THAN U.S. BASED Earth Networks, Inc. (ENI)
C             (currently determined by characters 5-8 of report id)
C             --> This applies ONLY to newer WMO BUFR GPS-IPW/ZTD rpts
C                 (i.e., in subset NC012004 of "gpsipw" dump file)
C              SKGNSS =.TRUE.  ---> ENABLE RPT SKIPPING        (DEFAULT)
C              SKGNSS =.FALSE. ---> DISABLE RPT SKIPPING
CC
C GET LIMITS FOR EXTRACTING NON-SAT. UPPER-AIR DATA IN CAT 1-5:
C    (SEE SWITCH "KTOP" FOR SATELLITE RETRIEVAL LIMITS)
CC
C    LEVPM  - INDEX CORRESP. TO UPPER LIMITING MAND. PRESSURE LEVEL FOR
C              PROCESSING MAND-LVL (CAT.1), SIG-LVL (CAT.3/SPEC.-LVL),
C              TEMP-BY-HGT (CAT.15) AND WNDS-BY-HGT (CAT.4/11) U-AIR
C              DATA {DATA ON ALL LVLS ON & BELOW PMAND(LEVPM) ARE
C              PROCESSED}  (DEFAULT=16,10MB) -- THE MAXIMUM VALUE IS 21
C              (CORRESPONDING TO 1.0 MB)
C              {NOTE: DOES NOT APPLY TO MOISTURE - SEE SWITCH LEVQQ;
C               FOR CAT.4/11 AND 15 DATA, ALL LVLS ON & BELOW STANDARD
C               ATMOSPHERE HEIGHT CORRESPONDING TO PMAND(LEVPM) ARE
C               PROCESSED}
C    LEVST  - INDEX CORRESP. TO UPPER LIMITING MAND. PRESSURE LEVEL FOR
C              PROCESSING SIG-LVL (CAT.2/5) U-AIR DATA {DATA ON ALL LVLS
C              ON & BELOW PMAND(LEVST) ARE PROCESSED}  (DEFAULT=13,50MB)
C              -- THE MAXIMUM VALUE IS 21 (CORRESPONDING TO 1.0 MB)
C              (NOTE: DOES NOT APPLY TO MOISTURE - SEE SWITCH LEVQQ)
C    LEVQQ  - INDEX CORRESP. TO UPPER LIMITING MAND. PRESSURE LEVEL FOR
C              PROCESSING MAND- & SIG-LVL U-AIR MOIST. DATA {DATA ON ALL
C              LVLS ON & BELOW PMAND(LEVQQ) ARE PROCESSED} (DEF=8,250MB)
C              -- THE MAXIMUM VALUE IS 21 (CORRESPONDING TO 1.0 MB)
CC
C    MODPRT - CONTROLS FREQ. OF RPT STD. O-PUT (UNIT 6) PRT- MUST BE A
C               MULT. OF 4 {WHEN MODPRT=N, EVERY N'TH U-AIR RPT OR SAT.
C               RAD/RETR RPT IS PRINTED FOR EACH CAT. IN THE MERGING
C               PROCESS; EVERY N/4'TH FILLED REPORT IN "MOBS" ARRAY
C               (FOR ALL DATA) IS PRINTED}
C              MODPRT < 0 ---> NO REPORTS ARE PRINTED      (DEFAULT=500)
C
C    IPRINT - CONTROLS AMOUNT OF STANDARD OUTPUT (UNIT 6) PRINT -
C               MAINLY FOR PRINT RELATED TO REPORTS THAT HAVE BEEN
C               TOSSED OR FULLY FLAGGED
C              IPRINT   =  0 ----> FULL PRINTOUT               (DEFAULT)
C              IPRINT .NE. 0 ----> LIMITED PRINTOUT
C
C    STNPRT - C*8 3-WORD ARRAY HOLDING SPECIFIC STN. IDS FOR DETAILED
C              STD. O-PUT (UNIT 6) PRINT DURING MERGING OF CAT. -- WILL
C              ALSO PRINT EVERYTHING PRINTED WHEN 'MODPRT' ABOVE IS
C              INVOKED -- LIMIT OF THREE STATIONS AND ALL MUST BE OF THE
C              ADPUPA OR SAT. RAD/RETR TYPE(DEF-STNPRT(3)/3*'        '/)
CC
CC
C   ***** VARIABLES IN NAMELIST PARM  READ IN MAIN PROGRAM *****
CC
CC
C    IUNIT  - 28-WORD ARRAY HOLDING UNIT NUMBERS AND SWITCHES ....
C       IUNIT(1)  - UNIT NUMBER FOR CENTER (CYCLE) DATE FILE
C       IUNIT(2)  - UNIT NUMBER OF FIRST FILE IN BUFR TABLE FILE GROUP
C       IUNIT(3)  - UNIT NUMBER OF FIRST FILE IN FIXED FIELD FILE GROUP
C       IUNIT(4)  - UNIT NUMBER OF FIRST FILE IN BACKGROUND FILE GROUP
C       IUNIT(5)  - UNIT NUMBER OF FIRST FILE IN UPPER-AIR FILE GROUP
C       IUNIT(6)  - UNIT NUMBER OF FIRST FILE IN SURFACE FILE GROUP
C       IUNIT(7)  - UNIT NUMBER OF FIRST FILE IN POLAR-ORBITING
C                    SATELLITE SOUNDING FILE GROUP
C       IUNIT(8)  - UNIT NUMBER OF FIRST FILE IN GOES SATELLITE
C                    SOUNDING FILE GROUP
C       IUNIT(9)  - UNIT NUMBER OF FIRST FILE IN OTHER SATELLITE FILE
C                    GROUP
C       IUNIT(10)\
C         TO     -> CURRENTLY NOT USED
C       IUNIT(15)/
C       IUNIT(16) - UNIT NUMBER OF OUTPUT PREPBUFR FILE
C       IUNIT(17) - UNIT NUMBER OF OUTPUT "PREVENT" EVENTS DATA
C                    FILTERING SUMMARY PRINT FILE
C       IUNIT(18)\
C         TO     -> CURRENTLY NOT USED
C       IUNIT(28)/
C
C           (DEFAULT - IUNIT/11,12,15,18,21,31,41,46,48,6*0,51,52,11*0/)
CC
CC
C *** VARIABLES IN NAMELIST PREVDATA READ IN W3EMC ROUTINE GBLEVENTS ***
CC
CC
C         ---> See Docblock in W3EMC Routine GBLEVENTS
CC
C***********************************************************************
CCCCC

C----------------------------------------------------------------------
C     REPORT (SINGLE MASS/WIND PIECE) HEADER IS STORED IN ARRAY "HDR"
C                   (NOTE: THIS APPLIES TO ALL REPORTS)
C----------------------------------------------------------------------
C
C         C O N T E N T S   O F   T H E   A R R A Y   H D R
C                     HDR HOLDS UP TO "MXWRDH" WORDS
C                      (CURRENTLY MXWRDH SET TO 15)
C
C        HDR(1)   = STATION IDENTIFICATION (CHARACTER)
C        HDR(2)   = LONGITUDE(DEGREES) EAST (0.00 TO 359.99)
C                   passed through this code as ALON_8 only if OBS8_8(2)
C                   (see below) is missing
C        HDR(3)   = LATITUDE (DEGREES) N+ (RANGE -90.00 TO 90.00)
C                   passed through this code as ALAT_8 only if OBS8_8(1)
C                   (see below) is missing
C        HDR(4)   = DELTA OBS. TIME (OBS. TIME - CYCLE TIME, HRS)
C        HDR(5)   = RECEIPT TIME (HRS)
C        HDR(6)   = PREPBUFR REPORT TYPE -- SEE "ITYPE" BELOW
C        HDR(7)   = DUMP REPORT TYPE
C        HDR(8)   = REPORT SUB-TYPE (VALUE DEPENDS ON TYPE OF REPORT,
C                    SEE COMMENTS WITHIN CODE)
C        HDR(9)   = FOR ALL TYPES COMING FROM IW3UNPBF -
C                        INSTRUMENT TYPE
C                   FOR GOES SOUNDINGS COMING FROM W3UNPKB7 -
C                        PROCESSING TECHNIQUE
C                   FOR ALL OTHER TYPES - NOT USED (MISSING)
C        HDR(10)  = ELEVATION (METERS)
C        HDR(11)  = REPORT SEQUENCE NUMBER (NUMERIC)
C        HDR(12)  = SOLAR AND INFRARED RADIATION CORRECTION INDICATOR
C                   (SEE BUFR C.T. 0-02-013, APPLIES ONLY TO "ADPUPA"
C                   TYPES WITH A VALID INSTRUMENT TYPE)
C        HDR(13)  = REPORTED OBSERVATION TIME (HRS)
C        HDR(14)  = INDICATOR FOR OBSERVATION TIME IN "HDR(4)"
C                   CALCULATION: (=0 - REPORTED; =1 - CORRECTED FROM
C                   REPORTED LAUNCH TIME; =2 - CORRECTED EVEN THOUGH
C                   LAUNCH TIME IS MISSING)
C        HDR(15)  = SATELLITE ID (SEE BUFR C.T. 0-01-007, APPLIES
C                   ONLY TO SATELLITE DATA TYPES)
C
C      MISSING PARAMETERS SET TO XMISS (99999.), EXCEPT FOR HDR(11)
C      WHICH IS SET TO XMISS*10. (999990.)
C      ITYPE = (KI * 100) + (NI * 10) + JI
C        WHERE, KI = OBSERVATION  TYPE (1 FOR MASS, 2 FOR WINDS)
C               NI = INSTRUMENT
C               JI = SUBSET OF INSTRUMENT
C
C----------------------------------------------------------------------
C  ADDITONAL REPORT (SINGLE MASS/WIND PIECE) HEADER INFORMATION
C                       IS STORED IN ARRAY "OBS8_8"
C  (NOTE: THIS APPLIES TO ALL REPORTS COMING FROM IW3UNPBF OR W3UNPKB7)
C----------------------------------------------------------------------
C
C       C O N T E N T S   O F   T H E   A R R A Y   O B S 8 _ 8
C                               OBS8_8(2)
C
C        OBS8_8(1)   = REAL*8 LATITIUDE DEGREES)  N+ (RANGE -90. TO 90.)
C        OBS8_8(2)   = REAL*8 LONGITUDE (DEGREES) E+ (RANGE -179.99999
C                                                              TO +180.)
C
C     OBS8_8(1) passed through this code as ALAT_8 (REAL*8)
C     OBS8_8(2) passed through this code as ALON_8 (REAL*8)
C       {ALON_8 redefined as degrees East (0.00 TO 359.99999)}
C
C----------------------------------------------------------------------
C       SINGLE "LEVEL" REPORT (SINGLE MASS/WIND PIECE) INFORMATION
C           STORED DIRECTLY FROM BUFR IS STORED IN ARRAY "OBS2"
C         (NOTE: THIS APPLIES TO ALL REPORTS COMING FROM IW3UNPBF)
C----------------------------------------------------------------------
C
C         C O N T E N T S   O F   T H E   A R R A Y   O B S 2
C                     OBS2 HOLDS UP TO "NUMOBS2" WORDS
C                       (CURRENTLY NUMOBS2 SET TO 43)
C
C        OBS2(1)  = RESTRICTIONS ON REDISTRIBUTION (BUFR F.T. 0-35-200)
C        OBS2(2)  = EXPIRATION OF RESTRICTIONS ON REDISTRIBUTION (HR)
C        OBS2(3)  = ALTIMETER SETTING (PASCALS)
C        OBS2(4)  = SEA-SURFACE TEMPERATURE (KELVIN)
C        OBS2(5)  = DEPTH AT WHICH SEA-SURFACE TEMPERATURE MEASURED (M)
C        OBS2(6)  = METHOD OF SEA SURFACE TEMPERATURE MEASUREMENT
C                   (BUFR C.T. 0-02-038)
C        OBS2(7)  = RELATIONSHIP TO HORIZONTAL VISIBILITY
C                   (BUFR C.T. 0-08-201)
C        OBS2(8)  = HORIZONTAL VISIBILITY (M)
C        OBS2(9)  = VERTICAL VISIBILITY (M)
C        OBS2(10) = PAST WEATHER - 1 (BUFR C.T. 0-20-004)
C        OBS2(11) = PAST WEATHER - 2 (BUFR C.T. 0-20-005)
C        OBS2(12) = PEAK WIND SPEED (M/SEC)
C        OBS2(13) = PEAK WIND DIRECTION (DEGREES)
C        OBS2(14) = DURATION OF TIME FOR MAX. WIND SPEED (GUST) (MIN)
C        OBS2(15) = MAXIMUM WIND SPEED (GUST) (M/SEC)
C        OBS2(16) = MAXIMUM WIND GUST DIRECTION (DEGREES)
C        OBS2(17) = TOTAL PRECIPITATION PAST  1-HR (KG/M**2)
C        OBS2(18) = TOTAL PRECIPITATION PAST  3-HR (KG/M**2)
C        OBS2(19) = TOTAL PRECIPITATION PAST  6-HR (KG/M**2)
C        OBS2(20) = TOTAL PRECIPITATION PAST 12-HR (KG/M**2)
C        OBS2(21) = TOTAL PRECIPITATION PAST 24-HR (KG/M**2)
C        OBS2(22) = TOTAL SUNSHINE (MIN)
C        OBS2(23) = TOTAL CLOUD COVER (%)
C        OBS2(24) = HEIGHT ABOVE SURFACE OF BASE OF LOWEST CLOUD SEEN
C                   (BUFR C.T. 0-20-201)
C        OBS2(25) = 10 METER EXTRAPOLATED WIND SPEED (M/SEC)
C        OBS2(26) = 20 METER EXTRAPOLATED WIND SPEED (M/SEC)
C        OBS2(27) = SURFACE WIND DIRECTION (DEGREES)
C        OBS2(28) = SURFACE WIND SPEED (M/SEC)
C        OBS2(29) = DURATION OF TIME FOR DEPTH OF FRESH SNOW (HR)
C        OBS2(30) = DEPTH OF FRESH SNOW (M)
C        OBS2(31) = TOTAL SNOW DEPTH (M)
C        OBS2(32) = HEIGHT OF WAVES (M)
C        OBS2(33) = PERIOD OF WAVES (SEC)
C        OBS2(34) = HEIGHT OF WIND WAVES (M)
C        OBS2(35) = PERIOD OF WIND WAVES (SEC)
C        OBS2(36) = TRUE DIRECTION OF SHIP PAST 3-HRS
C                   (BUFR C.T. 0-01-193)
C        OBS2(37) = AVG SPEED OF SHIP PAST 3-HRS (BUFR C.T. 0-01-200)
C        OBS2(38) = CHARACTERISTIC OF PRESSURE TENDENCY
C                   (BUFR C.T. 0-10-063)
C        OBS2(39) = 03-HOUR PRESSURE CHANGE (PASCALS)
C        OBS2(40) = 24-HOUR PRESSURE CHANGE (PASCALS)
C        OBS2(41) = SEA-SURFACE TEMPERATURE TABLE VALUE (Q.M.)
C                   (BUFR C.T. 0-22-246)
C        OBS2(42) = MOISTURE QUALITY (BUFR C.T. 0-33-026)
C        OBS2(43) = SATELLITE ZENITH ANGLE (DEGREES)
C
C----------------------------------------------------------------------
C  ADDITONAL SINGLE "LEVEL" REPORT (SINGLE MASS/WIND PIECE) INFORMATION
C          STORED DIRECTLY FROM BUFR IS STORED IN ARRAY "RDATA2"
C         (NOTE: THIS APPLIES TO ALL REPORTS COMING FROM W3UNPKB7)
C----------------------------------------------------------------------
C
C       C O N T E N T S   O F   T H E   A R R A Y   R D A T A 2
C                               RDATA2(25)
C
C        RDATA2(1)  = TIME SIGNIFICANCE (BUFR C.T. 0-08-021)
C        RDATA2(2)  = TOTAL NUMBER (WITH RESPECT TO ACCUMULATION OR
C                     AVERAGE) (i.e., F-O-V number for GOES sounding/
C                     radiance; # of orig. reports used to generate
C                     superob for QuikSCAT, WindSAT and ASCAT - for
C                     non-superobs, hardwired to 1) (NUMERIC)
C        RDATA2(3)  = ACROSS-SWATH CELL NUMBER (NUMERIC)
C        RDATA2(4)  = ALONG-TRACK ROW NUMBER (NUMERIC)
C        RDATA2(5)  = WIND PROFILER SUBMODE INFORMATION (Note: Submode
C                     is missing after 5/2002 (no longer available)
C                     (BUFR C.T. 0-25-033)
C        RDATA2(6)  = TIME PERIOD OR DISPLACEMENT (i.e., AVERAGING
C                     TIME) (Note: A negative number means prior to
C                     observation time (MINUTE)
C        RDATA2(7)  = QUALITY INFORMATION (BUFR C.T. 0-33-002)
C        RDATA2(8)  = SEAWINDS PROBABILITY OF RAIN (NUMERIC)
C        RDATA2(9)  = SEA SURFACE TEMPERATURE (KELVIN)
C        RDATA2(10) = TOTAL WATER VAPOR (KG/M**2)
C        RDATA2(11) = TOTAL CLOUD LIQUID WATER (KG/M**2)
C        RDATA2(12) = WINDSAT SURFACE TYPE (BUFR C.T. 0-20-219)
C        RDATA2(13) = MODEL WIND DIRECTION AT 10 METERS (DEGREES)
C        RDATA2(14) = MODEL WIND SPEED AT 10 METERS  (M/SEC)
C        RDATA2(15) = WINDSAT EDR Q.C. FLAG # 1 (BUFR F.T. 0-33-200)
C        RDATA2(16) = CHI-SQUARED (OF THE WIND VECTOR RETRIEVAL)
C                     (NUMERIC)
C        RDATA2(17) = ESTIMATED ERROR COVARIANCE FOR WIND DIRECTION
C                     RETRIEVAL (DEGREES)
C        RDATA2(18) = ESTIMATED ERROR COVARIANCE FOR WIND (M/SEC)
C        RDATA2(19) = ESTIMATED ERROR COVARIANCE FOR SEA SURFACE
C                     TEMPERATURE RETRIEVAL (KELVIN)
C        RDATA2(20) = ESTIMATED ERROR COVARIANCE FOR TOTAL CLOUD LIQUID
C                     WATER RETRIEVAL (KG/M**2)
C        RDATA2(21) = ESTIMATED ERROR COVARIANCE FOR TOTAL WATER VAPOR
C                     RETRIEVAL (KG/M**2)
C        RDATA2(22) = WIND VECTOR CELL QUALITY (BUFR F.T. 0-21-155)
C        RDATA2(23) = BACKSCATTER DISTANCE (NUMERIC)
C        RDATA2(24) = LIKELIHOOD COMPUTED FOR SOLUTION (NUMERIC)
C        RDATA2(25) = TOTAL CLOUD COVER (PERCENT)
C
C----------------------------------------------------------------------
C       MULTI-"LEVEL" REPORT (SINGLE MASS/WIND PIECE) INFORMATION
C           STORED DIRECTLY FROM BUFR IS STORED IN ARRAY "OBS3"
C         (NOTE: THIS APPLIES TO ALL REPORTS COMING FROM IW3UNPBF)
C----------------------------------------------------------------------
C
C  C O N T E N T S   O F   T H E   A R R A Y S   O B S 3  &  N O B S 3
C                              OBS3(5,MXBLVL,7)
C                                NOBS3(7)
C
C
C        OBS3(1,A,1) = DURATION OF TIME FOR TOTAL PRECIPITATION
C                      MEASURMENT (HR)
C        OBS3(2,A,1) = TOTAL PRECIPITATION MEASUREMENT (KG/M**2)
C        {WHERE A RANGES FROM 1 TO NOBS3(1), THE NUMBER OF "LEVELS"}
C
C        OBS3(1,B,2) = PRESENT WEATHER (BUFR C.T. 0-20-003)
C        {WHERE B RANGES FROM 1 TO NOBS3(2), THE NUMBER OF "LEVELS"}
C
C        OBS3(1,C,3) = VERTICAL SIGNIFICANCE (SURFACE OBSERVATION)
C                      (BUFR C.T. 0-08-002)
C        OBS3(2,C,3) = CLOUD AMOUNT (BUFR C.T. 0-20-011)
C        OBS3(3,C,3) = CLOUD TYPE (BUFR C.T. 0-20-012)
C        OBS3(4,C,3) = HEIGHT OF BASE OF CLOUD (M)
C        OBS3(5,C,3) = HEIGHT OF TOP OF CLOUD (M)
C        {WHERE C RANGES FROM 1 TO NOBS3(3), THE NUMBER OF "LEVELS"}
C
C        OBS3(1,D,4) = DURATION OF TIME FOR MAXIMUM TEMPERATURE (HR)
C        OBS3(2,D,4) = MAXIMUM TEMPERATURE (K)
C        OBS3(3,D,4) = DURATION OF TIME FOR MINIMUM TEMPERATURE (HR)
C        OBS3(4,D,4) = MINIMUM TEMPERATURE (K)
C        {WHERE D RANGES FROM 1 TO NOBS3(4), THE NUMBER OF "LEVELS"}
C
C        OBS3(1,E,5) = DIRECTION OF SWELL WAVES (DEGREES)
C        OBS3(2,E,5) = HEIGHT OF SWELL WAVES (M)
C        OBS3(3,E,5) = PERIOD OF SWELL WAVES (SEC)
C        {WHERE E RANGES FROM 1 TO NOBS3(5), THE NUMBER OF "LEVELS"}
C
C        OBS3(1,F,6) = AIRFRAME ICING (BUFR C.T. 0-20-041)
C        OBS3(2,F,6) = HEIGHT OF BASE OF ICING (M)
C        OBS3(3,F,6) = HEIGHT OF TOP OF ICING (M)
C        {WHERE F RANGES FROM 1 TO NOBS3(6), THE NUMBER OF "LEVELS"}
C
C        OBS3(1,G,7) = DEGREE OF TURBULENCE (BUFR C.T. 0-11-031)
C        OBS3(2,G,7) = HEIGHT OF BASE OF TURBULENCE (M)
C        OBS3(3,G,7) = HEIGHT OF TOP OF TURBULENCE (M)
C        {WHERE G RANGES FROM 1 TO NOBS3(7), THE NUMBER OF "LEVELS"}
C
C----------------------------------------------------------------------
C            REPORT (MASS/WIND PIECE) DATA ARE STORED IN ARRAYS
C  "ICAT", "MOBS", "IPMSL", "PWAT", "GRAD", "RTRAD", "SRAD", "REQV"
C                             AND "CLTOP"
C----------------------------------------------------------------------
C
C         C O N T E N T S   O F   T H E   A R R A Y   I C A T
C                         (DATA LEVEL CATEGORY -
C       CURRENTLY APPLIES ONLY TO RAOB, PIBAL, RECCO, DROPS, CLASS,
C    PROFILER, VAD, RASS, SATELLITE SOUNDINGS, SATWINDS, AND AIRCRAFT.)
C
C                              ICAT(MXLVL)
C
C          WHERE MXLVL  = MAX NUMBER OF LEVELS
C                   CURRENTLY = 600 (BOTTOM TO TOP)
C
C                      POSSIBLE VALUES FOR ICAT:
C
C    =  0 SURFACE LEVEL (APPLIES ONLY TO MASS REPORTS OF THE FOLLOWING
C         TYPE: RAOB, PIBAL, MULTI-LEVEL RECCO, DROPS, CLASS, RASS,
C         AND SATELLITE SOUNDINGS)
C    =  1 MANDATORY LEVEL
C    =  2 SIGNIFICANT TEMPERATURE LEVEL (MASS ONLY)
C    =  3 WINDS-BY-PRESSURE LEVEL (WIND ONLY)
C    =  4 WINDS-BY-HEIGHT LEVEL (WIND ONLY)
C    =  5 TROPOPAUSE LEVEL
C    =  6 SINGLE LEVEL (INCLUDING ALL AIRCRAFT TYPES, AND ALL SATELLITE
C         WIND TYPES)
C    =  7 AUXILIARY LEVEL (SPECIAL INTERPOLATED LEVELS - APPLIES ONLY TO
C         RAOB, PIBAL, DROPWINSONDE, CLASS, PROFILER, SATELLITE
C         SOUNDINGS AND ONLY FOR SPCIAL=TRUE)
C    = 15 TEMPERATURES-BY-HEIGHT (PERTAINS ONLY TO RASS DATA)
C
C
C         C O N T E N T S   O F   T H E   A R R A Y   M O B S
C           (REPORT LEVEL DATA FOR A SINGLE MASS/WIND PIECE)
C
C                        MOBS(MXTYPV,MXWRDL,MXLVL)
C
C          WHERE MXTYPV = MAX NUMBER OF "GROUPS" ASSIGNED TO A
C                         VARIABLE ON AN MOBS REPORT LEVEL
C          CURRENTLY = 3 {1 - OBSERVATION;
C                         2 - PREPBUFR TABLE VALUE (QUALITY MARKER
C                            UNLESS OTHERWISE INDICATED BELOW;
C                         3 - REASON CODE}
C
C          WHERE MXWRDL = MAX NUMBER OF VARIABLES (AS GROUPED ABOVE)
C                         ON AN MOBS REPORT LEVEL
C          CURRENTLY = 6 (AS INDICATED BELOW)
C
C          WHERE MXLVL  = MAX NUMBER OF LEVELS FOR AN MOBS REPORT
C          CURRENTLY = 600 (BOTTOM TO TOP)
C
C      {IN ALL CASES, MISSING/NOT USED IS INITIALIZED AS IMISS (99999)}
C
C     MXWRD = 1 --> MASS AND WIND: PRESSURE (OBS. UNITS: MB * 10)
C                   (NOTE1: THIS IS STATION PRESSURE FOR SFC REPORTS)
C                   (NOTE2: FOR ALL TYPES EXCEPT CAT. 4/11 AND 15
C                           UPPER-AIR AND CAT. 6 SINGLE-LEVEL DATA, THE
C                           PREPBUFR TABLE VALUE IS THE VERTICAL
C                           COORDINATE INDICATOR MARK)
C     MXWND = 2 --> MASS: GEOPOTENTIAL (FOR ACFT FLIGHT-LEVEL,THIS IS
C                         PRESSURE ALTITUDE) (OBS. UNITS: METERS);
C                   WIND: PRESSURE-ALTITUDE (OBS. UNITS: METERS)
C                         (NOTE: APPLIES ONLY TO CAT. 4/11, CAT. 15 OR
C                                CAT. 6 WIND LEVELS, FOR ALL OTHERS
C                                THIS IS MISSING; ALSO FOR THESE TYPES,
C                                THE PREPBUFR TABLE VALUE IS THE
C                                VERTICAL COORDINATE INDICATOR MARK)
C     MXWRD = 3 --> MASS: "REPORTED" TEMPERATURE (FOR RTOVS OR ATOVS
C                         VIRT., FOR ALL OTHERS SENSIBLE) (OBS. UNITS:
C                         DEGREES C * 100);
C                   WIND: U-COMP (OBS. UNITS: M/SEC * 100)
C     MXWRD = 4 --> MASS: SPECIFIC HUMIDITY (OBS. UNITS: G/KG * 10**3);
C                   WIND: V-COMP (OBS. UNITS: M/SEC * 100)
C     MXWRD = 5 --> MASS: VIRTUAL TEMP (OBS. UNITS: DEGREES C * 100);
C                   WIND: DIRECTION (OBS. UNITS: DEGREES)
C     MXWRD = 6 --> MASS: DEWPOINT TEMP (OBS. UNITS: DEGREES C * 100);
C                   WIND: SPEED (OBS. UNITS: KNOTS FOR ALL TYPES
C                         EXCEPT SURFACE, OTHERWISE FOR SURFACE (ALL
C                         TYPES) M/SEC * 10)
C
C
C         C O N T E N T S   O F   T H E   A R R A Y   I P M S L
C         (MEAN SEA-LEVEL PRESSURE DATA FOR A SINGLE MASS PIECE)
C
C                             IPMSL(MXTYPV)
C
C          WHERE MXTYPV = MAX NUMBER OF "GROUPS" ASSIGNED TO A
C                         VARIABLE ON AN MOBS REPORT LEVEL
C          CURRENTLY = 3 {1 - PMSL OBSERVATION (UNITS: MB * 10);
C                         2 - PREPBUFR TABLE VALUE (QUALITY MARKER)
C                         3 - REASON CODE}
C
C      {IN ALL CASES, MISSING/NOT USED IS INITIALIZED AS IMISS (99999)}
C
C
C          C O N T E N T S   O F   T H E   A R R A Y   P W A T
C          (PRECIPITABLE WATER REPORT DATA FOR A SINGLE MASS PIECE)
C              (APPLIES ONLY TO GOES, SSM/I AND GPS-IPW REPORTS)
C
C                         PWAT(MXTYPV,MXPWT)
C
C          WHERE MXTYPV = MAX NUMBER OF "GROUPS" ASSIGNED TO A
C                         VARIABLE ON AN MOBS REPORT LEVEL
C          CURRENTLY = 3 {1 - PWATER OBSERVATION (UNITS: MM, WITH
C                             PRECISION TO NEAREST 10'TH MM)
C                         2 - PREPBUFR TABLE VALUE (QUALITY MARKER)
C                         3 - REASON CODE}
C
C          WHERE MXPWT  = INDICATOR OF TYPE (COLUMNAR EXTENT) OF
C                         PRECIPITABLE WATER OBSERVATION
C          CURRENTLY = 5 (AS INDICATED BELOW)
C
C     {IN ALL CASES, MISSING/NOT USED IS INITIALIZED AS XMISS (99999.)}
C
C                MXPWT = 1 --> TOTAL COLUMN
C                MXPWT = 2 --> 1.0 TO 0.9 SIGMA LAYER
C                MXPWT = 3 --> 0.9 TO 0.7 SIGMA LAYER
C                MXPWT = 4 --> 0.7 TO 0.3 SIGMA LAYER
C                MXPWT = 5 --> 0.3 TO 0.0 SIGMA LAYER
C
C
C         C O N T E N T S   O F   T H E   A R R A Y   G R A D
C          (GOES RADIANCE REPORT DATA FOR A SINGLE MASS PIECE)
C                    (APPLIES ONLY TO GOES REPORTS)
C
C                              GRAD(18)
C                    + POSSIBLE ANCILLARY DATA
C
C        GRAD - BRIGHTNESS TEMPERATURE OBSERVATION (UNITS: DEG. K);
C         (REAL NUMBER WITH PRECISION TO NEAREST 100'TH DEG. K)
C
C           {MISSING/NOT USED IS INITIALIZED AS XMISS (99999.)}
C
C
C        C O N T E N T S   O F   T H E   A R R A Y   R T R A D
C     (RTOVS OR ATOVS RADIANCE REPORT DATA FOR A SINGLE MASS PIECE)
C               (APPLIES ONLY TO RTOVS AND ATOVS REPORTS)
C
C                              RTRAD(35)
C                    + POSSIBLE ANCILLARY DATA
C
C       RTRAD - BRIGHTNESS TEMPERATURE OBSERVATION (UNITS: DEG. K);
C         (REAL NUMBER WITH PRECISION TO NEAREST 100'TH DEG. K)
C
C           {MISSING/NOT USED IS INITIALIZED AS XMISS (99999.)}
C              (32 CHANNELS FOR RTOVS, 35 CHANNELS FOR ATOVS)
C
C
C          C O N T E N T S   O F   T H E   A R R A Y   S R A D
C          (SSM/I RADIANCE REPORT DATA FOR A SINGLE MASS PIECE)
C                    (APPLIES ONLY TO SSM/I REPORTS)
C
C                              SRAD(7)
C
C        SRAD - BRIGHTNESS TEMPERATURE OBSERVATION (UNITS: DEG. K);
C         (REAL NUMBER WITH PRECISION TO NEAREST 100'TH DEG. K)
C
C           {MISSING/NOT USED IS INITIALIZED AS XMISS (99999.)}
C
C
C         C O N T E N T S   O F   T H E   A R R A Y   R E Q V
C           (RAIN RATE REPORT DATA FOR A SINGLE MASS PIECE)
C                    (APPLIES ONLY TO SSM/I REPORTS)
C                              -- OR --
C           (RAIN RATE REPORT DATA FOR A SINGLE WIND PIECE)
C                 (APPLIES ONLY TO WINDSAT REPORTS)
C
C                              REQV(1)
C
C              REQV - RAIN RATE OBSERVATION (UNITS: MM/SEC);
C   (REAL NUMBER WITH PRECISION TO NEAREST 10**6'TH MM/SEC FOR SSM/I
C                 AND TO NEAREST 10**4'TH MM/SEC FOR WINDSAT)
C
C           {MISSING/NOT USED IS INITIALIZED AS XMISS (99999.)}
C
C
C        C O N T E N T S   O F   T H E   A R R A Y   C L T O P
C          (CLOUD TOP REPORT REPORT DATA FOR A SINGLE MASS PIECE)
C                    (APPLIES ONLY TO GOES REPORTS)
C
C                            CLTOP(2,3)
C
C          WHERE FIRST ELEMENT OF ARRAY IS:
C                      1 FOR OBSERVATION
C                      2 FOR PREPBUFR TABLE VALUE (QUALITY MARKER)
C          AND SECOND ELEMENT OF ARRAY IS:
C                      1 FOR CLOUD TOP PRESSURE (OBS. IN MB PRECISE
C                         TO 10**1)
C                      2 FOR TOTAL CLOUD COVER (OBS. IN PER CENT
C                         PRECISE TO 10**0)
C                      3 FOR CLOUD TOP TEMPERATURE (OBS. IN KELVIN
C                         PRECISE TO 10**2)
C
C           {MISSING/NOT USED IS INITIALIZED AS XMISS (99999.)}
C
C
C----------------------------------------------------------------------

      PROGRAM PREPOBS_PREPDATA

C PARAMETER NAME "MXWRDH" THROUGHOUT PGM SETS MAXIMUM NO. OF VARIABLES
C  IN THE REPORT HEADER
      PARAMETER (MXWRDH = 15)

C PARAMETER NAME "MXTYPV" THROUGHOUT PGM SETS MAXIMUM NO. GROUPS THAT
C  ARE ASSIGNED TO A VARIABLE ON AN MOBS REPORT LEVEL (CURRENTLY 3 -
C  OBS, PREPBUFR TABLE VALUE, AND PREPDATA REASON CODE)
      PARAMETER (MXTYPV =  3)

C PARAMETER NAME "MXWRDL" THROUGHOUT PGM SETS MAXIMUM NO. OF OBS/Q.M./
C  R.C., ETC. VARIABLE GROUPS ON AN MOBS REPORT LEVEL
      PARAMETER (MXWRDL =  6)

C PARAMETER NAME "MXLVL"  THROUGHOUT PGM SETS MAXIMUM NO. OF LEVELS THAT
C  CAN BE PROCESSED INTO THE FOLLOWING ARRAYS: MOBS, ICAT, DAT, TMP, IQ,
C  JQ, IR, JR, VDAT, VTMP, PP, ZP, TP, DP, QP, UP, VP, VV, CLAM, CLAL,
C  AND KS
      PARAMETER (MXLVL = 600)

C PARAMETER NAME "MXPWT" THROUGHOUT PGM SETS MAXIMUM NO. OF PRECIP.
C  WATER OBS/Q.M./R.C. ETC. GROUPS (CURRENTLY 5 - TOTAL COLUMN, 1.0-0.9
C  SIGMA LAYER, 0.9-0.7 SIGMA LAYER, 0.7-0.3 SIGMA LAYER, AND 0.3-0.0
C  SIGMA LAYER)
      PARAMETER (MXPWT =  5)

C PARAMETER NAME "NUMVAR" THROUGHOUT PGM SETS NO. OF OBS. VARIABLES
C  IN THE DAT AND TMP ARRAYS (UPPER-AIR DATA)
C PARAMETER NAME "NUMQMS" THROUGHOUT PGM SETS NO. OF OBS. PREPBUFR TBL
C  VALUES IN THE IQ (EQUIV. TO DAT) & JQ (EQUIV. TO TMP) ARRAYS (U-AIR)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
C      PARAMETER (NUMVAR = 9, NUMQMS = 5)
C PARAMETER NAME "NUMDAT" THROUGHOUT PGM SETS SIZE OF DAT AND TMP ARRAYS
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
C      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS))

C PARAMETER NAME "NUMTYP" THROUGHOUT PGM SETS NO. OF POSSIBLE MASS
C  REPORT TYPES (NUMBER OF POSSIBLE WIND REPORT TYPES IS SAME AS THIS)
      PARAMETER (NUMTYP = 74)

C PARAMETER NAME "MAXOBS" THROUGHOUT PGM SETS MAX SIZE OF OBS ARRAY
C  IN INTERFACE WITH SUBROUTINE IW3UNPBF
      PARAMETER (MAXOBS = 4500)

      CHARACTER*4   c2many_lvls
      CHARACTER*5   CTYPE(2)
      CHARACTER*6   CMXLVL
      CHARACTER*8   STNPRT,STNID,SUBSET_d
      CHARACTER*10  CDAT(8)
      CHARACTER*14  NET(10)
      CHARACTER*40  NAMEW(NUMTYP),NAMEM(NUMTYP)
      LOGICAL  POLA,NORTH,RECCON,DROPSN,AIRLND,TOVEDS,GOESND,SATMST,
     $ SWNLND,MARLND,PG4243,SPCIAL,FILLZ,FILLT,FILLW,FILLM,KTEMP,TR80KM,
     $ PRFLER,TOVBFR,RECSLM,GOESPW,GOESCT,VADWIN,TOVRAD,TOVRTV,
     $ PFRALT,AIFNOW,FLDMGS,FLDMAF,FLDMFR,FLACMS,GOESRD,PREVEN,APPEND,
     $ SUBSKP,RASS,WRMISS,SKGP45,npkrpt,SKGNSS,UPRAIR
      REAL(8)  BMISS,GETBMISS,alon_8,alat_8
      INTEGER  KTYPE(NUMTYP-1),NTYPE(NUMTYP-1),JITSM(NUMTYP),
     $ JITSW(NUMTYP),IDATA(MAXOBS),IDAT(8)
      character*8   cvstr
      COMMON/WORD/LWI,LWR
      COMMON/LNDSEA/GDSH(145,37),GDUS(362,91),GDNH(362,91)
      COMMON/GRID/IGRD,JGRD,POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL,YNLIM,
     $ YSLIM
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/RUNSW/IRNMRK
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/SATSW2/PHI(6),IRTRV(5,4,4),KTOP(5,4,4),IWINDO_e(5,4,4),
     $ IWINDO_l(5,4,4),SATMST(5,4,4),ISATLS(5,4,4)
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      COMMON/ACFTSW/AWINDO(2,9),AIRLND(6,9),JAWIND(6,9),JAMASS(6,9),
     $ IACFTL(9),IACFTH(9),PHIACF(7),KEPAC(6,9),AIFNOW(9),POAF,TRBX(5),
     $ FLACMS(9),PCAT,ROLF,aMSTQ,RIALR
      COMMON/TVSWCH/TOVEDS(2),TOVBFR(2),TR80KM,KNTTOV(2),
     $ KSKPTV(2),KNOPTV(2),KIPTTV(2),KMSGTV(2),KBDYTV(2),KTIMTV(2),
     $ KLNDTV(2),KSEATV(2),KREDTV(2),KJFLAG(2)
      COMMON/GOSWCH/GOESND(2),GOESPW(2),GOESCT(2),KNTGIT,KNTGIS,KNTGIP,
     $ KSKPGI,KNDCGI,KNOPGI,KMSGGI,KBDYGI,KTIMGI(3),KLNDGI(3),KSEAGI(3),
     $ KNTGIC,KNOCTP
      COMMON/LFMSFC/LFMAXI,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,MARLND,
     $ JSURFM(12),JSURFW(12),FWINDO(12),PFRALT,npkrpt(12)
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/COUNT/KKTYPE(100:299)
      COMMON/PARM2/PG4243,KTEMP,i2many_lvls
      COMMON/PARM3/RECCON,RWINDO,UWINDO,RECSLM,FLRECO,VWINDO,VADWIN,
     $ IVADFL,IVADSP,FLDMGS,FLDMAF,FLDMFR,DROPSN,DWINDO,UPRAIR
      COMMON/PARM4/ICODE
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/SKPCNT/KSKPUA,KSKPSF,KMSGUA,KMSGSF,KBDYUA,KBDYSF,KTIMUA,
     $ KTIMSF,KSKNSW,KSKREC,KNOATS,KNTUPA,KNTCAR,KNTAIR,KNTSWN,KNTPRO,
     $ KNTVAD,KNTRAS,KNTDUM(3),KNTSFC,KNTSHP,KNTSLP,KNTMSO,KNTSPL,
     $ KSKSWN,KSKACF,KNDCDE(3),KSKCLS,KSKTHN,KSKOMR(2),KSKALM(9),
     $ KSKAHM(9),KSKNOW(9),KSKDRP
      COMMON/MISWCH/XWINDO(6,4),JPSSMI(6,4),SRAD(7),KNTSMI(4),KTIMM(4),
     $ KSKPMI,KMSGMI,KBDYMI
      COMMON/SCTWCH/IEWNDO(2),JPERSD(6),IQWNDO(2),JPQKSD(6),IWWNDO(2),
     $ JPWDSD(6),KSKPSC(4),KMSGSC(4),KBDYSC(4),KTIMSC(4),KNTSCT(4),
     $ JPASCD(6),IAWNDO(2)
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/GPSWCH/JPGPSD(6),GWINDO,KNTGPS,KSKPGP,KMSGGP,KBDYGP,KTIMGP,
     $ KMISGP,KT45GP,SKGP45,SKGNSS,KTGNSS
      COMMON/CLDTOP/CLTOP(2,3)
      COMMON/PREVSW/PREVEN
      COMMON/APDNSW/APPEND
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/PFSWCH/PRFLER(5),PWINDO(5),PROFILERinADPUPA
      COMMON/RASSSW/RASS,TWINDO
      common/pstnflg/ipstnflg
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE (RDATA,IDATA)
      DATA  IMISS/99999/
      DATA  NET/'??????????????',' AFOS GRAPHIC ','***** GFS ****',
     $          '**** RAP *****','**** GDAS ****','** NAM/NDAS **',
     $          '  CDAS-REANL  ','HRLY- GOES CLD','**** RTMA ****',
     $          '**** URMA ****'/
      DATA  CTYPE/'RTOVS','ATOVS'/
      DATA  JITSW/
     $ 202,210,220,221,222,223,224,225,226,227,228,229,230,231,232,233,
     $ 234,235,240,241,242,243,244,245,246,247,248,249,250,251,252,253,
     $ 254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,
     $ 270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,
     $ 286,287,288,289,290,291,292,293,294,295/
      DATA  NAMEW  /
                                               ! PREPBUFR REPORT TYPE
     $  '-- EMPTY --                             ',  ! 202
     $  'UAIR: SYNTHETIC TROPICAL CYCLONE WINDS  ',  ! 210
     $  'UAIR: RAWINSONDE                        ',  ! 220
     $  'UAIR: PIBAL                             ',  ! 221
     $  'UAIR: CLASS SOUNDING                    ',  ! 222
     $  'UAIR: NOAA PROFILER NETWORK (NPN) WINDS ',  ! 223
     $  'UAIR: VAD (NEXRAD)                      ',  ! 224
     $  'UAIR: NEXRAD RADIAL WINDS               ',  ! 225
     $  '-- EMPTY --                             ',  ! 226
     $  'UAIR: COOPERATIVE AGENCY PROFILERS (CAP)',  ! 227
     $  'UAIR: JAPANESE METEOR. AGENCY PROFILER  ',  ! 228
     $  'UAIR: PROFILER FROM PILOT(PIBAL) BULLS. ',  ! 229
     $  'ACFT: FLIGHT-LEVEL CNVENTNAL AIREP/PIREP',  ! 230
     $  'ACFT: FLT-LVL AMDAR, AMDARB, (K/E)AMDAR ',  ! 231
     $  'UAIR: RECONNAISSANCE OR DROPWINSONDES   ',  ! 232
     $  'ACFT: FLIGHT-LEVEL MDCRS                ',  ! 233
     $  'ACFT: FLIGHT-LEVEL TAMDAR(M/B)          ',  ! 234
     $  'ACFT: FLIGHT-LEVEL CANADIAN AMDAR       ',  ! 235
     $  '-- EMPTY --                             ',  ! 240
     $  'SATWND: INDIA  INSAT/KLPNA IR(LW)/VZ C-D',  ! 241
     $  'SATWND: JAPAN  GMS/MTST IR(LW)/VZ C-D LO',  ! 242
     $  'SATWND: EUMSAT MTEOSAT IR(LW)/VZ C-DR LO',  ! 243
     $  '-- EMPTY --                             ',  ! 244
     $  'SATWND: NESDIS GOES    H-D IR(LW) CL DFT',  ! 245
     $  'SATWND: NESDIS GOES    H-D IM WV/CL. TOP',  ! 246
     $  'SATWND: NESDIS GOES    H-D IM WV/DEEP LY',  ! 247
     $  'SATWND: NESDIS GOES    H-D SN WV/CL. TOP',  ! 248
     $  'SATWND: NESDIS GOES    H-D SN WV/DEEP LY',  ! 249
     $  'SATWND: JAPAN  GMS/MTSAT IM WV(C-T, D-L)',  ! 250
     $  'SATWND: NESDIS GOES    H-D VZ CLD-DRIFT ',  ! 251
     $  'SATWND: JAPAN  GMS/MTSAT IR(LW)/VZ CD HI',  ! 252
     $  'SATWND: EUMSAT MTEOSAT IR(LW)/VZ C-DF HI',  ! 253
     $  'SATWND: EUMSAT MTEOSAT IM WV (C-T, D-L) ',  ! 254
     $  'SATWND: NESDIS GOES    PICTURE TRIPLET  ',  ! 255
     $  'SATWND: INDIA INSAT/KALPANA IM WV(CT,DL)',  ! 256
     $  'SATWND: NASA/MODIS POES IR(LW) CL-DRFT  ',  ! 257
     $  'SATWND: NASA/MODIS POES IMGR WV/CLD. TOP',  ! 258
     $  'SATWND: NASA/MODIS POES IMGR WV/DEEP LYR',  ! 259
     $ 10*'-- EMPTY --                             ',! 260-9
     $  '* - CONSTANT-LEVEL BALLOON (PSEUDO)     ',  ! 270
     $  9*'-- EMPTY --                             ',! 271-9
     $  'SFC: MARINE (VALID STATION PRESSURE)    ',  ! 280
     $  'SFC: LAND (VALID STATION PRESSURE)      ',  ! 281
     $  'SFC: MARINE ATLAS BUOYS                 ',  ! 282
     $  'SFC: SSM-I WIND SPEED (DIR SET TO ZERO) ',  ! 283
     $  'SFC: LAND or MARINE, MISSING STN PRESS  ',  ! 284
     $  'SFC: QUIKSCAT SCATTEROMETER             ',  ! 285
     $  'SFC: ERS SCATTEROMETER                  ',  ! 286
     $  'SFC: LAND, MISSING STATION PRESSURE     ',  ! 287
     $  'SFC: MESONET (COOPERATIVE NETWORKS)     ',  ! 288
     $  'SFC: WINDSAT SCATTEROMETER              ',  ! 289
     $  'SFC: ASCAT SCATTEROMETER                ',  ! 290
     $  '-- EMPTY --                             ',  ! 291
     $  'SFC: SYNOP LAND, MSG STN AND MSL PRESS  ',  ! 292
     $  'SFC: METAR, MSG STN AND MSL PRESSURE    ',  ! 293
     $  'SFC: SHIP/CMAN/BUOY, MSG STN & MSL PRES ',  ! 294
     $  'SFC: MESONET, MSG STN AND MSL PRESS     '/  ! 295
      DATA  NAMEM  /
                                               ! PREPBUFR REPORT TYPE
     $  'SATSND: SSM-I 7-CHANNEL BRIGHTNESS TEMP.',  ! 102
     $  '-- EMPTY --                             ',  ! 110
     $  'UAIR: RAWINSONDE                        ',  ! 120
     $  '-- EMPTY --                             ',  ! 121
     $  'UAIR: CLASS SOUNDING                    ',  ! 122
     $  '-- EMPTY --                             ',  ! 123
     $  2*'-- EMPTY --                             ',! 124-5
     $  'UAIR: NPN OR CAP RASS                   ',  ! 126
     $  3*'-- EMPTY --                             ',! 127-9
     $  'ACFT: FLIGHT-LVL CNVENTNAL AIREP/PIREP  ',  ! 130
     $  'ACFT: FLT-LVL AMDAR, AMDARB, (K/E)AMDAR ',  ! 131
     $  'UAIR: RECONNAISSANCE OR DROPWINSONDES   ',  ! 132
     $  'ACFT: FLIGHT-LEVEL MDCRS                ',  ! 133
     $  'ACFT: FLIGHT-LEVEL TAMDAR(M/B)          ',  ! 134
     $  'ACFT: FLIGHT-LEVEL CANADIAN AMDAR       ',  ! 135
     $  '-- EMPTY --                             ',  ! 140
     $  'SATWND: INDIA  INSAT/KLPNA IR(LW)/VZ C-D',  ! 141
     $  'SATWND: JAPAN  GMS/MTSAT IR(LW)/VZ C-DFT',  ! 142
     $  'SATWND: EUMSAT MTEOSAT IR(LW)/VZ CL-DRFT',  ! 143
     $  'SATWND: NESDIS GOES    H-D VZ CLD-DRIFT ',  ! 144
     $  'SATWND: NESDIS GOES    H-D IR(LW) CL DFT',  ! 145
     $  'SATWND: NESDIS GOES    H-D IM WV/CL. TOP',  ! 146
     $  'SATWND: NESDIS GOES    H-D IM WV/DEEP LY',  ! 147
     $  'SATWND: NESDIS GOES    H-D SN WV/CL. TOP',  ! 148
     $  'SATWND: NESDIS GOES    H-D SN WV/DEEP LY',  ! 149
     $  'MOISTR: SSM-I RAIN RATE RETRIEVAL       ',  ! 150
     $  'SATSND: GOES CLOUD TOP RETRIEVAL        ',  ! 151
     $  'MOISTR: SSM-I PRECIP. WATER RETRIEVAL   ',  ! 152
     $  'MOISTR: GPS INTEGR. PWATR/ZENITH TOT DLY',  ! 153
     $  2*'-- EMPTY --                             ',! 154-5
     $  'MOISTR: GOES PR. WATER RETR-LAND/CLEAR  ',  ! 156
     $  'MOISTR: GOES PR. WATER RETR-LAND/CLOUDY ',  ! 157
     $  'MOISTR: GOES PR. WATER RETR-SEA/CLEAR   ',  ! 158
     $  'MOISTR: GOES PR. WATER RETR-SEA/CLOUDY  ',  ! 159
     $  '-- EMPTY --                             ',  ! 160
     $  'SATSND: RTOVS/ATOVS RAD/SNDG-LAND/CLEAR ',  ! 161
     $  '-- EMPTY --                             ',  ! 162
     $  'SATSND: RTOVS/ATOVS RAD/SNDG-LAND/CLOUDY',  ! 163
     $  'SATSND: GOES RADIANCE/SNDG-LAND/CLEAR   ',  ! 164
     $  'SATSND: GOES RADIANCE/SNDG-LAND/CLOUDY  ',  ! 165
     $  4*'-- EMPTY --                             ',! 166-9
     $  '-- EMPTY --                             ',  ! 170
     $  'SATSND: RTOVS/ATOVS RAD/SNDG-SEA/CLEAR  ',  ! 171
     $  '-- EMPTY --                             ',  ! 172
     $  'SATSND: RTOVS/ATOVS RAD/SNDG-SEA/CLOUDY ',  ! 173
     $  'SATSND: GOES RADIANCE/SNDG-SEA/CLEAR    ',  ! 174
     $  'SATSND: GOES RADIANCE/SNDG-SEA/CLOUDY   ',  ! 175
     $  4*'-- EMPTY --                             ',! 176-9
     $  'SFC: MARINE (VALID STATION PRESSURE)    ',  ! 180
     $  'SFC: LAND (VALID STATION PRESSURE)      ',  ! 181
     $  'SFC: SPLASH-LVL (DROP OR RECCO W/ PMSL) ',  ! 182
     $  'SFC: LAND or MARINE, MISSING STN PRESS  ',  ! 183
     $  3*'-- EMPTY --                             ',! 184-6
     $  'SFC: LAND, MISSING STATION PRESSURE     ',  ! 187
     $  'SFC: MESONET (COOPERATIVE NETWORKS)     ',  ! 188
     $  '-- EMPTY --                             ',  ! 189
     $  'SFCBOG: OPC/NOS POINT PMSL BOGUS        ',  ! 190
     $  'SFCBOG: AUSTRALIAN PAOB PMSL BOGUS      ',  ! 191
     $  'SFC: SYNOP LAND, MSG STN AND MSL PRESS  ',  ! 192
     $  'SFC: METAR, MSG STN AND MSL PRESSURE    ',  ! 193
     $  'SFC: SHIP/CMAN/BUOY, MSG STN & MSL PRES ',  ! 194
     $  'SFC: MESONET, MSG STN AND MSL PRESS     '/  ! 195

      NAMELIST/TASK/MP_PROCESS
      NAMELIST/GBLEVN/PREVEN
      NAMELIST/RGRID/IGRD,JGRD,POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL
      NAMELIST/LDTA/IRNMRK,RECCON,AIRLND,JAWIND,TOVEDS,GOESND,SWINDO_e,
     $ SWINDO_l,SWNLND,JSWIND,PHI,IWINDO_e,IWINDO_l,SATMST,IRTRV,KTOP,
     $ MARLND,LFMAXI,DROPSN,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,PG4243,
     $ MODPRT,LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,AWINDO,RWINDO,UWINDO,JSURFM,
     $ JSURFW,FWINDO,SPCIAL,JAMASS,JSMASS,KTEMP,PHISWN,STNPRT,XWINDO,
     $ JPSSMI,TR80KM,FILLZ,FILLT,FILLW,FILLM,PRFLER,PWINDO,LSWIND,
     $ LSMASS,CWINDO,TOVBFR,RECSLM,IPRINT,IACFTL,GOESPW,PHIACF,VADWIN,
     $ VWINDO,TOVRAD,TOVRTV,PFRALT,IEWNDO,JPERSD,AIFNOW,FLDMGS,FLDMAF,
     $ GOESRD,IVADFL,IVADSP,ISATLS,DWINDO,JPQKSD,IQWNDO,GOESCT,APPEND,
     $ FLACMS,IACFTH,SUBSKP,JPGPSD,GWINDO,RASS,TWINDO,JPWDSD,IWWNDO,
     $ FLDMFR,WRMISS,SKGP45,JPASCD,IAWNDO,npkrpt,SKGNSS,UPRAIR
      NAMELIST/PARM/IUNIT
      CALL W3TAGB('PREPOBS_PREPDATA',2022,0105,0050,'EMC')
C DETERMINE MACHINE WORD LENGTH (BYTES) FOR BOTH INTEGERS AND REALS
      CALL WORDLENGTH(LWI,LWR)
      PRINT 2213, LWI,LWR
 2213 FORMAT(/' ---> MACHINE WORD LENGTH (BYTES) FOR INTEGER WORDS IS ',
     $ I3/' ---> MACHINE WORD LENGTH (BYTES) FOR   REAL  WORDS IS ',I3/)
C SWITCH DEFAULTS FOR VARIABLES NOT INITIALIZED IN BLOCK DATA
      IRNMRK = -99
C READ IN NAMELISTS TASK, GBLEVN, RGRID, LDTA AND PARM TO ESTABLISH
C  SWITCHES
C   (IF NAMELIST TASK NOT FOUND, THEN SWITCH MP_PROCESS SET TO 0; THIS
C    NAMELIST IS NORMALLY CAT'ED TO THE BEGINNING OF THE DATA CARDS
C    FILE BY THE MAKE_PREPBUFR SCRIPT)
C   (IF NAMELIST GBLEVN NOT FOUND, THEN SWITCH PREVEN SET TO FALSE;
C    THIS NAMELIST IS NORMALLY CAT'ED TO THE BEGINNING OF THE DATA
C    CARDS FILE, JUST AFTER NAMELIST TASK, BY THE MAKE_PREPBUFR SCRIPT)
      MP_PROCESS = 0
      READ(5,TASK,ERR=886,END=886)
  886 CONTINUE
      PREVEN = .FALSE.
      READ(5,GBLEVN,ERR=887,END=887)
  887 CONTINUE
      REWIND 5
      READ(5,RGRID)
      READ(5,LDTA)
      READ(5,PARM)
      IF(.NOT.TOVBFR(1).AND..NOT.TOVBFR(2))  THEN
         TOVRAD = .FALSE.
         TOVRTV = .FALSE.
      END IF
      IF(TOVBFR(1).OR.TOVBFR(2))  THEN
         TOVEDS(1) = .FALSE.
         TOVEDS(2) = .FALSE.
      ELSE IF(TOVEDS(1).OR.TOVEDS(2))  THEN
         TOVBFR(1) = .FALSE.
         TOVBFR(2) = .FALSE.
      END IF
      IF(IRNMRK.GT.0.AND.IRNMRK.LT.11)  THEN
         PRINT 321, NET(IRNMRK)
      ELSE
         PRINT 321, NET(1)
      END IF
  321 FORMAT(/37X,'WELCOME TO THE UNIVERSAL ',A14,' DATA PREPROCESSOR'/
     $ 48X,'WCOSS VERSION CREATED 24 Jun 2021 (BUFR ships/cman)')
      call bvers(cvstr)
      print 3211, cvstr
 3211 FORMAT(48X,'--BUFRLIB VERSION USED = v',a,/)
      PRINT 322, (IUNIT(I),I=1,8),IUNIT(16),IUNIT(17)
  322 FORMAT(//53X,'TABLE OF UNIT NUMBERS'/31X,
     $ 'INPUTS IN UNIT NUMBERS 11-50 - OUTPUTS IN UNIT NUMBERS 51-90'//
     $ 36X,'CENTER (CYCLE) DATE IN UNIT ......................... ',I5/
     $ 36X,'BUFR TABLE FILE GROUP OF 3 SEQUENTIAL FROM UNIT ..... ',I5/
     $ 36X,'FIXED FIELD FILE GROUP OF 3 SEQUENTIAL FROM UNIT .... ',I5/
     $ 36X,'BACKGROUND FILE GROUP OF 3 SEQUENTIAL FROM UNIT ..... ',I5/
     $ 36X,'UPPER-AIR FILE GROUP OF 10 SEQUENTIAL FROM UNIT ..... ',I5/
     $ 36X,'SURFACE FILE GROUP OF 10 SEQUENTIAL FROM UNIT ....... ',I5/
     $ 36X,'POLAR-ORBITING SAT. SNDG GROUP OF 5 SEQ. FROM UNIT .. ',I5/
     $ 36X,'GOES SATELLITE SNDG GROUP OF 4 SEQUENTIAL FROM UNIT . ',I5/
     $ 36X,'PREPBUFR DATA FILE IN UNIT .......................... ',I5/
     $ 36X,'"PREVENT" EVENTS SUMMARY PRINT FILE IN UNIT ......... ',I5)
C READ CENTER (CYCLE) DATE (POTENTIALLY DOWN TO MINUTES)
      READ(IUNIT(1),'(6X,I10)',END=326)  IDAT10 ! YYYYMMDDHH
      IDATMM = 00  ! initialize minutes as zero
      READ(IUNIT(1),'(6x,i2.2)',END=327) IDATMM ! mm (if missing use
  327 continue                                  !     default, zero)

C SPLIT CENTER (CYCLE) DATE INTO COMPONENTS YYYY MM DD HH (IDATE)
      IDATE(1) = IDAT10/1000000
      IDATE(2) = MOD((IDAT10/10000),100)
      IDATE(3) = MOD((IDAT10/100),100)
      IDATE(4) = MOD(IDAT10,100)
      PRINT 324, IDATE, IDATMM
  324 FORMAT(//23X,'ALL INPUT DATA SETS WILL BE CHECKED AGAINST THE ',
     $ 'CENTER (CYCLE) DATE: ',I4.4,2('-',I2.2),1X,I2.2,':',I2.2,'Z'/)
      CALL W3LOCDAT(IDAT)
      CALL W3PRADAT(IDAT,CDAT)
      PRINT 357, CDAT(2),CDAT(3),CDAT(6),CDAT(7),CDAT(1),IUNIT(16)
  357 FORMAT(/31X,'CURRENT WALL CLOCK TIME: ',A3,1X,A8,' - ',A8,A4,
     $ ' LST -- ',A10//36X,'OUTPUT IS THROUGH INTERFACE TO PREPBUFR ',
     $ 'DATA SET ON UNIT',I3//)
C PRINT OUT NAMELISTS TASK, GBLEVN, RGRID, LDTA & PARM
      WRITE(6,TASK)
      WRITE(6,GBLEVN)
      WRITE(6,RGRID)
      PRINT 999
  999 FORMAT(' ')
      WRITE(6,LDTA)
      PRINT 999
      WRITE(6,PARM)
      NEWPRT = MODPRT/4
      IF(MODPRT.GT.0)  THEN
         PRINT 332
  332    FORMAT(/)
         PRINT 334, MODPRT
  334    FORMAT(/13X,'>>> A COMPLETE LISTING OF EVERY ',I3,'-TH ADPUPA',
     $    ' AND SAT. RADIANCE/RETRIEVAL REPORT WILL BE PRINTED OUT <<<')
         PRINT 335, NEWPRT
  335    FORMAT(/2X,'>>> EVERY ',I3,'-TH FILLED REPORT IN "HDR/MOBS/',
     $    'IPMSL/PWAT/xRAD/REQV/CLTOP" ARRAYS WILL BE PRINTED OUT (FOR',
     $    ' EACH DATA TYPE) <<<')
      END IF

C  On WCOSS should always set BUFRLIB missing (BMISS) to 10E8 to avoid
C   overflow when either an INTEGER*4 variable is set to BMISS or a
C   REAL*8 (or REAL*4) variable that is missing is NINT'd
C  -------------------------------------------------------------------

      CALL ISETPRM ( 'MXMSGL', 600000 )  ! CH 04/15/21, moved 04/22/21
      CALL ISETPRM ( 'MAXSS',  600000 )  ! CH 04/15/21, moved 04/22/21
CCC                                     above lines moved to here from
CCC                                     8 places below at suggestion
CCC                                     of J. Wollen
ccccc CALL SETBMISS(10E10_8)
      CALL SETBMISS(10E8_8)
      BMISS=GETBMISS()
      CALL MAXOUT(50000)                 ! CH 08/09/21
      print'(1X)'
      print'(" BUFRLIB value for missing is: ",G0)', bmiss
      print'(1X)'

C DETERMINE SOUTH AND NORTH LATITUDE BOUNDARIES FOR DATA SEARCH AREA
      YSLIM = ALONVT
      YNLIM = YSLIM + ((JGRD - 1) * POLEI)
      IF(POLA)  THEN
         IF(NORTH)  THEN
            YSLIM = -20.
         ELSE
            YNLIM = 20.
         END IF
      END IF
C-----------------------------------------------------------------------
C READ IN N.H. LAND-SEA GRID (1 DEG.), S.H. LAND-SEA GRID (2.5 DEG.)
C  AND CONUS GRID (1 DEG.)
C  GRIDS DEFINED AS FOLLOWS:
C        GDNH (NH LAND-SEA) - =0.0 SEA; =1.0 LAND
C        GDSH (SH LAND-SEA) - =0.0 SEA; =1.0 LAND
C        GDUS (NH GEOGR.)   - =2.0 U.S. MAINLAND; =1.0 ADJOINING
C        WATER SURROUNDING USA, CANADA SOUTH OF 49N LAT; =0.0 REST OF N.H.
      PRINT 101, IUNIT(3)
  101 FORMAT(/,1X,'**** OPEN UNIT ',I2,' TO GET N.H./S.H. LAND-SEA ',
     $ 'GRIDS &  N.H. CONUS GRID FOR LOCATION CHECKS ****')
      READ(IUNIT(3),ERR=14,END=14)  GDNH
      READ(IUNIT(3),ERR=14,END=14)  GDSH
      READ(IUNIT(3),ERR=14,END=14)  GDUS
      GO TO 12
   14 CONTINUE
C ERROR READING FILE -- STOP 49
      PRINT 102
  102 FORMAT(/5X,'###### ERROR READING LAND-SEA-U.S. MASK FILE -- ',
     $ 'STOP 49'/)
      CALL W3TAGE('PREPOBS_PREPDATA')
      CALL ERREXIT(49)
   12 CONTINUE
C-----------------------------------------------------------------------
C CALL SUBR. PREP TO INITIATE PREPROCESSING OF ALL TYPES OF DATA
      CALL PREP
C CALL W3FIZZ WITH HDR(3) = IMISS (99999): SIGNALS TO BUFR INTERFACE
C  THAT LAST INCOMPLETE BUFR MESSAGE SHOULD BE WRITTEN OUT
      HDR(3) = IMISS
      CALL W3FIZZ(IER)
      PRINT 401
  401 FORMAT(/33X,21('-'),' ***** SUMMARY ***** ',21('-'))
      PRINT 950
  950 FORMAT(//54X,'>>> UPPER-AIR DATA <<<'/28X,'(INCLUDES ADPUPA',
     $ ', AIRCFT, AIRCAR, SATWND, PROFLR, VADWND AND RASSDA FILES)')
      PRINT 1951, KNTUPA,KNTAIR,KNTSWN,KNTCAR,KNTPRO,KNTVAD,KNTRAS,
     $ KSKPUA,KMSGUA,KBDYUA,KTIMUA,KSKOMR(1),KNOATS,KSKNSW,KSKSWD,
     $ KSKREC,KSKDRP,KNDCDE,KSKCLS
 1951 FORMAT(/,35X,
     $ 'NUMBER OF UNPACKED ADPUPA REPORTS PROCESSED      = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED AIRCFT REPORTS PROCESSED      = ',I8,/,35X,
     $ 'NO. UNPKD SATWND (MASS/WND; ALL TYPES) RPTS PROC.= ',I8,/,35X,
     $ 'NUMBER OF UNPACKED AIRCAR (MDCRS) REPORTS PROC.  = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED PROFILER REPORTS PROCESSED    = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED VAD(NEXRAD) REPORTS PROCESSED = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED RASS REPORTS PROCESSED        = ',I8,/,35X,
     $ 'TOTAL NO. OF UNPACKED REPORTS SKIPPED (ALL U-AIR)= ',I8,/,35X,
     $ '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $ '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $ '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $ '   -- NUMBER OVERLAND OCEAN STATION REPORTS      = ',I8,/,35X,
     $ '   -- NUMBER OF OLD-TYPE "CLOUD" WIND EST. RPTS. = ',I8,/,35X,
     $ '   -- NUMBER OF SATWND REPORTS WITH INVALID        ',8X,/,35X,
     $ '       PRODUCER/SATELLITE/PRODUCT COMBINATION    = ',I8,/,35X,
     $ '   -- NO. SATWND (ALL PRODUCERS/SATELLITES)...        ',/,35X,
     $ '          CONVENTIONAL IR (LONG-WAVE) CLOUD DRIFT= ',I8,/,35X,
     $ '          CONVENTIONAL IMGR WTR VPR(CL-TOP,D-LYR)= ',I8,/,35X,
     $ '          CONVENTIONAL VISIBLE CLOUD DRIFT       = ',I8,/,35X,
     $ '          HI-DENSITY IR (LONG-WAVE) CLOUD DRIFT  = ',I8,/,35X,
     $ '          HI-DENSITY VISIBLE CLOUD DRIFT         = ',I8,/,35X,
     $ '          HI-DENSITY IMAGER  WATER VAPOR-CLD TOP = ',I8,/,35X,
     $ '          HI-DENSITY IMAGER  WATER VAPOR-DEEP LYR= ',I8,/,35X,
     $ '          HI-DENSITY SOUNDER WATER VAPOR-CLD TOP = ',I8,/,35X,
     $ '          HI-DENSITY SOUNDER WATER VAPOR-DEEP LYR= ',I8,/,35X,
     $ '          PICTURE TRIPLET CLOUD DRIFT            = ',I8,/,35X,
     $ '   -- NO. SKIPPED RECONNAISSANCE RPTS (RECCON=F) = ',I8,/,35X,
     $ '   -- NO. SKIPPED DROPWINSONDE REPORTS (DROPSN=F)= ',I8,/,35X,
     $ '   -- NO. PROFILER RPTS THAT COULD NOT BE DECODED= ',I8,/,35X,
     $ '   -- NO. VAD REPORTS THAT COULD NOT BE DECODED  = ',I8,/,35X,
     $ '   -- NO. RASS REPORTS THAT COULD NOT BE DECODED = ',I8,/,35X,
     $ '   -- NUMBER OF CLASS SOUNDINGS                  = ',I8)
      PRINT 1958, KSKSWN,KSKACF,(IACFTL(II),KSKALM(II),II=1,9),
     $ (IACFTH(II),KSKAHM(II),II=1,9),(KSKNOW(II),II=1,9)
 1958 FORMAT(35X,
     $ 'COUNT OF RPTS FLAGGED (TBL. VAL. SET TO 15, ALL VARIABLES)'/35X,
     $ '   -- NO. SATWND (ALL COMBN/TYPES) RPTS OVER LAND= ',I8,/,35X,
     $ '   -- NO. OF AIRCRAFT FLIGHT LVL RPTS OVER LAND  = ',I8,/,35X,
     $ '   -- NO. OF AIREP/PIREP RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF AMDAR  ACFT RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF EAMDAR ACFT RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF MDCRS  ACFT RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF TAMDARM ACF RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF CAMDAR ACFT RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF KAMDAR ACFT RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF AMDARB ACFT RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF TAMDARB ACF RPTS BELOW',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF AIREP/PIREP RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF AMDAR  ACFT RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF EAMDAR ACFT RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF MDCRS  ACFT RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF TAMDARM ACF RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF CAMDAR ACFT RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF KAMDAR ACFT RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF AMDARB ACFT RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. OF TAMDARB ACF RPTS ABOVE',I6,' METERS = ',I8,/,35X,
     $ '   -- NO. AIREP/PIR. RPTS W/MSG WIND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. AMDAR ACFT RPTS W/MSG WIND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. EAMDAR ACFT RPTS W/MSG WND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. MDCRS ACFT RPTS W/MSG WIND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. TAMDARM ACF RPTS W/MSG WND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. CAMDAR ACFT RPTS W/MSG WND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. KAMDAR ACFT RPTS W/MSG WND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. AMDARB ACFT RPTS W/MSG WND & VALID MASS= ',I8,/,35X,
     $ '   -- NO. TAMDARB ACF RPTS W/MSG WND & VALID MASS= ',I8)
      DO  II = 1,2
         IF(TOVBFR(II).OR.TOVEDS(II))  THEN
            PRINT 3990, CTYPE(II)
 3990 FORMAT(//49X,'>>>  ',A5,' SATELLITE REPORTS  <<<')
            IF(TOVBFR(II))  THEN
               IF(TOVRAD)  PRINT 7990
 7990          FORMAT(/50X,'>>>  RADIANCES PROCESSED <<<')
               IF(TOVRTV)  PRINT 7991
 7991          FORMAT(/45X,'>>>  40-LEVEL RETRIEVALS PROCESSED <<<')
            ELSE  IF(TOVEDS(II))  THEN
               PRINT 7992
 7992          FORMAT(/46X,'>>>  NMCEDS RETRIEVALS PROCESSED <<<')
            END IF
            PRINT 991, CTYPE(II),KNTTOV(II),KSKPTV(II),KNOPTV(II),
     $       KIPTTV(II),KMSGTV(II),KBDYTV(II),KTIMTV(II),KLNDTV(II),
     $       KSEATV(II),KREDTV(II),KJFLAG(II)
  991       FORMAT(/,35X,
     $ 'NUMBER OF UNPACKED ',A5,' REPORTS PROCESSED       = ',I8,/,35X,
     $ 'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $ ' *** NO. SKIPPED BY FOLLOWING CHECKS (IN THIS ORDER) ***'/35X,
     $ '   -- NUMBER FROM NON-OPERATIONAL SATELLITES     = ',I8,/,35X,
     $ '   -- NUMBER FROM INVALID PATHS (INSTRUMENTS)    = ',I8,/,35X,
     $ '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $ '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $ '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $ '   -- NUMBER OF OVERLAND REPORTS                 = ',I8,/,35X,
     $ '   -- NUMBER OF OCEANIC REPORTS                  = ',I8,/,35X,
     $ '   -- NUMBER OF SKIPPED TR80KM=F OR BAD REPORTS  = ',I8,/,35X,
     $ '   -- NO. W/ NON-0 STATUS FROM W3XTOVSMND(NMCEDS)= ',I8)
         END IF
      ENDDO
      IF(GOESND(1).OR.GOESPW(1).OR.GOESRD(1).OR.GOESCT(1).OR.GOESND(2).
     $ OR.GOESPW(2).OR.GOESRD(2).OR.GOESCT(2))  THEN
         PRINT 590
  590 FORMAT(//48X,'>>>  GOES SATELLITE REPORTS  <<<')
         IF(GOESRD(1))  PRINT 8990
 8990 FORMAT(/46X,'---  GOES 5x5 RADIANCES PROCESSED ---')
         IF(GOESRD(2))  PRINT 8993
 8993 FORMAT(/46X,'---  GOES 1x1 RADIANCES PROCESSED ---')
         IF(GOESND(1))  PRINT 8991
 8991 FORMAT(/42X,'---  GOES 5x5 PROFILE SOUNDINGS PROCESSED ---')
         IF(GOESND(2))  PRINT 8994
 8994 FORMAT(/42X,'---  GOES 1x1 PROFILE SOUNDINGS PROCESSED ---')
         IF(GOESPW(1))  PRINT 8992
 8992 FORMAT(/38X,'---  GOES 5x5 PRECIP. WATER RETRIEVALS PROCESSED ',
     $ '---')
         IF(GOESPW(2))  PRINT 8995
 8995 FORMAT(/38X,'---  GOES 1x1 PRECIP. WATER RETRIEVALS PROCESSED ',
     $ '---')
         IF(GOESCT(1))  PRINT 8996
 8996 FORMAT(/40X,'---  GOES 5x5 CLOUD TOP RETRIEVALS PROCESSED ---')
         IF(GOESCT(2))  PRINT 8997
 8997 FORMAT(/40X,'---  GOES 1x1 CLOUD TOP RETRIEVALS PROCESSED ---')
         PRINT 591, KNTGIT,KNTGIS,KNTGIP,KNTGIC,KSKPGI,KNDCGI,KNOPGI,
     $    KMSGGI,KBDYGI,KNOCTP
  591    FORMAT(/35X,
     $ 'NUMBER OF DECODED GOES REPORTS PROCESSED         = ',I8/35X,
     $ '... NUMBER CONTAINING GOES SNDG/RADIANCE DATA    = ',I8/35X,
     $ '... NUMBER CONTAINING GOES PRECIP. WATER DATA    = ',I8/35X,
     $ '... NUMBER CONTAINING GOES CLOUD TOP DATA        = ',I8/35X,
     $ 'TOTAL NO. OF DECODED REPORTS SKIPPED             = ',I8/35X,
     $ ' *** NO. SKIPPED BY FOLLOWING CHECKS (IN THIS ORDER) ***'/35X,
     $ '   -- NUMBER THAT COULD NOT BE DECODED, ERROR    = ',I8/35X,
     $ '   -- NO. FROM NON-OP. SATS OR INVALID PATH(INST)= ',I8/35X,
     $ '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8/35X,
     $ '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8/35X,
     $ '   -- C-TOP ONLY: NO. W/ MSG P, BUT W/ OTHER DATA= ',I8)
         PRINT 7591, KTIMGI,KLNDGI,KSEAGI
 7591    FORMAT(/,35X,
     $ ' *** NO. OF REPORTS SKIPPED ***'/35X,
     $ '   -- NUMBER OF SNDG/RAD OUTSIDE TIME INTERVAL   = ',I8/35X,
     $ '   -- NUMBER OF P. WATER OUTSIDE TIME INTERVAL   = ',I8/35X,
     $ '   -- NUMBER OF CLOUD TOP OUTSIDE TIME INTERVAL  = ',I8/35X,
     $ '   -- NUMBER OF OVERLAND SOUNDING/RADIANCE       = ',I8/35X,
     $ '   -- NUMBER OF OVERLAND PRECIPITABLE WATER      = ',I8/35X,
     $ '   -- NUMBER OF OVERLAND CLOUD TOP               = ',I8/35X,
     $ '   -- NUMBER OF OCEANIC SOUNDING/RADIANCE        = ',I8/35X,
     $ '   -- NUMBER OF OCEANIC PRECIPITABLE WATER       = ',I8/35X,
     $ '   -- NUMBER OF OCEANIC CLOUD TOP                = ',I8)
      END IF
      PRINT 954
  954 FORMAT(//56X,'>>> SURFACE DATA <<<'/38X,'(INCL. ADPSFC, SFCSHP, ',
     $ 'SFCBOG, SPLASH-LEVEL, MSONET)')
      KOTHSF = KSKPSF - KMSGSF - KBDYSF - KTIMSF
      PRINT 1955, KNTSFC,KNTSHP,KNTSLP,KNTMSO,KNTSPL,KSKPSF,KMSGSF,
     $ KBDYSF,KTIMSF,KOTHSF,KSKOMR(2),KSKTHN
 1955 FORMAT(/,35X,
     $ 'NUMBER OF UNPACKED ADPSFC REPORTS PROCESSED      = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED SFCSHP REPORTS PROCESSED      = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED MSL P BOGUS REPORTS PROCESSED = ',I8,/,35X,
     $ 'NUMBER OF UNPACKED MESONET REPORTS PROCESSED     = ',I8,/,35X,
     $ 'NUMBER OF SPLASH-LEVEL MASS REPORTS PROCESSED    = ',I8,/,35X,
     $ 'TOTAL NO. OF UNPACKED REPORTS SKIPPED (ALL SFC)  = ',I8,/,35X,
     $ '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $ '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $ '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $ '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8,/,35X,
     $ 'COUNT OF RPTS FLAGGED (TBL. VAL. SET TO 15, ALL VARIABLES)'/35X,
     $ '   -- NUMBER OVERLAND MARINE REPORTS             = ',I8,/,35X,
     $ '   -- NUMBER LAND RPTS THINNED OUTSIDE LFM DOMAIN= ',I8)
      DO IB = 1,6
         IF(MIN(JPSSMI(IB,1),JPSSMI(IB,2),JPSSMI(IB,3),JPSSMI(IB,4))
     $    .EQ.0)  THEN
            PRINT 956
  956       FORMAT(//57X,'>>> SSM/I DATA <<<'/13X,'(INCLUDES REPORTS ',
     $       'WITH EITHER WIND SPEED, PRECIP. WATER, RAIN RATE AND/OR ',
     $       '7-CHN. BRIGHTNESS TEMPERATURES)')
            KOTHMI = KSKPMI - KMSGMI - KBDYMI - KTIMM(1) - KTIMM(2) -
     $               KTIMM(3) - KTIMM(4)
            KNTSMI_TOT = KNTSMI(1) + KNTSMI(2) + KNTSMI(3) + KNTSMI(4)
            PRINT 957, KNTSMI_TOT,(KNTSMI(II),II=1,4),KSKPMI,KMSGMI,
     $       KBDYMI,(KTIMM(II),II=1,4),KOTHMI
  957       FORMAT(/,35X,
     $   'NUMBER OF UNPACKED SSM/I REPORTS PROCESSED       = ',I8,/,35X,
     $   '   -- NUMBER OF OCEANIC WIND SPEED REPORTS       = ',I8,/,35X,
     $   '   -- NUMBER OF OCEANIC PRECIP. WATER REPORTS    = ',I8,/,35X,
     $   '   -- NUMBER OF RAIN RATE REPORTS                = ',I8,/,35X,
     $   '   -- NUMBER OF 7-CHANNEL BRIGHTNESS TEMP REPORTS= ',I8,/,35X,
     $   'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $   '   -- NO. OF W. SPEED RPTS OUTSIDE TIME INTERVAL = ',I8,/,35X,
     $   '   -- NO. OF P. WATER RPTS OUTSIDE TIME INTERVAL = ',I8,/,35X,
     $   '   -- NO. OF R. RATE  RPTS OUTSIDE TIME INTERVAL = ',I8,/,35X,
     $   '   -- NO. OF B. TEMP. RPTS OUTSIDE TIME INTERVAL = ',I8,/,35X,
     $   '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8)
            EXIT
         END IF
      ENDDO
      IF(MIN(JPERSD(1),JPERSD(2),JPERSD(3),JPERSD(4),JPERSD(5),
     $ JPERSD(6)).EQ.0)  THEN
         PRINT 976
  976    FORMAT(//49X,'>>> ERS SCATTEROMETER WIND DATA <<<')
         KOTHER = KSKPSC(1) - KMSGSC(1) - KBDYSC(1) - KTIMSC(1)
         PRINT 977, KNTSCT(1),KSKPSC(1),KMSGSC(1),KBDYSC(1),KTIMSC(1),
     $    KOTHER
  977       FORMAT(/,35X,
     $   'NUMBER OF UNPACKED ERS SCATTER. RPTS PROCESSED   = ',I8,/,35X,
     $   'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $   '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8)
      END IF
      IF(MIN(JPQKSD(1),JPQKSD(2),JPQKSD(3),JPQKSD(4),JPQKSD(5),
     $ JPQKSD(6)).EQ.0)  THEN
         PRINT 2976
 2976    FORMAT(//46X,'>>> QUIKSCAT SCATTEROMETER WIND DATA <<<')
         KOTHQK = KSKPSC(2) - KMSGSC(2) - KBDYSC(2) - KTIMSC(2)
         PRINT 2977, KNTSCT(2),KSKPSC(2),KMSGSC(2),KBDYSC(2),KTIMSC(2),
     $    KOTHQK
 2977       FORMAT(/,35X,
     $   'NUMBER OF UNPACKED QUIKSCAT SCATTER. RPTS PROC.  = ',I8,/,35X,
     $   'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $   '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8)
      END IF
      IF(MIN(JPWDSD(1),JPWDSD(2),JPWDSD(3),JPWDSD(4),JPWDSD(5),
     $ JPWDSD(6)).EQ.0)  THEN
         PRINT 2978
 2978    FORMAT(//46X,'>>> WINDSAT SCATTEROMETER WIND DATA <<<')
         KOTHWS = KSKPSC(3) - KMSGSC(3) - KBDYSC(3) - KTIMSC(3)
         PRINT 2979, KNTSCT(3),KSKPSC(3),KMSGSC(3),KBDYSC(3),KTIMSC(3),
     $    KOTHWS
 2979       FORMAT(/,35X,
     $   'NUMBER OF UNPACKED WINDSAT SCATTER. REPORTS PROC.= ',I8,/,35X,
     $   'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $   '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8)
      END IF
      IF(MIN(JPASCD(1),JPASCD(2),JPASCD(3),JPASCD(4),JPASCD(5),
     $ JPASCD(6)).EQ.0)  THEN
         PRINT 2996
 2996    FORMAT(//44X,'>>> ASCAT SCATTEROMETER WIND DATA <<<')
         KOTHAS = KSKPSC(4) - KMSGSC(4) - KBDYSC(4) - KTIMSC(4)
         PRINT 2997, KNTSCT(4),KSKPSC(4),KMSGSC(4),KBDYSC(4),KTIMSC(4),
     $    KOTHAS
 2997       FORMAT(/,35X,
     $   'NUMBER OF UNPACKED ASCAT SCATTEROMETER RPTS PROC.= ',I8,/,35X,
     $   'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $   '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8)
      END IF
      IF(MIN(JPGPSD(1),JPGPSD(2),JPGPSD(3),JPGPSD(4),JPGPSD(5),
     $ JPGPSD(6)).EQ.0)  THEN
         PRINT 3976
 3976    FORMAT(//54X,'>>> GPS-IPW/ZTD DATA <<<')
         KOTHGP = KSKPGP - KMISGP - KMSGGP - KBDYGP - KTIMGP - KT45GP
     $                   - KTGNSS
         PRINT 4977, KNTGPS,KSKPGP,KMISGP,KMSGGP,KBDYGP,KTIMGP,KT45GP,
     $    KTGNSS,KOTHGP
 4977    FORMAT(/,35X,
     $   'NUMBER OF UNPACKED GPS-IPW/ZTD REPORTS PROCESSED = ',I8,/,35X,
     $   'TOTAL NO. OF UNPACKED REPORTS SKIPPED            = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING TOTAL PRECIP. WATER    = ',I8,/,35X,
     $   '   -- NUMBER WITH MISSING LATITUDE OR LONGITUDE  = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE DATA EXTRACTION BOUNDARY    = ',I8,/,35X,
     $   '   -- NUMBER OUTSIDE TIME INTERVAL               = ',I8,/,35X,
     $   '   -- NUMBER WITH REPORT TIME MINUTES > 30       = ',I8,/,35X,
     $   '   -- NUMBER THAT ARE NOT PROVIDED BY ENI        = ',I8,/,35X,
     $   '   -- NUMBER SKIPPED FOR OTHER REASONS           = ',I8)
      END IF
      PRINT 299
  299 FORMAT(///,38X,'TABLE OF IDENTIFICATION OF PREPBUFR REPORT TYPES',
     $ ' USED'//41X,'WINDS',40X,'MASS  ',/)
      DO I = 1,NUMTYP
         JITSM(I) = JITSW(I) - 100
         PRINT 501, JITSW(I),NAMEW(I),JITSM(I),NAMEM(I)
      ENDDO
  501 FORMAT(14X,I3,4X,A40,7X,I3,4X,A40)
      IKN = 0
      KKTOT = 0
      KTYPE = 0
      NTYPE = 0
      DO I = 100,299
         IF(KKTYPE(I).GT.0)  THEN
            IF(IKN.EQ.NUMTYP)  THEN
               PRINT 8897, NUMTYP-1,I
 8897 FORMAT(//'  %%  >',I3,' UNIQUE RPT TYPES PROCESSED - COUNTS ',
     $ 'FOR RPT TYPE',I4,' CANNOT BE PRINTED -- TOTAL NO. OF COUNTS ',
     $ 'SET TO ',I0/)
               KKTOT = -99999
               CYCLE
            END IF
            IKN = IKN + 1
            KTYPE(IKN) = KKTYPE(I)
            NTYPE(IKN) = I
            KKTOT = KKTOT + KKTYPE(I)
         END IF
      ENDDO
      PRINT 400
  400 FORMAT(//,46X,'REPORT COUNTS BY PREPBUFR REPORT TYPE')
      PRINT 200, (NTYPE(I), I= 1,17)
      PRINT 200, (KTYPE(I), I= 1,17)
      PRINT *
      PRINT 200, (NTYPE(I), I=18,34)
      PRINT 200, (KTYPE(I), I=18,34)
      PRINT *
      PRINT 200, (NTYPE(I), I=35,51)
      PRINT 200, (KTYPE(I), I=35,51)
      PRINT *
      PRINT 200, (NTYPE(I), I=52,68)
      PRINT 200, (KTYPE(I), I=52,68)
      PRINT *
      PRINT 200, (NTYPE(I), I=69,NUMTYP-1)
      PRINT 200, (KTYPE(I), I=69,NUMTYP-1)
  200 FORMAT(3X,17I7)
      PRINT 203, KKTOT
  203 FORMAT(/33X,'>>>>> TOTAL NUMBER OF REPORTS WRITTEN TO DATA',
     $ ' SET =',I6,' <<<<<')
      PRINT 91
   91 FORMAT(//39X,'***** PREPDATA PROGRAM SUCCESSFULLY COMPLETED',
     $ ' *****'//)
      if(i2many_lvls.gt.0) then
         WRITE(c2many_lvls,'(I4)') i2many_lvls
         WRITE(CMXLVL,'(I6)') MXLVL
         CALL SYSTEM('[ -n "$jlogfile" ] && $DATA/postmsg'//
     $    ' "$jlogfile" "***WARNING: '//c2many_lvls//' REPORT(S) '//
     $    'SKIPPED DUE TO HAVING TOO MANY LEVELS (> '//
     $    CMXLVL//' )"')
      end if
      GO TO 99
C-----------------------------------------------------------------------
  326 CONTINUE
C PROBLEM IN CENTER (CYCLE) DATE FILE -- STOP 29
      PRINT 9326
 9326 FORMAT(/5X,'++ ERROR READING CENTER (CYCLE) DATE FILE- STOP 29'/)
      CALL W3TAGE('PREPOBS_PREPDATA')
      CALL ERREXIT(29)
C-----------------------------------------------------------------------
   99 CONTINUE
      IF(ICODE.EQ.4.AND..NOT.APPEND)  THEN
C-----------------------------------------------------------------------
C NO DATA FOUND IN ONE OF THE FOLLOWING FILES: ADPUPA OR ADPSFC (AND
C  NOT APPENDING)
         PRINT 9327
 9327 FORMAT(/5X,'++ NO DATA FOUND IN EITHER ADPUPA OR ADPSFC -STOP 4'/)
      CALL W3TAGE('PREPOBS_PREPDATA')
      CALL ERREXIT(4)
C-----------------------------------------------------------------------
      END IF
      CALL W3TAGE('PREPOBS_PREPDATA')
      STOP
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    PREP
C   PRGMMR: Keyser           ORG: NP22       DATE: 2017-10-20
C
C ABSTRACT: PERFORMS SEVERAL FUNCTIONS - UNPACKS REPORTS ONE AT A TIME
C   INTO UNPACKED IW3UNPBF FMT, PERFORMING SEVERAL CHECKS SUCH AS
C   WHETHER REPORT IS WITHIN TIME LIMIT OR DATA EXTRACTION BOUNDARY -
C   CALLS PROPER SUBROUTINE TO ACTUALLY PROCESS UPPER AIR DATA (ALL
C   TYPES & CATEGORIES) - FINALLY CALLS SUBROUTINES TO UNPACK AND
C   EVENTUALLY PROCESS SATELLITE RETRIEVALS AND SURFACE REPORTS.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED, STREAMLINED;
C    SATWND CHECK FOR OVERLAND REPORTS ADDED
C 1988-08-24  D. A. KEYSER -- ADDED SWITCHES TO PROCESS NHC SAT. WINDS
C 1988-10-25  D. A. KEYSER -- MODIFIED TO PROCESS WATER VAPOR CHN WINDS;
C    NEW SWITCHES FOR SATWNDS; REF. TO ON29 TOVS REMOVED
C 1989-02-16  D. A. KEYSER -- TIME WINDOW TYPE DEPENDENT; KEEP/TOSS
C    TYPE DEPENDENT; LAND CHECK POSSIBLE FOR AIRCRAFT RPTS
C 1989-12-13  D. A. KEYSER -- RESTRUCTRED CAT. 6 REPORT PROCESSING
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-07-11  D. A. KEYSER -- SWITCH 'FGGE' REMOVED FROM N-LIST (FALSE)
C 1990-10-25  D. A. KEYSER -- NEW SUBR. 'UNPO29' + ENTRIES NOW UNPACKS
C    REPORTS FROM ON29 DATA SETS (STREAMLINED)
C 1991-06-07  D. A. KEYSER -- ADDED PROCESSING OF PROFILER DATA
C 1992-01-27  D. A. KEYSER -- HANDLES CLASS SNDGS (ON29 R.TYPE=13, OI/
C    SSI R.TYPE=122/222) W/ SWITCHES 'LSMASS,LSWIND,CWINDO'
C 1992-06-10  D. A. KEYSER -- SPCIAL AND ALL FILL SWITCHES SET TO FALSE
C    FOR SAT. RETR.. (ALL TYPES) REGARDLESS OF OUTPUT D-SET
C 1992-12-02  D. A. KEYSER -- CALLS W3FI77 RATHER THAN W3FI60 TO UNPACK
C    PROFILER RPTS DIRECTLY FROM SEQ'L BUFR FILES
C 1993-02-10  D. A. KEYSER -- MODIFIED TO CALL NEWEST VERSION OF W3FI77
C 1993-03-17  D. A. KEYSER -- MODIFIED TO CALL NEWEST VERSION OF W3FI77
C    (PROFLR DCTY NO LONGER READ IN, CHG IN FORMAT OF O-PUT 'IDATA'
C    ARRAY)
C 1993-05-31  D. A. KEYSER -- CALLS SUBR. "SATBFR" TO PROCESS TOVS RETR.
C    FROM INPUT BUFR-FMT FILES, CURRENTLY PROCESSES ONLY NESDIS 40-LVL
C    (80KM) RETR. (LATER NMC INTERACT. RETR.) CHANGED DEFAULT VALUES
C    AND ORDER FOR N-LIST SWITCH "IUNIT"
C 1993-09-14  D. A. KEYSER -- ADDED N-LIST SWITCH "TVIRT" TO OUTPUT
C    TEMP. AS VIRTUAL (=TRUE, DEFAULT) OR AS SENSIBLE (=FALSE) FOR
C    RAOB, RECCO/DROPS, CLASS & SFC DATA
C 1993-10-07  D. A. KEYSER -- PGM RUNS TO COMPL. W/ C.CODE=04 IF EITHER
C    ADPUPA OR ADPSFC CONTAIN NO RPTS
C 1993-11-02  D. A. KEYSER -- SINGLE-LVL CAT. 1 RECCOS NOW PROCESSED IN
C    SUBR. 'GETC06'
C 1994-08-11  D. A. KEYSER -- N-LIST SWITCH 'MARLND' NOW APPLIES TO
C    OCEAN STATION UPPER-AIR (RAOB, PIBAL) REPORTS AS WELL AS TO MARINE
C    SFC RPTS
C 1995-07-12  D. A. KEYSER -- ADDED CALL TO SUBR. 'GOESDG' TO PROCESS
C    GOES SOUNDINGS AND/OR PRECIPITABLE WATER; CHECKS FOR AND TOSSES
C    'CLIMATOLOGY' REPORTS; ADDED TABLE SUMMARIZING ACFT COUNTS BY LAT.
C    BAND; ADDED PROCESSING OF VAD (NEXRAD) WINDS VIA CALLS TO W3FI77;
C    ACCOUNTED FOR CHANGES/FIXES TO RECCO DECODER (AUG. 95) BY
C    REFORMATTING BACK TO OLD FORMAT SINCE EXISTING LOGIC WILL CORRECT
C    ERRORS
C 1996-10-24  D. A. KEYSER -- ADDED LOGIC TO PROCESS ERS SCATTEROMETER
C    WIND REPORTS (R.TYPE=286) VIA CALL TO NEW SUBR. "GETERS"
C 1997-01-31  D. A. KEYSER -- ADDED CALL TO NEW SUBR. "W3UNPK77" WHEN
C    INPUT WIND PROFILER DATA SET IS FROM BUFR DATA DUMP
C 1997-07-02  D. A. KEYSER -- PROFLR AND VADWND GENERATE SPECIAL LEVELS
C    BASED ON "SPCIAL" SWITCH (BEFORE, HARDWIRED TO ALWAYS GENERATE
C    SPECIAL LEVELS)
C 1998-06-15  D. A. KEYSER -- STREAMLINED THE PROCESSING OF CAT. 6
C    RECCOS W/ EITHER MAND LVL GEOPOT. OBS OR MEAN SEA-LVL PRESS. OBS
C 1999-01-20  D. A. KEYSER -- N-LIST SWITCHES "RECCON" AND "RWINDO" NOW
C    APPLY ONLY TO RECCO DATA, NEW SWITCHES "DROPSN" AND "DWINDO" NOW
C    APPLY TO DROPS
C 1999-08-04  D. A. KEYSER -- THE LOGIC THAT ALLOWS PROFILER DATA FROM
C    EITHER 1-HR PREV OR 1-HR LATER TO BE USED IF ONLY A SINGLE TIME
C    SELECTED AND NO DATA AT THAT TIME FOUND CONFINED TO ONLY OI RUNS
C    (WAS FOR ALL TYPES); R.C. =4 NOW OCCURS IF EITHER NO ADPUPA OR
C    ADPSFC REPORTS WERE PROCESSED INTO PREPBUFR FILE, BEFORE IT
C    OCCURRED ONLY IF EITHER NO ADPUPA OR ADPSFC REPORTS WERE READ IN
C 2000-02-17  D. A. KEYSER -- CAN NOW SKIP OVER INPUT BUFR MESSAGES IN
C    DATA DUMP FILES IF THE BUFR TYPE/SUBTYPE IS SET TO BE EXCLUDED
C    (BEFORE EXCLUSION OCCURRED ONLY AFTER REPORT WAS DECODED FROM DUMP
C    FILE), THIS MAKES THIS PROGRAM MORE EFFICIENT IN THESE CASES
C    (NOTE: APPLIES ONLY TO U-AIR AND SURFACE LAND DATA READ IN VIA
C    FUNCTION IW3UNPBF)
C 2001-04-06  D. A. KEYSER -- CAN HANDLE PROFILERS ORIG. IN PILOT
C    (PIBAL) FORMAT BULLETINS IN "PROFLR" DUMP FILE; NOW PROCESSES
C     SSM/I RAIN RATE UNDER R.TYP 150; N-LIST SWITCH SWINDO SPLIT INTO
C     SWINDO_e (EARLIEST TIME WINDOW) AND SWINDO_l (LATEST TIME WINDOW)
C     FOR SATWND REPORTS ("-" PRIOR TO CYCLE TIME, "+" AFTER CYCLE
C     TIME) (SAME DEFAULTS AS BEFORE); SUBR. "RPTLBL" NOW HAS INPUT
C     ARGS. "TIMWIN_e" (EARLIEST TIME WINDOW) AND "TIMWIN_l" (LATEST
C     TIME WINDOW) REPL. "TIMWIN" (+/- TIME WINDOW) ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME), ALLOWS THE 2 TO BE DIFFERENT
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"; N-LIST SWITCHES "GOESND", "GOESPW",
C     "GOESRD" AND NEW "GOESCT" NOW LENGTH 2 TO PROCESS THE 4 GOESND
C     TYPES FORM EITHER 5X5 OR 1X1 FOV
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF GPS-IPW DATA, READ
C     FROM "GPSIPW" DUMP FILE DUMP R. TYPE 74, GET PREPBUFR R. TYPE
C     153, PROCESSED BY NEW SUBR. "GETGPSIPW" INTO PREPBUFR FILE UNDER
C     NEW TBL A ENTRY "GPSIPW" {NEW NAMELIST SWITCH JPGPSD (PROCESS/
C     DON'T PROCESS)}; ADDED PROCESSING OF NPN AND CAP RASS DATA READ
C     FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R. TYPE 77,
C     GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE UNDER NEW
C     TBL A ENTRY "RASSDA" {NEW NAMELIST SWITCHES TWINDO (TIME WINDOW
C     ABOUT CYCLE TIME FOR ACCEPTING)} AND RASS (PROCESS/DON'T
C     PROCESS); ADDED PROCESSING OF EAMDAR ACFT RPTS NOW POSSIBLY INCL.
C     IN "AIRCFT" DUMP FILE DUMP R. TYPE 41, SUBTYPE 6, INCL. WITH
C     EXISTING PREPBUFR R. TYPES 131/231, PROCESSED INTO PREPBUFR FILE
C     UNDER EXISTING TBL A ENTRY "AIRCFT"; ADDED PROCESSING OF CAP AND
C     JAPANESE WIND PROFILERS NOW POSSIBLY INCL. IN "PROFLR" DUMP FILE
C     DUMP R. TYPES 75 AND 76, RESP., GETS PREPBUFR R. TYPES 227 AND
C     228, RESP., PROCESSED INTO PREPBUFR FILE UNDER EXISTING TBL A
C     ENTRY "PROFLR", WIND PROFILER RPTS ORIGINATING FROM PILOT (PIBAL)
C     BULLETINS NOW GET A UNIQUE PREPBUFR R. TYPE OF 229 {NAMELIST
C     SWITCHES PROFIL (PROCESS/DON'T PROCESS) CHANGED TO PRFLER AND
C     NWINDO (EARLIEST/LATEST TIME RELATIVE TO CYCLE TIME FOR
C     ACCEPTING) REPL. WITH PWINDO (TIME WINDOW ABOUT CYCLE TIME FOR
C     ACCEPTING)}; FOR VAD WINDS NAMELIST SWITCH VADWND CHANGED TO
C     VADWIN (PROCESS/DON'T PROCESS) AND NAMELIST SWITCH MWINDO
C     (EARLIEST/LATEST TIME RELATIVE TO CYCLE TIME FOR ACCEPTING) REPL.
C     WITH VWINDO (TIME WINDOW ABOUT CYCLE TIME FOR ACCEPTING); ADDED
C     PROCESSING OF NASA/MODIS POES AQUA/TERRA SATELLITE-DERIVED WINDS,
C     NOW POSSIBLY INCL. IN "SATWND" DUMP FILE EXISTING DUMP R. TYPE
C     63, GET PREPBUFR R. TYPES 257 (IR), 258 (W.VAPOR IMGR CLOUD-TOP)
C     AND 259 (W.WAPOR IMGR DEEP LAYER), PROCESSED INTO PREPBUFR FILE
C     UNDER EXISTING TBL A ENTRY "SATWND"
C 2005-07-01  D. A. KEYSER -- NOW STORES A VALUE 2 INTO REPORT SUBTYPE
C     (HEADER WORD 8) FOR DROPWINSONDE REPORTS IN REPORT TYPE 132/232 -
C     LATER GETS ENCODED INTO PREPBUFR UNDER MNEMONIC "TSB" (SUBR.
C     GETC06 STORES THIS AS 1 FOR RECCOS - THIS ALLOWS DROPS AND RECCOS
C     TO BE DIFFERENTIATED IN PREPBUFR)
C 2007-09-14  D. A. KEYSER -- MODIFIED TO RECOGNIZE HIGH-DENSITY JMA
C     SATELLITE WINDS DERIVED FROM BUFR BULLETINS IN NC005044-NC005046
C     WHICH MAY NOW BE IN INPUT "satwnd" DUMP FILE IN PLACE OF LOW-
C     DENSITY JMA WINDS DERIVED FROM SATOB BULLETINS IN NC005041-
C     NC005043 (EITHER BUFR OR SATOB WILL BE PROCESSED); MODIFIED TO
C     PROCESS WINDSAT SCATTEROMETER REPORTS, READ FROM NEW "WDSATR"
C     DUMP FILE (GETS PREPBUFR REPORT TYPE 289 AND ENCODES NEW
C     PARAMETERS MRWVC, MRLWC, WSST, MWD10, MWS10, WSEQC1, CHSQ, PHER,
C     SPDE, SSTE, CLDE AND VPRE IN PREPBUFR FILE UNDER NEW MESSAGE TYPE
C     "WDSATR); MODIFIED TO HANDLE RETURN OF NEW ARGUMENT "RDATA2" FROM
C     CALLS TO W3UNPKB7 [1-DIM 21-WORD ARRAY WHICH HOLDS ADDITIONAL
C     VALUES DECODED DIRECTLY FROM BUFR (AND NOT IN "RDATA" ARRAY), FOR
C     SOME PARAMETERS REPLACING WHAT HAD BEEN RETURNED IN "RDATA" ARRAY
C     (IN THE HEADER)]
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 -- CAN NOW PROCESS ASCAT SCATTEROMETER
C     WIND DATA READING FROM REPROCESSED DUMP FILE IN UNIT 39, ENCODING
C     INTO NEW PREPBUFR REPORT TYPE 290 UNDER NEW PREPBUFR MESSAGE TYPE
C     "ASCATW" VIA NEW NAMELIST SWITCHES "JPASCD" (DEF=6*9999) AND
C     IAWNDO (DEF=-3,+3)
C 2014-04-25  Y. Ling      -- Handles new VAD wind reports from Level 2
C     decoder.  Differentiates between these and existing Radar Coded
C     Message (RCM) VAD wind reports via use of report subtype (TSB=1
C     for RCM and =2 for Level 2).
C 2015-01-30  D. A. Keyser -- All references to IR satellite-derived
C     winds now expanded to refer to IR "long-wave" - this
C     differentiates them from IR "short-wave" winds which are now
C     produced from GOES but are not processed by this program. Skips
C     over the reading of reports in "satwnd" dump coming from tanks
C     NC005080 (AVHRR POES) and NC005090 (VIIRS POES) since these
C     cannot be processed by this program.
C 2016-02-08  S. Melchior --
C      - Processes two new aircraft data types in AIRCFT message type:
C        Korean AMDAR (BUFR) and Catch-all AMDAR (BUFR).  Either pre-
C        version 7 BUFR or new version 7 BUFR for Catch-All AMDAR,
C        MDCRS and E-AMDAR can be handled.
C          - The following arrays' dimensions were increased and
C            defaults adjusted: AWINDO, AIRLND, JAWIND, JAMASS, IACFTL,
C            IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC, KSKNOW,
C            INAC.
C 2016-10-27  C. Hill --
C      - TAMDARB AIRCFT message type added to handle BUFR form of TAMDAR
C        reports.  Allows for older (pre-2011) and newer TAMDAR data to
C        be processed.  The array sizes of AWINDO, AIRLND, JAWIND,
C        JAMASS, IACFTL, IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC,
C        KSKNOW, and INAC were all increased to (6,9).
C 2016-11-30  D. A. KEYSER -- Accounts for new output argument "OBS8_8"
C     returned from W3UNPKB7 for unpacked reports (REAL*8 2-word array
C     containing latitude and longitude of report).
C 2017-10-20  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01. Fixed bug that did not
C     test central dump time minutes against center (cycle) PRPBUFR
C     minutes in date check (i.e., only YYYYMMDDHH were tested for a
C     match).
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30 or
C              45 (since the RTMA_RU runs 4 times per hour). This change
C              allows the print statements to reflect this new center
C              dump time format.  It also ensures that the dump vs.
C              PREPBUFR center dates are correctly tested.
C 2020-08-20 J. Dong -- 
C     - Changes added to handle new VAD wind data reported from other
C       countries (e.g. Europe, New Zealand) (NC002018) and Hong Kong
C       wind profiler data (NC002014). Future feature.
C     - Logic added to differentiate between these and existing Radar
C       Coded Message (RCM) VAD wind reports via use of report subtype
C       (TSB=1 for RCM, =2 for Level 2 and =3 for other vadwnd). Future
C       feature.
C     - Changed subset to subset_t.  Defined subset_t and IDSDAT to 
C       eliminate Boundary Run-Time Check Failures.
C 2020-09-14 S. Melchior -- Added subsets 005067, 005068, and 005069
C       to the processing to read in Meteosat AMV data.
C
C USAGE:    CALL PREP
C   INPUT FILES:
C     UNIT EE   - 'ADPUPA' BUFR DATA DUMP FILE (RAOB/PIBAL/DROPS/RECCOS)
C     UNIT EE+1 - 'AIRCAR' BUFR DATA DUMP FILE (MDCRS AIRCRAFT)
C     UNIT EE+2 - 'AIRCFT' BUFR DATA DUMP FILE (ALL AIRCRAFT OTHER THAN
C                  MDCRS)
C     UNIT EE+3 - 'SATWND' BUFR DATA DUMP FILE (SATELLITE-DERIVED WINDS)
C     UNIT EE+4 - 'PROFLR' BUFR DATA DUMP FILE (WIND PROFILER)
C     UNIT EE+5 - 'VADWND' BUFR DATA DUMP FILE (NEXRAD VAD WINDS)
C     UNIT EE+6 - 'RASSDA' BUFR DATA DUMP FILE (RASS TEMPERATURES)
C     UNIT EE+7 - 'UPRAIR' BUFR DATA DUMP FILE (BUFR RAOB/PIBAL/DROPS)
C    (WHERE EE IS UNIT NUMBER DEFINED AS IUNIT(5) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY MAIN PROGRAM.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE PREP
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MAXOBS = 4500)
C PARAMETER NAME "NUMOBS2"  THROUGHOUT PGM SETS NO. OF ELEMENTS IN OBS2
C  ARRAY
      PARAMETER (NUMOBS2 = 43)
C PARAMETER NAME "MXBLVL"  THROUGHOUT PGM SETS MAXIMUM NO. OF REPORT
C  LEVELS THAT CAN BE PROCESSED AND ENCODED INTO BUFR MESSAGES
      PARAMETER (MXBLVL = 255)
      CHARACTER*8   STNPRT,STNID,FILNAM(8),DSNAME,SUBSET_d,subset_t
      CHARACTER*25  DNAME(3)
      CHARACTER*47  NAME1
      CHARACTER*56  NAME2
      LOGICAL  RECCON,TOVEDS,GOESND,FILLZ,SWNLND,AIRLND,PRFLER,
     $ SPCIAL,FILLW,FILLT,FILLM,TOVBFR,MARLND,GOESPW,GOESCT,VADWIN,
     $ GOESRD,FLRECO,DROPSN,SUBSKP,PROFILERinADPUPA,RASS,UPRAIR
      INTEGER  IDATA(MAXOBS),MDATE(4)
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/STRCTY/ICAT(MXLVL)
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/STRMSL/IPMSL(MXTYPV)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      COMMON/ACFTSW/AWINDO(2,9),AIRLND(6,9),JAWIND(6,9),JAMASS(6,9),
     $ IACFTL(9),IACFTH(9),PHIACF(7),KEPAC(6,9),AIFNOW(9),POAF,TRBX(5),
     $ FLACMS(9),PCAT,ROLF,aMSTQ,RIALR
      COMMON/TVSWCH/TOVEDS(2),TOVBFR(2),TR80KM,KNTTOV(2),
     $ KSKPTV(2),KNOPTV(2),KIPTTV(2),KMSGTV(2),KBDYTV(2),KTIMTV(2),
     $ KLNDTV(2),KSEATV(2),KREDTV(2),KJFLAG(2)
      COMMON/GOSWCH/GOESND(2),GOESPW(2),GOESCT(2),KNTGIT,KNTGIS,KNTGIP,
     $ KSKPGI,KNDCGI,KNOPGI,KMSGGI,KBDYGI,KTIMGI(3),KLNDGI(3),KSEAGI(3),
     $ KNTGIC,KNOCTP
      COMMON/GPSWCH/JPGPSD(6),GWINDO,KNTGPS,KSKPGP,KMSGGP,KBDYGP,KTIMGP,
     $ KMISGP,KT45GP,SKGP45,SKGNSS,KTGNSS
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/PARM3/RECCON,RWINDO,UWINDO,RECSLM,FLRECO,VWINDO,VADWIN,
     $ IVADFL,IVADSP,FLDMGS,FLDMAF,FLDMFR,DROPSN,DWINDO,UPRAIR
      COMMON/PARM4/ICODE
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/LNDSEA/GDSH(145,37),GDUS(362,91),GDNH(362,91)
      COMMON/LFMSFC/LFMAXI,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,MARLND,
     $ JSURFM(12),JSURFW(12),FWINDO(12),PFRALT,npkrpt(12)
      COMMON/SKPCNT/KSKPUA,KSKPSF,KMSGUA,KMSGSF,KBDYUA,KBDYSF,KTIMUA,
     $ KTIMSF,KSKNSW,KSKREC,KNOATS,KNTUUU(10),KNTSFC,KNTSHP,KNTSLP,
     $ KNTMSO,KNTSPL,KSKSWN,KSKACF,KNDCDE(3),KSKCLS,KSKTHN,KSKOMR(2),
     $ KSKALM(9),KSKAHM(9),KSKNOW(9),KSKDRP
      COMMON/MISWCH/XWINDO(6,4),JPSSMI(6,4),SRAD(7),KNTSMI(4),KTIMM(4),
     $ KSKPMI,KMSGMI,KBDYMI
      COMMON/SCTWCH/IEWNDO(2),JPERSD(6),IQWNDO(2),JPQKSD(6),IWWNDO(2),
     $ JPWDSD(6),KSKPSC(4),KMSGSC(4),KBDYSC(4),KTIMSC(4),KNTSCT(4),
     $ JPASCD(6),IAWNDO(2)
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/PWSWCH/PWT(5),IQMPW
      COMMON/PFSWCH/PRFLER(5),PWINDO(5),PROFILERinADPUPA
      COMMON/RASSSW/RASS,TWINDO
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE  (IDATA,RDATA)
      DATA  XMISS/99999./,IMISS/99999/
      DATA  FILNAM/'UPRAIR  ','AIRCAR  ','AIRCFT  ','SATWND  ',
     $             'PROFLR  ','VADWND  ','RASSDA  ','ADPUPA  '/
      DATA  DNAME/'WIND PROFILER DATA -     ',
     $            'VAD WIND DATA - .........',
     $            'RASS TEMPERATURE DATA - .'/
      DATA  DATA4/0/
      PWT = XMISS
C INITIALIZE IPMSL ARRAY (WILL REMAIN MISSING UNTIL SURFACE REPORTS)
      IPMSL  = IMISS
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
C***********************************************************************
C UPPER-AIR DATA RPTS {RAOB/PIBAL/RECCO/CLASS, A-CFT FLIGHT LVL, SATWND
C       {ALL TYPES), WIND PROFILER, VAD WINDS, RASS TEMPERATURES}
C              (DATA LEVEL CATEGORIES 1-5, 6, 8, 10, 11, 15)
C***********************************************************************
      PRINT 8001
 8001 FORMAT(//30X,21('-'),' ***** UPPER-AIR DATA ***** ',21('-'))
      NN = 1
  700 CONTINUE
      IPRFPIB   = 0
      IOPENED   = 0
      DSNAME    = 'ZZZZZZZZ'
      IDSDAT    = 0
      IDSDMP_8  = 0
      SUBSET_d  = 'XXXXXXXX'
      subset_t  = 'XXXXXXXX'
C KNTALL COUNTS NO. OF REPORTS UNPACKED FROM FILE (ALL REPORTS)
      KNTALL = 0
C KOUNT COUNTS NO. OF REPORTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR CAT. 6 PROCESSING,
C  SUBR. GETC06 WILL LATER INIT. ONLY FIRST TWO LEVELS FOR EACH RPT)
      MOBS = IMISS
C INITIALIZE ALL LEVELS OF ICAT ARRAY (NOTE: FOR CAT. 6 PROCESSING,
C  SUBR. GETC06 WILL LATER INIT. ONLY FIRST TWO LEVELS FOR EACH RPT)
      ICAT = IMISS
      FLRECO = .FALSE.
      PROFILERinADPUPA = .FALSE.
      NFILE = NN + IUNIT(5) - 1
      IF(NN.EQ.2)  THEN
C CHECK TO SEE IF AIRCAR (MDCRS) DATA SHOULD BE PROCESSED
         IF(MIN(JAWIND(1,4),JAWIND(2,4),JAWIND(3,4),JAWIND(4,4),
     $    JAWIND(5,4),JAWIND(6,4),JAMASS(1,4),JAMASS(2,4),JAMASS(3,4),
     $    JAMASS(4,4),JAMASS(5,4),JAMASS(6,4)).EQ.9999)  GO TO 7001
      ELSE IF(NN.EQ.3)  THEN
C CHECK TO SEE IF ANY BUFR MESSAGES CAN BE SKIPPED IN INPUT AIRCFT DUMP
         IF(MIN(JAWIND(1,1),JAWIND(2,1),JAWIND(3,1),JAWIND(4,1),
     $    JAWIND(5,1),JAWIND(6,1),JAMASS(1,1),JAMASS(2,1),JAMASS(3,1),
     $    JAMASS(4,1),JAMASS(5,1),JAMASS(6,1)).EQ.9999)  THEN
            SUBSKP(004,001) = .TRUE.
            SUBSKP(004,002) = .TRUE.
         END IF
         IF(MIN(JAWIND(1,2),JAWIND(2,2),JAWIND(3,2),JAWIND(4,2),
     $    JAWIND(5,2),JAWIND(6,2),JAMASS(1,2),JAMASS(2,2),JAMASS(3,2),
     $    JAMASS(4,2),JAMASS(5,2),JAMASS(6,2)).EQ.9999)
     $    SUBSKP(004,003) = .TRUE.
         IF(MIN(JAWIND(1,3),JAWIND(2,3),JAWIND(3,3),JAWIND(4,3),
     $    JAWIND(5,3),JAWIND(6,3),JAMASS(1,3),JAMASS(2,3),JAMASS(3,3),
     $    JAMASS(4,3),JAMASS(5,3),JAMASS(6,3)).EQ.9999)
     $    SUBSKP(004,006) = .TRUE.
         IF(MIN(JAWIND(1,5),JAWIND(2,5),JAWIND(3,5),JAWIND(4,5),
     $    JAWIND(5,5),JAWIND(6,5),JAMASS(1,5),JAMASS(2,5),JAMASS(3,5),
     $    JAMASS(4,5),JAMASS(5,5),JAMASS(6,5)).EQ.9999) THEN
            SUBSKP(004,008) = .TRUE.
            SUBSKP(004,012) = .TRUE.
            SUBSKP(004,013) = .TRUE.
         END IF
         IF(MIN(JAWIND(1,6),JAWIND(2,6),JAWIND(3,6),JAWIND(4,6),
     $    JAWIND(5,6),JAWIND(6,6),JAMASS(1,6),JAMASS(2,6),JAMASS(3,6),
     $    JAMASS(4,6),JAMASS(5,6),JAMASS(6,6)).EQ.9999)
     $    SUBSKP(004,009) = .TRUE.
         IF(MIN(JAWIND(1,7),JAWIND(2,7),JAWIND(3,7),JAWIND(4,7),
     $    JAWIND(5,7),JAWIND(6,7),JAMASS(1,7),JAMASS(2,7),JAMASS(3,7),
     $    JAMASS(4,7),JAMASS(5,7),JAMASS(6,7)).EQ.9999)
     $    SUBSKP(004,011) = .TRUE.
         IF(MIN(JAWIND(1,8),JAWIND(2,8),JAWIND(3,8),JAWIND(4,8),
     $    JAWIND(5,8),JAWIND(6,8),JAMASS(1,8),JAMASS(2,8),JAMASS(3,8),
     $    JAMASS(4,8),JAMASS(5,8),JAMASS(6,8)).EQ.9999)
     $    SUBSKP(004,103) = .TRUE.
         IF(MIN(JAWIND(1,9),JAWIND(2,9),JAWIND(3,9),JAWIND(4,9),
     $    JAWIND(5,9),JAWIND(6,9),JAMASS(1,9),JAMASS(2,9),JAMASS(3,9),
     $    JAMASS(4,9),JAMASS(5,9),JAMASS(6,9)).EQ.9999)
     $    SUBSKP(004,010) = .TRUE.
C CHECK TO SEE IF AIRCFT DATA SHOULD BE PROCESSED
         IF(SUBSKP(004,001).AND.SUBSKP(004,002).AND.SUBSKP(004,003).AND.
     $      SUBSKP(004,006).AND.SUBSKP(004,008).AND.SUBSKP(004,009).AND.
     $      SUBSKP(004,010).AND.SUBSKP(004,011).AND.SUBSKP(004,012).AND.
     $      SUBSKP(004,013).AND.SUBSKP(004,103))
     $    GO TO 7001
      ELSE IF(NN.EQ.4)  THEN
         SUBSKP(005,001:091) = .TRUE.
C CHECK TO SEE IF ANY BUFR MESSAGES CAN BE SKIPPED IN INPUT SATWND DUMP
         LOOP1: DO II=1,6
            LOOP1n1: DO JJ=1,2
               IF(MIN(JSWIND(II,JJ,4),JSMASS(II,JJ,4)).LT.9999)  THEN
                   ! ** GOES-E AND GOES-W Infrared (long-wave) **
                  SUBSKP(005,010) = .FALSE. ! current
                  SUBSKP(005,001) = .FALSE. ! historical (oldest)
                  SUBSKP(005,005) = .FALSE. ! historical
                  EXIT LOOP1
               END IF
            END DO LOOP1n1
         END DO LOOP1
         LOOP2: DO II=1,6
            LOOP2n1: DO JJ=1,2
               IF(MIN(JSWIND(II,JJ,5),JSMASS(II,JJ,5)).LT.9999)  THEN
                   ! ** GOES-E AND GOES-W Visible **
                  SUBSKP(005,012) = .FALSE. ! current
                  SUBSKP(005,002) = .FALSE. ! historical (oldest)
                  SUBSKP(005,008) = .FALSE. ! historical
                  EXIT LOOP2
               END IF
            END DO LOOP2n1
         END DO LOOP2
         LOOP3: DO II=1,6
            LOOP3n1: DO JJ=1,2
               LOOP3n2: DO KK=6,7
                  IF(MIN(JSWIND(II,JJ,KK),JSMASS(II,JJ,KK)).LT.9999)THEN
                   ! ** GOES-E AND GOES-W Water Vapor Imager **
                     SUBSKP(005,011) = .FALSE. ! current
                     SUBSKP(005,003) = .FALSE. ! historical (oldest)
                     SUBSKP(005,006) = .FALSE. ! historical
                     EXIT LOOP3
                  END IF
               END DO LOOP3n2
            END DO LOOP3n1
         END DO LOOP3
         LOOP4: DO II=1,6
            LOOP4n1: DO JJ=1,2
               LOOP4n2: DO KK=8,9
                  IF(MIN(JSWIND(II,JJ,KK),JSMASS(II,JJ,KK)).LT.9999)THEN
                   ! ** GOES-E AND GOES-W Water Vapor Sounder **
                     SUBSKP(005,014) = .FALSE. ! current
                     EXIT LOOP4
                  END IF
               END DO LOOP4n2
            END DO LOOP4n1
         END DO LOOP4
         LOOP5: DO II=1,6
            LOOP5n1: DO JJ=1,2
               IF(MIN(JSWIND(II,JJ,10),JSMASS(II,JJ,10)).LT.9999)  THEN
                   ! ** GOES-E AND GOES-W Picture Triplet **
                  SUBSKP(005,013) = .FALSE. ! current
                  SUBSKP(005,004) = .FALSE. ! historical (oldest)
                  SUBSKP(005,009) = .FALSE. ! historical
                  EXIT LOOP5
               END IF
            END DO LOOP5n1
         END DO LOOP5
         DO II=1,6
            IF(MIN(JSWIND(II,3,1),JSMASS(II,3,1)).LT.9999)  THEN
               SUBSKP(005,021) = .FALSE.
               EXIT
            END IF
         END DO
         DO II=1,6
            IF(MIN(JSWIND(II,3,3),JSMASS(II,3,3)).LT.9999)  THEN
               SUBSKP(005,022) = .FALSE.
               EXIT
            END IF
         END DO
         DO II=1,6
            IF(MIN(JSWIND(II,3,2),JSMASS(II,3,2)).LT.9999)  THEN
               SUBSKP(005,023) = .FALSE.
               EXIT
            END IF
         END DO
         DO II=1,6
            IF(MIN(JSWIND(II,4,1),JSMASS(II,4,1)).LT.9999)  THEN
               SUBSKP(005,044) = .FALSE. ! current
               SUBSKP(005,041) = .FALSE. ! historical
               EXIT
            END IF
         END DO
         DO II=1,6
            IF(MIN(JSWIND(II,4,3),JSMASS(II,4,3)).LT.9999)  THEN
               SUBSKP(005,045) = .FALSE. ! current
               SUBSKP(005,042) = .FALSE. ! historical
               EXIT
            END IF
         END DO
         DO II=1,6
            IF(MIN(JSWIND(II,4,2),JSMASS(II,4,2)).LT.9999)  THEN
               SUBSKP(005,046) = .FALSE. ! current
               SUBSKP(005,043) = .FALSE. ! historical
               EXIT
            END IF
         END DO
         LOOP8: DO II=1,6
            LOOP8n1: DO JJ=5,6
               IF(MIN(JSWIND(II,JJ,1),JSMASS(II,JJ,1)).LT.9999)  THEN
              ! ** METEOSAT-ODD AND METEOSAT-EVEN Infrared (long-wave)**
                  SUBSKP(005,067) = .FALSE. ! current
                  SUBSKP(005,064) = .FALSE. ! historical
                  SUBSKP(005,061) = .FALSE. ! historical
                  EXIT LOOP8
               END IF
            END DO LOOP8n1
         END DO LOOP8
         LOOP9: DO II=1,6
            LOOP9n1: DO JJ=5,6
               IF(MIN(JSWIND(II,JJ,3),JSMASS(II,JJ,3)).LT.9999)  THEN
                   ! ** METEOSAT-ODD AND METEOSAT-EVEN Visible **
                  SUBSKP(005,068) = .FALSE. ! current
                  SUBSKP(005,065) = .FALSE. ! historical
                  SUBSKP(005,062) = .FALSE. ! historical
                  EXIT LOOP9
               END IF
            END DO LOOP9n1
         END DO LOOP9
         LOOP10: DO II=1,6
            LOOP10n1: DO JJ=5,6
               IF(MIN(JSWIND(II,JJ,2),JSMASS(II,JJ,2)).LT.9999)  THEN
                   ! ** METEOSAT-ODD AND METEOSAT-EVEN Water Vpr Imgr **
                  SUBSKP(005,069) = .FALSE. ! current
                  SUBSKP(005,066) = .FALSE. ! historical
                  SUBSKP(005,063) = .FALSE. ! historical
                  EXIT LOOP10
               END IF
            END DO LOOP10n1
         END DO LOOP10
         LOOP6: DO II=1,6
            LOOP6n1: DO JJ=7,8
               IF(MIN(JSWIND(II,JJ,4),JSMASS(II,JJ,4)).LT.9999)  THEN
            ! ** AQUA AND TERRA (NASA/MODIS POES) Infrared (long-wave)**
                  SUBSKP(005,070) = .FALSE. ! current
                  EXIT LOOP6
               END IF
            END DO LOOP6n1
         END DO LOOP6
         LOOP7: DO II=1,6
            LOOP7n1: DO JJ=7,8
               LOOP7n2: DO KK=6,7
                  IF(MIN(JSWIND(II,JJ,KK),JSMASS(II,JJ,KK)).LT.9999)THEN
                   ! ** AQUA AND TERRA (NASA/MODIS POES) W. Vpr Imgr **
                     SUBSKP(005,071) = .FALSE. ! current
                     EXIT LOOP7
                  END IF
               END DO LOOP7n2
            END DO LOOP7n1
         END DO LOOP7
C CHECK TO SEE IF SATWND DATA SHOULD BE PROCESSED
         DO II = 001,071
            IF(.NOT.SUBSKP(005,II))  GO TO 234
         END DO
         GO TO 7001
  234    CONTINUE
      ELSE IF(NN.EQ.5)  THEN
C CHECK TO SEE IF ANY BUFR MESSAGES CAN BE SKIPPED IN INPUT PROFLR DUMP
         IF(.NOT.PRFLER(1))  SUBSKP(002,007) = .TRUE.
         IF(.NOT.PRFLER(2))  SUBSKP(002,009) = .TRUE.
         IF(.NOT.PRFLER(3))  SUBSKP(002,011) = .TRUE.
         IF(.NOT.PRFLER(4))  SUBSKP(002,013) = .TRUE.
         IF(.NOT.PRFLER(5))  SUBSKP(002,014) = .TRUE.
C CHECK TO SEE IF WIND PROFILER DATA SHOULD BE PROCESSED
         IF(SUBSKP(002,007).AND.SUBSKP(002,009).AND.SUBSKP(002,011).AND.
     $      SUBSKP(002,013).AND.SUBSKP(002,014))  GO TO 7001
      ELSE IF(NN.EQ.6)  THEN
C CHECK TO SEE IF VAD WIND DATA SHOULD BE PROCESSED
         IF(.NOT.VADWIN)  GO TO 7001
      ELSE IF(NN.EQ.7)  THEN
C CHECK TO SEE IF RASS TMPERATURE DATA SHOULD BE PROCESSED
         IF(.NOT.RASS)  GO TO 7001
      ELSE IF(NN.EQ.8) THEN
         IF(.NOT.UPRAIR) GO TO 7001
      END IF
      IFLAG = 0
      JFLAG = 0
      PRINT 5678, FILNAM(NN)
 5678 FORMAT(/130('.')/15X,'Next Dataset should be ',A8/130('.')/)
      GO TO 2100
C***********************************************************************
C***********************************************************************
 2090 CONTINUE
C COUNT ALL SKIPPED REPORTS
      KSKPUA = KSKPUA + 1
C***********************************************************************
C***********************************************************************
 2100 CONTINUE
      IF(NN.LT.5.OR.(NN.EQ.5.AND.IPRFPIB.GT.0).OR.NN.EQ.8)  THEN
C***********************************************************************
C CALL UNPREPBF TO UNPACK THE NEXT REPORT {NOT USED FOR WIND PROFILER
C  (EXCEPT FOR THOSE ORIGINATING FROM PILOT FORMAT BULLETINS), VAD WIND
C  OR RASS TEMPERATURE REPORTS}
         CALL UNPREPBF(IFLAG,CYCLET,IOPENED,DSNAME,IDSDAT,IDSDMP_8,
     $    *7000)
         IF(IFLAG.EQ.1.OR.IPRFPIB.EQ.2)  THEN
C.......................................................................
C IFLAG = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
            PRINT 871
  871 FORMAT(/42X,'+++  TIME WINDOW  (HRS X 100) ON REPORTS  +++'/)
            IF(NN.EQ.4)  THEN
               PRINT 872
  872          FORMAT(25X,'---> HIGH-DENSITY U.S. GEOSTATIONARY ',
     $          'REPORTS:')
               IF(.NOT.SUBSKP(005,010))  THEN
               NAME1 = 'NESDIS: GOES-ODD IMAGER C D-IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,4),I=1,6),
     $             (SWINDO_l(I,1,4),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN IMGR C.DFT-IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,4),I=1,6),
     $             (SWINDO_l(I,2,4),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,011))  THEN
               NAME1 = 'NESDIS: GOES-ODD IMAGER WV-CL.TOP (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,6),I=1,6),
     $             (SWINDO_l(I,1,6),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN IMAGER WV-CL.TOP (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,6),I=1,6),
     $             (SWINDO_l(I,2,6),I=1,6)
               NAME1 = 'NESDIS: GOES-ODD IMAGER WV-D. LYR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,7),I=1,6),
     $             (SWINDO_l(I,1,7),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN IMAGER WV-D. LYR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,7),I=1,6),
     $             (SWINDO_l(I,2,7),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,014))  THEN
               NAME1 = 'NESDIS: GOES-ODD SOUNDR WV-CL.TOP (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,8),I=1,6),
     $             (SWINDO_l(I,1,8),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN SOUNDR WV-CL.TOP (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,8),I=1,6),
     $             (SWINDO_l(I,2,8),I=1,6)
               NAME1 = 'NESDIS: GOES-ODD SOUNDR WV-D. LYR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,9),I=1,6),
     $             (SWINDO_l(I,1,9),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN SOUNDR WV-D. LYR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,9),I=1,6),
     $             (SWINDO_l(I,2,9),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,012))  THEN
               NAME1 = 'NESDIS: GOES-ODD IMAGER C.DFT-VIZ (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,5),I=1,6),
     $             (SWINDO_l(I,1,5),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN IMAGER C.DFT-VIZ (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,5),I=1,6),
     $             (SWINDO_l(I,2,5),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,013))  THEN
               NAME1 = 'NESDIS: GOES-ODD PICTURE TRIPLET  (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,1,10),I=1,6),
     $             (SWINDO_l(I,1,10),I=1,6)
               NAME1 = 'NESDIS: GOES-EVN PICTURE TRIPLET  (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,2,10),I=1,6),
     $             (SWINDO_l(I,2,10),I=1,6)
               END IF
               PRINT 8873
 8873          FORMAT(25X,'---> CONVENTIONAL FOREIGN GEOSTATIONARY ',
     $          'REPORTS:')
               IF(.NOT.SUBSKP(005,021))  THEN
               NAME1 = 'INDIA: INSAT/KALPANA CL.DFT-IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,3,1),I=1,6),
     $             (SWINDO_l(I,3,1),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,022))  THEN
               NAME1 = 'INDIA: INSAT/KALPANA CLD DRFT-VIS (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,3,3),I=1,6),
     $             (SWINDO_l(I,3,3),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,023))  THEN
               NAME1 = 'INDIA: INSAT/KALPANA CLD DRFT -WV (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,3,2),I=1,6),
     $             (SWINDO_l(I,3,2),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,041).OR..NOT.SUBSKP(005,044))  THEN
               NAME1 = 'JAPAN: GMS/MTSAT CL. DRIFT- IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,4,1),I=1,6),
     $             (SWINDO_l(I,4,1),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,042).OR..NOT.SUBSKP(005,045))  THEN
               NAME1 = 'JAPAN: GMS/MTSAT CLOUD DRIFT -VIS (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,4,3),I=1,6),
     $             (SWINDO_l(I,4,3),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,043).OR..NOT.SUBSKP(005,046))  THEN
               NAME1 = 'JAPAN: GMS/MTSAT CLOUD DRIFT - WV (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,4,2),I=1,6),
     $             (SWINDO_l(I,4,2),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,061).OR..NOT.SUBSKP(005,064).OR.
     $            .NOT.SUBSKP(006,067))  THEN
               NAME1 = 'ESA: METEOSAT-ODD CL DRIFT -IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,5,1),I=1,6),
     $             (SWINDO_l(I,5,1),I=1,6)
               NAME1 = 'ESA: METEOSAT-EVN CL DRIFT -IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,6,1),I=1,6),
     $             (SWINDO_l(I,6,1),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,062).OR..NOT.SUBSKP(005,065).OR.
     $            .NOT.SUBSKP(005,068))  THEN
               NAME1 = 'ESA: METEOSAT-ODD CLOUD DRIFT-VIS (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,5,3),I=1,6),
     $             (SWINDO_l(I,5,3),I=1,6)
               NAME1 = 'ESA: METEOSAT-EVN CLOUD DRIFT-VIS (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,6,3),I=1,6),
     $             (SWINDO_l(I,6,3),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,063).OR..NOT.SUBSKP(005,066).OR.
     $            .NOT.SUBSKP(005,069))  THEN
               NAME1 = 'ESA: METEOSAT-ODD CLOUD DRFT-WVPR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,5,2),I=1,6),
     $             (SWINDO_l(I,5,2),I=1,6)
               NAME1 = 'ESA: METEOSAT-EVN CLOUD DRFT-WVPR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,6,2),I=1,6),
     $             (SWINDO_l(I,6,2),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,070).OR..NOT.SUBSKP(005,071))
     $          PRINT 8874
 8874          FORMAT(25X,'---> POLAR-ORBITING REPORTS:')
               IF(.NOT.SUBSKP(005,070))  THEN
               NAME1 = 'NASA/MODIS: AQUA  IMGR C.DR-IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,7,4),I=1,6),
     $             (SWINDO_l(I,7,4),I=1,6)
               NAME1 = 'NASA/MODIS: TERRA IMGR C.DR-IR-LW (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,8,4),I=1,6),
     $             (SWINDO_l(I,8,4),I=1,6)
               END IF
               IF(.NOT.SUBSKP(005,071))  THEN
               NAME1 = 'NASA/MODIS: AQUA  IMGR WV-CL. TOP (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,7,6),I=1,6),
     $             (SWINDO_l(I,7,6),I=1,6)
               NAME1 = 'NASA/MODIS: TERRA IMGR WV-CL. TOP (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,8,6),I=1,6),
     $             (SWINDO_l(I,8,6),I=1,6)
               NAME1 = 'NASA/MODIS: AQUA  IMGR WV-DP. LYR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,7,7),I=1,6),
     $             (SWINDO_l(I,7,7),I=1,6)
               NAME1 = 'NASA/MODIS: TERRA IMGR WV-DP. LYR (6 LAT BANDS)'
                  PRINT 8872, NAME1,(SWINDO_e(I,8,7),I=1,6),
     $             (SWINDO_l(I,8,7),I=1,6)
               END IF
 8872          FORMAT(5X,A47,6F6.0,' TO ',6F6.0)
               PRINT'(1X)'
            ELSE IF(NN.EQ.1.OR.NN.EQ.8)  THEN
      NAME2 = '               RAOB/PIBAL - ............ MINUS AND PLUS '
               PRINT 876, NAME2,UWINDO
      NAME2 = '               RECONNAISSANCE - ........ MINUS AND PLUS '
               IF(RECCON)  PRINT 876, NAME2,RWINDO
      NAME2 = '               DROPWINSONDE - .......... MINUS AND PLUS '
               IF(DROPSN)  PRINT 876, NAME2,DWINDO
      NAME2 = '               CLASS SOUNDINGS - ....... MINUS AND PLUS '
               IF(MIN(LSMASS,LSWIND).EQ.0)  PRINT 876, NAME2,CWINDO
  876          FORMAT(27X,A56,F5.0)
               PRINT'(1X)'
            ELSE  IF(NN.EQ.3)  THEN
               IF(.NOT.SUBSKP(004,001).OR..NOT.SUBSKP(004,002))  THEN
      NAME2 = 'AIREP/PIREP ACFT; OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,1)
      NAME2 = 'AIREP/PIREP ACFT; IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,1)
               END IF
               IF(.NOT.SUBSKP(004,003))  THEN
      NAME2 = 'AMDAR AIRCRAFT;   OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,2)
      NAME2 = 'AMDAR AIRCRAFT;   IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,2)
               END IF
               IF(.NOT.SUBSKP(004,006))  THEN
      NAME2 = 'EAMDAR AIRCFT;    OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,3)
      NAME2 = 'EAMDAR AIRCFT;    IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,3)
               END IF
               IF(.NOT.SUBSKP(004,008).OR..NOT.SUBSKP(004,012).OR.
     $            .NOT.SUBSKP(004,013))  THEN
      NAME2 = 'TAMDARM AIRCFT;   OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,5)
      NAME2 = 'TAMDARM AIRCFT;   IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,5)
               END IF
               IF(.NOT.SUBSKP(004,009))  THEN
      NAME2 = 'CAMDAR AIRCFT;    OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,6)
      NAME2 = 'CAMDAR AIRCFT;    IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,6)
               END IF
               IF(.NOT.SUBSKP(004,011))  THEN
      NAME2 = 'KAMDAR AIRCFT;    OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,7)
      NAME2 = 'KAMDAR AIRCFT;    IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,7)
               END IF
               IF(.NOT.SUBSKP(004,103))  THEN
      NAME2 = 'AMDARB AIRCFT;    OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,8)
      NAME2 = 'AMDARB AIRCFT;    IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,8)
               END IF
               IF(.NOT.SUBSKP(004,010))  THEN
      NAME2 = 'TAMDARB AIRCFT;   OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(1,9)
      NAME2 = 'TAMDARB AIRCFT;   IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
                  PRINT 873, NAME2,AWINDO(2,9)
               END IF
               PRINT'(1X)'
            ELSE  IF(NN.EQ.2)  THEN
      NAME2 = 'MDCRS AIRCRAFT;   OUT US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
               PRINT 873, NAME2,AWINDO(1,4)
      NAME2 = 'MDCRS AIRCRAFT;   IN  US MNLND/OCEAN/S.ONT.-MINUS & PLUS'
               PRINT 873, NAME2,AWINDO(2,4)
               PRINT'(1X)'
            ELSE  IF(NN.EQ.5)  THEN
      NAME2 = 'WIND PROFILER DATA ORIG. FROM PILOT BULL .. MINUS & PLUS'
               PRINT 873, NAME2,PWINDO(2)
               IPRFPIB = 1
               GO TO 79
            END IF
  873       FORMAT(34X,A56,F5.0)
            GO TO 2100
C.......................................................................
         END IF
      ELSE
C***********************************************************************
         IRET = 0
C CALL W3UNPKB7 TO READ/DECODE THE NEXT WIND PROFILER (EXCEPT FOR THOSE
C  ORIGINATING FROM PILOT FORMAT BULLETINS), VAD WIND OR RASS TEMP.
C  REPORT {ASSUME THAT ALL MESSAGES IN BUFR DUMP FILE SHOULD BE READ
C  AND DECODED (TIME WINDOW CHECK LATER ON CAN FILTER REPORTS OUTSIDE
C  OF REQUESTED TIME LIMITS) - SET RANGE FROM MINUS 5 HOURS TO PLUS 5
C  HOURS SO W3UNPKB7 WILL NOT HAVE TO DO ANY TIME CHECKS - -3 TO +2
C  HOURS WOULD ALSO AVOID TIME CHECKS BUT NEED EXPANDED WINDOW
C  BECAUSE GFS DUMPS ATE +/-5 HOURS TO IMPROVE PROFCQC PERFORMANCE}
         OBS2   = BMISS  ! init obs2   array before reading any rpts
         OBS3   = BMISS  ! init OBS3   array before reading any rpts
         NOBS3  = 0      ! init NOBS3  array before reading any rpts
         obs8_8 = BMISS  ! init obs8_8 array before reading any rpts
         RDATA2 = BMISS  ! init rdata2 array before reading any rpts
         CALL W3UNPKB7(IDATE,-5,+5,NFILE,RDATA,STNID,DSNAME,RDATA2,
     $    obs8_8,IDSDAT,IDSDMP_8,SUBSET_d,SUBSKP,IRET)
C.......................................................................
         IF(IRET.EQ.1)  THEN
C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
            JFLAG = 1
            PRINT 102, DSNAME,NFILE
  102       FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')
C SPLIT CENTER DATE INTO COMPONENTS (MDATE)
            MDATE(1) = IDSDAT/1000000
            MDATE(2) = MOD((IDSDAT/10000),100)
            MDATE(3) = MOD((IDSDAT/100),100)
            MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
            call readmg(nfile,subset_t,ibdate,kret)
            iminu = iupvs01(nfile,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
            call closbf(nfile)
            call openbf(nfile,'IN',nfile)
c-----------------------------------------------------------------------
            PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101 FORMAT(/20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $ 1X,I2.2,':',i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
            IF(IDSDAT.NE.IDAT10 .and. iminu.ne.idatmm)  THEN
               PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
               GO TO 7000
            END IF
C CYCLET IS TIME THE WIND PROFILER, VAD WIND OR RASS TEMPERATURE REPORT
C  IS CENTERED ON (CYCLE TIME, to fraction of an hr if IDATMM non-zero)
            CYCLET = IDATE(4) + IDATMM / 60.d0
            PRINT 871
            IF(NN.EQ.5)  THEN
               IF(.NOT.SUBSKP(002,007))  THEN
      NAME2 = 'NOAA PROFILER NETWORK (NPN) WIND DATA ..... MINUS & PLUS'
                  PRINT 873, NAME2,PWINDO(1)
               END IF
               IF(.NOT.SUBSKP(002,011))  THEN
      NAME2 = 'COOPERATIVE AGENCY PROFLR (CAP) WIND DATA . MINUS & PLUS'
                  PRINT 873, NAME2,PWINDO(3)
               END IF
               IF(.NOT.SUBSKP(002,013))  THEN
      NAME2 = 'JAPANESE METEOR. AGENCY WIND PROFILER DATA. MINUS & PLUS'
                  PRINT 873, NAME2,PWINDO(4)
               END IF
               IF(.NOT.SUBSKP(002,014))  THEN
      NAME2 = 'HONG KONG WIND PROFILER DATA .............. MINUS & PLUS'
                  PRINT 873, NAME2,PWINDO(5)
               END IF
            ELSE  IF(NN.EQ.6)  THEN
      NAME2 = 'VAD WIND DATA ............................. MINUS & PLUS'
               PRINT 873, NAME2,VWINDO
            ELSE  IF(NN.EQ.7)  THEN
      NAME2 = 'NPN OR CAP RASS TEMPERATURE DATA .......... MINUS & PLUS'
               PRINT 873, NAME2,TWINDO
            END IF
            GO TO 2100
C.......................................................................
         ELSE  IF(IRET.EQ.8)  THEN
C A NEW BUFR MESSAGE WAS READ WITH TYPE 002, SUBTYPE 009 - THIS MESSAGE
C  CONTAINS WIND PROFILER REPORTS ORIGINATING FROM PILOT (PIBAL) FORMAT
C  BULLETINS - USE SUBROUTINE UNPREPBF TO UNPACK THESE
            PRINT 892, NFILE
  892 FORMAT(/'BUFR MESSAGE IN UNIT',I3,' CONTAINS WIND PROFILER ',
     $ 'REPORTS FROM PIBAL BULLETINS - USE SUBROUTINE UNPREPBF TO ',
     $ 'UNPACK THESE REPORTS'/)
            IOPENED = 1
            IPRFPIB = 2
            GO TO 2100
C.......................................................................
         ELSE  IF(IRET.GT.2)  THEN
C PROBLEM READING WIND PROFILER, VAD WIND OR RASS TEMPERATURE REPORT,
C  GO ON TO NEXT REPORT
            PRINT 912, DNAME(NN-4)
  912       FORMAT(/' * * ERROR READING ',A8,' REPORT'/)
            KNDCDE(NN-4) = KNDCDE(NN-4) + 1
            GO TO 2090
C.......................................................................
         ELSE  IF(IRET.EQ.2)  THEN
C ALL WIND PROFILER, VAD WIND OR RASS TEMPERATURE REPORTS READ; GO ON
C  TO NEXT DATA TYPE
            GO TO 7002
         END IF
         DATA4 = RDATA(4)
C***********************************************************************
      END IF
   79 CONTINUE
      JFLAG = 2
      KNTALL = KNTALL + 1
C-----------------------------------------------------------------------
C BEGIN SERIES OF CHECKS ON UNPACKED REPORT - IF ANY FAIL, SKIP REPORT
C-----------------------------------------------------------------------
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
      CALL CHKREP(KMSGUA,KBDYUA,*2090)
      IF(IDATA(9).EQ.62)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C        CHECKS ON OLD-TYPE "CLOUD" WIND ESTIMATES (R. TYPE 62)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C CURRENTLY THESE REPORTS ARE ALL SKIPPED (BUT KEEP COUNT)
         PRINT 105, STNID,RDATA(1),RDATA(2),IDATA(9)
  105 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OLD "CLOUD" WIND ESTIMATE')
         KNOATS = KNOATS + 1
         GO TO 2090
      ELSE  IF(IDATA(9).EQ.61)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C         CHECKS ON OLD-TYPE VTPR SATELLITE RETRIEVALS (R. TYPE 61)
C                          (OLD FGGE CASES)
C MODERN SATELLITE RETRIEVALS PROCESSED LATER IN SUBR. SATEDS OR SATBFR
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C CURRENTLY THESE REPORTS ARE ALL SKIPPED (NO COUNT)
         PRINT 9105, STNID,RDATA(1),RDATA(2),IDATA(9)
 9105 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - VTPR SATELLITE RETRIEVAL')
         GO TO 2100
      ELSE  IF(IDATA(9).EQ.51.AND.STNID(1:1).EQ.'C')  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C      CHECKS ON CLIMATOLOGY (R. TYPE 51, STATION ID BEGINS WITH 'C')
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C CURRENTLY THESE REPORTS ARE ALL SKIPPED (NO COUNT)
         PRINT 9109, STNID,RDATA(1),RDATA(2),IDATA(9)
 9109 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - CLIMATOLOGY')
         GO TO 2100
      ELSE  IF(IDATA(9).EQ.31)  THEN
         IF(IDATA(10).EQ.1)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C            CHECKS ON RECONNAISSANCE (R. TYPE 31, SUBTYPE 1)
C  (NOTE: I BELIEVE THE TIME CHECK IS NOT NEEDED HERE BECAUSE ALL RECCOS
C         ARE DATA LEVEL CAT. 6 AND GO INTO SUBR. GETC06 WHERE THEY ARE
C         AGAIN TIME CHECKED)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C SKIP REPORT IF RECCON=F (KEEP COUNT)
            IF(.NOT.RECCON)  THEN
               KSKREC = KSKREC + 1
               GO TO 2090
            ELSE
C SET UP FOR LATER CHECK IF RECCO. IS W/I TIME WINDOW (RWINDO)
               TIMWIN_e = -RWINDO * .01
               TIMWIN_l =  RWINDO * .01
cppppppppppppppppppppppppppppp
               if(idata(23).le.0) print'(" ^^^^^ Here is a RECCO that",
     $          " would NOT go into subr. GETC06 - something wrong?")'
cppppppppppppppppppppppppppppp
            END IF
         ELSE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C             CHECKS ON DROPWINSONDE (R. TYPE 31, SUBTYPE 2)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C SKIP REPORT IF DROPSN=F (KEEP COUNT)
            IF(.NOT.DROPSN)  THEN
               KSKDRP = KSKDRP + 1
               GO TO 2090
            ELSE
C SET UP FOR LATER CHECK IF DROPS. IS W/I TIME WINDOW (DWINDO)
               TIMWIN_e = -DWINDO * .01
               TIMWIN_l =  DWINDO * .01
            END IF
         END IF
         INSTR = 2
      ELSE  IF(IDATA(9).EQ.71)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     CHECKS ON NOAA PROFILER NETWORK (NPN) WIND REPORTS (R. TYPE 71)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 3
C SET UP FOR LATER CHECK IF PROFILER RPT IS W/I TIME WINDOW {PWINDO(1)}
         TIMWIN_e = -PWINDO(1) * .01
         TIMWIN_l =  PWINDO(1) * .01
      ELSE  IF(IDATA(9).EQ.73)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C              CHECKS ON WIND PROFILER REPORTS ORIGINATING FROM
C                PILOT (PIBAL) FORMAT BULLETINS  (R. TYPE 73)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 9
C SET UP FOR LATER CHECK IF PROFILER RPT IS W/I TIME WINDOW {PWINDO(2)}
         TIMWIN_e = -PWINDO(2) * .01
         TIMWIN_l =  PWINDO(2) * .01
      ELSE  IF(IDATA(9).EQ.75)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C  CHECKS ON COOPERATIVE AGENCY PROFILER (CAP) WIND RPTS (R. TYPE 75)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 7
C SET UP FOR LATER CHECK IF PROFILER RPT IS W/I TIME WINDOW {PWINDO(3)}
         TIMWIN_e = -PWINDO(3) * .01
         TIMWIN_l =  PWINDO(3) * .01
      ELSE  IF(IDATA(9).EQ.76)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C        CHECKS ON JMA (JAPANESE) WIND PROFILER REPORTS (R. TYPE 76)
C                  HONG KONG WIND PROFILER REPORTS (R. TYPE 76)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 8
C SET UP FOR LATER CHECK IF PROFILER RPT IS W/I TIME WINDOW {PWINDO(4)}
         TIMWIN_e = -PWINDO(4) * .01
         TIMWIN_l =  PWINDO(4) * .01
      ELSE  IF(IDATA(9).EQ.72)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C           CHECKS ON VAD (NEXRAD) WIND REPORTS (R. TYPE 72)
C           OTHER VAD WIND REPORTS FROM EUROPE ETC (R. TYPE 72)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 4
C SET UP FOR LATER CHECK IF VAD WIND REPORT IS W/I TIME WINDOW (VWINDO)
         TIMWIN_e = -VWINDO * .01
         TIMWIN_l =  VWINDO * .01
      ELSE  IF(IDATA(9).EQ.77)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C       CHECKS ON NPN AND CAP RASS TEMPERATURE REPORTS (R. TYPE 77)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 6
C SET UP FOR LATER CHECK IF RASS TEMP REPORT IS W/I TIME WINDOW (TWINDO)
         TIMWIN_e = -TWINDO * .01
         TIMWIN_l =  TWINDO * .01
      ELSE  IF(IDATA(9).EQ.13.AND.STNID(1:4).EQ.'CLAS')  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C          CHECKS ON CLASS SOUNDINGS (R. TYPE 13), STNID = 'CLASxx'
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C SKIP REPORT IF BOTH LSMASS AND LSWIND = 9999 (KEEP COUNT)
         IF(LSMASS.EQ.9999.AND.LSWIND.EQ.9999)  THEN
            KSKCLS = KSKCLS + 1
            GO TO 2090
         END IF
         INSTR = 2
C SET UP FOR LATER CHECK IF CLASS SNDG IS W/I TIME WINDOW (CWINDO)
         TIMWIN_e = -CWINDO * .01
         TIMWIN_l =  CWINDO * .01
      ELSE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C                CHECKS ON RADIOSONDE/PIBALS (DEFAULT)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         INSTR = 0
C SET UP FOR LATER CHECK IF RAOB, PIBAL W/I TIME WINDOW (UWINDO)
         TIMWIN_e = -UWINDO * .01
         TIMWIN_l =  UWINDO * .01
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      END IF
C***********************************************************************
C PROCESS DATA LEVEL CAT.6 {ACFT FLT-LVL, SATWND(ALL TYPES), RECCO} RPTS
C***********************************************************************
C ALL CAT. 6 RPTS ARE TREATED IN THEIR OWN SUBROUTINE
      IF(IDATA(23).GT.0.AND.(IDATA(9).EQ.31.OR.IDATA(9).EQ.41.OR.
     $ IDATA(9).EQ.63)) CALL GETC06(NN,CYCLET,*2100,*2090)
C IF REPORT IS NOT ONE OF THE VALID CAT. 6 TYPES, SKIP IT
      IF(IDATA(23).GT.0)  THEN
         PRINT 995, STNID,RDATA(1),RDATA(2),IDATA(9)
  995 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - INVALID TYPE WITH CAT. 6')
         GO TO 2090
      END IF
C***********************************************************************
C PROCESS DATA LEVEL CAT. 1-5 (RAOB, PIBAL, DROPS, PROFILERS ORIG. IN
C   PILOT FORMAT, VAD WINDS), DATA LEVEL CAT. 11 (ALL OTHER PROFILERS),
C                & DATA LEVEL CAT. 15 (RASS) REPORTS
C***********************************************************************
      IFLUA = 0
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
C STORE WORD 8 OF REPORT HEADER (REPORT "SUBTYPE") AS 2 FOR DROPS
C  (STORED AS 1 FOR RECCOS IN SUBR. GETC06)
      IF(IDATA(9).EQ.31)  HDR(8) = 2.
C  STORE WORD 8 OF REPORT HEADER (REPORT "SUBTYPE") AS 3 FOR OTHER
C  VAD WIND REPORTS FROM EUROPE AND NEW ZEALAND, AS 2 FOR VAD WIND
C  REPORTS FROM LEVEL 2 DECODER AND AS 1 FOR VAD WIND REPORTS FROM
C  RADAR CODED MESSAGE
      IF(IDATA(9).EQ.72) THEN
         IF(SUBSET_d.EQ.'NC002018')  THEN
            HDR(8) = 3.
         ELSE IF(SUBSET_d.EQ.'NC002017')  THEN
            HDR(8) = 2.
         ELSE
            HDR(8) = 1.
         END IF
      END IF
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMUA = KTIMUA + 1
         GO TO 2090
      END IF
      IF(MARLND.OR.IDATA(9).LT.21.OR.IDATA(9).GT.23)  GO TO 1490
C-----------------------------------------------------------------------
C TEST OCEAN STATION RADIOSONDE AND PIBAL REPORTS FOR OVER LAND CRITERIA
C         IF MET SUCH RPTS ARE GIVEN PREPBUFR TABLE VALUE = 15
C-----------------------------------------------------------------------
C OTHERWISE, CALL SUBR. LNDCHK, SEE IF RPT SATISFIES OVER LAND CRITERIA
      IF(NINT(RDATA(1)*100.).LT.0)  THEN
         CALL LNDCHK(RDATA(1),RDATA(2),1,4,1,GDSH,145,37,0.5,ILAND)
      ELSE
         CALL LNDCHK(RDATA(1),RDATA(2),1,4,1,GDNH,362,91,0.5,ILAND)
      END IF
      IF(ILAND.EQ.0)  GO TO 1490
C REPORT SATISFIES OVER LAND CRITERIA
C   PROCESS BUT FLAG ALL VARIABLES WITH PREPBUFR T.V. OF 15
      IF(IPRINT.EQ.0)  PRINT 1929, STNID,RDATA(1),RDATA(2),IDATA(9)
 1929 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVERLAND OCEAN STN REPORT')
      IF(IFLUA.EQ.0)  KSKOMR(1) = KSKOMR(1) + 1
      IFLUA = 1
 1490 CONTINUE
C-----------------------------------------------------------------------
C         UNPACKED REPORT HAS SUCCESSFULLY PASSED ALL CHECKS
C-----------------------------------------------------------------------
C FUNCTION ISEL CONVERTS DUMP REPORT TYPE TO A VALUE USED TO GET
C  PREPBUFR REPORT TYPE
      HDR(6) = ((ISEL(IDATA(9)) + 10) * 10) + INSTR
C CHECK FOR VALID DATA, IF NONE UNPACK NEXT REPORT
      IF(MAX(IDATA(13),IDATA(15),IDATA(17),IDATA(19),IDATA(21),
     $       IDATA(31),IDATA(35),IDATA(37),IDATA(45)).EQ.0)  GO TO 2100
C.......................................................................
C  PROCESS RAOB, PIBAL, DROPWINSONE, WIND PROFILER, VAD WIND, RASS AND
C   CLASS DATA ON MANDATORY AND SIGNIFICANT LEVELS (DATA LEVEL
C   CAT. 1-5, 11, 15)
C.......................................................................
C "ISATOB" =0 - NON-SATELLITE DATA (TRANSF. VIA COMMON, DEFAULT VALUE)
      CALL GETUPA(*2100,*2090)
C***********************************************************************
C HIT END-OF FILE - TIME TO LOOK AT NEXT UPPER-AIR FILE
 7000 CONTINUE
      REWIND NFILE
      GO TO 7003
 7002 CONTINUE
C ONLY WIND PROFILER (EXCEPT THOSE ORIG. IN PILOT FORMAT BULLETINS),
C  VAD WIND OR RASS TEMPERATURE REPORTS CAN COME HERE
      IF(JFLAG.LE.0)  THEN
         PRINT 8003, IUNIT(8)
 8003    FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN ',
     $    'FIRST CALL TO FILE IN UNIT ',I3,' -- THIS MAY BE A NULL',
     $    ' FILE -- GO TO NEXT FILE'/)
      ELSE  IF(JFLAG.EQ.1)  THEN
         PRINT 8002
 8002 FORMAT(/' * * NO REPORTS CURRENTLY PRESENT IN THIS DATA FILE,',
     $ ' GO TO NEXT FILE'/)
         END IF
 7003 CONTINUE
      PRINT 950, KNTALL
  950 FORMAT(19X,'===>  A TOTAL OF ',I6,'  REPORTS WERE UNPACKED ',
     $ 'FROM THIS FILE, WHETHER KEPT OR SKIPPED  <===',/)
      IF((NN.EQ.1.OR.NN.EQ.8).AND.KOUNT.EQ.0)  ICODE = 4
      KNTUUU(NN) = KOUNT
      IF(NN.EQ.4.AND.KNTUUU(4).GT.0)  THEN
C FOR SATWND FILE, CALL SUBROUTINE SWNTBL TO SUMMARIZE RESULTS IN TABLE
         CALL SWNTBL
      ELSE  IF(NN.EQ.2.AND.KNTUUU(2).GT.0)  THEN
C FOR AIRCAR FILE, BRIEFLY SUMMARIZE IN A TABLE
         PRINT 881, (KEPAC(I,4),I=1,6)
  881    FORMAT(/31X,'***** TABLE DETAILING THE USE OF AIRCRAFT REPORTS'
     $,   ' *****'//,20X,86('_')/43X,'||',19X,'COUNTS BY LATITUDE BAND',
     $    17X,'||'/20X,'AIRCRAFT REPORT TYPE   || 90S-70S | 70S-20S ',
     $    '| 20S-EQ  |  EQ-20N | 20N-70N | 70N-90N ||'/43X,'||',
     $    6(9X,'|'),'|'
     $    /21X,'MDCRS                 ||',6(I6,3X,'|'),'|'
     $    /20X,86('_')/)
      ELSE  IF(NN.EQ.3.AND.KNTUUU(3).GT.0)  THEN
C FOR AIRCRAFT FILE, BRIEFLY SUMMARIZE IN A TABLE
         PRINT 981, ((KEPAC(I,J),I=1,6),J=1,3),
     $              ((KEPAC(I,J),I=1,6),J=5,9)
  981    FORMAT(/31X,'***** TABLE DETAILING THE USE OF AIRCRAFT REPORTS'
     $,   ' *****'//,20X,86('_')/43X,'||',19X,'COUNTS BY LATITUDE BAND',
     $    17X,'||'/20X,'AIRCRAFT REPORT TYPE   || 90S-70S | 70S-20S ',
     $    '| 20S-EQ  |  EQ-20N | 20N-70N | 70N-90N ||'/43X,'||',
     $    6(9X,'|'),'|'
     $    /21X,'AIREP/PIREP           ||',6(I6,3X,'|'),'|'
     $    /21X,'AMDAR                 ||',6(I6,3X,'|'),'|'
     $    /21X,'EAMDAR                ||',6(I6,3X,'|'),'|'
     $    /21X,'TAMDARM               ||',6(I6,3X,'|'),'|'
     $    /21X,'CAMDAR                ||',6(I6,3X,'|'),'|'
     $    /21X,'KAMDAR                ||',6(I6,3X,'|'),'|'
     $    /21X,'AMDARB                ||',6(I6,3X,'|'),'|'
     $    /21X,'TAMDARB               ||',6(I6,3X,'|'),'|'
     $    /20X,86('_')/)
      END IF
 7001 CONTINUE
      NN = NN + 1
      IF(NN.LT.9)  GO TO 700
      PRINT 5679
 5679 FORMAT(/130('.')/130('.')/)
      FLRECO = .FALSE.
      PROFILERinADPUPA = .FALSE.
C***********************************************************************
C***********************************************************************
C ALL U-AIR DATA FILES HAVE BEEN EXAMINED, PRINT TABLES SUMMARIZING
C  HYDROSTATIC CHECK (UNLESS FILLZ = FALSE)
      IF(FILLZ)  CALL PSTATS
C READY FOR SATELLITE DATA.....
      PRINT 8050
 8050 FORMAT(//30X,21('-'),' ***** SATELLITE DATA ***** ',21('-'))
C***********************************************************************
C RTOVS OR ATOVS RADIANCES/40-LEVEL RETRIEVALS FROM BUFR DATA DUMP FILE
C***********************************************************************
C "ISATOB" =4 - RTOVS OR ATOVS 40-LEVEL RETRIEVALS (TRANSF. VIA COMMON)
      ISATOB = 4
      IF(TOVBFR(1).OR.TOVBFR(2))  CALL SATBFR
C***********************************************************************
C SPCIAL=FILLZ=FILLT=FILLW=FILLM=F ALWAYS FOR ALL OTHER SAT. RETR.
C (THEY DON'T APPLY TO 40-LVL RTOVS AND ATOVS RETRIEVALS AND GOES SNDGS)
      SPCIAL = .FALSE.
      FILLZ  = .FALSE.
      FILLT  = .FALSE.
      FILLW  = .FALSE.
      FILLM  = .FALSE.
C***********************************************************************
C        RTOVS OR ATOVS RETRIEVAL RETURNED IN UNPACKED NMCEDS FORMAT
C                        FROM BUFR DATA DUMP FILE
C***********************************************************************
C "ISATOB" =1 - RTOVS OR ATOVS RETR. RETURNED IN UNPACKED NMCEDS FORMAT
C   (TRANSF. VIA COMMON)
      ISATOB = 1
      IF(TOVEDS(1).OR.TOVEDS(2))  CALL SATEDS
C***********************************************************************
C                 GOES DATA FROM BUFR DATA DUMP FILE
C                            -- EITHER --
C  GOES SNDGS {WHEN EITHER GOESND(1) OR GOESND(2) =T} (DATA LVL CAT 12)
C                              -- OR --
C GOES PREC. WTR RETR. {WHEN GOESPW(1) OR GOESPW(2) =T} (DATA LVL CAT 8)
C                              -- OR --
C    GOES RADIANCES {WHEN GOESRD(1) OR GOESRD(2) =T} (DATA LVL CAT 13)
C                              -- OR --
C GOES CLOUD TOP RETR. {WHEN GOESCT(1) OR GOESCT(2) =T} (DATA LVL CAT 8)
C***********************************************************************
C "ISATOB" =3 - GOES REPORTS (TRANSF. VIA COMMON)
      ISATOB = 3
      IF(GOESND(1).OR.GOESPW(1).OR.GOESRD(1).OR.GOESCT(1).OR.GOESND(2)
     $ .OR.GOESPW(2).OR.GOESRD(2).OR.GOESCT(2))  CALL GOESDG
      ISATOB = -99
C***********************************************************************
C    SURFACE AND PMSL BOGUS REPORTS (DATA LEVEL CATEGORIES 51 AND 8)
C***********************************************************************
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR SURFACE PROCESSING,
C  SUBR. SFCDTA WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
      MOBS = IMISS
C INITIALIZE ALL LEVELS OF ICAT ARRAY (NOTE: FROM HERE ON, NO DATA TYPE
C  STORES CAT. IN ICAT, HOWEVER IT'S STILL REFERRED TO IN SUBR. FILLX
      ICAT = IMISS
      CALL SFCDTA
C***********************************************************************
C        SSM/I WIND SPEED, P. WATER, RAIN RATE AND B. TEMP. REPORTS
C                        (DATA LEVEL CATEGORY 8)
C***********************************************************************
      DO IB = 1,6
         IF(MIN(JPSSMI(IB,1),JPSSMI(IB,2),JPSSMI(IB,3),JPSSMI(IB,4))
     $    .EQ.0)  THEN
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR SSMI WSPD PROCESSING,
C  SUBR. GETSMI WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
            MOBS = IMISS
            CALL GETSMI
            EXIT
         END IF
      ENDDO
C***********************************************************************
C              ERS SCATTEROMETER DATA (DATA LEVEL CATEGORY 10)
C***********************************************************************
      IF(MIN(JPERSD(1),JPERSD(2),JPERSD(3),JPERSD(4),JPERSD(5),
     $ JPERSD(6)).EQ.0)  THEN
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR ERS PROCESSING, SUBR.
C  GETSCATT WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
         MOBS = IMISS
         CALL GETSCATT(1)
      END IF
C***********************************************************************
C           QUIKSCAT SCATTEROMETER DATA (DATA LEVEL CATEGORY 10)
C***********************************************************************
      IF(MIN(JPQKSD(1),JPQKSD(2),JPQKSD(3),JPQKSD(4),JPQKSD(5),
     $ JPQKSD(6)).EQ.0)  THEN
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR QUIKSCAT PROCESSING,
C  SUBR. GETSCATT WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
         MOBS = IMISS
         CALL GETSCATT(2)
      END IF
C***********************************************************************
C           WINDSAT SCATTEROMETER DATA (DATA LEVEL CATEGORY 10)
C***********************************************************************
      IF(MIN(JPWDSD(1),JPWDSD(2),JPWDSD(3),JPWDSD(4),JPWDSD(5),
     $ JPWDSD(6)).EQ.0)  THEN
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR WINDSAT PROCESSING,
C  SUBR. GETSCATT WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
         MOBS = IMISS
         CALL GETSCATT(3)
      END IF
C***********************************************************************
C             ASCAT SCATTEROMETER DATA (DATA LEVEL CATEGORY 10)
C***********************************************************************
      IF(MIN(JPASCD(1),JPASCD(2),JPASCD(3),JPASCD(4),JPASCD(5),
     $ JPASCD(6)).EQ.0)  THEN
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR ASCAT PROCESSING,
C  SUBR. GETSCATT WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
         MOBS = IMISS
         CALL GETSCATT(4)
      END IF
C***********************************************************************
C      GLOBAL POSITIONING SATELLITE - INTEGRATED PRECIPITABLE WATER
C                        / ZENITH TOTAL DELAY
C                (GPS-IPW/ZTD) DATA (DATA LEVEL CATEGORY 14)
C***********************************************************************
      IF(MIN(JPGPSD(1),JPGPSD(2),JPGPSD(3),JPGPSD(4),JPGPSD(5),
     $ JPGPSD(6)).EQ.0)  THEN
C INITIALIZE ALL LEVELS OF MOBS ARRAY (NOTE: FOR GPS-IPW/ZTD PROCESSING,
C  SUBR. GETGPSIPW WILL LATER INIT. ONLY FIRST LEVEL FOR EACH RPT)
         MOBS = IMISS
         CALL GETGPSIPW
      END IF
C***********************************************************************
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UNPREPBF
C   PRGMMR: Keyser           ORG: NP22       DATE: 2017-10-20
C
C ABSTRACT: GENERALIZED CODE TO UNPACK RPTS FROM BUFR DATA SETS VIA
C   FCN IW3UNPBF.  REPORTS ARE PLACED INTO SPECIFIED UNPACKED FORMAT.
C   IN THE FIRST CALL TO THIS SUBROUTINE FOR A NEW DATA SET, DATA SET
C   INFORMATION RETURNED FROM THE FIRST CALL TO IW3UNPBF IS USED TO
C   CHECK THE DATA SET CENTER DATE AGAINST THE CENTER (CYCLE) DATE.
C   IF THE DATES AGREE, A NORMAL RETURN OCCURS BUT WITH NO REPORT
C   UNPACKED.  THIS IS IDENTIFIED BY THE OUTPUT ARGUMENT IFLAG=1.
C   THE SECOND CALL TO THIS SUBROUTINE THEN RETURNS THE FIRST REPORT
C   IN THE DATA SET.  EACH SUBSEQUENT CALL RETURNS AN UNPACKED REPORT
C   UNTIL ALL DATA IN THE FILE HAVE BEEN PROCESSED.  ENTRY CHKREP
C   CHECKS AN UNPACKED REPORT FOR MISSING LAT/LON VALUES AND FOR
C   LAT/LON VALUES OUTSIDE THE DATA SEARCH BOUNDARY. {THE LATTER
C   CHECK DOES NOT APPLY TO AIRCRAFT REPORTS (ALL TYPES)}.
C
C PROGRAM HISTORY LOG:
C 1998-02-17  D. A. KEYSER -- ORIGINAL AUTHOR (ADAPTED FROM ORIGINAL
C    SUBROUTINE UNPREP WHICH UNPACKED ON29 DATA SETS)
C 1999-08-04  D. A. KEYSER -- MODIFIED TO READ REPROCESSED SSM/I
C    (SPSSMI) DATA FROM "JACK WOOLLEN" BUFR FILES RATHER THAN FROM ON29
C    FILES, SUBR. IW3UNPBF MOD. TO HANDLE SSM/I REPROC. DATA IN JACK"
C    BUFR
C 2001-04-06  D. A. KEYSER -- CAN HANDLE WIND PROFILERS ORIG. IN PILOT
C    (PIBAL) FORMAT BULLETINS IN "PROFLR" DUMP FILE (FOR THIS EXPANDED
C    INPUT ARG. TO INCLUDE "IOPENED", "DSNAME", "IDSDAT", "IDSDMP_8",
C    SUBSET_d")
C 2003-07-10  D. A. KEYSER -- NOW RETURNS NEW ARRAY "OBS2" OUT OF
C     CALL TO IWUNPBF, CURRENTLY JUST 2-WORDS WHERE WORD 1 IS
C     "RESTRICTIONS ON REDISTRIBUTION" (BUFR F.T. 0-35-200) AND WORD
C     2 IS "EXPIRATION OF RESTRICTIONS ON REDISTRIBUTION" (HRS)
C 2004-09-09  D. A. KEYSER -- NOW RETURNS 41-WORD (RATHER THAN 2-WORD)
C     ARRAY "OBS2" OUT OF CALL TO IW3UNPBF, WHERE WORDS 3-41 CONTAIN
C     ALTIMETER SETTING, SEA-SURFACE TEMPERATURE, SINGLE-LEVEL SENSIBLE
C     WEATHER ELEMENTS AND SST TABLE VALUE (Q.M.); RETURNS NEW ARRAY
C     ARGUMENTS "OBS3" {(5,MXBLVL,5)} AND "NOBS3" {(5)} OUT OF CALL TO
C     IW3UNPBF WHERE OBS3 CONTAINS MULTIPLE-LEVEL SENSIBLE WEATHER
C     ELEMENTS AND NOBS3 DEFINES THE NUMBER OF LEVELS OF DATA IN THE
C     OBS3(X,Y,1) TO OBS3(X,Y,5) ARRAYS (SEE IW3UNPBF DOCBLOCK FOR MORE
C     INFO)
C 2007-09-14  D. A. KEYSER -- BUMP UP ARRAY SIZE FOR UNPACKED REPORT
C     FROM IW3UNPBF FROM 3000 TO 3500
C 2015-03-09  D. A. KEYSER -- Accounts for new output argument "CBULL"
C     returned from IW3UNPBF for unpacked reports (character*11 string
C     containing wmo bulletin header and originator - filled only for
C     aircraft types right now).
C 2016-11-30  D. A. KEYSER -- Accounts for new output argument "OBS8_8"
C     returned from IW3UNPBF for unpacked reports (REAL*8 2-word array
C     containing latitude and longitude of report).
C 2017-10-20  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01. Fixed bug that did not
C     test central dump time minutes against center (cycle) PRPBUFR
C     minutes in date check (i.e., only YYYYMMDDHH were tested for a
C     match).
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30 or
C              45 (since the RTMA_RU runs 4 times per hour). This change
C              allows the print statements to reflect this new center
C              dump time format.  It also ensures that the dump vs.
C              PREPBUFR center dates are correctly tested.
C 2020-08-20 J. DONG -- Defined IDSDAT to eliminate Boundary Run-Time
C              Check Failures.
C
C USAGE:    CALL UNPREPBF(IFLAG,CYCLET,IOPENED,DSNAME,IDSDAT,IDSDMP_8,*)
C   INPUT  ARGUMENT LIST:
C     IFLAG    - SWITCH {=0 - NEW DATA SET (I.E., THIS MUST BE FIRST
C              - CALL TO THIS SUBR.); =1 - OLD DATA SET BUT ONLY
C              - DATA SET INFO RETURNED TO THIS POINT (I.E., THIS
C              - MUST BE SECOND CALL TO THIS SUBR.); =2 - OLD
C              - DATA SET WITH VALID DATA READ TO THIS POINT (I.E.,
C              - THIS MUST BE AT LEAST THE THIRD CALL TO THIS SUBR.)}
C     IOPENED  - INDICATOR AS TO WHETHER INPUT FILE HAS ALREADY
C              - BEEN OPENED BY SUBROUTINE W3UNPKB7 IN THIS PROGRAM
C              - (AND SOME REPORTS HAVE BEEN READ BY W3UNPKB7) (=0 -
C              - HAS NOT ALREADY BEEN OPENED; =1 - HAS ALREADY BEEN
C              - OPENED)
C     DSNAME   - CHARACTER*8 DATA SET NAME (IF IOPENED IS INPUT AS
C              - 0, THEN DSNAME IS NOT READ AND CAN BE INPUT AS
C              - 'ZZZZZZZZ')
C     IDSDAT   - CENTER TIME FOR DUMP DATA SET IN FORM YYYYMMDDHH (IF
C              - IOPENED IS INPUT AS 0, THEN IDSDAT IS NOT READ AND
C              - CAN BE INPUT AS ZERO)
C     IDSDMP_8 - INTEGER*8 DUMP TIME FOR DUMP DATA SET IN FORM
C              - YYYYMMDDHHMM (IF IOPENED IS INPUT AS 0, THEN IDSDMP_8
C              - IS NOT READ AND CAN BE INPUT AS ZERO)
C
C   OUTPUT ARGUMENT LIST:
C     IFLAG    - SWITCH {=1 - OLD DATA SET BUT ONLY DATA SET INFO
C              - RETURNED TO THIS POINT (I.E., THIS MUST BE FIRST CALL
C              - TO THIS SUBR.); =2 - OLD DATA SET WITH VALID DATA
C              - READ TO THIS POINT (I.E., THIS MUST BE AT LEAST THE
C              - SECOND CALL TO THIS SUBR.)}
C     CYCLET   - CYCLE TIME (IN HOURS UTC, to fraction of an hr if
C                IDATMM non-zero)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: SUBROUTINE AND ENTRY BOTH CALLED BY SUBROUTINES 'PREP',
C    'SFCDTA' AND 'GETSMI'.  ENTRY ONLY CALLED BY SUBROUTINES 'SATEDS',
C    'SATBFR', 'GOESDG' AND 'GETSCATT'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE UNPREPBF(IFLAG,CYCLET,IOPENED,DSNAME,IDSDAT,IDSDMP_8,*)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*8   STNID,CRES1,CRES2,DSNAME,SUBSET_d
      CHARACTER*11  CBULL
      INTEGER  IDATA(MAXOBS),MDATE(4)
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/GRID/IGRD,JGRD,POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL,YNLIM,
     $ YSLIM
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/XTRHD2/CRES1,CRES2,CBULL
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE  (RDATA,IDATA)
      DATA  YMISS/99998.8/

      IER = 0
      IF(IFLAG.EQ.0)  THEN
         IF(IOPENED.EQ.1)  THEN
            IER = -1
            PRINT 892, NFILE
  892 FORMAT(/'IW3UNPBF WILL NOW UNPACK REPORTS FROM A FILE (UNIT',I3,
     $ ') WHICH HAS ALREADY BEEN OPENED BY SUBROUTINE W3UNPKB7'/)
         END IF
      END IF

C CALL IW3UNPBF TO UNPACK AND READ FROM DATA SET --> RDATA, STNID,
C  CRES1, CRES2, CBULL, OBS2, OBS3, NOBS3 and obs8_8 HOLD RETURNED
C  REPORT IN SPECIFIED UNPACKED FORMAT {UNLESS FIRST CALL WHICH SHOULD
C  RETURN JUST THE DATA SET INFO (DSNAME, IDSDAT AND IDSDMP_8)}
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
      IF(IW3UNPBF(NFILE,RDATA,STNID,CRES1,CRES2,CBULL,OBS2,OBS3,NOBS3,
     $ obs8_8,DSNAME,IDSDAT,IDSDMP_8,SUBSET_d,SUBSKP,IER).EQ.0) GO TO 50
   78 CONTINUE
C-----------------------------------------------------------------------
      IF(IER.EQ.1)  THEN
C COME HERE IF FIRST CALL AND DATA SET INFORMATION RETURNED IN DSNAME,
C  IDSDAT AND IDSDMP_8
         IFLAG = 1
         PRINT 102, DSNAME,NFILE
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')
C SPLIT CENTER DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c  1st dummy message in file is open, call iupvs01 to get iminu
         iminu = iupvs01(nfile,'MINU')
         PRINT 101, DSNAME,MDATE,iminu,IDSDMP_8
  101    FORMAT(/19X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',
     $    I2.2),1X,I2.2,':',i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',
     $    I12.12/)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
         IF(IDSDAT.NE.IDAT10 .and. iminu.ne.idatmm)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
            RETURN 1
         END IF
C CYCLET IS TIME THE DATA IS CENTERED ON (CYCLE TIME, to fraction of an
C  hr if IDATMM non-zero)
         CYCLET = IDATE(4) + idatmm / 60.d0
         IF(IOPENED.EQ.1)  THEN
            IOPENED = 0
            IER = 0
            GO TO 50
         END IF
         RETURN
C-----------------------------------------------------------------------
      ELSE  IF(IER.EQ.2.OR.IER.EQ.3)  THEN
C COME HERE IF ALL REPORTS HAVE BEEN PROCESSED FOR THIS DATA SET
         IF(IFLAG.LE.0)  THEN
            PRINT 8003, NFILE
 8003       FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN ',
     $       'FIRST CALL TO FILE IN UNIT ',I3,' -- THIS MAY BE A NULL',
     $       ' FILE -- GO TO NEXT FILE'/)
         ELSE  IF(IFLAG.EQ.1)  THEN
            PRINT 8002
 8002    FORMAT(/' * * NO REPORTS CURRENTLY PRESENT IN THIS DATA FILE,',
     $    ' GO TO NEXT FILE'/)
         END IF
         RETURN 1
C-----------------------------------------------------------------------
      ELSE
C COME HERE IF A PROBLEM OCCURRED IN RETURNING A REPORT
C   -- STOP 39 (THIS SHOULD BE THE RESULT OF AN IER=999 RETURNED HERE)
         PRINT 8013
 8013    FORMAT(/5X,'###### IER FROM IW3UNPBF = 999 -- STOP 39'/)
      CALL W3TAGE('PREPOBS_PREPDATA')
      CALL ERREXIT(39)
      END IF
C-----------------------------------------------------------------------
   50 CONTINUE
      IF(IOPENED.EQ.1)  THEN
         IER = 1
         GO TO 78
      END IF
C COME HERE IF REPORT HAS BEEN SUCCESSFULLY RETURNED IN SPECIFIED FORMAT
      IFLAG = 2
      IF(NFILE.EQ.IUNIT(5)+2)  THEN
C CAN NOW FILL IN COMPLETE CARRIER ID FOR CERTAIN AIRCRAFT REPORTS
         IF(STNID(1:2).EQ.'UA'.AND.STNID(3:3).NE.'L')  THEN
            STNID = STNID(1:2)//'L'//STNID(3:7)
         ELSE  IF((STNID(1:2).EQ.'AL'.AND.STNID(3:3).NE.'L')
     $        .OR.(STNID(1:2).EQ.'DL'.AND.STNID(3:3).NE.'H'))  THEN
            STNID = STNID(1:1)//'A'//STNID(2:7)
         END IF
      END IF
      RETURN
           ENTRY CHKREP(KSMSG,KSBDY,*)
C SKIP REPORTS WITH MISSING OR UNREASONABLE LAT/LON (BUT KEEP COUNT)
      IF(NINT(RDATA(1)*100.).GT.9000.OR.NINT(RDATA(1)*100.).LT.-9000.OR.
     $ NINT(RDATA(2)*100.).GT.36000.OR.NINT(RDATA(2)*100.).LT.0)  THEN
         IF(MAX(RDATA(1),RDATA(2)).GT.YMISS)  THEN
            PRINT 953
  953 FORMAT(' * * TOTAL REPORT TOSSED  -ID=????????, LAT=???????N, ',
     $ 'LON=????????E, RTYP ??? - LAT AND LON MISSING')
         ELSE
            PRINT 954
  954 FORMAT(' * * TOTAL REPORT TOSSED  -ID=????????, LAT=???????N, ',
     $ 'LON=????????E, RTYP ??? - LAT AND LON UNREASONABLE')
         END IF
         KSMSG = KSMSG + 1
         RETURN 1
      END IF
      WLON = 360. - RDATA(2)
      IF(NINT(WLON*100.).EQ.36000)  WLON = 0.
      IF(IDATA(9).EQ.41)  RETURN
C FOR ALL TYPES EXCEPT ACFT (ALL TYPES), CHECK TO SEE IF RPT W/I LAT/LON
C  LIMIT OF DATA SEARCH AREA; SKIP RPTS O-SIDE THE LIMIT(BUT KEEP COUNT)
      IF(NINT(RDATA(1)*100.).LT.NINT(YSLIM*100.).OR.
     $   NINT(RDATA(1)*100.).GT.NINT(YNLIM*100.))  THEN
CCCCC    PRINT 952, STNID,RDATA(1),RDATA(2),IDATA(9)
CC952 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
CCCCC$ 'LON=',F8.2,'E, RTYP',I4,' - OUTSIDE SEARCH AREA ')
         KSBDY = KSBDY + 1
         RETURN 1
      END IF
      CALL LL2IJ(RDATA(1),WLON,XI,YJ)
      IF(XI.LT.1..OR.YJ.LT.1..OR.XI.GT.REAL(IGRD).OR.YJ.GT.REAL(JGRD))
     $ THEN
         KSBDY = KSBDY + 1
         RETURN 1
      END IF
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LL2IJ
C   PRGMMR: D. A. KEYSER     ORG: W/NMC22    DATE: 1990-01-11
C
C ABSTRACT: CONVERTS A REPORT'S LATITUDE/LONGITUDE TO GRID POINT
C   SPACE VIA A LINEAR COORDINATE TRANSFORMATION WITHIN THE DATA
C   SEARCH REGION INITIALLY SET UP IN NAMELIST 'RGRID' AND
C   PASSED VIA COMMON BLOCK /GRID/.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C
C USAGE:    CALL LL2IJ(YLAT,WLON,XI,YJ)
C   INPUT ARGUMENT LIST:
C     YLAT      - LATITUDE OF DATA REPORT  (NORTH +, SOUTH -)
C     WLON      - LONGITUDE OF DATA REPORT (0.0-359.99 DEG. W)
C
C   OUTPUT ARGUMENT LIST:
C     XI       - I-COORDINATE OF REPORT IN GRID PT. SPACE
C     YJ       - J-COORDINATE OF REPORT IN GRID PT. SPACE
C
C REMARKS: CALLED BY SUBROUTINE 'CHKREP'.  SEARCH GRID DEFINES AREA
C    FOR DATA EXTRACTION, ALL DATA OUTSIDE SEARCH GRID ARE EXCLUDED
C    {NO. OF GRID POINTS IN X & Y DIRECTION DEFINED BY IGRD AND JGRD
C    (DEF = 73,37)}
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE LL2IJ(YLAT,WLON,XI,YJ)
      LOGICAL  POLA,NORTH
      COMMON/GRID/IGRD,JGRD,POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL,YNLIM,
     $ YSLIM
      EQUIVALENCE(YLATS,ALONVT),(DLAT,POLEI),(XLONW,POLEJ),(DLON,XMESHL)
      DATA  CONV2R/0.017453293/,EARTHR/6371.2/
      IF(.NOT.POLA)  THEN
C GRID IS LAT/LONG (I.E., MERCATOR)
         YJ = (((NINT(YLAT*100.) - NINT(YLATS*100.))/NINT(DLAT*100.)) +
     $    100)/100
         XI = (((NINT(XLONW*100.) - NINT(WLON*100.))/NINT(DLON*100.)) +
     $    100)/100
C IF XI < 0, POSSIBLE THAT GREENWICH HAS BEEN CROSSED, ADD 360. TO XLONW
         IF(XI.LT.0.0)  XI = ((((NINT(XLONW*100.) + 36000) -
     $    NINT(WLON*100.))/NINT(DLON*100.)) + 100)/100
C WLON CAN NEVER BE LESS THAN ZERO, NEXT LINE NEVER SATISFIED
         IF(NINT(WLON*100.).LT.0)  XI = (((NINT(XLONW*100.) - (36000 +
     $    NINT(WLON*100.)))/NINT(DLON*100.)) + 100)/100
         RETURN
      ELSE
C GRID IS POLAR STEREOGRAPHIC
         RE = (EARTHR * 1.86603)/XMESHL
         ALAT = YLAT * CONV2R
         IF(.NOT.NORTH)  THEN
            ALAT = -ALAT
            ALONG = (180. - WLON + ALONVT) * CONV2R
         ELSE
            ALONG = (WLON + 180. - ALONVT) * CONV2R
         END IF
         R = (RE * COS(ALAT))/(1.0 + SIN(ALAT))
         XI = POLEI + (R * SIN(ALONG)) + 0.00000005
         YJ = POLEJ + (R * COS(ALONG)) + 0.00000005
      END IF
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    RPTLBL
C   PRGMMR: Keyser           ORG: NP22       DATE: 2016-11-30
C
C ABSTRACT: FOR ALL REPORT TYPES, STORES WORDS 4 (REPORT D-TIME), 5
C   (RECEIPT TIME), 7 (DUMP REPORT TYPE), 9 (INSTRUMENT TYPE), 10
C   (ELEVATION), 11 (SEQUENCE NUMBER), 12 (ADPUPA REPORT SOLAR AND
C   INFRARED RADIATION CORRECTION INDICATOR), 13 (REPORTED OBS. TIME),
C   14 (CORRECTION INDICATOR FOR OBS. TIME USED IN REPORT D-TIME
C   CALCULATION), AND 15 (SATELLITE ID) INTO THE REPORT HEADER ARRAY
C   "HDR".  ALSO STORES LATITUDE AND LONGITUDE INTO ALAT_8 AND ALON_8.
C   THE STATION ID (IN WORD 1 OF HDR), PREPBUFR REPORT TYPE (WORD 6) AND
C   REPORT SUBTYPE (WORD 8) ARE ALL STORED ELSEWHERE.
C
C PROGRAM HISTORY LOG:
C 1990-01-17  D. A. KEYSER (W/NMC22)
C 1992-09-08  D. A. KEYSER -- REMOVED WRITING OF STATION ID INTO WORDS
C    3-5, THIS IS NOW DONE IN SUBROUTINE FILLX
C 1993-11-02  D. A. KEYSER -- WILL STORE ON29 R.TYPE AND INSTR. TYPE IN
C    WORDS 9 & 10 OF OUTPUT RPT HDR, RESP. AND ENCODED IN PREPBUFR
C 1994-08-11  D. A. KEYSER -- WILL STORE ELEV. AND REPORT SEQ. NUMBER
C    IN REPORT HEADER (CURRENTLY ONLY MDCRS STORE SEQ. NO. IN THIS
C    SUBR.); MACHINE CHARACTER TYPE NOW USED FOR ASCII/EBCDIC
C    CONVERSION TEST RATHER THAN 'LW' VALUE
C 1998-02-17  D. A. KEYSER -- RCPT. TIME NOW STORED IN WORD 5 OF HDR;
C    ONLY IDATA(8) NOW USED TO GET RPT. INSTR. TYPE
C 1998-06-15  D. A. KEYSER -- READS SOLAR & IR RAD. CORRECTION
C    INDICATOR FROM CAT. 8 C.F. 353 (LATER ENCODED INTO PREPBUFR FILE)
C 2000-02-17  D. A. KEYSER -- LAUNCH TIME NOW READ FROM CAT. 8 CODE
C    FIG. 104 IN ORDER TO ASSIGN A BASE TIME TO FIRST DATA LEVEL;
C    LAUNCH TIME USED TO "CORRECT" OBS. TIME FOR ADPUPA RPTS IN "DHR";
C    STORE VALUES LATER ENCODED INTO PREPBUFR FILE WITH MNEMONICS "RPT"
C    (ORIG. OBS. TIME) AND "TCOR" (IND. FOR CORRECTED OBS. TIME IN"DHR")
C 2001-04-06  D. A. KEYSER -- FOR ALL SATELLITE TYPES EXCEPT SSM/I
C     SUPEROBED PRODUCTS, NOW READS SATELLITE ID FROM WORD 6 OF HEADER
C     RETURNED FROM BOTH SUBR. IW3UNPBF AND W3UNPB7; NOW HAS INPUT
C     ARGS. "TIMWIN_e" (EARLIEST TIME WINDOW) AND "TIMWIN_l" (LATEST
C     TIME WINDOW) REPL. "TIMWIN" (+/- TIME WINDOW) ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME), ALLOWS THE 2 TO BE DIFFERENT;
C     PROFILERS COMING IN DISGUISED AS PIBALS (DETERMINED BY STNID) IN
C     THE "ADPUPA" FILE ARE NO LONGER SUBJECT TO POSSIBLE REPORT TIME
C     ALTERATION AND LAUNCH TIME CALC. (THIS WAS AN OVERSIGHT IN LAST
C     IMPL. WHICH GAVE THEM R.T. 223 - THE POINT WILL SOON BE MUTE IN
C     PRODUCTION SINCE THESE WILL BE IN "PROFLR" FILE, BUT STILL NEEDED
C     FOR HISTORICAL RERUNS); PRINTS THE 4 MDCRS TURBULENCE INDECES
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM THIS SUBR.
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF NPN AND CAP RASS DATA
C     READ FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R.
C     TYPE 77, GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE
C     UNDER NEW TBL A ENTRY "RASSDA"; INITIALIZES INSTRUMENT TYPE AS
C     MISSING INSTEAD OF "99"
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 2012-11-27  D. A. KEYSER -- INCREASED MAXIMUM POSSIBLE VALUE FOR SQN
C     (SEQUENCE NUMBER) ENCODED INTO PREPBUFR FILE FROM 99998 TO 524286
C     (NEEDED BECAUSE THERE CAN NOW BE > 99998 MDCRS REPORTS IN A
C     MONOLITHIC "AIRCAR" DUMP FILE - THIS CAUSES PREPACQC TO FAIL IN
C     SERIAL PREPBUFR PROCESSING RUNS, E.G. IN SDMEDIT)
C 2015-03-11  D. A. Keyser -- SQN (sequence number) now initialized as
C     999990 instead of 99999.
C 2015-04-08  D. A. Keyser -- Encodes new, unique report subtype (TSB)
C     values into PREPBUFR file for AIRCAR types based on WMO bulletin
C     header/originator (1-U.S. MDCRS, 2-Mexican MDCRS, 3-ADS-C MDCRS,
C     99-default/unknown)
C 2016-11-30  D. A. Keyser --
C      - Carries double-precision latitude and longitude for each report
C        through code as R*8 variables ALAT_8 and ALON_8 obtained from
C        new R*8 array OBS8_8(1:2) read directly out of IW3UNPBF or
C        W3UNPKB7.  Replaces machine precision lat/lon stored in
C        HDR(2:3) (normally R*4). {Values in ALAT_8 and ALON_8 obtained
C        from HDR(2:3) only in rare event that OBS8_8(1:2) are
C        missing.}.
C
C USAGE:    CALL RPTLBL(CYCLET)
C   INPUT ARGUMENT LIST:
C     CYCLET   - CYCLE TIME (IN HOUR UTC) USED FOR TIME CHECKING A
C                REPORT (to fraction of an hr if IDATMM non-zero)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINES 'PREP', 'GETC06', 'SATEDS',
C     'SATBFR', 'GOESDG', 'SFCDTA', 'GETSMI' AND 'GETSCATT'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE RPTLBL(CYCLET)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MAXOBS = 4500)
      parameter (MXBLVL = 255)
      parameter (numobs2 = 43)
      CHARACTER*8  STNID,SUBSET_d,CRES1,CRES2
      CHARACTER*11 CBULL
      LOGICAL  PROFILERinADPUPA
      INTEGER  IDATA(MAXOBS)
      real(8)  bmiss,obs8_8,alon_8,alat_8
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/LAUNCH/ALNCH
      COMMON/PFSWCH/PRFLER(5),PWINDO(5),PROFILERinADPUPA
      COMMON/XTRHD2/CRES1,CRES2,CBULL
      common/direct/OBS3(5,MXBLVL,7),OBS2(numobs2),NOBS3(7),rdata2(25),
     $ obs8_8(2)
      common /bufrlib_missing/bmiss
      DATA  XMISS/99999./, YMISS/99998.8/,IMISS/99999/
      EQUIVALENCE (RDATA,IDATA)
      HDR(2:MXWRDH) = XMISS
      HDR(11) = XMISS*10.
      ALNCH = XMISS
      alon_8 = bmiss
      alat_8 = bmiss
C LONGITUDE GOES IN ALON_8 (EAST, RANGE: 0. TO 359.99999)
      HDR(2) = RDATA(2)

C Important: According to BUFR Manual, longitude (0-06-001 or 0-06-002)
C            {represented here by obs8_8(2)} should be in units of
C            Degrees West - and East + (-180.0 to +180.0); however some
C            BUFR data sets (e.g., PREPBUFR) are known to encode
C            longitude in units of Degree East (0.0 to 359.99) --
C            convert to PREPBUFR convention regardless of which
C            convention is used coming in here
C if obs8_8(2) (r*8) non-missing store it into alon_8 (r*8), else store
C  hdr(2) {obtained from rdata(2)} into alon_8
      if(obs8_8(2).lt.bmiss)  then
         alon_8 = 360. - mod(720.-obs8_8(2),360.)
         if(alon_8.eq.360.)  alon_8 = 0.0
      else
         alon_8 = hdr(2)
      end if
C LATITUDE GOES IN ALAT_8 (N +, RANGE: -90. TO +90.)
      HDR(3) = RDATA(1)
C if obs8_8(1) (r*8) non-missing store it into alat_8 (r*8), else store
C  hdr(3) {obtained from rdata(1)} into alat_8
      if(obs8_8(1).lt.bmiss)  then
         alat_8 = obs8_8(1)
      else
         alat_8 = hdr(3)
      end if
C DUMP REPORT TYPE GOES IN HDR(7)
      HDR(7)  = IDATA(9)
C REPORT SEQUENCE NUMBER GOES IN HDR(11) (ONLY CURRENTLY FOR MDCRS
C  AIRCRAFT REPORTS HERE)
C INSTRUMENT TYPE GOES IN HDR(9)
      HDR(9) = IDATA(8)
C IF INSTRUMENT TYPE VALID, SOLAR AND INFRARED RADIATION CORRECTION
C  INDICATOR GOES IN HDR(12) (ONLY FOR ADPUPA REPORTS HERE)
C LAUNCH TIME IS READ FOR LATER USE IN THIS SUBR. (ONLY FOR ADPUPA
C  REPORTS HERE)
      IF(NFILE.EQ.IUNIT(5).OR.NFILE.EQ.IUNIT(5)+7)  THEN
         IF(HDR(9).LT.IMISS)  THEN
            IF(HDR(9).EQ.0.OR.(HDR(9).GE.2.AND.HDR(9).LE.6).OR.
     $       HDR(9).EQ.8.OR.(HDR(9).GE.100.AND.HDR(9).LE.109).OR.
     $       HDR(9).GE.112) PRINT 261, STNID,NINT(HDR(9))
  261 FORMAT(2X,'* * *  STNID ',A8,' HAS AN UNRECOGNIZED INSTR. TYPE',
     $ ' DESIGNATION (BUFR CODE ',I3.3,') - GO AHEAD & STORE IT'/)
         END IF
         IF(IDATA(27).GT.0)  THEN
            L = IDATA(28) - 4
            DO I = 1,IDATA(27)
               L = L + 4
               IF(NINT(RDATA(L+1)).EQ.353)  THEN
C CHECK FOR ADPUPA REPORT SOLAR AND INFRARED RADIATION CORRECTION
C  INDICATOR
                  IF(RDATA(L).LT.YMISS.AND.HDR(9).LT.IMISS)
     $             HDR(12) = NINT(RDATA(L))
                  CYCLE
               ELSE  IF(NINT(RDATA(L+1)).EQ.104)  THEN
C CHECK FOR ADPUPA REPORT LAUNCH TIME
                  IF(RDATA(L).LT.YMISS)  ALNCH = RDATA(L) * 0.01
                  CYCLE
               END IF
            ENDDO
         END IF
      ELSE  IF(NFILE.EQ.IUNIT(5)+1)  THEN
         IF(IDATA(27).GT.0)  THEN
            L = IDATA(28) - 4
            DO I = 1,IDATA(27)
               L = L + 4
               IF(NINT(RDATA(L+1)).EQ.21)  THEN
ccdak             IF(RDATA(L).LT.YMISS)  THEN
                                       !SQN can now be > XMISS (99999.)
                  IF(RDATA(L).LT.YMISS*10.)  THEN
C MDCRS REPORT SEQUENCE NUMBER FOUND
                     HDR(11) = NINT(RDATA(L))
                     GO TO 856
                  END IF
               END IF
            ENDDO
         END IF
  856    CONTINUE
C DUMP REPORT SUBTYPE GOES IN HDR(8) (for MDCRS, based on WMO bulletin
C  header and originator)
         HDR(8) = 99.    ! Unknown (default)
         IF(CBULL.EQ.'IUAX02 KARP') THEN
            HDR(8) = 1.  ! U.S. MDCRS
         ELSE IF(CBULL.EQ.'IUAX01 MMMX') THEN
            HDR(8) = 2.  ! Mexico AMDAR
         ELSE IF(CBULL.EQ.'IUAX06 KARP') THEN
            HDR(8) = 3.  ! ADS-C (U.S.)
         ELSE IF(CBULL.EQ.'IUAX07 KARP') THEN
            HDR(8) = 4.  ! ADS-C (Int'l)
         ELSE IF(CBULL(1:3).EQ.'IUA'.AND.CBULL(7:11).EQ.' BABJ') THEN
            HDR(8) = 5.  ! China AMDAR
         ELSE IF(CBULL.EQ.'IUAI01 SCSC') THEN
            HDR(8) = 6.  ! S. America AMDAR
         ELSE IF(CBULL.EQ.'IUAX92 KARP') THEN
            HDR(8) = 9.  ! ADS-C (Experminental)
         END IF
      END IF
C RECEIPT TIME GOES IN HDR(5)
      HDR(5) = RDATA(11)
C ELEVATION GOES IN HDR(10)
      HDR(10) = NINT(RDATA(7))
C REPORTED OBSERVATION TIME GOES IN HDR(13)
      HDR(13) = RDATA(4)
C CORRECTION INDICATOR FOR OBS. TIME USED IN REPORT D-TIME CALCULATION
C  GOES IN HDR(14) (INITIALIZED AS 0 - NOT CORRECTED)
      HDR(14) = 0
      IF(NFILE.EQ.IUNIT(5).OR.NFILE.EQ.IUNIT(5)+7)  THEN
C WIND PROFILERS ORIG. IN PILOT (PIBAL) FORMAT BULLETINS WERE DECODED
C  AS PIBALS INTO THE "ADPUPA" DUMP FILE PRIOR TO 05/14/2001.  IF THIS
C  IS A HISTORICAL RERUN, THESE NEED TO BE IDENTIFIED SO THAT THEY ARE
C  TREATED AS PROFILERS AND ASSIGNED RTYPE 223 (WILL BE WRITTEN TO
C  "PROFLR" BUFR MESSAGES & PROCESSED BY THE SUBSEQUENT PROGRAM
C  PREPOBS_PROFCQC)
         IF(IDAT10.GT.2001051415)  THEN
            PROFILERinADPUPA = .FALSE.
         ELSE
            PROFILERinADPUPA =     (STNID.EQ.'91492   '.OR.
     $       STNID.EQ.'PSMAN   '.OR.STNID.EQ.'PSNAU   '.OR.
     $       STNID.EQ.'91609   '.OR.STNID.EQ.'PSGAL   '.OR.
     $       STNID.EQ.'PSPIU   '.OR.STNID.EQ.'03501')
         END IF
         IF(.NOT.PROFILERinADPUPA)  THEN
            IF(MOD(NINT(RDATA(4))*100000,10000).EQ.0)  THEN
C FOR REPORTS IN ADPUPA FILE WITH REPORTED OBS. TIME ON THE HOUR ...
               IF(ALNCH.LT.YMISS)  THEN
C . IF LAUNCH TIME IS NOT MISSING ...
                  IF(INT(ALNCH).EQ.INT(RDATA(4)))  THEN
C ... IF LAUNCH HOUR SAME AS REPORTED OBS. TIME HOUR ...
                     IF(MOD(ALNCH*100.,100.).LE.25.)  THEN
C     ... IF LAUNCH WAS BEFORE 15 MIN PAST HOUR, "CORRECT" OBS. TIME
C          BY ADDING 1/2 HOUR TO REPORTED VALUE
                        RDATA(4) = INT(RDATA(4)) + 0.50
                     ELSE
C     ... IF LAUNCH WAS LATER THAN 15 MIN PAST HOUR, "CORRECT" OBS. TIME
C          BY ADDING 1 HOUR TO REPORTED VALUE
                        RDATA(4) = MOD(INT(RDATA(4))+1,24)
                     END IF
      PRINT 2951,STNID,RDATA(1),RDATA(2),IDATA(9),HDR(13),RDATA(4),ALNCH
 2951 FORMAT(' # # REPORT TIME CHANGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,'- FROM',F9.5,' TO',F9.5,'; LAUNCH ',
     $ 'TIME',F6.2)
C ... HDR(14) IS RESET TO 1 (OBS. TIME IS CORRECTED, BASED ON REPORTED
C      LAUNCH TIME)
                     HDR(14) = 1
                  ELSE
C ... IF LAUNCH HOUR IS NOT SAME AS REPORTED OBS. TIME HOUR ...
                     IDT = INT(ALNCH) - INT(RDATA(4))
                     IF(IDT.GT. 12)  IDT = IDT - 24
                     IF(IDT.LT.-12)  IDT = IDT + 24
                     IF(IDT.GT.1.OR.IDT.LT.-2)  THEN
C     ... IF LAUNCH HOUR IS EITHER MORE THAN 1-HOUR LATER THAN REPORTED
C          OBS. TIME HOUR OR MORE THAN 2-HOURS EARLIER, CONSIDER LAUNCH
C          HOUR INVALID AND SET IT TO MISSING
      PRINT 5951,STNID,RDATA(1),RDATA(2),IDATA(9),ALNCH,RDATA(4)
 5951 FORMAT(' # # BAD LAUNCH TIME      -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - SET TO MISSING (WAS',F6.2,'); RPT ',
     $ 'TIME',F9.5)
                        ALNCH = XMISS
                     END IF
                  END IF
               END IF
               IF(ALNCH.GE.YMISS)  THEN
C . IF LAUNCH TIME IS MISSING ...
                  IF(INT(RDATA(4)).EQ.11.OR.INT(RDATA(4)).EQ.23)  THEN
                     IF((STNID(1:2).LT.'70'.OR.STNID(1:2).GT.'74').AND.
     $                (IDATA(9).EQ.11.OR.IDATA(9).EQ.12))  THEN
C     ... FOR LAND FIXED RAOB/PIBAL REPORTS OTHER THAN BLOCK 70-74 AT
C          11Z OR 23Z, "CORRECT" OBS. TIME BY ADDING 1/2 HOUR TO
C          REPORTED VALUE AND SET LAUNCH TIME TO 1/4 HOUR PRIOR TO
C          CORRECTED OBS. TIME
                        RDATA(4) = INT(RDATA(4)) + 0.50
      PRINT 2958,STNID,RDATA(1),RDATA(2),IDATA(9),HDR(13),RDATA(4)
 2958 FORMAT(' # # REPORT TIME CHANGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - FROM',F9.5,' TO',F9.5,'; NO ',
     $ 'REPORTED LAUNCH TIME')
                        ALNCH = INT(RDATA(4)) + 0.25
              PRINT 2959,STNID,RDATA(1),RDATA(2),IDATA(9),ALNCH,RDATA(4)
C ... HDR(14) IS RESET TO 2 (OBS. TIME IS CORRECTED, EVEN THOUGH LAUNCH
C      TIME IS MISSING)
                        HDR(14) = 2
                     END IF
                  END IF
               END IF
            END IF
            IF(ALNCH.GE.YMISS)  THEN
C AT THIS POINT, ANY REPORTS WHICH STILL HAVE A MISSING LAUNCH TIME
C  ASSIGN THE LAUNCH TIME TO BE 1/4 HOUR PRIOR TO REPORTED OBS. TIME
               ALNCH = RDATA(4) - 0.25
               IF(ALNCH.LT.0.)  ALNCH = ALNCH + 24.
              PRINT 2959,STNID,RDATA(1),RDATA(2),IDATA(9),ALNCH,RDATA(4)
 2959 FORMAT(' # # LAUNCH TIME MISSING  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - SET TO',F6.2,' (BASED ON REPORT ',
     $ 'TIME',F9.5,')')
            END IF
         END IF
      END IF
C SATELLITE ID GOES IN HDR(15) (MISSING FOR NON-SATELLITE TYPES)
      HDR(15) = REAL(IDATA(6))
C CHECK TO SEE IF REPORT IS W/I PROPER TIME WINDOW OF INPUT CYCLE TIME
      DT = RDATA(4) - CYCLET
      IF(DT.GT. 12.)  DT = DT - 24.
      IF(DT.LT.-12.)  DT = DT + 24.
C RESET RDATA(4) WORD TO DIFFERENCE BETWEEN OBS. TIME & CYCLE TIME (HRS)
      RDATA(4) = DT
C TIME DIFFERENCE GOES IN HDR(4)
      HDR(4) = RDATA(4)
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    TIMCHK
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2001-06-13
C
C ABSTRACT: PERFORMS A TIME CHECK TO SEE IF REPORT IS WITHIN PROPER
C   TIME WINDOW OF INPUT CYCLE TIME.  IF TIME CHECK FAILS WILL RETURN
C   WITH IER = 1.
C
C PROGRAM HISTORY LOG:
C 2001-06-13  D. A. KEYSER -- ORIGINAL AUTHOR (REMOVED FROM SUBR.
C    RPTLBL)
C
C USAGE:    CALL TIMCHK(DT,TIMWIN_e,TIMWIN_l,IER)
C   INPUT ARGUMENT LIST:
C     DT       - DIFFERENCE BETWEEN OBS. TIME AND CYCLE TIME (IN HOURS,
C              - REAL NUMBER PRECISION)
C     TIMWIN_e - EARLIEST TIME WINDOW (HOURS) RELATIVE TO CYCLE TIME
C              - FOR ACCEPTING REPORT ("-" IS PRIOR TO CYCLE TIME,
C              - "+" IS AFTER CYCLE TIME) (REAL NUMBER PRECISION)
C     TIMWIN_l - LATEST TIME WINDOW (HOURS) RELATIVE TO CYCLE TIME FOR
C              - ACCEPTING REPORT ("-" IS PRIOR TO CYCLE TIME, "+" IS
C              - AFTER CYCLE TIME) (REAL NUMBER PRECISION)
C
C   OUTPUT ARGUMENT LIST:
C     IER      - ERROR RETURN CODE INDICATING RESULT OF TIME CHECK
C              -   = 0 --> REPORT PASSED TIME CHECK
C              -   = 1 --> REPORT FAILED TIME CHECK & SHOULD BE PURGED
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: THIS SHOULD ONLY BE CALLED AFTER SUBROUTINE 'RPTLBL' IS
C     CALLED BECAUSE THE OBS. TIME MAY BE ADJUSTED THERE {IT ALSO
C     STORES THE OBS. TIME CORRECTION INDICATOR IN HDR(14)}.  CALLED
C     BY SUBROUTINES 'PREP', 'GETC06', 'SATEDS', 'SATBFR', 'GOESCHK',
C     'SFCDTA', 'GETSMI' AND 'GETSCATT'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE TIMCHK(DT,TIMWIN_e,TIMWIN_l,IER)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MAXOBS = 4500)
      CHARACTER*8  STNID,SUBSET_d
      INTEGER  IDATA(MAXOBS)
      real(8)  alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      EQUIVALENCE (RDATA,IDATA)
      IER = 0
      IF(NINT(DT*100000.).LT.NINT(TIMWIN_e*100000.).OR.
     $   NINT(DT*100000.).GT.NINT(TIMWIN_l*100000.))  THEN
cdak     PRINT 951, STNID,RDATA(1),RDATA(2),IDATA(9)
cd951    FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
cdak $    'LON=',F8.2,'E, RTYP',I4,' - OUTSIDE TIME WINDOW')
         IF(NINT(HDR(14)).GT.0) PRINT 100, STNID,RDATA(1),RDATA(2),
     $    IDATA(9)
  100    FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $    'LON=',F8.2,'E, RTYP',I4,' - OUTSIDE TIME WINDOW DUE TO OBS ',
     $    'TIME CORR.')
         IER = 1
      END IF
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    LNDCHK
C   PRGMMR: D. A. KEYSER     ORG: W/NMC22    DATE: 2015-04-16
C
C ABSTRACT: CHECKS THE FOUR OR SIXTEEN (BASED ON INPUT ARGUMENT "NPTS")
C   GRID POINTS SURROUNDING A REPORT.  BASED ON THE TYPE OF CHECK WILL
C   FLAG THE REPORT WITH "ILAND=1" IF ANY ONE (ICHK=2) OR IF ALL FOUR OR
C   SIXTEEN (ICHK=1) SURROUNDING GRID POINTS EXCEED A SPECIFIED CRITICAL
C   VALUE.  FOR REPORTS IN THE N. HEMISPHERE THE GRID IS 1 DEGREE
C   LAT/LON; FOR REPORTS IN THE S. HEMISPHERE THE GRID IS 2.5 DEGREE
C   LAT/LON.
C
C PROGRAM HISTORY LOG:
C 1989-02-02  D. A. KEYSER (W/NMC22)
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1992-06-30  D. A. KEYSER -- CODE GENERALIZED; GRID PASSED IN AS ARG.
C    RATHER THAN READING IN FROM FILE HERE; NEW ARG. NX, NY AND CRIT
C    ALLOW SUBR. TO BE MORE GENERAL HERE
C 2014-02-14  D. A. KEYSER -- FIXED BUG IN S.H. KXI/KYJ CALCULATION
C    WHICH LED TO ALL S.H. REPORTS NEVER HAVING "ICHK" SATISFIED,
C    MEANING ILAND WAS ALWAYS RETURNED AS 0 (E.G., FOR LAND/SEA CHECK,
C    ALL S.H. REPORTS WERE DEEMED OVER WATER REGARDLESS OF THEIR
C    LOCATION), THIS ALSO CAUSED AN ARRAY OVERFLOW SINCE KYJ COULD BE
C    CALCULATED AS 38, 1 GREATER THAN THE LIMIT; FIXED S.H. BUGS WHICH
C    CAUSED AN OVERFLOW IN KXI FOR ELON > 359.98 AND AN OVERFLOW IN KYJ
C    FOR LAT > -0.01
C 2015-04-16  D. A. KEYSER -- Added new input argument ITYC to indicate
C    whether the check being done is land/sea (=1) or geographical
C    (inside vs. outside U.S. mainland/water surrounding USA/Southern Ontario,
C    =2).  Added new input agrument NPTS to indicate whether the values
C    in the immediate surrounding 4 grid points (=4) or these plus the
C    next ring of 12 grid points (=16) should be tested against the
C    critical value.
C         Updated land/sea check for N.H. surface marine reports.  Now
C    has option (under certain conditions) to check 16 points around
C    obs lat/lon location {4 inner points as before (which is still an
C    option) plus also now 12 points in next, outer ring}.  If any one
C    of the 16 points is over water, the obs is deemed over water. On
C    the mask boundary (i.e., Prime Meridian or Equator), check reverts
C    back to only surrounding 4 points since 1 or more mask points are
C    not stored in outer 12 point ring in this case.  Several
C    additional mask points in key geographical locations known to be
C    over water are also converted from over land to over water (after
C    being read in).
C
C
C USAGE:    CALL LNDCHK(YLAT,ELON,ITYC,NPTS,ICHK,GRID,NX,NY,CRIT,ILAND)
C   INPUT ARGUMENT LIST:
C     YLAT     - LATITUDE OF DATA REPORT  (DEG. N+,S-)
C     ELON     - LONGITUDE OF DATA REPORT (0.0 TO 359.99 DEG. E)
C     ITYC     - INDICATES WHAT IS BEING CHECKED:
C                  =1  - LAND vs. SEA
C                  =2  - GEOGRAPHICAL (INSIDE vs. OUTSIDE U.S. MAINLAND/
C                        WATER SURROUNDING USA/SOUTHERN ONTARIO)
C     NPTS     - NUMBER OF GRID POINTS SURROUNDING REPORT TO BE CHECKED
C              - {SHOULD BE EITHER 4 OR 16 (I.E., 2 ROWS OUT FROM
C              - REPORT), IF SOMETHING ELSE DEFAULTS TO 4}
C              - {NOTE: IF NPTS PASSED IN AS 16 AND ANY GRID POINT 2
C              - ROWS OUT NOT STORED (I.E., ON BOUNDARY) -- OR -- ITYC
C              - IS NOT 1 -- OR -- REPORT IS IN S.H., THEN ONLY THE 4
C              - SURROUNDING GRID POINTS ARE CHECKED}
C     ICHK     - TYPE OF CHECK (=1 ALL 4 OR 16 SURROUNDING GRID PTS MUST
C              - EXCEED CRITICAL VALUE; =2 ONLY 1 OF THE 4 OR 16
C              - SURROUNDING GRID PTS NEED EXCEED CRITICAL VALUE) - IF
C              - SATISFIED, OUTPUT ARGUMENT "ILAND" SET TO 1; OTHERWISE
C              - "ILAND" SET TO 0
C     GRID     - NX X NY GRID (EITHER 1 DEG IN N.H. OR 2.5 DEG IN S.H.)
C     NX       - NUMBER OF X-DIRECTION POINTS (COLUMNS) IN "GRID"
C     NY       - NUMBER OF Y-DIRECTION POINTS (ROWS) IN "GRID"
C     CRIT     - CRITICAL VALUE FOR CHECK
C
C   OUTPUT ARGUMENT LIST:
C     ILAND    - RETURN FLAG FOR CHECK (=0 "ICHK" NOT SATISFIED; =1
C              - "ICHK" IS SATISFIED)
C
C REMARKS: CALLED BY SUBROUTINES 'PREP', 'SFCDTA', 'GETC06', AND
C     'GOESDG'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE LNDCHK(YLAT,ELON,ITYC,NPTS,ICHK,GRID,NX,NY,CRIT,ILAND)
      REAL  GRID(NX,NY)
      ILAND = 0
      ELONG = ELON + 0.0051
      IF(NINT(YLAT*100.).LT.0)  THEN
         KXI = (NINT(ELONG*100./2.5) +  100)/100
         KYJ = (NINT(YLAT*100./2.5) + 3700)/100
         IF(KYJ.EQ.37)  KYJ = 36 ! account for lat > -0.01 which can
                                 ! render KYJ=37 & overflow GRID array
         IF(KXI.EQ.145) KXI =  1 ! account for lon > 359.98 which can
                                 ! render KXI=145 & overflow GRID array
      ELSE
         KXI = (NINT(ELONG*100.) + 100)/100
         KYJ = (NINT(YLAT*100.) + 100)/100
C IF RIGHT ON NORTH POLE, CONSIDER REPORT TO BE OVER WATER
         IF(KYJ.EQ.91)  RETURN
      END IF

C If NPTS passed in as 16 but any one of the following is true:
C       - report is in S.H.,
C       - any grid point 2 rows out not stored (i.e., on boundary),
C       - ITYC is 2 (geographical test)
C  then only the 4 surrounding grid points are checked
C -----------------------------------------------------------------
      if(npts.eq.16 .and.
     $   nint(ylat*100.).ge.0 .and.
     $   ITYC.eq.1 .and.
     $   (kxi.ge.  2 .and. kxi.le. nx-2) .and.
     $   (kyj.ge.  2 .and. kyj.le. ny-2)) then
C-----------------------------------------------------------------------
C    CHECK SIXTEEN GRID POINTS SURROUNDING REPORT -- TWO METHODS
C-----------------------------------------------------------------------
         grid(286,46) = 0. !set mask pt. near St. Lawrence Seaway to sea
         grid(289,48) = 0. !set mask pt. near St. Lawrence Seaway to sea
         grid(291,49) = 0. !set mask pt. near St. Lawrence Seaway to sea
         grid(262,69) = 0  !set grid pt. near Canadian NW Territ. to sea
         grid(357,54) = 0. !set grid pt. near Irish Sea to sea
         grid( 56,26) = 0. !set grid pt. near Persian Gulf to sea
C Future: The following lat/lon values need to be converted to sea:
C           (based on Google Maps)
C           49.90N   0.40E
C           49.90N   0.10E
C           50.60N 263.10E
C           56.10N 357.10E
C           56.30N 357.70E
C           73.80N 279.50E
C           81.30N 295.90E
C           72.03N 338.75E
C           49.70N 265.50E
C           50.80N 263.30E
C           53.20N 261.70E
C           62.00N 245.90E
C           56.40N 357.80E
C           56.50N 357.90E
C           81.40N 297.40E
C           72.01N 338.73E
C           65.30N 232.80E
C           67.90N 244.90E
C           73.80N 279.70E
C           72.02N 338.74E
C  after these go on, keep watching for more points to be added to sea!
         if(ichk.eq.1)  then
C CHECK 1 ---> ALL SURROUNDING PTS MUST BE OVER LAND (MOST RESTRICTIVE)
         if(min(grid(kxi-1,kyj-1),grid(kxi  ,kyj-1),
     $          grid(kxi+1,kyj-1),grid(kxi+2,kyj-1),
     $          grid(kxi-1,kyj  ),grid(kxi  ,kyj  ),
     $          grid(kxi+1,kyj  ),grid(kxi+2,kyj  ),
     $          grid(kxi-1,kyj+1),grid(kxi  ,kyj+1),
     $          grid(kxi+1,kyj+1),grid(kxi+2,kyj+1),
     $          grid(kxi-1,kyj+2),grid(kxi  ,kyj+2),
     $          grid(kxi+1,kyj+2),grid(kxi+2,kyj+2)).gt.crit) iland=1
         ELSE
C CHECK 2 ---> ONLY 1 SURROUNDING PT NEED BE OVER LAND (LEAST RESTRCTVE)
         if(max(grid(kxi-1,kyj-1),grid(kxi  ,kyj-1),
     $          grid(kxi+1,kyj-1),grid(kxi+2,kyj-1),
     $          grid(kxi-1,kyj  ),grid(kxi  ,kyj  ),
     $          grid(kxi+1,kyj  ),grid(kxi+2,kyj  ),
     $          grid(kxi-1,kyj+1),grid(kxi  ,kyj+1),
     $          grid(kxi+1,kyj+1),grid(kxi+2,kyj+1),
     $          grid(kxi-1,kyj+2),grid(kxi  ,kyj+2),
     $          grid(kxi+1,kyj+2),grid(kxi+2,kyj+2)).gt.crit) iland=1
         END IF
      else
C-----------------------------------------------------------------------
C      CHECK FOUR GRID POINTS SURROUNDING REPORT -- TWO METHODS
C-----------------------------------------------------------------------
         IF(ICHK.EQ.1)  THEN
C CHECK 1 ---> ALL SURROUNDING PTS MUST BE OVER LAND (MOST RESTRICTIVE)
            IF(MIN(GRID(KXI,KYJ  ),GRID(KXI+1,KYJ  ),
     $             GRID(KXI,KYJ+1),GRID(KXI+1,KYJ+1)).GT.CRIT) ILAND=1
         ELSE
C CHECK 2 ---> ONLY 1 SURROUNDING PT NEED BE OVER LAND (LEAST RESTRCTVE)
            IF(MAX(GRID(KXI,KYJ  ),GRID(KXI+1,KYJ  ),
     $             GRID(KXI,KYJ+1),GRID(KXI+1,KYJ+1)).GT.CRIT) ILAND=1
         END IF
C-----------------------------------------------------------------------
      end if
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    ISEL
C   PRGMMR: D. A. KEYSER     ORG: W/NMC22    DATE: 2004-09-09
C
C ABSTRACT: FUNCTION -- CONVERTS AN UPPER-AIR DUMP REPORT TYPE TO A
C   VALUE FROM WHICH ITS PREPBUFR REPORT TYPE CAN BE DERIVED.  THE DUMP
C   REPORT TYPE IS INPUT AND THE FUNCTION RETURNS THE VALUE WHICH WILL
C   BE CONVERTED TO THE PROPER PREPBUFR REPORT TYPE BY THE CALLING
C   PROGRAM.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) &
C     RESTRUCTURED
C 1991-06-07  D. A. KEYSER -- RECOGNIZES ON29 R. TYPE FOR PROFILER RTPS
C 2001-04-06  D. A. KEYSER -- RECOGNIZES WIND PROFILERS ORIGINATING
C    FROM PILOT (PIBAL) FORMAT BULLETINS IN "PROFLR" DUMP FILE WITH
C    ON29 R.TYPE 73)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF NPN AND CAP RASS DATA
C     READ FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R.
C     TYPE 77, GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE
C     UNDER NEW TBL A ENTRY "RASSDA"
C
C USAGE:     XX = ISEL(ID)
C   INPUT ARGUMENT LIST:
C     ID       - DUMP REPORT TYPE
C
C REMARKS: 'ISEL' RETURNED IS VALUE WHICH WILL LATER BE USED TO GENERATE
C   PREPBUFR REPORT TYPE.  CALLED BY SUBROUTINES 'PREP' AND 'GETC06'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      FUNCTION ISEL(ID)
      PARAMETER  (ITYPES=18)
      INTEGER  JTYPE(ITYPES),MTYPE(ITYPES)
      DATA JTYPE/51,11,12,13,21,22,23,31,41,61,63,42,71,72,73,75,76,77/,
     $     MTYPE/ 1, 2, 2, 2, 2, 2, 2, 3, 3, 6, 4, 7, 2, 2, 2, 2, 2, 2/
      DO I = 1,ITYPES
         IF(ID.EQ.JTYPE(I))  THEN
            IS = MTYPE(I)
            ISEL = IS
            RETURN
         END IF
      ENDDO
      IS = 9
      ISEL = IS
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GETUPA
C   PRGMMR: KEYSER/LING      ORG: NP22       DATE: 2014-04-25
C
C ABSTRACT: RETRIEVES UPPER-AIR RAOB, PIBAL, DROPWINSONDE, CLASS,
C   WIND PROFILER ORIGINATING FROM PILOT (PIBAL) FORMAT BULLETINS, VAD
C   WIND & SATELLITE SOUNDING DATA (ALL TYPES EXCEPT RTOVS AND ATOVS
C   40-LVL & GOES) FROM DATA LEVEL CATEGORIES 1-5; ALL OTHER WIND
C   PROFILER DATA FROM DATA LEVEL CATEGORY 11; AND RASS TEMPERATURE
C   DATA FROM DATA LEVEL CATEGORY 15, ONE REPORT AT A TIME.  FILLS
C   DAT(NL,M) WHERE NL IS LVL (EA. CAT. HANDLED ONE -AT-A-TIME) AND M
C   IS COUNTER FOR VARIOUS DATA VARIABLES (1- "NUMDAT").  REPORTS CAN
C   HAVE ADDITIONAL "SPECIAL" PRESS. LVLS (EITHER AT APPROX. 25 OR 50
C   MB INCREMENTS) SET UP (IF SPCIAL=TRUE)
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1987-06-14  D. A. KEYSER -- CORRECTED ERROR IN TREATMENT OF PIBALS
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED; STREAMLINED
C 1989-01-25  D. A. KEYSER -- CORRECTED ERROR IN PROCESSING P(SFC) FROM
C    CAT. 2 IN 'GETUPA' WHEN INPUT PRESS. IS MISSING
C 1989-02-16  D. A. KEYSER -- PRINTS MONITOR PURGE BY CAT.; FIXED PROB.
C    'NS', 'NP', 'PINT(1)' NOT INIT. IF SATOBS=T & SIGLVL=F
C 1989-04-05  D. A. KEYSER -- ADDED SWITCH 'SPCIAL' TO PROCESS/NOT
C    PROCESS "SPECIAL"  25/50 MB PRESSURE LEVELS
C 1989-04-24  D. A. KEYSER -- ADDED CALL TO SUBR BASLIN TO PERFORM BASE-
C    LINE CHK OF NON-SAT. RPTS OUTPUT TO OI, USES SWITCH "IDELEV" TO
C    TEST FOR FAILURE
C 1989-12-13  D. A. KEYSER -- B-LINE CHECK NOW APPLIES TO ANY VALID
C    PSTN; INDIAN RAOB MASS CHK MOVED HERE FROM SUBR. STOROB
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-09-19  D  A. KEYSER -- PERF. A DVAL TEST ON U-AIR CAT. 2 LVL 1
C    PRESS, IF UNREASONABLE ASSUMES NOT PSTN
C 1990-10-25  D. A. KEYSER -- IF NO CAT.2 U-AIR, GETS PSFC FROM 1ST LVL
C    IN CAT.3 (IF VALID)
C 1991-06-07  D. A. KEYSER -- ADDED PROCESSING OF PROFILER DATA
C    (TREATED AS CAT. 4 DATA)
C 1992-01-27  D. A. KEYSER -- 925 MB MANDATORY LEVEL DATA PROCESSED
C    FROM CAT. 8(HEIGHT), 2(TEMP/TDEP) AND 3(WIND)
C 1992-06-10  D. A. KEYSER -- TOSSES ALL DATA ON ANY CAT. 2 OR 3 LVL IF
C    PRESS. .GT. SFC. PRESS. (1ST LVL)
C 1992-07-09  D. A. KEYSER -- 925 MB LVL NOT PROC. AS CAT. 2 OR 3 IF
C    MAND. LVL;
C 1992-12-02  D. A. KEYSER -- PROCESSING OF PROFILER DATA STREAMLINED
C    SINCE UNPACKED RPT HERE CLOSER TO UNPACKED ON29 THAN PREVIOUS
C    UNPACKED PROFILER RPT VIA W3FI60; PROFLR RPTS CAN ALSO BE INPUT IN
C    ADPUPA FILE (ON29 CAT.4, R. TYPE STILL 71), SWITCH "PROFIL" NOT
C    USED BUT "NWINDO" VALID
C 1993-03-17  D. A. KEYSER -- CHG IN FORMAT OF O-PUT 'IDATA' ARRAY FROM
C    W3FI77 (PROFLR UNPKER), PASS EDITION NO. TO 'MARKP'
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C    RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C    MARKERS; ON29 CAT. NO. IS STORED IN THE MOSITURE POSITION; ALL
C    NON-MISSING DATA ARE NOW PACKED INTO PREPBUFR FILE REGARDLESS OF
C    QUALITY; IN INTERNAL PROCESSING MSG DATA GET PREPBUFR TBL VALUE OF
C    16 RATHER THAN 10; VERT. COORD. INDIC. ADDED TO PREPBUFR TBL VALUE
C    LIST FOR VARIABLES
C 1993-11-02  D. A. KEYSER -- MONITOR PURGE ON ALL U-AIR MAND. LVL
C    WINDS/HGHTS-TEMPS NOW PUTS SAME TBL. VALUE ON ALL SIG. LVL WINDS/
C    TEMPS & CAT.4 HGHTS IF M.P. ON MND-LVL HGHTS
C 1994-08-11  D. A. KEYSER -- WILL PROCESS CAT. 4 LVLS EVEN IF NO. OF
C    CAT. 4 LEVELS IS < SUM OF CAT. 1,3,5 LVLS; ANY CAT. 2 OR 3 LEVEL >
C    (BELOW) SFC. PRESSURE NO LONGER SKIPPED BUT KEPT WITH ALL
C    VARIABLES ON LEVEL FLAGGED; RAOBS FAILING B-LINE CHK NOW FLAG ALL
C    CAT. 4 LEVELS BELOW TOP SPANNING PRESS. (BEFORE LVLS NOT PROCESSED)
C 1995-07-12  D. A. KEYSER -- REMOVED LOGIC TO PROCESS VAS RETRIEVALS;
C    ADDED PROCESSING OF VAD (NEXRAD) WINDS
C 1995-08-24  D. A. KEYSER -- FOR 925 MB MAND. LVL, PREPBUFR TBL VALUE
C    FOR VERTICAL COORD. (PRESS) INITIALIZED TO DEFAULT (7), BEFORE WAS
C    INITIALIZED TO 16
C 1996-02-07  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: ORIGINAL TESTS FOR
C    OLD PREPDA PROC. OF CAT. 4 LVLS RETAINED (TO MAKE BUFR-PREPDA FILE
C    CONTAIN DATA EXPECTED BY FERR PGM AND OI ANALYSIS)
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C    BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C    (DEWPT SET TO MISSING IF TEMP. BAD; SFC LVL HGHT. Q.M. SET TO 1
C    RATHER THAN 6)
C 1996-09-03  D. A. KEYSER -- ALLOW BUFR EDIT. 3 WIND PROFILER MSGS TO
C    BE PROCESSED
C 1996-10-24  D. A. KEYSER -- FOR U-AIR REPORT FAILING B-LINE CHK ANY
C    VARIABLES WITH AN EXISTING KEEP FLAG ON THEM WILL NOT BE FLAGGED
C    AS BAD OR SUSPECT
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C    TYPES (CURRENTLY JUST 100, 101-103, 105 TO IDENTIFY INTERPOLATED
C    DATA FOR CQCBUFR PGM); CHGS IN LVL ON29 CATEGORY INDICATORS: SPEC.
C    LVLS GET CAT=7 RATHER THAN 6; STDOUT EXPANDED TO INCL. REASON
C    CODES
C 1997-07-02  D. A. KEYSER -- QUAL. MARKER FOR VAD WIND LEVELS WITH
C    INPUT RMS VECTOR ERROR TAG OF "B" (3.9 KNOTS) DOWNGRADED FROM
C    NEUTRAL TO SUSPECT (AT REQUEST OF NOAA/FSL)
C 1998-02-17  D. A. KEYSER -- CHANGES TO INTERFACE WITH NEW UNPACKED
C    IW3UNPBF FORMAT (RATHER THAN IW3GAD), MAINLY PRESS. STORED IN WORD
C    1, 925 MB LEVEL IN CAT. 1; REMOVED LOGIC RE: FLAGGING SIG. LVL IF
C    ALL MAND. LVLS FLAGGED; SPCIAL=F NO LONGER GENERATES SPEC. LEVELS;
C    CAT. 5 LVLS WITH WSPD=0 ARE FLAGGED; REMOVED B-LINE CHECK LOGIC
C 1998-05-15  D. A. KEYSER -- FLAGGING OF TROP LVLS WITH WSPD=0 MOVED
C    FROM SUBR. GETUPA TO STOROB BECAUSE SOME CALM TROP WINDS WEREN'T
C    BEING IDENTIFIED
C 1999-01-20  D. A. KEYSER -- ADDED N-LIST SWITCHES "IVADFL" AND
C   "IVADSP" TO SELECT VAD WIND RMSVE TOLERANCE
C 2002-01-28  D. A. KEYSER -- NOW RECOGNIZES THAT W3UNPKB7 CAN RETURN A
C     VAD WIND Q.M. OF 12 (MEANING ON REJECT LIST) OR 14 (MEANING SDM
C     PURGED) ALONG WITH EXISTING Q.M. GENERATED FROM RMS VECTOR ERROR;
C     NOW RECOGNIZES THAT W3UNPKB7 CAN RETURN A WIND PROFILER "QUALITY
C     CODE" OF 14 (MEANING EITHER ON WIND REJECT LIST OR SDM PURGED)
C     ALONG WITH EXISTING Q. CODES FROM FSL/HUB
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF NPN AND CAP RASS DATA
C     READ FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R.
C     TYPE 77, GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE
C     UNDER NEW TBL A ENTRY "RASSDA"
C 2014-04-25  D. A. Keyser -- No longer aborts with RC=99 if number of
C     levels in a report exceeds the limit of "MXLVL".  Instead, now
C     skips the offending report(s) and, at the very end, posts a
C     message to the JOBLOG file noting how many reports were skipped
C     due to this issue.
C 2014-04-25  Y. Ling      -- No conversion of winds from dir/speed to
C     u/v for VAD wind reports from Level 2 decoder since these are
C     already u/v and are stored in m/sec
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. HP, XP, AND YP WERE
C     ADDED TO KEEP LOCATION AND TIME INFORMATION. IS WAS ADDED AS AN
C     ARRAY TO KEEP THE DATA. UPRAIR DATA USES DATA LEVEL CATEGORIES 1,
C     2, AND 10, SO GPS DATA WAS ADDED TO ALL 3. THE SIZE OF EACH DATA
C     ARRAY NEEDED TO BE INCREASED BY 3. 
C
C USAGE:    CALL GETUPA(*,*)
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINES 'PREP' & 'SNDPRP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GETUPA(*,*)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      PARAMETER (MAXOBS = 4500)
      CHARACTER*5  CTYPE
      CHARACTER*8  STNPRT,STNID,SUBSET_d
      LOGICAL  KTEMP,PG4243,SPCIAL
      INTEGER  IDATA(MAXOBS),IQ(MXLVL,NUMQMS),IPRT(2),IR(MXLVL,NUMQMS),
     $ MARKP(0:14)
      REAL  PS(47),IS(MXLVL,NUMGPS)
      real(8)  BMISS,GETBMISS,alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/PARM2/PG4243,KTEMP,i2many_lvls
      COMMON/PARM3/RECCON,RWINDO,UWINDO,RECSLM,FLRECO,VWINDO,VADWIN,
     $ IVADFL,IVADSP,FLDMGS,FLDMAF,FLDMFR,DROPSN,DWINDO,UPRAIR
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/RUNSW/IRNMRK
      COMMON /BUFRLIB_MISSING/BMISS
C DATA AT PRESSURE LEVELS (MESHED SOUNDING)
      EQUIVALENCE  (RDATA,IDATA),(DAT(1,NUMVAR+1),IQ)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+1),IR)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+NUMQMS+1),IS)
      DATA  XMISS/99999./,YMISS/99998.8/,IMISS/99999/
      DATA  PS/1000.,975.,950.,925.,900.,875.,850.,825.,800.,775.,
     $          750.,725.,700.,675.,650.,625.,600.,575.,550.,525.,
     $          500.,475.,450.,425.,400.,375.,350.,325.,300.,275.,
     $          250.,225.,200.,175.,150.,125.,100., 85., 70., 60.,
     $           50., 40., 30., 25., 20., 15., 10./
      DATA  MARKP/1,3,11,2,12,2,2,2,13,2,2,2,10,14,14/
CVVVVV%%%%%TEMP FOR PRINT
cdak  DATA  IPRTF/0/
CAAAAA%%%%%
C FCN PR GETS PRESSURE FROM STANDARD ATMOSPHERE HEIGHT (Z < 11000M)
      PR(Z) = 1013.25 * (((288.15 - (.0065 * Z))/288.15)**5.256)
C GET LIMITS FOR EXTRACTING DATA:
C    PTOP IS TOP LEVEL FOR EXTRACTING CAT. 1, 3, & SPECIAL LEVEL DATA
C    STOP IS TOP LEVEL FOR EXTRACTING CAT. 2/5 DATA
C    QTOP IS TOP LEVEL FOR EXTRACTING CAT. 1 AND 2/5 MOISTURE DATA
C    ZTOP IS TOP LEVEL FOR EXTRACTING CAT. 4/11 AND 15 DATA
C       (ZTOP IS STD ATMOS. HEIGHT CORRESPONDING TO PTOP)
      PTOP = PMAND(LEVPM)
      CALL W3FA03(PTOP,ZTOP,TTOP,THETA)
      STOP = PMAND(LEVST)
      QTOP = PMAND(LEVQQ)
      ELEV = NINT(RDATA(7))
C IQMLIM IS PREPBUFR TABLE VALUE LIMIT FOR ACCEPTING RPTS
      IQMLIM = 16
C IQMGUD IS THE HIGHEST 'NON-REJECTED' PREPBUFR TABLE VALUE
      IQMGUD = 3
      IBLIZ1 = 99
      INDIAN = 0
C INDIAN=1: INDIAN MASS RAOB RPT TO BE AT LEAST FLAGGED & POSS. PURGED
      IF(PG4243.AND.HDR(6).EQ.120.AND.(STNID(1:2).EQ.'42'.OR.
     $ STNID(1:2).EQ.'43'))  INDIAN = 1
C***********************************************************************
C      COLLECT UPPER-AIR DATA IN DATA LEVEL CATEGORIES 1 - 5, 10, 15
C         IQ(N,3) IS NOW USED TO RECORD CATEGORY OF INPUT DATA
C***********************************************************************
      DAT = XMISS
      IQ = 16
C INITIALIZE ALL REASON CODES AS 100 (ORIGINAL DATA)
      IR = 100
      STAP = XMISS
      BMISS=GETBMISS()
C
C FOR EACH REPORT, DAT IS FILLED WITH UNPACKED DATA AS FOLLOWS:
C  OBSERVATIONS FOR:
C   DAT(NL,1)  - PRESSURE              DAT(NL,2)  - HEIGHT
C   DAT(NL,3)  - REPORTED TEMP (SEE #) DAT(NL,4)  - DEWPOINT TEMPERATURE
C   DAT(NL,5)  - WIND DIRECTION        DAT(NL,6)  - WIND SPEED
C  PREPBUFR TABLE VALUES FOR:
C   DAT(NL,7) - HEIGHT                DAT(NL,8)  - TEMPERATURE
C   DAT(NL,9) - DATA LEVEL CATEGORY   DAT(NL,10) - WIND
C   DAT(NL,11)- VERTICAL COORDINATE
C  GPS VALUES:
C   DAT(NL,17) - HRDR   DAT(NL,18) - YDR   DAT(NL,19) - XDR
C
C  # - SENSIBLE TEMPERATURE FOR ALL NON-SATELLITE DATA TYPES
C      VIRTUAL TEMPERATURE FOR RTOVS OR ATOVS (UNPACKED NMCEDS)
C
C NL IS COUNT OF TOTAL LVLS FROM ALL CATEGORIES (1-5, 10, 11, 15 + SPECIAL)
C NP3 IS COUNT OF ALL LEVELS CONTAINING VALID WIND DATA IN CAT. 1,3,5,10
C NPZ IS COUNT OF ALL LVLS CONTAINING NON-MISSING HGHT DATA IN
C CATEGORIES 1,2,10
C  (ONLY SIGNIFICANT WHEN SPCIAL = FALSE)
      NL  = 0
      NP3 = 0
      NPZ = 0
C-----------------------------------------------------------------------
C        MANDATORY LEVEL MASS AND WIND DATA (DATA LEVEL CATEGORY 1)
C-----------------------------------------------------------------------
C
C NN IS NO. OF LEVELS THAT WILL BE CONSIDERED
C NM IS NO. OF MANDATORY DATA LEVELS (CAT. 1) ACTUALLY COLLECTED
      NM = 0
      NN = IDATA(13)
C     THE 14 BELOW IS EQUIVALENT TO MCAT(1) FROM IW3UNPBF. CHANGE 14 IF
C     THAT VALUE CHANGES DUE TO INCREASE OR DECREASE IN VARS SAVED. 
      II = IDATA(14) - 14
      NN = MIN(NN,LEVPM)
      IZBEST = 99
      IF(NN.LE.0)  GO TO 11
      DO N = 1,NN
C        THE 14 BELOW IS EQUIVALENT TO MCAT(1) FROM IW3UNPBF. CHANGE 14
C        IF THAT VALUE CHANGES DUE TO INCREASE OR DECREASE IN VARS
C        SAVED.
         II = II + 14
C GET PREPBUFR TABLE VALUES FOR PRESSURE, HGHT, TEMP., MOISTURE, & WIND
         IPM = NINT(RDATA(II+ 6))
         IZM = NINT(RDATA(II+ 7))
         ITM = NINT(RDATA(II+ 8))
         IQM = NINT(RDATA(II+ 9))
         IVM = NINT(RDATA(II+10))
C  GET GPS DATA IF AVAILABLE
         IF(RDATA(II+11).LT.BMISS) THEN
           GPST=NINT(RDATA(II+11))
         ELSE 
           GPST=BMISS
         END IF
         IF(RDATA(II+12).LT.BMISS) THEN
           GPSY=(NINT(RDATA(II+12))/100000.)
         ELSE
           GPSY=BMISS
         END IF
         IF(RDATA(II+13).LT.BMISS) THEN
           GPSX=(NINT(RDATA(II+13))/100000.)
         ELSE
           GPSX=BMISS
         END IF
         IBTEST = 0
         IF(IZM.GT.3)  IBTEST = 1
         IBLIZ1 = MIN(IBLIZ1,IBTEST)
C IF REPORT IS RTOVS OR ATOVS SAT RETRIEVAL, ALL MANDATORY LEVELS
C  PROCESSED (EVEN IF DATA MISSING)
         IF(ISATOB.EQ.0.AND.MIN(RDATA(II+1),RDATA(II+2)).GE.YMISS.AND.
     $    (MAX(RDATA(II+4),RDATA(II+5)).GE.YMISS))  CYCLE
         NL = NL + 1
         IQ(NL,3) = 1
         DAT(NL,1) = NINT(RDATA(II)) * 0.1
         IQ(NL,5) = IPM
         CALL W3FA03(DAT(NL,1),DAT(NL,2),DAT(NL,3),THETA)
         IF(RDATA(II+1).LT.YMISS)  THEN
            DAT(NL,2) = NINT(RDATA(II+1))
            IQ(NL,1) = IZM
            NPZ = NPZ + 1
         END IF
         IF(RDATA(II+2).LT.YMISS)  THEN
            DAT(NL,3) = (NINT(RDATA(II+2)) * 0.1) + 273.16
            IQ(NL,2) = ITM
            IF(DAT(NL,1).GE.QTOP.AND.RDATA(II+3).LT.YMISS
     $       .AND.NINT(RDATA(II+3)).GE.0)  THEN
               DEWPT = DAT(NL,3) - (NINT(RDATA(II+3)) * 0.1)
C PROCESS NON-MSG MOISTURE REGARDLESS OF PREPBUFR TBL VAL
               IF(MAX(IQM,ITM).LT.IQMLIM)  DAT(NL,4) = DEWPT
            END IF
         END IF
C IZBEST IS BEST (LOWEST) HEIGHT PREPBUFR TBL VALUE AMONGST ALL LEVELS
         IZBEST = MIN(IQ(NL,1),IZBEST)
C IF KTEMP = T, THEN ALSO EXAMINE TEMP PREPBUFR TABLE VALUE FOR IZBEST
         IF(KTEMP)  IZBEST = MIN(IQ(NL,2),IZBEST)
         IF(MAX(RDATA(II+4),RDATA(II+5)).LT.YMISS.AND.IVM.LT.IQMLIM)THEN
C PROCESS NON-MSG WIND REGARDLESS OF PREPBUFR TABLE VALUE
            IF(IQ(NL,1).LT.3)  NP3 = NP3 + 1
            DAT(NL,5) = NINT(RDATA(II+4))
            DAT(NL,6) = NINT(RDATA(II+5)) * 0.1
            IQ(NL,4) = IVM
         END IF
         IS(NL,1) = GPST 
         IS(NL,2) = GPSY
         IS(NL,3) = GPSX
      ENDDO
   11 CONTINUE
      NM = NL
C-----------------------------------------------------------------------
C        SIGNIFICANT LEVEL MASS (TEMP) DATA (DATA LEVEL CATEGORY 2)
C-----------------------------------------------------------------------
C
C NN IS NO. OF LEVELS THAT WILL BE CONSIDERED
C NSIG IS NO. OF SIGNIFICANT DATA (CAT. 2) LEVELS ACTUALLY COLLECTED
      NSIG = 0
      NN = IDATA(15)
C     THE 10 BELOW IS EQUIVALENT TO MCAT(2) FROM IW3UNPBF. CHANGE WHEN
C     THERE IS A CHANGE IN NUMBER OF VARIABLES SAVED. SAME WITH THE 10
C     FIVE LINES BELOW.
      II = IDATA(16) - 10
      NP1VLD = 0
      IF(NN.EQ.0)  GO TO 5694
      DO N = 1,NN
         II = II + 10
C GET PREPBUFR TBL VALUES FOR PRESS., TEMP., AND MOISTURE AT THIS LEVEL
         IPM = NINT(RDATA(II+3))
         ITM = NINT(RDATA(II+4))
         IQM = NINT(RDATA(II+5))
C SAVE GPS DATA
         IF(RDATA(II+7).LT.BMISS) THEN
           GPST = NINT(RDATA(II+7))
         ELSE
           GPST=BMISS
         ENDIF
         IF(RDATA(II+8).LT.BMISS) THEN
           GPSY = NINT(RDATA(II+8))
         ELSE
           GPSY=BMISS
         ENDIF
         IF(RDATA(II+9).LT.BMISS) THEN
           GPSX = NINT(RDATA(II+9))
         ELSE
           GPSX=BMISS
         ENDIF
C IF PRESSURE IS MISSING, SKIP PROCESSING OF THIS LEVEL
        IF(NINT(RDATA(II)).GE.32750.OR.(NINT(RDATA(II))*0.1).LT.STOP.OR.
     $    IPM.GE.IQMLIM)  CYCLE
C IF PRESSURE > STN (SFC) PRESSURE (GOOD ONLY)FLAG ALL DATA ON THIS LVL
         IF(NP1VLD.EQ.1.AND.(NINT(RDATA(II))*0.1).GT.DAT(NM+1,1))  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
            IPM = 15
            ITM = 15
            IQM = 15
CVVVVV%%%%%TEMP FOR PRINT
cdak        PRINT'(" ~~~~~")'
cdak        IPRTF = 1
CAAAAA%%%%%
            PRINT 1415, STNID,RDATA(1),RDATA(2),IDATA(9),RDATA(II)*.1,
     $       DAT(NM+1,1)
 1415 FORMAT(' * * CAT2,LVL DATA FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESS =',F7.2,' > SFC PRESS(',F7.2,
     $ ')')
         END IF
         IF(NINT(RDATA(II)).GE.10750)  THEN
C IF PRESSURE > 1075 MB FLAG PRESSURE ON LVL
          ! this should not be monitored by GSI!! (but is since qm=15)
            IPM = 15
CVVVVV%%%%%TEMP FOR PRINT
cdak        PRINT'(" ~~~~~")'
cdak        IPRTF = 1
CAAAAA%%%%%
            PRINT 1215, STNID,RDATA(1),RDATA(2),IDATA(9)
 1215 FORMAT(' * * CAT2,LVL PRES FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESSURE > 1075 MB')
         END IF
         IF(N.EQ.1)  THEN
C CHECK PRESSURE OF FIRST CAT.2 LVL (SHOULD BE SFC) TO SEE IF REASONABLE
            DVAL = 0.0
            IF(ELEV.LT.YMISS)  DVAL = (NINT(RDATA(II)) * 0.1) - PR(ELEV)
            IF(DVAL.GT.-75..AND.DVAL.LT.50.)  THEN
C IF SO,SET NP1VLD=1 -INDICATES THIS IS THE SURFACE & PRESSURE IS "GOOD"
               NP1VLD = 1
            ELSE
C ELSE, SET NP1VLD=-1 & FLAG PRESSURE ON LVL -INDICATES THIS IS THE
C  SURFACE & PRESSURE IS "BAD"
CVVVVV%%%%%TEMP FOR PRINT
cdak        PRINT'(" ~~~~~")'
cdak           IPRTF = 1
CAAAAA%%%%%
               PRINT 915, STNID,RDATA(1),RDATA(2),IDATA(9),DVAL,ELEV
  915 FORMAT(' * * CAT2,SFC PRES FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PSTN DVALUE(',F7.1,') BAD, ELEV =',
     $ F7.1)
               NP1VLD = -1
          ! this should not be monitored by GSI!! (but is since qm=15)
               IPM = 15
            END IF
         END IF
C IF THIS IS NOT SFC LVL DON'T PROCESS LVL IF TEMP MISSING
         IF((N.GT.1.OR.NP1VLD.EQ.0).AND.RDATA(II+1).GE.YMISS)  CYCLE
         NL = NL + 1
         IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
            PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
 9953 FORMAT(' # # TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - EXCEEDS LIMIT OF',I6,' LVLS')
            i2many_lvls = i2many_lvls + 1
            RETURN 2
C----------------------------------------------------------------------
         END IF
         NSIG = NSIG + 1
         IQ(NL,3) = 2
         IQ(NL,5) = IPM
         DAT(NL,1) = NINT(RDATA(II)) * 0.1
         CALL W3FA03(DAT(NL,1),DAT(NL,2),DAT(NL,3),THETA)
         IF(RDATA(II+1).LT.YMISS)  THEN
            DAT(NL,3) = (NINT(RDATA(II+1)) * 0.1) + 273.16
            IQ(NL,2) = ITM
            IF(DAT(NL,1).GE.QTOP.AND.RDATA(II+2).LT.YMISS.AND.
     $       NINT(RDATA(II+2)).GE.0)  THEN
               DEWPT = DAT(NL,3) - (NINT(RDATA(II+2)) * 0.1)
C PROCESS NON-MSG MOISTURE REGARDLESS OF PREPBUFR TBL VAL
               IF(MAX(IQM,ITM).LT.IQMLIM)  DAT(NL,4) = DEWPT
            END IF
         END IF
         IS(NL,1) = GPST
         IS(NL,2) = GPSY
         IS(NL,3) = GPSX
      ENDDO
C RESET IDATA(15) TO NUMBER OF 'GOOD' CAT. 2 LEVELS ACTUALLY PROCESSED
      IDATA(15) = NSIG
 5694 CONTINUE
C-----------------------------------------------------------------------
C TROPOPAUSE LEVEL MASS AND WIND DATA (DATA LEVEL CATEGORY 5) -
C  TREATED LIKE DATA LEVEL CATEGORY 2
C-----------------------------------------------------------------------
C
C NN IS NO. OF LEVELS THAT WILL BE CONSIDERED
C N5 IS NO. OF TROPOPAUSE (CAT. 5) LEVELS ACTUALLY COLLECTED
      N5 = 0
      NN = IDATA(21)
      II = IDATA(22) - 9
      IF(NN.EQ.0)  GO TO 21
      DO N = 1,NN
         II = II + 9
C GET PREPBUFR TABLE VALUES FOR TEMP., MOISTURE AND WIND AT THIS LEVEL
         IPM = NINT(RDATA(II+5))
         ITM = NINT(RDATA(II+6))
         IQM = NINT(RDATA(II+7))
         IVM = NINT(RDATA(II+8))
C CHECK FOR UNREASONABLE PRESSURE, IF SO SKIP PROCESSING OF THIS LEVEL
         IF(NINT(RDATA(II)).GE.10750)  CYCLE
C PROCESS NON-MSG PRESSURE REGARDLESS OF PREPBUFR TBL VAL
         IF(IPM.GE.IQMLIM.OR.(NINT(RDATA(II))*0.1).LT.STOP)  CYCLE
         IF(MIN(RDATA(II+1),RDATA(II+2)).GE.YMISS.AND.
     $      MAX(RDATA(II+3),RDATA(II+4)).GE.YMISS)  CYCLE
         NL = NL + 1
         IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
            PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
            i2many_lvls = i2many_lvls + 1
            RETURN 2
C----------------------------------------------------------------------
         END IF
         N5 = N5 + 1
         IQ(NL,3) = 5
         IQ(NL,5) = IPM
         DAT(NL,1) = NINT(RDATA(II)) * 0.1
         CALL W3FA03(DAT(NL,1),DAT(NL,2),DAT(NL,3),THETA)
         IF(RDATA(II+1).LT.YMISS)  THEN
            DAT(NL,3) = (NINT(RDATA(II+1)) * 0.1) + 273.16
            IQ(NL,2) = ITM
            IF(DAT(NL,1).GE.QTOP.AND.RDATA(II+2).LT.YMISS
     $       .AND.NINT(RDATA(II+2)).GE.0)  THEN
               DEWPT = DAT(NL,3) - (NINT(RDATA(II+2)) * 0.1)
C PROCESS NON-MSG MOISTURE REGARDLESS OF PREPBUFR TBL VAL
               IF(MAX(IQM,ITM).LT.IQMLIM)  DAT(NL,4) = DEWPT
            END IF
         END IF
         IF(MAX(RDATA(II+3),RDATA(II+4)).LT.YMISS.AND.IVM.LT.IQMLIM)THEN
C PROCESS NON-MSG WIND REGARDLESS OF PREPBUFR TABLE VALUE
            NP3 = NP3 + 1
            DAT(NL,5) = NINT(RDATA(II+3))
            DAT(NL,6) = NINT(RDATA(II+4)) * 0.1
            IQ(NL,4) = IVM
         END IF
      ENDDO
C RESET IDATA(21) TO NUMBER OF 'GOOD' CAT. 5 LEVELS ACTUALLY PROCESSED
      IDATA(21) = N5
   21 CONTINUE
C N125 IS THE NUMBER OF CAT. 1, 2, AND 5 LEVELS COLLECTED
      N125 = NL
C---------------------------------------------------vv--CH 07/23/2021-vv
C-----------------------------------------------------------------------
C    BUFR SPECIFIC LEVEL MASS AND WIND DATA (DATA LEVEL CATEGORY 10)
C-----------------------------------------------------------------------
C
C NN IS NO. OF LEVELS THAT WILL BE CONSIDERED
C NB IS NO. OF BUFR DATA LEVELS (CAT. 10) ACTUALLY COLLECTED
      NB = 0
      NN = IDATA(31)
C      II = IDATA(32) - 11
      II = IDATA(32) - 14
C x   NN = MIN(NN,LEVPM)
      IZBEST = 99
      IF(NN.LE.0)  GO TO 5695
      DO N = 1,NN
C         II = II + 11
         II = II + 14
C GET PREPBUFR TABLE VALUES FOR PRESSURE, HGHT, TEMP., MOISTURE, & WIND
         IPM = NINT(RDATA(II+ 6))
         IZM = NINT(RDATA(II+ 7))
         ITM = NINT(RDATA(II+ 8))
         IQM = NINT(RDATA(II+ 9))
         IVM = NINT(RDATA(II+10))
         IF(RDATA(II+11).LT.BMISS) THEN
           GPST=RDATA(II+11)
         ELSE 
           GPST=BMISS
         END IF
         IF(RDATA(II+12).LT.BMISS) THEN
           GPSY=(NINT(RDATA(II+12))*0.00001)
         ELSE
           GPSY=BMISS
         ENDIF
         IF(RDATA(II+13).LT.BMISS) THEN
           GPSX=(NINT(RDATA(II+13))*0.00001)
         ELSE
           GPSX=BMISS
         ENDIF
         IBTEST = 0
         IF(IZM.GT.3)  IBTEST = 1
         IBLIZ1 = MIN(IBLIZ1,IBTEST)
C  SKIP IF DATA ARE MISSING
         IF(MIN(RDATA(II+1),RDATA(II+2)).GE.YMISS.AND.
     $     (MAX(RDATA(II+4),RDATA(II+5)).GE.YMISS))  CYCLE
         NL = NL + 1
         IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
            PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
            i2many_lvls = i2many_lvls + 1
            RETURN 2
C----------------------------------------------------------------------
         END IF
         NB = NB + 1
         IQ(NL,3) = 10
         DAT(NL,1) = NINT(RDATA(II)) * 0.1
         IQ(NL,5) = IPM
         CALL W3FA03(DAT(NL,1),DAT(NL,2),DAT(NL,3),THETA)
         IF(RDATA(II+1).LT.YMISS)  THEN
            DAT(NL,2) = NINT(RDATA(II+1))
            IQ(NL,1) = IZM
            NPZ = NPZ + 1
         END IF
         IF(RDATA(II+2).LT.YMISS)  THEN
            DAT(NL,3) = (NINT(RDATA(II+2)) * 0.1) + 273.16
            IQ(NL,2) = ITM
            IF(DAT(NL,1).GE.QTOP.AND.RDATA(II+3).LT.YMISS
     $       .AND.NINT(RDATA(II+3)).GE.0)  THEN
               DEWPT = DAT(NL,3) - (NINT(RDATA(II+3)) * 0.1)
C PROCESS NON-MSG MOISTURE REGARDLESS OF PREPBUFR TBL VAL
               IF(MAX(IQM,ITM).LT.IQMLIM)  DAT(NL,4) = DEWPT
            END IF
         END IF
C IZBEST IS BEST (LOWEST) HEIGHT PREPBUFR TBL VALUE AMONGST ALL LEVELS
         IZBEST = MIN(IQ(NL,1),IZBEST)
C IF KTEMP = T, THEN ALSO EXAMINE TEMP PREPBUFR TABLE VALUE FOR IZBEST
         IF(KTEMP)  IZBEST = MIN(IQ(NL,2),IZBEST)
         IF(MAX(RDATA(II+4),RDATA(II+5)).LT.YMISS.AND.IVM.LT.IQMLIM)THEN
C PROCESS NON-MSG WIND REGARDLESS OF PREPBUFR TABLE VALUE
            IF(IQ(NL,1).LT.3)  NP3 = NP3 + 1
            DAT(NL,5) = NINT(RDATA(II+4))
            DAT(NL,6) = NINT(RDATA(II+5)) * 0.1
            IQ(NL,4) = IVM
         END IF
         IS(NL,1) = GPST 
         IS(NL,2) = GPSY 
         IS(NL,3) = GPSX 
      ENDDO
C RESET IDATA(31) TO NUMBER OF 'GOOD' CAT. 10 LEVELS ACTUALLY PROCESSED
      IDATA(31) = NB
 5695 CONTINUE
C N125_10 IS THE NUMBER OF CAT. 1, 2, 5, AND 10 LEVELS COLLECTED
      N125_10 = NL
C---------------------------------------------------^^--CH 07/23/2021-^^
C-----------------------------------------------------------------------
C            WINDS AT VARIABLE PRESSURE (DATA LEVEL CATEGORY 3)
C-----------------------------------------------------------------------
C
C NN IS NO. OF LEVELS THAT WILL BE CONSIDERED
C NP IS NO. OF CAT.3 & "SPECIAL" 25 OR 50 MB LVL DATA ACTUALLY COLLECTED
      NP = 0
      NN = IDATA(17)
      II = IDATA(18) - 6
      IF(NN.EQ.0)  GO TO 31
      DO N = 1,NN
         II = II + 6
C GET PREPBUFR TABLE VALUES FOR PRESSURE AND WIND AT THIS LEVEL
         IPM = NINT(RDATA(II+3))
         IVM = NINT(RDATA(II+4))
C IF PRESSURE IS MISSING, SKIP PROCESSING OF THIS LEVEL
        IF(NINT(RDATA(II)).GE.32750.OR.(NINT(RDATA(II))*0.1).LT.PTOP.OR.
     $    IPM.GE.IQMLIM)  CYCLE
C IF PRESSURE > STN (SFC) PRESSURE (GOOD ONLY) FLAG ALL DATA ON THIS LVL
         IF(NP1VLD.GE.1.AND.
     +     (NINT(RDATA(II))*0.1).GT.DAT(N125_10+1,1)) THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
            IPM = 15
            IVM = 15
CVVVVV%%%%%TEMP FOR PRINT
cdak        PRINT'(" ~~~~~")'
cdak        IPRTF = 1
CAAAAA%%%%%
            PRINT 1515, STNID,RDATA(1),RDATA(2),IDATA(9),RDATA(II)*.1,
     $       DAT(N125_10+1,1)
 1515 FORMAT(' * * CAT3,LVL DATA FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESS =',F7.2,' > SFC PRESS(',F7.2,
     $ ')')
         END IF
         IF(NINT(RDATA(II)).GE.10750)  THEN
C IF PRESSURE > 1075 MB FLAG PRESSURE ON LVL
          ! this should not be monitored by GSI!! (but is since qm=15)
            IPM = 15
CVVVVV%%%%%TEMP FOR PRINT
cdak        PRINT'(" ~~~~~")'
cdak        IPRTF = 1
CAAAAA%%%%%
            PRINT 1315, STNID,RDATA(1),RDATA(2),IDATA(9)
 1315 FORMAT(' * * CAT3,LVL PRES FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESSURE > 1075 MB')
         END IF
C CHECK IF "GOOD" SFC PRESS. ALREADY PRESENT, IF NOT TRY TO GET IT HERE
         IF(NP1VLD.LT.1.AND.N.EQ.1)  THEN
            DVAL = 0.0
            IF(ELEV.LT.YMISS)  DVAL = (NINT(RDATA(II)) * 0.1) - PR(ELEV)
            IF(DVAL.GT.-75..AND.DVAL.LT.50.)  THEN
               NP1VLD = 2
               PRINT 1115, STNID,RDATA(1),RDATA(2),IDATA(9)
 1115 FORMAT(' * * PSTN GOTTEN IN CAT.3-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NOT AVAILABLE OR BAD IN CAT.2')
            ELSE  IF(NP1VLD.EQ.0)  THEN
               NP1VLD = -2
          ! this should not be monitored by GSI!! (but is since qm=15)
               IPM = 15
CVVVVV%%%%%TEMP FOR PRINT
cdak           PRINT'(" ~~~~~")'
cdak           IPRTF = 1
CAAAAA%%%%%
               PRINT 1915, STNID,RDATA(1),RDATA(2),IDATA(9),DVAL,ELEV
 1915 FORMAT(' * * PSTN GOTTEN IN CAT.3 -- BUT --'/'  SURFACE PRESSURE',
     $ ' FLAGGED-ID=',A8,', LAT=',F7.2,'N, LON=',F8.2,'E, RTYP',I4,
     $ ' - PSTN DVALUE(',F7.1,') BAD, ELEV =',F7.1)
            END IF
         END IF
C IF THIS IS NOT SFC LVL OR PSTN NOT GOTTEN HERE, DON'T PROCESS LVL IF
C  WIND IS BAD OR MISSING
         IF((N.GT.1.OR.IABS(NP1VLD).NE.2).AND.(MAX(RDATA(II+1),
     $    RDATA(II+2)).GE.YMISS.OR.IVM.GE.IQMLIM))  CYCLE
         NL = NL + 1
         IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
            PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
            i2many_lvls = i2many_lvls + 1
            RETURN 2
C----------------------------------------------------------------------
         END IF
         NP = NP + 1
         IQ(NL,3) = 3
         IQ(NL,5) = IPM
         DAT(NL,1) = NINT(RDATA(II)) * 0.1
         CALL W3FA03(DAT(NL,1),DAT(NL,2),DAT(NL,3),THETA)
         IF(MAX(RDATA(II+1),RDATA(II+2)).LT.YMISS.AND.IVM.LT.IQMLIM)THEN
C PROCESS NON-MSG WIND REGARDLESS OF PREPBUFR TABLE VALUE
            DAT(NL,5) = NINT(RDATA(II+1))
            DAT(NL,6) = NINT(RDATA(II+2)) * 0.1
            IQ(NL,4) = IVM
         END IF
   30    CONTINUE
      ENDDO
C RESET IDATA(17) TO NUMBER OF 'GOOD' CAT. 3 LEVELS ACTUALLY PROCESSED
      IDATA(17) = NP
   31 CONTINUE
C IF NP1VLD =  1, ASSUME FIRST CAT. 2 LEVEL FILLED IS P(SFC) & IT'S GOOD
C IF NP1VLD =  2, ASSUME FIRST CAT. 3 LEVEL FILLED IS P(SFC) {CAT.2 MSG
C  OR BAD} & IT'S GOOD
C IF NP1VLD = -1, ASSUME FIRST CAT. 2 LEVEL FILLED IS P(SFC) & IT'S BAD
C IF NP1VLD = -2, ASSUME FIRST CAT. 3 LEVEL FILLED IS P(SFC) {CAT.2 MSG}
C  & IT'S BAD
C IN ANY CASE, FILL HGHT AS ELEV W/ PREPBUFR TBL VAL. 6 IF
C   NON-MSG EXCEPT: IF NO VALID CAT.1 MASS (HGHT) & NO CAT. 2 DATA &
C   IABS(NP1VLD) IS 2, THIS IS PIBAL RPT, LEAVE SFC HGT PREPBUFR TBL VAL
C   AS MSG; OR IF ALL MAND. LVL HGHT ON REJECT LIST/SDM PURGE, SET T.V.
C   AS SUCH
      IF(NP1VLD.NE.0)  THEN
         NCN = NM + 1
         IF(IABS(NP1VLD).EQ.2)  NCN = N125_10 + 1
         STAP = DAT(NCN,1)
         DAT(NCN,2) = ELEV
         NPZ = NPZ + 1
         IF(ELEV.LT.YMISS.AND.(IABS(NP1VLD).EQ.1.OR.IZBEST.LT.IQMLIM.OR.
     $    IDATA(15).NE.0.OR.IDATA(9).EQ.31))  THEN
            IQ(NCN,1) = 2
            IF(IBLIZ1.EQ.1)  THEN
               IQ(NCN,1) = 14
               PRINT 71, STNID
   71 FORMAT(' * * * * *  MONITOR PURGE ON ALL CAT. 1 LVL HEIGHTS FOR ',
     $ 'ID = ',A8,' -- GIVE CAT. 2 OR 3 SFC HEIGHT A MONITOR PURGE ',
     $ 'T.V.  * * * * *')
            END IF
         END IF
      END IF
      NP3 = NP3 + NP
      PSTA = 1013.50
C SET PSTN TO FIRST PRESS. IN CAT. 2 (IF REASONABLE); ELSE GET FROM ELEV
      IF(STAP.LT.1070..OR.STAP.LT.3275.)  THEN
         PSTA = STAP
C RESET STAP TO MISSING IF SFC. P IS "BAD" (FOR LATER SUBROUTINES)
         IF(NP1VLD.LT.1)  STAP = XMISS
      ELSE
         IF(ELEV.LT.YMISS)
     $    PSTA = 1013.50 * ((288. - .0065 * ELEV)/288.)**5.256
      END IF
C-----------------------------------------------------------------------
C         (RASS) TEMPERATURES BY HEIGHT (DATA LEVEL CATEGORY 15)
C-----------------------------------------------------------------------
C
C NN  IS NO. OF LEVELS THAT WILL BE CONSIDERED
C N15 IS NO. OF TEMP. BY HEIGHT (CAT. 15) LEVELS ACTUALLY COLLECTED
      N15 = 0
      NN = IDATA(45)
      II = IDATA(46) - 3
      IF(NN.EQ.0)  GO TO 4141
      DO N = 1,NN
         II = II + 3
C GET PREPBUFR TABLE VALUES FOR HEIGHT AND TEMP. AT THIS HEIGHT LEVEL
         IZM = 2
         ITM = 2
C CONVERT RASS QUALITY CODE (IF VALID) TO PREPBUFR TABLE VALUE (SEE
C  SUBROUTINE W3UNPKB7 DOCBLOCK FOR QUALITY MARKER MEANING)
         IF(IDATA(II+2).GT.-1.AND.IDATA(II+2).LT.15)
     $    ITM = MARKP(IDATA(II+2))
C MISSING HEIGHTS OR THOSE ABOVE THE LIMIT RESULT IN SKIPPED CAT. 15 LVL
         IF(RDATA(II).GT.ZTOP-.02)  CYCLE
C DON'T PROCESS CAT. 15 LEVEL IF TEMPERATURE IS MISSING
         IF(RDATA(II+1).GE.YMISS)  CYCLE
         NL = NL + 1
         IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
            PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
            i2many_lvls = i2many_lvls + 1
            RETURN 2
C----------------------------------------------------------------------
         END IF
         N15 = N15 + 1
         IQ(NL,3) = 15
         DAT(NL,2) = NINT(RDATA(II))
         IQ(NL,1) = IZM
C CALCULATE PRESSURE FROM HEIGHT USING U.S. STANDARD ATMOSPHERE AND
C  ASSIGN IT PREPBUFR TABLE VALUE 3
         CALL W3FA04(DAT(NL,2),DAT(NL,1),TMPR,THETA)
         IQ(NL,5) = 3
         DAT(NL,3) = RDATA(II+1) ! This is VIRTUAL temperature
         IQ(NL,2) = ITM
      ENDDO
C RESET IDATA(45) TO NUMBER OF 'GOOD' CAT. 15 LEVELS ACTUALLY PROCESSED
      IDATA(45) = N15
 4141 CONTINUE
      IF(SPCIAL)  THEN
C ALWAYS SET NPZ NON-ZERO FOR SPCIAL = TRUE TO AVOID RETAINING CAT. 4
C  LEVELS BELOW(ABOVE) LOWEST(HIGHEST) SPECIAL LEVEL IN SUBR. WNDBYZ
         NPZ = 99999
C-----------------------------------------------------------------------
C SPECIAL INTERP. P-LVLS (NO DUPL W/ MAND OR SIG LVLS) -
C  TREATED AS DATA LEVEL CATEGORY 3
C  *** NOW NEVER PROCESSED FOR RTOVS AND ATOVS SATELLITE RETRIEVALS ***
C   WILL PROCESS THESE SPECIAL LEVELS AT APPROX. EVERY 25 MB UNLESS:
C  1) SUFFICIENTLY FEW 'GOOD' SIG. LEVELS ARE AVAILABLE (NOT A TEST FOR
C      VAD WIND OR NOAA PROFILER NETWORK WIND REPORTS WHICH ARE ALWAYS
C      PROCESSED AT 25 MB IF SPCIAL=TRUE)
C
C IF CASE 1) OCCURS, WILL PROCESS AT APPROX. EVERY 50 MB
C
C-----------------------------------------------------------------------
         NLIM = NL
         NINC = 1
         IF((((IDATA(15)+IDATA(21).LE.3).AND.(MAX(IDATA(17),IDATA(19))
     $    .LE.3)).OR.NLIM.LT.5).AND.IDATA(9).NE.71.AND.IDATA(9).NE.72)
     $     NINC = 2
C FOR NAM OR NDAS RUNS, VAD WIND AND NOAA PROFILER NETWORK WIND REPORTS
C  PROCESSED ONLY AT 50 MB
         IF((IDATA(9).EQ.71.OR.IDATA(9).EQ.72).AND.IRNMRK.EQ.6) NINC = 2
         DO N = 1,47,NINC
            IF(PS(N).LT.PTOP)  CYCLE
            IP = PS(N)
C CHECK FOR DUPLICATE PRESSURES
            DO NN = 1,NLIM
               JP = NINT(DAT(NN,1))
               IF(IP.EQ.JP)  CYCLE
            ENDDO
            NL = NL + 1
            IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
               PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
               i2many_lvls = i2many_lvls + 1
               RETURN 2
C----------------------------------------------------------------------
            END IF
            NP = NP + 1
C THE SPECIAL LEVELS ARE NOW ASSIGNED DATA LEVEL CATEGORY 7 (UNIQUELY
C  IDENTIFIES THEM)
            IQ(NL,3) = 7
C PREPBUFR TBL VALUE FOR VRT. COORD. (PRESS) SET TO DEFAULT OF 2
            IQ(NL,5) = 2
            DAT(NL,1) = PS(N)
C EVENT#105 -  NEW PRESSURE LEVEL CREATED
            IR(NL,5) = 105
C FILL-IN HEIGHTS AND TEMPERATURES WITH STD. ATMOS. VALUES FOR NOW
            CALL W3FA03(DAT(NL,1),DAT(NL,2),DAT(NL,3),THETA)
         ENDDO
      END IF
C-----------------------------------------------------------------------
C             WINDS BY HEIGHT (DATA LEVEL CATEGORY 4)
C  NPN, CAP AND JAPANESE WIND PROFILER DATA (DATA LEVEL CATEGORY 11)
C    (NOTE: FROM HERE ON, DATA LEVEL CATEGORY 11 TREATED LIKE DATA LEVEL
C           CATEGORY 4, ALL REFERENCES TO DATA LEVEL CATEGORY 4 COULD
C           ALSO MEAN THESE DATA)
C-----------------------------------------------------------------------
C
C NN IS NO. OF LEVELS THAT WILL BE CONSIDERED
C NH IS NO. OF CAT. 4 HEIGHT LEVELS ACTUALLY COLLECTED
      NH = 0
      ISUBS  = 19
      NUMLVL =  5
      IF(IDATA(37).GT.0)  THEN  ! Data level category 11
         ISUBS  = 37
         NUMLVL = 11
      END IF
      NN = IDATA(ISUBS)
      II = IDATA(ISUBS+1) - NUMLVL
      IF(NN.EQ.0)  GO TO 41
      DO N = 1,NN
         II = II + NUMLVL
C GET PREPBUFR TABLE VALUES FOR HEIGHT AND WIND AT THIS HEIGHT LEVEL
         IF(IDATA(37).EQ.0)  THEN ! Data level category 4
            IF(IDATA(9).NE.72)  THEN
               IZM = NINT(RDATA(II+3))
               IVM = NINT(RDATA(II+4))
            ELSE
               IZM = 2
               IVM = 2
C CONVERT VAD WIND QUALITY MARKER (IF VALID) TO PREPBUFR TABLE VALUE
C  (SEE SUBROUTINE W3UNPKB7 DOCBLOCK FOR QUALITY MARKER MEANING)
              IF(NINT(RDATA(II+4)).EQ.12.OR.NINT(RDATA(II+4)).EQ.14)THEN
                  IVM = NINT(RDATA(II+4))
               ELSE  IF(NINT(RDATA(II+4)).LT.IVADSP)  THEN
                  IVM =  2
               ELSE IF(NINT(RDATA(II+4)).LT.IVADFL)  THEN
                  IVM =  3
               ELSE
                  IVM = 13
               END IF
            END IF
         ELSE   ! Data level category 11
            IZM = 2
            IVM = 2
C CONVERT WIND PROFILER QUALITY CODE (IF VALID) TO PREPBUFR TABLE VALUE
C  (SEE SUBROUTINE W3UNPKB7 DOCBLOCK FOR QUALITY MARKER MEANING)
            IF(IDATA(II+3).GT.-1.AND.IDATA(II+3).LT.15)
     $       IVM = MARKP(IDATA(II+3))
         END IF
         IPM = IZM
C MISSING HEIGHTS OR THOSE ABOVE LIMIT RESULT IN SKIPPED CAT. 4 LVL
         IF(RDATA(II).GT.ZTOP-.02)  CYCLE
C DON'T PROCESS CAT. 4 LEVEL IF EITHER WIND COMPONENT IS MISSING
         IF(MAX(RDATA(II+1),RDATA(II+2)).GE.YMISS) CYCLE
C PROCESS NON-MSG WIND/HGT REGARDLESS OF PREPBUFR TBL VAL
         IF(MAX(IVM,IPM).LT.IQMLIM)  THEN
            NL = NL + 1
            IF(NL.GT.MXLVL)  THEN
C----------------------------------------------------------------------
C IF NO. OF LEVELS IN A REPORT EXCEEDS THE LIMIT OF "MXLVL", SKIP
C  REPORT AND PRINT DIAGNOSTIC
               PRINT 9953, STNID,RDATA(1),RDATA(2),IDATA(9),MXLVL
               i2many_lvls = i2many_lvls + 1
               RETURN 2
C----------------------------------------------------------------------
            END IF
            NH = NH + 1
            IQ(NL,3) = 4
            DAT(NL,2) = NINT(RDATA(II))
            IQ(NL,1) = IZM
            IQ(NL,5) = IPM
            IF(DAT(NL,2).EQ.ELEV.AND.IBLIZ1.EQ.1)  THEN
               IQ(NL,1) = 14
               PRINT 471, STNID
  471 FORMAT(' * * * * *  MONITOR PURGE ON ALL CAT. 1 LVL HEIGHTS FOR ',
     $ 'ID = ',A8,' -- GIVE CAT. 4 SFC HEIGHT A MONITOR PURGE ',
     $ 'T.V.  * * * * *')
            END IF
C HGHT PREPBUFR TBL VAL. SET TO AT BEST 3 (CAN CHG IN WNDBYZ FOR BAD
C  SPANNING HEIGHT)
            IF(IQ(NL,1).LE.IQMGUD)  IQ(NL,1) = 3
            IF(MAX(RDATA(II+1),RDATA(II+2)).LT.YMISS)  THEN
               IF(SUBSET_d .NE. 'NC002017') THEN
                  DAT(NL,5) = NINT(RDATA(II+1))
                  DAT(NL,6) = NINT(RDATA(II+2)) * 0.1
               ELSE
C VAD WIND REPORTS FROM LEVEL 2 DECODER STORE U-COMP/V-COMP WIND WHICH
C  IS ALREADY STORED IN M/SEC
                  DAT(NL,5) = RDATA(II+1)
                  DAT(NL,6) = RDATA(II+2)
               END IF
               IQ(NL,4) = IVM
            END IF
         END IF
      ENDDO
C RESET IDATA(19) TO NUMBER OF 'GOOD' CAT. 4 LVLS ACTUALLY PROCESSED
      IDATA(19) = NH
   41 CONTINUE
      IF(SUBSET_d .NE. 'NC002017')  THEN
C FOR ALL TYPES EXCEPT VAD WIND REPORTS FROM LEVEL 2 DECODER, CONVERT
C  WINDS FROM DIR/SPEED (DEGREES & M/SEC) TO GRID U-COMP/V-COMP (M/SEC)
C  (VAD WIND REPORTS FROM LEVEL 2 DECODER ARE ALREADY U-COMP/V-COMP)
         DO N = 1,NL
            IF(IQ(N,4).GE.16)  CYCLE
            CALL UV(DAT(N,5),DAT(N,6),U,V)
            DAT(N,5) = U
            DAT(N,6) = V
         ENDDO
      END IF
C KOUNT COUNTS NO. OF REPORTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = KOUNT + 1
      IPRT(1) = 0
      IPRT(2) = 0
CVVVVV%%%%%TEMP FOR PRINT
cdak  STNPRT(3) = '        '
cdak  IF(IPRTF.EQ.1)  THEN
cdak     IPRT(1) = 1
cdak     IPRT(2) = 1
cdak     STNPRT(3) = STNID
cdak  END IF
cdak  IPRTF = 0
      STNPRT(1) = '01028   '
      STNPRT(2) = '72251   '
      STNPRT(3) = '72364   '
CAAAAA%%%%%
C IN MERGING, PRINT OUT COMPLETE LISTING OF RPT FOR EACH CAT. (MODPRT)
      IF(MOD((KOUNT-1),MODPRT).EQ.0)  IPRT(1) = 1
      IF(MODPRT.LT.0)  IPRT(1) = 0
C ALSO, CAN PRINT OUT COMPLETE LISTING FOR SPECIFIC REPORT(S)
      IF(STNID.EQ.STNPRT(1).OR.STNID.EQ.STNPRT(2).OR.STNID.EQ.STNPRT(3))
     $  IPRT(2) = 1
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
C      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 902, STNID
  902 FORMAT(/' GETUPA: ',A8,', ALL CAT. GATHERED, PRIOR TO "SMERGE"')
         DO N = 1,NL
            PRINT 900, (DAT(N,K),K=1,NUMVAR)
            PRINT 905, (IQ(N,L),L=1,NUMQMS)
            PRINT 910, (IS(N,QQ),QQ=1,NUMGPS)
         ENDDO
         PRINT 901
C      END IF
  900 FORMAT(1X,10F10.2)
  905 FORMAT('+',102X,8I3)
  910 FORMAT('+',F13.5,F13.5,F13.5)
  901 FORMAT('0',//)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C MERGE DATA LEVEL CATEGORIES INTO SINGLE PROFILE, ACCORDING TO DECR.
C  PRESSURE
      CALL SMERGE(NM,NSIG,N5,NB,NP,NH,N15,NLEV,IPRT,STOP)
      IF(NLEV.LE.0)  THEN
C IF NLEV IS ZERO, SKIP REPORT AND PRINT DIAGNOSTIC
         KOUNT = KOUNT - 1
         PRINT 9954, STNID,RDATA(1),RDATA(2),IDATA(9)
 9954 FORMAT(' # # TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NLEV=0 RETURNED FROM SMERGE')
         RETURN 2
      END IF
      IF(IPRT(1).EQ.1.OR.IPRT(2).EQ.1)  THEN
         PRINT 1903, STNID
 1903 FORMAT(//,17X,'>>> COMPLETE LISTING OF DATA FOR STATION ID ',A8,
     $ '  - AFTER MERGING OF UPPER-AIR CATEGORIES <<<',//)
         CTYPE = 'VIRT.'
         IF(ISATOB.EQ.0.AND.IDATA(9).NE.77)  CTYPE = 'SENS.'
         PRINT 899, CTYPE
  899 FORMAT(2X,'     UPPER-',4X,'PRESSURE',6X,'HEIGHT',4X,
     $ A5,' TEMP.',4X,'DEWPOINT',4X,'U-WIND',7X,
     $ 'V-WIND',5X,'HGHT',5X,'TEMP',5X,'WIND',3X,'VERT. COORD.'/,2X,
     $ 'AIR CATEGORY',5X,'(MB)',9X,'(GPM)',8X,'(K)',10X,'(K)',8X,'(M/S)'
     $ ,8X,'(M/S)',4X,'TV/RC',4X,'TV/RC',4X,'TV/RC',4X,'  TV/RC'/)
         PRINT 7901, (IQ(N,3),(DAT(N,K),K=1,6),IQ(N,1),IR(N,1),IQ(N,2),
     $    IR(N,2),IQ(N,4),IR(N,4),IQ(N,5),IR(N,5),IS(N,1),
     $    IS(N,2),IS(N,3),N=1,NLEV)
 7901    FORMAT(6X,I2,F16.2,F14.2,F12.2,F13.2,F11.2,F13.2,I6,'/',I3,
     $    I5,'/',I3,I5,'/',I3,I7,'/',I3,F13.5,F13.5,F13.5)
         PRINT 7902
 7902    FORMAT(//)
      END IF
C CALL SUBR. 'STOROB' TO WRITE REPORT PIECES IN MOBS ARRAY
      CALL STOROB(NLEV,PSTA,INDIAN,IPRT,*2090)
      RETURN 1
 2090 CONTINUE
      RETURN 2
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UV
C   PRGMMR: D. A. KEYSER     ORG: W/NMC22    DATE: 1998-02-17
C
C ABSTRACT: CONVERTS WIND DIRECTION AND SPEED (METERS/SEC) TO GRID U
C   AND V COMPONENTS OF VELOCITY (METERS/SEC).
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1991-06-07  D. A. KEYSER -- ADDED ARGUMENT 'ISUNIT' (DUE TO PROFILER)
C 1998-02-17  D. A. KEYSER -- REMOVED ARGUMENT 'ISUNIT' AND HARDWIRED
C     TO ACCEPT INPUT SPEED ONLY AS METERS/SEC; ADDED SEPARATE, NEW
C     OUTPUT AGRUMENTS (BEFORE I/O ARGUMENTS WERE SHARED)
C
C USAGE:    CALL UV(DD,FF,U,V)
C   INPUT ARGUMENT LIST:
C     DD       - DIRECTION OF WIND (DEGREES)
C     FF       - SPEED OF WIND (METERS/SEC)
C
C   OUTPUT ARGUMENT LIST:
C     U        - U-COMPONENT OF WIND VELOCITY (METERS/SEC)
C     V        - V-COMPONENT OF WIND VELOCITY (METERS/SEC)
C
C REMARKS: CALLED BY SUBROUTINES 'GETUPA', 'GETC06', 'SFCDTA' AND
C   'GETSCATT'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C---------------------------------------------------------------------
C
C ENTRY:         CMDDFF      CONVERTS WIND U/V COMPONENTS TO DIR/SPD
C   PRGMMR: D. A. KEYSER     ORG: W/NMC22    DATE: 1994-08-11
C
C ABSTRACT: CONVERTS GRID U AND V COMPONENTS OF VELOCITY (METERS/SEC) TO
C   WIND DIRECTION AND SPEED (KNOTS).
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1994-08-11  D. A. KEYSER -- ORIGINAL AUTHOR
C
C USAGE:    CALL CMDDFF(U,V,DD,FF)
C   INPUT ARGUMENT LIST:
C     U        - U-COMPONENT OF WIND VELOCITY (METERS/SEC)
C     V        - V-COMPONENT OF WIND VELOCITY (METERS/SEC)
C
C   OUTPUT ARGUMENT LIST:
C     DD       - DIRECTION OF WIND (DEGREES)
C     FF       - SPEED OF WIND (KNOTS)
C
C REMARKS: CALLED BY SUBROUTINE STOROB.
C
C---------------------------------------------------------------------
C$$$
      SUBROUTINE UV(DD,FF,U,V)
      DATA  CONV2R/0.017453293/,FACTOR/0.5148/

      IF(FF.LE.0.0)  THEN
C IF WIND SPEED LESS THAN ZERO, WE HAVE A PROBLEM
         U = 0.0
         V = 0.0
      ELSE
         U = -FF * SIN(DD*CONV2R)
         V = -FF * COS(DD*CONV2R)
      END IF
      RETURN

         ENTRY CMDDFF(U,V,DD,FF)
      IF(U.EQ.0.0)  THEN
         DD = 0.
         IF(V.GT.0.0)  DD = 180.
      ELSE
         IF(V.EQ.0.0)  THEN
            DD =  90.
            IF(U.GT.0.0)  DD = 270.
         ELSE
            DD = (ATAN2(U,V)/CONV2R) + 180.
            DD = MOD(DD,360.)
         END IF
      END IF
      FF = SQRT(U**2 + V**2)/FACTOR
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SMERGE
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2004-09-09
C
C ABSTRACT: MERGES MANDATORY (DATA LEVEL CATEGORY 1), SIGNIFICANT
C   (DATA LEVEL CATEGORY 2), & TROPOPAUSE (DATA LEVEL CATEGORY 5)
C   MASS & WIND DATA FOR RAOB AND RTOVS OR ATOVS (ORIGINALLY FROM
C   UNPACKED NMCEDS FORMAT) SATELLITE SOUNDING REPORTS (RTOVS OR ATOVS
C   RETRIEVALS ONLY HAVE MASS DATA IN DATA LEVEL CATEGORIES 1 AND 2).
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED, STREAMLINED
C 1989-06-15  G. J. DIMEGO -- FIXED INTEGRATION THRU HOLES BY REDEFINING
C     PLIMIT & ZLIMIT, ALSO TIGHTER LIMITS IN HYDRO CHK; MADE RO2G IN
C     SMERGE/WNDBYP CONFORM TO RAFS/GDAS VALUE
C 1989-12-13  D. A. KEYSER -- 'FILL' SWITCH NOW TESTED FOR INTERPOLATING
C     TO MISSING DATA LEVELS; DUPL. LVL CHECK NOW SEPARATE FOR CAT. 1
C     VS. CAT. 2 AND CAT. 1 VS. CAT. 5
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-10-25  D. A. KEYSER -- CALLS FCN 'PWCLC' TO CALC PWATER FOR RAOBS
C 1992-07-09  D. A. KEYSER -- RMVED. SUBPR. FCN "QFRMTP" & REPL. W/
C     IN-LINE FCN STMNT.
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C     RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C     MARKERS; IN INTERNAL PROCESSING MISSING DATA GET PREPBUFR TABLE
C     VALUE OF 16 RATHER THAN 10; VERTICAL COORDINATE INDIC. ADDED TO
C     PREPBUFR TBL VALUE LIST FOR VARIABLES
C 1993-09-14  D. A. KEYSER -- ADDED N-LIST SWITCH "TVIRT" TO OUTPUT
C     TEMP. AS VIRTUAL (=TRUE, DEFAULT) OR AS SENSIBLE (=FALSE) FOR
C     RAOB, RECCO/DROPS, CLASS & SFC DATA; IF VIRT. TEMP >375K (>325K
C     ABOVE 100 MB) STORES SENS. TEMP WITH "FAILED" Q.M. AND SETS DWPT
C     TEMP TO MSG; SENSIBLE TEMPERATURE FOR PROFILE SAVED IN STMP OR
C     SDAT ARRAYS (IN CASE TVIRT=FALSE)
C 1994-08-11  D. A. KEYSER -- FOR CALC. V. TEMP> 375K (> 325K ABOVE 100
C     MB), DWPT NOW SAVED (BEFORE ALWAYS SET TO MSG); ALL DUPL. PRESS.
C     CHECKS NOW REQUIRE PRESS. TO AGREE TO NEAREST 10'TH OF A MB TO BE
C     A DUPL. (WAS TO NEAREST WHOLE MB).
C 1995-07-12  D. A. KEYSER -- REMOVED LOGIC TO PROCESS VAS RETRIEVALS;
C     IF SPANNING LVL PRESS. Q.M. IS BAD INTEGR. HEIGHT Q.M. SET TO
C     BAD, IF INTEGR. LVL PRESS. Q.M. IS BAD INTEGR. HEIGHT Q.M. SET
C     TO BAD
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (INTERP./CALC. DATA CAN GET GOOD Q.M. IF SPANNING LVL DATA GOOD)
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C     TYPES (CURRENTLY JUST 100, 101-103, 105 TO IDENTIFY INTERPOLATED
C     DATA FOR CQCBUFR PGM); CHGS IN LVL ON29 CATEGORY INDICATORS:
C     SPEC. LVLS GET CAT=7 RATHER THAN 6, TROP CAT=5 EXPLICITLY
C     IDENTIFED IN ALL CASES; STDOUT EXPANDED TO INCL. REASON CODES
C 1998-02-17  D. A. KEYSER -- REMOVED LOGIC RE: RAOB PWATER CALC.
C 1999-08-04  D. A. KEYSER -- REPLACED SORT ROUTINE "SHELL" (IN-LINE
C     SUBROUTINE) WITH W3LIB ROUTINE "ORDERS", MORE EFFICIENT AND
C     ALLOWS MULTIPLE ORDER SORT KEYS
C 2000-02-17  D. A. KEYSER -- NOW CALLS SUBR. FILWND FOR RAOBS AND
C     PIBALS EVEN WHEN FILLW=F TO GET INTERP. WIND LEVELS FOR BALLOON
C     DRIFT LAT/LON CALC. (DISCARDS THEM PRIOR TO WRITE TO PREPBUFR
C     FILE WHEN FILLW=F)
C 2002-01-14  D. A. KEYSER -- LEVELS WITH REPORTED DWPT < "TDLIM" VALUE
C     NOW CALC. SPEC. HUM AND RETAIN DWPT IN PREPBUFR FILE, BUT MOISTURE
C     PREPBUFR TBL VALUE IS FLAGGED WITH Q.M.=15 (BEFORE, SPEC. HUM. AND
C     DWPT SET TO MISSING) VIRT. TEMP. CALC. AND ENCODED IN THIS CASE
C     (BEFORE, SET TO SENSIBLE TEMP.)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF NPN AND CAP RASS DATA
C     READ FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R.
C     TYPE 77, GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE
C     UNDER NEW TBL A ENTRY "RASSDA"; ADDED NEW INPUT ARGUMENT N15 FOR
C     NUMBER OF DATA LEVEL CATEGORY 15 LEVELS
C 2021-07-23 C. Hill -- NB added to represent new data level category 10
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. HP, XP, AND YP WERE
C     ADDED TO KEEP LOCATION AND TIME INFORMATION. IS WAS ADDED AS AN
C     ARRAY TO KEEP THE DATA.
C
C USAGE:    CALL SMERGE(NM,NSIG,N5,NB,NP,NH,N15,NLEV,IPRT,STOP)
C   INPUT ARGUMENT LIST:
C     NM       - NO. OF LEVELS IN CAT.  1 (MANDATORY MASS/WIND)
C     NSIG     - NO. OF LEVELS IN CAT.  2 (SIG. MASS)
C     N5       - NO. OF LEVELS IN CAT.  5 (TROPOPAUSE)
C     NB       - NO. OF LEVELS IN CAT. 10 (BUFR MASS/WIND)
C     NP       - NO. OF CAT. 3 & ADD'L 25 OR 50 MB PRES. LVLS
C     NH       - NO. OF LEVELS IN CAT.  4 (WINDS BY HEIGHT)
C     N15      - NO. OF LEVELS IN CAT. 15 (TEMPERATURES BY HEIGHT)
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C     STOP     - TOP LEVEL FOR EXTRACTING CAT. 2/5 DATA
C
C   OUTPUT ARGUMENT LIST:
C     NLEV     - NUMBER OF LEVELS IN REPORT AFTER MERGING
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'GETUPA'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SMERGE(NM,NSIG,N5,NB,NP,NH,N15,NLEV,IPRT,STOP)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
C      PARAMETER (NUMVAR = 9, NUMQMS = 5)
C      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS))
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      PARAMETER (MAXOBS = 4500)
      DIMENSION  TMP(MXLVL,NUMDAT),VTMP(MXLVL),IWORK(MXLVL),
     $ DATINV(NUMDAT,MXLVL)
      LOGICAL  FILLZ,FILLW,FILLM
      CHARACTER*5  CTYPE
      CHARACTER*8  STNID,STNPRT,SUBSET_d
      INTEGER  IDATA(MAXOBS),KS(MXLVL),IQ(MXLVL,NUMQMS),
     $ JQ(MXLVL,NUMQMS),IPRT(2),IC(0:16),IR(MXLVL,NUMQMS),
     $ JR(MXLVL,NUMQMS)
      REAL  PLIMIT(4),PRS(3),IS(MXLVL,NUMGPS),JS(MXLVL,NUMGPS)
      real(8)  BMISS,alon_8,alat_8
      COMMON/WORD/LWI,LWR
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      EQUIVALENCE(DAT(1,NUMVAR+1),IQ),(TMP(1,NUMVAR+1),JQ),(RDATA,IDATA)
      EQUIVALENCE(DAT(1,NUMVAR+NUMQMS+1+NUMGPS),TEST)
      EQUIVALENCE(DAT(1,NUMVAR+NUMQMS+1),IR)
      EQUIVALENCE(TMP(1,NUMVAR+NUMQMS+1),JR)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+NUMQMS+1),IS) 
      EQUIVALENCE  (TMP(1,NUMVAR+NUMQMS+NUMQMS+1),JS) 
      DATA  XMISS/99999./,YMISS/99998.8/,PLIMIT/200.,100.,50.,150./,
     $ PRS/700.,600.,250./,
C PREPBUFR TABLE VALUE INTERPRETED AS: 0 - KEEP, 1 - GOOD, 2- DEFAULT,
C  3 - SUSPECT, 9 - BAD  IN DUPL. LEVEL TBL VALUE COMPARISON
C  T.V ->    0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16
     $   IC/ 0, 1, 2, 3, 9, 9, 9, 9, 9, 9,  9,  9,  9,  9,  9,  9, 16/
C FCNS BELOW CONVERT TEMP/TD (K) & PRESS (MB) INTO SAT./ SPEC. HUM.(G/G)
      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)))
      SCALE = 10.
      RO2G = 287.05/(2.0 * 9.8)
      LSTOP = NINT(STOP*SCALE)
C FILL TMP ARRAY W/ "MISSING" & PREPBUFR TBL VALS. AS 16 INITIALLY
      TMP = XMISS
      JQ = 16
C INITIALIZE ALL REASON CODES AS 100 (ORIGINAL DATA)
      JR = 100
C NS IS NUMBER OF CAT. 2 AND CAT. 5 LEVELS COMBINED
      NS = NSIG + N5
      NSN = NS
C KLVL IS NUMBER OF CAT. 1, 2, 5, AND 10 LEVELS COMBINED
      KLVL = NM + NS + NB
      NSTZ = NM + NS
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 902, STNID
  902 FORMAT(/' SMERGE: ',A8,', CAT. 1,2,5,10 LVLS PRIOR TO DUPL. CHK')
         IF(KLVL.GT.0)  THEN
            DO N = 1,KLVL
               PRINT 900, (DAT(N,K),K=1,NUMVAR)
               PRINT 905, (IQ(N,L),L=1,NUMQMS)
               PRINT 910, (IS(N,QQ),QQ=1,NUMGPS)
            ENDDO
         END IF
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  900 FORMAT(1X,10F10.2)
  905 FORMAT('+',102X,8I3)
  910 FORMAT('+',F13.5,F13.5,F13.5)
  901 FORMAT('0',//)
C LASTP IS HIGHEST CAT. 2 OR CAT. 5 LVL WITH MASS INFO. (DEF = 1050 MB)
      LASTP = 1050 * NINT(SCALE)
      IF(NM.LE.0.OR.NS.LE.0)  GO TO 62
C***********************************************************************
C      CHECK FOR DUPLICATE LEVELS IN DATA LEVEL CATEGORIES 1, 2, & 5
C***********************************************************************
C FIRST, COMPARE CAT. 1 PRESSURE VALUES WITH CAT. 2 PRESSURE VALUES
C THEN,  COMPARE CAT. 1 PRESSURE VALUES WITH CAT. 5 PRESSURE VALUES
      LOOP1: DO INDEX = 1,2
         L = 1
         NST = NM + 1
         NUMLVL = NSIG
         IF(INDEX.EQ.2)  THEN
            NST = NM + NSIG + 1
            NUMLVL = N5
         END IF
         IF(NUMLVL.LE.0)  CYCLE LOOP1
         NLVL = (NST - 1) + NUMLVL
         LOOP1n1: DO N = NST,NLVL
            JP = NINT(DAT(N,1)*SCALE)
            LASTP = MIN(LASTP,JP)
   13       CONTINUE
            IP = NINT(DAT(L,1)*SCALE)
            IF(IP-JP.LT.0)  THEN
               CYCLE LOOP1n1
            ELSE IF(IP-JP.EQ.0)  THEN
               GO TO 11
            END IF
            L = L + 1
            IF(NM-L.LT.0)  THEN
               CYCLE LOOP1
            ELSE
               GO TO 13
            END IF
   11       CONTINUE
C ALL DUPLICATE CAT. 2 AND/OR CAT. 5 PRESSURE LEVELS WILL BE SET TO 0.0
            DAT(N,1) = 0.0
            NSN = NSN - 1
C IF DUPLICATE LEVEL IS CATEGORY 5, ADD 60 TO CATEGORY NUMBER
            IF(MOD(IQ(N,3),20).EQ.5)  IQ(L,3) = MOD(IQ(L,3),20) + 60
            IF(IC(IQ(N,2)).LT.IC(IQ(L,2)))  THEN
C IF DUPL. CAT. 1 TEMP IS OF POORER QUALITY, GIVE IT THE CAT. 2/5 VALUE
               IQ(L,2) = IQ(N,2)
               DAT(L,3) = DAT(N,3)
               IR(L,2) = IR(N,2)
               IR(L,3) = IR(N,3)
            END IF
C IF DUPLICATE CAT. 1 DWPT MISSING , GIVE IT THE CAT. 2/5 VALUE
            IF(DAT(L,4).GE.XMISS)  DAT(L,4) = DAT(N,4)
cfix?       IF(DAT(L,4).GE.YMISS)  DAT(L,4) = DAT(N,4)
C CHECK FOR A SECOND DUPLICATE LEVEL IN CAT. 2 OR 5
            IF(NINT(DAT(N+1,1)*SCALE).EQ.JP)  CYCLE LOOP1n1
            L = L + 1
            IF(L.GT.NM)  CYCLE LOOP1
         ENDDO LOOP1n1
      ENDDO LOOP1
C-----------------------------------------------------------------------
C COMPARE CAT. 2 PRESS. W/ THEMSELVES & W/ CAT. 5 PRESS.; LOOK FOR DUPL.
      NST = NM + 1
C  KLVL REPLACED BELOW WITH NSTZ, DEFINED ABOVE   CH 07/23/2021
      LOOP2: DO N = NST,NSTZ
         IP = NINT(DAT(N,1)*SCALE)
         LOOP2n1: DO M = NST,NSTZ
            IF(M.EQ.N)  CYCLE LOOP2n1
            JP = NINT(DAT(M,1)*SCALE)
            IF(IP.NE.JP)  CYCLE LOOP2n1
C IT MAKES NO SENSE TO COMPARE TWO ZERO'ED OUT LEVELS
            IF(IP.EQ.0)  CYCLE LOOP2n1
C THE HIGHER OF THE TWO DUPL. CAT. 2/5 PRESSURE LVLS WILL BE SET TO 0.0
            NSN = NSN - 1
            DAT(M,1) = 0.0
C IF DUPLICATE LEVEL IS CATEGORY 5, ADD 60 TO CATEGORY NUMBER
            IF(MOD(IQ(M,3),20).EQ.5)  IQ(N,3) = MOD(IQ(N,3),20) + 60
            IF(IC(IQ(M,4)).LT.IC(IQ(N,4)))  THEN
C IF DUPL. LOWER LVL WIND IS OF POORER QUALITY, GIVE IT HIGHER LVL VALUE
               IQ(N,4) = IQ(M,4)
               DAT(N,5) = DAT(M,5)
               DAT(N,6) = DAT(M,6)
               IR(N,4) = IR(M,4)
            END IF
            IF(IC(IQ(M,2)).LT.IC(IQ(N,2)))  THEN
C IF DUPL. LOWER LVL TEMP IS OF POORER QUALITY, GIVE IT HIGHER LVL VALUE
               IQ(N,2) = IQ(M,2)
               DAT(N,3) = DAT(M,3)
               IR(N,2) = IR(M,2)
               IR(N,3) = IR(M,3)
            END IF
C IF DUPLICATE LOWER LEVEL DWPT MISSING, GIVE IT HIGHER LVL VALUE
            IF(DAT(N,4).GE.XMISS)  DAT(N,4) = DAT(M,4)
cfix?       IF(DAT(N,4).GE.YMISS)  DAT(N,4) = DAT(M,4)
         ENDDO LOOP2n1
      ENDDO LOOP2
C***********************************************************************
   62 CONTINUE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 903, STNID
  903 FORMAT(/' SMERGE: ',A8,', CAT. 1,2,5,10 LVLS W/ DUPL. ZEROED OUT')
         IF(KLVL.GT.0)  THEN
            DO N = 1,KLVL
               PRINT 900, (DAT(N,K),K=1,NUMVAR)
               PRINT 905, (IQ(N,L),L=1,NUMQMS)
               PRINT 910, (IS(N,QQ),QQ=1,NUMGPS)
            ENDDO
         END IF
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      IF(LASTP.LT.LSTOP)  LASTP = LSTOP
C NSTA IS TOTAL NO. OF LVLS IN ALL DATA LEVEL CATEGORIES PLUS SPEC. 25
C  OR 50MB LVLS
      NSTA = NM + NS + NB + NP + NH + N15
C IF MODPRT SMALL, STD. O-PUT PRINT NO. OF LVL IN EACH DATA LEVEL
C  CATEGORY. FOR ALL RPTS
      IF(MODPRT.LE.300.AND.MODPRT.GE.0)
     $ PRINT 9090,STNID,IDATA(9),NSTA,NM,NSIG,N5,NB,NP,NH,N15,
     $ REAL(LASTP)/SCALE
 9090 FORMAT(1X,'ID ',A8,' DUMP RT.=',I3,', NLVLS: TOT=',I2,', CAT 1='
     $,I2,', CAT 2=',I2,', CAT 5=',I2,', CAT 10=',I3,
     $', CAT 3+SPEC LVLS=',I2,', CAT 4=',I2,', CAT 15=',I2,
     $' - TOP SIG P(W/MASS)=',F6.1,'MB')
      IF(IPRT(1).EQ.1.OR.IPRT(2).EQ.1)  THEN
         PRINT 1902, STNID
 1902 FORMAT(//,15X,'>>> COMPLETE LISTING OF DATA FOR STATION ID ',A8,
     $ '  - PRIOR TO MERGING OF UPPER-AIR CATEGORIES <<<',//)
         CTYPE = 'VIRT.'
         IF(ISATOB.EQ.0.AND.IDATA(9).NE.77)  CTYPE = 'SENS.'
         PRINT 899, CTYPE
  899 FORMAT(2X,'     UPPER-',4X,'PRESSURE',6X,'HEIGHT',4X,
     $ A5,' TEMP.',4X,'DEWPOINT',4X,'U-WIND',7X,
     $ 'V-WIND',5X,'HGHT',5X,'TEMP',5X,'WIND',3X,'VERT. COORD.'/,2X,
     $ 'AIR CATEGORY',5X,'(MB)',9X,'(GPM)',8X,'(K)',10X,'(K)',8X,'(M/S)'
     $ ,8X,'(M/S)',4X,'TV/RC',4X,'TV/RC',4X,'TV/RC',4X,'  TV/RC'/)
         PRINT 7901, (IQ(N,3),(DAT(N,K),K=1,6),IQ(N,1),IR(N,1),IQ(N,2),
     $    IR(N,2),IQ(N,4),IR(N,4),IQ(N,5),IR(N,5),IS(N,1),
     $    IS(N,2),IS(N,3),N=1,NSTA)
 7901    FORMAT(6X,I2,F16.2,F14.2,F12.2,F13.2,F11.2,F13.2,I6,'/',I3,
     $    I5,'/',I3,I5,'/',I3,I7,'/',I3,F13.5,F13.5,F13.5)
         PRINT 7902
      END IF
 7902 FORMAT(//)
      IF(KLVL.LE.0)  GO TO 63
      KS = 0
      IF(KLVL.EQ.1)  KS(1) = 1
C***********************************************************************
C               MERGE MANDATORY (DATA LEVEL CAT. 1) AND
C                SIGNIFICANT (DATA LEVEL CAT. 2,5) AND
C                BUFR (DATA LEVEL CAT. 10)  LEVEL DATA
C***********************************************************************
C
C FIRST, ARRANGE LEVELS IN ORDER OF DECREASING PRESSURE (FIRST ORDER
C  SORT KEY, SECOND ORDER SORT KEY IS HEIGHT)
C .. MUST SWITCH ORDER OF ELEMENTS IN DAT ARRAY - CALL IT DATINV
      DO  J=1,NUMDAT
         DATINV(J,1:KLVL) = DAT(1:KLVL,J)
      END DO
      IF(KLVL.GE.2)  THEN
         CALL ORDERS( 2,IWORK,DATINV(2,1),KS,KLVL,NUMDAT,LWR,2)
         CALL ORDERS(12,IWORK,DATINV(1,1),KS,KLVL,NUMDAT,LWR,2)
      END IF
      J = 0
C .. TMP ARRAY LIKE DATINV ARRAY, BUT P-LVLS ARRANGED PROPERLY & DUPL.
C    REMOVED, ALSO ORDER OF ELEMENTS SWITCHED BACK
      DO N = 1,KLVL
         L = KS(KLVL-N+1)
         IF(DATINV(1,L).GE.0.4)  THEN
            J = J + 1
            TMP(J,1:NUMDAT) = DATINV(1:NUMDAT,L)
         END IF
      ENDDO
C INITIALIZE VIRTUAL TEMPERATURE ARRAY WITH REPORTED TEMPERATURE
C  {REPORTED TEMPERATURE IS SENSIBLE FOR ALL NON-SATELLITE TYPES,
C   VIRTUAL FOR RTOVS OR ATOVS (UNPACKED NMCEDS)}
      VTMP = TMP(:,3)
      KLVL = J
      DO N = 1,KLVL
         IP = NINT(TMP(N,1)*SCALE)
C TEMP PREPBUFR TBL VAL. .GE. 2 IF DWPT MSG OR .LT. TDLIM & RPT BELOW
C  400 MB OR RPT ABOVE LASTP LEVEL
         IF(IP.LT.LASTP)  JQ(N,2) = MAX(2,JQ(N,2))
cfix?    IF((TMP(N,4).GE.YMISS.OR.TMP(N,4).LT.TDLIM).AND.IP.GE.
         IF((TMP(N,4).GE.XMISS.OR.TMP(N,4).LT.TDLIM).AND.IP.GE.
     $    400*NINT(SCALE))  JQ(N,2) = MAX(2,JQ(N,2))
C NEED VIRT. TEMP. TO COMPUTE SIG. LVL HGHTS HYDROSTATICALLY --
C FOR RAOB, REPORTED TEMP SENSIBLE, MUST CALCULATE VIRTUAL TEMP
C FOR RTOVS OR ATOVS (UNPACKED NMCEDS), REPORTED TEMP. ALREADY VIRT.
cfix?    IF(JQ(N,2).LT.16.AND.TMP(N,4).LT.YMISS.AND.TMP(N,4).GE.0.0.AND.
         IF(JQ(N,2).LT.16.AND.TMP(N,4).LT.XMISS.AND.TMP(N,4).GE.0.0.AND.
     $    JQ(N,5).NE.15.AND.ISATOB.EQ.0)  THEN
C Q (SPECIFIC HUMIDITY) USED TO CALC. VIRTUAL TEMPERATURE (IF > 0)
            Q = QFRMTP(TMP(N,4),TMP(N,1))
            IF(Q.GE.0.0)  THEN
               TMPV = TMP(N,3) * (1.0 + (0.61 * Q))
              IF(TMPV.GE.375..OR.(TMPV.GE.325.AND.TMP(N,1).LT.100.))THEN
C IF CALC. VIRT. TEMP >375 K ( >325 K ABOVE 100 MB): USE SENS. TEMP IN
C  CALC.& SET Q.M. TO 15; (KEEP DEWPOINT TEMPERATURE)
          ! this should not be monitored by GSI!! (but is since qm=15)
                  JQ(N,2) = 15
                  PRINT 7983, STNID,TMP(N,1),N,TMP(N,3),TMP(N,4),TMPV
 7983 FORMAT(' * * T FLGGD, CAT2 Z CALC W/ S.TEMP;ID=',A8,', AT LVL '
     $,F6.1,'MB(',I2,') - S.TEMP (',F6.1,') AND/OR DWPT (',F6.1,') BAD',
     $ ', V.TEMP=',F6.1)
               ELSE
                  VTMP(N) = TMPV
               END IF
            END IF
         END IF
      ENDDO
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 904, STNID, NUMVAR+1
  904 FORMAT(/' SMERGE: ',A8,', CAT. 1,2,5 LVLS SORTED, PRIOR TO HYDRO',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (TMP(N,K),K=1,NUMVAR),VTMP(N)
            PRINT 905, (JQ(N,L),L=1,NUMQMS)
            PRINT 910, (IS(N,M),M=1,NUMGPS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      IF(KLVL.LE.1.OR.NSN.LE.0)  GO TO 63
C-----------------------------------------------------------------------
C           COMPUTE SIGNIFICANT LEVEL HEIGHTS HYDROSTATICALLY
C-----------------------------------------------------------------------
      DO N = 1,KLVL
         NTT  = N
         NST = NTT
         IF(JQ(NTT,1).LT.16.AND.JQ(NTT,2).LT.16)  GO TO 802
      ENDDO
      GO TO 63
  802 CONTINUE
      IF(FILLZ.AND.(IPRT(1).EQ.1.OR.IPRT(2).EQ.1).AND.JQ(NTT,1).LT.16)
     $ PRINT 800, STNID
  800 FORMAT(/,45X,'>>> HYDROSTATIC CHECK FOR STN. ID = ',A8,' <<<',
     $ //,1X,'MAND. PRES.',3X,'VIRT. TEMP',3X,'REPORTED',3X,
     $ 'INTEGRATED ',3X,'TV- ',3X,'TV- ',2X,'!   NEXT SIG/MAND  ',3X,
     $ 'VIRT. TEMP',3X,'INTEGR./REPORTED',2X,'TV- ',/,1X,' LEVEL (MB)',
     $ 3X,'   (K)',6X,' HGHT (M)  ',2X,'HGHT (M)',5X,'TEMP',
     $ 3X,'HGHT',2X,'!  PRES BELOW (MB)',3X,'    (K)  ',9X,'HGHT(M)  ',
     $ 5X,'HGHT',/,66X,'!')
C SET DEFAULTS IN CASE FIRST LEVEL PREPBUFR TABLE VALUE > 7
C  (PLIMIT = 150., SET BY KPM)
      PBOT = TMP(NTT,1)
      KPM = 4
      NST = NTT
      LOOP3: DO N = NTT,MXLVL
         PLO = TMP(N,1)
         ZLO = TMP(N,2)
         TLO = VTMP(N)
         JQN1 = JQ(N,1)
         IF(JQ(N,1).EQ.17)  THEN
            JQN1 = 15
         ELSE  IF(JQ(N,1).EQ.-3)  THEN
            JQN1 = 3
         ELSE  IF(JQ(N,1).EQ.-1)  THEN
            JQN1 = 2
         END IF
         IZQM = MAX(JQN1,JQ(N,2))
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING IZQM AS BAD(15)
         IF(JQ(N,5).EQ.15)  IZQM = MAX(15,IZQM)
         IF(IZQM.LT.16.AND.IZQM.GT.3)  THEN
            IZQM = 15
         ELSE  IF(IZQM.LT.3)  THEN
            IZQM =  2
         END IF
         IF(JQN1.LT.3)  THEN
            PBOT = PLO
C PLIMIT IS SET BY INDEX KPM (KPM=1 - 200; KPM=2 - 100; KPM=3 - 50)
            DO I = 1,3
               IF(PBOT.LE.PRS(I))  KPM = I
            ENDDO
            NST = N + 1
         END IF
         NN = N + 1
         IF(NN.GT.KLVL)  GO TO 63
         ZNEW = ZLO - (RO2G * (VTMP(NN) + TLO) * ALOG(TMP(NN,1)/PLO))
         NEWP = TMP(NN,1)
         PDIF = PLO - TMP(NN,1)
         ZLIMIT = 30. - (REAL(NEWP)/50.)
         JQNN1 = JQ(NN,1)
         IF(JQ(NN,1).EQ.17)  THEN
            JQNN1 = 15
         ELSE  IF(JQ(NN,1).EQ.-3)  THEN
            JQNN1 = 3
         ELSE  IF(JQ(NN,1).EQ.-1)  THEN
            JQNN1 = 2
         END IF
         IF(FILLZ.AND.(IPRT(1).EQ.1.OR.IPRT(2).EQ.1).AND.JQNN1.LT.16)
     $    PRINT 801, TMP(NN,1),VTMP(NN),TMP(NN,2),ZNEW,JQ(NN,2),JQNN1,
     $    PLO,TLO,ZLO,IZQM
  801    FORMAT(3X,F7.2,6X,F7.2,4X,F9.2,3X,F9.2,4X,I3,4X,I3,'    !  ',
     $    3X,F7.2,10X,F7.2,7X,F9.2,6X,I3)
         IF(JQNN1.LT.3)  THEN
C.......................................................................
C LEVEL NN CONTAINS GOOD HGHT INFO. (GENERALLY A MANDATORY LEVEL)
            ZDIF = ABS(TMP(NN,2) - ZNEW)
            IF(ZDIF.LT.ZLIMIT.AND.PDIF.LE.PLIMIT(KPM)+.001)  THEN
               CALL HSTATS(TMP(NN,2),ZNEW,RDATA(2),RDATA(1),NEWP)
               CYCLE LOOP3
            END IF
            IF(NN.EQ.NST)  CYCLE LOOP3
C IF ZLIMIT OR PLIMIT EXCEEDED SET HGHT PREPBUFR T. VAL=9 BETWEEN THIS &
C  LAST GOOD HGHT LVL (PREPBUFR TBL VAL.=17 IF FILLZ=F & NOT A MANDATORY
C  LEVEL, OTHERWISE SUBR. WNDBYP WOULD ATTEMPT A HEIGHT CALCULATION)
            NEND = N
            IF(FILLZ)  THEN
               PUP = TMP(NN,1)
               IF(ZDIF.GE.ZLIMIT)  PRINT 20, STNID,TMP(NST,1),NST,
     $          TMP(NEND,1),NEND,ZDIF,ZLIMIT,PUP
   20 FORMAT(' * * HGHT PREPBUFR T. V. SET TO 15, ID=',A8,', LVLS',
     $ ' BETWN ',F6.1,'(',I2,')& ',F6.1,'MB(',I2,')INCL.-ZDIF(',F6.1,
     $ 'M) GE ZLIMIT(',F6.1,'M)AT ',F6.1,'MB')
               IF(PDIF.GT.PLIMIT(KPM)+.001)  PRINT 1920, STNID,
     $          TMP(NST,1),NST,TMP(NEND,1),NEND,PLO,PUP,PLIMIT(KPM)
 1920 FORMAT(' * * HGHT PREPBUFR T. V. SET TO 15, ID=',A8,', LVLS',
     $ ' BETWN ',F6.1,'(',I2,')& ',F6.1,'MB(',I2,')INCL.-PDIF ',F6.1,
     $ ' TO ',F6.1,'MB GT PLIMIT(',F6.1,'MB')
            END IF
            DO NNF = NST,NEND
               JQNNF1 = JQ(NNF,1)
               JQ(NNF,1) = 15
               IF(.NOT.FILLZ.AND.(MOD(JQ(NNF,3),20).NE.1.OR.JQNNF1.GE.
     $          16)) JQ(NNF,1) = 17
            ENDDO
         ELSE  IF(JQNN1.GE.16)  THEN
C.......................................................................
C LVL NN IS CAT. 1/2 LVL W/ MSG HGHT -- FILL IN NEW CALC. HGHT AND
C  PREPBUFR TABLE VALUE
            TMP(NN,2) = ZNEW
            IZQM2 = MAX(IZQM,JQ(NN,2))
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING IZQM2 AS BAD(15)
            IF(JQ(NN,5).EQ.15)  IZQM2 = MAX(15,IZQM2)
            IF(IZQM2.LT.16.AND.IZQM2.GT.3)  THEN
               IZQM2 = 15
            ELSE  IF(IZQM2.LT.3)  THEN
               IZQM2 =  2
            END IF
            JQ(NN,1) = IZQM2
C EVENT#103 -  HEIGHT CREATED FROM HYDROSTATIC INTEGRATION OF RPTED DATA
            IF(FILLZ)  JR(NN,1) = 103
            IF(IZQM2.NE.16.AND..NOT.FILLZ)  THEN
C IF FILLZ=F & PREPBUFR TBL VAL NOT 16, SET HGT PREPBUFR TBL VAL =-1 IF
C  NON-BAD/SUSPECT, HGT PREPBUFR TBL VALUE =-3 IF SUSPECT, AND HGT
C  PREPBUFR TABLE VALUE =17 IF BAD
               JQ(NN,1) = -1
               IF(IZQM2.EQ.3) JQ(NN,1)=-3
               IF(IZQM2.GT.3.OR.PDIF.GT.PLIMIT(KPM)+.001)  JQ(NN,1) = 17
            END IF
            IF(FILLZ.AND.PDIF.GT.PLIMIT(KPM)+.001)  THEN
C IF FILLZ=T, HGHT PREPBUFR TBL VALUE SET TO 15 IF PLIMIT EXCEEDED
               PRINT 7821, STNID,TMP(NN,1),NN,PLO,TMP(NN,1),PLIMIT(KPM)
               JQ(NN,1) = 15
 7821 FORMAT(' * * HGHT PREPBUFR T. V. SET TO 15, ID = ',A8,', AT LVL '
     $,F6.1,'MB(',I2,') - PDIF ',F6.1,' TO ',F6.1,'MB GT PLIMIT(',F6.1,
     $ 'MB)')
            END IF
            IF(NN.GE.KLVL)  GO TO 63
         END IF
      ENDDO LOOP3
C***********************************************************************
   63 CONTINUE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 1905, STNID,NUMVAR+1
 1905 FORMAT(/' SMERGE: ',A8,', CAT. 1,2,5 LVLS W/ HYDRO, CALL"WNDBYP"',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         IF(KLVL.GT.0)  THEN
            DO N = 1,KLVL
               PRINT 900, (TMP(N,K),K=1,NUMVAR),VTMP(N)
               PRINT 905, (JQ(N,L),L=1,NUMQMS)
               PRINT 910, (IS(N,M),M=1,NUMGPS)
            ENDDO
         END IF
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C MERGE WINDS BY PRESSURE (DATA LEVEL CAT.3 + "SPEC." 25/50MB PRES.)
C  INTO TMP ARRAY
      IF(NP.GT.0)  CALL WNDBYP(NM,NS,NP,KLVL,TMP,JQ,JR,IPRT,VTMP)
C MERGE WINDS BY HEIGHT (DATA LEVEL CAT. 4) INTO TMP ARRAY
      IF(NH.GT.0)  CALL WNDBYZ(NM,NS,NP,NH,KLVL,TMP,JQ,IPRT,VTMP)
C TEMPERATURES BY HEIGHT (DATA LEVEL CAT. 15) ALREADY HAVE STD. ATMOS.
C  PRESSURE AND ARE NEVER MERGED WITH ANY OTHER CATEGORY AT THIS TIME,
C  NOTHING MORE NEEDS TO BE DONE EXCEPT TRANSFER DAT ARRAY TO TMP ARRAY)
      IF(N15.GT.0)  THEN
         KLVL = N15
         TMP = DAT
      END IF
C FILL MISSING WINDS INTO TMP ARRAY IF FILLW = TRUE
C  NOTE: THIS MUST BE CALLED FOR FOR RAOB AND PIBAL REPORTS EVEN IF
C        FILLW IS FALSE BECAUSE INTERPOLATED WINDS ARE USED TO OBTAIN
C        BALLOON DRIFT LAT/LON (IF FILLW=F, INTERPOLATED WINDS ARE
C        LATER EXCLUDED)
      IF(FILLW.OR.HDR(6).EQ.120)  CALL FILWND(KLVL,TMP,JQ,JR,IPRT)
C FILL MISSING DEWPOINTS INTO TMP ARRAY
      IF(FILLM)  CALL FILDPT(KLVL,TMP,JQ,JR,IPRT)
      DO N = 1,KLVL
C-----------------------------------------------------------------------
C  Changes to Height PREPBUFR Table Value
C-----------------------------------------------------------------------
C CHANGE T.V. FOR MISSING HEIGHTS (STANDARD ATMOSPHERE) FROM 16 TO 17
         IF(JQ(N,1).EQ.16)  JQ(N,1) = 17
C IF FILLZ=F, CHANGE T.V. -1,-2,-3 TO 16
         IF(JQ(N,1).LE.-1)  JQ(N,1) = 16
         IF(.NOT.FILLZ.AND.MOD(JQ(N,3),20).EQ.4)  THEN
C IF FILLZ=F AND CAT. 4/15 ...
            IF(JQ(N,1).GT.3.AND.JQ(N,1).LT.16)  THEN
C ... CHANGE T.V. FOR BAD HEIGHTS (4-15) TO 17
               JQ(N,1) = 17
            ELSE IF(JQ(N,1).NE.17)  THEN
C ... CHANGE T.V. 0-3,16 TO 16
               JQ(N,1) = 16
            END IF
         END IF
C AT THIS POINT, HEIGHTS WITH Q.M. .GE. 16 WILL BE EXCLUDED FROM OUTPUT
C  PREPBUFR FILE, HOWEVER HEIGHTS WITH Q.M. 16 (INTERPOLATED FROM
C  NON-BAD BRACKETING HEIGHT LVLS WHEN FILLZ=F) WILL BE USED IN BALLOON
C  DRIFT CALC
C-----------------------------------------------------------------------
C  Changes to Wind PREPBUFR Table Value
C-----------------------------------------------------------------------
C CHANGE T.V. FOR MISSING WINDS FROM 16 TO 17
         if(jq(n,4).eq.16)  jq(n,4) = 17
C IF FILLW=F, CHANGE T.V. -1,-2,-3 TO 16
         if(jq(n,4).le.-1)  jq(n,4) = 16
C AT THIS POINT, WINDS WITH Q.M. .GE. 16 WILL BE EXCLUDED FROM OUTPUT
C  PREPBUFR FILE, HOWEVER WINDS WITH Q.M. 16 (INTERPOLATED FROM NON-BAD
C  BRACKETING WIND LVLS WHEN FILLW=F) WILL BE USED IN BALLOON DRIFT CALC
C-----------------------------------------------------------------------
C IF FILLT=F, RESET T PREPBUFR T. V. -1,-7, 11 BACK TO 16 TO EXCL. INFO.
         IF(JQ(N,2).LE.-1.OR.JQ(N,2).EQ.17)  JQ(N,2) = 16
      ENDDO
C TRANSFER TMP ARRAY BACK TO DAT ARRAY
      DAT = TMP
      NLEV = KLVL
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SWNTBL
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2015-01-30
C
C ABSTRACT: COMPILES COUNTS FOR EACH SATWND TYPE (FOR ALL VALID COMB.
C   OF PRODUCER/SATELLITE/PRODUCT) AND SUMMARIZES EACH TYPE IN A
C   SEPARATE TABLE ACCORDING TO LATITUDE BAND (AND ALSO ACCORDING TO
C   ODD OR EVEN SATELLITE FOR GOES AND ACCORDING TO AQUA OR TERRA
C   SATELLITE FOR MODIS/POES).  INFORMATION SUCH AS TIME WINDOW,
C   OVERLAND SWITCH, & PROCESS/NO PROCESS SWITCH ALSO INCLUDED.
C
C PROGRAM HISTORY LOG:
C 1990-02-06  D. A. KEYSER (W/NMC22)
C 1993-05-31  D. A. KEYSER -- REORGANIZED TO PRINT A SEPARATE TABLE FOR
C     EACH PRODUCER/SATELLITE/PRODUCT COMBINATION PASSED IN, ALL VALID
C     COMBINATIONS NOW PRODUCE A UNIQUE TABLE
C 1996-09-03  D. A. KEYSER -- ADDED PROCESSING FOR NESDIS HI-DENSITY
C     SAT. WINDS (SWITCHES "SWINDO", "SWNLND", "JSWIND", "JSMASS"
C     EXPANDED), R.TYPES EXPANDED
C 2001-04-06  D. A. KEYSER -- N-LIST SWITCH SWINDO SPLIT INTO SWINDO_e
C     (EARLIEST TIME WINDOW) AND SWINDO_l (LATEST TIME WINDOW) FOR
C     SATWND REPORTS ("-" PRIOR TO CYCLE TIME, "+" AFTER CYCLE TIME)
C     (SAME DEFAULTS AS BEFORE)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF NASA/MODIS POES AQUA/
C     TERRA SATELLITE-DERIVED WINDS, NOW POSSIBLY INCL. IN "SATWND"
C     DUMP FILE EXISTING DUMP R. TYPE 63, GET PREPBUFR R. TYPES 257
C     (IR), 258 (W.VAPOR IMGR CLOUD-TOP) AND 259 (W.WAPOR IMGR DEEP
C     LAYER), PROCESSED INTO PREPBUFR FILE UNDER EXISTING TBL A ENTRY
C     "SATWND"
C 2006-11-29  D. A. KEYSER -- MODIFIED EUMETSAT PROCESSING TO CONSIDER
C     "ODD" AND "EVEN" SATELLITES SEPARATELY FOR PROCESS/NO-PROCESS/
C     FLAG ALL/FLAG EVERY-OTHER (N-LIST SWITCHES "JSMASS"/"JSWIND"),
C     TIME WINDOW ("SWINDO_e"/"SWINDO_l"), LAND/NO-LAND ("SWNLND"), ALL
C     BY LAT BAND AND PRODUCT TYPE
C 2015-01-30  D. A. Keyser -- All references to IR satellite-derived
C     winds now expanded to refer to IR "long-wave" - this
C     differentiates them from IR "short-wave" winds which are now
C     produced from GOES but are not processed by this program.
C
C USAGE:    CALL SWNTBL
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP  '.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SWNTBL
      LOGICAL  SWNLND
      CHARACTER*14  NAMEB(8)
      CHARACTER*47  NAME1(8),NAME2(8),NAME3(8),NAME4(8),NAME5(8),
     $ NAME6(8),NAME7(8),NAME8(8),NAME9(8),NAME10(8),NAMEA(8,10)
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      EQUIVALENCE (NAME1,NAMEA),(NAME2,NAMEA(1,2)),(NAME3,NAMEA(1,3)),
     $ (NAME4,NAMEA(1,4)),(NAME5,NAMEA(1,5)),(NAME6,NAMEA(1,6)),
     $ (NAME7,NAMEA(1,7)),(NAME8,NAMEA(1,8)),(NAME9,NAMEA(1,9)),
     $ (NAME10,NAMEA(1,10))
      DATA  NAME1/'>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>> INDIA GEOSTATIONARY IR(LW) CLOUD-DRIFT  <<<',
     $            '>>>  JAPAN GEOSTATIONARY IR(LW) CLOUD-DRIFT <<<',
     $            '>>>EUMETSAT GEOSTATIONARY IR(LW) CLOUD-DRIFT<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA  NAME2/'>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>     INDIA GEOSTATIONARY WATER VAPOR     <<<',
     $            '>>>     JAPAN GEOSTATIONARY WATER VAPOR     <<<',
     $            '>>>    EUMETSAT GEOSTATIONARY WATER VAPOR   <<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA  NAME3/'>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>> INDIA GEOSTATIONARY VISIBLE CLOUD-DRIFT <<<',
     $            '>>> JAPAN GEOSTATIONARY VISIBLE CLOUD-DRIFT <<<',
     $            '>>>EUMETSAT GEOSTATIONARY VISIBLE CLOUD-DRFT<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA  NAME4/'>>> NESDIS GEOSTATIONARY IMGR IR(LW) CLD-DFT<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>NASA/MODIS PLR-ORBITING IMGR IR(LW) C-DFT<<<',
     $            '                                               '/
      DATA  NAME5/'>>> NESDIS GEOSTATIONARY VISIBLE CLOUD-DRIFT<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA  NAME6/'>>>NESDIS GEOSTATIONARY IMAGER W.VPR-CL. TOP<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>NASA/MODIS POLAR-ORBITING IMGR WV-CL. TOP<<<',
     $            '                                               '/
      DATA  NAME7/'>>>NESDIS GEOSTATIONARY IMAGER W.VPR-DP. LYR<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>NASA/MODIS POLAR-ORBITING IMGR WV-DP. LYR<<<',
     $            '                                               '/
      DATA  NAME8/'>>>NESDIS GEOSTATIONARY SOUNDER W.VPR-CL.TOP<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA  NAME9/'>>>NESDIS GEOSTATIONARY SOUNDER W.VPR-DP.LYR<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA NAME10/'>>>   NESDIS GEOSTATIONARY PICTURE TRIPLET  <<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               ',
     $            '>>>?????????????????????????????????????????<<<',
     $            '                                               '/
      DATA  NAMEB/'   GOES-ODD   ','   GOES-EVEN  ','INSAT/KALPANA ',
     $            '  GMS/MTSAT   ',' METEOSAT-ODD ',' METEOSAT-EVEN',
     $            '     AQUA     ','     TERRA    '/
      PRINT 1
    1 FORMAT(/,33X,'***** TABLE DETAILING THE USE OF SINGLE-LEVEL ',
     $ 'SATELLITE DATA *****'/)
C***********************************************************************
C            LOOP THROUGH THE TEN POSSIBLE PRODUCT TYPES
C***********************************************************************
      LOOP1: DO IPROD = 1,10
C-----------------------------------------------------------------------
C      LOOP THROUGH THE PRODUCERS FOR WHICH WE TRACK TWO DIFFERENT
C               SATELLITES (NESDIS, EUMETSAT AND NASA/MODIS)
C-----------------------------------------------------------------------
         LOOP1n1: DO ITYPE = 1,7,2
            IF(ITYPE.EQ.3)  CYCLE LOOP1n1
            LOOP1n2: DO I = 1,6
               IF(MIN(JSMASS(I,ITYPE,IPROD),JSMASS(I,ITYPE+1,IPROD),
     $          JSWIND(I,ITYPE,IPROD),JSWIND(I,ITYPE+1,IPROD)).LT.9999)
     $          THEN
                  PRINT 33, NAMEA(ITYPE,IPROD)
                  PRINT 2, NAMEB(ITYPE),NAMEB(ITYPE+1),PHISWN,PHISWN,
     $            ((SWINDO_e(IPH,ITY,IPROD),IPH=1,6),ITY=ITYPE,ITYPE+1),
     $             ((SWINDO_l(IPH,ITY,IPROD),IPH=1,6),ITY=ITYPE,ITYPE+1)
                  PRINT 93,((SWNLND(IPH,ITY,IPROD),IPH=1,6),ITY=ITYPE,
     $             ITYPE+1)
                  PRINT 4,((JSWIND(IPH,ITY,IPROD),IPH=1,6),ITY=ITYPE,
     $             ITYPE+1)
                  PRINT 5,((JSMASS(IPH,ITY,IPROD),IPH=1,6),ITY=ITYPE,
     $             ITYPE+1)
   33 FORMAT(/41X,A47)
    2 FORMAT(/,1X,128('_') ,/,1X,'!',T29,'!',T47,A14,T79,'!',
     $ T95,A14,T129,'!'/' ',128('_')/1X,'!',T29,'!',T79,'!',T129,
     $ '!'/' ! PHISWN (LAT STRIPS - N )',T29,'!',7F7.0,'!',7F7.0,T129,
     $ '!'/' ',128('_'),/1X,'!',T29,'!',T79,'!',T129,'!'/
     $ ' ! EARLIEST TIME (HOUR*100)',T29,'!',5X,6F7.0,'  !',5X,6F7.0,
     $ T129,'!'/1X,'!',T29,'!',T79,'!',T129,'!'/
     $ ' !  LATEST  TIME (HOUR*100)',T29,'!',5X,6F7.0,'  !',5X,6F7.0,
     $ T129,'!'/1X,'!',T29,'!',T79,'!',T129,'!')
   93 FORMAT(' ! SWITCH: NO FLAG OVERLAND',T29,'!',5X,6L7,'  !',5X,6L7,
     $ T129,'!'/1X,'!',T29,'!',T79,'!',T129,'!')
    4 FORMAT(' ! SWITCH: PROCESS WIND RPT',T29,'!',5X,6I7,'  !',5X,6I7,
     $ T129,'!'/1X,'!',T29,'!',T79,'!',T129,'!')
    5 FORMAT(' ! SWITCH: PROCESS MASS RPT',T29,'!',5X,6I7,'  !',5X,6I7,
     $ T129,'!'/1X,128('-'))
                  PRINT 6,((KEPSW(IPH,ITY,IPROD),IPH=1,6),ITY=ITYPE,
     $             ITYPE+1)
    6 FORMAT(' ! NUMBER OF REPORTS KEPT',T29,'!',5X,6I7,'  !',5X,6I7,
     $ T129,'!'/' ',129('_')/)
                  CYCLE LOOP1n1
               END IF
            ENDDO LOOP1n2
         ENDDO LOOP1n1
C-----------------------------------------------------------------------
C    LOOP THROUGH THE PRODUCERS FOR WHICH WE TRACK JUST ONE SATELLITE
C                           (INDIA, JAPAN)
C-----------------------------------------------------------------------
         LOOP1n3: DO ITYPE = 3,4
            LOOP1n4: DO I = 1,6
               IF(MIN(JSMASS(I,ITYPE,IPROD),JSWIND(I,ITYPE,IPROD)).LT.
     $          9999)  THEN
                  PRINT 33, NAMEA(ITYPE,IPROD)
                  PRINT 22, NAMEB(ITYPE),PHISWN,
     $             (SWINDO_e(IPH1,ITYPE,IPROD),IPH1=1,6),
     $             (SWINDO_l(IPH1,ITYPE,IPROD),IPH1=1,6)
                  PRINT 923,(SWNLND(IPH,ITYPE,IPROD),IPH=1,6)
                  PRINT 24,(JSWIND(IPH,ITYPE,IPROD),IPH=1,6)
                  PRINT 25,(JSMASS(IPH,ITYPE,IPROD),IPH=1,6)
   22 FORMAT(/,31X,78('_') ,/,31X,'!',T59,'!',T77,A14,T109,'!'/30X,
     $ ' ',78('_')/31X,'!',T59,'!',T109,
     $ '!'/30X,' ! PHISWN (LAT STRIPS - N )',T59,'!',7F7.0,
     $ '!'/30X,' ',78('_'),/31X,'!',T59,'!',T109,'!'/30X,
     $ ' ! EARLIEST TIME (HOUR*100)',T59,'!',5X,6F7.0,'  !'/30X,
     $ ' !  LATEST  TIME (HOUR*100)',T59,'!',5X,6F7.0,'  !'
     $ /31X,'!',T59,'!',T109,'!')
  923 FORMAT(30X,' ! SWITCH: NO FLAG OVERLAND',T59,'!',5X,6L7,'  !'
     $ /31X,'!',T59,'!',T109,'!')
   24 FORMAT(30X,' ! SWITCH: PROCESS WIND RPT',T59,'!',5X,6I7,'  !'
     $ /31X,'!',T59,'!',T109,'!')
   25 FORMAT(30X,' ! SWITCH: PROCESS MASS RPT',T59,'!',5X,6I7,'  !'
     $ /31X,78('-'))
         PRINT 26,(KEPSW(IPH,ITYPE,IPROD),IPH=1,6)
   26 FORMAT(30X,' ! NUMBER OF REPORTS KEPT',T59,'!',5X,6I7,'  !'
     $ /30X,' ',78('_')/)
                  CYCLE LOOP1n3
               END IF
            ENDDO LOOP1n4
         ENDDO LOOP1n3
C-----------------------------------------------------------------------
      ENDDO LOOP1
C***********************************************************************
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    HSTATS
C   PRGMMR: D. A. KEYSER     ORG: W/NMC22    DATE: 1990-01-11
C
C ABSTRACT: COMPUTES STATISTICS FOR HYDROSTATIC CHECK OF MERGED RAOBS.
C   FOR EACH RAOB REPORT, EVERY SIGNIFICANT LEVEL IS INTEGRATED
C   HYDROSTATICALLY UP TO FIRST MANDATORY LEVEL ABOVE.  THE INTEGRATED
C   HEIGHT IS THEN COMPARED TO THE REPORTED HEIGHT AT THE MANDATORY
C   LEVEL.  THIS SUBPROGRAM SUMS UP REPORTED HEIGHTS, INTEGRATED
C   HEIGHTS, DIFFERENCES AND THEIR SQUARES AT ALL MANDATORY LEVELS
C   FOR ALL REPORTS.  FINALLY, ENTRY 'PSTATS' IS CALLED AFTER ALL
C   UPPER-AIR REPORTS HAVE BEEN EXAMINED, AND IT PRINTS A TABLE
C   OF MEAN REPORTED/INTEGRATED HEIGHT FOR EACH MAND. P-LEVEL ALONG
C   WITH THE BIAS, RMS, MAXIMUM DIFFERENCE, AND LAT/LON OF MAX. DIFF.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKED/COMMENTED
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C
C USAGE:    CALL HSTATS(ZIN,ZOUT,XI,YJ,KP)
C   INPUT ARGUMENT LIST:
C     ZIN      - REPORTED HEIGHT AT MANDATORY PRESSURE LEVEL
C     ZOUT     - INTEGRATED HEIGHT REPORTED AT MAND. P-LEVEL
C     XI       - LONGITUDE OF REPORT (DEG.WEST)
C     YJ       - LATITUDE OF REPORT (DEG., N+,S-)
C     KP       - PRESSURE LEVEL
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'SMERGE', ENTRY 'PSTATS' IN SUBROUTINE
C   'PREP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE HSTATS(ZIN,ZOUT,XI,YJ,KP)
      PARAMETER (MAXOBS = 4500)
      DIMENSION  STATS(8,22),XMAX(22),YMAX(22)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      DATA  STATS/176*0.0/,XMAX/22*0.0/,YMAX/22*0.0/
      DO I = 1,22
         K = I
         IF(KP.GE.INT(PMAND(I)))  EXIT
      ENDDO
      ZDIF = ZOUT - ZIN
      STATS(8,K) = STATS(8,K) + 1.
      STATS(1,K) = STATS(1,K) + ZIN
      STATS(2,K) = STATS(2,K) + ZOUT
      STATS(3,K) = STATS(3,K) + ZDIF
      STATS(4,K) = STATS(4,K) + (ZIN * ZIN)
      STATS(5,K) = STATS(5,K) + (ZOUT * ZOUT)
      STATS(6,K) = STATS(6,K) + (ZDIF * ZDIF)
      IF(ABS(ZDIF).GT.STATS(7,K))  THEN
         STATS(7,K) = ABS(ZDIF)
         XMAX(K) = XI
         YMAX(K) = YJ
      END IF
      RETURN
         ENTRY PSTATS
      PRINT 20
   20 FORMAT(/,20X,'***** STATISTICAL ANALYSIS BY PRESSURE',
     $ ' FOR HYDROSTATIC HEIGHT CHECK OF MERGED RAOBS *****',//,3X,
     $ 'COUNT',5X,'PRESSURE',2X,'REPORTED MEAN',3X,'INTEGRATED MEAN',6X,
     $ 'BIAS',12X,'RMS',10X,'MAXDIF',4X,'AT',4X,'LON*100',8X,'LAT*100',
     $  /,15X,'(MB)',6X,'HEIGHT (M)',7X,'HEIGHT (M)',9X,'(M)',
     $ 12X,'(M)',12X,'(M)',10X,'(DEG. W)',7X,'(DEG. N)')
      DO K = 1,22
         COUNT = MAX(1.0,STATS(8,K))
         COUNT = 1.0/COUNT
         DO I = 1,3
            STATS(I,K) = STATS(I,K) * COUNT
            STATS(I+3,K) = SQRT(STATS(I+3,K) * COUNT)
         ENDDO
      ENDDO
      DO K = 22,1,-1
         KNTT = MAX(1,INT(STATS(8,K)))
         IF(STATS(1,K).EQ.0..AND.NINT(XMAX(K)*100.).EQ.0.AND.
     $    NINT(YMAX(K)*100.).EQ.0)  CYCLE
         IPMAND = INT(PMAND(K))
         PRINT 30, KNTT,IPMAND,(STATS(I,K),I=1,3),(STATS(I,K),I=6,7),
     $    XMAX(K),YMAX(K)
   30    FORMAT(I7,5X,I6,7X,5(F10.3,5X),3X,2(F7.2,8X))
      ENDDO
      STATS = 0.0
      XMAX  = 0.0
      YMAX  = 0.0
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    WNDBYP
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 1999-08-04
C
C ABSTRACT: MERGES CATEGORY 3 (WINDS-BY-PRESSURE) AND SPECIAL 25 OR
C   50 MB LEVEL DATA LEVELS INTO UPPER-AIR REPORT PROFILE.  CHECKS FOR
C   DUPLICATE PRESSURES AND IF FOUND TRANSFERS HIGHEST QUALITY WIND
C   TO A CATEGORY 1,2,5 DATA LEVEL.  FINALLY, INTERPOLATES TEMPERATURE
C   AND HEIGHT TO LEVELS CONTAINING ONLY WIND INFORMATION.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1989-04-17  D. A. KEYSER -- DOCBLOCKING/COMMENTING, TESTS FOR SPEC.
C     LEVELS (UNIQUE CAT. NO. OF 6)
C 1989-06-15  G. J. DIMEGO -- MADE RO2G CONFORM TO RAFS/GDAS VALUE
C 1989-12-13  D. A. KEYSER -- 'FILL' SWITCH NOW TESTED FOR INTERPOLATING
C     TO MISSING DATA LEVELS
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C     RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C     MARKERS; IN INTERNAL PROCESSING MISSING DATA GET PREPBUFR TABLE
C     VALUE OF 16 RATHER THAN 10; VERTICAL COORDINATE INDIC. ADDED TO
C     PREPBUFR TBL VALUE LIST FOR VARIABLES
C 1993-09-14  D. A. KEYSER -- SENSIBLE TEMPERATURE FOR PROFILE SAVED
C     IN STMP OR SDAT ARRAYS (IN CASE TVIRT=FALSE)
C 1993-12-21  D. A. KEYSER -- DUPL. P-LVLS NOW ENSURES THAT BEST TEMP
C     IS KEPT REGARDLESS OF HGHT TBL. VAL. & WILL NOT TRANSF. DWPT TO
C     LVL WHERE MSG UNLESS FILLM=T OR TEMP. HAS BEEN TRANSFERRED
C 1994-08-11  D. A. KEYSER --  ALL DUPL. PRESS. CHECKS NOW REQUIRE
C     PRESS. TO AGREE TO NEAREST 10'TH OF A MB TO BE A DUPL. (WAS TO
C     NEAREST WHOLE MB)
C 1995-07-12  D. A. KEYSER -- IF SPANNING LVL PRESS. Q.M. IS BAD INTEGR.
C     HGHT & TEMP Q.M. SET TO BAD, IF INTEGR. LVL PRESS. Q.M. IS BAD
C     INTEGR. HGHT & TEMP Q.M. SET TO BAD
C 1996-02-07  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: ORIGINAL TESTS FOR
C     OLD PREPDA PROC. OF CAT. 3 WINDS ON LVLS ABOVE LAST NON-MISSING
C     HGHT AND TEMP. LEVELS RETAINED (TO MAKE BUFR-PREPDA FILE CONTAIN
C     DATA EXPECTED BY FERR PGM AND OI ANALYSIS)
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (DUPL. P-LVL CHECK MORE LIKE OLD "PREPDA" FORM; INTERP./CALC.
C     DATA CAN GET GOOD Q.M. IF SPANNING LVL DATA GOOD)
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C     TYPES (CURRENTLY JUST 100, 101-103, 105 TO IDENTIFY INTERPOLATED
C     DATA FOR CQCBUFR PGM); CHGS IN LVL ON29 CATEGORY INDICATORS:
C     SPEC. LVLS GET CAT=7 RATHER THAN 6, CAT 2 & 3 EXPLICITLY
C     IDENTIFIED IN ALL CASES
C 1999-08-04  D. A. KEYSER -- REPLACED SORT ROUTINE "SHELL" (IN-LINE
C     SUBROUTINE) WITH W3LIB ROUTINE "ORDERS", MORE EFFICIENT AND
C     ALLOWS MULTIPLE ORDER SORT KEYS
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. HP, XP, AND YP WERE
C     ADDED TO KEEP LOCATION AND TIME INFORMATION. IS WAS ADDED AS AN
C     ARRAY TO KEEP THE DATA.
C
C USAGE:    CALL WNDBYP(NM,NS,NP,KLVL,TMP,JQ,JR,IPRT,VTMP)
C   INPUT ARGUMENT LIST:
C     NM       - NO. OF LEVELS IN CAT. 1 (MANDATORY MASS/WIND)
C     NS       - NO. OF LEVELS IN CAT. 2,5 (SIG. MASS & TROP)
C     NP       - NO. OF CAT. 3 & SPECIAL 25 OR 50 MB PRES. LVLS
C     KLVL     - NO. OF COMBINED CAT. 1,2, AND 5 LEVELS WITH
C              - DUPLICATES REMOVED
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2, AND 5 AFTER MERGING
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S PREPBUFR
C              - TABLE VALUES IN CAT. 1,2, AND 5 AFTER MERGING
C     JR       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S REASON
C              - CODES IN CAT. 1,2, AND 5 AFTER MERGING
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C     VTMP    - "MXLVL" WORD ARRAY HOLDING AN U-AIR REPORT'S VIRTUAL
C              - TEMP DATA IN CAT. 1,2, AND 5 AFTER MERGING
C
C   OUTPUT ARGUMENT LIST:
C     KLVL     - NO. OF COMBINED CAT. 1,2,3,5 AND SPECIAL 25/50 MB
C              - LEVELS WITH DUPLICATES REMOVED
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,5 AND SPECIAL 25/50 MB
C              - LEVELS AFTER MERGING
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S PREPBUFR
C              - TABLE VALUES IN CAT. 1,2,3,5 AND SPECIAL 25/50 MB LVLS
C              - AFTER MERGING
C     JR       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S REASON
C              - CODES IN CAT. 1,2,3,5 AND SPECIAL 25/50 MB LEVELS
C              - AFTER MERGING
C     VTMP     - "MXLVL" WORD ARRAY HOLDING AN U-AIR REPORT'S VIRTUAL
C              - TEMP DATA IN CAT. 1,2,3,5 AND SPECIAL 25/50 MB LEVELS
C              - AFTER MERGING
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'SMERGE'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE WNDBYP(NM,NS,NP,KLVL,TMP,JQ,JR,IPRT,VTMP)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      DIMENSION  TMP(MXLVL,NUMDAT),KS(MXLVL),IQ(MXLVL,NUMQMS),
     $ JQ(MXLVL,NUMQMS),VTMP(MXLVL),VDAT(MXLVL),IR(MXLVL,NUMQMS),
     $ JR(MXLVL,NUMQMS),IWORK(MXLVL),TMPINV(NUMDAT,MXLVL)
      CHARACTER*8  STNID,SUBSET_d
      INTEGER  IPRT(2),IC(0:16)
      real(8)  alon_8,alat_8
      REAL     IS(MXLVL,NUMGPS)
      LOGICAL  FILLM,FILLZ,FILLT
      COMMON/WORD/LWI,LWR
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      EQUIVALENCE  (DAT(1,NUMVAR+1),IQ)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+1),IR)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+NUMQMS+1),IS)
C PREPBUFR TABLE VALUE INTERPRETED AS: 0 - KEEP, 1 - GOOD,
C  2- DEFAULT, 3 - SUSPECT, 9 - BAD  IN DUPL. LEVEL TBL VALUE COMPARISON
C  T.V.->      0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16
      DATA IC/ 0, 1, 2, 3, 9, 9, 9, 9, 9, 9,  9,  9,  9,  9,  9,  9, 16/
      SCALE = 10.
      RO2G = 287.05/(2.0 * 9.8)
C MP IS NO. OF CAT 1,2,5 LEVELS (ARRANGED IN PROPER ORDER)
      MP = NM + NS
      NN = KLVL
C TRANSFER BLOCK OF CAT. 3 AND SPECIAL LEVELS FROM DAT TO TMP
      DO N = 1,NP
         NN = KLVL + N
         MM = MP + N
         VTMP(NN) = DAT(MM,3)
         TMP(NN,1:NUMDAT) = DAT(MM,1:NUMDAT)
      ENDDO
C KLVL NOW IS TOTAL OF CAT. 1,2,5, & 3 + SPECIAL LVLS, DUPLICATES POSS.
      KLVL = NN
      KS = 0
C ARRANGE LEVELS IN ORDER OF DECREASING PRESSURE (FIRST ORDER SORT KEY,
C  SECOND ORDER SORT KEY IS HEIGHT)
C .. MUST SWITCH ORDER OF ELEMENTS IN TMP ARRAY - CALL IT TMPINV
      DO  J=1,NUMDAT
         TMPINV(J,1:KLVL) = TMP(1:KLVL,J)
      END DO
      CALL ORDERS( 2,IWORK,TMPINV(2,1),KS,KLVL,NUMDAT,LWR,2)
      CALL ORDERS(12,IWORK,TMPINV(1,1),KS,KLVL,NUMDAT,LWR,2)
C .. DAT ARRAY LIKE TMPINV ARRAY, BUT P-LVLS ARRANGED PROPERLY, ALSO
C    ORDER OF ELEMENTS SWITCHED BACK
      DO N = 1,KLVL
         L = KS(KLVL-N+1)
         VDAT(N) = VTMP(L)
         DAT(N,1:NUMDAT) = TMPINV(1:NUMDAT,L)
      ENDDO
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 902, STNID,NUMVAR+1
  902 FORMAT(/' WNDBYP: ',A8,', CAT. 1,2,3,5,S  W/ SORT HAS DUPL. LVLS',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
            PRINT 905, (IQ(N,L),L=1,NUMQMS)
            PRINT 910, (IS(N,M),M=1,NUMGPS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
C          CHECK FOR DUPLICATE PRESSURES ON ADJACENT LEVELS
C  MAY RESULT IN TRANSFER OF WIND FROM CAT. 3 DATA LEVEL TO CAT. 1,2,5
C                            DATA LEVEL
C***********************************************************************
      IP = NINT(DAT(1,1)*SCALE)
      NCNT = 0
      DO N = 2,KLVL
C "NN" IS LVL DIRECTLY BELOW "N" -- TRANSFER ALWAYS FROM N TO NN
         NN = N - 1
         JP = NINT(DAT(N,1)*SCALE)
         IF(IP.NE.JP)  GO TO 24
C HERE IS A DUPLICATE, NCNT COUNTS NO. OF DUPLICATE LEVELS
         NCNT = NCNT + 1
C IN CASE ONE OF IQ(N,3)/IQ(NN,3) BELOW SET TO 7 FOR SPECIAL LVLS, NEED
C  TO TEST IT AS A CAT. 3 (ORIGINALLY SPECIAL LEVELS WERE SET TO CAT. 3)
C  (SAME TRUE FOR TROP LVLS SET TO CAT 5 BUT NEED TO BE TESTED AS CAT 2)
         IQN3 = MOD(IQ(N,3),20)
         IQNN3 = MOD(IQ(NN,3),20)
         JQNN3 = IQ(NN,3)
         IF(IQN3.EQ.5)   IQN3  = 2
         IF(IQN3.EQ.7)   IQN3  = 3
         IF(IQNN3.EQ.5)  IQNN3 = 2
         IF(IQNN3.EQ.7)  IQNN3 = 3
         IQN1  = IQ(N,1)
         IQNN1 = IQ(NN,1)
         IF(IQN1 .LE.-1.OR.IQN1 .EQ.17)  IQN1  = 16
         IF(IQNN1.LE.-1.OR.IQNN1.EQ.17)  IQNN1 = 16
         IF(IQN3.LT.IQNN3)  THEN
C-----------------------------------------------------------------------
C    CASE WHERE CAT. 3 OR SPECIAL DATA LVL ON "NN", CAT 1,2,5 DATA
C                              LVL ON "N"
C  (NOTE: THIS LOGIC IS CONVOLUTED -- SOMETIME NEEDS TO BE STREAMLINED)
C-----------------------------------------------------------------------
            NFLAG = 0
            MFLAG = 0
            IF(IC(IQN1).LT.IC(IQNN1))  THEN
C HGHT PREPBUFR TBL VAL. FOR N BETTER THAN FOR NN (ALWAYS TRUE, NN HGHT
C  PREPBUFR TBL VAL. =16); TRANS. PRESS., HGHT, CAT. NO., & VERT. COORD.
C  INDICATOR ON LVL N TO LVL NN
C (IF HGT PREPBUFR TBL VAL. ON N NOT BETTER, NEVER TRANSF. TEMP)
               MFLAG = 1
               IQ(NN,1) = IQ(N,1)
               DAT(NN,1) = DAT(N,1)
               IR(NN,1) = IR(N,1)
               IQ(NN,3) = IQ(N,3)
               IQ(NN,5) = IQ(N,5)
               DAT(NN,2) = DAT(N,2)
               IR(NN,5) = IR(N,5)
            END IF
            IF(IC(IQ(N,2)).LT.IC(IQ(NN,2)))  THEN
C TEMP PREPBUFR TBL VAL FOR N BETTER THAN FOR NN (ALMOST ALWAYS TRUE, NN
C  TEMP PREPBUFR TBL VAL. =16); TRANS. TMP ON LVL N TO NN (TEMP CAN BE
C  TRANS. REGARDLESS OF HGHT PREPBUFR TABLE VALUE, ALSO MAY TRANS. CAT.
C  NO., VERT. COORD. IND. AND PRESS. IN THIS CASE)
               NFLAG = 1
               IQ(NN,2) = IQ(N,2)
               DAT(NN,3) = DAT(N,3)
               IR(NN,2) = IR(N,2)
               IR(NN,3) = IR(N,3)
               VDAT(NN) = VDAT(N)
               IF(MFLAG.EQ.0)  THEN
                  IQ(NN,3) = IQ(N,3)
                  IQ(NN,5) = IQ(N,5)
                  DAT(NN,1) = DAT(N,1)
                  IR(NN,5) = IR(N,5)
                  IF(IQ(NN,1).EQ.16)  THEN
C IF HGHT T.V. ON LVL NN IS 16, GO AHEAD AND TRANSF. HGHT
C  (CAN'T BE ANY WORSE & MAY HELP IN LATER CAT. 4 PROFILE PLACEMENT)
                     IQ(NN,1) = IQ(N,1)
                     DAT(NN,2) = DAT(N,2)
                     IR(NN,1) = IR(N,1)
                  END IF
               END IF
            END IF
C ONLY TRANSFER DWPT ON LVL N TO LVL NN WHEN NN DWPT MSG (ALWAYS TRUE)
C  AND EITHER FILLM IS TRUE OR ABOVE TRANSF. OF TEMP & CAT. # OCCURRED
            IF(DAT(NN,4).GE.9999..AND.(FILLM.OR.NFLAG.EQ.1))
     $       DAT(NN,4) = DAT(N,4)
         ELSE
C-----------------------------------------------------------------------
C    CASE WHERE CAT. 3 OR SPECIAL DATA LVL ON "N", CAT 1,2,5 DATA LVL
C                                ON "NN"
C ONLY TRANSFER HERE IS OF HEIGHT (ELEV) FROM LVL 2 TO LVL 1 WHEN CAT. 3
C DATA LVL W/ VALID ELEV ON "N" & CAT. 2 DATA LVL W/ MSG ELEV ON "NN" --
C    THIS CAN HAPPEN ONLY IF 1ST CAT. 2 DATA LVL HAS UNREASONABLE/MSG
C  PRESSURE & 2ND CAT. 2 DATA LVL IS SFC PRESSURE EQUAL TO FIRST CAT. 3
C                      DATA LVL WHICH HAS ELEV
C-----------------------------------------------------------------------
            IF(IC(IQN1).LT.IC(IQNN1).AND.NN.EQ.1) THEN
               IQ(NN,1) = IQ(N,1)
               DAT(NN,2) = DAT(N,2)
               IR(NN,1) = IR(N,1)
            END IF
         END IF
C-----------------------------------------------------------------------
C  CASE WHERE CAT. 3 OR SPECIAL DATA LVL & CAT 1,2,5 DATA LVL COULD BE
C                              EITHER WAY
C-----------------------------------------------------------------------
         IQN4  = IC(IQ(N,4))
         IQNN4 = IC(IQ(NN,4))
        IF(IQN4.LT.IQNN4.OR.(IQN4.EQ.IQNN4.AND.IQ(N,3).EQ.IQ(NN,3)))THEN
C WIND PREPBUFR TBL V. FOR N BETTER THAN FOR NN - OR - WIND PREPBUFR TBL
C  VAL. FOR N SAME AS FOR NN AND CAT. NO. 1,5 TRANSF. FROM N TO NN --
C  TRANSFER WIND ON LVL N TO LVL NN (ALWAYS TRUE FOR SPEC. LVLS WHEN
C  ON "NN", WIND PREPBUFR TBL VALUE = 16; NEVER TRUE FOR SPEC. LVLS WHEN
C  ON "N", WIND PREPBUFR TABLE VALUE = 16)
C IF WIND IS ORIGINALLY FROM CAT. 3 LEVEL AND RETAINED LEVEL DOES NOT
C  HAVE CAT. NO. 5 (AND DOES NOT HAVE AN EARLIER CAT. 5 DUPL.), ADD 40
C  TO DATA LEVEL CATEGORY NUMBER
            IF(MOD(IQ(N,3),20).EQ.3.AND.MOD(IQ(NN,3),20).NE.5.AND.
     $       IQ(NN,3).LT.60)  IQ(NN,3) = MOD(IQ(NN,3),20) + 40
            IQ(NN,4) = IQ(N,4)
            DAT(NN,5) = DAT(N,5)
            DAT(NN,6) = DAT(N,6)
            IR(NN,4) = IR(N,4)
         ELSE  IF(IQN4.GT.IQNN4.AND.IQ(N,3).EQ.IQ(NN,3))  THEN
C WIND PREPBUFR TBL VAL. FOR N WORSE THAN FOR NN AND CAT. NO.1,5 TRANSF.
C  FROM N TO NN -- IF GOOD WIND WAS ORIGINALLY ON CAT. 3 LEVEL AND
C  TRANSFERRED CAT. NO. IS NOT 5 (AND DOES NOT HAVE AN EARLIER CAT. 5
C  DUPL.) ADD 40 TO DATA LEVEL CATEGORY NUMBER
            IF(MOD(JQNN3,20).EQ.3.AND.MOD(IQ(NN,3),20).NE.5.AND.
     $       IQ(NN,3).LT.60) IQ(NN,3) = MOD(IQ(NN,3),20) + 40
         END IF
C CULL THE DUPLICATE PRESSURE LEVEL
         DAT(N,1) = 0.0
   24    CONTINUE
         IP = JP
      ENDDO
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 903, STNID,NUMVAR+1
  903 FORMAT(/' WNDBYP: ',A8,', CAT. 1,2,3,5,S  W/ DUPL. ZEROED OUT',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
            PRINT 905, (IQ(N,L),L=1,NUMQMS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
C REMOVE DUPLICATE LEVELS AND FILL ARRAY TMP
      LCNT = 0
      DO N = 1,KLVL
         IF(DAT(N,1).LT.0.4)  CYCLE
         LCNT = LCNT + 1
         VTMP(LCNT) = VDAT(N)
         TMP(LCNT,1:NUMDAT) = DAT(N,1:NUMDAT)
      ENDDO
C RESET KLVL TO NO. OF CAT. 1,2,3,5,+ SPECIAL LEVELS (W/O DUPS)
      KLVL = LCNT
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 904, STNID,NUMVAR+1
  904 FORMAT(/' WNDBYP: ',A8,', CAT. 1,2,3,5,S  W/ DUPL. REMOVED',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (TMP(N,K),K=1,NUMVAR),VTMP(N)
            PRINT 905, (JQ(N,L),L=1,NUMQMS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
C   INTERP. HGHT & IF APPROP. TEMP TO CAT. 3 & SPEC. DATA LVLS WHERE
C                            EITHER MISSING
C***********************************************************************
      IF(NCNT.EQ.NP)  GO TO 31
      DO N = 1,KLVL
         NT = N
         IF(JQ(NT,1).LE.3.AND.JQ(NT,2).LE.3)  GO TO 29
      ENDDO
      GO TO 31
   29 CONTINUE
C BOTTOM SPANNING LVL (NT)-FOR SOME REASON LOWEST B.S. LVL IN PROFILE
C  MUST HAVE HGHT & TEMP PREPBUFR TBL. VAL. .LE. 9;
C  ABOVE THIS ONLY NEED NON-MISSING HGHT & TEMP
      PLO = TMP(NT,1)
      ZLO = TMP(NT,2)
      TLO = TMP(NT,3)
      VTLO = VTMP(NT)
      IZQLO = JQ(NT,1)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING IZQLO AS BAD(15)
      IF(JQ(NT,5).EQ.15)  IZQLO = MAX(15,IZQLO)
C IF HGHT PREPBUFR TBL VAL. =17 IT IS POOR QUALITY CAT. 2 HGHT WHEN
C  FILLZ=F, CHG TO 15
      IF(IZQLO.EQ.17)  IZQLO = 15
C IF HGHT PREPBUFR TABLE VALUE =-1 OR -3 IT IS GOOD QUALITY CAT. 2 HGHT
C  WITH FILLZ=F, CHG TO 2
      IF(IZQLO.LE.-1)  IZQLO = 2
      ITQLO = JQ(NT,2)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING ITQLO AS BAD(15)
      IF(JQ(NT,5).EQ.15)  ITQLO = MAX(15,ITQLO)
C NST WILL NOW REPRESENT BOTTOM SPANNING LEVEL
      NST = NT
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 31
      LCNT = 0
      IF(JQ(NT,1).NE.16.AND.JQ(NT,2).NE.16)  GO TO 29
   30 CONTINUE
C LVL W/ EITHER MISSING HGHT OR MISSING TEMP FOUND, LCNT COUNTS THESE
      LCNT = LCNT + 1
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 31
      IF(JQ(NT,1).EQ.16.OR.JQ(NT,2).EQ.16)  GO TO 30
C THIS IS TOP SPANNING LVL (NT) -- BOTH HGHT & TEMP ARE NON-MISSING
      PPHI  = TMP(NT,1)
      THI   = TMP(NT,3)
      VTHI   = VTMP(NT)
      IZQHI = JQ(NT,1)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING IZQHI AS BAD(15)
      IF(JQ(NT,5).EQ.15)  IZQHI = MAX(15,IZQHI)
C IF HGHT PREPBUFR TABLE VALUE =17 IT IS POOR QUALITY CAT. 2 HGHT WHEN
C  FILLZ=F, CHG TO 15
      IF(IZQHI.EQ.17)  IZQHI = 15
C IF HGHT PREPBUFR TABLE VALUE =-1 OR -3 IT IS GOOD QUALITY CAT. 2 HGHT
C  WITH FILLZ=F, CHG TO 2
      IF(IZQHI.LE.-1)  IZQHI = 2
      ITQHI = JQ(NT,2)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING ITQHI AS BAD(15)
      IF(JQ(NT,5).EQ.15)  ITQHI = MAX(15,ITQHI)
C-----------------------------------------------------------------------
C LOOP THROUGH ALL IN BETWEEN LEVELS W/ MISSING HGHT AND/OR MISSING TEMP
C-----------------------------------------------------------------------
      DO L = 1,LCNT
C NOW, N REPRESENTS IN BETWEEN MISSING HGHT/TEMP LEVEL; NST STILL
C  REPRESENTS BOTTOM SPANNING LEVEL & NT REPRESENTS TOP SPANNING LEVEL
         N = NST + L
C CALC. THE DELTA TEMP/DELTA LOG P BETWEEN THE SPANNING LEVELS
         DTDLNP = (THI - TLO)/ALOG(PPHI/PLO)
         VTDLNP = (VTHI - VTLO)/ALOG(PPHI/PLO)
C THE PRESSURE ON THIS LEVEL IS KNOWN
         PP = TMP(N,1)
C CALC. THE DELTA LOG P BETWEEN THE LEVEL BENEATH & THIS LEVEL
         PLOG = ALOG(PP/PLO)
C NOW INTERPOLATE TEMP UP TO THIS LEVEL & DETERMINE ITS PREPBUFR TBL VAL
         TT  = TLO + (DTDLNP * PLOG)
         VTT  = VTLO + (VTDLNP * PLOG)
         ITQ = MAX(ITQLO,ITQHI)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING ITQ AS BAD(15)
         IF(JQ(N,5).EQ.15)  ITQ = MAX(15,ITQ)
         IF(ITQ.LT.16.AND.ITQ.GT.3)  THEN
            ITQ = 15
         ELSE  IF(ITQ.LT.3)  THEN
            ITQ =  2
         END IF
C IS TEMP ALREADY OF GOOD QUALITY?  IF SO, WILL REMAIN ORIG. VALUE
         IF(JQ(N,2).LE.3)  THEN
            TT  = TMP(N,3)
            VTT  = VTMP(N)
            ITQ = JQ(N,2)
         END IF
C NOW INTERPOLATE HGHT UP TO THIS LEVEL & DETERMINE ITS PREPBUFR TBL VAL
C  (USE VIRTUAL TEMPERATURE IN THIS CALCULATION)
         ZLO = ZLO - (RO2G * (VTT + VTLO) * PLOG)
         IZQ = MAX(IZQLO,IZQHI)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING IZQ AS BAD(15)
         IF(JQ(N,5).EQ.15)  IZQ = MAX(15,IZQ)
         IF(IZQ.LT.16.AND.IZQ.GT.3)  THEN
            IZQ = 15
         ELSE  IF(IZQ.LT.3)  THEN
            IZQ =  2
         END IF
C IS HGHT ALREADY OF GOOD QUALITY?  IF SO, WILL REMAIN ORIG. VALUE
         IF(JQ(N,1).LE.3)  THEN
            ZLO = TMP(N,2)
            IZQ = JQ(N,1)
         END IF
C PLO, ZLO, TLO NOW ASSIGNED TO THIS LEVEL BEFORE LOOKING AT NEXT ONE
         PLO = PP
         TMP(N,2) = ZLO
         TMP(N,3) = TT
         VTMP(N)  = VTT
         IF(FILLZ)  THEN
C IF FILLZ=T, ASSIGN NEW PREPBUFR TABLE VALUE FOR HEIGHT ON THIS LEVEL
C EVENT#103 -  HEIGHT CREATED FROM HYDROSTATIC INTEGRATION OF RPTED DATA
            IF(JQ(N,1).GT.3)  JR(N,1) = 103
            JQ(N,1) = IZQ
         ELSE
C FILLZ=F & HGT PREPBUFR TBL VAL=16: THIS IS CAT 3 OR SPECIAL LVL; RESET
C  HGT PREPBUFR TBL VAL TO -1 IF GOOD OR TO 17 IF BAD SO INCL. IN LATER
C  HGT CALCULATION (WILL CHANGE BACK TO 16)
            IF(JQ(N,1).EQ.16)  THEN
               IF(IZQ.LE.3)  THEN
                  JQ(N,1) = -1
               ELSE  IF(IZQ.GT.3.AND.IZQ.LE.15) THEN
                  JQ(N,1) = 17
               END IF
            END IF
         END IF
         IF(FILLT)  THEN
C IF FILLT=T, ASSIGN NEW PREPBUFR TBL VALUE FOR TEMPERATURE ON THIS LVL
C EVENT#102 - TEMPERATURE CREATED FROM INTERPOLATION OF REPORTED DATA
            IF(JQ(N,2).GT.3)  JR(N,2) = 102
            JQ(N,2) = ITQ
         ELSE
C IF FILLT=F & TEMP PREPBUFR TABLE VALUE =16 ALSO A CAT. 3 OR SPEC. LVL;
C  RESET TEMP PREPBUFR TBL VALUE TO -1 IF GOOD, OR TO 17 IF BAD SO THAT
C  IT IS USED TO CALC. PWATER (NOT USED ANYMORE TO CALC. PWATER)
            IF(JQ(N,2).EQ.16)  THEN
               IF(ITQ.LE.3)  THEN
                  JQ(N,2) = -1
               ELSE  IF(ITQ.EQ.12)  THEN
                  JQ(N,2) = -ITQ
               ELSE  IF(ITQ.GT.3.AND.ITQ.LE.15)  THEN
                  JQ(N,2) = 17
               END IF
            END IF
         END IF
         IZQLO = IZQ
C IF BOTTOM SPANNING PRESS. Q.M. BAD(15), SET NON-MSG IZQLO AS BAD(15)
         IF(JQ(NST,5).EQ.15)  IZQLO = MAX(15,IZQLO)
C IF IZQ=-1 OR -3 THIS LVL IS A GOOD QUAL. CAT. 2 Z W/ FILLZ=F, CHG TO 2
         IF(IZQLO.LE.-1)  IZQLO = 2
         TLO = TT
         VTLO = VTT
         ITQLO = ITQ
C IF BOTTOM SPANNING PRESS. Q.M. BAD(15), SET NON-MSG ITQLO AS BAD(15)
         IF(JQ(NST,5).EQ.15)  ITQLO = MAX(15,ITQLO)
      ENDDO
C-----------------------------------------------------------------------
      GO TO 29
   31 CONTINUE
  900 FORMAT(1X,10F10.2)
  905 FORMAT('+',102X,8I3)
  910 FORMAT('+',3F10.5)
  901 FORMAT ('0',//)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 1905, STNID,NUMVAR+1
 1905 FORMAT(/' WNDBYP: ',A8,', CAT. 1-3,5,S; HGT,T INTERP. TO MSG LVL',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (TMP(N,K),K=1,NUMVAR),VTMP(N)
            PRINT 905, (JQ(N,L),L=1,NUMQMS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    WNDBYZ
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2000-02-17
C
C ABSTRACT: MERGES CATEGORY 4 (WINDS-BY-HEIGHT) DATA LEVEL DATA INTO
C   UPPER-AIR REPORT PROFILE.  CHECKS FOR ADJACENT LEVEL HEIGHTS NO
C   MORE THAN 1 METER APART AND IF FOUND TRANSFERS HIGHEST QUALITY WIND
C   TO A CAT. 1,2,5,3, SPECIAL DATA LEVEL.  INTERPOLATES PRESSURE &
C   TEMP. TO CAT. 4 DATA LEVELS WHERE PRESSURE IS MISSING. FINALLY,
C   CHECKS FOR DUPLICATE PRESSURES AND IF FOUND TRANSFERS HIGHEST
C   QUALITY WIND TO A CAT. 1,2,5,3, SPECIAL DATA LEVEL.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1989-04-17  D. A. KEYSER -- DOCBLOCKING/COMMENTING, TESTS FOR SPEC.
C     LEVELS (UNIQUE CAT. NO. OF 6)
C 1989-12-13  D. A. KEYSER -- 'FILL' SWITCH NOW TESTED FOR INTERPOLATING
C     TO MISSING DATA LEVELS
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-10-25  D. A. KEYSER -- Q.M. FOR TEMP. INTERP. TO CAT. 4 LVL NOW
C     MIN. OF 3 (WAS 2) FOR PREPDA, THIS ENSURES THAT RPTED. TEMP. USED
C     WHEN CAT. 4 CALC. PRESS. COINCIDES W/ CAT. 1,2, OR 5 PRESS. WHICH
C     MAY HAVE TEMP. W/ Q.M. OF 2; CAT 4 HGHT Q.M. IS 9 IF EITHER
C     SPANNING P-LVL HGHT Q.M. IS 10, CAN'T LOCATE PROPER PRESS. FOR
C     CAT. 4 IN THIS CASE
C 1992-12-02  D. A. KEYSER -- U-AIR CAT. 4 CALC. PRESSURES SET TO
C     NEAREST INTEGER RATHER THAN TRUNCATED
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C     RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C     MARKERS; IN INTERNAL PROCESSING MISSING DATA GET PREPBUFR TABLE
C     VALUE OF 16 RATHER THAN 10; VERTICAL COORDINATE INDIC. ADDED TO
C     PREPBUFR TBL VALUE LIST FOR VARIABLES
C 1993-09-14  D. A. KEYSER -- SENSIBLE TEMPERATURE FOR PROFILE SAVED
C     IN STMP OR SDAT ARRAYS (IN CASE TVIRT=FALSE)
C 1993-12-21  D. A. KEYSER -- DUPL. LVLS NOW ENSURES THAT BEST TEMP IS
C     KEPT REGARDLESS OF HGHT TBL. VAL. & WILL NOT TRANSF. DWPT TO LVL
C     WHERE MSG UNLESS FILLM=T OR TEMP. HAS BEEN TRANSF.; HGHTS MUST
C     AGREE TO NEAREST 100'TH METER TO BE DUPL.; NO LONGER SET 2 LVLS
C     WITHIN 1 MB OF EACH OTHER TO SAME PRESSURE
C 1994-08-11  D. A. KEYSER --  ALL DUPL. PRESS. CHECKS NOW REQUIRE
C     PRESS. TO AGREE TO NEAREST 10'TH OF A MB TO BE A DUPL. (WAS TO
C     NEAREST WHOLE MB); CALC. CAT. 4 PRESS. NOW STORED TO NEAREST
C     10'TH OF A MB (WAS TO NEAREST WHOLE MB)
C 1995-07-12  D. A. KEYSER -- IF SPANNING LVL PRESS. Q.M. IS BAD ALL
C     INTEGR. DATA SET TO BAD Q.M.
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (DUPL. P/Z-LVL CHECKS MORE LIKE OLD "PREPDA" FORM; INTERP./CALC.
C     DATA CAN GET GOOD Q.M. IF SPANNING LVL DATA GOOD)
C 1997-05-01  D. A. KEYSER -- WILL NOW ALWAYS RESORT ALL REPORTS BY
C     PRESSURE TO ENSURE THAT ALL REPORTS IN THE PREPBUFR FILE WILL BE
C     ARRANGED IN DECREASING PRESSURE (ERRONEOUS REPORTS MAY CONTAIN
C     HEIGHTS THAT ARE OUT OF ORDER NOW); EST. REASON CODES FOR
C     UPPER-AIR DATA TYPES (CURRENTLY JUST 100, 101-103, 105 TO
C     IDENTIFY INTERPOLATED DATA FOR CQCBUFR PGM); CHGS IN LVL ON29
C     CATEGORY INDICATORS: SPEC. LVLS GET CAT=7 RATHER THAN 6, CAT=4
C     EXPLICITLY IDENTIFED IN ALL CASES
C 1998-02-17  D. A. KEYSER -- FOR SPCIAL=F, WILL GENERATE CAT. 4 PRESS
C     VIA U.S. STD. ATMOS. WHEN NO SPANNING LVLS W/ Z AVAIL.
C 1999-08-04  D. A. KEYSER -- REPLACED SORT ROUTINE "SHELL" (IN-LINE
C     SUBROUTINE) WITH W3LIB ROUTINE "ORDERS", MORE EFFICIENT AND
C     ALLOWS MULTIPLE ORDER SORT KEYS
C 2000-02-17  D. A. KEYSER -- CAT. 4 UPPER-AIR LEVELS NOW SET WIND Q.M.
C     TO AT LEAST 2 ONLY IF WIND DOES NOT HAVE AN SDM KEEP FLAG (I.E.,
C     THE KEEP FLAG ON CAT. 4 WINDS IS HONORED)
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. HP, XP, AND YP WERE
C     ADDED TO KEEP LOCATION AND TIME INFORMATION. IS WAS ADDED AS AN
C     ARRAY TO KEEP THE DATA.
C
C USAGE:    CALL WNDBYZ(NM,NS,NP,NH,KLVL,TMP,JQ,IPRT,VTMP)
C   INPUT ARGUMENT LIST:
C     NM       - NO. OF LEVELS IN CAT. 1 (MANDATORY MASS/WIND)
C     NS       - NO. OF LEVELS IN CAT. 2,5 (SIG. MASS & TROP)
C     NP       - NO. OF CAT. 3 & SPECIAL 25 OR 50 MB PRES. LVLS
C     NH       - NO. OF LEVELS IN CAT. 4 (WINDS-BY-HEIGHT)
C     KLVL     - NO. OF COMBINED  CAT. 1,2,3,5 AND SPECIAL 25/50 MB
C              - LEVELS WITH DUPLICATES REMOVED
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,5 AND SPECIAL 25/50 MB
C              - LEVELS AFTER MERGING
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S
C              - PREPBUFR TABLE VALUES IN CAT. 1,2,3,5 AND SPECIAL
C              - 25/50 MB LVLS AFTER MERGING
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C     VTMP     - "MXLVL" WORD ARRAY HOLDING AN U-AIR REPORT'S VIRTUAL
C              - TEMP DATA IN CAT. 1,2,3,5 AND SPECIAL 25/50 MB LEVELS
C              - AFTER MERGING
C
C   OUTPUT ARGUMENT LIST:
C     KLVL     - NO. OF COMBINED  CAT. 1,2,3,4,5 AND SPECIAL
C              - 25/50 MB LEVELS WITH DUPLICATES REMOVED
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,4,5 AND SPECIAL
C              - 25/50 MB LEVELS AFTER MERGING
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S
C              - PREPBUFR TABLE VALUES IN CAT. 1,2,3,4,5 AND SPECIAL
C              - 25/50 MB LEVELS AFTER MERGING
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'SMERGE'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE WNDBYZ(NM,NS,NP,NH,KLVL,TMP,JQ,IPRT,VTMP)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS=3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      PARAMETER (MAXOBS = 4500)
      DIMENSION  TMP(MXLVL,NUMDAT),KS(MXLVL),IQ(MXLVL,NUMQMS),
     $ JQ(MXLVL,NUMQMS),IDATA(MAXOBS),VTMP(MXLVL),VDAT(MXLVL),
     $ IR(MXLVL,NUMQMS),IWORK(MXLVL),TMPINV(NUMDAT,MXLVL)
C     $ ,IS(NXLVL,NUMGPS)
      LOGICAL  SPCIAL,FILLT,FILLM
      CHARACTER*8  STNID,SUBSET_d
      INTEGER  IPRT(2),IC(0:16)
      real(8)  alon_8,alat_8
      REAL     IS(MXLVL,NUMGPS)
      COMMON/WORD/LWI,LWR
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      EQUIVALENCE (DAT(1,NUMVAR+1),IQ),(RDATA,IDATA)
      EQUIVALENCE (DAT(1,NUMVAR+NUMQMS+1),IR)
      EQUIVALENCE (DAT(1,NUMVAR+NUMQMS+NUMQMS+1),IS)
C PREPBUFR TABLE VALUE INTERPRETED AS: 0 - KEEP, 1 - GOOD,
C  2- DEFAULT, 3 - SUSPECT, 9 - BAD  IN DUPL. LEVEL TBL VALUE COMPARISON
C  T.V.->      0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16
      DATA IC/ 0, 1, 2, 3, 9, 9, 9, 9, 9, 9,  9,  9,  9,  9,  9,  9, 16/
      DATA YMISS/99998.8/
C FCN PRS CALC. PRESS. FROM ALT. FOR Z > 11000M (U.S. STANDARD ATMOSPHERE)
      PRS(Z) = 226.3 * EXP(1.576106E-4 * (11000. - Z))
      SCALE  = 10.
      SCALE0 = 100.
      G = 9.8
      R = 287.05
C MH IS NO. OF CAT 1,2,5,3, & SPECIAL LEVELS (ARRANGED IN PROPER ORDER)
      MH = NM + NS + NP
      NN = KLVL
C TRANSFER BLOCK OF CAT. 4 LEVELS FROM DAT TO TMP
      DO N = 1,NH
         MM = MH + N
         NN = KLVL + N
         VTMP(NN) = DAT(MM,3)
         TMP(NN,1:NUMDAT) = DAT(MM,1:NUMDAT)
      ENDDO
C KLVL NOW IS TOTAL OF CAT. 1,2,3,5, SPECIAL & 4 LVLS, DUPL. POSS.
      KLVL = NN
      KS = 0
C ARRANGE LEVELS IN ORDER OF INCREASING HEIGHT (FIRST ORDER SORT KEY,
C  SECOND ORDER SORT KEY IS PRESSURE)
C .. MUST SWITCH ORDER OF ELEMENTS IN TMP ARRAY - CALL IT TMPINV
      DO  J=1,NUMDAT
         TMPINV(J,1:KLVL) = TMP(1:KLVL,J)
      END DO
      CALL ORDERS( 2,IWORK,TMPINV(1,1),KS,KLVL,NUMDAT,LWR,2)
      CALL ORDERS(12,IWORK,TMPINV(2,1),KS,KLVL,NUMDAT,LWR,2)
      N = 0
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)
     $ PRINT 903, STNID,NUMVAR+1
  903 FORMAT(/' WNDBYZ: ',A8,', CAT. 4 HGTS INSERTED, NEXT DUPL. Z CHK',
     $ ' - VIRT. TEMP IN COLUMN',I3)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C .. DAT ARRAY LIKE TMPINV ARRAY, BUT P-LVLS ARRANGED PROPERLY, ALSO
C    ORDER OF ELEMENTS SWITCHED BACK
      DO I = 1,KLVL
         L = KS(I)
         N = N + 1
         VDAT(N) = VTMP(L)
         DAT(N,1:NUMDAT) = TMPINV(1:NUMDAT,L)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
         IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
            PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
            PRINT 905, (IQ(N,J),J=1,NUMQMS)
         END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         IF(N.EQ.1)  CYCLE
C***********************************************************************
C CHECK ADJACENT LVLS: IF HGHTS ARE THE SAME TO NEAREST 100TH METER MAY
C RESULT IN TRANSFER OF WIND FROM CAT. 4 DATA LVL TO CAT. 1,2,5,3,SPEC
C                              DATA LVL
C***********************************************************************
         IZ = NINT(DAT(N,2)*SCALE0)
C NM IS LVL DIRECTLY BELOW N -- TRANSFER ALWAYS FROM N TO NM
         NM = N - 1
         JZ = NINT(DAT(NM,2)*SCALE0)
         IF(IZ.NE.JZ)  CYCLE
C DUPL. LVL CHECK SATISFIED; IN CASE ONE OF IQ(N,3)/IQ(NM,3) BELOW = 7
C FOR SPEC. LVLS, NEED TO TEST AS CAT. 3 (ORIG. SPEC. LVLS SET AS CAT 3)
C  (SAME TRUE FOR TROP LVLS SET TO CAT 5 BUT NEED TO BE TESTED AS CAT 2)
         IQN3 = MOD(IQ(N,3),20)
         IQNM3 = MOD(IQ(NM,3),20)
         IF(IQN3.EQ.5)  IQN3  = 2
         IF(IQN3.EQ.7)  IQN3  = 3
         IF(IQNM3.EQ.5) IQNM3 = 2
         IF(IQNM3.EQ.7) IQNM3 = 3
         IF(IQN3.LT.IQNM3)  THEN
C-----------------------------------------------------------------------
C   CASE WHERE CAT. 4 DATA LVL ON "NM", CAT 1,2,5,3, SPECIAL DATA LVL
C                                  ON "N"
C  (NOTE: THIS LOGIC IS CONVOLUTED -- SOMETIME NEEDS TO BE STREAMLINED)
C-----------------------------------------------------------------------
            IQN1  = IQ(N,1)
            IQNM1 = IQ(NM,1)
            IF(IQN1 .LE.-1.OR.IQN1 .EQ.17)  IQN1  = 16
            IF(IQNM1.LE.-1.OR.IQNM1.EQ.17)  IQNM1 = 16
            NFLAG = 0
            MFLAG = 0
            IF(IC(IQN1).LT.IC(IQNM1))  THEN
C HGHT PREPBUFR TBL VALUE FOR N BETTER THAN FOR NM (NEVER TRUE FOR SPEC.
C  LVL ON N, HGHT PREPBUFR TBL VAL=16) - TRANSFER PRESS., HGHT, CAT. NO.
C  & VERT. COORD. INDICATOR ON LEVEL N TO NM
C (NOTE: IF HGT PREPBUFR TBL VALUE ON N NOT BETTER, NEVER TRANSF. TEMP)
C IF WIND IS ORIGINALLY FROM CAT. 4 LEVEL ADD 20 TO CAT. NO.
               IF(DAT(N,5).GE.YMISS.OR.DAT(N,6).GE.YMISS)
     $          IQ(N,3) = MOD(IQ(N,3),20) + 20
               MFLAG = 1
               IQ(NM,1) = IQ(N,1)
               DAT(NM,1) = DAT(N,1)
               IR(NM,1) = IR(N,1)
               IQ(NM,3) = IQ(N,3)
               IQ(NM,5) = IQ(N,5)
               DAT(NM,2) = DAT(N,2)
               IR(NM,5) = IR(N,5)
            END IF
            IQN2  = IQ(N,2)
            IQNM2 = IQ(NM,2)
            IF(IQN2 .EQ.-1.OR.IQN2. EQ.17)  IQN2  = 16
            IF(IQNM2.EQ.-1.OR.IQNM2.EQ.17)  IQNM2 = 16
            IF(IQN2 .EQ.-12.OR.IQN2 .EQ.-14)  IQN2   = -IQN2
            IF(IQNM2.EQ.-12.OR.IQNM2.EQ.-14)  IQNM2  = -IQNM2
            IF(IC(IQN2).LT.IC(IQNM2))  THEN
C TEMP PREPBUFR TBL V. FOR N BETTER THAN FOR NM (NEVER TRUE FOR SPC. LVL
C  ON N, TEMP PREPBUFR TBL VAL. =16) TRANSFER TEMP ON LVL N TO LVL NM
C (TEMP CAN. BE TRANS. REGARDLESS OF HGHT PREPBUFR TABLE VALUE, ALSO MAY
C  TRANS. PRESS.,CAT. NO.,VERT. COORD. IND. IN THIS CASE)
               NFLAG = 1
               IQ(NM,2) = IQ(N,2)
               DAT(NM,3) = DAT(N,3)
               IR(NM,2) = IR(N,2)
               IR(NM,3) = IR(N,3)
               VDAT(NM) = VDAT(N)
               IF(MFLAG.EQ.0)  THEN
                  IQ(NM,3) = IQ(N,3)
                  IQ(NM,5) = IQ(N,5)
                  DAT(NM,1) = DAT(N,1)
                  IR(NM,5) = IR(N,5)
               END IF
            END IF
       IF(MOD(IQ(N,3),20).EQ.1.AND.IC(IQ(N,4)).LE.IC(IQ(NM,4)).AND.
     $        (MFLAG.EQ.1.OR.NFLAG.EQ.1))  THEN
C IF LVL N IS CAT. 1 & WIND PREPBUFR T.V. FOR N AT LEAST AS GOOD AS FOR
C  NM AND EITHER HGHT OR TEMP HAVE BEEN TRANS., TRANF. WIND ON LVL N TO
C  NM
C (NOTE: THIS MAY BE REDUNDANT TO LOGIC TESTING FOR TRANSF. OF CAT. NO.
C        1-3,5 TO LEVEL NM JUST AFTER THIS IF-THEN-ELSE BLOCK)
               IQ(NM,4) = IQ(N,4)
               DAT(NM,5) = DAT(N,5)
               DAT(NM,6) = DAT(N,6)
               IR(NM,4) = IR(N,4)
            END IF
C WILL ONLY TRANSFER DWPT ON LVL N TO LVL NM WHEN NM DWPT IS MISSING
C  AND EITHER FILLM IS TRUE OR ABOVE TRANSF. OF TEMP & CAT. # OCCURRED
            IF(DAT(NM,4).GE.9999..AND.(FILLM.OR.NFLAG.EQ.1))
     $       DAT(NM,4) = DAT(N,4)
         END IF
C-----------------------------------------------------------------------
C  CASE WHERE CAT. 4 DATA LVL OR CAT 1,2,5,3, SPEC. DATA LVL COULD BE
C                             EITHER WAY
C-----------------------------------------------------------------------
         IQN4  = IC(IQ(N,4))
         IQNM4 = IC(IQ(NM,4))
        IF(IQN4.LT.IQNM4.OR.(IQN4.EQ.IQNM4.AND.IQ(N,3).EQ.IQ(NM,3)))THEN
C WIND PREPBUFR TBL V. FOR N BETTER THAN FOR NM - OR - WIND PREPBUFR TBL
C  VAL. FOR N SAME AS FOR NM AND CAT. NO. 1-3,5 TRANSF. FROM N TO NM --
C  TRANSFER WIND ON LVL N TO LVL NM (NEVER TRUE FOR SPEC. LVLS WHEN ON
C  "N", WIND PREPBUFR TBL VALUE = 16; ALWAYS TRUE FOR SPEC. LVLS WHEN ON
C  "NM", WIND PREPBUFR TABLE VALUE = 16)
C IF WIND IS ORIGINALLY FROM CAT. 4 LEVEL ADD 20 TO CAT. NO.
            IF(MOD(IQ(N,3),20).EQ.4)  IQ(NM,3)=MOD(IQ(NM,3),20)+20
            IQ(NM,4) = IQ(N,4)
C LVL TRANS. FROM IS CAT.4 & LVL TRANS. TO HAS A MSG/BAD HGT, THEN LVL
C  TRANS. TO WIND PREPBUFR TBL VAL. IS SET TO AT LEAST 2
            IF(MOD(IQ(N,3),20).EQ.4.AND.IQ(NM,1).GT.3)
     $       IQ(NM,4) = MAX(2,IQ(NM,4))
            IR(NM,4) = IR(N,4)
            DAT(NM,5) = DAT(N,5)
            DAT(NM,6) = DAT(N,6)
         END IF
         N = N - 1
      ENDDO
      KLVL = N
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 901
         PRINT 904, STNID,NUMVAR+1
  904 FORMAT(/' WNDBYZ: ',A8,', DUPL. HGHTS REMOVED, GOOD DATA TRANSF.',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
            PRINT 905, (IQ(N,L),L=1,NUMQMS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
C    INTERP. PRESS. & IF APPROPRIATE TEMP TO LVLS WHERE PRESS. MSG
C       (NORMALLY MEANING INTERPOLATE TO THE CAT. 4 DATA LEVELS)
C***********************************************************************
      DO N = 1,KLVL
         NT = N
         IF(DAT(N,1).LT.3275.0)  GO TO 39
         IF(NPZ.EQ.0.AND.DAT(N,2).LT.32000)  THEN
C IF THIS REPORT HAS NO VALID HEIGHT LEVELS (E.G., ONLY CAT. 4 DATA AS
C  FOR PIBALS, NPN/CAP/JMA WIND PROFILERS, OR VAD WINDS; ONLY CAT. 3
C  AND 4 DATA AS FOR PIBALS OR WIND PROFILERS ORIGINALLY FROM PILOT
C  (PIBAL) FORMAT BULLETINS) THEN GET PRESSURE FROM HEIGHT VIA U.S.
C  STD. ATMOSPHERE
C  NOTE: DOES NOT APPLY WHEN SPCIAL = TRUE
            CALL W3FA04(DAT(N,2),DAT(N,1),TMPR,THETA)
C EVENT#116 -  PRESS CREATED FROM RPRTED HGHT VIA U.S. STD ATMOS. VALUE
            IR(N,5) = 116
         ELSE
C OTHERWISE, SET MISSING PRESSURE NOT BETWEEN SPANNING PRES-LVLS TO 0.0
            DAT(N,1) = 0.0
         END IF
      ENDDO
      GO TO 33
   39 CONTINUE
C NON-MISSING PRESSURE FOUND AT LVL=NT, THIS IS BOTTOM SPANNING PRESSURE
      PLO = DAT(NT,1)
      ZLO = DAT(NT,2)
      TLO = DAT(NT,3)
      VTLO = VDAT(NT)
      IPQLO = IQ(NT,5)
C FOR FILLZ & FILLT = F CASES OF CAT. 2, 3, & SPEC. LVLS; RESET Z & T
C  PREPBUFR TABLE VALUES
      IZQLO = IQ(NT,1)
      IF(IZQLO.LE.-1)  THEN
         IZQLO = 2
      ELSE  IF(IZQLO.EQ.17)  THEN
         IZQLO = 15
      END IF
      ITQLO = IQ(NT,2)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING ITQLO AS BAD(15)
      IF(IQ(NT,5).EQ.15)  ITQLO = MAX(15,ITQLO)
      IF(ITQLO.EQ.-1)  THEN
         ITQLO =  2
      ELSE  IF(ITQLO.EQ.17)  THEN
         ITQLO = 15
      ELSE  IF(ITQLO.EQ.-12.OR.ITQLO.EQ.-14)  THEN
         ITQLO = -ITQLO
      END IF
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 33
      LCNT = 0
      IF(DAT(NT,1).LT.3275.0)  GO TO 39
   41 CONTINUE
C MISSING PRESSURE FOUND W/ A VALID PRESSURE BELOW, LCNT COUNT THESE
      LCNT = LCNT + 1
      NT = NT + 1
      IF(NT.GT.KLVL)  THEN
         IF(.NOT.SPCIAL)  THEN
            NN = NT - LCNT - 1
            PPREF = DAT(NN,1)
C-----------------------------------------------------------------------
C      COME HERE IF ALL REMAINING LEVELS UP HAVE MISSING PRESSURE
C    GENERATE U.S. STANDARD ATMOSPHERE PRESSURE FROM REPORTED HEIGHT
C             NOTE: DOES NOT APPLY WHEN SPCIAL = TRUE
C-----------------------------------------------------------------------
            DO L = 1,LCNT
               NN = NN + 1
C NN IS NOW INDEX FOR NEXT MISSING PRESSURE LEVEL IN LCNT LOOP
               IF(DAT(NN,2).LT.32000) THEN
                  CALL W3FA04(DAT(NN,2),PP,TMPR,THETA)
               ELSE
                  PP = PRS(DAT(NN,2))
               END IF
C PERFORM A SANITY CHECK ON THE PRESSURE (MUST KEEP DECREASING W/ HGHT)
               IF(NINT(PP*10.).LT.NINT(PPREF*10.))  THEN
                  DAT(NN,1) = PP
                  PPREF = DAT(NN,1)
C EVENT#116 -  PRESS CREATED FROM RPRTED HGHT VIA U.S. STD ATMOS. VALUE
                  IR(NN,5) = 116
               END IF
            ENDDO
C-----------------------------------------------------------------------
         END IF
         GO TO 33
      END IF
      IF(DAT(NT,1).GE.3275.0)  GO TO 41
C NON-MISSING PRESSURE FOUND ABOVE MISSING PRESSURE (TOP SPANNING PRESS)
      PPHI = DAT(NT,1)
      ZHI = DAT(NT,2)
      THI = DAT(NT,3)
      VTHI = VDAT(NT)
      IPQHI = IQ(NT,5)
C FOR FILLZ & FILLT = F CASES OF CAT. 2, 3, & SPEC. LVLS; RESET Z & T
C  PREPBUFR TABLE VALUES
      IZQHI = IQ(NT,1)
      IF(IZQHI.LE.-1)  THEN
         IZQHI = 2
      ELSE  IF(IZQHI.EQ.17)  THEN
         IZQHI = 15
      END IF
      ITQHI = IQ(NT,2)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING ITQHI AS BAD(15)
      IF(IQ(NT,5).EQ.15)  ITQHI = MAX(15,ITQHI)
      IF(ITQHI.EQ.-1)  THEN
         ITQHI =  2
      ELSE  IF(ITQHI.EQ.17)  THEN
         ITQHI = 15
      ELSE  IF(ITQHI.EQ.-12.OR.ITQHI.EQ.-14)  THEN
         ITQHI = -ITQHI
      END IF
C CALC. THE LOG OF DELTA P FOR THE TWO VALID SPANNING PRESSURE LEVELS
      ALNPB = ALOG(PLO)
      ALNPT = ALOG(PPHI)
      DLNP = ALNPB - ALNPT
      IF(DLNP.NE.0.)  GO TO 7612
C-----------------------------------------------------------------------
C PROBLEM: SPANNING PRESSURES ARE THE SAME !!!
  898 CONTINUE
         NN = NT - LCNT - 1
         PRINT 899, STNID,RDATA(1),RDATA(2),IDATA(9),NN,NT
  899 FORMAT(' > > APPARENT DUPL. LEVELS-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BETWEEN',I4,' AND',I4/)
         DO N = NN,NT
C FOR FILLZ=F CASES OF CAT. 2, 3, & SPEC. LVLS MUST RESET HGHT PREPBUFR
C  TABLE VALUE
            IQHGHT = IQ(N,1)
            IF(IQHGHT.LE.-1)  THEN
               IQHGHT = 2
            ELSE  IF(IQHGHT.EQ.17)  THEN
               IQHGHT = 15
            END IF
            IF(NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
               PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
               PRINT 905, IQHGHT,(IQ(N,L),L=2,NUMQMS)
            END IF
            IF(N.EQ.NN.OR.N.EQ.NT)  THEN
C LEVELS WITH MISSING PRESSURE IN BETWEEN GET LINEAR AVG. OF PRESSURE,
C  HEIGHT, AND TEMPERATURE OF SPANNING LVLS
               DAT(N,1) = 0.5 * (DAT(NN,1) + DAT(NT,1))
               DAT(N,2) = 0.5 * (DAT(NN,2) + DAT(NT,2))
               DAT(N,3) = 0.5 * (DAT(NN,3) + DAT(NT,3))
               VDAT(N)  = 0.5 * (VDAT(NN)  + VDAT(NT))
               IQPRS1 = IQ(NN,5)
               IQPRS2 = IQ(NT,5)
               IQHGH1 = IQ(NN,1)
               IQHGH2 = IQ(NT,1)
               IF(IQHGH1.LE.-1)  THEN
                  IQHGH1 = 2
               ELSE  IF(IQHGH1.EQ.17)  THEN
                  IQHGH1 = 15
               END IF
               IF(IQHGH2.LE.-1)  THEN
                  IQHGH2 = 2
               ELSE  IF(IQHGH2.EQ.17)  THEN
                  IQHGH2 = 15
               END IF
               IQTMP1 = IQ(NN,2)
               IQTMP2 = IQ(NT,2)
               IF(IQTMP1.EQ.-1)  IQTMP1 =  2
               IF(IQTMP2.EQ.-1)  IQTMP2 =  2
               IF(IQTMP1.EQ.17)  IQTMP1 = 15
               IF(IQTMP2.EQ.17)  IQTMP2 = 15
               IF(IQTMP1.EQ.-12.OR.IQTMP1.EQ.-14)  IQTMP1 = -IQTMP1
               IF(IQTMP2.EQ.-12.OR.IQTMP2.EQ.-14)  IQTMP2 = -IQTMP2
               IQ(N,1) = MAX(IQHGH1,IQHGH2)
               IF(IQ(N,1).LT.16.AND.IQ(N,1).GT.3)  THEN
                  IQ(N,1) = 15
               ELSE  IF(IQ(N,1).LT.3)  THEN
                  IQ(N,1) =  2
               END IF
               IQ(N,2) = MAX(IQTMP1,IQTMP2)
               IF(IQ(N,2).LT.16.AND.IQ(N,2).GT.3)  THEN
                  IQ(N,2) = 15
               ELSE  IF(IQ(N,2).LT.3)  THEN
                  IQ(N,2) =  2
               END IF
               IF(IQPRS1.EQ.15.OR.IQPRS2.EQ.15)  THEN
                  IQ(N,1) =  MAX(15,IQ(N,1))
                  IQ(N,2) =  MAX(15,IQ(N,2))
               END IF

               DO K = 1,5
                  IF(K.EQ.4)  CYCLE
C EVENT#101 - HEIGHT CREATED FROM AVERAGING OF REPORTED DATA
C EVENT#101 - TEMPERATURE CREATED FROM AVERAGING OF REPORTED DATA
C EVENT#101 - MOISTURE CREATED FROM AVERAGING OF REPORTED DATA
C EVENT#101 - PRESSURE CREATED FROM AVERAGING OF REPORTED DATA
                  IR(N,K) = 101
               ENDDO

               IF(NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
                  PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
                  PRINT 905, (IQ(N,L),L=1,NUMQMS)
               END IF
            END IF
         ENDDO
         GO TO 39
 7612 CONTINUE
C-----------------------------------------------------------------------
      ALNP3 = 0.5 * (ALNPB + ALNPT)
      A = G * (ZHI - ZLO)/DLNP
      BB = R * (TLO - THI)/DLNP
      B = R * (VTLO - VTHI)/DLNP
C IF HGHT & TEMP OF SPANNING LVLS ARE SAME, TREAT LIKE DUPL SPAN. PRESS.
      IF(A.EQ.0.0.AND.B.EQ.0.0)  GO TO 898
      PHI3 = (G * 0.5 * (ZLO + ZHI)) + (0.125 * B * DLNP * DLNP)
      NN = NT - LCNT - 1
C-----------------------------------------------------------------------
C       LOOP THROUGH ALL IN BETWEEN LEVELS W/ MISSING PRESSURE
C-----------------------------------------------------------------------
      DO L = 1,LCNT
C NN NOW IN BETWEEN MSG-PRESS. LVL; NT STILL NEXT SPANNING P-LVL ABOVE
         NN = NN + 1
         ZZ = DAT(NN,2)
         RADICL = (A * A) - (2. * B * ((G * ZZ) - PHI3))
         DENOM = (A + SQRT(RADICL))
         IF(RADICL.GE.0.0.AND.DENOM.NE.0.0)  GO TO 7613
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C PROBLEM: RADICL.LT.0 OR DENOM.= 0 - CAN'T CALC. PRESS OR TEMP
            PRINT 951, STNID,RDATA(1),RDATA(2),IDATA(9),NN
  951 FORMAT(' > > CATEGORY 4 LVL TOSSED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESS, TEMP CANNOT BE CALC. ON ',
     $ 'LEVEL',I4)
            PRINT 106, RADICL,A,B,ZZ,DENOM
  106       FORMAT(5X,'RADICL = ',G12.5,'; A = ',G12.5,'; B = ',G12.5,
     $       '; HGHT(M) = ',F8.1,'; DENOM = ',G12.5)
  110       CONTINUE
      PRINT 107,PPHI,ZHI,VTHI,IZQHI,ITQHI,PLO,ZLO,VTLO,IZQLO,ITQLO
  107 FORMAT(10X,'UPPER SPANNING LEVEL: PRES =',F8.2,'; HGHT(M) =',F9.1,
     $ '; V. TEMP(K) = ',F6.2,'; HGHT T.V. = ',I2,'; TEMP T.V. = ',
     $ I2/10X,'LOWER SPANNING LEVEL: PRES = ',F7.2,'; HGHT(M) = ',F8.1,
     $ '; V. TEMP(K) = ',F6.2,'; HGHT T.V. = ',I2,'; TEMP T.V. = ',I2/)
C INTERP. NOT POSSIBLE, SO SET IN BETWEEN PRESS. TO 0 (SO LATER SKIPPED)
            DAT(NN,1) = 0.0
            CYCLE
 7613    CONTINUE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         ALNPS = ALNP3 - (2. * (G * ZZ - PHI3)/DENOM)
         IF(ALNPS.GT.ALNPB.OR.ALNPS.LT.ALNPT)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C PROBLEM: RESULT OUTSIDE RANGE OF TOP & BOTTOM SPANNING P-LVLS
            PRINT 951, STNID,RDATA(1),RDATA(2),IDATA(9),NN
            PRINT 109, ALNPS,ALNPB,ALNPT,ZZ
  109      FORMAT(5X,'ALNPS = ',G12.5,'; ALNPB = ',G12.5,'; ALNPT = ',
     $       G12.5,'; HGHT(M) = ',F8.1)
            GO TO 110
         END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C CALCULATE PRESSURE VALUE ON THE IN BETWEEN MSG-PRESS. LEVEL
         PP = EXP(ALNPS)
C CALCULATE TEMPERATURE VALUE ON THE IN BETWEEN MSG-PRESS. LEVEL
         TT = TLO - ((ALNPB-ALNPS) * BB/R)
         VTT = VTLO - ((ALNPB-ALNPS) * B/R)
C CALC. TEMP PREPBUFR T V (HIGHER OF 2 SPAN LVL TEMP PREPBUFR TBL VALS.)
         ITQ = MAX(ITQLO,ITQHI)
         IF(ITQ.LT.16.AND.ITQ.GT.3)  THEN
            ITQ = 15
         ELSE  IF(ITQ.LT.3)  THEN
            ITQ =  2
         END IF
C DETERMINE THE HIGHER OF THE 2 SPANNING LVL HEIGHT PREPBUFR TBL VALUES
         IZQ = MAX(IZQLO,IZQHI)
         IF(IZQ.LT.16.AND.IZQ.GT.3)  THEN
            IZQ = 15
         ELSE  IF(IZQ.LT.3)  THEN
            IZQ =  2
         END IF
C ASSIGN THE CALCULATED PRESSURE VALUE TO THE IN-BETWEEN LEVEL
         DAT(NN,1) = PP
C IF HGHT PREPBUFR TABLE VALUE FOR EITHER SPANNING LEVEL IS 16, SET
C  INTERP. PRESS. LVL HGHT PREPBUFR TBL V. TO 15 S.T. HGHT WON'T BE USED
C  (CAN'T BE CERTAIN THAT THE INTERP. PRESS. IS ACCURATE SINCE SPANNING
C  HGHTS ARE STD. ATMOS.-WON'T WORRY ABOUT WINDS SINCE P-LVL LESS CRIT.)
         IF(IZQ.EQ.16)  IQ(NN,1) = 15
C EVENT#103 -  PRESS CREATED FROM HYDROSTATIC INTEGRATION OF RPTED DATA
C  - OR IF NO VALID HEIGHT LEVELS IN THIS REPORT AND SPCIAL = FALSE -
C EVENT#116 -  PRESS CREATED FROM RPRTED HGHT VIA U.S. STD ATMOS. VALUE
         IR(NN,5) = 103
         IF(NPZ.EQ.0)  IR(NN,5) = 116
         IF(IPQLO.EQ.15.OR.IPQHI.EQ.15)  THEN
C IF EITHER SPANNING PRESS. BAD(15), THEN SET ALL NON-MISSING VARIABLES
C  ON LEVEL TO BAD(15)
            IQ(NN,1) = MAX(15,IQ(NN,1))
            IQ(NN,2) = MAX(15,IQ(NN,2))
            IQ(NN,4) = MAX(15,IQ(NN,4))
            IQ(NN,5) = 15
         END IF
C ASSIGN CALCULATED TEMP VALUE TO THE IN-BETWEEN LEVEL
         DAT(NN,3) = TT
         VDAT(NN) = VTT
         IF(FILLT)  THEN
C IF FILLT=T, ASSIGN TEMP PREPBUFR TBL VAL. TO IN-BETWEEN LVL (PREPBUFR
C  TABLE VALUE .GE. 2)
C INTERP. TEMP TO NON-CAT. 4 LVL (NEVER?) GETS MINIMUM PREPBUFR TABLE
C  VALUE 2, WHILE INTERP. TEMP TO CAT. 4 LVL (ALWAYS?) GETS MINIMUM
C  PREPBUFR TABLE VALUE 3
            IQ(NN,2) = MAX(2,ITQ)
            IF(MOD(IQ(NN,3),20).EQ.4)  IQ(NN,2) = MAX(3,ITQ)
C EVENT#103 -  TEMP CREATED FROM HYDROSTATIC INTEGRATION OF RPTED DATA
            IR(NN,2) = 103
         ELSE
C IF FILLT=F, TEMP PREPBUFR TBL VAL. =16 (CAT. 4 LVL); RESET TEMP
C  PREPBUFR TBL VAL. TO -1 IF GOOD OR TO 17 IF BAD SO IT IS USED TO
C  CALC. PWATER (NOT USED ANYMORE TO CALC. PWATER)
            IF(IQ(NN,2).EQ.16)  THEN
               IF(ITQ.LE.3)  THEN
                  IQ(NN,2) = -1
               ELSE  IF(ITQ.EQ.12)  THEN
                  IQ(NN,2) = -ITQ
               ELSE  IF(ITQ.GT.3.AND.ITQ.LE.15)  THEN
                  IQ(NN,2) = 17
               END IF
            END IF
         END IF
C WIND PREPBUFR TABLE VALUE .GE. 2 (HOWEVER AN SDM KEEP FLAG IS HONORED)
         IF(IQ(NN,4).GT.0)  IQ(NN,4) = MAX(2,IQ(NN,4))
      ENDDO
C-----------------------------------------------------------------------
      GO TO 39
   33 CONTINUE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR+1.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 1905, STNID,NUMVAR+1
 1905 FORMAT(/' WNDBYZ: ',A8,', AFTER INTERP. PRESS. TEMP TO MSG LVLS',
     $ ' - VIRT. TEMP IN COLUMN',I3)
         DO N = 1,KLVL
            PRINT 900, (DAT(N,K),K=1,NUMVAR),VDAT(N)
            PRINT 905, (IQ(N,L),L=1,NUMQMS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
C        CHECK FOR DUPLICATE PRESSURES ON ADJACENT LEVELS
C MAY RESULT IN TRANSFER OF WND FROM CAT. 4 DATA LVL TO CAT 1,2,5,3,
C                         SPEC. DATA LVL
C***********************************************************************
      IP = NINT(DAT(1,1)*SCALE)
      DO N = 2,KLVL
C NN IS LVL DIRECTLY BELOW N -- TRANSFER ALWAYS FROM N TO NN
         NN = N - 1
         JP = NINT(DAT(N,1)*SCALE)
         IF(IP.NE.JP)  GO TO 24
C IN CASE ONE OF IQ(N,3)/IQ(NN,3) BELOW SET TO 7 FOR SPECIAL LVLS, NEED
C  TO TEST IT AS A CAT. 3 (ORIGINALLY SPECIAL LEVELS WERE SET TO CAT. 3)
C  (SAME TRUE FOR TROP LVLS SET TO CAT 5 BUT NEED TO BE TESTED AS CAT 2)
         IQN3 = MOD(IQ(N,3),20)
         IQNN3 = MOD(IQ(NN,3),20)
         JQNN3 = IQ(NN,3)
         IF(IQN3.EQ.5)  IQN3 = 2
         IF(IQN3.EQ.7)  IQN3 = 3
         IF(IQNN3.EQ.5) IQNN3 = 2
         IF(IQNN3.EQ.7) IQNN3 = 3
         IF(IQN3.LT.IQNN3)  THEN
C-----------------------------------------------------------------------
C     CASE WHERE CAT. 4 DATA LVL ON "NN", CAT 1,2,5,3, SPECIAL DATA LVL
C                                ON "N"
C  (NOTE: THIS LOGIC IS CONVOLUTED -- SOMETIME NEEDS TO BE STREAMLINED)
C-----------------------------------------------------------------------
            IQN1  = IQ(N,1)
            IQNN1 = IQ(NN,1)
            IF(IQN1 .LE.-1.OR.IQN1 .EQ.17)  IQN1  = 16
            IF(IQNN1.LE.-1.OR.IQNN1.EQ.17)  IQNN1 = 16
            NFLAG = 0
            MFLAG = 0
            IF(IC(IQN1).LT.IC(IQNN1))  THEN
C HGHT PREPBUFR TBL VALUE FOR N BETTER THAN FOR NN (NEVER TRUE FOR SPEC.
C  LVL ON N, HGHT PREPBUFR TBL VAL=16) - TRANSFER PRESS., HGHT, CAT. NO.
C  & VERT. COORD. INDICATOR ON LEVEL N TO NN
C (IF HGT PREPBUFR TBL VAL. ON N NOT BETTER, NEVER TRANSF. TEMP)
C IF WIND IS ORIGINALLY FROM CAT. 4 LEVEL ADD 20 TO CAT. NO.
               IF(DAT(N,5).GE.YMISS.OR.DAT(N,6).GE.YMISS)
     $          IQ(N,3) = MOD(IQ(N,3),20) + 20
               MFLAG = 1
               IQ(NN,1) = IQ(N,1)
               DAT(NN,1) = DAT(N,1)
               IR(NN,1) = IR(N,1)
               IQ(NN,3) = IQ(N,3)
               IQ(NN,5) = IQ(N,5)
               DAT(NN,2) = DAT(N,2)
               IR(NN,5) = IR(N,5)
            END IF
            IQN2  = IQ(N,2)
            IQNN2 = IQ(NN,2)
            IF(IQN2 .EQ.-1.OR.IQN2. EQ.17)  IQN2  = 16
            IF(IQNN2.EQ.-1.OR.IQNN2.EQ.17)  IQNN2 = 16
            IF(IQN2 .EQ.-12.OR.IQN2 .EQ.-14)  IQN2  = -IQN2
            IF(IQNN2.EQ.-12.OR.IQNN2.EQ.-14)  IQNN2 = -IQNN2
            IF(IC(IQN2).LT.IC(IQNN2))  THEN
C TEMP PREPBUFR TBL VALUE FOR N BETTER THAN FOR NN (NEVER TRUE FOR SPEC.
C  LVL ON N, TEMP PREPBUFR TBL VAL=16) - TRANSFER TEMP ON LVL N TO NN  .
C  (TEMP CAN BE TRANS. REGARDLESS OF HGHT PREPBUFR TABLE VALUE, ALSO MAY
C  TRANSF. CAT. NO., VERT. COORD. IND AND PRESS. HERE)
               NFLAG = 1
               IQ(NN,2) = IQ(N,2)
               DAT(NN,3) = DAT(N,3)
               IR(NN,2) = IR(N,2)
               IR(NN,3) = IR(N,3)
               IF(MFLAG.EQ.0)  THEN
                  IQ(NN,3) = IQ(N,3)
                  IQ(NN,5) = IQ(N,5)
                  DAT(NN,1) = DAT(N,1)
                  IR(NN,5) = IR(N,5)
               END IF
            END IF
       IF(MOD(IQ(N,3),20).EQ.1.AND.IC(IQ(N,4)).LE.IC(IQ(NN,4)))  THEN
C IF LVL N IS CAT. 1 & WIND PREPBUFR T.V. FOR N AT LEAST AS GOOD AS FOR
C  NN -- TRANSFER WIND ON LVL N TO LVL NN
C (NOTE: THIS MAY BE REDUNDANT TO LOGIC TESTING FOR TRANSF. OF CAT. NO.
C        1-3,5 TO LEVEL NN JUST AFTER THIS IF-THEN-ELSE BLOCK)
               IQ(NN,4) = IQ(N,4)
               DAT(NN,5) = DAT(N,5)
               DAT(NN,6) = DAT(N,6)
               IR(NN,4) = IR(N,4)
            END IF
C WILL ONLY TRANSFER DWPT ON LVL N TO LVL NN WHEN NN DWPT IS MISSING
C  AND EITHER FILLM IS TRUE OR ABOVE TRANSF. OF TEMP & CAT. # OCCURRED
            IF(DAT(NN,4).GE.9999..AND.(FILLM.OR.NFLAG.EQ.1))
     $       DAT(NN,4) = DAT(N,4)
         END IF
C-----------------------------------------------------------------------
C CASE WHERE CAT. 4 DATA LVL OR CAT 1,2,5,3, SPECIAL DATA LVL COULD BE
C                              EITHER WAY
C-----------------------------------------------------------------------
         IQN4  = IC(IQ(N,4))
         IQNN4 = IC(IQ(NN,4))
        IF(IQN4.LT.IQNN4.OR.(IQN4.EQ.IQNN4.AND.IQ(N,3).EQ.IQ(NN,3)))THEN
C WIND PREPBUFR T VAL. FOR N BETTER THAN FOR NN - OR - WIND PREPBUFR TBL
C  VAL. FOR N SAME AS FOR NN AND CAT. NO. 1-3,5 TRANSF. FROM N TO NN --
C  TRANSFER WIND ON LVL N TO LVL NN (NEVER TRUE FOR SPEC. LVLS WHEN ON
C  "N", WIND PREPBUFR TBL VALUE = 16; ALWAYS TRUE FOR SPEC. LVLS WHEN ON
C  "NN", WIND PREPBUFR TABLE VALUE = 16)
C IF WIND IS ORIGINALLY FROM CAT. 4 LEVEL ADD 20 TO CAT. NO.
          IF(MOD(IQ(N,3),20).EQ.4)  IQ(NN,3)=MOD(IQ(NN,3),20)+20
            IQ(NN,4) = IQ(N,4)
            DAT(NN,5) = DAT(N,5)
            DAT(NN,6) = DAT(N,6)
            IR(NN,4) = IR(N,4)
            IF((IDATA(9).EQ.71.OR.IDATA(9).EQ.72).AND.MOD(IQ(N,3),20)
     $       .EQ.4.AND.MOD(IQ(NN,3),20).EQ.7)  THEN
C IF VAD WIND OR NOAA PROFILER NETWORK WIND WITH SPEC. LVL UNDER CAT. 4,
C  TRANSF. HGHT(& ITS T.V.) AND CAT. FROM LVL N TO LVL NN (PLACES
C  CORRECT P-ALT ON LVL)
               IQ(NN,1) = IQ(N,1)
               DAT(NN,2) = DAT(N,2)
               IR(NN,1) = IR(N,1)
               IQ(NN,3) = IQ(N,3)
            END IF
         ELSE  IF(IQN4.GT.IQNN4.AND.IQ(N,3).EQ.IQ(NN,3))  THEN
C WIND PREPBUFR TBL VAL. FOR N WORSE THAN FOR NN AND CAT. NO.1,5 TRANSF.
C  FROM N TO NN -- IF GOOD WIND WAS ORIGINALLY ON CAT. 4 LEVEL AND
C  TRANSFERRED CAT. NO. IS NOT 5 (AND DOES NOT HAVE AN EARLIER CAT. 5
C  DUPL.) ADD 20 TO CAT. NO. IF OUTPUT IS TO GSI
            IF(MOD(JQNN3,20).EQ.4.AND.MOD(IQ(NN,3),20).NE.5.AND.
     $       IQ(NN,3).LT.60)  THEN
               IQ(NN,3) = MOD(IQ(NN,3),20) + 20
            END IF
         END IF
C CULL THE DUPLICATE PRESSURE LEVEL
         DAT(N,1) = 0.0
   24    CONTINUE
         IP = JP
      ENDDO
C***********************************************************************
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 906, STNID
  906 FORMAT(/' WNDBYZ: ',A8,', DUPL. LVLS ZEROED OUT, DATA TRANSF.')
         DO N = 1,KLVL
            PRINT 900, (DAT(N,K),K=1,NUMVAR)
            PRINT 905, (IQ(N,L),L=1,NUMQMS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
C REMOVE DUPLICATE & MISSING PRESSURE LEVELS, AND FILL ARRAY TMP
      M = 0
C EARLIER, ALL CAT. 4 LVLS BELOW THE 1ST NON-MSG (ORIG.) PRESS. LVL WERE
C  SET TO MISSING
      DO N = 1,KLVL
         IF(DAT(N,1).LT.0.4.OR.DAT(N,1).GE.3275.)  CYCLE
         M = M + 1
         TMP(M,1:NUMDAT) = DAT(N,1:NUMDAT)
      ENDDO
C RESET KLVL TO NO. OF CAT 1,2,3,4,5,+ SPECIAL LEVELS (W/O DUPLICATES)
      KLVL = M
      KS = 0
C ARRANGE LEVELS IN ORDER OF DECREASING PRESSURE (FIRST ORDER SORT KEY,
C  SECOND ORDER SORT KEY IS HEIGHT)
C .. MUST SWITCH ORDER OF ELEMENTS IN TMP ARRAY - CALL IT TMPINV
      DO  J=1,NUMDAT
         TMPINV(J,1:KLVL) = TMP(1:KLVL,J)
      END DO
      CALL ORDERS( 2,IWORK,TMPINV(2,1),KS,KLVL,NUMDAT,LWR,2)
      CALL ORDERS(12,IWORK,TMPINV(1,1),KS,KLVL,NUMDAT,LWR,2)
C .. DAT ARRAY LIKE TMPINV ARRAY, BUT P-LVLS ARRANGED PROPERLY, ALSO
C    ORDER OF ELEMENTS SWITCHED BACK
      DO N = 1,KLVL
         L = KS(KLVL-N+1)
         DAT(N,1:NUMDAT) = TMPINV(1:NUMDAT,L)
      ENDDO
      TMP = DAT
  900 FORMAT(1X,10F10.2)
  905 FORMAT('+',102X,8I3)
  910 FORMAT('+',3F10.5)
  901 FORMAT('0',//)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 907, STNID
  907 FORMAT(/' WNDBYZ: ',A8,', DUPL. & MSG PRESSURE LEVELS REMOVED; ',
     $ 'RESORTED BY PRESSURE')
         DO N = 1,KLVL
            PRINT 900, (TMP(N,K),K=1,NUMVAR)
            PRINT 905, (JQ(N,L),L=1,NUMQMS)
            PRINT 910, (IS(N,M),M=1,NUMGPS)
         ENDDO
         PRINT 901
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C***********************************************************************
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    FILWND
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2000-02-17
C
C ABSTRACT: FILLS IN MISSING WIND INFORMATION IN THE RAOB PROFILE BY
C   INTERPOLATING BETWEEN BRACKETING LEVELS WITH QUALITY WIND DATA.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING; IF > 100 MB
C     BETWEEN BRACKETING P-LVLS SET WINDS MSG (WAS > 600 MB)
C 1989-04-24  D. A. KEYSER -- CHECKS 'FAILBL', IF TRUE WILL NOT USE
C     CAT. 4 WIND BELOW TOP SPANNNING PRESSURE FOR PSTN AS A BRACKETING
C     LVL FOR WIND
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1991-01-23  D. A. KEYSER -- SPLIT OLD SUBR. 'FILLIN' INTO SEPARATE
C     WIND AND DEWPOINT INTERPOLATING SUBROUTINES
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C     RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C     MARKERS
C 1995-07-12  D. A. KEYSER -- IF SPANNING LVL PRESS. Q.M. IS BAD INTERP.
C     WIND Q.M. SET TO BAD, IF INTERP. LVL PRESS. Q.M. IS BAD INTERP.
C     WIND Q.M. SET TO BAD
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (INTERP. DATA Q.M. CALC. SAME AS FOR OLD "PREPDA" FORM)
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C     TYPES (CURRENTLY JUST 100, 101-103, 105 TO IDENTIFY INTERPOLATED
C     DATA FOR CQCBUFR PGM)
C 2000-02-17  D. A. KEYSER -- NOW CALLED FOR RAOBS AND PIBALS EVEN
C     WHEN FILLW=F TO GET INTERP. WIND LEVELS FOR BALLOON DRIFT LAT/LON
C     CALC. (DISCARDS THEM PRIOR TO WRITE TO PREPBUFR FILE WHEN FILLW=
C     F), USES DEL-PRESSURE LIMIT OF 150 MB WHEN FILLW=F (VS. 100 MB
C     LIMIT WHEN FILLW=T) AND ALLOWS SPANNING WINDS TO BE BAD WHEN
C     FILLW=F (VS. RESTR. OF NON-BAD SPANNING WINDS WHEN FILLW=T)
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. 
C
C USAGE:    CALL FILWND(KLVL,TMP,JQ,JR,IPRT)
C   INPUT ARGUMENT LIST:
C     KLVL     - NO. OF COMBINED CAT. 1,2,3,4,5 AND "SPEC" 25/50 MB
C              - LEVELS WITH DUPLICATES REMOVED
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,4,5 AND "SPEC" 25/50 MB
C              - LEVELS AFTER MERGING
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S PREPBUFR
C              - TABLE VALUES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB
C              - LEVELS AFTER MERGING
C     JR       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S REASON
C              - CODES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB LEVELS
C              - AFTER MERGING
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C
C   OUTPUT ARGUMENT LIST:
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,4,5 AND "SPEC" 25/50 MB
C              - LEVELS AFTER MERGING AND WIND IS FILLED IN
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S PREPBUFR
C              - TABLE VALUES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB
C              - LEVELS AFTER MERGING AND WIND IS FILLED IN
C     JR       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S REASON
C              - CODES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB LEVELS
C              - AFTER MERGING AND WIND IS FILLED IN
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'SMERGE'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE FILWND(KLVL,TMP,JQ,JR,IPRT)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5,NUMGPS=3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      DIMENSION TMP(MXLVL,NUMDAT),JQ(MXLVL,NUMQMS),IPRT(2),
     $ JR(MXLVL,NUMQMS)
C     $ ,IS(MXLVL,NUMGPS)
      real(8)  alon_8,alat_8
      logical  fillw
      REAL     IS(MXLVL,NUMGPS)
      CHARACTER*8  STNID,SUBSET_d
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      DATA  XMISS/99999./,YMISS/99998.8/
C-----------------------------------------------------------------------
C INTERPOLATE BETWEEN BRACKETING LEVELS
C - IF FILLW=T, BRACKETING LEVEL MUST HAVE NON-BAD WIND
C - IF FILLW=F, BRACKETING LEVEL MUST HAVE NON-MISSING WIND (CAN BE BAD)
C-----------------------------------------------------------------------
C IQMLIM IS PREPBUFR TABLE VALUE LIMIT FOR ACCEPTING A BRACKETING LEVEL
      IQMLIM = 3
      DELPLM = 100.
      IF(.NOT.FILLW)  THEN
         IQMLIM = 15
         DELPLM = 150.
      END IF
      DO N = 1,KLVL
         NT = N
         IF(TMP(N,1).LT.XMISS.AND.JQ(N,4).LE.IQMLIM)  GO TO 46
cfix?    IF(TMP(N,1).LT.YMISS.AND.JQ(N,4).LE.IQMLIM)  GO TO 46
      ENDDO
      GO TO 48
   46 CONTINUE
      ULO = TMP(NT,5)
      VLO = TMP(NT,6)
      PLO = TMP(NT,1)
      QLO = JQ(NT,4)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING WIND Q.M. AS BAD(15)
      IF(JQ(NT,5).EQ.15)  QLO = MAX(15.,QLO)
      NST = NT
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 48
      LCNT = 0
      IF(JQ(NT,4).LE.IQMLIM)  GO TO 46
   49 CONTINUE
      LCNT = LCNT + 1
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 48
      IF(JQ(NT,4).GT.IQMLIM)  GO TO 49
      UHI = TMP(NT,5)
      VHI = TMP(NT,6)
      PPHI = TMP(NT,1)
      QHI = JQ(NT,4)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING WIND Q.M. AS BAD(15)
      IF(JQ(NT,5).EQ.15)  QHI = MAX(15.,QHI)
C IN RARE INSTANCES (E.G., WHEN CAT. 2 HGHTS GENERATED THROUGH DEEP
C  LAYERS W/O MAND-LVL HGHTS) THE SPANNING PRESSURES HERE COULD BE EQUAL
C  OR PLO COULD BE .LT. PPHI -- IN THIS CASE DON'T INTERP. (WINDS MSG)
      IF(PLO.LE.PPHI)  GO TO 46
      DLNP = ALOG(PPHI/PLO)
C LIMIT FOR DELTA-PRESSURE BETWEEN BRACKETING WIND LEVELS IS SET TO
C  100 MB FOR FILLW=T AND 150 MB FOR FILLW=F - IF THIS IS EXCEEDED, OR
C  IF DEL LN(P) .GT. 0.25 DON'T INTERPOLATE (ALL WINDS IN BETWEEN STAY
C  MISSING)
C  NOTE: I don't think DLNP can ever be > 0.25 as calc. here!!
      IF((PLO-PPHI).GE.DELPLM.OR.DLNP.GT.0.25)  GO TO 46
      DUDLNP = (UHI - ULO)/DLNP
      DVDLNP = (VHI - VLO)/DLNP
      DO L = 1,LCNT
         N = NST + L
         PLOG = ALOG(TMP(N,1)/PLO)
         UU = ULO + (DUDLNP * PLOG)
         VV = VLO + (DVDLNP * PLOG)
         TMP(N,5) = UU
         TMP(N,6) = VV
         IQQ = MAX(NINT(QLO),NINT(QHI))
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING IQQ AS BAD(15)
         IF(JQ(N,5).EQ.15)  IQQ = MAX(15,IQQ)
         IF(IQQ.LT.16.AND.IQQ.GT.3)  THEN
            IQQ = 15
         ELSE  IF(IQQ.LT.3)  THEN
            IQQ =  2
         END IF
C EVENT#102 - WIND CREATED FROM INTERPOLATION OF REPORTED DATA
         JR(N,4) = 102
         JQ(N,4) = IQQ
      ENDDO
      GO TO 46
   48 CONTINUE
      IF(.NOT.FILLW)  THEN
C FOR FILLW=F, RESET PREPBUFR TABLE VALUES FOR INTERPOLATED LEVELS AS
C  FOLLOWS: MISSING LEVELS GET 16 (NO CHANGE); BAD LEVELS GET 17;
C  KEEP LEVELS GET -1; NON-BAD LEVELS 1,2,3 GET -1,-2,-3, RESP.
C  (THIS WILL LATER BE USED TO EXCLUDE THESE LEVELS FROM PREPBUFR FILE)
         DO N = 1,KLVL
            IF(JR(N,4).EQ.102)  THEN
               IF(JQ(N,4).GT.15)  THEN
                  JQ(N,4) = 16
               ELSE IF(JQ(N,4).GT.3)  THEN
                  JQ(N,4) = 17
               ELSE IF(JQ(N,4).EQ.0)  THEN
                  JQ(N,4) = -1
               ELSE
                  JQ(N,4) = -JQ(N,4)
               END IF
            END IF
         END DO
      END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 903, STNID
  903 FORMAT(/' FILWND: ',A8,', LVLS W/ MISSING WINDS FILLED IN')
         DO N = 1,KLVL
            PRINT 900, (TMP(N,K),K=1,NUMVAR)
            PRINT 905, (JQ(N,L),L=1,NUMQMS)
            PRINT 910, (IS(N,M),M=1,NUMGPS)
         ENDDO
         PRINT 901
      END IF
  900 FORMAT(1X,10F10.2)
  905 FORMAT('+',102X,8I3)
  910 FORMAT('+',3F10.5)
  901 FORMAT('0',//)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    FILDPT
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 1997-05-01
C
C ABSTRACT: FILLS IN MISSING DEWPOINT INFORMATION IN THE RAOB PROFILE
C   BY INTERPOLATING BETWEEN BRACKETING LEVELS WITH GOOD QUALITY
C   DEWPOINT DATA.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING; IF > 100 MB
C     BETWEEN BRACKETING P-LVLS SET WINDS MSG (WAS > 600 MB)
C 1989-04-24  D. A. KEYSER -- CHECKS 'FAILBL', IF TRUE WILL NOT USE
C     CAT. 4 WIND BELOW TOP SPANNNING PRESSURE FOR PSTN AS A BRACKETING
C     LVL FOR WIND
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1991-01-23  D. A. KEYSER -- SPLIT OLD SUBR. 'FILLIN' INTO SEPARATE
C     WIND AND DEWPOINT INTERPOLATING SUBROUTINES
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C     RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C     MARKERS
C 1995-07-12  D. A. KEYSER -- IF SPANNING LVL PRESS. Q.M. IS BAD INTERP.
C     DWPT IS BAD AND IS STORED AS MISSING, IF INTERP. LVL PRESS. Q.M.
C     IS BAD INTERP. DWPT IS BAD AND IS STORED AS MISSING
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (INTERP. DATA Q.M. CALC. SAME AS FOR OLD "PREPDA" FORM)
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C     TYPES (CURRENTLY JUST 100, 101-103, 105 TO IDENTIFY INTERPOLATED
C     DATA FOR CQCBUFR PGM)
C
C USAGE:    CALL FILDPT(KLVL,TMP,JQ,JR,IPRT)
C   INPUT ARGUMENT LIST:
C     KLVL     - NO. OF COMBINED CAT. 1,2,3,4,5 AND "SPEC" 25/50 MB
C              - LEVELS WITH DUPLICATES REMOVED
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,4,5 AND "SPEC" 25/50 MB
C              - LEVELS AFTER MERGING
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S PREPBUFR
C              - TABLE VALUES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB
C              - LEVELS AFTER MERGING
C     JR       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S REASON
C              - CODES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB LEVELS
C              - AFTER MERGING
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C
C   OUTPUT ARGUMENT LIST:
C     TMP      - "MXLVL" X "NUMDAT" ARRAY HOLDING AN U-AIR REPORT'S
C              - MASS & WIND DATA IN CAT. 1,2,3,4,5 AND "SPEC" 25/50 MB
C              - LEVELS AFTER MERGING AND DEWPOINT IS FILLED IN
C     JQ       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S PREPBUFR
C              - TABLE VALUES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB
C              - LEVELS AFTER MERGING & DEWPOINT IS FILLED IN
C     JR       - "MXLVL" X "NUMQMS" ARRAY HOLDING AN U-AIR RPT'S REASON
C              - CODES IN CAT. 1,2,3,4,5 AND "SPECIAL" 25/50 MB LEVELS
C              - AFTER MERGING & DEWPOINT IS FILLED IN
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'SMERGE'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE FILDPT(KLVL,TMP,JQ,JR,IPRT)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      DIMENSION  TMP(MXLVL,NUMDAT),JQ(MXLVL,NUMQMS),IPRT(2),
     $ JR(MXLVL,NUMQMS)
      real(8)  alon_8,alat_8
      REAL      IS(MXLVL,NUMGPS)
      CHARACTER*8  STNID,SUBSET_d
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
C-----------------------------------------------------------------------
C   INTERPOLATE BETWEEN BRACKETING LEVELS TO FILL IN MISSING DEWPOINTS
C-----------------------------------------------------------------------
      DO N = 1,KLVL
         NT = N
         IF(TMP(N,4).LT.9999.)  GO TO 52
      ENDDO
      GO TO 99
   52 CONTINUE
      PLO = TMP(NT,1)
      DLO = TMP(NT,4)
C USE TEMPERATURE PREPBUFR TABLE VALUE
      QLO = JQ(NT,2)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING DWPT Q.M. AS BAD(15)
      IF(JQ(NT,5).EQ.15)  QLO = MAX(15.,QLO)
      NST = NT
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 99
      LCNT = 0
      IF(TMP(NT,4).LT.9999.)  GO TO 52
   54 CONTINUE
      LCNT = LCNT + 1
      NT = NT + 1
      IF(NT.GT.KLVL)  GO TO 99
      IF(TMP(NT,4).GT.9999.)  GO TO 54
      DHI = TMP(NT,4)
      PPHI = TMP(NT,1)
      QHI = JQ(NT,2)
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING DWPT Q.M. AS BAD(15)
      IF(JQ(NT,5).EQ.15)  QHI = MAX(15.,QHI)
C IN RARE INSTANCES (E.G., WHEN CAT. 2 HGHTS GENERATED THROUGH DEEP
C  LAYERS W/O MAND-LVL HGHTS) THE SPANNING PRESSURES HERE COULD BE EQUAL
C  OR PLO COULD BE .LT. PPHI -- IN THIS CASE DON'T INTERP. (DEWPT MSG)
      IF(PLO.LE.PPHI)  GO TO 52
      DLNP = ALOG(PPHI/PLO)
      DTDLNP = (DHI - DLO)/DLNP
      DO L = 1,LCNT
         N = NST + L
         PLOG = ALOG(TMP(N,1)/PLO)
         TD = DLO + (DTDLNP * PLOG)
         QQ = MAX(QLO,QHI)
         QQLIM = 3.5
C IF PRESSURE Q.M. IS BAD(15), THEN SET NON-MISSING QQ AS BAD(15)
         IF(JQ(N,5).EQ.15)  QQ = MAX(15.,QQ)
C ONLY STORE INTERP. TDD IF CALC. PREPBUFR TBL VAL. NON-BAD
         IF(QQ.LT.QQLIM)  THEN
            TMP(N,4) = TD
C EVENT#102 - MOISTURE CREATED FROM INTERPOLATION OF REPORTED DATA
            JR(N,3) = 102
         END IF
      ENDDO
      GO TO 52
   99 CONTINUE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C DETAILED PRINT FOR SPECIFIED REPORT(S) -- IF ENTERED IN DATA CARDS
      IF(IPRT(2).EQ.1.AND.NUMVAR.LT.11.AND.NUMQMS.LT.9)  THEN
         PRINT 904, STNID
  904 FORMAT(/' FILDPT: ',A8,', LVLS W/ MISSING DWPTS FILLED IN')
         DO N = 1,KLVL
            PRINT 900, (TMP(N,K),K=1,NUMVAR)
            PRINT 905, (JQ(N,L),L=1,NUMQMS)
            PRINT 910, (IS(N,M),M=1,NUMGPS)
         ENDDO
         PRINT 901
      END IF
  900 FORMAT(1X,10F10.2)
  905 FORMAT('+',102X,8I3)
  910 FORMAT('+',3F10.5)
  901 FORMAT('0',//)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    STOROB
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2008-09-25
C
C ABSTRACT: READS IN MERGED UPPER-AIR PROFILE VIA DAT IN COMMON BLOCK
C   AND WRITES IT TO SEPARATE MASS AND WIND 'REPORTS' (UP TO "MXLVL"
C   LEVELS)  IN MOBS.  CALLS SUBR. 'FILLX' TO ACTUALLY STORE 'REPORT'
C   INTO PREPBUFR MESSAGE.
C
C PROGRAM HISTORY LOG:
C 1987-06-14  D. A. KEYSER -- CORRECTED STORAGE LIMIT PROBLEM FOR
C     SPECIFIC HUMIDITY
C 1987-12-29  D. A. KEYSER -- ADDED SWITCH TO SKIP INDIAN MASS REPORTS
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1989-12-13  D. A. KEYSER -- PIBAL HGHTS STORED IN 1ST POSITION FOR A
C     WIND LEVEL (WAS ALWAYS MISSING); INDIAN TEST MOVED TO SUBR.
C     'GETUPA' AND PASSED HERE AS ARGUMENT
C 1990-01-11  D. A. KEYSER -- CONVRTED TO VS FORTRAN(77) & RESTRUCTURED
C 1992-06-10  D. A. KEYSER -- U-AIR PRESS. NOW ROUNDED RATHER THAN
C     TRUNCATED PRIOR TO BEING WRITTEN TO PREPDA FILE
C 1992-07-09  D. A. KEYSER -- RMVED. SUBPR. FCN "QFRMTP" & REPL. W/
C     IN-LINE FCN STMNT.; NOBS ARRAY NOT FILLED W/ VARIABLE IF .GT.
C     32767
C 1993-05-12  D. A. KEYSER -- SET-UP EXPANDED REPORT FORMAT, WORD 2 FOR
C     EACH MASS/WIND LVL IS PRESS. X 10MB, NEW WORD 5 FOR EACH LEVEL
C     CONTAINS 4 PACKED "PREPBUFR TBL VALUES" WHICH CAN RANGE FROM 0-15
C     AND CORRESPOND TO ON29 Q. MARKERS OR PREPRO-GENERATED Q. MARKERS
C     OR ON29 CAT. NO.; ALL NON-MISSING DATA ARE NOW PACKED INTO
C     PREPBUFR FILE REGARDLESS OF QUAL.; VERT. COORDINATE INDICATOR
C     ADDED TO PREPBUFR TABLE VALUE LIST FOR VARIABLES
C 1993-05-31  D. A. KEYSER -- CHECKS FOR TOVS RETR. (BUFR-INPUT) WHICH
C     ALREADY CONTAINS MOISTURE AS SPEC. HUMIDITY, CHKS QUAL.
C 1993-10-07  D. A. KEYSER -- MSG VALUE IN NOBS ARRAY IS 99999, ACTUAL
C     HEIGHT (NO D-VAL) STORED IN NOBS ARRAY
C 1993-11-02  D. A. KEYSER -- VARIABLE IFLUA WHEN SET TO 1 WILL FLAG
C     ALL VARIABLES WITH PREPBUFR T. VALUE=15 (VARIABLE INDIAN SET TO 1
C     ALSO FLAGS)
C 1993-12-21  D. A. KEYSER -- CAT. 4 WIND LVLS NOW HOLD P-ALT IN WORD 1
C     OF LVL INFO (NOBS) W/ TBL. VAL. IN POSITION 3 OF WORD 5 (BOTH
C     WERE MISSING)
C 1994-08-11  D. A. KEYSER -- VIRT. TEMP NOW CALC. HERE PRIOR TO WRITING
C     TO NOBS ARRAY; WORDS 6 AND 7 OF MASS LVL NOW CONTAIN SENS. TEMP
C     AND DWPT TEMP, RESP. WHILE WORDS 6 AND 7 OF WIND LEVEL CONTAIN
C     WIND DIR. AND SPEED, RESP., ALSO WORD 3 OF MASS LVL NOW CONTAINS
C     "REPORTED" TEMP
C 1995-07-12  D. A. KEYSER -- SPECIFIC HUMIDITY SET TO MISSNG IF
C     PRESSURE ON THE LEVEL HAS A BAD Q.M.
C 1995-08-24  D. A. KEYSER -- R.T. 132 DROPS SFC. DATA ALL FLAGGED FOR
C     NON-USE BY ANAL. (USED LATER AS R.T 182)
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (PIBAL TEST AND LAST "GOOD" DATA LEVEL TEST SAME AS FOR OLD
C     "PREPDA" FORM, PRESSURE ENCODED IN BUFR IS TO NEAREST WHOLE
C     MILLIBAR W/ ZERO IN TENTHS); REPORT SEQ. NUMBER STORED IN HDR(11)
C     FOR ALL "ADPUPA" REPORTS AND LATER ENCODED IN BUFR/PREPDA FILE
C 1997-05-01  D. A. KEYSER --  SUBR. 'STOROB' NO LONGER CALLED AND
C     REMOVED, SUBR. 'STORXX' RENAMED TO 'STOROB'; EST. REASON CODES
C     FOR UPPER-AIR DATA TYPES (CURRENTLY JUST 100, 101-103, 105 TO
C     IDENTIFY INTERPOLATED DATA FOR CQCBUFR PGM); CHGS IN LVL ON29
C     CATEGORY INDICATORS: TROP CAT=5 EXPLICITLY IDENTIFED IN ALL
C     CASES, SAME W/ CAT 2-4
C 1998-05-15  D. A. KEYSER -- FLAGGING OF TROP LVLS WITH WSPD=0 MOVED
C     FROM SUBR. GETUPA TO STOROB BECAUSE SOME CALM TROP WINDS WEREN'T
C     BEING IDENTIFIED
C 1999-08-04  D. A. KEYSER --  RADIOSONDE BALLOON DRIFT LAT/LON NOW
C     CALCULATED ON EACH LEVEL
C 2000-02-17  D. A. KEYSER -- EXPANDED BALLOON DRIFT PROCESSING TO
C     INCL. PIBALS; UPDATED DEL-TIME ON UPPER-AIR RAOB AND PIBAL LVLS
C     (ALREADY CALC. BASED ON BALLOON DRIFT) AND ENCODED INTO PREPBUFR
C     FILE W/ MNEMONIC "HRDR"; IMPR. CHECKING IN RAOB/PIBAL BALLOON
C     DRIFT LAT/LON/TIME CALC.; USES INTERPOL. WIND LEVELS FOR BALLOON
C     DRIFT LAT/LON CALC.
C 2000-12-05  D. A. KEYSER -- WIND PROFILERS WHICH COME IN DISGUISED AS
C     PIBALS ARE CHANGED TO R.T. 223 SO THEY WILL BE PROCESSED AS WIND
C     PROFILERS (DETERMINED BY STNID)
C 2001-04-06  D. A. KEYSER -- ADDED UK PROFILER ID 03501 TO LIST OF
C     PROFILERS WHICH MAY COME IN DISGUISED AS PIBALS PRIOR TO DECODER
C     CHANGE (GETS R.TYPE 223)
C 2001-09-14  D. A. KEYSER -- FINAL REPORT SEQ. NUMBER FOR RAOBS/
C     PIBALS/DROPS SAVED IN "ISQNUM_UPA" IN COMMON /UPALIM/ SO RECCOS
C     IN SUBR. GETC06 CAN STORE SEQ. NUMBER IN HDR(11), PICKING UP
C     WHERE THESE LEFT OFF
C 2003-08-22  D. A. KEYSER -- CORRECTED BUG WHICH STARTED CALCULATING
C     RADIOSONDE/PIBAL BALLOON DRIFT TIME FROM FIRST REPORTING HEIGHT
C     LEVEL RATHER THAN SURFACE LEVEL (STARTED AT 1000 MB MAND. LEVEL
C     BELOW GROUND), DRIFT LAT/LON VALUES WERE OKAY
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF NPN AND CAP RASS DATA
C     READ FROM "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R.
C     TYPE 77, GET PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE
C     UNDER NEW TBL A ENTRY "RASSDA"; NOW RETURNS 41-WORD (RATHER THAN
C     2-WORD) ARRAY "OBS2" OUT OF CALL TO IW3UNPBF, WHERE WORDS 3-41
C     CONTAIN ALTIMETER SETTING, SEA-SURFACE TEMPERATURE, SINGLE-LEVEL
C     SENSIBLE WEATHER ELEMENTS AND SST TABLE VALUE (Q.M.); RETURNS NEW
C     ARRAY ARGUMENTS "OBS3" {(5,MXBLVL,5)} AND "NOBS3" {(5)} OUT OF
C     CALL TO IW3UNPBF WHERE OBS3 CONTAINS MULTIPLE-LEVEL SENSIBLE
C     WEATHER ELEMENTS AND NOBS3 DEFINES THE NUMBER OF LEVELS OF DATA
C     IN THE OBS3(X,Y,1) TO OBS3(X,Y,5) ARRAYS (SEE IW3UNPBF DOCBLOCK
C     FOR MORE INFO); ALL NEW PARAMETERS (I.E., SST AND SENSIBLE
C     WEATHER ELEMENTS) IN OBS2 AND OBS3 ARE ENCODED INTO PREPBUFR
C     FILE, BUT ONLY IN THE MASS "PIECE" OF A REPORT (UNLESS THERE IS
C     NO MASS PIECE, THEN THEY ARE ENCODED INTO WIND PIECE); WILL NOW
C     CALC. Q AND Tv IF PQM IS 15 (BUTS SETS QQM TO 15) (E.G., FOR
C     DROPs WITH PRESS FAILING D-VAL, BEFORE Q MISSING BUT LATER CALC.
C     IN VIRTMP STEP)
C 2006-08-17  D. A. KEYSER -- MOVED BALLOON DRIFT PROCESSING OUT OF
C     THIS SUBR. (TWO PLACES - IN MASS AND WIND PROC.) INTO NEW SUBR.
C     BALLOON_DRIFT; NOW PRINTS WARNING AND SENDS DIAGNOSTIC TO JOBLOG
C     IF NUMBER OF PROCESSED MASS AND WIND LEVELS SENT TO SUBR. FILLX
C     ARE NOT THE SAME (SHOULD ALWAYS BE THE SAME!); WIND QM SET TO 15
C     IF A REPORTED WIND IS FOUND ON A LEVEL WHICH IS BELOW GROUND
C 2007-09-14  D. A. KEYSER -- CASES WHERE OBS ARE SET TO QM=15 IN ORDER
C     TO FLAG A REPORT FOR NON-USE BY ANALYSIS (EVEN THOUGH OBS MAY NOT
C     NECESSARILY BE BAD) NOW FIRST CHECK TO MAKE SURE OBS QM ISN'T
C     ALREADY "BAD" (> 3 AND < 15) (PREVENTS GSI FROM MONITORING TRULY
C     BAD OBS WHICH JUST HAPPEN TO BE IN REPORT GROUPS FLAGGED FOR NON-
C     USE BY ANALYSIS)
C 2008-09-25  D. A. KEYSER -- UPPER LIMIT FOR STORING Q CHANGED FROM
C     32767 MG/KG TO 99999 MG/KG TO ENSURE THAT LEVELS WITH VERY
C     HIGH SPECIFIC HUMIDITY ARE PROCESSED (THE 32767 LIMIT WAS A
C     VESTIGE FROM THE OLD I*2 PREPDA DAYS); IF NEAREST INTEGER FOR Q
C     IS 0 MG/KG, IT IS RESET TO 1 MG/KG (.001 G/KG) TO ENSURE THAT
C     LEVELS WITH VERY LOW SPECIFIC HUMIDITY ARE PROCESSED (Q MUST BE >
C     0 TO BE PROCESSED)
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITION OF GPS DATA TO UPRAIR
C     DUMP FILES, CHANGES WERE NEEDED. NUMGPS WAS ADDED AS A WAY TO SAVE
C     TIME AND LOCATION DISPLACEMENT DATA. MAXOBS WAS INCREASED TO 4500
C     DUE TO SEGFAULTS WHEN MAXOBS WAS SET TO 3500. HP, XP, AND YP WERE
C     ADDED TO KEEP LOCATION AND TIME INFORMATION. IS WAS ADDED AS AN
C     ARRAY TO KEEP THE DATA.
C
C USAGE:    CALL STOROB(NLEV,PSTA,INDIAN,IPRT,*)
C   INPUT ARGUMENT LIST:
C     NLEV     - NUMBER OF LEVELS IN REPORT AFTER MERGING
C     PSTA     - STATION PRESSURE (MB)
C     INDIAN   - INDICATOR FOR INDIAN RAOB FOR WHICH MASS RPT IS FLAGGED
C              -   (=1 IN THIS CASE, OTHERWISE = 0)
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINES 'GETUPA', 'SATBFR', AND 'GOESDG'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE STOROB(NLEV,PSTA,INDIAN,IPRT,*)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*8  ADPTYP,STNID,STNPRT,SUBSET_d
      LOGICAL  KTEMP,PROFILERinADPUPA
      INTEGER  IQ(MXLVL,NUMQMS),IDATA(MAXOBS),IR(MXLVL,NUMQMS),IPRT(2)
      REAL  PP(MXLVL),ZP(MXLVL),TP(MXLVL),DP(MXLVL),UP(MXLVL),VP(MXLVL),
     $ HP(MXLVL),XP(MXLVL),YP(MXLVL)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8,IS(MXLVL,NUMGPS)
      COMMON/STRCTY/ICAT(MXLVL)
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/PARM2/PG4243,KTEMP,i2many_lvls
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/LFMSFC/LFMAXI,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,MARLND,
     $ JSURFM(12),JSURFW(12),FWINDO(12),PFRALT,npkrpt(12)
      COMMON/PFSWCH/PRFLER(5),PWINDO(5),PROFILERinADPUPA
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE  (DAT,PP),(DAT(1,2),ZP),(DAT(1,3),TP),(DAT(1,4),DP),
     $ (DAT(1,5),UP),(DAT(1,6),VP),(DAT(1,NUMVAR+1),IQ),
     $ (DAT(1,17),HP),(DAT(1,18),YP),(DAT(1,19),XP),
     $ (IDATA,RDATA)
      DATA   XMISS/99999./,YMISS/99998.8/,IMISS/99999/
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+1),IR)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+NUMQMS+1),IS)
C FCNS BELOW CONVERT TEMP/TD (K) & PRESS (MB) INTO SAT./ SPEC. HUM.(G/G)
      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)))
      IF(IPRT(2).EQ.1)  THEN
         PRINT'(1X)'
         PRINT'(" ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")'
         PRINT'("       WELCOME TO STOROB FOR STN. ",A)', STNID
         PRINT'(" ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")'
         PRINT'(1X)'
      END IF
      LL_MASS=0
      LL_WIND=0
      IF(NFILE.EQ.IUNIT(5).OR.NFILE.EQ.IUNIT(5)+7)
     +  ISQNUM_UPA = ISQNUM_UPA + 1
      ADPTYP = '  RAOB  '
C 'ICALLM' INDICATES WHETHER MASS PIECE STORED IN OUTPUT FILE (IF SO =1)
      ICALLM = 0
C IQMLIM IS PREPBUFR TBL V. LIMIT FOR ACCEPTING REPORTS (HERE SET TO 16)
      IQMLIM = 16
      IZLAST = 00
      ITLAST = 00
      IWLAST = 00
      IZBEST = 99
      IWBEST = 99
      DO I = 1,NLEV
         IQ1 = IQ(I,1)
C FOR NON-SAT RETR: ADD 16 TO HEIGHT PREPBUFR TABLE VAL. SO IT WILL PASS
C  PIBAL/PROFLR/VADWND TST(ALSO TST CAT.3 IN CASE OF DUPL. LVL W/ CAT.4,
C  HGHT WOULD BE IN CAT. 3) - CALL IT IQ1, RETAIN ORIG. VALUE IN IQ(I,1)
C  NOTE: EVEN IF HGT PREPBUFR TBL VAL. SET TO 3, MUST STILL ADD 16 TO
C        PREPBUFR TBL VAL. TO PASS TEST (IQMLIM=16)
         IF((MOD(IQ(I,3),20).EQ.4.OR.MOD(IQ(I,3),20).EQ.3).AND.ISATOB
     $    .EQ.0)  IQ1 = IQ(I,1) + 16
C IZBEST IS BEST (LOWEST) HEIGHT PREPBUFR TABLE VALUE AMONGST ALL LEVELS
         IZBEST = MIN(IQ1,IZBEST)
C IF KTEMP = T, THEN ALSO EXAMINE TEMP PREPBUFR TABLE VALUE FOR IZBEST
         IF(KTEMP)  IZBEST = MIN(IQ(I,2),IZBEST)
C IWBEST IS BEST (LOWEST) WIND PREPBUFR TABLE VALUE AMONGST ALL LEVELS
         IWBEST = MIN(IQ(I,4),IWBEST)
C IZLAST HOLDS HIGHEST LVL NO. W/ HEIGHT PREPBUFR TBL VALUE .LT. IQMLIM
         IF(IQ(I,1).LT.IQMLIM)  IZLAST = I
C ITLAST HOLDS HIGHEST LVL NO. W/ TEMP PREPBUFR TABLE VALUE .LT. IQMLIM
C  (BUT ONLY IF KTEMP = TRUE)
         IF(IQ(I,2).LT.IQMLIM.AND.KTEMP) ITLAST = I
C IWLAST HOLDS HIGHEST LVL NO. W/ WIND PREPBUFR TABLE VALUE .LT. IQMLIM
         IF(IQ(I,4).LT.IQMLIM)  IWLAST = I
      ENDDO
      NLEV = MAX(IZLAST,ITLAST,IWLAST)
C CAT. 4 HEIGHTS GET PREPBUFR TBL VALUE 8(?); PIBAL, PROFILER AND VAD
C  WIND TEST IS FOR IZBEST .GE. 16
      IF(ISATOB.EQ.0.AND.IZBEST.GE.IQMLIM.AND.IDATA(15).EQ.0)  THEN
         ADPTYP = '  PIBAL '
         IF(IDATA(9).EQ.72)  THEN
            ADPTYP = 'VAD WIND'
         ELSE  IF(IDATA(9)/10.EQ.7)  THEN
            ADPTYP = 'PROFILER'
         END IF
      END IF
      IF(IDATA(9).EQ.13.AND.STNID(1:4).EQ.'CLAS')  THEN
         ADPTYP = '  CLASS '
C IF LSMASS = 9999, MASS PIECE FOR CLASS SOUNDING NOT PROCESSED
         IF(LSMASS.EQ.9999)  GO TO 1080
      ELSE  IF(IDATA(9).EQ.77)  THEN
         ADPTYP = '  RASS  '
      END IF
C PIBAL, PROFILER, VAD WIND TEST IS FOR IZBEST .GE. IQMLIM (16)
      IF(IZBEST.GE.IQMLIM)  GO TO 68
C***********************************************************************
C       PACK-UP MOBS FOR MASS PART OF REPORT AND SHIP OFF TO FILLX
C***********************************************************************
C INITIALIZE ALL LEVELS OF MOBS ARRAY
      MOBS = IMISS
C INITIALIZE ALL LEVELS OF ICAT ARRAY
      ICAT = IMISS
C FILL PSFC*10 IN 1ST LEVEL WITH TABLE VALUE SET TO 99 TO IDENTIFY THIS
C  AS A META-DATA LEVEL - EVERYTHING ELSE IS SET TO MISSING {EXPLICITLY
C  IDENTIFIES PSTN, REMAINING PSTN DATA (CAT. 2) STORED IN PROFILE}
      LL = 1
C PSTA ALWAYS .LT. XMISS ==> MAY WANT TO REMOVE IF TEST BELOW
cfix? C PSTA ALWAYS .LT. YMISS ==> MAY WANT TO REMOVE IF TEST BELOW
      IF(PSTA.LT.XMISS)  THEN
cfix? IF(PSTA.LT.YMISS)  THEN
         MOBS(1,1,1) = NINT(PSTA * 10.)
         MOBS(2,1,1) = 99
      END IF
C NOW STORE MERGED LEVELS INTO MOBS ARRAY
      DO I = 1,NLEV
         IF(ISATOB.EQ.3.OR.ISATOB.EQ.4)  THEN
C GOES SOUNDINGS OR RTOVS OR ATOVS 40-LEVEL SOUNDINGS
            IMQ = IQ(I,3) ! SPECIFIC HUMIDITY QUALITY MARKER
            JCAT  = IMISS  ! DATA LEVEL CATEGORY INDICATOR
         ELSE
            IMQ = IQ(I,2) ! SPEC. HUM. Q. MARKER SET TO TEMP. Q. MARKER
            JCAT= IQ(I,3) ! DATA LEVEL CATEGORY INDICATOR
         END IF
C CHECK FOR LEVELS W/ ABSOLUTELY NO VALID DATA -- DEPENDS ON IQMLIM AS
C  TO WHAT "BAD" DATA ARE; SUCH LEVELS ARE SKIPPED ENTIRELY
         IF(MIN(IQ(I,1),IQ(I,2),IQ(I,4),IMQ).GE.IQMLIM) CYCLE
C FLAG ANY VALID WINDS ON BELOW GROUND LEVELS (NEEDED HERE FOR BALLOON
C  DRIFT PROCESSING, WILL BE TESTED AGAIN IN WIND PIECE PROCESSING)
          ! this should not be monitored by GSI!! (but is since qm=15)
         IF(NINT(PP(I)*10.).GT.NINT(PSTA*10.).AND.MAX(UP(I),VP(I)).LT.
     $    XMISS) IQ(I,4) = 15
cfix?$    YMISS) IQ(I,4) = 15
         LL = LL + 1
         IMP = IQ(I,5) ! PRESSURE QUALITY MARKER
         IMZ = IQ(I,1) ! HEIGHT QUALITY MARKER
         IMT = IQ(I,2) ! TEMPERATURE QUALITY MARKER
         IF(JCAT.LT.IMISS)  THEN
C STORE THIS DATA LEVEL'S CATEGORY
            ICAT(LL) = MOD(JCAT,20)
C THE CAT. NO. HAS 60 ADDED TO IT TO INDICATE MASS DATA CAME FROM CAT. 5
            IF(JCAT.GT.60)  ICAT(LL) = 5
         END IF
         Q = XMISS
         P = PP(I)
         IP = NINT(P)
         IF(DP(I).LE.9999..AND.DP(I).GE.0.0)  THEN
            IF(ISATOB.EQ.4)  THEN
C 40-LVL RTOVS OR ATOVS RETR.: SPEC. HUMIDITY (G/G) STORED IN DP ARRAY;
C  ACCEPTABLE PREDPA TABLE VALUE FOR MOISTURE DEPENDS ON IQMLIM VALUE
               Q = DP(I)
               IF(IQ(I,3).GE.IQMLIM)  GO TO 8765
            ELSE
C ALL OTHER TYPES: MUST CALCULATE SPECIFIC HUMIDITY; ALSO, STORE
C  DEWPOINT TEMPERATURE OBS (*100 DEG. C) IN WORD 6 OF MOBS MASS LEVEL
cccc before cccIF(IQ(I,5).NE.15)  Q = QFRMTP(DP(I),P)
                 if(p.lt.XMISS)  q = qfrmtp(dp(i),p)
cfix?            if(p.lt.YMISS)  q = qfrmtp(dp(i),p)
                 if(iq(i,5).eq.15)  imq = 15
C GOES: ACCEPTABLE PREDPA T.V. FOR MOISTURE DEPENDS ON IQMLIM VALUE
               IF(ISATOB.EQ.3.AND.IQ(I,3).GE.IQMLIM)  GO TO 8765
               TMPCEL = (DP(I) - 273.16) * 100.
               IF(NINT(TMPCEL).LT.32767) MOBS(1,6,LL) = NINT(TMPCEL)
            END IF
            IF(Q.LT.XMISS)  THEN
cfix?       IF(Q.LT.YMISS)  THEN
               INTQ = NINT(Q * 1.E6)
               IF(INTQ.EQ.0)  INTQ = 1
C STORE SPECIFIC HUMIDITY OBS (*10**6 G/G) AND R.C. IN WORD 4 OF MOBS
C  MASS LEVEL; MUST BE < IMISS (99999) * 10**6 G/G AND > 0 - IF NOT SET
C  TO MISSING
               IF(INTQ.LT.IMISS.AND.INTQ.GT.0)  THEN
                  MOBS(1,4,LL) = INTQ
                  MOBS(3,4,LL) = IR(I,3)
               END IF
            END IF
         END IF
 8765    CONTINUE
C STORE PRESSURE OBS (*10 MB) AND R.C. IN WORD 1 OF MOBS MASS LEVEL
         MOBS(1,1,LL) = NINT(P * 10.)
         MOBS(3,1,LL) = IR(I,5)
C ACCEPTABLE PREDPA TABLE VALUE FOR HEIGHT DEPENDS ON IQMLIM VALUE
         IF(IQ(I,1).LT.IQMLIM)  THEN
C STORE GEOPOTENTIAL OBS (METERS) AND R.C. IN WORD 2 OF MOBS MASS LEVEL
            IF(NINT(ZP(I)).LT.IMISS)  THEN
               MOBS(1,2,LL) = NINT(ZP(I))
               MOBS(3,2,LL) = IR(I,1)
            END IF
         END IF
         IF(INDIAN.GT.0.OR.IFLUA.EQ.1)  THEN
            IF(IMP.LE.3.OR.IMP.GT.15) IMP = 15
            IF(IMZ.LE.3.OR.IMZ.GT.15) IMZ = 15
            IF(IMT.LE.3.OR.IMT.GT.15) IMT = 15
            IF(IMQ.LE.3.OR.IMQ.GT.15) IMQ = 15
         END IF
         IF(IDATA(9).EQ.31)  THEN
            IF(NINT(PSTA*10.).EQ.NINT(P*10.).AND.JSURFM(5).EQ.0)
     $       THEN
C IF DROPWINSONDE RPT: FLAG ALL DATA ON SFC LVL
C (THIS DATA LATER PROCESSED AS R.T. 182; SUBSEQ. OIQC PGM DOESN'T CHK
C SFC P FOR DROPS IN R.T. 132 BUT DOES FOR SPLASH-LVL RPTS IN R.T. 182 -
C EVEN IF GOOD DON'T WANT REDUNDANCY)
               IF(IMP.LE.3.OR.IMP.GT.15) IMP = 15
               IF(IMZ.LE.3.OR.IMZ.GT.15) IMZ = 15
               IF(IMT.LE.3.OR.IMT.GT.15) IMT = 15
               IF(IMQ.LE.3.OR.IMQ.GT.15) IMQ = 15
               PRINT 6415, STNID,RDATA(1),RDATA(2),IDATA(9)
 6415 FORMAT(' * * CAT2,SFC DATA FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PROCESSED LATER AS SPLASH-LEVEL ',
     $ 'REPORT')
            END IF
         END IF
C STORE P, Z, T, Q PREPBUFR TABLE VALUES IN WORDS 1-4 OF MOBS MASS LEVEL
         MOBS(2,1,LL) = IMP
         MOBS(2,2,LL) = IMZ
         MOBS(2,3,LL) = IMT
         MOBS(2,4,LL) = IMQ
C ACCEPTABLE PREPBUFR TBL VALUE FOR TEMPERATURE DEPENDS ON IQMLIM VALUE
         IF(IQ(I,2).LT.IQMLIM)  THEN
            TVIRT = XMISS
            TMPCEL = (TP(I) - 273.16) * 100.
            IF(NINT(TMPCEL).LT.32767)  THEN
C STORE "REPORTED" TEMP. OBS. (*100 DEG. C) AND R.C. IN WORD 3 OF MOBS
C  MASS LEVEL (FOR RTOVS OR ATOVS SATELLITE THIS IS VIRT., ELSE SENS.)
               MOBS(1,3,LL) = NINT(TMPCEL)
               MOBS(3,3,LL) = IR(I,2)
            END IF
            IF((ISATOB.EQ.0.AND.IDATA(9).NE.77).OR.ISATOB.EQ.3)  THEN
C ALL NON-SAT. TYPES (EXCEPT RASS) & GOES SNDG. CALC. VIRTUAL TEMP. IF
C  Q NON-MSG (IF Q MSG: V. TEMP MSG) ELSE IF Q MSG TP REMAINS SENS.
C  TEMP.)
               IF(Q.LT.XMISS)  THEN
cfix?          IF(Q.LT.YMISS)  THEN
                  TV = TP(I) * (1.0 + (0.61 * Q))
            IF(TV.GE.375..OR.(TV.GE.325.AND.PP(I).LT.100.))  THEN
C IF CALC. VIRT. TEMP >375 K ( >325 K ABOVE 100 MB) THEN: V. TEMP MSG)
                  ELSE
                     TVIRT = TV
                  END IF
               END IF
            ELSE
               TVIRT = TP(I)
            END IF
            IF(TVIRT.LT.XMISS)  THEN
cfix?       IF(TVIRT.LT.YMISS)  THEN
C STORE VIRTUAL TEMP. OBS. (*100 DEG. C) IN WORD 5 OF MOBS MASS LEVEL
               TMPCEL = (TVIRT - 273.16) * 100.
               IF(NINT(TMPCEL).LT.32767)  MOBS(1,5,LL) = NINT(TMPCEL)
            END IF
         END IF
         IF(HDR(6).EQ.120)  THEN
C.......................................................................
C              MASS REPORT BALLOON DRIFT PROCESSING
C (FILL INTO DFTLAT/DFTLON AND DFTTIM ARRAYS - LATER ENCODED INTO MASS
C         AND WIND PIECES FOR THIS REPORT IN PREPBUFR FILE)
C.......................................................................
            CALL BALLOON_DRIFT(IPRT,I,PSTA,LL)
         END IF
      ENDDO
      IF(LL.GT.0)  THEN
C SET REPORT SEQ. NUMBER TO "ISQNUM_UPA" AND STORE IN HDR(11) IF A
C  RADIOSONDE, PIBAL, DROPWINSONDE OR CLASS REPORT IN ADPUPA FILE
         IF(NFILE.EQ.IUNIT(5).OR.NFILE.EQ.IUNIT(5)+7)
     +     HDR(11) = ISQNUM_UPA
         CALL FILLX(LL,IERF)
         IF(IERF.EQ.0)  THEN
            ICALLM = 1
            LL_MASS = LL
         END IF
      END IF
   68 CONTINUE
      IF(INDIAN.GT.0.AND.IPRINT.EQ.0)  PRINT 71, STNID
   71 FORMAT(31X,'+ + + + +   INDIAN RAOB MASS REPORT FLAGGED, ID = ',
     $ A8,'  + + + + +')
C***********************************************************************
C       PACK-UP MOBS FOR WIND PART OF REPORT AND SHIP OFF TO FILLX
C***********************************************************************
      IF(ICALLM.EQ.1) THEN
C  DO NOT ENCODE OBS2 OR OBS3 VARIABLES WITH WIND REPORT UNLESS NO MASS
C   REPORT WAS GENERATED {EXCEPTIONS: OBS2(1-3) - RSRD, EXPRSRD, ALSE}
         OBS2(4:NUMOBS2) = BMISS
         OBS3 = BMISS
         NOBS3 = 0
      END IF
C Q.M. TESTS BELOW DEPENDENT ON IQMLIM VALUE
      IF(IZBEST.GE.IQMLIM.AND.IWBEST.LT.IQMLIM.AND.IPRINT.EQ.0)
     $ PRINT 87,ADPTYP,STNID,IQMLIM
   87 FORMAT(25X,'* * * * *   ',A8,' MASS REPORT TOSSED, ID = ',A8,
     $ ', IZBEST .GE. ',I2,'   * * * * *')
 1080 CONTINUE
      IF(IWBEST.GE.IQMLIM.OR.(IDATA(9).EQ.13.AND.STNID(1:4).EQ.'CLAS'
     $ .AND.LSWIND.EQ.9999))  THEN
C IF LSWIND = 9999, WIND PIECE FOR CLASS SOUNDING NOT PROCESSED
         IF((IZBEST.LT.IQMLIM).AND.ISATOB.EQ.0.AND.(LSWIND.EQ.0.OR.
     $    STNID(1:4).NE.'CLAS'.OR.IDATA(9).NE.13).AND.IPRINT.EQ.0)
     $    PRINT 88,ADPTYP,STNID,IQMLIM
   88    FORMAT(25X,'* * * * *   ',A8,' WIND REPORT TOSSED,',
     $    ' ID = ',A8,', IWBEST .GE. ',I2,'   * * * * *')
         IF(ICALLM.EQ.0)  THEN
C---------------------------------------------------------------------
C IN THIS CASE, NO MASS PIECE WAS CALC. -- SINCE NO WIND TOSS REPORT
            IF(IPRINT.EQ.0) PRINT 9954, STNID,RDATA(1),RDATA(2),IDATA(9)
 9954 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NO VALID DATA IN STOROB')
            KOUNT = KOUNT - 1
            RETURN 1
C---------------------------------------------------------------------
         ELSE
C SINCE NO WIND, ALL DONE, RETURN
            RETURN
C---------------------------------------------------------------------
         END IF
      END IF
C INITIALIZE ALL LEVELS OF MOBS ARRAY
      MOBS = IMISS
C INITIALIZE ALL LEVELS OF ICAT ARRAY
      ICAT = IMISS
C FILL PSFC*10 IN 1ST LEVEL WITH TABLE VALUE SET TO 99 TO IDENTIFY THIS
C  AS A META-DATA LEVEL - EVERYTHING ELSE IS SET TO MISSING {EXPLICITLY
C  IDENTIFIES PSTN, REMAINING PSTN DATA (CAT. 3) STORED IN PROFILE}
      LL = 1
C PSTA ALWAYS .LT. XMISS ==> MAY WANT TO REMOVE IF TEST BELOW
cfix? C PSTA ALWAYS .LT. YMISS ==> MAY WANT TO REMOVE IF TEST BELOW
      IF(PSTA.LT.XMISS)  THEN
cfix? IF(PSTA.LT.YMISS)  THEN
         MOBS(1,1,1) = NINT(PSTA * 10.)
         MOBS(2,1,1) = 99
      END IF
      HDR(6) = HDR(6) + 100
C IF PIBAL BUMP PREPBUFR REPORT TYPE BY 1 TO 221
      IF(IZBEST.GE.IQMLIM.AND.IDATA(15).EQ.0.AND.NINT(HDR(6)).EQ.220)
     $ THEN
         HDR(6) = 221
         IF(PROFILERinADPUPA)  THEN
C WIND PROFILERS ORIG. IN PILOT (PIBAL) FORMAT BULLETINS WERE DECODED
C  AS PIBALS INTO THE "ADPUPA" DUMP FILE PRIOR TO 05/14/2001.  IF THIS
C  IS A HISTORICAL RERUN, THESE NEED TO BE IDENTIFIED SO THAT THEY ARE
C  TREATED AS PROFILERS AND ASSIGNED RTYPE 223 (WILL BE WRITTEN TO
C  "PROFLR" BUFR MESSAGES & PROCESSED BY THE SUBSEQUENT PROGRAM
C  PREPOBS_PROFCQC)
               PRINT 6599, STNID,RDATA(1),RDATA(2),IDATA(9),RDATA(4)
 6599 FORMAT(' > > PIBAL ACTUALLY PROFLR-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,', TIME',F9.5,' - SET PREPBUFR R.TYPE ',
     $ 'TO 223')
            HDR(6) = 223
         END IF
      END IF
C NOW STORE MERGED LEVELS INTO MOBS ARRAY
      DO I = 1,NLEV
C CHECK FOR LVLS W/ ABSOLUTELY NO VALID DATA -- DEPENDS ON IQMLIM AS
C  TO WHAT "BAD" DATA ARE; SUCH LEVELS ARE SKIPPED ENTIRELY
         IF(MIN(IQ(I,1),IQ(I,2),IQ(I,4)).GE.IQMLIM)  CYCLE
C FLAG ANY VALID WINDS ON BELOW GROUND LEVELS
         IF(NINT(PP(I)*10.).GT.NINT(PSTA*10.).AND.MAX(UP(I),VP(I)).LT.
     $    XMISS) THEN
cfix?$    YMISS) THEN
            PRINT 9515,STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),PSTA
 9515 FORMAT(' * * WIND OBS LVL FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' BELOW GROUND - PRESS =',F6.1,' MB,',
     $ ' PSFC =',F6.1,' MB')
          ! this should not be monitored by GSI!! (but is since qm=15)
            IQ(I,4) = 15
         END IF
         LL = LL + 1
         IMP = IQ(I,5) ! PRESSURE QUALITY MARKER
         IMZ = IMISS
         IMW = IQ(I,4) ! WIND QUALITY MARKER
         JCAT= IQ(I,3) ! DATA LEVEL CATEGORY INDICATOR
C STORE THIS DATA LEVEL'S CATEGORY
         ICAT(LL) = JCAT
         IF(JCAT.GT.20)  THEN
            IF(JCAT.LT.40)  THEN
C THE CAT. NO. HAS 20 ADDED TO IT TO INDICATE WIND CAME FROM CATEGORY 4
C  (ALSO, GIVE PRESSURE A REASON CODE OF 103 OR 116)
               ICAT(LL) = 4
               IR(I,5) = 103
               IF(NPZ.EQ.0)  IR(I,5) = 116
            ELSE  IF(JCAT.LT.60)  THEN
C THE CAT. NO. HAS 40 ADDED TO IT TO INDICATE WIND CAME FROM CATEGORY 3
               ICAT(LL) = 3
            ELSE
C THE CAT. NO. HAS 60 ADDED TO IT TO INDICATE WIND CAME FROM CATEGORY 5
               ICAT(LL) = 5
            END IF
         END IF
         IF(ICAT(LL).EQ.5)  THEN
            IF(NINT(UP(I)*10.).EQ.0.AND.NINT(VP(I)*10.).EQ.0)  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
               IMW = 15
             PRINT 6515,STNID,RDATA(1),RDATA(2),IDATA(9),UP(I)+VP(I),IMW
 6515 FORMAT(' * * TROP LVL WIND FLAGGED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - SPEED =',F7.2,' M/SEC, Q.MARK SET ',
     $ 'TO ',I2)
            END IF
         END IF
         P = PP(I)
         IP = NINT(P)
C STORE PRESSURE OBS (*10 MB) AND R.C. IN WORD 1 OF MOBS WIND LEVEL
         MOBS(1,1,LL) = NINT(P * 10.)
         MOBS(3,1,LL) = IR(I,5)
         IF(ICAT(LL).EQ.4.AND.NINT(ZP(I)).LT.IMISS)  THEN
C CAT. 4 LVL: STORE PRESSURE-ALT OBS (METERS), PREPBUFR TABLE VALUE,
C  AND R.C. IN WORD 2 OF MOBS WIND LEVEL
            MOBS(1,2,LL) = NINT(ZP(I))
            IMZ = 2
            MOBS(3,2,LL) = IR(I,1)
         END IF
         IF(IFLUA.EQ.1)  THEN
            IF(IMP.LE.3.OR.IMP.GT.15) IMP = 15
            IF(IMZ.LE.3.OR.IMZ.GT.15) IMZ = 15
            IF(IMW.LE.3.OR.IMW.GT.15) IMW = 15
         END IF
C STORE P, Z, W PREPBUFR TABLE VALUES IN WORDS 1-4 OF MOBS WIND LEVEL
         MOBS(2,1,LL) = IMP
         MOBS(2,2,LL) = IMZ
         MOBS(2,3,LL) = IMW
         MOBS(2,4,LL) = IMW
         JU = NINT(UP(I) * 100.)
         JV = NINT(VP(I) * 100.)
C ACCEPTABLE PREPBUFR TABLE VALUE FOR WIND DEPENDS ON IQMLIM VALUE
         IF(IQ(I,4).LT.IQMLIM)  THEN
            IF(JU.LT.32767.AND.JV.LT.32767)  THEN
C STORE U-COMP OBS (*100 M/SEC) AND R.C. IN WORD 3 OF MOBS WIND LEVEL
               MOBS(1,3,LL) = JU
               MOBS(3,3,LL) = IR(I,4)
C STORE V-COMP OBS (*100 M/SEC) AND R.C. IN WORD 4 OF MOBS WIND LEVEL
               MOBS(1,4,LL) = JV
               MOBS(3,4,LL) = IR(I,4)
            END IF
            CALL CMDDFF(UP(I),VP(I),DD,FF)
            JDD = NINT(DD)
            JFF = NINT(FF)
            IF(MAX(JDD,JFF).LT.32767)  THEN
C STORE WIND DIRECTION (DEGREES) IN WORD 5 OF MOBS WIND LEVEL
C STORE WIND SPEED (KNOTS) IN WORD 6 OF MOBS WIND LEVEL
               MOBS(1,5,LL) = JDD
               MOBS(1,6,LL) = JFF
            END IF
         END IF
         IF(ICALLM.EQ.0)  THEN
            IF(HDR(6).EQ.220.OR.HDR(6).EQ.221)  THEN
C.......................................................................
C              WIND REPORT BALLOON DRIFT PROCESSING
C      -- ONLY IF MASS PIECE NOT PROCESSED FOR THIS REPORT --
C (FILL INTO DFTLAT/DFTLON AND DFTTIM ARRAYS - LATER ENCODED INTO WIND
C           WIND PIECE FOR THIS REPORT IN PREPBUFR FILE)
C (NOTE: DFTLAT/DFTLON AND DFTTIM ALREADY FILLED IF MASS PIECE WAS
C        PROCESSED SO DON'T HAVE TO REPEAT HERE FOR WIND PIECE)
C.......................................................................
               CALL BALLOON_DRIFT(IPRT,I,PSTA,LL)
            END IF
         END IF
      ENDDO
C FOLLOWING SHOULD NEVER BE SATISFIED (LL AT LEAST 1)!!!!!
      IF(LL.EQ.0)  THEN
         IF(ICALLM.EQ.0)  THEN
            PRINT 9955, STNID,RDATA(1),RDATA(2),IDATA(9)
 9955 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - REASON YET TO BE DETERMINED')
            RETURN 1
         ELSE
C MASS & WIND PIECES BOTH CALC., ALL DONE, RETURN
            RETURN
         END IF
      END IF
C SET REPORT SEQ. NUMBER TO "ISQNUM_UPA" AND STORE IN HDR(11) IF A
C  RADIOSONDE, PIBAL, DROPWINSONDE OR CLASS REPORT IN ADPUPA FILE
      IF(NFILE.EQ.IUNIT(5).OR.NFILE.EQ.IUNIT(5)+7) HDR(11) = ISQNUM_UPA
      CALL FILLX(LL,IERF)
      LL_WIND = LL
      IF(LL_WIND.NE.LL_MASS.AND.LL_MASS.GT.0)  THEN
         PRINT 9823, STNID,LL_MASS,LL_WIND
 9823 FORMAT(/10X,'-->  WARNING: ID ',A8,' HAS ',I4,' MASS LEVELS AND ',
     $ I4,' WIND LEVELS - THESE SHOULD BE THE SAME AT THIS POINT!!!'/)
         CALL SYSTEM('[ -n "$jlogfile" ] && $DATA/postmsg'//
     $    ' "$jlogfile" "***WARNING: ID='//STNID//' HAS DIFFERENT '//
     $    'NUMBER OF MASS AND WIND LEVELS AT POINT WHERE THEY SHOULD '//
     $    'BE THE SAME"')
      END IF
C***********************************************************************
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    BALLOON_DRIFT
C   PRGMMR: KEYSER           ORG: NP22        DATE: 2006-08-17
C
C ABSTRACT: CALCULATES RADIOSONDE AND PIBAL BALLOON DRIFT LATITUDE/
C   LONGITUDE AND TIME ON A REPORTED LEVEL AND FILLS INTO ARRAYS
C   DFTLAT, DFTLON AND DFTTIM, RESPECTIVELY.  ACCEPTS INTEGRATED HEIGHT
C   AND INTERPOLATED WIND AS LONG AS THEY ARE NON-BAD.  THESE DATA WILL
C   LATER BE ENCODED INTO PREPBUFR FILE ON EACH REPORT LEVEL. THIS
C   SUBROUTINE IS CALLED ONCE FOR EACH LEVEL IN REPORT.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 2006-08-17  D. A. KEYSER -- ORIGINAL AUTHOR
C 2023-01-31  N. ESPOSITO -- WITH THE ADDITON OF GPS DATA, WE NEEDED TO
C             NEW UPRAIR BUFR DUMPS HAVE GPS DATA IN THEM, ALLOWING US
C             TO USE THAT DATA INSTEAD OF CALCULATING DRIFT USING WIND
C             SPEEDS. GPSFLAG WAS ADDED TO DICTATE WHEN WE HAVE THE
C             DATA. GPSFLAG(1) IS SET TO 1 WHEN WE USE TIME DISPLACEMENT
C             DATA FROM THE GPS INSTEAD OF CALCULATING IT. GPSFLAG(2) IS
C             SET TO 1 WHEN WE USE LOCATION DISPLACEMENT DATA INSTEAD OF
C             CALCULATING IT USING THE WIND DIRECTION DATA. IF THE FLAGS
C             ARE KEPT AT 0, THEN WE CONTINUE CALCULATING THE WAY WE
C             USED TO.
C
C USAGE:    CALL BALLOON_DRIFT(IPRT,I,PSTA,LL)
C   INPUT ARGUMENT LIST:
C     IPRT     - 2-WORD SWITCH, DETAILED STD. O-PUT (UNIT 6) PRT OF RPT
C     I        - INDEX POINTING TO THE CURRENT REPORT LEVEL BEING
C              - READ IN SUBROUTINE STOROB (THE "DAT" ARRAY)
C     PSTA     - STATION PRESSURE (MB)
C     LL       - INDEX POINTING TO THE CURRENT REPORT LEVEL BEING
C              - GENERATED IN SUBROUTINE STOROB
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'STOROB'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE BALLOON_DRIFT(IPRT,I,PSTA,LL)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5, NUMGPS = 3)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS) + NUMGPS)
      PARAMETER (MAXOBS = 4500)
      CHARACTER*8 STNID,SUBSET_d
      INTEGER  IQ(MXLVL,NUMQMS),IDATA(MAXOBS),IPRT(2)
      REAL  PP(MXLVL),ZP(MXLVL),TP(MXLVL),DP(MXLVL),UP(MXLVL),VP(MXLVL),
     $ XP(MXLVL),YP(MXLVL),HP(MXLVL)
      real(8)  BMISS,GETBMISS,alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/DRIFT/DFTLON(MXLVL),DFTLAT(MXLVL),DFTTIM(MXLVL)
      COMMON/LAUNCH/ALNCH
      COMMON /BUFRLIB_MISSING/BMISS
      COMMON/SBDRIFT/ZDRIFT(MXLVL),TDRIFT(MXLVL),TDRIFTLL(MXLVL),
     $ UDRIFT(MXLVL),VDRIFT(MXLVL),XDRIFT(MXLVL),YDRIFT(MXLVL),
     $ TDRIFT_LL(MXLVL),KFLAG(5),LFLAG(3),GPSFLAG(2),PLO,IFLTIM,JJ,II
      EQUIVALENCE  (DAT,PP),(DAT(1,2),ZP),(DAT(1,3),TP),(DAT(1,4),DP),
     $ (DAT(1,5),UP),(DAT(1,6),VP),(DAT(1,NUMVAR+1),IQ),(DAT(1,17),HP),
     $ (DAT(1,18),YP),(DAT(1,19),XP),
     $ (IDATA,RDATA)
      DATA   XMISS/99999./,YMISS/99998.8/
      DATA   PI/3.141592654/
      DATA   ASCRT/5.0/      ! ASCENT RATE (IN M/SEC)
      DATA   CON/8.9929E-06/ ! 180.0/(PI*RADIUS OF EARTH) (RADIUS IN M

      BMISS=GETBMISS()

      IF(LL.EQ.2)  THEN
C COME HERE FOR FIRST LEVEL OF A NEW REPORT "PIECE" {LL = 1 IS A META-
C  DATA LEVEL IDENTIFYING SURFACE PRESSURE (HOLDS ONLY PSFC*10)}
         IF(IPRT(2).EQ.1)  THEN
            IF(HDR(6).EQ.120)   THEN
               PRINT'(1X)'
               PRINT'(" WILL PERFORM BALLOON DRIFT CALC. IN MASS ",
     $          "PIECE PROCESSING FOR STN. ",A)', STNID
            ELSE
               PRINT'(1X)'
               PRINT'(" WILL PERFORM BALLOON DRIFT CALC. IN WIND ",
     $          "PIECE PROCESSING FOR STN. ",A)', STNID
            END IF
         END IF
         DFTLON = XMISS
         DFTLAT = XMISS
         DFTTIM = XMISS
         ZDRIFT = XMISS
         UDRIFT = XMISS
         VDRIFT = XMISS
         XDRIFT = XMISS
         YDRIFT = XMISS
         TDRIFT = XMISS
         TDRIFT_LL = XMISS
         TDRIFTLL = XMISS
         PLO = PSTA
         KFLAG = 0
         LFLAG = 0
         GPSFLAG = 0
         IFLTIM = 0
         JJ = 0
         II = 0
      END IF

      IQ1 = IQ(I,1)
      IF(IQ(I,1).EQ.16)  IQ1 = 3
C FOR PIBALS, ACCEPT ALL NON-MISSING HEIGHTS (EVEN STD. ATMOSPHERE)
      IF(HDR(6).EQ.221)  IQ1 = 3
      IQ4 = IQ(I,4)
      IF(IQ(I,4).EQ.16)  IQ4 = 3


C-----------------------------------------------------------------------
C                  BALLOON DRIFT TIME CALCULATION
C-----------------------------------------------------------------------
      IF(IPRT(2).EQ.1)  THEN
         PRINT'(1X)'
         PRINT'(" - Level ", I0, "perform balloon drift TIME ",
     $    "calculation")', I
      END IF
cfix? IF((ZP(I).LT.YMISS.AND.IQ1.LT.4.AND.NINT(PSTA*10.).GE.
      IF((ZP(I).LT.XMISS.AND.IQ1.LT.4.AND.NINT(PSTA*10.).GE.
     $ NINT(PP(I)*10.)).AND.MAX(LFLAG(1),LFLAG(2),LFLAG(3)).EQ.0)  THEN
C .. BALLOON DRIFT TIME IS A FUNCTION OF MEASURED HEIGHT, IF HEIGHT IS
C     BELOW GROUND, HARDWIRE TO LAUNCH TIME; IF HEIGHT IS MISSING OR
C     BAD, OR IF ONE OR MORE BALLOON LAT/LON CALCULATION TESTS (BELOW)
C     HAVE FAILED ON SOME PREVIOUS LEVEL, SKIP DRIFT TIME CALC. AND
C     REVERT TO PREVIOUS LEVEL TIME VALUE
C     {NOTE: LEVELS ORIG. WITH MISSING HEIGHT ARE USED IF INTEGRATED
C            HEIGHT ON THAT LEVEL IS NON-BAD OR NON-MISSING (NON-
C            STANDARD ATMOSPHERE)}
         IF(IPRT(2).EQ.1) PRINT'(" Level ",I0," at press ",G0," has ",
     $    "valid height with non-bad q.m. and is above ground, also ",
     $    "no lat/lon calc. tests have failed on some prev. lvl, ",
     $    "proceed w/ drift time calc.")', I,PP(I)
         JJ = JJ + 1
         ZDRIFT(JJ) = ZP(I)
         IF(JJ.GT.1)  THEN
            IF((HP(I).LT.BMISS).AND.(HP(I).NE.XMISS)) THEN
C.   IF TIME DISPLACEMENT DATA WAS RETRIEVED, USE IT AND SET GPSFLAG(1)
C    TO 1 SO THAT COMPUTATION CHECKS AFTERWARD WILL BE IGNORED. IF TIME
C    DISPLACEMENT DATA WAS NOT RETRIEVED, KEEP GPSFLAG(1) AT 0, AND DO
C    ALL OF THE ORIGINAL, NORMAL CHECKS.
               TDRIFT(JJ)=HP(I)
               PRINT *, "TDRIFT FROM GPS: ", STNID, TDRIFT(JJ)
               GPSFLAG(1) = 1
            ELSE
               TDRIFT(JJ) = TDRIFT(JJ-1) +
     $          (ZDRIFT(JJ) - ZDRIFT(JJ-1))/ASCRT
               PRINT *, "TDRIFT FROM WIND: ", STNID,TDRIFT(JJ)
               GPSFLAG(1) = 0
            ENDIF
            IF((IFLTIM.EQ.1).AND.(GPSFLAG(1).EQ.0))  THEN
C .. ONE OR MORE BALLOON TIME CALCULATION TESTS HAVE FAILED ON SOME
C     PREVIOUS LEVEL - REVERT THIS LEVEL (AND LATER ALL ABOVE) TO
C     PREVIOUS LEVEL TIME VALUE
               IF(IPRT(2).EQ.1) PRINT'(" IFLTIM = 1 - revert back to ",
     $          "previous level drift time value")'
               JJ = JJ - 1
            ELSE  IF((TDRIFT(JJ)-TDRIFT(JJ-1).LT.0.0).AND.
     $       (GPSFLAG(1).EQ.0)) THEN
C .. NEGATIVE TIME DIFFERENCE BETWEEN LEVELS -
C     .. IF MAGNITUDE IS LESS THAN 5 SECONDS, ADD DIFFERENCE ON TO THIS
C        LEVEL AND CONTINUE DRFIT TIME CALCULATION
C     .. OTHERWISE, REVERT THIS LEVEL (AND LATER ALL ABOVE) TO PREVIOUS
C        LEVEL TIME VALUE
C        (NOTE: IN THIS LATTER CASE, BALLOON DRIFT LAT/LON REVERTS THIS
C               AND ALL LEVELS ABOVE TO PREVIOUS LEVEL LAT/LON VALUES
C               AS WELL)
               IF(ABS(TDRIFT(JJ)-TDRIFT(JJ-1)).LT.5.0)  THEN
                  PRINT 8495, STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),
     $             TDRIFT(JJ),TDRIFT(JJ-1)
 8495 FORMAT(' * * BALLOON DRFT TIME ODD-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - AT PRESSURE',F6.1,'MB, DRFT TIME ',
     $ '(=',F8.2,'SEC)'/6X,'< DRFT TIME ON LVL BELOW (=',F8.2,'SEC) -',
     $ ' TRANSFER DRFT TIME FROM LVL BELOW TO THIS LVL & CONTINUE ',
     $ 'PROC. DRFT LAT/LON/TIME')
               TDRIFT(JJ) = TDRIFT(JJ-1)
               ELSE
                  PRINT 8475, STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),
     $             TDRIFT(JJ),TDRIFT(JJ-1)
 8475 FORMAT(' * * BALLOON DRFT TIME BAD-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - AT PRESSURE',F6.1,'MB, DRIFT TIME'/
     $ 6X,'(=',F8.2,'SEC) < DRIFT TIME ON LEVEL BELOW (=',F8.2,'SEC) -',
     $ ' TRANSFER DRFT LAT/LON/TIME FROM LVL BELOW TO THIS LVL AND ALL',
     $ ' LVLS ABOVE')
                  JJ = JJ - 1
                  IFLTIM = 1
               END IF
            ELSE IF((ABS(TDRIFT(JJ)-TDRIFT(JJ-1)).GT.3600.).AND.
     $       (GPSFLAG(1).EQ.0)) THEN
C .. > 1-HOUR TIME DIFFERENCE BETWEEN LEVELS - REVERT THIS LEVEL (AND
C     LATER ALL ABOVE) TO PREVIOUS LEVEL TIME VALUE
C     (NOTE: BALLOON DRIFT LAT/LON REVERTS THIS AND ALL LEVELS ABOVE TO
C            PREVIOUS LEVEL LAT/LON VALUES AS WELL)
               PRINT 8476, STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),
     $          TDRIFT(JJ),TDRIFT(JJ-1)
 8476 FORMAT(' * * BALLOON DRFT TIME BAD-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - AT PRESSURE',F6.1,'MB, DRIFT TIME ',
     $ '(=',F8.2/6X,'SEC) > 1 HR DIFF. THAN DRFT TIME ON LEVEL BELOW ',
     $ '(=',F8.2,'SEC) - TRANSF. DRFT LAT/LON/TIME FROM LVL BELOW TO ',
     $ 'THIS LVL AND ALL LVLS ABOVE')
               JJ = JJ - 1
               IFLTIM = 1
            END IF
         ELSE
C .. IF THIS IS THE FIRST LEVEL IN THE PROFILE, RELATIVE BALLOON DRIFT
C     TIME IS SET TO ZERO
            TDRIFT(1) = 0.0
         END IF
         IF(ALNCH.LT.YMISS)  THEN
C .. ABSOLUTE BALLOON DRIFT TIME IS OBTAINED BY ADDING RELATIVE DRIFT
C     TIME TO BASELINE TIME (LAUNCH TIME) - ON FIRST VALID LEVEL OF
C     PROFILE THIS IS JUST THE LAUNCH TIME (ABSOLUTE BALLOON DRIFT TIME
C     LATER ENCODED INTO PREPBUFR FILE)
            DFTTIM(LL) = ALNCH + TDRIFT(JJ)/3600.
            TDRIFTLL(LL) = TDRIFT(JJ)
            IF(DFTTIM(LL).GE.24.) DFTTIM(LL) = DFTTIM(LL) - 24.
         END IF
         IF(IPRT(2).EQ.1)  PRINT'(" I,JJ,LL,PP(I),ZDRIFT(JJ),",
     $    "TDRIFT(JJ),TDRIFTLL(LL),DFTTIM(LL): ",3(I0,1X),5(G0,1X))',
     $    I,JJ,LL,PP(I),ZDRIFT(JJ),TDRIFT(JJ),TDRIFTLL(LL),DFTTIM(LL)
         ELSE
            IF(IPRT(2).EQ.1)  THEN
               IF(MAX(LFLAG(1),LFLAG(2),LFLAG(3)).EQ.1)  THEN
                  PRINT'(" one of the LFLAGs = 1 - revert back to ",
     $             "previous level drift time value")'
               ELSE
                  PRINT'(" Lvl ",I0," at ",G0,"mb either has missing ",
     $             "or bad hght or is < elev, set drft time to launch ",
     $             "time(1st lvl) or to drft time from prev lvl")', 
     $             I,PP(I)
            END IF
         END IF
         IF(LL.GT.2)  THEN
            DFTTIM(LL) = DFTTIM(LL-1)
            TDRIFTLL(LL) = TDRIFTLL(LL-1)
         ELSE
C .. IF THIS IS THE FIRST LEVEL IN THE PROFILE, BALLOON DRIFT TIME IS
C     SIMPLY SET TO REPORTED (OR GENERATED) LAUNCH TIME
            IF(ALNCH.LT.YMISS)  DFTTIM(LL) = ALNCH
            TDRIFTLL(LL) = 0
         END IF
         IF(IPRT(2).EQ.1)  PRINT'(" I,LL,PP(I),ZP(I),IQ1,PSTA,",
     $    "TDRIFTLL(LL),DFTTIM(LL): ",2(I0,1X),2(G0,1X),I0,1X,
     $    3(G0,1X))', I,LL,PP(I),ZP(I),IQ1,PSTA,TDRIFTLL(LL),DFTTIM(LL)
      END IF

C-----------------------------------------------------------------------
C                BALLOON DRIFT LAT/LON CALCULATION
C-----------------------------------------------------------------------
      IF(IPRT(2).EQ.1)  THEN
         PRINT'(1X)'
         PRINT'(" - Level ", I0,"- perform balloon drift LAT/LON ",
     $    "calculation")', I
      END IF
      IF(MAX(ZP(I),UP(I),VP(I)).LT.XMISS.AND.MAX(IQ1,IQ4).LT.4)  THEN
cfix? IF(MAX(ZP(I),UP(I),VP(I)).LT.YMISS.AND.MAX(IQ1,IQ4).LT.4)  THEN
C .. BALLOON DRIFT LAT/LON AND TIME IS A FUNCTION OF MEASURED HEIGHT
C     AND U/V WIND, IF ANY OF THESE ARE MISSING OR BAD, SKIP DRIFT CALC.
C     AND REVERT TO PREVIOUS LEVEL VALUES {NOTE: LEVELS ORIG. WITH
C     MISSING HEIGHT ARE USED IF INTEGRATED HEIGHT ON THAT LEVEL IS NON-
C     BAD OR NON-MISSING (NON-STANDARD ATMOSPHERE); LEVELS ORIG. WITH
C     MISSING WIND ARE USED IF INTERPOLATED WIND ON THAT LEVEL IS NON-
C     BAD}
         IF(IPRT(2).EQ.1) PRINT'(" Level ",I0," at press ",G0," has ",
     $    "valid height and wind with non-bad q.m. on each, proceed ",
     $    "w/ drift lat/lon calc.")' ,I,PP(I)
         II = II + 1
         IF(KFLAG(1).EQ.0)  THEN
            IF(PLO-PP(I).GE.150.)  THEN
C .. IF PRESSURE LAYER BETWEEN THIS VALID WIND LEVEL AND PREVIOUS VALID
C     WIND LEVEL BELOW > 150 MB, TRANFSER DRIFT LAT/LON FROM VALID LEVEL
C     BELOW TO THIS LEVEL AND ALL LEVELS ABOVE
C     (NOTE: DRIFT TIME IS STILL CALCULATED)
               PRINT 6425, STNID,RDATA(1),RDATA(2),IDATA(9),PLO
 6425 FORMAT(' * * VALID WND P-LYR>150MB-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,'-BALLOON DR. LAT/LON ON',F6.1,'MB ',
     $ 'TRANSF. TO LVLS ABOVE (DRIFT TIME IS CALCULATED)')
               KFLAG(1) = 1
            END IF
         END IF
         UDRIFT(II) = UP(I)
         VDRIFT(II) = VP(I)
         TDRIFT_LL(II) = TDRIFTLL(LL)
         IF(II.GT.1)  THEN
C.   IF LOCATION DISPLACEMENT DATA WAS RETRIEVED, USE IT AND SET 
C    GPSFLAG(2) TO 1 SO THAT COMPUTATION CHECKS AFTERWARD WILL BE
C    IGNORED. IF LOCATION DISPLACEMENT DATA WAS NOT RETRIEVED, KEEP
C    GPSFLAG(2) AT 0 AND DO ALL OF THE ORIGINAL CHECKS.
            IF ((XP(I).LT.BMISS).AND.(XP(I).NE.XMISS).AND.
     $    (YP(I).LT.BMISS).AND.(YP(I).NE.XMISS)) THEN
              XDRIFT(II) = RDATA(2)+XP(I)
              YDRIFT(II) = RDATA(1)+YP(I)
              GPSFLAG(2) = 1
              PRINT *,"X/Y DRIFT FROM GPS: ",STNID,XDRIFT(II),YDRIFT(II)
            ELSE
              XDRIFT(II) = XDRIFT(II-1) +
     $                    (0.5 * (UDRIFT(II-1) + UDRIFT(II)) *
     $                    (TDRIFT_LL(II) - TDRIFT_LL(II-1))
     $                    * CON/(COS(PI*YDRIFT(II-1)/180.)))
              YDRIFT(II) = YDRIFT(II-1) +
     $                    (0.5 * (VDRIFT(II-1) + VDRIFT(II)) *
     $                    (TDRIFT_LL(II) - TDRIFT_LL(II-1)) * CON)
              GPSFLAG(2) = 0
              PRINT *,"X/Y DRIFT FROM WIND: ",STNID,XDRIFT(II),
     $                     YDRIFT(II)
            END IF
            IF((IFLTIM.EQ.1).AND.(GPSFLAG(2).EQ.0))  THEN
C .. A PROBLEM IN THE BALLOON DRIFT TIME CALCULATION (ABOVE) MEANS THE
C     BALLOON DRIFT LAT/LON IS ALSO SUSPECT - REVERT THIS LEVEL (AND
C     LATER ALL ABOVE) TO PREVIOUS LEVEL LAT/LON VALUES
               IF(IPRT(2).EQ.1) PRINT'(" IFLTIM = 1 - revert back to ",
     $          "previous level drift lat/lon value")'
               II = II - 1
            ELSE  IF((MAX(KFLAG(1),KFLAG(2),KFLAG(3),KFLAG(4), KFLAG(5))
     $       .EQ.1).AND.(GPSFLAG(2).EQ.0))  THEN
C .. ONE OR MORE BALLOON LAT/LON CALCULATION TESTS HAVE FAILED ON THIS
C     OR SOME PREVIOUS LEVEL - REVERT THIS LEVEL (AND LATER ALL ABOVE)
C     TO PREVIOUS LEVEL LAT/LON VALUES
C     (NOTE: DRIFT TIME MAY STILL BE CALCULATED DEPENDING UPON TEST)
               IF(IPRT(2).EQ.1) PRINT'(" one of the KFLAGs = 1 - ",
     $          "revert back to previous level drift lat/lon value")'
               II = II - 1
            ELSE  IF((STNID.EQ.'89009   ').AND.(GPSFLAG(2).EQ.0))  THEN
C .. SOUTH POLE STATION, CAN'T CALC. BALLOON DRIFT LAT/LON - REVERT THIS
C     LEVEL (AND LATER ALL ABOVE) TO PREVIOUS LEVEL LAT/LON VALUES
C     (NOTE: DRIFT TIME IS STILL CALCULATED)
               PRINT 9425, STNID,RDATA(1),RDATA(2),IDATA(9)
 9425 FORMAT(' * * BALLOON LAT/LON DRFT -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NOT CALCULATED - REPORTED LAT/LON'/
     $ 10X,'USED ON ALL LEVELS - SOUTH POLE STATION (DRIFT TIME IS ',
     $ 'CALCULATED)')
               II = II - 1
               KFLAG(2) = 1
            ELSE  IF((ABS(XDRIFT(II)-XDRIFT(II-1)).GT.1.0).AND.(
     $             GPSFLAG(2).EQ.0)) THEN
C .. "UNREASONABLE" CALCULATED BALLOON DRIFT LON - REVERT THIS LEVEL
C     (AND LATER ALL ABOVE) TO PREVIOUS LEVEL LAT/LON VALUES
C     (NOTE: BALLOON DRIFT TIME REVERTS THIS AND ALL LEVELS ABOVE TO
C            PREVIOUS LEVEL TIME VALUES AS WELL)
               PRINT 8425, STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),
     $          XDRIFT(II),XDRIFT(II-1)
 8425 FORMAT(' * * BALLOON DRFT LON BAD -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - AT PRESSURE',F6.1,'MB, DRIFT LON ',
     $ '(=',F8.2,'E)'/6X,'> 1 DEG. DIFFERENT THAN DRIFT LON ON LEVEL ',
     $ 'BELOW (=',F7.2,'E) - TRANSFER DRIFT LAT/LON/TIME FROM LVL ',
     $ 'BELOW TO THIS LVL AND ALL LVLS ABOVE')
               II = II - 1
               KFLAG(3) = 1
               LFLAG(1) = 1
               IF(LL.GT.2)  THEN
                  DFTTIM(LL) = DFTTIM(LL-1)
                  TDRIFTLL(LL) = TDRIFTLL(LL-1)
               ELSE
                  IF(ALNCH.LT.YMISS)  DFTTIM(LL) = ALNCH
                  TDRIFTLL(LL) = 0
               END IF
               IF(IPRT(2).EQ.1) PRINT'(" updated DFTTIM(LL),",
     $          "TDRIFTLL(LL): ",G0,G0)',DFTTIM(LL),TDRIFTLL(LL)
            ELSE  IF(ABS(YDRIFT(II)-YDRIFT(II-1)).GT.1.0)  THEN
C .. "UNREASONABLE" CALCULATED BALLOON DRIFT LAT - REVERT THIS LEVEL
C     (AND LATER ALL ABOVE) TO PREVIOUS LEVEL LAT/LON VALUES
C     (NOTE: BALLOON DRIFT TIME REVERTS THIS AND ALL LEVELS ABOVE TO
C            PREVIOUS LEVEL TIME VALUES AS WELL)
               PRINT 8426, STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),
     $          YDRIFT(II),YDRIFT(II-1)
 8426 FORMAT(' * * BALLOON DRFT LAT BAD -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - AT PRESSURE',F6.1,'MB, DRIFT LAT ',
     $ '(=',F8.2,'N)'/6X,'> 1 DEG. DIFFERENT THAN DRIFT LAT ON LEVEL ',
     $ 'BELOW (=',F6.2,'N) - TRANSFER DRIFT LAT/LON/TIME FROM LVL ',
     $ 'BELOW TO THIS LVL AND ALL LVLS ABOVE')
               II = II - 1
               KFLAG(4) = 1
               LFLAG(2) = 1
               IF(LL.GT.2)  THEN
                  DFTTIM(LL) = DFTTIM(LL-1)
                  TDRIFTLL(LL) = TDRIFTLL(LL-1)
               ELSE
                  IF(ALNCH.LT.YMISS)  DFTTIM(LL) = ALNCH
                  TDRIFTLL(LL) = 0
               END IF
               IF(IPRT(2).EQ.1) PRINT'(" updated DFTTIM(LL),",
     $          "TDRIFTLL(LL): ",G0,G0)', DFTTIM(LL),TDRIFTLL(LL)
            ELSE  IF(ABS(YDRIFT(II)).GT.90.0)  THEN
C .. CALCULATED BALLOON DRIFT ABS(LAT) IS > 90 DEG. - REVERT THIS LEVEL
C     (AND LATER ALL ABOVE) TO PREVIOUS LEVEL LAT/LON VALUES
C     (NOTE: BALLOON DRIFT TIME REVERTS THIS AND ALL LEVELS ABOVE TO
C            PREVIOUS LEVEL TIME VALUES AS WELL)
               PRINT 8427, STNID,RDATA(1),RDATA(2),IDATA(9),PP(I),
     $          YDRIFT(II)
 8427 FORMAT(' * * BALLOON DRFT LAT BAD -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - AT PRESSURE',F6.1,'MB, DRIFT LAT ',
     $ '(=',F8.2,'N)'/6X,'FAILS GROSS CHECK - TRANSFER DRIFT LAT/LON/',
     $ 'TIME FROM LVL BELOW TO THIS LVL AND ALL LVLS ABOVE')
               II = II - 1
               KFLAG(5) = 1
               LFLAG(3) = 1
               IF(LL.GT.2)  THEN
                  DFTTIM(LL) = DFTTIM(LL-1)
                  TDRIFTLL(LL) = TDRIFTLL(LL-1)
               ELSE
                  IF(ALNCH.LT.YMISS)  DFTTIM(LL) = ALNCH
                  TDRIFTLL(LL) = 0
               END IF
               IF(IPRT(2).EQ.1) PRINT'(" updated DFTTIM(LL),",
     $          "TDRIFTLL(LL): ",G0,G0)', DFTTIM(LL),TDRIFTLL(LL)
            ELSE
C .. FOR NEWLY CALCULATED BALLOON DRIFT LAT/LON, ACCOUNT FOR BALLOON
C     CROSSING GREENWICH
               XDRIFT(II) = MOD(XDRIFT(II)+360.0,360.0)
               IF(NINT(XDRIFT(II)*100.).GT.35999)  XDRIFT(II) = 0.
               PLO = PP(I)
            END IF
         ELSE
C .. IF THIS IS THE FIRST LEVEL IN THE PROFILE, BALLOON DRIFT LAT/LON
C     IS SET TO REPORTED LAT/LON
            XDRIFT(1) = alon_8
            YDRIFT(1) = alat_8
         END IF
C .. STORE BALLOON DRIFT LAT/LON ON THIS LEVEL (LATER ENCODED INTO
C     PREPBUFR FILE)
         DFTLON(LL) = XDRIFT(II)
         DFTLAT(LL) = YDRIFT(II)
         IF(IPRT(2).EQ.1)  THEN
            PRINT'(" I,LL,II,PP(I),UDRIFT(II),VDRIFT(II),",
     $       "TDRIFT_LL(II),DFTLON(LL),DFTLAT(LL): ",3(I0,1X),
     $       6(G0,1X))', I,LL,II,PP(I),UDRIFT(II),VDRIFT(II),
     $       TDRIFT_LL(II),DFTLON(LL),DFTLAT(LL)
         END IF
      ELSE
         IF(IPRT(2).EQ.1) PRINT'(" Lvl ",I0," at ",G0,"mb either ",
     $    "has missing or bad hght or wind, set drft lat/lon to rpt ",
     $    "lat/lon (1st lvl) or to drft lat/lon from prev lvl")',
     $    I,PP(I)
         IF(LL.GT.2)  THEN
            DFTLON(LL) = DFTLON(LL-1)
            DFTLAT(LL) = DFTLAT(LL-1)
         ELSE
C .. IF THIS IS THE FIRST LEVEL IN THE PROFILE, BALLOON DRIFT LAT/LON
C     IS SET TO REPORTED LAT/LON
            DFTLON(LL) = alon_8
            DFTLAT(LL) = alat_8
         END IF
         IF(IPRT(2).EQ.1) PRINT'(" I,LL,PP(I),ZP(I),UP(I),VP(I),IQ1,IQ4,
     $    DFTLON(LL),DFTLAT(LL): ",2(I0,1X),4(G0,1X),2(I0,1X),
     $    2(G0,1X))',
     $    I,LL,PP(I),ZP(I),UP(I),VP(I),IQ1,IQ4,DFTLON(LL),DFTLAT(LL)
      END IF

      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    FILLX
C   PRGMMR: Keyser           ORG: NP22        DATE: 2016-11-30
C
C ABSTRACT: SENDS EACH FILLED REPORT PASSED IN THROUGH "HDR/MOBS/
C   IPMSL/PWAT/xRAD/REQV/CLTOP" ARRAYS TO PREPBUFR ENCODER
C   (SUBROUTINE W3FIZZ), AND ACCUMULATES COUNTS BY PREPBUFR REPORT
C   TYPE.  THIS SUBROUTINE ALSO CAN PRINT SOME FILLED DATA REPORTS IN
C   THE "HDR/MOBS/IPMSL/PWAT/xRAD/REQV/CLTOP" ARRAYS TO STANDARD
C   OUTPUT (BASED ON THE VALUE OF 'MODPRT').
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1987-03-10  D. A. KEYSER -- OLD SUBR. 'FILLX' AND 'FILLXX' COMBINED
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77)
C 1991-01-03  D. A. KEYSER -- NO LONGER NEED TO WRITE OUT 72-RECORDS FOR
C    AVN PREPDA FILE, REMOVED FROM CODE
C 1992-07-09  D. A. KEYSER -- INCR. MAX. NO. BYTES WRITTEN TO PREPDA
C    FILE FROM 5200K TO 10000K W/ STOP 89 (& LOG MSG.) IF EXCEEDED;
C    INCR. MAX. NO. RECORDS WRITTEN TO PREPDA FILE FROM 172 TO 272 W/
C    STOP 79 (& LOG MSG.) IF EXCEEDED
C 1992-08-07  D. A. KEYSER -- STOP 69 ADDED FOR OVERFLOW PACKING
C    FULL-WORD ARRAY TO 16-BIT ARRAY (& LOG MSG.)
C 1992-09-08  D. A. KEYSER -- ADDED CALL TO W3AI39 TO CONVERT STN. ID
C     FROM ASCII TO EBCDIC ON CRAY PRIOR TO WRITE TO PREPDA FILE;
C     STATION ID PACKED INTO 16-BIT WORDS 3-5
C 1993-05-31  D. A. KEYSER -- CHANGED DEF. VALUES & ORDER FOR NAMELIST
C     SWITCH "IUNIT"
C 1993-07-28  D. A. KEYSER -- OPTION TO PASS FILLED REPORTS THROUGH
C     INTERFACE TO ENCODE IN BUFR/PREPDA FILE ADDED, BUT INTERFACE NOT
C     YET READY
C 1993-10-07  D. A. KEYSER -- STREAMLINED W3FIZZ W/ MORE VARIABLES
C     PASSED THRU COMMON
C 1995-07-12  D. A. KEYSER -- ADDED OUTPUT ARG. 'IERF' (RETURN CODE -
C     SEE BELOW)
C 1996-09-03  D. A. KEYSER -- PROCESSING OF TOVS RADIANCES PARTIALLY
C     DONE (SWITCH "TOVRAD")
C 1996-10-24  D. A. KEYSER -- ADDED STD. OUTPUT (UNIT 6) PRINT OF TOVS
C     REPORT RADIANCES/OTHER INFO. BASED ON "MODPRT"
C 1997-05-01  D. A. KEYSER -- STDOUT EXPANDED TO INCL. REASON CODES
C 1999-08-04  D. A. KEYSER -- ADDED PRINT FOR NEW VARIABLES POAF AND
C     DGOT FOR ALL AIRCRAFT TYPES
C 2000-02-17  D. A. KEYSER -- ADDED PRINT FOR NEW VARIABLE RFFL FOR
C     NESDIS (GOES) SATWND TYPES
C 2000-09-22  D. A. KEYSER -- ADDED THE PRINTING OF QUIKSCAT SCATTER-
C     OMETER WINDS
C 2001-04-06  D. A. KEYSER -- NOW PROCESSES SSM/I RAIN RATE UNDER R.TYP
C     150; ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES PWATER AS AS MM
C     (PRECISE TO 10**2) RATHER THAN MM*100;  ACCOUNTS FOR SUBR.
C     IW3UNPBF OUTPUTTING SSM/I TPW IN MM (PRECISE TO 10**1) RATHER
C     THAN MM*10; PRINTS MDCRS TURB. INDEX; PRINTS GOES SFC PRESS.
C     FOR PW REPORTS
C 2001-06-19  D. A. KEYSER -- CAN NOW LIST GOES 1x1 FOV CLOUD TOP
C     REPORTS UNDER R.T. 151
C 2001-01-28  D. A. KEYSER -- ADDED PRINT FOR NEW VARIABLE "PCAT" FOR
C     ALL AIRCRAFT TYPES
C 2003-07-10  D. A. KEYSER -- ADDED PRINT OF FLAG TBL VALUE FOR
C     "RESTRICTIONS ON REDISTRIBUTION" FOR ALL SINGLE-LEVEL REPORTS
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF MESONET DATA, READ
C     FROM "MSONET" DUMP FILE DUMP R. TYPE 540, GET PREPBUFR R. TYPE
C     188/288, PROCESSED INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "MSONET"; ADDED PROCESSING OF GPS-IPW DATA, READ FROM "GPSIPW"
C     DUMP FILE DUMP R. TYPE 74, GET PREPBUFR R. TYPE 153, PROCESSED
C     BY NEW SUBR. "GETGPSIPW" INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "GPSIPW"; NOW PRINTS "*" (FORMAT OVERFLOW) FOR MISSING QUALITY
C     MARKS (BEFORE SET THEM TO "15"); PRINTS MDCRS FLIGHT NUMBER;
C     PRINTS MESONET PROVIDER AND SUB-PROVIDER ID STRINGS;  RAIN RATE
C     (SSM/I) IS NOW ENCODED WITH STANDARD MNEMONIC REQV INSTEAD OF
C     LOCAL MNEMONIC REQ6 (STILL HIGH PRECISION, BUFRTABLE HAS OPERATOR
C     DESCRIPTORS)
C 2007-09-14  D. A. KEYSER -- MODIFIED TO PROCESS TAMDAR AND CANADIAN
C     AMDAR AIRCRAFT REPORTS (FORMER GET PREPBUFR REPORT TYPE 134/234
C     AND ENCODES NEW PARAMETERS "TRBX" AND "ROLF" INTO PREPBUFR FILE;
C     LATTER GET PREPBUFR REPORT TYPE 135/125); MODIFIED TO PROCESS
C     WINDSAT SCATTEROMETER REPORTS, READ FROM NEW "WDSATR" DUMP FILE
C     (GETS PREPBUFR REPORT TYPE 289 AND ENCODES NEW PARAMETERS MRWVC,
C     MRLWC, WSST, MWD10, MWS10, WSEQC1, CHSQ, PHER, SPDE, SSTE, CLDE
C     AND VPRE IN PREPBUFR FILE UNDER NEW MESSAGE TYPE "WDSATR);
C     MODIFIED TO HANDLE RETURN OF NEW ARGUMENT "RDATA2" FROM CALLS TO
C     W3UNPKB7 [1-DIM 21-WORD ARRAY WHICH HOLDS ADDITIONAL VALUES
C     DECODED DIRECTLY FROM BUFR (AND NOT IN "RDATA" ARRAY), FOR SOME
C     PARAMETERS REPLACING WHAT HAD BEEN RETURNED IN "RDATA" ARRAY (IN
C     THE HEADER)]; ADDED LISTING OF PERCENT CONFIDENCE BASED ON -
C     EUMETSAT QUALITY INDEX WITH FORECAST CONSISTENCY TEST, EUMETSAT
C     QUALITY INDEX WITHOUT FORECAST CONSISTENCY TEST AND NESDIS
C     EXPECTED ERROR FOR SATWND TYPES
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-25  D. A. KEYSER -- CAN NOW PROCESS ASCAT SCATTEROMETER
C     WIND DATA READING FROM REPROCESSED DUMP FILE IN UNIT 39, ENCODING
C     INTO NEW PREPBUFR REPORT TYPE 290 UNDER NEW PREPBUFR MESSAGE TYPE
C     "ASCATW" VIA NEW NAMELIST SWITCHES "JPASCD" (DEF=6*9999) AND
C     IAWNDO (DEF=-3,+3); 1-DIM ARRAY OBS2 RETURNED FROM IW3UNPBF
C     INCREASED FROM 41 TO 42 WORDS TO HOLD MOISTURE QUALITY (CODE
C     TABLE) FOR MDCRS REPORTS
C 2014-04-25  D. A. Keyser -- 1-dim array OBS2 returned from IW3UNPBF
C     increased from 42 to 43 words to hold satellite zenith angle
C     (degrees, for all SATWND types).
C 2016-08-15  D. A. Keyser -- Add zenith total delay and its error to
C     listings for GPS-IPW/ZTD reports in report type 153.
C 2016-09-05  S. Melchior --
C      - Diagnostic output print statements formatted to accommodate
C        increased precision now in latitude and longitude.
C 2016-11-25  D. A. Keyser --
C      - Adds instantaneous altitude rate (IALR) to listings for TAMDARB
C        reports in report type 134/234.
C      - Add flight number (ACID) to listings for AMDARB reports (only)
C        in report type 131/231.
C 2016-11-30  D. A. Keyser --
C      - Replace machine length lat/lon {HDR(3), HDR(2)} with R*8 lat/
C        lon (ALAT_8, ALON_8) in print statements.
C        BENEFIT: Values are now precise to 10**5 degrees (was not the
C                 case after 2016-09-05 change above).
C
C USAGE:    CALL FILLX(LL,IERF)
C   INPUT ARGUMENT LIST:
C     LL       - IF .GE. 0 - THE NUMBER OF LEVELS IN THE REPORT
C              - PIECE; IF = -1 - FLAG TO INDICATE THAT REPORT
C              - CONTAINS ONLY RADIANCES (EITHER RTOVS, ATOVS, GOES,
C              - OR SSM/I); IF -2 - FLAG TO INDICATE THAT REPORT
C              - CONTAINS ONLY PRECIPITABLE WATER DATA (EITHER GOES,
C              - SSM/I OR GPS-IPW), OR ONLY RAIN RATE DATA (SSM/I),
C              - OR ONLY CLOUD TOP DATA (GOES)
C
C   OUTPUT ARGUMENT LIST:
C     IERF     - RETURN CODE (=0 - REPORT SUCCESSFULLY ENCODED INTO
C              - PREPBUFR FILE; =1 - REPORT NOT ENCODED INTO PREPBUFR
C              - FILE - PROBLEM!)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINES 'GETC06', 'SFCDTA', 'STOROB',
C   'GETPWATER', 'GETSMI' AND 'GETSCATT'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE FILLX(LL,IERF)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MXPWT =  5)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      LOGICAL  TOVRAD,GOESRD,TOVEDS
      real(8)  obs8_8,alon_8,alat_8
      CHARACTER*8  STNPRT,STNID,CRES1,CRES2,SUBSET_d
      CHARACTER*9  TSLTT1,TSLTT2,TSLTB1,TSLTB2
      CHARACTER*10 MSLTT1,ZSLTT1,MSLTT2,ZSLTT2,MSLTB1,ZSLTB1,MSLTB2,
     $ ZSLTB2
      CHARACTER*11  CBULL,CRES2_save
      INTEGER  ICHN(35),IDATA(MAXOBS)
      COMMON/STRCTY/ICAT(MXLVL)
      COMMON/STRPWT/PWAT(MXTYPV,MXPWT)
      COMMON/STRMSL/IPMSL(MXTYPV)
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/STRRRT/REQV
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/LEVELS/MLEV
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/TVSWCH/TOVEDS(2),TOVBFR(2),TR80KM,KNTTOV(2),
     $ KSKPTV(2),KNOPTV(2),KIPTTV(2),KMSGTV(2),KBDYTV(2),KTIMTV(2),
     $ KLNDTV(2),KSEATV(2),KREDTV(2),KJFLAG(2)
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/CLDTOP/CLTOP(2,3)
      COMMON/ACFTSW/AWINDO(2,9),AIRLND(6,9),JAWIND(6,9),JAMASS(6,9),
     $ IACFTL(9),IACFTH(9),PHIACF(7),KEPAC(6,9),AIFNOW(9),POAF,TRBX(5),
     $ FLACMS(9),PCAT,ROLF,aMSTQ,RIALR
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      COMMON/MISWCH/XWINDO(6,4),JPSSMI(6,4),SRAD(7),KNTSMI(4),KTIMM(4),
     $ KSKPMI,KMSGMI,KBDYMI
      COMMON/COUNT/KKTYPE(100:299)
      COMMON/SFCBFR/ALTIMR,PRSS
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON/XTRHD2/CRES1,CRES2,CBULL
      EQUIVALENCE(IDATA,RDATA)
      DATA  ICHN/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
     $ 22,23,24,25,26,27,28,29,30,31,32,33,34,35/
      DATA YMISS/99998.8/,IMISS/99999/
C INITIALIZE CERTAIN VARIABLES TO AVOID COMPILER WARNINGS
      MODKNT = -1
      IERF = 0
C NEWPRT CONTROLS INTERVAL BETWEEN STANDARD OUTPUT PRINT (FROM REPORT
C  IN "HDR/MOBS/IPMSL/PWAT/xRAD/REQV/CLTOP" ARRAYS)
C MODPRT CONTROLS INTERVAL BETWEEN STANDARD OUTPUT OF REPORTS AS THEY
C  ARE MERGED IN THE GETUPA AND SATELLITE SOUNDING SUBROUTINES
      IF(MODPRT.GE.0)  THEN
         NEWPRT = MODPRT/4
         MODKNT = MOD((KOUNT-1),NEWPRT)
      END IF
C CAN ALSO PRINT OUT FILLED REPORT IN "HDR/MOBS/IPMSL/PWAT/xRAD/REQV/
C  CLTOP" ARRAYS FOR SPECIFIC REPORT(S)
      IF(STNID.EQ.STNPRT(1).OR.STNID.EQ.STNPRT(2).OR.STNID.EQ.
     $ STNPRT(3))  MODKNT = 0
      IF(LL.LT.1)  THEN
         MLEV = 0
      ELSE
         MLEV = LL
C THE MAXIMUM NUMBER OF LEVELS PROCESSED IS MXLVL
         MLEV = MIN(MLEV,MXLVL)
      END IF
C ENCODE REPORT INTO PREPBUFR DATASET
      CALL W3FIZZ(IERF)
      IF(IERF.NE.0)  RETURN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C OPTION TO PRINT LISTING OF ALL REPORTS (NORMALLY COMMENTED OUT)
C     PRINT 9091, STNID,NINT(HDR(6))
C9091 FORMAT(1X,'STN. ',A8,'  PREPBUFR REPORT TYPE =',I4)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C ACCUMULATE COUNTS OF ENCODED REPORTS ACCORDING TO PREPBUFR REPORT TYPE
      KKTYPE(NINT(HDR(6))) = KKTYPE(NINT(HDR(6))) + 1
      IF(MODKNT.NE.0)  RETURN
C PRINTS OUT DATA FOR AN OCCASIONAL REPORT (DEPENDING ON MODPRT/NEWPRT)
C**********************************************************************
C       SET UP FORMAT OF STANDARD OUTPUT (UNIT 06) REPORT PRINTOUT
C**********************************************************************
C GET DEFAULT HEADER LABELS FOR TEMP., MOISTURE, HEIGHT & PRESSURE
      ZSLTT1 = '   HEIGHT '
      ZSLTB1 = '  (METERS)'
      TSLTT1 = ' RPT. TMP'
      TSLTB1 = '  (*100C)'
      MSLTT1 = '      Q   '
      MSLTB1 = '   (MG/KG)'
      IF(HDR(6).GE.200)  THEN
C CORRECT HEADER LABELS FOR U-WIND AND V-WIND FOR WIND REPORTS
         TSLTT1 = '   U-WIND'
         TSLTB1 = '(*100M/S)'
         MSLTT1 = '    V-WIND'
         MSLTB1 = ' (*100M/S)'
      ELSE
         IF((NFILE.EQ.IUNIT(7)  .AND.TOVEDS(1)).OR.
     $      (NFILE.EQ.IUNIT(7)+1.AND.TOVEDS(2)))  THEN
C CORRECT HGHT LBL TO THICK. TO 1000 MB FOR RTOVS OR ATOVS SAT. SNDINGS
            ZSLTT1 = '  THK-1000'
            ZSLTB1 = '   MB (M) '
         END IF
      END IF
      ZSLTB2 = ZSLTB1
      ZSLTT2 = ZSLTT1
      TSLTT2 = TSLTT1
      TSLTB2 = TSLTB1
      MSLTT2 = MSLTT1
      MSLTB2 = MSLTB1
      IF(NFILE.NE.IUNIT(8))  THEN
         PRINT 905, KOUNT,STNID,alat_8,alon_8,MLEV,HDR(4),NINT(HDR(6)),
     $    NINT(HDR(8)),NINT(HDR(7)),NINT(HDR(9)),NINT(HDR(10))
  905 FORMAT(/'>> (',I6,') ID ',A8,' @',F11.5,' N LAT/',F10.5,' E LON:',
     $ '# LVLS=',I4,'  D-TIM=',F9.5,' HR  ANL RT=',I3,'/',I4,'  DUMP ',
     $ 'RT=',I3,'  IT=',I3.3,' ELV=',I5)
      ELSE
         PRINT 915, KOUNT,STNID,alat_8,alon_8,MLEV,HDR(4),NINT(HDR(6)),
     $    NINT(HDR(7)),NINT(HDR(9)),NINT(HDR(10)),NINT(RDATA2(2))
  915 FORMAT(/'>> (',I6,') ID ',A8,' @',F11.5,' N LAT/',F10.5,' E LON:',
     $ ' # LVLS=',I4,'  DHR=',F9.5,' HR  RTP: PRP=',I3,' DMP=',I3,'; ',
     $ 'ITP=',I3.3,' ELV=',I5,' #FOV=',I2)
      END IF
      IF(HDR(6).EQ.102)  THEN
         PRINT 961, SRAD
  961 FORMAT(5X,'CHN.  1 -- BTEMP=',F8.2,'K;  CHN.  2 -- BTEMP=',F8.2,
     $ 'K;  CHN.  3 -- BTEMP=',F8.2,'K;  CHN.  4 -- BTEMP=',F8.2,'K'/5X,
     $ 'CHN.  5 -- BTEMP=',F8.2,'K;  CHN.  6 -- BTEMP=',F8.2,'K;  CHN.',
     $ '  7 -- BTEMP=',F8.2,'K')
         PRINT 999
         RETURN
      ELSE  IF(LL.EQ.-1)  THEN
         GO TO 6666
      ELSE  IF(LL.EQ.-2)  THEN
         IF(HDR(6).EQ.150)  THEN
            PRINT 969, REQV*3600.
  969 FORMAT(5X,'RAIN RATE=',F8.3,' MM/HOUR')
         ELSE  IF(HDR(6).EQ.151)  THEN
            PRINT 977, CLTOP(1,1),NINT(CLTOP(2,1)),NINT(CLTOP(1,2)),
     $       CLTOP(1,3)
  977 FORMAT(5X,'CLOUD TOP PRESSURE=',F7.1,' MB - Q.M. = ',I2,', TOTAL',
     $ ' CLOUD COVER=',I3,' %, CLOUD TOP TEMPERATURE=',F6.2)
         ELSE  IF(HDR(6).EQ.152)  THEN
            PRINT 967, PWAT(1,1),NINT(PWAT(2,1))
  967 FORMAT(5X,'TOTAL COLUMN PRECIP. WATER=',F7.1,' MM - Q.M. = ',I2)
         ELSE  IF(HDR(6).EQ.153)  THEN
            PRINT 986, PWAT(1,1),NINT(PWAT(2,1)),PRSS
  986 FORMAT(5X,'TOTAL COLUMN PRECIP. WATER=',F7.1,' MM - Q.M. = ',I2/
     $ 5X,'SURFACE PRESSURE= ',F6.1,' MB')
            if(idata(43).gt.0)  then
               if(rdata(idata(44)+4).lt.ymiss) then
                  print 987, rdata(idata(44)+4),rdata(idata(44)+5)
  987 format(5X,'ZTD=',F8.4,' M, Error in ZTD= ',F7.4,' M')
               end if
            end if
         ELSE  IF(HDR(6).GT.155)  THEN
            PRINT 966, (PWAT(1,I),NINT(PWAT(2,I)),I=2,5),PRSS
  966 FORMAT(
     $ 5X,'1.0 TO 0.9 SIGMA PRECIP. WATER=',F7.1,' MM - Q.M. = ',I2/
     $ 5X,'0.9 TO 0.7 SIGMA PRECIP. WATER=',F7.1,' MM - Q.M. = ',I2/
     $ 5X,'0.7 TO 0.3 SIGMA PRECIP. WATER=',F7.1,' MM - Q.M. = ',I2/
     $ 5X,'0.3 TO 0.0 SIGMA PRECIP. WATER=',F7.1,' MM - Q.M. = ',I2/
     $ 5X,'SURFACE PRESSURE= ',F6.1,' MB')
         END IF
         PRINT 999
         RETURN
      END IF
      IF(MLEV.EQ.1)  THEN
C SINGLE-LEVEL DATA PRINTS HERE
         IF(NFILE.NE.IUNIT(5)+1.AND.NFILE.NE.IUNIT(5)+2) PRINT 909,
     $    ZSLTT1,TSLTT1,MSLTT1,ZSLTB1,TSLTB1,MSLTB1,NINT(OBS2(1))
  909 FORMAT(1X,'  PRES ',A10,A9,A10,'   --TBL VALS-   -R. CODES--! '/
     $ 1X,'(*10MB)',A10,A9,A10,14X,'    {MOD(100)}! RESTRICTED FLAG:',
     $ I5)
         JPIP1 = MOBS(1,1,1)
         JPIP2 = MOBS(1,2,1)
         JPIP3 = MOBS(1,3,1)
         JPIP4 = MOBS(1,4,1)
         JPIP6 = MOBS(1,6,1)
cdak     KPIP1 = MIN(15,MOBS(2,1,1))
         KPIP1 = MOBS(2,1,1)
cdak     KPIP2 = MIN(15,MOBS(2,2,1))
         KPIP2 = MOBS(2,2,1)
cdak     KPIP3 = MIN(15,MOBS(2,3,1))
         KPIP3 = MOBS(2,3,1)
cdak     KPIP4 = MIN(15,MOBS(2,4,1))
         KPIP4 = MOBS(2,4,1)
         LPIP1 = MOD(MOBS(3,1,1),100)
         LPIP2 = MOD(MOBS(3,2,1),100)
         LPIP3 = MOD(MOBS(3,3,1),100)
         LPIP4 = MOD(MOBS(3,4,1),100)
         IF(ICAT(1).LT.IMISS)  THEN
            IF(HDR(6).LT.200)  THEN
               IF(ISATOB.NE.3.AND.ISATOB.NE.4)  KPIP4 = ICAT(1)
            ELSE
               KPIP4 = ICAT(1)
            END IF
         END IF
         IF(IPMSL(1).LT.YMISS)  THEN
            PRINT 994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,IPMSL(1),IPMSL(2)
  994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! PMSL=',I6,
     $ ' (*10MB), Q.M.(PMSL)=',I2)
         ELSE IF(HDR(6).GE.200.AND.NFILE.EQ.IUNIT(6).AND.JPIP6.LT.IMISS)
     $    THEN
            PRINT 4994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,JPIP6,KPIP4
 4994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! WSPD=',I6,
     $ ' (*10M/S), Q.M.(WSPD)=',I2)
         ELSE  IF(NFILE.EQ.IUNIT(6)+3)  THEN ! Mesonet
            PRINT 8995, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,CRES1,CRES2
 8995 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! PRVSTG= ',A8,
     $ ', SPRVSTG= ',A8)
         ELSE  IF(NFILE.EQ.IUNIT(5)+1.OR.NFILE.EQ.IUNIT(5)+2)  THEN
            CRES2_save = CRES2//'   '
            if(CRES2.eq.'        ')  then
               if(IDATA(10).eq.103) then
                  CRES2_save = ' -missing- '
               else
                  CRES2_save = 'not encoded'
               end if
            end if
            PRINT 910, ZSLTT1,TSLTT1,MSLTT1,ZSLTB1,TSLTB1,MSLTB1,
     $       NINT(OBS2(1)),CRES2_save
  910 FORMAT(1X,'  PRES ',A10,A9,A10,'   --TBL VALS-   -R. CODES--! '/
     $ 1X,'(*10MB)',A10,A9,A10,14X,'    {MOD(100)}! RESTRICTED FLAG:',
     $ I5,', FLIGHT NUMBER=',A11)
            IF(NFILE.EQ.IUNIT(5)+1)  THEN
               PRINT 2994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,
     $          KPIP4,LPIP1,LPIP2,LPIP3,LPIP4,PCAT,NINT(POAF),
     $          (NINT(TRBX(I)),I=1,4),NINT(aMSTQ)
 2994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! TEMP PREC=',
     $ F5.2,'K; CF: PH FLT=',I1,', TRB INDX(1-4)=',4I2,', MSTQ=',I2)
            ELSE
               PRINT 8994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,
     $          KPIP4,LPIP1,LPIP2,LPIP3,LPIP4,PCAT,NINT(POAF),
     4          NINT(TRBX(5)),NINT(ROLF),RIALR
 8994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! T PREC=',F5.2,
     $ 'K; CF: PH FLT=',I1,', TRB IDX=',I2,', ROLL ANG FL=',I1,
     $ ', IALR=',F6.3,'M/SEC')
            END IF
         ELSE  IF(NFILE.EQ.IUNIT(5)+3.AND.(MIN(RFFL,QIFY,QIFN,EEQF,
     $    OBS2(NUMOBS2)).LT.YMISS))  THEN
            PRINT 3994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,NINT(RFFL),NINT(QIFY),NINT(QIFN),
     $       NINT(EEQF),OBS2(NUMOBS2)
 3994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! RFFL, QIFY, ',
     $ 'QIFN, EEQF: ',4I4,'; SAZA=',F6.2)
         ELSE  IF(NFILE.EQ.IUNIT(6)+6)  THEN
            PRINT 6994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,NINT(RDATA2(3)),NINT(RDATA2(4)),
     $       RDATA2(8)*100.0
 6994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! CELL # = ',I4,
     $ '; ROW # = ',I4,'; SPRR =',F6.1,'%')
         ELSE  IF(NFILE.EQ.IUNIT(6)+7)  THEN
            PRINT 6995, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,NINT(RDATA2(2)),(RDATA2(II),
     $       II=9,11),RDATA2(14),RDATA2(13),NINT(RDATA2(15)),
     $       (RDATA2(II),II=16,21),REQV*3600,NINT(RDATA2(12))
 6995 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'!ACAV ',I2,
     $ '|SST1 ',F6.2,'K|MRWVC ',F6.2,'MM|MRLWC ',F5.2,'MM|MWS10 ',F6.2,
     $ 'M/S'/'MWD10 ',F6.2,'|WSEQC1',I10,'|CHSQ ',F5.2,'|PHER ',F5.1,
     $ '|SPDE ',F5.2,'M/S|SSTE ',F6.2,'K|CLDE ',F6.3,'MM|VPRE ',F5.2,
     $ 'MM|REQV',F8.3,'MM/HR|WSST ',I2)
         ELSE  IF(NFILE.EQ.IUNIT(6)+8)  THEN
            PRINT 6996, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,NINT(RDATA2(3)),NINT(RDATA2(22)),
     $       RDATA2(23),RDATA2(24)
 6996 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! CELL # = ',I4,
     $ '; WVCQ = ',I10,'; BSCD =',F6.1,'; LKCS = ',F7.3)
         ELSE
            PRINT 1994, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4
 1994 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'!')
         END IF
      ELSE
         PRINT 902, ZSLTT1,TSLTT1,MSLTT1,ZSLTT2,TSLTT2,MSLTT2,ZSLTB1,
     $    TSLTB1,MSLTB1,ZSLTB2,TSLTB2,MSLTB2
  902 FORMAT(1X,'  PRES ',A10,A9,A10,'   --TBL VALS-   -R. CODES--!   ',
     $ 'PRES ',A10,A9,A10,'   --TBL VALS-   -R. CODES--'/1X,'(*10MB)',
     $ A10,A9,A10,14X,'    {MOD(100)}! (*10MB)',A10,A9,A10,14X,'    ',
     $ '{MOD(100)}')
         NSLEV = MLEV
         IF(MOD(MLEV,2).NE.0)  NSLEV = NSLEV + 1
         NSLEV = NSLEV/2
         DO I = 1,NSLEV
            JPIP1 = MOBS(1,1,I)
            JPIC1 = MOBS(1,1,I+NSLEV)
            JPIP2 = MOBS(1,2,I)
            JPIC2 = MOBS(1,2,I+NSLEV)
            JPIP3 = MOBS(1,3,I)
            JPIC3 = MOBS(1,3,I+NSLEV)
            JPIP4 = MOBS(1,4,I)
            JPIC4 = MOBS(1,4,I+NSLEV)
cdak        KPIP1 = MIN(15,MOBS(2,1,I))
            KPIP1 = MOBS(2,1,I)
cdak        KPIC1 = MIN(15,MOBS(2,1,I+NSLEV))
            KPIC1 = MOBS(2,1,I+NSLEV)
cdak        KPIP2 = MIN(15,MOBS(2,2,I))
            KPIP2 = MOBS(2,2,I)
cdak        KPIC2 = MIN(15,MOBS(2,2,I+NSLEV))
            KPIC2 = MOBS(2,2,I+NSLEV)
cdak        KPIP3 = MIN(15,MOBS(2,3,I))
            KPIP3 = MOBS(2,3,I)
cdak        KPIC3 = MIN(15,MOBS(2,3,I+NSLEV))
            KPIC3 = MOBS(2,3,I+NSLEV)
cdak        KPIP4 = MIN(15,MOBS(2,4,I))
            KPIP4 = MOBS(2,4,I)
cdak        KPIC4 = MIN(15,MOBS(2,4,I+NSLEV))
            KPIC4 = MOBS(2,4,I+NSLEV)
            LPIP1 = MOD(MOBS(3,1,I),100)
            LPIC1 = MOD(MOBS(3,1,I+NSLEV),100)
            LPIP2 = MOD(MOBS(3,2,I),100)
            LPIC2 = MOD(MOBS(3,2,I+NSLEV),100)
            LPIP3 = MOD(MOBS(3,3,I),100)
            LPIC3 = MOD(MOBS(3,3,I+NSLEV),100)
            LPIP4 = MOD(MOBS(3,4,I),100)
            LPIC4 = MOD(MOBS(3,4,I+NSLEV),100)
            IF(HDR(6).LT.200)  THEN
               IF(ISATOB.NE.3.AND.ISATOB.NE.4)  THEN
                  IF(ICAT(I).LT.IMISS)  KPIP4 = ICAT(I)
                  IF(ICAT(I+NSLEV).LT.IMISS)  KPIC4 = ICAT(I+NSLEV)
               END IF
            ELSE
               IF(ICAT(I).LT.IMISS)  KPIP4 = ICAT(I)
               IF(ICAT(I+NSLEV).LT.IMISS)  KPIC4 = ICAT(I+NSLEV)
            END IF
            PRINT 94, JPIP1,JPIP2,JPIP3,JPIP4,KPIP1,KPIP2,KPIP3,KPIP4,
     $       LPIP1,LPIP2,LPIP3,LPIP4,JPIC1,JPIC2,JPIC3,JPIC4,KPIC1,
     $       KPIC2,KPIC3,KPIC4,LPIC1,LPIC2,LPIC3,LPIC4
   94 FORMAT(1X,I6,I10,I9,I10,1X,2X,4(1X,I2),2X,4I3.2,'! ',I6,I10,I9,
     $ I10,1X,2X,4(1X,I2),2X,4I3.2)
         ENDDO
      END IF
 6666 CONTINUE
      IF(NFILE.EQ.IUNIT(7))  THEN
         IF(TOVRAD)  THEN
            PRINT 2995, SOZANG,SAZANG,OZONE,SKINT
 2995 FORMAT(/1X,'RTOVS RADIANCES: ZENITH ANGLE (DEG): SOLAR=',F8.2,
     $ ', SATELLITE=',F8.2,'; OZONE=',F6.0,'(DOBSON); SKIN TEMP=',F7.1,
     $ 'K')
            PRINT 2996, (ICHN(I),RTRAD(I),I=1,32)
 2996 FORMAT(5X,'CHN.',I3,' -- BTEMP=',F8.2,'K;  CHN.',I3,' -- BTEMP=',
     $ F8.2,'K;  CHN.',I3,' -- BTEMP=',F8.2,'K;  CHN.',I3,' -- BTEMP=',
     $ F8.2,'K')
         END IF
      ELSE IF(NFILE.EQ.IUNIT(7)+1)  THEN
         IF(TOVRAD)  THEN
            PRINT 3995, SOZANG,SAZANG,OZONE,SKINT
 3995 FORMAT(/1X,'ATOVS RADIANCES: ZENITH ANGLE (DEG): SOLAR=',F8.2,
     $ ', SATELLITE=',F8.2,'; OZONE=',F6.0,'(DOBSON); SKIN TEMP=',F7.1,
     $ 'K')
            PRINT 3996, (ICHN(I),RTRAD(I),I=1,35)
 3996 FORMAT(5X,'CHN.',I3,' -- BTEMP=',F8.2,'K;  CHN.',I3,' -- BTEMP=',
     $ F8.2,'K;  CHN.',I3,' -- BTEMP=',F8.2,'K;  CHN.',I3,' -- BTEMP=',
     $ F8.2,'K')
         END IF
      END IF
      IF(NFILE.EQ.IUNIT(8))  THEN
         IF((GOESRD(1).AND.STNID(1:1).NE.'H').OR.
     $      (GOESRD(2).AND.STNID(1:1).EQ.'H'))  THEN
            IF(IGCHN(1).NE.-99999)  THEN
               PRINT 997, SOZANG,SAZANG,SKINT,CLDAMT
  997 FORMAT(/1X,'GOES RADIANCES:: ZENITH ANGLE (DEG): SOLAR=',F8.2,
     $ ', SATELLITE=',F8.2,'; SKIN TEMP=',F8.2,'K; CLOUD AMT=',F5.0,
     $ '(CODE TBL)')
               PRINT 998, (IGCHN(I),GRAD(I),I=1,18)
  998 FORMAT(5X,'CHN.',I3,' -- BTEMP=',F8.2,'K;  CHN.',I3,' -- BTEMP=',
     $ F8.2,'K;  CHN.',I3,' -- BTEMP=',F8.2,'K')
            END IF
         END IF
      END IF
      PRINT 999
  999 FORMAT(' ')
C**********************************************************************
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GETC06
C   PRGMMR: Keyser           ORG: NP22        DATE: 2016-11-30
C
C ABSTRACT: RETRIEVES SINGLE LEVEL {AIRCRAFT FLIGHT-LEVEL, SATWND (ALL
C   TYPES), RECCO} REPORTS FROM DATA LEVEL CAT. 6.  RECCOS MAY INCLUDE
C   EITHER A MANDATORY LEVEL GEOPOTENTIAL OBS OR A MEAN SEA-LEVEL
C   PRESSURE OBS IF SUFFICIENTLY "NEAR" A MANDATORY PRESSURE LEVEL OR
C   THE SURFACE.  CALLS FILLX TO WRITE REPORT TO PREPBUFR FILE.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1988-08-24  D. A. KEYSER -- SATWNDS FROM NAT. HURRICANE CENTER P-LVL
C     CHANGED FROM 850 MB TO 900 MB
C 1988-10-28  D. A. KEYSER -- SUBR. NAME CHGED FROM 'AIRCFT' TO 'GETC06'
C 1989-03-15  D. A. KEYSER -- ADDED SWITCH 'PGCALM' (=T PURGES CALM
C     AIRCRAFT FLIGHT LEVEL WIND REPORTS)
C 1989-12-13  D. A. KEYSER -- REPORT SUB-TYPE DETERMINATION MOVED FROM
C     SUBR. 'PREP' TO HERE; HANDLES MASS PIECE AS WELL AS WIND PIECE;
C     QM FOR ACFT PIREP ('P????P', 'XX999 ') WINDS BUMPED FROM 1 OR 2
C     TO 3
C 1990-01-04  D. A. KEYSER -- FUNCTION PR(Z) BETTER DEFINED
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-02-06  D. A. KEYSER -- ADDED NEW SWITCH 'PHISWN' TO CATEGORIZE
C     SAT. RPTS (CAT. 6) ACCORDING 6 TO LAT. BANDS
C 1990-07-11  D  A. KEYSER -- HONORS NEW AIRCFT Q. MARKS, AIRCFT FILE
C     CHECKED IN 'PREPACFT' PRIOR TO THIS PGM; SWITCH 'PGCALM' NO
C     LONGER NEEDED, REMOVED; SWITCH 'FGGE' REMOVED FROM N-LIST (FALSE)
C 1991-01-03  D. A. KEYSER -- INSAT RPTS MISPLACED (NORTH OF 40N) ARE
C     TOSSED
C 1992-07-01  D. A. KEYSER -- CAN PROCESS NESDIS GRADIENT WINDS FROM
C     SATWND FILE, WITH OI/SSI R. TYPE 244/254 (LO/HI)
C 1992-07-09  D. A. KEYSER -- NOBS ARRAY NOT FILLED W/ VARIABLE IF
C     IF .GT. 32767
C 1992-08-07  D. A. KEYSER -- THE QUALITY MARK FOR BOTH MASS (TEMP)
C     AND WIND FOR CONV'L/AMDAR AIRCFT COMING FROM RAW PROD AIRCFT
C     UNPKD ON29 D-SET IS NOW OBTAINED FROM THE FIRST Q.M. POSITION
C     RATHER THAN THE SECOND OR FOURTH POSITION FOR TEMP & WIND, RESP.;
C     THE TEST FOR AMDAR AIRCRAFT REPORTS NO LONGER LOOKS FOR AN 'A'
C     IN THE 6'TH POSITION OF THE STN. ID (ONLY LOOKS FOR 'Z'); ADDED
C     GEOGRAPHICAL TEST TO N-LIST SWITCH "AWINDO" (TIME WINDOW CAN VARY
C     BASED ON IN/OUTSIDE U.S. MAINLAND/ADJOINING REGIONS); ADDED
C     N-LIST SWITCH "PGAFUS" TO ALLOW CONV'L AIREP/PIREP ACFT FLT LVL
C     RPTS OVER U.S. MAINLAND/ADJOINING REGIONS TO BE TOSSED IF .GT.
C     100 MDCRS RPTS HERE
C 1992-12-02  D. A. KEYSER -- IMPR. STD O-PUT (UNIT 6) PRINT RE: CAT. 6
C     MASS/WIND RPTS W/ BAD/MSG DATA; ACFT RPTS W/ BAD/MSG TEMP NO
C     LONGER PROCESS MASS PIECE (PREPDA); MDCRS RPTS USE NEW, EXPAND.
C     Q.M. (MARKN), CHGS. SSI/OI Q.M. ON MDCRS WIND FROM 2 TO 1
C 1993-05-12  D. A. KEYSER -- SET-UP EXPANDED REPORT FORMAT, WORD 2 FOR
C     EACH MASS/WIND LVL IS PRESS. X 10MB, NEW WORD 5 FOR EACH LEVEL
C     CONTAINS 4 PACKED "PREPBUFR TBL VALUES" WHICH CAN RANGE FROM 0-15
C     AND CORRESPOND TO ON29 Q. MARKERS OR PREPRO-GENERATED Q. MARKERS;
C     ALL NON-MISSING DATA ARE NOW PACKED INTO PREPBUFR FILE REGARDLESS
C     OF QUALITY; HIGH LEVEL PRESSURES (MB * 10) NOW ROUNDED TO NEAREST
C     WHOLE NUMBER RATHER THAN TRUNCATED WHEN CONVERTED TO INTEGER
C 1993-05-31  D. A. KEYSER -- REDEFINED AND ADDED NEW OI/SSI R. TYPES
C     FOR ALL VALID SATWND PRODUCER/SATELLITE/PRODUCT COMB.; EACH
C     SATWND REPORT NOW IDENTIFIED EXPLICITLY BY PRODUCER/SATELLITE
C     COMBINATION AND BY PRODUCT, THESE ARE USED TO TEST EXPANDED
C     3-DIM. N-LIST SWITCHES "SWINDO", "SWNLND", "JSWIND", AND "JSMASS"
C     TO DETERMINE IF SATWND RPT. IS TO BE PROCESSED
C 1993-10-07  D. A. KEYSER -- MSG VALUE IN NOBS ARRAY IS 99999, ACTUAL
C     HEIGHT (NO D-VAL) STORED IN NOBS ARRAY
C 1993-11-02  D. A. KEYSER -- ADDED N-LIST SWITCH 'RECSLM' TO PROCESS
C     (=T) OR NOT PROCESS (=F) CAT. 6 RECCO MASS LEVELS (DEF= T); ALL
C     CAT. 6 LEVEL DATA NOW STORE ON29 CAT. IN MOIST. TBL VAL. SLOT;
C     FOLLOWING PERTAINS TO SINGLE-LVL CAT. 1 RECCOS: NO LONGER O-PUT
C     SFC. PRESS. (ONLY) IN 1ST LVL OF MASS/WIND RPT; NOW PROCESSED IN
C     THIS SUBROUTINE; MAND. P-LVL STILL INCL. GEOPOT. BUT TEMP,
C     MOIST., WIND & ELEV NOW TREATED ON 2ND LVL LIKE CAT. 6 (PRESS.
C     EST. FROM GEOPOT., ELEV, AND TEMP); VARIABLE IFLC6 WHEN SET 1
C     WILL FLAG ALL VARIABLES WITH PREPBUFR T. VALUE=15
C 1993-12-21  D. A. KEYSER -- CAT. 6 WIND LVLS NOW HOLD P-ALT IN WORD 1
C     OF LVL INFO (NOBS) W/ TBL. VAL. IN POSITION 3 OF WORD 5 (BOTH
C     WERE MISSING)
C 1994-07-19  D. A. KEYSER -- FOLLOWING PERTAINS TO SINGLE-LVL CAT.
C     2/3 RECCOS: NO LONGER O-PUT SFC. PRESS. (ONLY) IN 1ST LVL OF
C     MASS/WIND RPT; NOW PROCESSED IN SUBR. 'GETC06'; PSTN-LVL STILL
C     INCL. BUT GEOPOT. NOW ZERO RATHER THAN 'ELEV' ALSO TEMP, MOIST.,
C     WIND & ELEV NOW TREATED ON 2ND LVL LIKE CAT. 6 (PRESS. EST. FROM
C     GEOPOT., ELEV, AND TEMP)
C 1994-08-11  D. A. KEYSER -- WORDS 6 AND 7 OF MASS LVL NOW CONTAIN
C     SENS. TEMP AND DWPT TEMP, RESP. WHILE WORDS 6 AND 7 OF WIND LVL
C     CONTAIN WIND DIR. AND SPEED, RESP.; ALSO WORD 3 OF MASS LVL NOW
C     CONTAINS "REPORTED" TEMP ADDED N-LIST SWITCH 'IACARL' TO INDICATE
C     FLOOR (METERS) FOR MDCRS; CONV'L/AMDAR QCACFT WSPD INCR. Q.M. NOW
C     KEPT IN COMMON FOR EA. REPORT; RPT SEQ. NO. NOW STORED IN WORD 12
C     OF HDR FOR CONV'L/AMDAR AIRCFT (=KOUNT)
C 1995-07-12  D. A. KEYSER -- SATWND TEMPS HI- & LO-LVL NOW COMBINED
C     IN R. TYPES 140-149; GOES-EVN & GOES-ODD SATWND SATWND (MASS/
C     WIND) R.TYPES NOW SEPARATE; ADDED N-LIST SWITCH "PHIACF", DEFINES
C     LAT. BANDS FOR SELECTING ACFT RPTS; EXPAND. N-LIST SWITCHES
C     "AIRLND", "JAWIND", "JAMASS" TO (6,4) ARRAYS TO SELECT BY LAT.
C     BAND
C 1995-08-24  D. A. KEYSER -- R.T. 132 CAT.2 SNGL-LVL RECCOS SFC. DATA
C     (PMSL, Z) FLAGGED FOR NON-USE BY ANAL. (USED LATER AS R.T 182)
C 1996-02-07  D. A. KEYSER -- NAMELIST SWITCHES 'JSMASS' AND 'JSWIND'
C     NOW HAVE MORE POSSIBLE VALUES THAN 0 OR 9999, THIS ALLOWS
C     CERTAIN COMBINATIONS OF SATELLITE PRODUCERS/PRODUCTS AND EVEN
C     CERTAIN GOES-EVEN AND ODD SATELLITE NUMBERS TO BE PROCESSED BUT
C     FLAGGED FOR NON-USE BY THE ANALYSIS; NOW RECOGNIZES THAT GOES
C     SATWND STNID SUFFIX CHARACTER DIFFERS FOR EVERY-OTHER ODD ('A'
C     OR 'C') OR EVEN ('B' OR 'D') SATELLITE
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C     BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C     (PRESSURE ENCODED IN BUFR IS TO NEAREST WHOLE MILLIBAR W/ ZERO IN
C     TENTHS)
C 1996-09-03  D. A. KEYSER -- ADDED PROCESSING FOR NESDIS HI-DENSITY
C     SAT. WINDS (SWITCHES "SWINDO", "SWNLND", "JSWIND", "JSMASS"
C     EXPANDED), R.TYPES EXPANDED; CAN READ WSPD IN M/SEC X 10 FROM
C     ON29 CAT.8, C.FIG. 924 IF AVAILABLE
C 1997-01-31  D. A. KEYSER -- AIRCRAFT DATA CAN NOW BE FLAGGED OR
C     TOSSED IF BELOW "FLOOR" OR WIND IS MISSING
C 1997-06-02  D. A. KEYSER -- AMDAR ACFT REPORTS NOW IDENTIFIED BY
C     LOGICAL SWITCH "AMDAR" (SET IN SUBR. UNPREP) RATHER THAN BY A 'Z'
C     IN 6'TH POSITION OF STNID SINCE STNID AT THIS POINT NOW CONTAINS
C     ACTUAL AMDAR STNID (UP TO 8-CHARACTERS, NO LONGER 'Z' IN 6'TH POS.
C     OF STNID)
C 1997-10-06  D. A. KEYSER -- ADDED LOGIC TO PROCESS NEW TYPES OF
C     NESDIS HI-DENS SATWNDS
C 1998-02-17  D. A. KEYSER -- WSPD IN M/SEC * 10 NOW READ DIRECTLY FROM
C     CAT 6. (NOT CAT. 8), SAME FOR PRESSURE (IF NON-MSG, ELSE CALC.
C     FROM P-ALT AS BEFORE); REMOVED LOGIC RE: FLAGGING AIREP/PIREP
C     OVER CONUS; AMDAR AIRCFT PHASE OF FLT. INDIC. NOW USED TO STORE
C     SPECIAL REPORT SUB-TYPE IN HDR(8)
C 1998-06-15  D. A. KEYSER -- STREAMLINED THE PROCESSING OF CAT. 6
C     RECCOS W/ EITHER MAND LVL GEOPOT. OBS OR MEAN SEA-LVL PRESS. OBS
C 1999-08-04  D. A. KEYSER -- ADDED STORAGE (FOR LATER ENCODING) OF
C     PHASE OF FLIGHT (POAF) FOR ALL ACFT TYPES AND DEGREE OF
C     TURBULENCE (DGOT) FOR NON-MDCRS ACFT TYPES; ADDED PROCESSING OF
C     MDCRS MOISTURE DATA; FOREIGN SATWND SWITCHES NOW CONTROL IR
C     C-DRFT AND VIS. C-DRFT SEPARATELY (STILL SAME R.TYPES); ADDED
C     PROCESSING OF FOREIGN WATER VAPOR SATWNDS WITH NEW R.TYPES 250
C     (GMS), 254 (EUMETSAT), AND 256 (INSAT)
C 2000-02-17  D. A. KEYSER -- ADDED STORAGE (FOR LATER ENCODING) OF
C     NESDIS RECURSIVE FILTER FLAG (RFFL) FOR NESDIS (GOES) SATWND
C     TYPES; MOVED GOES SATWND Q.M. ASSIGNMENT BASED ON RFFL FROM
C     SUBROUTINE IW3UNPBF TO THIS SUBROUTINE
C 2000-12-05  D. A. KEYSER -- RECOGNIZES SATWIND REPORTS WITH NEW
C     8-CHAR. STNID FORMAT; ALL CAT. 6 TYPES NOW STORE SPEC. HUMIDITY
C     AS MOISTURE VARIABLE RATHER THAN DEWPOINT DEPR.
C 2001-04-06  D. A. KEYSER -- PRINTS DIAG. IF TDEW < TDLIM FOR MDCRS;
C     N-LIST SWITCH SWINDO SPLIT INTO SWINDO_e (EARLIEST TIME WINDOW)
C     AND SWINDO_l (LATEST TIME WINDOW) FOR SATWND REPORTS ("-" PRIOR
C     TO CYCLE TIME, "+" AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE);
C     SUBR. "RPTLBL" NOW HAS INPUT ARGS. "TIMWIN_e" (EARLIEST TIME
C     WINDOW) AND "TIMWIN_l" (LATEST TIME WINDOW) REPL. "TIMWIN" (+/-
C     TIME WINDOW) ("-" PRIOR TO CYCLE TIME, "+" AFTER CYCLE TIME),
C     ALLOWS THE 2 TO BE DIFFERENT; READS IN THE 4 MDCRS TURBULENCE
C     INDECES
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"
C 2001-09-14  D. A. KEYSER -- REPORT SEQ. NUMBER STORED IN HDR(11) FOR
C     SATELLITE-DERIVED WIND REPORTS LATER ENCODED IN PREPBUFR FILE
C     UNDER MESSAGE TYPE "SATWND", AND FOR RECCOS LATER ENCODED UNDER
C     MESSAGE TYPE "ADPUPA" (RECCO SEQ. NUMBER WILL BEGIN WHERE RAOBS/
C     PIBALS/DROPS LEFT OFF IN "ADPUPA")
C 2002-01-14  D. A. KEYSER -- ADDED N-LIST SWITCH "IACFTH" WHICH ALLOWS
C     AIRCRAFT DATA TO BE FLAGGED IF ABOVE A LIMITING ALTITUDE; LEVELS
C     WITH CALC. DWPT < "TDLIM" VALUE NOW RETAIN SPEC. HUM AND CALC.
C     DWPT IN PREPBUFR FILE, BUT MOISTURE PREPBUFR TBL VALUE IS FLAGGED
C     WITH Q.M.=15 IN SUBR. FIZZ01 (BEFORE, SPEC. HUM. AND DWPT SET TO
C     MISSING) VIRT. TEMP. CALC. AND ENCODED IN THIS CASE  (BEFORE, SET
C     TO SENSIBLE TEMP.)
C 2002-01-28  D. A. KEYSER -- READS PRECISION OF TEMP. OBS. OUT OF
C     "AIRCAR" AND "AIRCFT" DUMP FILES (CAT. 8, CODE FIG. 915) (LATER
C     ENDCODED INTO PREPBUFR FILE)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF EAMDAR ACFT RPTS NOW
C     POSSIBLY INCL. IN "AIRCFT" DUMP FILE DUMP R. TYPE 41, SUBTYPE 6,
C     INCL. WITH EXISTING PREPBUFR R. TYPES 131/231, PROCESSED INTO
C     PREPBUFR FILE UNDER EXISTING TBL A ENTRY "AIRCFT"; ADDED
C     PROCESSING OF NASA/MODIS POES AQUA/TERRA SATELLITE-DERIVED WINDS,
C     NOW POSSIBLY INCL. IN "SATWND" DUMP FILE EXISTING DUMP R. TYPE
C     63, GET PREPBUFR R. TYPES 257 (IR), 258 (W.VAPOR IMGR CLOUD-TOP)
C     AND 259 (W.WAPOR IMGR DEEP LAYER), PROCESSED INTO PREPBUFR FILE
C     UNDER EXISTING TBL A ENTRY "SATWND"; NOW RETURNS 41-WORD (RATHER
C     THAN 2-WORD) ARRAY "OBS2" OUT OF CALL TO IW3UNPBF, WHERE WORDS
C     3-41 CONTAIN ALTIMETER SETTING, SEA-SURFACE TEMPERATURE, SINGLE-
C     LEVEL SENSIBLE WEATHER ELEMENTS AND SST TABLE VALUE (Q.M.);
C     RETURNS NEW ARRAY ARGUMENTS "OBS3" {(5,MXBLVL,5)} AND "NOBS3"
C     {(5)} OUT OF CALL TO IW3UNPBF WHERE OBS3 CONTAINS MULTIPLE-LEVEL
C     SENSIBLE WEATHER ELEMENTS AND NOBS3 DEFINES THE NUMBER OF LEVELS
C     OF DATA IN THE OBS3(X,Y,1) TO OBS3(X,Y,5) ARRAYS (SEE IW3UNPBF
C     DOCBLOCK FOR MORE INFO); ALL NEW PARAMETERS (I.E., SST AND
C     SENSIBLE WEATHER ELEMENTS) IN OBS2 AND OBS3 ARE ENCODED INTO
C     PREPBUFR FILE, BUT ONLY IN THE MASS "PIECE" OF A REPORT (UNLESS
C     THERE IS NO MASS PIECE, THEN THEY ARE ENCODED INTO WIND PIECE)
C 2005-07-01  D. A. KEYSER -- NOW STORES A VALUE 1 INTO REPORT SUBTYPE
C     (HEADER WORD 8) FOR RECCO REPORTS IN REPORT TYPE 132/232 - LATER
C     GETS ENCODED INTO PREPBUFR UNDER MNEMONIC "TSB" (SUBR. PREP
C     STORES THIS AS 2 FOR DROPS - THIS ALLOWS DROPS AND RECCOS TO BE
C     DIFFERENTIATED IN PREPBUFR)
C 2006-11-29  D. A. KEYSER -- MODIFIED EUMETSAT PROCESSING TO CONSIDER
C     "ODD" AND "EVEN" SATELLITES SEPARATELY FOR PROCESS/NO-PROCESS/
C     FLAG ALL/FLAG EVERY-OTHER (N-LIST SWITCHES "JSMASS"/"JSWIND"),
C     TIME WINDOW ("SWINDO_e"/"SWINDO_l"), LAND/NO-LAND ("SWNLND"), ALL
C     BY LAT BAND AND PRODUCT TYPE
C 2007-09-14  D. A. KEYSER -- ACCOUNTS FOR HIGH-DENSITY JMA SATELLITE
C     WINDS DERIVED FROM BUFR BULLETINS IN NC005044-NC005046 CONTAINING
C     RFF QUALITY INDICATOR, THE Q.C. TESTS FOR RFF ARE LIMITED ONLY TO
C     THE NESDIS GOES AND NASA/POES SATWINDS AT THIS TIME; MODIFIED TO
C     PROCESS TAMDAR AND CANADIAN AMDAR AIRCRAFT REPORTS (FORMER GET
C     PREPBUFR REPORT TYPE 134/234 AND ENCODES NEW PARAMETERS "TRBX"
C     AND "ROLF" INTO PREPBUFR FILE; LATTER GET PREPBUFR REPORT TYPE
C     135/125); IF AIFNOW=FALSE, NOW FLAGS ALL ACFT REPORTS AS BAD IF
C     WIND IS MISSING BUT TEMP IS PRESENT (USED TO FLAG ONLY MDCRS
C     HERE AND TOSS ALL OTHER TYPES DUE TO CONCERN ABOUT PREPACQC),
C     POINT IS MOOT BECAUSE AIFNOW NOW SET TO TRUE TO PROCESS ALL ACFT
C     TYPE TEMP REPORTS WHEN WIND DATA ARE MISSING; NOW FLAGS ALL ACFT
C     REPORTS BELOW "FLOOR" LEVEL (USED TO FLAG ONLY MDCRS HERE AND TOSS
C     ALL OTHER TYPES DUE TO CONCERN ABOUT PREPACQC); NOW HANDLES
C     SATWINDS FROM NEW INDIAN KALPANA SATELLITE (REPORTS HAVE SUFFIX
C     CHARACTER "K" IN STATION ID); ACCOUNTS FOR EUMETSAT MSG
C     (METEOSAT-8 AND UP) SATWINDS CONTAINING RFF QUALITY INDICATOR;
C     ADDED READING IN OF PERCENT CONFIDENCE BASED ON - EUMETSAT QUALITY
C     INDEX WITH FORECAST CONSISTENCY TEST (FROM CAT. 8 CODE TABLE 356),
C     EUMETSAT QUALITY INDEX WITHOUT FORECAST CONSISTENCY TEST (FROM
C     CAT. 8 CODE TABLE 357) AND NESDIS EXPECTED ERROR (FROM CAT. 8 CODE
C     TABLE 358) FOR SATWND TYPES; CASES WHERE OBS ARE SET TO QM=15 IN
C     ORDER TO FLAG A REPORT FOR NON-USE BY ANALYSIS (EVEN THOUGH OBS
C     MAY NOT NECESSARILY BE BAD) NOW FIRST CHECK TO MAKE SURE OBS QM
C     ISN'T ALREADY "BAD" (> 3 AND < 15) (PREVENTS GSI FROM MONITORING
C     TRULY BAD OBS WHICH JUST HAPPEN TO BE IN REPORT GROUPS FLAGGED FOR
C     NON-USE BY ANALYSIS); THE SINGLE DEGREE OF TURBULENCE VALUE IS NO
C     LONGER RETURNED FROM IW3UNPBF IN CAT. 8, CODE FIGURE 916, IT HAS
C     BEEN REPLACED WITH EXPANDED DEGREE OF TURBULENCE INFORMATION NOW
C     INCLUDED IN THE MULTIPLE-LEVEL SENSIBLE WEATHER ELEMENT ARRAY OBS3
C     RETURNED FROM IW3UNPBF; AIRCRAFT REPORTS WITH MISSING WIND AND
C     TEMP ARE STILL ENCODED INTO PREPBUFR FILE AS A MASS REPORT IF
C     OTHER ANCILLARY INFO (E.G., SENSIBLE WX ELEMENTS LIKE TURBULENCE,
C     ICING, CLOUD) IS PRESENT (MAINLY PIREPS) AND NEW N-LIST SWITCH
C     WRMISS IS TRUE - BEFORE SUCH OBS WITHOUT ANY WIND AND TEMP DATA
C     WERE ALWAYS SKIPPED
C 2008-09-25  D. A. KEYSER -- 1-DIM ARRAY OBS2 RETURNED FROM IW3UNPBF
C     INCREASED FROM 41 TO 42 WORDS TO HOLD MOISTURE QUALITY (CODE
C     TABLE) FOR MDCRS REPORTS; UPPER LIMIT FOR STORING Q CHANGED FROM
C     32767 MG/KG TO 99999 MG/KG TO ENSURE THAT LEVELS WITH VERY
C     HIGH SPECIFIC HUMIDITY ARE PROCESSED (THE 32767 LIMIT WAS A
C     VESTIGE FROM THE OLD I*2 PREPDA DAYS); IF NEAREST INTEGER FOR Q
C     IS 0 MG/KG, IT IS RESET TO 1 MG/KG (.001 G/KG) TO ENSURE THAT
C     LEVELS WITH VERY LOW SPECIFIC HUMIDITY ARE PROCESSED (Q MUST BE >
C     0 TO BE PROCESSED)
C 2014-04-25  D. A. Keyser -- For all satellite-derived wind reports,
C     now encodes PREPBUFR report sub-type (mnemonic "TSB", previously
C     missing) as BUFR satellite id times 10 plus "Satellite Derived
C     Wind Computation Method ("SWCM" - BUFR code table 0-02-023),
C     allows GSI to identify cloud-top vs. deep-layer WV winds and IR
C     vs. visible winds for METEOSAT and JMA since, unlike NESDIS, both
C     have same report types (250-JMA & 254-EUMETSAT for WV, 242/252-
C     JMA & 243/253-EUMETSAT for IR/VIS).
C 2015-01-30  D. A. Keyser -- All references to IR satellite-derived
C     winds now expanded to refer to IR "long-wave" - this
C     differentiates them from IR "short-wave" winds which are now
C     produced from GOES but are not processed by this program.
C 2015-03-11  D. A. Keyser -- Corrected bug which was not encoding SQN
C     (sequence number) properly for AIRCAR type when SQN was > 99998.
C 2016-02-08  S. Melchior --
C      - Processes two new aircraft data types in AIRCFT message type:
C        Korean AMDAR (BUFR) and Catch-all AMDAR (BUFR).  Either pre-
C        version 7 BUFR or new version 7 BUFR for Catch-All AMDAR,
C        MDCRS and E-AMDAR can be handled.
C          - The following arrays' dimensions were increased and
C            defaults adjusted: AWINDO, AIRLND, JAWIND, JAMASS, IACFTL,
C            IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC, KSKNOW,
C            INAC.
C      - Fixed a bug which allowed an aircraft report "mass piece" to
C        be encoded into the PREPBUFR file in cases when everything was
C        missing other than the restriction indicators (mnemonics RSRD
C        and EXPRSRD).
C 2016-09-05  S. Melchior --
C      - Diagnostic output some print statements formatted to
C        accommodate increased precision now in latitude and longitude.
C 2016-10-27  C. Hill --
C      - TAMDARB AIRCFT message type added to handle BUFR form of TAMDAR
C        reports.  Allows for older (pre-2011) and newer TAMDAR data to
C        be processed.  The array sizes of AWINDO, AIRLND, JAWIND, JAMASS,
C        IACFTL, IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC, KSKNOW,
C        and INAC were all increased to (6,9).
C 2016-11-25  D. A. Keyser --
C      - Encodes instantaneous altitude rate (IALR) into PREPBUFR file
C        for TAMDARB reports in report type 134/234 (returned from c.f.
C        932 in call to IW3UNPBF).
C      - Corrected a bug in 2016-10-27 update: TAMDARB reports now get
C        proper report type 134/234 (were getting 131/231).
C      - Encode report subtype (TSB) of 1 for new Panasonic TAMDARB
C        reports (distinguishes them from legacy AirDAT TAMDAR BUFR
C        reports which had the default TSB value of 0).
C 2016-11-30  D. A. Keyser --
C      - Replace machine length lat/lon {HDR(3), HDR(2)} with R*8 lat/
C        lon (ALAT_8, ALON_8) in some print statements.
C        BENEFIT: Values are now precise to 10**5 degrees (was not the
C                 case after 2016-09-05 change above).
C
C
C USAGE:    CALL GETC06(NN,CYCLET,*,*)
C   INPUT ARGUMENT LIST:
C     NN       - UPPER-AIR FILE INDICATOR {=1 ADPUPA/RECCO; =2 MDCRS
C              - AIRCRAFT; =3 AIREP/PIREP, AMDAR, EAMDAR, TAMDAR(M/B),
C              - CAMDAR, KAMDAR AND AMDARB AIRCRAFT; =4 SATELLITE
C              - (CLOUD-DRIFT, W. VAPOR, VISIBLE, ETC)}
C     CYCLET   - CYCLE TIME (IN HOURS UTC, to fraction of an hr if
C                IDATMM non-zero)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GETC06(NN,CYCLET,*,*)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*8  STNID,CRES1,CRES2,SUBSET_d
      CHARACTER*11 CBULL
      LOGICAL  AIRLND,SWNLND,RECSLM,AIFNOW,FLRECO,WRMISS
      REAL P(100)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      INTEGER IDATA(MAXOBS),JNSTR(10,8),MOBS1(MXTYPV,MXWRDL),ISQNUM(4),
     $ ITIMES(4),INAC(9)
      COMMON/STRCTY/ICAT(MXLVL)
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/LNDSEA/GDSH(145,37),GDUS(362,91),GDNH(362,91)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/ACFTSW/AWINDO(2,9),AIRLND(6,9),JAWIND(6,9),JAMASS(6,9),
     $ IACFTL(9),IACFTH(9),PHIACF(7),KEPAC(6,9),AIFNOW(9),POAF,TRBX(5),
     $ FLACMS(9),PCAT,ROLF,aMSTQ,RIALR
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/PARM3/RECCON,RWINDO,UWINDO,RECSLM,FLRECO,VWINDO,VADWIN,
     $ IVADFL,IVADSP,FLDMGS,FLDMAF,FLDMFR,DROPSN,DWINDO,UPRAIR
      COMMON/SKPCNT/KSKPUA,KSKPSF,KMSGUA,KMSGSF,KBDYUA,KBDYSF,KTIMUA,
     $ KTIMSF,KSKNSW,KSKREC,KNOATS,KNTUPA,KNTCAR,KNTAIR,KNTSWN,KNTPRO,
     $ KNTVAD,KNTRAS,KNTDUM(3),KNTSFC,KNTSHP,KNTSLP,KNTMSO,KNTSPL,
     $ KSKSWN,KSKACF,KNDCDE(3),KSKCLS,KSKTHN,KSKOMR(2),KSKALM(9),
     $ KSKAHM(9),KSKNOW(9),KSKDRP
      COMMON/LFMSFC/LFMAXI,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,MARLND,
     $ JSURFM(12),JSURFW(12),FWINDO(12),PFRALT,npkrpt(12)
      COMMON/XTRHD2/CRES1,CRES2,CBULL
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE  (IDATA,RDATA)
      DATA INAC/0,1,1,3,4,5,1,1,4/
      DATA JNSTR/
C
C                   NESDIS/GOES-ODD               NESDIS/GOES-EVEN
C ---> NSW:  ---------------1------------- ---------------2-------------
C ---> IPD:   1  2  3  4  5  6  7  8  9 10  1  2  3  4  5  6  7  8  9 10
C                            W  W  S  S                    W  W  S  S
C             C  V  B  I  Z CT DL CT DL  P  C  V  B  I  Z CT DL CT DL  P
     $       -1,-1,-1, 5,11, 6, 7, 8, 9,15,-1,-1,-1, 5,11, 6, 7, 8, 9,15
C
C             INDIAN/INSAT/KALPANA(GEOST.)     JAPAN/GMS/MTSAT (GEOST.)
C ---> NSW:  ---------------3------------- ---------------4-------------
C ---> IPD:   1  2  3  4  5  6  7  8  9 10  1  2  3  4  5  6  7  8  9 10
C                            W  W  S  S                    W  W  S  S
C             C  V  B  I  Z CT DL CT DL  P  C  V  B  I  Z CT DL CT DL  P
     $,       1,16, 1,-1,-1,-1,-1,-1,-1,-1, 2,10, 2,-1,-1,-1,-1,-1,-1,-1
C
C              EUMETSAT/METEO-ODD (GEOST.)   EUMETSAT/METEO-EVEN(GEOST.)
C ---> NSW:  ---------------5------------- ---------------6-------------
C ---> IPD:   1  2  3  4  5  6  7  8  9 10  1  2  3  4  5  6  7  8  9 10
C                            W  W  S  S                    W  W  S  S
C             C  V  B  I  Z CT DL CT DL  P  C  V  B  I  Z CT DL CT DL  P
     $,       3,14, 3,-1,-1,-1,-1,-1,-1,-1, 3,14, 3,-1,-1,-1,-1,-1,-1,-1
C
C                NASA/MODIS AQUA (POES)       NASA/MODIS TERRA (POES)
C ---> NSW:  ---------------7------------- ---------------8-------------
C ---> IPD:   1  2  3  4  5  6  7  8  9 10  1  2  3  4  5  6  7  8  9 10
C                            W  W  S  S                    W  W  S  S
C             C  V  B  I  Z CT DL CT DL  P  C  V  B  I  Z CT DL CT DL  P
     $,      -1,-1,-1,17,-1,18,19,-1,-1,-1,-1,-1,-1,17,-1,18,19,-1,-1,-1
     $/

      DATA  XMISS/99999./,YMISS/99998.8/,LL0/0/,ITIMES/4*0/,ISQNUM/4*0/,
     $ IMISS/99999/
C FCNS PRS, PR CALC. PRESS. FROM ALT. FOR Z > 11000M, Z < 11000M; RESP
C  (U.S. STANDARD ATMOSPHERE)
      PRS(Z) = 226.3 * EXP(1.576106E-4 * (11000. - Z))
      PR(Z) = 1013.25 * (((288.15 - (.0065 * Z))/288.15)**5.256)
CWAS  PR(Z) = 1013.5 * (((288. - (.0065 * Z))/288.)**5.256)
C FCN PRE CALC. PRESS. FROM ALT. (FOR Z > 11000M), TEMPERATURE, AND AN
C  EXISTING PRESSURE AND ITS CORRESPONDING GEOPOTENTIAL HEIGHT
      PRE(PMND,TEMP,Z,ZMND)
     $ = PMND * (((TEMP - (.0065 * (Z - ZMND)))/TEMP)**5.256)
C FCNS BELOW CONVERT SAT./SPEC. HUM.(G/G) & PRESS(MB) INTO TEMP/TD(K)
      AS(Q,PPPP) = ALOG((Q * PPPP)/(6.1078 * ((0.378 * Q) + 0.622)))
      TFRMQP(Q,PPPP) = ((237.3 * AS(Q,PPPP))/(17.269-AS(Q,PPPP))+273.16)

      IF(ITIMES(NN).EQ.0)  THEN
C FOR FIRST CALL TO SUBR. FOR PARTICULAR UNIT NUMBER, INITIALIZE ISQNUM
C  (NOTE: FOR RECCOS IN NN=1, INITIALIZE WITH SEQ. NUMBER FROM LAST
C         REPORT PROCESSED FROM ADPUPA FILE IN SUBR. STOROB)
         ISQNUM(NN) = 0
         IF(NN.EQ.1.OR.NN.EQ.8)  ISQNUM(NN) = ISQNUM_UPA
         ITIMES(NN) = 1
      END IF
      IFLC6 = 0
      KLVL = IDATA(23)
C THE MAXIMUM NUMBER OF LEVELS PROCESSED IS MXLVL
      KLVL = MIN(KLVL,MXLVL)
C-----------------------------------------------------------------------
C    FOR ALL DATA LEVEL CAT. 6 TYPES CHECK FOR ZERO LEVELS OF DATA --
C    IF SO TOSS
C    FOR NON-AIRCRAFT RPTS CHECK FOR .GT. 1 LVL  OF DATA -- IF SO TOSS
C-----------------------------------------------------------------------
      IF(KLVL.LE.0)  THEN
         PRINT 950, STNID,RDATA(1),RDATA(2),IDATA(9)
  950 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NUMBER LEVELS = 0 IN GETC06')
         RETURN 2
      ELSE  IF(IDATA(9).NE.41.AND.KLVL.GT.1)  THEN
         PRINT 2951, STNID,RDATA(1),RDATA(2),IDATA(9)
 2951 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NUMBER OF LEVELS > 1 IN GETC06')
         RETURN 2
      END IF
C-----------------------------------------------------------------------
C IQMLIM IS PREPBUFR TABLE VALUE LIMIT FOR ACCEPTING REPORTS
C IQMGUD IS THE HIGHEST 'NON-REJECTED' PREPBUFR TABLE VALUE
      IQMLIM = 16
      IQMGUD = 3
C INITIALIZE CERTAIN VARIABLES TO AVOID COMPILER WARNINGS
      IPD = 1
      IBNDA = 1
      IBAND = 1
      NAC = 1
      NSW = 1
      IUS = 1
      IPPM= 99
      IGM = 99
      IPM = 99
      IZM = 99
      IQM = 99
      PP   = XMISS
      ZZ   = XMISS
      IF(IDATA(9).EQ.31)  THEN
C***********************************************************************
C                 CHECKS ON RECONNAISSANCE (R. TYPE 31)
C***********************************************************************
         INSTR = 2
C SET UP FOR LATER CHECK IF RECCO IS W/I TIME WINDOW (RWINDO)
         TIMWIN_e = -RWINDO * .01
         TIMWIN_l =  RWINDO * .01
C***********************************************************************
      ELSE  IF(IDATA(9).EQ.63)  THEN
C***********************************************************************
C      CHECKS ON SATELLITE (SATWND) MASS/WIND REPORTS (R. TYPE 63)
C***********************************************************************
C-----------------------------------------------------------------------
C DETERMINE RPT SUBTYPE (IBAND,NSW,IPD); WHERE:
C  IBAND IS LAT BAND INDEX
C  NSW IS DEFINED AS FOLLOWS:
C           =1-NESDIS/GOES-ODD;
C           =2-NESDIS/GOES-EVEN;
C           =3-INDIA/INSAT OR KALPANA - ALL SATS. (GEOSTATIONARY);
C           =4-JAPAN/GMS OR MTSAT -ALL SATS. or GOES-09 (GEOSTATIONARY);
C           =5-EUMETSAT/METEOSAT-ODD  (GEOSTATIONARY);
C           =6-EUMETSAT/METEOSAT-EVEN (GEOSTATIONARY);
C           =7-NASA/MODIS AQUA (POLAR-ORBITING);
C           =8-NASA/MODIS TERRA (POLAR-ORBITING)
C IPD IS DEFINED AS FOLLOWS:
C           = 1-CONVENTIONAL IR (LONG-WAVE) CLOUD DRIFT (CLOUD TOP);
C           = 2-CONVENTIONAL IMAGER WATER VPR (CLOUD TOP OR DEEP LAYER);
C           = 3-CONVENTIONAL VISIBLE CLOUD DRIFT (CLOUD TOP);
C           = 4-HIGH-DENSITY IR  (LONG-WAVE) CLOUD DRIFT (CLOUD TOP);
C           = 5-HIGH-DENSITY VISIBLE CLOUD DRIFT (CLOUD TOP);
C           = 6-HIGH-DENSITY IMAGER WATER VAPOR (CLOUD TOP);
C           = 7-HIGH-DENSITY IMAGER WATER VAPOR (DEEP LAYER);
C           = 8-HIGH-DENSITY SOUNDER WATER VAPOR (CLOUD TOP);
C           = 9-HIGH-DENSITY SOUNDER WATER VAPOR (DEEP LAYER);
C           =10-PICTURE TRIPLET CLOUD DRIFT
C-----------------------------------------------------------------------
C IDENTIFY LATITUDE (PHISWN) BAND INDEX ---> IBAND
         DO IBAND = 1,5
            IF(NINT(RDATA(1)*100.).LT.(NINT(PHISWN(IBAND+1)*100.)-0.5))
     $       GO TO 1700
         ENDDO
         IBAND = 6
 1700    CONTINUE
C.......................................................................
C IDENTIFY PRODUCT INDEX ---> IPD
C DETERMINED FROM CHARACTER IN POSITION 8 OF STN. ID AND FROM CLOUD
C  MASK INDICATOR
C
C   CHARACTER IN POSITION 8 OF STN. ID:
C        1 - 'C' ---> CONVENTIONAL IR (LONG-WAVE) CLOUD-DRIFT (ALWAYS
C                     CLOUD TOP)
C        2 - 'V' ---> CONVENTIONAL IMAGER WATER VAPOR (CLOUD TOP OR
C                     DEEP LAYER)
C        3 - 'B' ---> CONVENTIONAL VISIBLE CLOUD-DRIFT (ALWAYS CLD TOP)
C        4 - 'I' ---> HIGH-DENSITY IR (LONG-WAVE) CLOUD-DRIFT (ALWAYS
C                     CLOUD TOP)
C        5 - 'Z' ---> HIGH-DENSITY VISIBLE CLOUD-DRIFT (ALWAYS CLD TOP)
C        6 - 'W' ---> HIGH-DENSITY IMAGER WATER VAPOR (CLOUD TOP)
C        7 - 'W' ---> HIGH-DENSITY IMAGER WATER VAPOR (DEEP LAYER)
C        8 - 'T' ---> HIGH-DENS SOUNDER BAND 10 WATER VAPOR (CLOUD TOP)
C            'L' ---> HIGH-DENS SOUNDER BAND 11 WATER VAPOR (CLOUD TOP)
C        9 - 'T' ---> HIGH-DENS SOUNDER BAND 10 WATER VAPOR (DEEP LAYER)
C            'L' ---> HIGH-DENS SOUNDER BAND 11 WATER VAPOR (DEEP LAYER)
C       10 - 'P' ---> PICTURE TRIPLET CLOUD DRIFT
C
C   CLOUD MASK INDICATOR (STORED IN BYTE 3 OF HEADER RESERVE CHARACTER
C    WORD 5):
C            '9' ---> MISSING - REVERTS TO CLOUD TOP
C            '1' ---> DEEP LAYER MEAN
C            '2' ---> CLOUD TOP
C
         IF(STNID(8:8).EQ.'V') THEN
            IPD = 2
         ELSE  IF(STNID(8:8).EQ.'B') THEN
            IPD = 3
         ELSE  IF(STNID(8:8).EQ.'I') THEN
            IPD = 4
         ELSE  IF(STNID(8:8).EQ.'Z') THEN
            IPD = 5
         ELSE  IF(STNID(8:8).EQ.'W') THEN
            IF(CRES1(3:3).NE.'1')  THEN
               IPD = 6
            ELSE
               IPD = 7
            END IF
         ELSE  IF(STNID(8:8).EQ.'T'.OR.STNID(8:8).EQ.'L') THEN
            IF(CRES1(3:3).NE.'1')  THEN
               IPD = 8
            ELSE
               IPD = 9
            END IF
         ELSE  IF(STNID(8:8).EQ.'P') THEN
            IPD = 10
         END IF
C.......................................................................
C IDENTIFY PRODUCER/SATELLITE INDEX ---> NSW
C DETERMINED FROM CHARACTER IN POSITION 1 OF STN. ID
C  POS. 1 STNID:'A','C'--> GOES-ODD SAT
C               'B','D'--> GOES-EVEN SAT
C               'W','Y'--> METEOSAT-ODD SAT (GEOSTATIONARY)
C               'X','Z'--> METEOSAT-EVEN SAT (GEOSTATIONARY)
C               'K' -----> KALPANA-ALL SAT (GEOSTATIONARY)
C               'V' -----> INSAT-ALL SAT (GEOSTATIONARY)
C               'P','R'--> GMS/MTSAT-EVEN SAT or GOES-09 (GEOSTATIONARY)
C               'O','Q'--> GMS/MTSAT-ODD SAT (GEOSTATIONARY)
C               'U' -----> AQUA SAT (POLAR-ORBITING)
C               'T' -----> TERRA SAT (POLAR-ORBITING)
         NSW = 0
         IF(STNID(1:1).EQ.'A'.OR.STNID(1:1).EQ.'C')  THEN
            NSW = 1
         ELSE  IF(STNID(1:1).EQ.'B'.OR.STNID(1:1).EQ.'D')  THEN
            NSW = 2
         ELSE  IF(STNID(1:1).EQ.'W'.OR.STNID(1:1).EQ.'Y')  THEN
            NSW = 5
         ELSE  IF(STNID(1:1).EQ.'X'.OR.STNID(1:1).EQ.'Z')  THEN
            NSW = 6
         ELSE  IF(STNID(1:1).GE.'O'.AND.STNID(1:1).LE.'R')  THEN
            NSW = 4
         ELSE  IF(STNID(1:1).EQ.'V'.OR.STNID(1:1).EQ.'K')  THEN
            NSW = 3
         ELSE  IF(STNID(1:1).EQ.'U')  THEN
            NSW = 7
         ELSE  IF(STNID(1:1).EQ.'T')  THEN
            NSW = 8
         END IF
C.......................................................................
         IF(NSW.EQ.0)  THEN
C THIS RPT'S PRODUCER/SAT. COMB. IS NOT VALID - SKIP IT (BUT KEEP COUNT)
            PRINT 954, STNID,RDATA(1),RDATA(2),IDATA(9)
  954 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRODUCER/SAT COMBINATION INVALID')
            KSKNSW = KSKNSW + 1
            RETURN 2
         END IF
C.......................................................................
         INSTR = JNSTR(IPD,NSW)
         IF(INSTR.LT.0)  THEN
C THIS REPORT DOESN'T HAVE A PREPBUFR REPORT TYPE ASSOCIATED WITH ITS
C  PRODUCER/SATELLITE/PRODUCT COMBINATION - SKIP IT (BUT KEEP COUNT)
            PRINT 955, STNID,RDATA(1),RDATA(2),IDATA(9)
  955 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NO R. TYPE FOR PRODUCER/SAT/PROD ',
     $ 'COMBINATION')
            KSKNSW = KSKNSW + 1
            RETURN 2
         END IF
C-----------------------------------------------------------------------
C KEEP/EXCLUDE RPT BASED ON: PROCESS NEITHER MASS NOR WIND; LAND/OCEAN;
C  TIME WINDOW: ARRAY (IBAND,NSW,IPD); IBAND, NSW, IPD AS DEFINED ABOVE
C-----------------------------------------------------------------------
C CHECK IF NEITHER MASS NOR WIND DATA FROM THIS TYPE IS TO BE PROCESSED
         IF(JSWIND(IBAND,NSW,IPD).EQ.9999.AND.JSMASS(IBAND,NSW,IPD).EQ.
     $    9999)  THEN
            KSKSWD(IPD) = KSKSWD(IPD) + 1
            RETURN 2
         ELSE  IF(JSWIND(IBAND,NSW,IPD).EQ.0.OR.JSMASS(IBAND,NSW,IPD)
     $    .EQ.0)  THEN
         ELSE
            IF(JSWIND(IBAND,NSW,IPD).EQ.99.OR.
     $       JSMASS(IBAND,NSW,IPD).EQ.99)  THEN
               IFLC6 = 1
            ELSE  IF(JSWIND(IBAND,NSW,IPD).EQ.299.OR.
     $       JSMASS(IBAND,NSW,IPD).EQ.299)  THEN
               IF(STNID(1:1).EQ.'C'.OR.STNID(1:1).EQ.'D'.OR.
     $            STNID(1:1).EQ.'Y'.OR.STNID(1:1).EQ.'Z')  IFLC6 = 1
            ELSE  IF(JSWIND(IBAND,NSW,IPD).EQ.199.OR.
     $       JSMASS(IBAND,NSW,IPD).EQ.199)  THEN
               IF(STNID(1:1).EQ.'A'.OR.STNID(1:1).EQ.'B'.OR.
     $            STNID(1:1).EQ.'W'.OR.STNID(1:1).EQ.'X')  IFLC6 = 1
            END IF
         END IF
C SPECIAL CHECK ON INDIAN SATWNDS: ON RARE OCCASIONS LATITUDE IS MIS-
C  PROCESSED PLACING RPT IN ARCTIC RGN -- SKIP RPTS W/ LAT > 40 DEG. N
         IF(NSW.EQ.3.AND.NINT(RDATA(1)*100.).GT.4000)  THEN
            PRINT 5952, STNID,RDATA(1),RDATA(2),IDATA(9)
 5952 FORMAT(' * * INDIAN SATWIND TOSSED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - LATITUDE MISPLACED')
            RETURN 2
         END IF
C TEST FOR OVERLAND SATWND REPORTS
         IF(.NOT.SWNLND(IBAND,NSW,IPD))  THEN
C CALL SUBR. LNDCHK TO SEE IF RPT SATISFIES OVER LAND CRITERIA
            IF(NINT(RDATA(1)*100.).LT.0)  THEN
              CALL LNDCHK(RDATA(1),RDATA(2),1,4,2,GDSH,145,37,0.5,ILAND)
            ELSE
              CALL LNDCHK(RDATA(1),RDATA(2),1,4,2,GDNH,362,91,0.5,ILAND)
            END IF
            IF(ILAND.NE.0)  THEN
C RPT SATISFIES OVER LAND CRITERIA PROCESS BUT FLAG ALL VARIABLES W/
C  PREPBUFR TABLE VALUE OF 15
             IF(IPRINT.EQ.0) PRINT 1956,STNID,RDATA(1),RDATA(2),IDATA(9)
 1956 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVER LAND SATWIND REPORT')
               IF(IFLC6.EQ.0)  KSKSWN = KSKSWN + 1
               IFLC6 = 1
            END IF
         END IF
C SET UP FOR LATER CHECK IF SAT. REPORT IS WITHIN TIME WINDOW
C  {SWINDO_e(IBAND,NSW,IPD) - EARLIEST TIME WINDOW RELATIVE TO CYCLE
C  TIME FOR ACCEPTING REPORTS; SWINDO_l(IBAND,NSW,IPD) - LATEST TIME
C  WINDOW RELATIVE TO CYCLE TIME FOR ACCEPTING REPORTS}
         TIMWIN_e = SWINDO_e(IBAND,NSW,IPD) * .01
         TIMWIN_l = SWINDO_l(IBAND,NSW,IPD) * .01
C***********************************************************************
      ELSE
C***********************************************************************
C CHECKS ON ACFT FLT-LVL (AIREP/PIREP, AMDAR, EAMDAR, MDCRS,
C  TAMDAR(M/B), CAMDAR, KAMDAR, AMDARB) RPTS (R. TYPE 41)
C***********************************************************************
C-----------------------------------------------------------------------
C DETERMINE AIRCRAFT FLIGHT-LEVEL TYPE (IBNDA,NAC); WHERE: IBNDA IS LAT
C              BAND INDEX AND NAC IS DEFINED AS FOLLOWS:
C   {=1-AIREP/PIREP-PRESET!; =2-AMDAR; =3-EAMDAR; =4-MDCRS; =5-TAMDARM;
C    =6-CAMDAR; =7-KAMDAR; =8-AMDARB; =9-TAMDARB}
C-----------------------------------------------------------------------
C IDENTIFY LATITUDE (PHIACF) BAND INDEX ---> IBNDA
         DO IBNDA = 1,5
            IF(NINT(RDATA(1)*100.).LT.(NINT(PHIACF(IBNDA+1)*100.)-0.5))
     $       GO TO 6700
         ENDDO
         IBNDA = 6
 6700    CONTINUE
C.......................................................................
C IDENTIFY AIRCRAFT TYPE INDEX ---> NAC
         IF(IDATA(10).EQ.3)  THEN
            NAC = 2
         ELSE  IF(IDATA(10).EQ.6)  THEN
            NAC = 3
         ELSE  IF(IDATA(10).EQ.8.OR.IDATA(10).EQ.12.OR.IDATA(10).EQ.13)
     $    THEN
            NAC = 5
         ELSE  IF(IDATA(10).EQ.9)  THEN
            NAC = 6
         ELSE  IF(IDATA(10).EQ.11)  THEN
            NAC = 7
         ELSE  IF(IDATA(10).EQ.103)  THEN
            NAC = 8
         ELSE  IF(IDATA(10).EQ.10)  THEN
            NAC = 9
         ELSE  IF(NN.EQ.2)  THEN
            NAC = 4
         END IF
C-----------------------------------------------------------------------
C     DETERMINE AIRCRAFT GEOGRAPHICAL LOCATION, IUS (=1-OUTSIDE US
C    MAINLND/WATER SURROUDNING USA/SO. ONTARIO - PRESET!; =2-INSIDE THIS REGION)
C-----------------------------------------------------------------------
         IF(NINT(RDATA(1)*100.).GE.0)  THEN
            CALL LNDCHK(RDATA(1),RDATA(2),2,4,2,GDUS,362,91,0.5,ILAND)
            IF(ILAND.NE.0)  IUS = 2
         END IF
C-----------------------------------------------------------------------
C KEEP OR EXCLUDE ACFT RPT BASED ON: 0 LVL CHK; PROCESS NEITHER MASS NOR
C  WIND; AND LAND/OCEAN {ARRAY(IBNDA,NAC)}; ALSO BASED ON TIME WINDOW
C {ARRAY(IUS,NAC)} -- (IBNDA IS LAT BAND; NAC IS RPT SUBTYPE; IUS IS
C                        GEOGRAPHICAL LOCATION)
C      (AIREP/PIREP RPTS OVER U.S. MAINLAND MAY BE EXCLUDED)
C   MAY ALSO EXCLUDE ACFT TYPES BELOW USER-SPECIFIED PRESSURE ALTITUDE
C   MAY ALSO EXCLUDE ACFT TYPES ABOVE USER-SPECIFIED PRESSURE ALTITUDE
C   MAY ALSO EXCLUDE ACFT TYPES IF MASS DATA AVAILABLE BUT WIND DATA MSG
C-----------------------------------------------------------------------
C CHECK IF NEITHER MASS NOR WIND DATA FROM THIS TYPE IS TO BE PROCESSED
         IF(JAWIND(IBNDA,NAC).NE.0.AND.JAMASS(IBNDA,NAC).NE.0)  RETURN 2
C SET UP FOR LATER CHK IF ACFT. RPT IS W/I TIME WINDOW {AWINDO(IUS,NAC)}
         TIMWIN_e = -AWINDO(IUS,NAC) * .01
         TIMWIN_l =  AWINDO(IUS,NAC) * .01
         INSTR = INAC(NAC)
C TEST FOR OVERLAND AIRCRAFT REPORTS
         IF(.NOT.AIRLND(IBNDA,NAC))  THEN
C CALL SUBR. LNDCHK TO SEE IF RPT SATISFIES OVER LAND CRITERIA
            IF(NINT(RDATA(1)*100.).LT.0)  THEN
              CALL LNDCHK(RDATA(1),RDATA(2),1,4,2,GDSH,145,37,0.5,ILAND)
            ELSE
              CALL LNDCHK(RDATA(1),RDATA(2),1,4,2,GDNH,362,91,0.5,ILAND)
            END IF
            IF(ILAND.NE.0)  THEN
C RPT SATISFIES OVER LAND CRITERIA PROCESS BUT FLAG ALL VARIABLES W/
C  PREPBUFR TABLE VALUE OF 15
             IF(IPRINT.EQ.0) PRINT 2355,STNID,RDATA(1),RDATA(2),IDATA(9)
 2355 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVER LAND AIRCRAFT REPORT')
               IF(IFLC6.EQ.0)  KSKACF = KSKACF + 1
               IFLC6 = 1
            END IF
         END IF
         IF(IDATA(23).EQ.1)  THEN
            IF(NINT(RDATA(IDATA(24)+1)).LT.IACFTL(NAC))   THEN
C REPORT HAS PRESSURE ALTITUDE LESS THAN 'IACFTL(NAC)' METERS
C   PROCESS BUT FLAG ALL VARIABLES WITH PREPBUFR TABLE VALUE OF 15
               IF(IPRINT.EQ.0)  PRINT 2455, STNID,RDATA(1),RDATA(2),
     $          IDATA(9),NINT(RDATA(IDATA(24)+1)),IACFTL(NAC)
 2455 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESSURE-ALT(',I5,'M) <',I5,'M')
               IF(IFLC6.EQ.0)  KSKALM(NAC) = KSKALM(NAC) + 1
               IFLC6 = 1
            ELSE  IF(NINT(RDATA(IDATA(24)+1)).GT.IACFTH(NAC))   THEN
C REPORT HAS PRESSURE ALTITUDE GREATER THAN 'IACFTH(NAC)' METERS
C   PROCESS BUT FLAG ALL VARIABLES WITH PREPBUFR TABLE VALUE OF 15
               IF(IPRINT.EQ.0)  PRINT 3455, STNID,RDATA(1),RDATA(2),
     $          IDATA(9),NINT(RDATA(IDATA(24)+1)),IACFTH(NAC)
 3455 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PRESSURE-ALT(',I5,'M) > ',I5,'M')
               IF(IFLC6.EQ.0)  KSKAHM(NAC) = KSKAHM(NAC) + 1
               IFLC6 = 1
            END IF
            IF(.NOT.AIFNOW(NAC))  THEN
            IF(MAX(RDATA(IDATA(24)+4),RDATA(IDATA(24)+5)).GE.YMISS) THEN
C RPT HAS MISSING WIND BUT MAY HAVE VALID MASS DATA, AND AIFNOW(NAC)=F
C   PROCESS BUT FLAG ALL VARIABLES W/ PREPBUFR TABLE VALUE OF 15
              IF(IPRINT.EQ.0)PRINT 2855,STNID,RDATA(1),RDATA(2),IDATA(9)
 2855 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - WIND DIRECTION AND/OR SPEED MISSG')
                  IF(IFLC6.EQ.0)  KSKNOW(NAC) = KSKNOW(NAC) + 1
                  IFLC6 = 1
               END IF
            END IF
         END IF
      END IF
C***********************************************************************
C***********************************************************************
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMUA = KTIMUA + 1
         RETURN 2
      END IF
C CURRENTLY ONLY RECCOS AND AIRCRAFT (ALL TYPES) NEED TO EXAMINE DATA
C  LEVEL CAT. 8
      ICF351 = 0
      ICF352 = 0
      JCF914 = 0
      ICF914 = 0
      POAF   = XMISS
      ROLF   = XMISS
      RIALR  = XMISS
      PCAT   = XMISS
      TRBX   = XMISS
      aMSTQ  = XMISS
      RFFL   = XMISS
      QIFY   = XMISS
      QIFN   = XMISS
      EEQF   = XMISS
      IWM_RFFL = IMISS
      AMANDZ = XMISS
      AMANDP = XMISS
      AMSLPR = XMISS
      IF(IDATA(27).GT.0)  THEN
         L = IDATA(28) - 4
         DO I = 1,IDATA(27)
            L = L + 4
            IF(NINT(RDATA(L+1)).EQ.914)  THEN
               IF(RDATA(L).LT.YMISS) THEN
                  JCF914 = 1
                  IF(NINT(RDATA(L)).EQ.7)  ICF914 = 1
                  POAF = RDATA(L)
               END IF
               CYCLE
            ELSE  IF(NINT(RDATA(L+1)).EQ.915)  THEN
               IF(RDATA(L).LT.YMISS)  PCAT = RDATA(L) * 0.01
            ELSE IF(NINT(RDATA(L+1)).GE.926.AND.NINT(RDATA(L+1)).LE.930)
     $       THEN
               IF(RDATA(L).LT.YMISS) TRBX(NINT(RDATA(L+1))-925)=RDATA(L)
               CYCLE
            ELSE  IF(NINT(RDATA(L+1)).EQ.931)  THEN
               IF(RDATA(L).LT.YMISS)  ROLF = RDATA(L)
               CYCLE
            ELSE  IF(NINT(RDATA(L+1)).EQ.932)  THEN
               IF(RDATA(L).LT.YMISS)  RIALR = RDATA(L) * 0.001
               CYCLE
            ELSE  IF(NINT(RDATA(L+1)).EQ.351)  THEN
               IF(MAX(RDATA(L),RDATA(L+2)).LT.YMISS)  THEN
                  ICF351 = 1
                  AMANDZ = RDATA(L)
                  AMANDP = RDATA(L+2)
                  AMNDZQ = RDATA(L+3)
               END IF
               CYCLE
            ELSE IF(NINT(RDATA(L+1)).EQ.352)  THEN
               IF(RDATA(L).LT.YMISS)  THEN
                  ICF352 = 1
                  AMSLPR = RDATA(L)
               END IF
               CYCLE
            ELSE IF(NINT(RDATA(L+1)).EQ.355)  THEN
               IF(RDATA(L).LT.YMISS)  THEN
C USE RFF TO SET WIND Q. MARK FOR NESDIS/GOES AND NASA/POES MODIS WINDS
                  RFFL = RDATA(L)
                  IF(NSW.EQ.1.OR.NSW.EQ.2.OR.NSW.EQ.7.OR.NSW.EQ.8) THEN
                     IF(NINT(RFFL).GT.84)  THEN
                        IWM_RFFL = 1
                     ELSE  IF(NINT(RFFL).GT.55)  THEN
                        IWM_RFFL = 2
                     ELSE  IF(NINT(RFFL).GT.49)  THEN
                        IWM_RFFL = 3
                     ELSE
                        IWM_RFFL = 13
                     END IF
                  END IF
               END IF
               CYCLE
            ELSE IF(NINT(RDATA(L+1)).EQ.356)  THEN
               IF(RDATA(L).LT.YMISS)  QIFY = RDATA(L)
               CYCLE
            ELSE IF(NINT(RDATA(L+1)).EQ.357)  THEN
               IF(RDATA(L).LT.YMISS)  QIFN = RDATA(L)
               CYCLE
            ELSE IF(NINT(RDATA(L+1)).EQ.358)  THEN
               IF(RDATA(L).LT.YMISS)  EEQF = RDATA(L)
               CYCLE
            END IF
         ENDDO
         IF(JCF914.EQ.0)  ICF914 = 1
      END IF

      IF(OBS2(42).LT.YMISS) aMSTQ = OBS2(42)

C FLRECO = TRUE MEANS THIS REPORT IS A RECCO WITH EITHER A MANDATORY
C  LEVEL GEOPOTENTIAL OR A MEAN SEA-LEVEL PRESSURE OBS INCLUDED (CAN
C  HAVE RECCOS WITH NEITHER OF THESE ADDITIONAL OBS, IN THIS CASE
C  FLRECO REMAINS FALSE)
      FLRECO = (ICF351.EQ.1.OR.ICF352.EQ.1)

      IF(NN.EQ.3)  THEN
C FOR AIREP/PIREP, AMDAR, EAMDAR, TAMDAR(M/B), CAMDAR, KAMDAR AND
C   AMDARB AIRCRAFT, STORE WORD 8 OF REPORT HEADER (REPORT "SUBTYPE")
C   AS FOLLOWS:
C   - DEFAULT IS HDR(8) = 0
C   - IF AMDAR, EAMDAR OR CAMDAR AND PHASE OF FLIGHT INDICATOR IS 7
C      (MEANING AIRCRAFT IS "BANKING") STORE HDR(8) = 2 (ABOVE,
C       ICF914=1)
C   - IF AMDAR, EAMDAR OR CAMDAR AND PHASE OF FLIGHT INDICATOR IS
C      MISSING (MEANING AIRCRAFT IS LIKELY "BANKING")
C      STORE HDR(8) = 2 (ABOVE, ICF914=1)
C   - IF AIREP/PIREP AND SOURCE OF REPORT IS AFWA STORE HDR(8) = 1
C   - IF TAMDARB STORE HDR(8) = 1
         HDR(8) = 0.
         IF(NAC.EQ.2.OR.NAC.EQ.3.OR.NAC.EQ.6)  THEN
            IF(ICF914.EQ.1)  HDR(8) = 2.
         ELSE  IF(NAC.EQ.1)  THEN
            IF(CRES2(1:1).EQ.'C')  HDR(8) = 1.
         ELSE  IF(NAC.EQ.9)  THEN
            HDR(8) = 1.
         END IF
      ELSE  IF(NN.EQ.1.OR.NN.EQ.8)  THEN
C STORE WORD 8 OF REPORT HEADER (REPORT "SUBTYPE") AS 1 FOR RECCOS
C  (STORED AS 2 FOR DROPS IN SUBR. PREP)
         IF(IDATA(9).EQ.31)  HDR(8) = 1.
      ELSE  IF(NN.EQ.4)  THEN
C STORE WORD 8 OF REPORT HEADER (REPORT "SUBTYPE") AS:
C   BUFR SATELLITE ID TIMES 10 PLUS "SATELLITE DERIVED WIND COMPUTATION
C   METHOD ("SWCM" - BUFR CODE TABLE 0-02-023) FOR ALL SATELLITE-
C   DERIVED WIND TYPES
         SWCM = 0
         IF(CRES1(3:3).EQ.'1')  THEN
            SWCM = 5 ! WV IMAGER/SOUNDER DEEP-LAYER
         ELSE
            IF(IPD.EQ.1.OR.IPD.EQ.4)  THEN
               SWCM = 1 ! IR
            ELSE IF(IPD.EQ.2.OR.IPD.EQ.6.OR.IPD.EQ.8)  THEN
               SWCM = 3 ! WV IMAGER/SOUNDER CLOUD-TOP
            ELSE IF(IPD.EQ.3.OR.IPD.EQ.5)  THEN
               SWCM = 2 ! VISIBLE
            ELSE IF(IPD.EQ.10)  THEN
               SWCM = 4 ! PICTURE-PAIR OR PICTURE-TRIPLET
            END IF
         END IF
         SAID = MIN(HDR(15),999.)
         HDR(8) = SAID*10. + SWCM
      END IF
C***********************************************************************
C    CONVERT PRESSURE ALTITUDE TO PRESSURE (VIA U.S. STD. ATMOS. EST.)
C***********************************************************************
C PRESSURE INITIALIZED AS MISSING
      P = XMISS
      DO K = 1,KLVL
         L = (9 * (K - 1)) + IDATA(24)
         IF(RDATA(L).LT.YMISS)  P(K) = RDATA(L) * 0.1
         ZZZ = NINT(RDATA(L+1))
         IF(ZZZ.LT.XMISS.AND.P(K).GE.XMISS)  THEN
cfix?    IF(ZZZ.LT.YMISS.AND.P(K).GE.YMISS)  THEN
C IF DATA LEVEL CAT. 6 PRESSURE IS MISSING, MUST CALC. IT FROM P-ALT.
            IF(NINT(ZZZ).LE.11000)  THEN
               P(K) = PR(ZZZ)
            ELSE
               P(K) = PRS(ZZZ)
            END IF
         END IF
         IF(P(K).GE.XMISS)  THEN
cfix?    IF(P(K).GE.YMISS)  THEN
C IF PRESSURE ON ANY LVL IS MSG SKIP THIS TOT. RPT (ASSUMES ONLY 1 LVL)
            PRINT 2959, STNID,alat_8,alon_8,IDATA(9),K
 2959 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - PRESS ON LEVEL',I3,' IS MISSING')
            RETURN 2
         END IF
      ENDDO
C***********************************************************************
C UNPACKED RPT SUCCESSFULLY PASSED ALL PRELIMINARY CHECKS - CONTINUE ON
C***********************************************************************
      KOUNT = KOUNT + 1
      ISQNUM(NN) = ISQNUM(NN) + 1
C GET R. TYPE (SET UP WITH '2' AS 1ST DIGIT, LIKE FOR WIND PIECE)
      NHDR6 = ((ISEL(IDATA(9)) + 20) * 10) + INSTR
C***********************************************************************
C                  FILL IN MASS INFORMATION FOR REPORT
C***********************************************************************
C 'ICALLM' INDICATES WHETHER MASS PIECE STORED IN OUTPUT FILE {IF SO =1;
C  IF NOT = -99 (NOT PROCESSED) OR = -1 (MSG. TEMP) OR = 0 (BAD TEMP)}
      ICALLM = -99
C SKIP MASS REPORT: IF ACFT & JAMASS(IBNDA,NAC) = 9999;
C                   IF SATWND(ALL TYPES) & JSMASS(IBAND,NSW,IPD) = 9999;
C                   IF FLRECO = F AND RECSLM = F
      IF((IDATA(9).EQ.41.AND.JAMASS(IBNDA,NAC).NE.0)
     $ .OR.(IDATA(9).EQ.63.AND.JSMASS(IBAND,NSW,IPD).EQ.9999)
     $ .OR.(IDATA(9).EQ.31.AND..NOT.FLRECO.AND..NOT.RECSLM)) GO TO 1900
      NI  = MOD((NHDR6/10),10)
      IF(NI.EQ.5.AND.NHDR6.NE.251)  THEN
C THIS MASS REPORT DOESN'T HAVE A PREPBUFR REPORT TYPE ASSOCIATED WITH
C  ITS PRODUCER/SATELLITE/PRODUCT COMBINATION - SKIP IT
         PRINT 7955, STNID,RDATA(1),RDATA(2),IDATA(9)
 7955 FORMAT(' # # MASS REPORT TOSSED   -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NO R. TYPE FOR PRODUCER/SAT/PROD ',
     $ 'COMBINATION')
         GO TO 1900
      END IF
      ICALLM = 0
C IGOODT INDICATES AT LEAST 1 LVL WITH VALID TEMP FOUND (=0 NO; =1 YES)
      IGOODT = 0
C GET PREPBUFR REPORT TYPE
      HDR(6) = NHDR6 - 100
      IF(NHDR6.EQ.251)  HDR(6) = 144
      LL = 0
C INITIALIZE BOTTOM TWO LEVELS OF MOBS ARRAY (NEED TWO LEVELS IN CASE
C  FLRECO = TRUE)
      MOBS(1:MXTYPV,1:MXWRDL,1:2) = IMISS
C INITIALIZE BOTTOM TWO LEVELS OF ICAT ARRAY
      ICAT(1:2) = IMISS
      IF(FLRECO)  THEN
C-----------------------------------------------------------------------
C       RECCOS WITH EITHER REPORTED MANDATORY LEVEL GEOPOTENTIAL
C             OR WITH REPORTED MEAN SEA-LEVEL PRESSURE
C-----------------------------------------------------------------------
         ICALLM = 1
         IGOODT = 1
         IF(ICF351.EQ.1)  THEN
C.......................................................................
C           RECCOS WITH REPORTED MANDATORY LEVEL GEOPOTENTIAL
C WILL GENERATE A CATEGORY 1 MOBS MASS DATA LEVEL WITH PRESSURE AND HGHT
C.......................................................................
            JCAT = 1
C STORE PRESSURE AND HEIGHT OBS INTO PP AND ZZ
            PP = AMANDP
            ZZ = AMANDZ
C STORE PRESSURE AND HEIGHT PREPBUFR TABLE VALUES
            IPPM = 2
            IGM  = NINT(AMNDZQ)
         ELSE
C.......................................................................
C             RECCOS WITH REPORTED MEAN SEA-LEVEL PRESSURE
C WILL GENERATE A CATEGORY 2 MOBS MASS DATA LEVEL WITH PRESSURE AND HGHT
C (CAT. 2 DATA LEVEL IS SURFACE, PRESS=PMSL=PSTN AND HGHT=0 AT SEA-LVL)
C.......................................................................
            JCAT = 2
C STORE PRESSURE AND HEIGHT OBS INTO PP AND ZZ
            PP = NINT(AMSLPR)/10.
            ZZ = 0.
C STORE PRESSURE AND HEIGHT PREPBUFR TABLE VALUES
            IPPM = 2
            IGM  = 2
            IF(JSURFM(5).EQ.0)  THEN
C FLAG PRESSURE AND HEIGHT ON THIS CAT. 2 MOBS LEVEL
C  SINCE THIS DATA IS LATER PROCESSED AS A SPLASH-LEVEL SURFACE REPORT
C  (PREPBUFR REPORT TYPE 182) (SUBSEQUENT OIQC PROGRAM DOESN'T CHECK SFC
C  PRESSURE FOR PREPBUFR REPORT TYPE 132 BUT DOES CHECK IT FOR PREPBUFR
C  REPORT TYPE 182 - EVEN IF GOOD DON'T WANT REDUNDANCY)
               IF(IPPM.LE.3.OR.IPPM.GT.15) IPPM = 15
               IF(IGM .LE.3.OR.IGM .GT.15) IGM  = 15
               PRINT 6495, STNID,RDATA(1),RDATA(2),IDATA(9)
 6495 FORMAT(' * * RECONNAISSANCE W/PMSL-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - SFC P,Z FLAGGED; PROCESSED LATER',
     $ ' AS R.TYPE 182')
            END IF
C IF PRESSURE IS MISSING OR UNREASONABLE, SKIP PROCESSING OF TOTAL RPT
            IF(PP.LT.938.25.OR.PP.GT.1063.25.OR.IPPM.GE.IQMLIM)  THEN
               KOUNT = KOUNT - 1
             IF(IPRINT.EQ.0) PRINT 3989,STNID,RDATA(1),RDATA(2),IDATA(9)
 3989 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - INVALID PSTN FOR RECCO REPORT')
               RETURN 2
            END IF
C.......................................................................
         END IF
         LL = LL + 1
C STORE PRESSURE OBS (*10 MB) IN WORD 1 OF MOBS MASS LEVEL
         MOBS(1,1,LL) = NINT(PP * 10.)
         ICAT(LL) = JCAT
         IF(IFLC6.EQ.1)  THEN
            IF(IPPM.LE.3.OR.IPPM.GT.15) IPPM = 15
            IF(IGM .LE.3.OR.IPPM.GT.15) IGM  = 15
         END IF
C STORE P,Z PREPBUFR TABLE VALUES IN WORDS 1-2 OF MOBS MASS LEVEL
         MOBS(2,1,LL) = IPPM
         MOBS(2,2,LL) = IGM
C STORE GEOPOTENTIAL OBS (METERS) IN WORD 2 OF MOBS MASS LEVEL
         IF(IGM.LT.IQMLIM)  MOBS(1,2,LL) = NINT(ZZ)
      END IF
C-----------------------------------------------------------------------
C   STORE MASS DATA INTO CATEGORY 6 MOBS DATA LEVEL (ASSUMES KLVL = 1)
C-----------------------------------------------------------------------
      DO KM = 1,KLVL
         JT = 32767
         LL = LL + 1
         L = (9 * (KM - 1)) + IDATA(24)
         ZZZ = NINT(RDATA(L+1))
C FILL IN PREPBUFR TABLE VALUES
         IZM = NINT(RDATA(L+7))
         ITM = NINT(RDATA(L+8))
         IQM = NINT(RDATA(L+9))
         IF(IDATA(9).EQ.63)  THEN
            IWM = NINT(RDATA(L+10))
            IF(IWM_RFFL.LT.IMISS.AND.IWM.EQ.2)  IWM = IWM_RFFL
C FOR SATWND REPORTS, A REJECT, PURGE, OR FAIL FLAG ON WIND IS
C  TRANSFERRED TO HEIGHT (LATER PRESSURE), TEMPERATURE AND MOISTURE
            IF(IWM.GT.11)   THEN
               IZM = IWM
               ITM = IWM
               IQM = IWM
            END IF
         END IF
         IPM = IZM
C PROCESS NON-MISSING TEMP REGARDLESS OF PREPBUFR TABLE VALUE
         IF(ITM.LT.IQMLIM.AND.RDATA(L+2).LT.YMISS)  THEN
            IGOODT = 1
            JT = NINT((RDATA(L+2)/10.) *  100.0)
            IF(JT.GE.32767)  GO TO 15
C STORE REPORTED (SENSIBLE) TEMP OBS (*100 DEG. C) IN WORD 3 OF MOBS
C  MASS LEVEL (UNLESS FLRECO = TRUE AND RECSLM = FALSE)
            IF(RECSLM.OR..NOT.FLRECO)  MOBS(1,3,LL) = JT
            IF(FLRECO.OR.NN.EQ.2.OR.NN.EQ.3)  THEN
C PROCESS NON-MISSING MOISTURE FOR AIRCRAFT (ALL TYPES) OR FLRECO = TRUE
C  (NOTE: HERE INPUT MOISTURE VARIABLE IS SPEC. HUMIDITY IN G/KG)
               IF(RDATA(L+3).LE.9999.)  THEN
                  IF(IQM.LT.IQMLIM.AND.RDATA(L+3).GE.0)  THEN
                     Q  = RDATA(L+3) * 0.001 ! SPEC. HUM. IN G/G
                     INTQ = NINT(Q*1.E6)
                     IF(INTQ.EQ.0)  INTQ = 1
                     DP = TFRMQP(Q,P(KM))
                     TMPCEL = (DP - 273.16) * 100.
                     IF(RECSLM.OR.NN.EQ.2)  THEN
C STORE SPEC HUMIDITY OBS (*10**6 G/G) IN WORD 4 OF MOBS MASS LEVEL
C  {MUST BE < IMISS (99999) AND > 0} (UNLESS FLRECO = TRUE AND RECSLM =
C  FALSE)
                        IF(INTQ.GT.0.AND.INTQ.LT.IMISS)MOBS(1,4,LL)=INTQ
C STORE DEWPOINT TEMP OBS (*100 DEG. C) IN WORD 6 OF MOBS MASS LEVEL
C  (UNLESS FLRECO = TRUE AND RECSLM = FALSE)
                        IF(NINT(TMPCEL).LT.32767)
     $                   MOBS(1,6,LL)=NINT(TMPCEL)
C STORE VIRT TEMP OBS (*100 DEG. C) IN WORD 5 OF MOBS MASS LEVEL (UNLESS
C  FLRECO = TRUE AND RECSLM = FALSE)
                        TT = (NINT(RDATA(L+2)) * 0.1) + 273.16
                        JT = NINT(100.0*((TT*(1.0 +(.61*Q)))-273.16))
                        IF(JT.LT.32767) MOBS(1,5,LL) = JT
                     END IF
                  END IF
               END IF
            END IF
         ELSE
            IF(.NOT.FLRECO)  THEN
C IF TEMP IS BAD OR MISSING, NEVER PROCESS MASS PIECE UNLESS FLRECO = T
               IF(RDATA(L+2).GE.YMISS)  ICALLM = -1
               GO TO 7000
            END IF
         END IF
   15    CONTINUE
         IF(FLRECO)  THEN
C FOR FLRECO = TRUE, GET A BETTER EST. OF CAT. 6 PRESS. THAN JUST STD.
C  ATMOS. (VIA FUNCTION 'PRE') SINCE GEOPOTENTIAL (ZZ) ALWAYS VALID
            IF(JT.GE.32767.OR.ITM.GT.IQMGUD)  THEN
C IF TEMP ON CAT. 6 LVL IS MISSING, MUST EST. VIA U.S. STD. ATMOS. VALUE
               CALL W3FA03(P(1),DUM1,TEMP,DUM2)
            ELSE
C ELSE, VALID TEMP HERE IS VIRT(SENS) IF SP. HUM. AVAILABLE(NOT AVAIL.)
               TEMP = (REAL(JT)/100.0) + 273.16
            END IF
            P(1) = PRE(PP,TEMP,ZZZ,ZZ)
         END IF
C STORE PRESSURE OBS (*10 MB) IN WORD 1 OF MOBS MASS LEVEL
         MOBS(1,1,LL) = NINT(P(KM) * 10.)
         IF(.NOT.FLRECO.OR.RECSLM)  THEN
            IF(IFLC6.EQ.1)  THEN
               IF(IPM.LE.3.OR.IPM.GT.15) IPM = 15
               IF(IZM.LE.3.OR.IZM.GT.15) IZM = 15
               IF(ITM.LE.3.OR.ITM.GT.15) ITM = 15
               IF(IQM.LE.3.OR.IQM.GT.15) IQM = 15
            END IF
         ELSE
            IPM = 2
            IF(IFLC6.EQ.1)  IPM = 15
            ITM = 15
            IZM = 15
            IQM = 15
         END IF
         ICAT(LL) = 6
C STORE P, Z, T, Q PREPBUFR TABLE VALUES IN WORDS 1-4 OF MOBS MASS LEVEL
         MOBS(2,1,LL) = IPM
         MOBS(2,2,LL) = IZM
         MOBS(2,3,LL) = ITM
         MOBS(2,4,LL) = IQM
C STORE PRESSURE ALTITUDE OBS (METERS) IN WORD 2 OF MOBS MASS LEVEL
C  (UNLESS FLRECO = TRUE AND RECSLM = FALSE)
         IF(RECSLM.OR..NOT.FLRECO)  THEN
            IF(NINT(ZZZ).LT.IMISS)  MOBS(1,2,LL) = NINT(ZZZ)
         END IF
         ICALLM = 1
      ENDDO
C-----------------------------------------------------------------------
 7000 CONTINUE
      IF(ICALLM.EQ.1)  THEN
         IF(LL.GT.1)  THEN
C IF THERE ARE TWO MOBS LEVELS (CAN ONLY HAPPEN FOR FLRECO = TRUE),
C  RESTORE THEM BY DECREASING PRESSURE
            IPL1 = MOBS(1,1,1)
            IPL2 = MOBS(1,1,2)
            IF(IPL1.LT.IPL2)  THEN
               MOBS1 = MOBS(:,:,1)
               MOBS(:,:,1) = MOBS(:,:,2)
               MOBS(:,:,2) = MOBS1
               ICAT1 = ICAT(1)
               ICAT(1) = ICAT(2)
               ICAT(2) = ICAT1
            END IF
         END IF
C SET REPORT SEQ. NUMBER TO "ISQNUM(1)" IF RECCO, OR TO "ISQNUM(3) IF
C  AIREP/PIREP, AMDAR, EAMDAR, TAMDARM, CAMDAR, KAMDAR, AMDARB OR
C  TAMDARB AIRCFT, OR TO "ISQNUM(4)" IF SATELLITE (CLOUD-DRIFT,
C  W. VAPOR, VISIBLE, ETC) AND STORE IN HDR(11)
C  {NOTE: "ISQNUM(2)" FOR MDCRS AIRCFT IS NOT USED HERE SINCE HDR(11)
C         HAS ALREADY BEEN FILLED IN SUBR. RPTLBL, THUS THE TEST FOR
C         MISSING BELOW}
ccdak    IF(HDR(11).GE.YMISS)  HDR(11) = ISQNUM(NN)
                                       !SQN can now be > XMISS (99999.)
         IF(HDR(11).GE.YMISS*10.)  HDR(11) = ISQNUM(NN)
C NOW CALL FILLX TO INITIATE PROCESS TO ENCODE RPT INTO PREPBUFR FILE
         CALL FILLX(LL,IERF)
         IF(IERF.EQ.1)  THEN
            ICALLM = -99
         ELSE
            IF(IGOODT.EQ.0.AND.IPRINT.EQ.0)  PRINT 787, STNID
  787 FORMAT(7X,'* * * * *   NO VALID TEMP INFORMATION IN ID = ',A8,
     $' ON ANY LVL, MASS PIECE STORED BUT ONLY W/ P-ALTITUDE * * * * *')
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C OPTION TO PRINT LISTING OF ALL MASS RPTS (NORM. COMMENTED OUT)
C           PRINT 9091, STNID,IDATA(9),NINT(HDR(6))
C9091 FORMAT(1X,'STN. ',A8,'DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
C    $ 'TYPE =',I4)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         END IF
      END IF
 1900 CONTINUE
C***********************************************************************
C                  FILL IN WIND INFORMATION FOR REPORT
C***********************************************************************
      IF(ICALLM.EQ.1) THEN
C  DO NOT ENCODE OBS2 OR OBS3 VARIABLES WITH WIND REPORT UNLESS NO MASS
C   REPORT WAS GENERATED {EXCEPTIONS: OBS2(1-3) - RSRD, EXPRSRD, ALSE}
         OBS2(4:NUMOBS2) = BMISS
         OBS3 = BMISS
         NOBS3 = 0
      END IF
C 'ICALLW' INDICATES WHETHER WIND PIECE STORED IN OUTPUT FILE {IF SO =1;
C  IF NOT = -99 (NOT PROCESSED) OR = -1 (MSG. WIND) OR = 0 (BAD WIND)}
      ICALLW = -99
C SKIP WIND REPORT: IF ACFT & JAWIND(IBNDA,NAC) = 9999;
C                   IF SATWND(ALL TYPES) & JSWIND(IBAND,NSW,IPD) = 9999;
      IF((IDATA(9).EQ.41.AND.JAWIND(IBNDA,NAC).NE.0)
     $ .OR.(IDATA(9).EQ.63.AND.JSWIND(IBAND,NSW,IPD).EQ.9999)) GOTO 1800
      ICALLW = 0
C GET PREPBUFR REPORT TYPE (NOTE: FOR SOME TYPES, HIGH- VS. LOW-LEVEL
C  SAT. WIND RPTS GET DIFFERENT R. TYPES)
      IF(IDATA(9).EQ.63)  THEN
         IF(P(1).LE.800.00001.AND.(NHDR6.EQ.242.OR.NHDR6.EQ.243))
     $    NHDR6 = NHDR6 + 10
      END IF
      HDR(6) = NHDR6
      LL =  0
C INITIALIZE BOTTOM TWO LEVELS OF MOBS ARRAY (NEED TWO LEVELS IN CASE
C  FLRECO = TRUE)
      MOBS(1:MXTYPV,1:MXWRDL,1:2) = IMISS
C INITIALIZE BOTTOM TWO LEVELS OF ICAT ARRAY
      ICAT(1:2) = IMISS
C-----------------------------------------------------------------------
C   STORE WIND DATA INTO CATEGORY 6 MOBS DATA LEVEL (ASSUMES KLVL = 1)
C-----------------------------------------------------------------------
      DO KW = 1,KLVL
         LL = LL + 1
         L = (9 * (KW - 1)) + IDATA(24)
         ZZZ = NINT(RDATA(L+1))
C FILL IN PREPBUFR TABLE VALUES
         IPM = NINT(RDATA(L+ 7))
         IWM = NINT(RDATA(L+10))
         IF(IDATA(9).EQ.63)  THEN
C FOR SATWND REPORTS, WIND Q.M. IS BASED ON RFFL VALUE (SEE ABOVE)
C  (Note: Now that RFFL is encoded in PREPBUFR file, it may be
C         best to eventually let anal determine quality based on RFFL)
            IF(IWM_RFFL.LT.IMISS.AND.IWM.EQ.2)  IWM = IWM_RFFL
C FOR SATWND REPORTS, A REJECT, PURGE, OR FAIL FLAG ON WIND IS
C  TRANSFERRED TO PRESSURE
            IF(IWM.GT.11)   IPM = IWM
         END IF
C STORE PRESSURE OBS (*10 MB) IN WORD 1 OF MOBS WIND LEVEL
         MOBS(1,1,LL) = NINT(P(KW) * 10.)
         IZM = 15
         IF(NINT(ZZZ).LT.IMISS)  THEN
C STORE PRESSURE ALTITUDE OBS (METERS) IN WORD 2 OF MOBS WIND LEVEL
            MOBS(1,2,LL) = NINT(ZZZ)
            IZM = IPM
         END IF
         IF(IFLC6.EQ.1)  THEN
            IF(IPM.LE.3.OR.IPM.GT.15) IPM = 15
            IF(IZM.LE.3.OR.IZM.GT.15) IZM = 15
            IF(IWM.LE.3.OR.IWM.GT.15) IWM = 15
         END IF
         ICAT(LL) = 6
C STORE P, Z, W PREPBUFR TABLE VALUES IN WORDS 1-4 OF MOBS WIND LEVEL
         MOBS(2,1,LL) = IPM
         MOBS(2,2,LL) = IZM
         MOBS(2,3,LL) = IWM
         MOBS(2,4,LL) = IWM
C PROCESS NON-MSG WIND REGARDLESS OF PREPBUFR TABLE VALUE
         IF(IWM.GE.IQMLIM.OR.MAX(RDATA(L+4),RDATA(L+5)).GE.YMISS)  THEN
            IF(MAX(RDATA(L+4),RDATA(L+5)).GE.YMISS)  ICALLW = -1
            GO TO 6000
         END IF
C CONVERT WIND DIRECTION & SPEED TO U- AND V-COMPONENTS
         CALL UV(RDATA(L+4),RDATA(L+5)*0.1,UCOMP,VCOMP)
         IF(MAX(NINT(UCOMP*100.),NINT(VCOMP*100.)).LT.32767)  THEN
C STORE U-COMP OBS (*100 M/SEC) IN WORD 3 OF MOBS WIND LEVEL
            MOBS(1,3,LL) = NINT((UCOMP * 100.0) + 0.005)
C STORE V-COMP OBS (*100 M/SEC) IN WORD 4 OF MOBS WIND LEVEL
            MOBS(1,4,LL) = NINT((VCOMP * 100.0) + 0.005)
         else
           print 1681, stnid,kw
 1681 format(5X,'* * * * *   WIND REPORT TOSSED, ID = ',A8,', LEVEL',I3
     $,' EITHER U- OR V-COMP ERRONEOUSLY LARGE, SET TO MISSING  * * * ',
     $ '* *')
           icallw = -1
           go to 6000
         END IF
         JDD = NINT(RDATA(L+4))
         JFF = NINT(RDATA(L+5) * 0.19425)
         IF(MAX(JDD,JFF).LT.32767)  THEN
C STORE WIND DIRECTION OBS (DEGREES) IN WORD 5 OF MOBS WIND LEVEL
C STORE WIND SPEED OBS (KNOTS) IN WORD 6 OF MOBS WIND LEVEL
            MOBS(1,5,LL) = JDD
            MOBS(1,6,LL) = JFF
         END IF
         ICALLW = 1
      ENDDO
C-----------------------------------------------------------------------
 6000 CONTINUE
      IF(ICALLW.EQ.1)  THEN
         IF(LL.GT.1)  THEN
C IF THERE ARE TWO MOBS LEVELS (CAN ONLY HAPPEN FOR FLRECO = TRUE),
C  RESTORE THEM BY DECREASING PRESSURE
            IPL1 = MOBS(1,1,1)
            IPL2 = MOBS(1,1,2)
            IF(IPL1.LT.IPL2)  THEN
               MOBS1 = MOBS(:,:,1)
               MOBS(:,:,1) = MOBS(:,:,2)
               MOBS(:,:,2) = MOBS1
               ICAT1 = ICAT(1)
               ICAT(1) = ICAT(2)
               ICAT(2) = ICAT1
            END IF
         END IF
C SET REPORT SEQ. NUMBER TO "ISQNUM(1)" IF RECCO, OR TO "ISQNUM(3) IF
C  AIREP/PIREP, AMDAR, EAMDAR, TAMDARM, CAMDAR, KAMDAR, AMDARB OR
C  TAMDARB AIRCFT, OR TO "ISQNUM(4)" IF SATELLITE (CLOUD-DRIFT,
C  W.VAPOR, VISIBLE, ETC) AND STORE IN HDR(11)
C  {NOTE: "ISQNUM(2)" FOR MDCRS AIRCFT IS NOT USED HERE SINCE HDR(11)
C         HAS ALREADY BEEN FILLED IN SUBR. RPTLBL, THUS THE TEST FOR
C         MISSING BELOW}
ccdak    IF(HDR(11).GE.YMISS)  HDR(11) = ISQNUM(NN)
                                       !SQN can now be > XMISS (99999.)
         IF(HDR(11).GE.YMISS*10.)  HDR(11) = ISQNUM(NN)
C NOW CALL FILLX TO PUT THIS REPORT INTO BLOCK OF REPORTS
         CALL FILLX(LL,IERF)
         IF(IERF.EQ.1)  THEN
            ICALLW = -99
C        ELSE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C OPTION TO PRINT LISTING OF ALL DATA LEVEL CAT. 6 WIND RPTS (NORMALLY
C                         . COMMENTED OUT)
C           PRINT 9090, STNID,IDATA(9),NINT(HDR(6))
C9090 FORMAT(1X,'STN. ',A8,'DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
C    $ 'TYPE =',I4)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         END IF
      END IF
C***********************************************************************
 1800 CONTINUE
      IF(IPRINT.EQ.0)  THEN
         IF(ICALLW.EQ.1)  THEN
            IF(ICALLM.EQ.0)  PRINT 679, STNID,KM,ITM
  679 FORMAT(6X,'* * * * *   MASS REPORT TOSSED, ID = ',A8,', LEVEL',I3,
     $ ' IW3UNPBF TEMP Q.M. IS BAD (PREPBUFR TABLE VALUE=',I2,
     $ ')   * * * * *')
            IF(ICALLM.EQ.-1)  PRINT 1679, STNID,KM
 1679 FORMAT(24X,'* * * * *   MASS REPORT TOSSED, ID = ',A8,', LEVEL',I3
     $,' TEMP IS MISSING   * * * * *')
         ELSE  IF(ICALLM.EQ.1)  THEN
            IF(ICALLW.EQ.0)  PRINT 680, STNID,KW,IWM
  680 FORMAT(6X,'* * * * *   WIND REPORT TOSSED, ID = ',A8,', LEVEL',I3,
     $ ' IW3UNPBF WIND Q.M. IS BAD (PREPBUFR TABLE VALUE=',I2,
     $ ')   * * * * *')
            IF(ICALLW.EQ.-1)  PRINT 1680, STNID,KW
 1680 FORMAT(24X,'* * * * *   WIND REPORT TOSSED, ID = ',A8,', LEVEL',I3
     $,' WIND IS MISSING   * * * * *')
         END IF
      END IF
      IF(ICALLM.EQ.1.OR.ICALLW.EQ.1)  THEN
         IF(IDATA(9).EQ.63) KEPSW(IBAND,NSW,IPD)= KEPSW(IBAND,NSW,IPD)+1
         IF(IDATA(9).EQ.41) KEPAC(IBNDA,NAC) = KEPAC(IBNDA,NAC) + 1
         RETURN 1
      ELSE
         IF(WRMISS) THEN
            IF(NN.EQ.3) THEN
C IF N-LIST SWITCH WRMISS IS TRUE, NO VALID TEMP OR WIND DATA PRESENT
C  AND REPORT IS FROM "AIRCFT" MESSAGE TYPE, CHECK FOR PRESENCE OF ANY
C  ANCILLARY INFORMATION (E.G., SENSIBLE WEATHER ELEMENTS) - IF SOME IS
C  FOUND, WILL ENCODE AS A MASS REPORT (EVEN THOUGH THIS INFO IS NOT
C  DIRECTLY USED BY ASSIMILATION, IT MIGHT BE USEFUL FOR VERIFICATION
C  OR IN OTHER WAYS)
c
c  bug fix dak 2/3/16: If the only non-missing ancillary information
c   found is RSRD or EXPRSRD {stored in OBS2(1) and OBS2(2)}, then
c   CHANGE to NOT encode a mass report because it would later cause
c   PREPACQC to fail since a place holder for NRLQMS is not encoded
c   into pre-QC PRPEBUFR file in this case (NRLQMS is in the PRSLEVLA
c   replication which in this case would be zero) -- fortunately a
c   failure has never occurred because AMDAR reports (only type
c   restricted) have never had both a missing temperature & wind
c    (lines commented out below fix the bug)
ccccccccccccc  NMOBS2 = 0
               NMHDR  = 0
ccccccccccccc  DO I = 1,2
ccccccccccccc     IF(OBS2(I).LT.YMISS) THEN
ccccccccccccc        NMOBS2 = 1
ccccccccccccc        EXIT
ccccccccccccc     END IF
ccccccccccccc  ENDDO
ccccccccccccc  IF(NMOBS2.EQ.0) THEN
                  IF(MIN(ROLF,RIALR,POAF,TRBX(5),PCAT).LT.YMISS) NMHDR=1
ccccccccccccc  END IF
ccccccccccccc  IF(MAX(NOBS3(2),NOBS3(3),NOBS3(6),NOBS3(7),NMOBS2,NMHDR)
               IF(MAX(NOBS3(2),NOBS3(3),NOBS3(6),NOBS3(7),NMHDR)
     $          .GT.0) THEN
                  LL = 1
C GET PREPBUFR REPORT TYPE (STORE AS MASS PIECE)
                  HDR(6) = NHDR6 - 100
                  IF(NHDR6.EQ.251)  HDR(6) = 144
C SET REPORT SEQ. NUMBER TO "ISQNUM(1)" IF RECCO, OR TO "ISQNUM(3) IF
C  AIREP/PIREP, AMDAR, EAMDAR, TAMDAR(M/B), CAMDAR, KAMDAR, AMDARB OR
C  AIRCFT, OR TO "ISQNUM(4)" IF SATELLITE (CLOUD-DRIFT, W. VAPOR,
C  VISIBLE, ETC) AND STORE IN HDR(11)
C  {NOTE: "ISQNUM(2)" FOR MDCRS AIRCFT IS NOT USED HERE SINCE HDR(11)
C         HAS ALREADY BEEN FILLED IN SUBR. RPTLBL, THUS THE TEST FOR
C         MISSING BELOW}
ccdak             IF(HDR(11).GE.YMISS)  HDR(11) = ISQNUM(NN)
                                       !SQN can now be > XMISS (99999.)
                  IF(HDR(11).GE.YMISS*10.)  HDR(11) = ISQNUM(NN)
C NOW CALL FILLX TO PUT THIS REPORT INTO BLOCK OF REPORTS
                  CALL FILLX(LL,IERF)
                  IF(IERF.EQ.0)  THEN
                     IF(IPRINT.EQ.0)  PRINT 9787, STNID
 9787 FORMAT(1X,'* * * NO VALID TEMP/WIND INFO IN ID = ',A8,' ON ANY ',
     $ 'LVL, MASS PIECE STORED BUT ONLY W/ ANCILLARY (E.G. SENS WX ',
     $ 'ELM) DATA * * *')
         IF(IDATA(9).EQ.63) KEPSW(IBAND,NSW,IPD)= KEPSW(IBAND,NSW,IPD)+1
         IF(IDATA(9).EQ.41) KEPAC(IBNDA,NAC) = KEPAC(IBNDA,NAC) + 1
                     RETURN 1
                  END IF
               END IF
            END IF
         END IF
         KOUNT = KOUNT - 1
         IF(IPRINT.EQ.0)  PRINT 959,STNID,alat_8,alon_8,IDATA(9)
  959 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - NO VALID DATA IN GETC06')
         RETURN 2
      END IF
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SATEDS
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2014-11-25
C
C ABSTRACT: UNPACKS RETRIEVAL DATA FROM RTOVS OR ATOVS BUFR DATA DUMP
C   FILE ONE REPORT AT A TIME, TRANSLATING INTO UNPACKED NMCEDS FORMAT
C   (TRANSLATES ONLY THOSE VALUES IN ORIGINAL NMCEDS FORMAT NEEDED BY
C   THIS PROGRAM).  PERFORMS SEVERAL CHECKS ON THE DATA, AND
C   ACCUMULATES COUNTS FOR VALID REPORTS BEFORE CALLING SUBROUTINES TO
C   ACTUALLY PROCESS REPORTS.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1987-06-14  D. A. KEYSER -- ADDED CAPABILITY TO PROCESS DMSP AND VAS
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1988-08-24  D. A. KEYSER -- EXPANDED TO INCLUDE DMSP F-9 SATELLITE
C 1988-09-14  D. A. KEYSER -- MODIFIED TO PROCESS TOVS PHYS. RETRIEVALS
C 1988-10-25  D. A. KEYSER -- ALL REFERENCES TO ON29 TOVS REMOVED
C 1989-04-24  D. A. KEYSER -- REMOVED CHECK OF VIRGS EDIT FLAG AND ADDED
C     CHECK OF TOVS FILTER FLAG
C 1989-05-12  D. A. KEYSER -- POS. 1 IN TOVS STN. ID NOW NADIR DIST.
C     INDICATOR (1-9; 1 BY NADIR & 9 AT LIMB), POS. 2-5 ARE LAST 4
C     DIGITS OF LOGICAL REC. NO., POS. 6 REMAINS SATELLITE/PATH
C     CHARACTER
C 1989-12-13  D. A. KEYSER -- TOVS FILTER FLAG TEST IGNORED & STN. ID
C     CALC. AS PRIOR TO 89-05-12 CHG. ABOVE IF PROD./ADPUPA DATE READ
C     IN IS PRIOR TO 89-05-31/12Z - ALLOWS FOR PREPRO RERUNS OF
C     HISTORICAL CASES
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-07-11  D. A. KEYSER -- SWITCH 'FGGE' REMOVED FROM N-LIST (FALSE)
C 1990-10-25  D. A. KEYSER -- ADDED PROC. TOVS PWATER IN SUBR.
C     'PWATER'; NEW SUBR. 'UNPO29' + ENTRIES NOW UNPACKS VAS RETR. FROM
C     D-SETS INTO UNPACKED ON29 FORMAT (STREAMLINED)
C 1991-06-24  D. A. KEYSER -- CAN READ IN EITHER PACKED 16-BIT OR FULL
C     WORD DIRECTORY FILE
C 1991-09-10  D. A. KEYSER -- FFGET FOR RETR DCTY REPLACED W/ SEQ. READ;
C     SWITCHES 'EVTSAT','ODTSAT','EVDSAT','ODDSAT' REMOVED FROM N-LIST
C     (NO SAT. NO. TEST)
C 1992-08-07  D. A. KEYSER -- STOP 69 ADDED FOR OVERFLOW PACKING
C     FULL-WORD ARRAY TO 16-BIT ARRAY (& LOG MSG.)
C 1993-05-12  D. A. KEYSER -- THE NEW "PREPBUFR TABLE VALUES" WHICH CAN
C     RANGE FROM 0-15 ARE EMPLOYED RATHER THAN THE OLD OI/SSI QUALITY
C     MARKERS; SUBR. "TWOBIT" REPLACED BY W3LIB ROUTINE "GBYTES"
C 1993-05-31  D. A. KEYSER -- RENAMED SUBR. "SATSND" TO "SATEDS";
C     REMOVED SECTION WHICH STD. O-PUT PRINTS OF COUNTS FOR ALL SAT.
C     RETR. TYPES AND PLACED IN NEW SUBR. "SNDTBL"; CHANGED DEF. VALUES
C     & ORDER FOR N-LIST SWITCH "IUNIT"; N-LIST SWITCH "IRTRV" EXPANDED
C     TO 3-DIM. W/ 3'RD ELEM. REFERRING TO SAT./RETR. TYPE (HERE ALWAYS
C     = 1)
C 1993-11-02  D. A. KEYSER -- VARIABLE IFLUA WHEN SET TO 1 WILL FLAG
C     ALL VARIABLES WITH PREPBUFR T. VALUE=15
C 1994-08-11  D. A. KEYSER -- ADDED PROCESSING OF TOVS VIA INPUT FILE
C     WHICH RETURNS UNPACKED ON29 FORMAT (NEVER OPER'L), INVOKED IF
C     TOVS DCTY FILE EMPTY; MACHINE CHAR. TYPE NOW USED FOR ASCII/
C     EBCDIC CONVERSION TEST RATHER THAN 'LW' VALUE
C 1995-07-12  D. A. KEYSER -- REMOVED LOGIC TO PROCESS VAS RETRIEVALS
C 1996-09-03  D. A. KEYSER -- CAN NOW RETURN NMCEDS FORMAT FOR TOVS
C     RETR. IN NEW BUFR DATA DUMP FILES (SWITCH 'IEDSTP', NEW SUBR.
C     W3TOVEDS)
C 1996-10-24  D. A. KEYSER -- ADDED CALL TO BUFRLIB "DATEBF" TO RETURN
C     CENTER DATE FROM TOVS BUFR DATA DUMP FILES (SIMPLIFIES OTHER
C     TIME-CHECKING PROCEDURES); STREAMLINED PARTS OF THIS SUBR. (UNIT
C     NO. DESIG.,ETC.); NOW PRINTS COUNT OF RPTS. OUTSIDE TIME WINDOW
C 1998-02-17  D. A. KEYSER -- REMOVED NEED TO REPACK TO 16-BIT ARRAY;
C     REMOVED LOGIC RE: UNPACKING REPORT FROM PHYSICAL NMCEDS OR ON29
C     FILE; REMOVED LOGIC RE: DMSP PROCESSING; REMOVED LOGIC RE: TOVS
C     PWATER PROCESSING
C 1998-05-15  D. A. KEYSER -- ADDED PROCESSING OF RTOVS DATA BASED ON
C     NEW NAMELIST SWITCH "RTOVS", NEW IN-LINE ROUTINE W3RTVEDS ADDED
C     FOR INTERFACE WITH RTOVS RETURNING PARTIAL NMCEDS FORMAT, 250 KM
C     RTOVS SAMPLING ACCOMPL. VIA PROCESSING ONLY EVERY 4'TH RETRIEVAL;
C     ADDED KOUNTS FOR REJECTED TOVS/RTOVS NMCEDS DATA PROCESSING,
C     SUMMARIZED IN STDOUT PRINT AT END OF PROGRAM
C 1998-06-15  D. A. KEYSER -- REMOVED ALL LOGIC PERTAINING TO TOVS
C     PROCESSING (SUBR. 'TOVSID' & 'TDEW' NO LONGER CALLED - REMOVED,
C     N-LIST SWITCH 'RTOVS' REMOVED; N*/PTLY-CLDY PATH NO LONGER
C     POSSIBLE); RTOVS 250KM SUB-SAMPLING NOW DEPENDS UPON VALUE IN
C     FILTER FLAG AS WAS THE CASE FOR TOVS (FIX BY NESDIS) (BEFORE
C     250KM SUB-SAMPLING WAS EST. BY PROCESSING EVERY 4'TH RTOVS RPT)
C 1999-01-20  D. A. KEYSER -- REPL. N-LIST SWITCH "SATLND" WITH NEW
C     SWITCHES "ISATLS" AND "JSATLS" TO HANDLE LAND/SEA SELECTION FOR
C     SATELLITE SNDGS/RADIANCES AND GOES PW RETR. SEPARATELY (ALSO CAN
C     NOW SELECT JUST LAND AS WELL AS JUST SEA OR EVERYWHERE)
C 2000-02-17  D. A. KEYSER -- SUBR. W3CNVTOV RENAMED TO W3CNVXTOVS
C     (HANDLES RTOVS AND NEW ATOVS), W3RTVEDS RENAMED TO W3XTOVSEDS
C     (HANDLES RTOVS AND NEW ATOVS), AND W3TOVMND RENAMED TO W3XTOVSMND
C     (HANDLES RTOVS AND ATOVS); CAN NOW PROCESS ATOVS DATA VIA SUBR.
C     W3XTOVSEDS (NMCEDS FORMAT); CHAR. 7 OF STNID NOW INDICATES RTOVS
C     (='R') OR ATOVS (='A') (WAS BLANK); IF FILTER FLAG=-99 AND
C     TR80KM=F, PROCESS ONLY EVERY 4'TH UNPACKED RTOVS RETRIEVAL TO
C     SIMULATE 250 KM SUB-SAMPLING (RTOVS DUMP FILE PRIOR TO 7/1/1998
C     - NO FILTER FLAG INFORMATION AVAILABLE - NEEDED FOR HISTORICAL
C     CDAS RUNS)
C 2001-04-06  D. A. KEYSER -- SUBR. "RPTLBL" NOW HAS INPUT ARGS.
C     "TIMWIN_e" (EARLIEST TIME WINDOW) AND "TIMWIN_l" (LATEST TIME
C     WINDOW) REPL. "TIMWIN" (+/- TIME WINDOW) ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME), ALLOWS THE 2 TO BE DIFFERENT
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"; N-LIST SWITCHES "IWINDO", "SATMST",
C     "ISATLS", "IRTRV" AND "KTOP" NOW MORE SPECIFIC TO POINT TO PAIRS
C     OF EVEN OR ODD GOES SATS. (NOT USEFUL HERE) AND TO THE 4 POSSIBLE
C     REPORT TYPES THAT CAN BE GENERATED FROM RTOVS/ ATOVS AND GOES
C     SNDG/RAD/RETR. DATA
C 2001-08-01  D. A. KEYSER -- N-LIST SWITCH IWINDO SPLIT INTO IWINDO_e
C     (EARLIEST TIME WINDOW) AND IWINDO_l (LATEST TIME WINDOW) FOR
C     SATELLITE SOUNDING/RETRIEVAL/RADIANCE REPORTS ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE)
C     WORD 6 SO IT CAN LATER BE ENCODED INTO PREPBUFR FILE
C 2001-10-10  D. A. KEYSER -- PASSES PREPBUFR CENTER DATE INTO SUBR.
C     W3CNVXTOVS SO IT CAN PROPERLY DETERMINE BUFR SATELLITE ID
C     WHICH IS NOW RETURNED FROM W3CNVXTOVS ID IN UNPACKED IW3UNPBF
C     WORD 6 (SO IT CAN LATER BE ENCODED INTO PREPBUFR FILE)
C 2014-11-25  D. A. Keyser -- Removed input argument "IDATE" (central
C     date) from call to subr. W3CNVXTOVS since year {IDATE(1)} is no
C     longer needed to obtain BUFR satellite ID.
C 2020-08-20 J. Dong -- 
C     - Defined IDSDAT to eliminate Boundary Run-Time Check Failures.
C     - Modified the code to handle invalid float errors during the
C       run when the code was compiled with debug options enabled.
C 2022-04-15 I. GENKOVA -- UPDATED IDSAT(4) TO IDSAT(8) TO ACCOMODATE 
C     WCOSS2 COMPILER
C
C USAGE:    CALL SATEDS
C   INPUT FILES:
C     UNIT GG   - RTOVS BUFR DATA FILE (SOUNDINGS/RETRIEVALS/RADIANCES)
C     UNIT GG+1 - ATOVS BUFR DATA FILE (SOUNDINGS/RETRIEVALS/RADIANCES)
C    (WHERE GG IS UNIT NUMBER DEFINED AS IUNIT(7) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.  FOR PROCESSING OF RTOVS OR
C   ATOVS RADIANCE/40-LEVEL RETRIEVAL REPORTS FILE SEE SUBROUTINE
C   SATBFR.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SATEDS
CCC
C  SAT. & PATH (INSTRUMENT) INDICATED BY CHARACTER 6 OF STATION ID
C  SAT. NO. DESIG'N: ODD1  - 3,7,11,15,19,...; ODD2  - 1,5, 9,13,17,...
C                    EVEN1 - 2,6,10,14,18,...; EVEN2 - 4,8,12,16,20,...
C          SUFFIX A,E ---> CLEAR  PATH FROM ODD1  (A) OR ODD2  (E) SAT.
C          SUFFIX S,W ---> CLEAR  PATH FROM EVEN1 (S) OR EVEN2 (W) SAT.
C          SUFFIX C,G ---> CLOUDY PATH FROM ODD1  (C) OR ODD2  (G) SAT.
C          SUFFIX U,Y ---> CLOUDY PATH FROM EVEN1 (U) OR EVEN2 (Y) SAT.
C          SUFFIX D,H ---> OTHER  PATH FROM ODD1  (D) OR ODD2  (H) SAT.
C          SUFFIX V,Z ---> OTHER  PATH FROM EVEN1 (V) OR EVEN2 (Z) SAT.
C
C  RTOVS VS. ATOVS INDICATED BY CHARACTER 7 OF STN. ID ("R" OR "A")
C
CCC
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*4  SAMPLE(2)
      CHARACTER*5  CTYPE(2)
      CHARACTER*8   STNPRT,STNID,DSNAME,SUBSET_d
      LOGICAL  SATMST,TR80KM,TOVEDS
      INTEGER  IBUF(140),JRTRV(3),NUMOB(5,4,2,4,4),KEPOB(5,4,2,4),
     $ MSTOB(5,4,2,4),IDATA(MAXOBS),KSATOB(3),IDSAT(8),ISAMPLE(2) 
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/TVSWCH/TOVEDS(2),TOVBFR(2),TR80KM,KNTTOV(2),
     $ KSKPTV(2),KNOPTV(2),KIPTTV(2),KMSGTV(2),KBDYTV(2),KTIMTV(2),
     $ KLNDTV(2),KSEATV(2),KREDTV(2),KJFLAG(2)
      COMMON/SATSW2/PHI(6),IRTRV(5,4,4),KTOP(5,4,4),IWINDO_e(5,4,4),
     $ IWINDO_l(5,4,4),SATMST(5,4,4),ISATLS(5,4,4)
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE (RDATA,IDATA)
      DATA  JRTRV/272,99999,544/,KNTRPT/0/,CTYPE/'RTOVS','ATOVS'/,
     $ MFIRST/0/,SAMPLE/' 4TH','11TH'/,ISAMPLE/4,11/
      NN = 1
  700 CONTINUE
C KOUNT COUNTS NO. REPORTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
C NN WILL INDICATE WHICH FILE IS BEING EXAMINED:
C    NN = 1 ===> RTOVS
C    NN = 2 ===> ATOVS
      IF(.NOT.TOVEDS(NN))  GO TO 110
C INITIALIZE NUMOB, KEPOB, AND MSTOB ARRAYS
      NUMOB = 0
      KEPOB = 0
      MSTOB = 0
C CYCLET IS TIME THE DATA IS CENTERED ON (CYCLE TIME, to fraction of an
C  hr if IDATMM non-zero)
      CYCLET = IDATE(4) + idatmm / 60.d0
      IDSAT = 0
      NFILE = IUNIT(7) + NN - 1
      PRINT 2002, CTYPE(NN),NFILE
 2002 FORMAT(//,37X,' ***** ',A5,' SATELLITE RETRIEVAL FILE    UNIT =',
     $ I4,' *****')
      PRINT 550, IDATE
  550 FORMAT(25X,'LOOKING FOR FILE WITH CENTER DATE: ',2X,I4.4,
     $ 2('-',I2.2),1X,I2.2,'Z  BASED ON PRODUCTION DATE'/33X,'--> --> ',
     $ ' RETRIEVALS RETURNED IN UNPACKED NMCEDS FORMAT <-- <--')
      IF(.NOT.TR80KM)  THEN
         PRINT 581
  581    FORMAT(/27X,'-->  ORIGINAL FULL RESOLUTION REPORTS ARE ',
     $    'FILTERED TO 250 KM RESOLUTION  <--'/)
      ELSE
         PRINT 583
  583    FORMAT(/37X,'-->  ALL REPORTS (AT FULL RESOLUTION) ARE ',
     $    'PROCESSED  <--'/)
      END IF
C KNTRPT WILL COUNT NUMBER OF RPTS SUCCESSFULLY DECODED FOR EACH FILE
      KNTRPT = 0
      GO TO 1400
C#######################################################################
C#######################################################################
 1410 CONTINUE
C KSKPTV WILL COUNT NO. OF DECODED REPORTS SKIPPED (VARIOUS REASONS)
      KSKPTV(NN) = KSKPTV(NN) + 1
 1400 CONTINUE
C ATTEMPT TO DECODE THE NEXT RTOVS OR ATOVS REPORT
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
      CALL W3XTOVSEDS(NFILE,IDATEM,IBUF,KSATOB,PBOT,DSNAME,IDSDAT,
     $ IDSDMP_8,IER)
      IFLUA = 0
C.......................................................................
      IF(IER.EQ.-3)  THEN
         PRINT 8002, NFILE
 8002    FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN FIRST ',
     $    'CALL TO FILE IN UNIT',I4,' -- THIS MAY BE A NULL FILE -- ',
     $    'GO TO NEXT FILE'/)
         RETURN
C.......................................................................
      ELSE  IF(IER.EQ.1)  THEN
C IER = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
         PRINT 7000, DSNAME,IDSDAT,IDSDMP_8
 7000    FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $    I10.10,'; DUMP TIME: ',I12.12,' <--'//)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
            RETURN
         END IF
         GO TO 1400
C.......................................................................
      ELSE  IF(IER.LT.0.OR.IER.GT.2)  THEN
C ERROR DECODING REPORT, DO NOT DECODE ANY MORE REPORTS AT THIS POINT
         PRINT 572, NFILE,KNTRPT+1,IER
  572 FORMAT(/' >>>>>  B U F R   D E C O D E   E R R O R   O N   UNIT',
     $ I3,'   --   R E P O R T   C N T .   ',I5,'   --   I E R   ',I5,
     $ '  <<<<<'/)
         GO TO 961
C.......................................................................
      ELSE  IF(IER.EQ.2)  THEN
C IF IER = 2, HAVE HIT END-OF-FILE, ALL REPORTS PROCESSED - GO SUMMARIZE
         GO TO 961
C.......................................................................
      END IF
C A REPORT WAS SUCCESSFULLY DECODED
      KNTRPT = KNTRPT + 1
      ELON  = REAL(IBUF(6)) * 0.01
      IF(IBUF(6).LT.0)   ELON = 360.00 + (REAL(IBUF(6)) * 0.01)
      IF(NINT(ELON*100.).EQ.36000)  ELON = 0.
C ID1ST5 HOLDS FIRST 5 POSITIONS IN GENERATED STATION IDENTICATION
C  = (NADIR DIST. INDICATOR * 10000) + LAST 4 DIGITS OF KNTRPT
C    (KNTRPT IS REPORT COUNT NUMBER)
C .. NADIR PROX. INDICATOR ITSELF STORED IN IBUF(16)
      ID1ST5 = (IBUF(16) * 10000) + MOD(KNTRPT,10000)
C W3XTOVSMND CALC. MAND LVL Z, T & STORES THEM IN COMMON FOR W3CNVXTOVS
      CALL W3XTOVSMND(IBUF,JFLAG)
      IF(JFLAG.NE.0)  THEN
         KJFLAG(NN) = KJFLAG(NN) + 1
C IF STATUS FLAG (JFLAG) RETURNED FROM W3XTOVSMND IS NON-ZERO, SKIP RPT
         PRINT 8755, ID1ST5,IBUF(5)*0.01,ELON,JFLAG
 8755 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',I6,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - JFLAG FROM W3XTOVSMND =',I3)
C GO BACK AND UNPACK NEXT REPORT
         GO TO 1410
      END IF
C-----------------------------------------------------------------------
C         REPORT COUNTS STORED IN ARRAY: NUMOB(IBAND,INSTR,MS,NS,1)
C         WHERE: IBAND IS LAT. BAND INDEX, INSTR IS PATH TYPE INDEX
C               MS IS LAND/OCEAN SWITCH AND NS IS SAT # INDEX
C   ** PERFORM CHECKS ON SATELLITE NUMBER AND PATH, TOSS IF PROBLEM **
C-----------------------------------------------------------------------
C.......................................................................
C IDENTIFY LATITUDE (PHI) BAND INDEX ---> IBAND
C.......................................................................
      DO IBAND = 1,4
         IF(IBUF(5).LT.(NINT(PHI(IBAND+1)*100.)-0.5))  GO TO 1800
      ENDDO
C NOTE: IN RARE EVENT THAT LAT. MSG, IBAND SET TO 5 (RPT. LATER SKIPPED)
      IBAND = 5
 1800 CONTINUE
C.......................................................................
C IDENTIFY SATELLITE NUMBER INDEX ---> NS (=1 EVEN SAT. ; =2 ODD  SAT.)
C.......................................................................
      NS = 0
C SATELLITE NUMBER IN IBUF(1)
      IF(MOD(IBUF(1),2).EQ.0)  THEN
         NS = 1
      ELSE  IF(MOD(IBUF(1),2).NE.0)  THEN
         NS = 2
      ELSE
C IF REPORT NOT FROM AN OPERATIONAL SATELLITE SKIP IT
         KNOPTV(NN) = KNOPTV(NN) + 1
         PRINT 8758, ID1ST5,IBUF(5)*0.01,ELON
 8758 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',I6,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - FROM NON-OPERATIONAL SATELLITE')
C GO BACK AND DECODE NEXT REPORT
         GO TO 1410
      END IF
      IDSAT(NS) = IBUF(1)
C.......................................................................
C IDENTIFY PATH ---> INSTR {=1 CLEAR; 3 CLOUDY}
C  (NOTE: INSTR = 2 IS NOT A POSSIBILITY)
C.......................................................................
C  IF IBUF(12) = 545 ---> CLOUDY
C  IF IBUF(12) = 273 ---> CLEAR
      IF(IBUF(12).EQ.545)  THEN
         INSTR = 3
      ELSE  IF(IBUF(12).EQ.273)  THEN
         INSTR = 1
      ELSE
C IF PATH (INSTRUMENT) NOT RECOGNIZED SKIP (NOTE: SHOULD NEVER HAPPEN)
         KIPTTV(NN) = KIPTTV(NN) + 1
         PRINT 8759, ID1ST5,IBUF(5)*0.01,ELON,IBUF(12)
 8759 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',I6,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - HAS INVALID PATH (RETRIEVAL TYPE=',I5,')')
C GO BACK AND DECODE NEXT REPORT
         GO TO 1410
      END IF
C.......................................................................
C IDENTIFY OVERLAND/OCEANIC SWITCH ---> MS (MS=1 OVERLAND; MS=2 OCEANIC)
C  IF IBUF(8) = 0 ---> CONSIDERED OCEANIC
C  IF IBUF(8) > 0 ---> CONSIDERED OVERLAND
C.......................................................................
      MS = 2
      IF(IBUF(8).GT.0)  MS = 1
C-----------------------------------------------------------------------
C  PERFORM SERIES OF CHECKS ON THE UNPACKED REPORT, MAY TOSS IF PROBLEM
C-----------------------------------------------------------------------
C NUMOB ACCUMULATES TOTAL NUMBER OF REPORTS
      NUMOB(IBAND,INSTR,MS,NS,1) = NUMOB(IBAND,INSTR,MS,NS,1) + 1
C-----------------------------------------------------------------------
C CHECK FILTER FLAG - IF TR80KM=F PROCESS ONLY "GOOD" REPORTS (250 KM
C  RESOLUTION); IF TR80KM=T PROCESS BOTH "GOOD" AND "REDUNDANT" REPORTS
C  (FULL RESOLUTION - 80 KM FOR RTOVS AND 40 KM FOR ATOVS)
      IF(IBUF(20).GT.1)  THEN
C INVALID FILTER FLAG, SKIP TO NEXT REPORT
         KREDTV(NN) = KREDTV(NN) + 1
         PRINT 8757, ID1ST5,IBUF(5)*0.01,ELON,IBUF(20)
 8757 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',I6,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - INVALID FILTER FLAG OF ',I3)
         GO TO 1410
      END IF
      IF(.NOT.TR80KM)  THEN
         IF(IBUF(20).EQ.1) THEN
C FILTER FLAG =1 INDICATES REDUNDANT RETRIEVAL, SKIP TO NEXT REPORT
            KREDTV(NN) = KREDTV(NN) + 1
            GO TO 1410
         ELSE  IF(IBUF(20).EQ.-99) THEN
C FILTER FLAG IS MISSING (=-99), ESTIMATE 250 KM SAMPLING BY PROCESSING
C  ONLY EVERY 4'TH RETRIEVAL FOR RTOVS AND EVERY 11'TH RETRIEVAL FOR
C  ATOVS
            IF(MFIRST.EQ.0)  THEN
               PRINT 9823, SAMPLE(NN)
 9823 FORMAT(/10X,'-->  WARNING: FILTER FLAG IS MISSING -- ESTIMATE 25',
     $ '0 KM SAMPLING BY PROCESSING ONLY EVERY ',A4,', RETRIEVAL  <--'/)
               MFIRST = 1
            END IF
            IF(MOD(KNTRPT-1,ISAMPLE(NN)).NE.0)  THEN
               KREDTV(NN) = KREDTV(NN) + 1
               GO TO 1410
            END IF
         END IF
      END IF
C W3CNVXTOVS: REFORMAT AS UNPACKED IW3UNPBF AND APPEND PROPER SUFFIX
C  CHARACTER TO STATION ID
      CALL W3CNVXTOVS(IBUF,RDATA,STNID,INSTR,ID1ST5,NN)
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
      CALL CHKREP(KMSGTV(NN),KBDYTV(NN),*1410)
C-----------------------------------------------------------------------
C KEEP OR EXCLUDE RETRIEVALS BASED ON LAND/OCEAN, LAT BAND, SAT.#, RETR.
C  TYPE, TOP LVL, & TIME WINDOW INDECES - ARRAY (IBAND,NS) WHERE IBAND
C IS LATITUDE BAND INDEX AND NS IS SATELLITE NUMBER INDEX DEFINED ABOVE
C-----------------------------------------------------------------------
      IF(MS.EQ.1)  THEN
C CHECK IF OVERLAND REPORTS ARE TO BE EXCLUDED {ISATLS(IBAND,NS,1) = 2}
         IF(ISATLS(IBAND,NS,1).EQ.2)  THEN
            KLNDTV(NN) = KLNDTV(NN) + 1
            GO TO 1410
         END IF
      ELSE
C CHECK IF OCEANIC REPORTS ARE TO BE EXCLUDED {ISATLS(IBAND,NS,1) = 1}
         IF(ISATLS(IBAND,NS,1).EQ.1)  THEN
            KSEATV(NN) = KSEATV(NN) + 1
            GO TO 1410
         END IF
      END IF
C FLAG ALL RETRIEVALS (IRTRV(IBAND,NS,1) = 9999)
      IF(IRTRV(IBAND,NS,1).EQ.9999)  IFLUA = 1
C KEEP ALL RETRIEVALS (IRTRV(IBAND,NS,1) = 0)
      IF(IRTRV(IBAND,NS,1).EQ.0)  GO TO 2100
C CHECK FOR COND WHERE ONLY ONE PATH (RETR. INSTR. TYPE) IS NOT-FLAGGED
      IF(IRTRV(IBAND,NS,1).LE.3)  THEN
         IF(IRTRV(IBAND,NS,1).EQ.INSTR)  GO TO 2100
         IFLUA = 1
      END IF
C CHECK FOR COND WHERE ONLY ONE PATH (RETR. INSTR. TYPE) IS FLAGGED
      IF(IRTRV(IBAND,NS,1).EQ.JRTRV(INSTR))  IFLUA = 1
 2100 CONTINUE
C LEVPM RESET TO LIMITING UPPER MAND. PRESS. LEVEL TO PROCESS DATA
C  (NO PROBLEM CHANGING SWITCH SINCE ALL NON-SAT. U-AIR PROCESSING DONE)
      LEVPM = KTOP(IBAND,NS,1)
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
C TIMWIN_e AND TIMWIN_l ARE THE TIME WINDOWS (RELATIVE TO CYCLE TIME)
C  FOR ACCEPTING REPORTS (EARLIEST AND LATEST, RESPECTIVELY)
      TIMWIN_e = IWINDO_e(IBAND,NS,1)
      TIMWIN_l = IWINDO_l(IBAND,NS,1)
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
        KTIMTV(NN) = KTIMTV(NN) + 1
         GO TO 1410
      END IF
C CALL SUBR. SNDPRP TO PROCESS THE SATELLITE RETRIEVAL
C KEP AND MST COUNT TOTAL RETR. KEPT AND RETR. WITH MOISTURE KEPT, RESP.
      CALL SNDPRP(MS,INSTR,SATMST(IBAND,NS,1),MST,KEP)
      IF(SATMST(IBAND,NS,1))  MSTOB(IBAND,INSTR,MS,1) =
     $ MSTOB(IBAND,INSTR,MS,1) + MST
      KEPOB(IBAND,INSTR,MS,1) = KEPOB(IBAND,INSTR,MS,1) + KEP
C GO BACK AND DECODE NEXT REPORT
      GO TO 1400
  961 CONTINUE
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C FINISHED PROCESSING RPTS IN THIS FILE; SUBR. SNDTBL SUMMARIZES IN TBL
      CALL SNDTBL(IDSAT,NUMOB,KEPOB,MSTOB,NN)
  110 CONTINUE
      KNTTOV(NN) = KOUNT
      NN = NN + 1
      IF(NN.LE.2)  GO TO 700
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SNDTBL
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2001-08-01
C
C ABSTRACT: GENERATES A TABLE WHICH SUMMARIZES SATELLITE RADIANCE/
C   RETRIEVAL REPORT COUNTS FOR RTOVS, ATOVS AND GOES.  TABLE BREAKS
C   UP THE COUNTS ACCORDING TO LATITUDE BAND, PATH (INSTRUMENT),
C   SATELLITE (EVEN/ODD OR, FOR GOES, 2 EVEN AND 2 ODD), AND OCEAN/
C   LAND.  THE TOTAL NUMBER OF REPORTS IS PRINTED AS WELL AS THE NUMBER
C   ACTUALLY KEPT AND THE NUMBER KEPT WITH VALID MOISTURE INFORMATION.
C
C PROGRAM HISTORY LOG:
C 1993-05-31  D. A. KEYSER (W/NMC22) -- ORIGINAL AUTHOR
C 1993-11-02  D. A. KEYSER (W/NMC22) -- FOR SATBFR=T, SUMMARY TABLE
C     EXPANDED TO INCL. COUNTS FROM BOTH NESDIS 40-LVL & NMC I/A RETR.
C 1995-07-12  D. A. KEYSER (W/NMC22) -- MODIFIED TO INCLUDE SUMMARY
C     OF GOES RETRIEVAL COUNTS, VAS SUMMARY REMOVED
C 1996-09-03  D. A. KEYSER -- CAN PROCESS RETR. FROM GOES-ODD SAT (AS
C     WAS FOR GOES-EVEN SAT)
C 1998-06-15  D. A. KEYSER -- REMOVED ALL LOGIC PERTAINING TO TOVS
C     PROCESSING
C 1999-01-20  D. A. KEYSER -- REPL. N-LIST SWITCH "SATLND" WITH NEW
C     SWITCHES "ISATLS" AND "JSATLS" TO HANDLE LAND/SEA SELECTION FOR
C     SATELLITE SNDGS/RADIANCES AND GOES PW RETR. SEPARATELY (ALSO CAN
C     NOW SELECT JUST LAND AS WELL AS JUST SEA OR EVERYWHERE)
C 2000-02-17  D. A. KEYSER -- NOW PROCESS ATOVS DATA
C 2001-06-19  D. A. KEYSER -- CAN NOW PRINT GOES 1x1 FOV CLOUD TOP
C     REPORTS; N-LIST SWITCHES "IWINDO", "SATMST", "ISATLS", "IRTRV"
C     AND "KTOP" NOW MORE SPECIFIC TO POINT TO PAIRS OF EVEN OR ODD
C     GOES SATS. AND TO THE 4 POSSIBLE REPORT TYPES THAT CAN BE
C     GENERATED FROM RTOVS/ATOVS AND GOES SNDG/RAD/RETR. DATA (OLD
C     SWITCHES "JSATLS" AND "FLGOES" NO LONGER NEEDED AND REMOVED);
C     SUBR. STREAMLINED TO PRESENT IMPROVED TABLES, INPUT ARG. "IDSAT"
C     OF LENGTH 4 REPL. OLD ARG. "IEVSAT" AND "IODSAT"
C 2001-08-01  D. A. KEYSER -- N-LIST SWITCH IWINDO SPLIT INTO IWINDO_e
C     (EARLIEST TIME WINDOW) AND IWINDO_l (LATEST TIME WINDOW) FOR
C     SATELLITE SOUNDING/RETRIEVAL/RADIANCE REPORTS ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE)
C
C USAGE:    CALL SNDTBL(IDSAT,NUMOB,KEPOB,MSTOB,NN)
C   INPUT ARGUMENT LIST:
C     IDSAT     - 4-WORD ARRAY HOLDING SATELLITE NO.: WORD 1 - EVEN
C               - RTOVS OR ATOVS, EVEN-1 GOES; WORD 2 - ODD RTOVS OR
C               - ATOVS, ODD-1 GOES; WORD 3 - EVEN-2 GOES (DOES NOT
C               - APPLY TO RTOVS OR ATOVS); WORD 4 - ODD-2 GOES (DOES
C               - NOT APPLY TO RTOVS OR ATOVS)
C     NUMOB     - (5,4,2,4,4) ARRAY HOLDING TOTAL COUNT BY LAT. BAND,
C               - PATH, LAND OR SEA, SAT. NUMBER, AND REPORT TYPE
C     KEPOB     - (5,4,2,4) ARRAY HOLDING KEPT COUNT BY LAT. BAND,
C               - PATH, LAND OR SEA, AND REPORT TYPE
C     MSTOB     - (5,4,2,4) ARRAY HOLDING KEPT MOISTURE COUNT BY LAT.
C               - BAND, PATH, LAND OR SEA, AND REPORT TYPE
C     NN        - SWITCH TO INDICATE SATELLITE TYPE - EITHER
C               - RTOVS (NN=1), ATOVS (NN=2) OR GOES (NN=3)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINES 'SATEDS', 'SATBFR' AND 'GOESDG'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SNDTBL(IDSAT,NUMOB,KEPOB,MSTOB,NN)
      PARAMETER (MAXOBS = 4500)
      LOGICAL  SATMST
      CHARACTER*3   CCAP_1(3),CCAP_3(3),CCAP_4(3)
      CHARACTER*5   CSATEL(4)
      CHARACTER*6   CABEL(4)
      INTEGER  NUMOB(5,4,2,4,4),KEPOB(5,4,2,4),MSTOB(5,4,2,4),IDSAT(4)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/SATSW2/PHI(6),IRTRV(5,4,4),KTOP(5,4,4),IWINDO_e(5,4,4),
     $ IWINDO_l(5,4,4),SATMST(5,4,4),ISATLS(5,4,4)
      COMMON/GOSWCH/GOESND(2),GOESPW(2),GOESCT(2),KNTGIT,KNTGIS,KNTGIP,
     $ KSKPGI,KNDCGI,KNOPGI,KMSGGI,KBDYGI,KTIMGI(3),KLNDGI(3),KSEAGI(3),
     $ KNTGIC,KNOCTP
      DATA  CSATEL/'RTOVS','ATOVS','GOES ','?????'/
      DATA  CABEL/'EVEN-1',' ODD-1','EVEN-2',' ODD-2'/
      DATA  CCAP_1/'I/L','XXX','O/Q'/
      DATA  CCAP_3/'J/M','XXX','P/R'/
      DATA  CCAP_4/'K/N','XXX','S/T'/
      NN = MIN(NN,4)
      PRINT 101, CSATEL(NN)
  101 FORMAT(/,42X,'***** TABLE DETAILING USE OF ',A5,' DATA *****')
      IF(ISATOB.NE.3)  THEN
         PRINT 102, CSATEL(NN),IDSAT(1),IDSAT(2)
  102    FORMAT(/32X,'(FOR ',A5,' SATELLITES - EVEN SAT. NO. IS',I4,
     $    ', ODD SAT. NO. IS',I4,')')
         PRINT 103
  103    FORMAT(//
     $ 24X,'PHI',17X,'- LATITUDE BANDS AS NOTED IN &LDTA'/
     $ 24X,'MOISTURE SWITCH     - T (USE) OR F (EXCLUDE) - SEE SATMST ',
     $ 'IN &LDTA'/
     $ 24X,'LAND/SEA SWITCH     - AS BELOW - SEE ISATLS IN &LDTA'/
     $ 24X,'PATH TYPE SWITCH    - AS BELOW - SEE IRTRV  IN &LDTA'/
     $ 24X,'  (IRTRV DOES NOT APPLY TO RADIANCES!!!)'/)
         PRINT 105
  105    FORMAT(37X,'0 - PROCESS ALL TYPES'/
     $ 37X,'1 - FLAG ALL BUT CLEAR-COLUMN TYPES',9X,'(PATH W,S,A OR E)'/
     $ 37X,'3 - FLAG ALL BUT CLOUDY TYPES',15X,'(PATH Y,U,C OR G)'/
     $ 34X,'9999 - FLAG ALL TYPES'/
     $ 35X,'272 - FLAG ONLY CLEAR-COLUMN TYPES',12X,'(PATH W,S,A OR E)'/
     $ 35X,'544 - FLAG ONLY CLOUDY TYPES',18X,'(PATH Y,U,C OR G)'/)
         PRINT 106
  106    FORMAT(24X,'TOP LEVEL',11X,'- INDEX OF TOPMOST MAND. PRES',
     $    'SURE IN WHICH TO PROCESS DATA - SEE KTOP IN &LDTA'/)
         PRINT 201, PHI,PHI,
     $    ((SATMST(ILAT,ISAT,1),ILAT=1,5),ISAT=1,2),
     $    ((ISATLS(ILAT,ISAT,1),ILAT=1,5),ISAT=1,2),
     $    (( IRTRV(ILAT,ISAT,1),ILAT=1,5),ISAT=1,2),
     $    ((  KTOP(ILAT,ISAT,1),ILAT=1,5),ISAT=1,2),
     $  ((IWINDO_e(ILAT,ISAT,1),ILAT=1,5),ISAT=1,2),
     $  ((IWINDO_l(ILAT,ISAT,1),ILAT=1,5),ISAT=1,2)
  201    FORMAT(//1X,126('_')
     $    /' !',T29,'!',T50,'EVEN SAT',T78,'!',T98,'ODD SAT',T127,'!'
     $    /1X,126('_')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $   /' ! PHI (LAT. STRIPS-DEG. N)',T29,'!',6F8.0,'!',6F8.0,T127,'!'
     $    /1X,126('_')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! MOISTURE SWITCH    ',10X,T29,2('!',4X,5L8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! LAND/SEA SWITCH    ',10X,T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! PATH TYPE SWITCH   ',10X,T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! TOP LEVEL          ',10X,T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! EARLIEST TIME (HOURS)',8X,T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! LATEST   TIME (HOURS)',8X,T29,2('!',4X,5I8,4X),T127,'!')
         PRINT 202, ((NUMOB(ILAT,1,1,ISAT,1)+
     $                NUMOB(ILAT,1,2,ISAT,1),ILAT=1,5),ISAT=1,2),
     $              ((NUMOB(ILAT,3,1,ISAT,1)+
     $                NUMOB(ILAT,3,2,ISAT,1),ILAT=1,5),ISAT=1,2)
  202    FORMAT(1X,126('.')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! TOTAL CNT -CLEAR W/S/A/E ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! TOTAL CNT -CLDY  Y/U/C/G ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /1X,126('_'))
         PRINT 203, PHI,PHI
  203    FORMAT(///1X,126('_')
     $    /' !',T29,'!',T38,'OVERLAND REPORT COUNT',T78,
     $              '!',T90,'OCEANIC REPORT COUNT',T127,'!'
     $    /1X,126('_')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $   /' ! PHI (LAT. STRIPS-DEG. N)',T29,'!',6F8.0,'!',6F8.0,T127,'!'
     $    )
         PRINT 204, ((NUMOB(ILAT,1,ILS,1,1)+
     $                NUMOB(ILAT,1,ILS,2,1),ILAT=1,5),ILS=1,2),
     $              ((NUMOB(ILAT,3,ILS,1,1)+
     $                NUMOB(ILAT,3,ILS,2,1),ILAT=1,5),ILS=1,2)
  204    FORMAT(1X,126('_')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! TOTAL CNT -CLEAR W/S/A/E ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! TOTAL CNT -CLDY  Y/U/C/G ',T29,2('!',4X,5I8,4X),T127,'!')
         PRINT 205, ((KEPOB(ILAT,1,ILS,1),ILAT=1,5),ILS=1,2),
     $              ((KEPOB(ILAT,3,ILS,1),ILAT=1,5),ILS=1,2)
  205    FORMAT(1X,126('.')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! KEPT - CLEAR  W/S/A/E ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! KEPT -  CLDY  Y/U/C/G ',T29,2('!',4X,5I8,4X),T127,'!')
         PRINT 206, ((MSTOB(ILAT,1,ILS,1),ILAT=1,5),ILS=1,2),
     $              ((MSTOB(ILAT,3,ILS,1),ILAT=1,5),ILS=1,2)
  206    FORMAT(1X,126('.')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! KEPT MOIST-CLEAR W/S/A/E ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! KEPT MOIST- CLDY Y/U/C/G ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /1X,126('_')//)
      ELSE
         PRINT 402, IDSAT
  402    FORMAT(/10X,'(FOR GOES SATELLITES - EVEN-1 SAT. NO. IS',I4,
     $    ', ODD-1 SAT. NO. IS',I4,', EVEN-2 SAT. NO. IS',I4,', ODD-2 ',
     $    'SAT. NO. IS',I4,')')
         PRINT 103
         PRINT 115
  115    FORMAT(37X,'0 - PROCESS ALL TYPES'/
     $ 37X,'1 - FLAG ALL BUT CLEAR-COLUMN TYPES',9X,'(PATH I,L,O OR Q)'/
     $ 37X,'3 - FLAG ALL BUT CLOUDY TYPES',15X,'(PATH J,M,P OR R)'/
     $ 37X,'4 - FLAG ALL BUT UNKNOWN TYPES',14X,'(PATH K,N,S OR T)'/
     $ 34X,'9999 - FLAG ALL TYPES'/
     $ 35X,'272 - FLAG ONLY CLEAR-COLUMN TYPES',12X,'(PATH I,L,O OR Q)'/
     $ 35X,'544 - FLAG ONLY CLOUDY TYPES',18X,'(PATH J,M,P OR R)'/
     $ 35X,'118 - FLAG ONLY UNKNOWN TYPES',17X,'(PATH K,N,S OR T)'/)
         PRINT 106
         DO  II=1,3,2
            PRINT 401, CABEL(II),CABEL(II+1),PHI,PHI,
     $       (((SATMST(ILAT,ISAT,ITP),ILAT=1,5),ISAT=II,II+1),ITP=2,2),
     $       (((ISATLS(ILAT,ISAT,ITP),ILAT=1,5),ISAT=II,II+1),ITP=2,4),
     $       ((( IRTRV(ILAT,ISAT,ITP),ILAT=1,5),ISAT=II,II+1),ITP=2,4),
     $       (((  KTOP(ILAT,ISAT,ITP),ILAT=1,5),ISAT=II,II+1),ITP=2,2),
     $     (((IWINDO_e(ILAT,ISAT,ITP),ILAT=1,5),ISAT=II,II+1),ITP=2,4),
     $     (((IWINDO_l(ILAT,ISAT,ITP),ILAT=1,5),ISAT=II,II+1),ITP=2,4)
  401       FORMAT(//1X,126('_')
     $       /' !',T29,'!',T49,A6,' SAT',T78,'!',T95,A6,' SAT',T127,'!'
     $       /1X,126('_')
     $       /' !',T29,'!',T78,'!',T127,'!'
     $   /' ! PHI (LAT. STRIPS-DEG. N)',T29,'!',6F8.0,'!',6F8.0,T127,'!'
     $       /1X,126('_'),
     $       /' !',T29,'!',T78,'!',T127,'!'
     $       /' ! MOISTURE SWITCH -     ',T29,'!',T78,'!',T127,'!'
     $       /' !   SOUNDINGS           ',T29,2('!',4X,5L8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' ! LAND/SEA SWITCH -     ',T29,'!',T78,'!',T127,'!'
     $       /' !   RADIANCES/SOUNDINGS ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   PWATER RETRIEVALS   ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   CLOUD TOP RETRIEVALS',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' ! PATH TYPE SWITCH -    ',T29,'!',T78,'!',T127,'!'
     $       /' !   SOUNDINGS           ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   PWATER RETRIEVALS   ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   CLOUD TOP RETRIEVALS',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' ! TOP LEVEL -           ',T29,'!',T78,'!',T127,'!'
     $       /' !   SOUNDINGS           ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' ! EARLIEST TIME (HRx100) - ',T29,'!',T78,'!',T127,'!'
     $       /' !   RADIANCES/SOUNDINGS ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   PWATER RETRIEVALS   ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   CLOUD TOP RETRIEVALS',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' ! LATEST   TIME (HRx100) - ',T29,'!',T78,'!',T127,'!'
     $       /' !   RADIANCES/SOUNDINGS ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   PWATER RETRIEVALS   ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !   CLOUD TOP RETRIEVALS',T29,2('!',4X,5I8,4X),T127,'!')
            PRINT 403,CCAP_1(II),((((NUMOB(ILAT,1,1,ISAT,ITP)+
     $                               NUMOB(ILAT,1,2,ISAT,ITP)),ILAT=1,5)
     $ ,                                         ISAT=II,II+1),ITP=2,3),
     $                CCAP_3(II),((((NUMOB(ILAT,3,1,ISAT,ITP)+
     $                               NUMOB(ILAT,3,2,ISAT,ITP)),ILAT=1,5)
     $ ,                                         ISAT=II,II+1),ITP=2,3),
     $                CCAP_4(II),((((NUMOB(ILAT,4,1,ISAT,ITP)+
     $                               NUMOB(ILAT,4,2,ISAT,ITP)),ILAT=1,5)
     $ ,                                         ISAT=II,II+1),ITP=4,4)
  403       FORMAT(1X,126('.')
     $       /' !',T29,'!',T78,'!',T127,'!'
     $       /' ! TOTAL COUNT -             ',T29,'!',T78,'!',T127,'!'
     $       /' !   CLEAR -           (',A3,')',T29,'!',T78,'!',T127,'!'
     $       /' !     RADIANCES/SOUNDINGS',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !     PWATER RETRIEVALS  ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' !   CLOUDY -          (',A3,')',T29,'!',T78,'!',T127,'!'
     $       /' !     RADIANCES/SOUNDINGS',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !     PWATER RETRIEVALS  ',T29,2('!',4X,5I8,4X),T127,'!'
     $       /' !',T29,'!',T78,'!',T127,'!',
     $       /' !   UNKNOWN -         (',A3,')',T29,'!',T78,'!',T127,'!'
     $      /' !     CLOUD TOP RETRIEVALS',T29,2('!',4X,5I8,4X),T127,'!'
     $       /1X,126('_'))
         END DO
         PRINT 404, PHI,PHI
  404    FORMAT(///1X,126('_')
     $    /' !',T29,'!',T38,'OVERLAND REPORT COUNT',T78,
     $              '!',T90,'OCEANIC REPORT COUNT',T127,'!'
     $    /1X,126('_')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $   /' ! PHI (LAT. STRIPS-DEG. N)',T29,'!',6F8.0,'!',6F8.0,T127,'!'
     $    )
         PRINT 405, ((((NUMOB(ILAT,1,ILS,1,ITP)+
     $                  NUMOB(ILAT,1,ILS,2,ITP)+
     $                  NUMOB(ILAT,1,ILS,3,ITP)+
     $                  NUMOB(ILAT,1,ILS,4,ITP)),ILAT=1,5),
     $                                           ILS=1,2),ITP=2,3),
     $              ((((NUMOB(ILAT,3,ILS,1,ITP)+
     $                  NUMOB(ILAT,3,ILS,2,ITP)+
     $                  NUMOB(ILAT,3,ILS,3,ITP)+
     $                  NUMOB(ILAT,3,ILS,4,ITP)),ILAT=1,5),
     $                                           ILS=1,2),ITP=2,3),
     $              ((((NUMOB(ILAT,4,ILS,1,ITP)+
     $                  NUMOB(ILAT,4,ILS,2,ITP)+
     $                  NUMOB(ILAT,4,ILS,3,ITP)+
     $                  NUMOB(ILAT,4,ILS,4,ITP)),ILAT=1,5),
     $                                           ILS=1,2),ITP=4,4)
  405    FORMAT(1X,126('_')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! TOTAL COUNT -            ',T29,'!',T78,'!',T127,'!'
     $    /' !   CLEAR -       (I/L/O/Q)',T29,'!',T78,'!',T127,'!'
     $    /' !     RADIANCES/SOUNDINGS  ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !     PWATER RETRIEVALS    ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!',
     $    /' !   CLOUDY -      (J/M/P/R)',T29,'!',T78,'!',T127,'!'
     $    /' !     RADIANCES/SOUNDINGS  ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !     PWATER RETRIEVALS    ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!',
     $    /' !   UNKNOWN -     (K/N/S/T)',T29,'!',T78,'!',T127,'!'
     $    /' !     CLOUD TOP RETRIEVALS ',T29,2('!',4X,5I8,4X),T127,'!')
         PRINT 406,(((KEPOB(ILAT,1,ILS,ITP),ILAT=1,5),
     $                                       ILS=1,2),ITP=2,3),
     $             (((KEPOB(ILAT,3,ILS,ITP),ILAT=1,5),
     $                                       ILS=1,2),ITP=2,3),
     $             (((KEPOB(ILAT,4,ILS,ITP),ILAT=1,5),
     $                                       ILS=1,2),ITP=4,4)
  406    FORMAT(1X,126('.')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! KEPT -                   ',T29,'!',T78,'!',T127,'!'
     $    /' !   CLEAR -       (I/L/O/Q)',T29,'!',T78,'!',T127,'!'
     $    /' !     RADIANCES/SOUNDINGS  ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !     PWATER RETRIEVALS    ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!',
     $    /' !   CLOUDY -      (J/M/P/R)',T29,'!',T78,'!',T127,'!'
     $    /' !     RADIANCES/SOUNDINGS  ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !     PWATER RETRIEVALS    ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!',
     $    /' !   UNKNOWN -     (K/N/S/T)',T29,'!',T78,'!',T127,'!'
     $    /' !     CLOUD TOP RETRIEVALS ',T29,2('!',4X,5I8,4X),T127,'!')
         PRINT 407, (((MSTOB(ILAT,1,ILS,ITP),ILAT=1,5),
     $                                        ILS=1,2),ITP=2,2),
     $              (((MSTOB(ILAT,3,ILS,ITP),ILAT=1,5),
     $                                        ILS=1,2),ITP=2,2)
  407    FORMAT(1X,126('.')
     $    /' !',T29,'!',T78,'!',T127,'!'
     $    /' ! KEPT MOISTURE -          ',T29,'!',T78,'!',T127,'!'
     $    /' !   CLEAR -       (I/L/O/Q)',T29,'!',T78,'!',T127,'!'
     $    /' !     SOUNDINGS            ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /' !',T29,'!',T78,'!',T127,'!',
     $    /' !   CLOUDY -      (J/M/P/R)',T29,'!',T78,'!',T127,'!'
     $    /' !     SOUNDINGS            ',T29,2('!',4X,5I8,4X),T127,'!'
     $    /1X,126('_')//)

      END IF
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SNDPRP
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 1998-06-15
C
C ABSTtACT: PREPROCESSES RTOVS OR ATOVS SATELLITE RETRIEVALS
C   ORIGINALLY UNPACKED IN NMCEDS FORMAT.  SETS UP VALUES FOR REPORT
C   TYPE IN HDR(6) AND COMPUTES THICKNESS RELATIVE TO 1000 MB HEIGHT.
C   FINALLY, CALLS SUBROUTINE 'GETUPA' TO BEGIN PROCESSING REPORT.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1987-06-14  D. A. KEYSER -- ADDED CAPABILITY TO PROCESS DMSP AND VAS;
C     OLD SUBR. TIREPT RENAMED; OLD SUBR. TIRPT REMOVED
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1988-08-24  D. A. KEYSER -- CHGED OI R.T. 'OTHER' TOVS RETR TO 160,170
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1993-05-31  D. A. KEYSER -- "KMAX" NOW APPLIES TO ALL VARIABLES AND
C     TO MAND. AND SIGNIF. LVLS FOR ALL SAT. RETR. TYPES; REDEFINED
C     OI/SSI REPORT TYPES FOR SATELLITE RETRIEVALS
C 1995-07-12  D. A. KEYSER -- REMOVED LOGIC TO PROCESS VAS RETRIEVALS
C 1998-06-15  D. A. KEYSER -- REMOVED ALL LOGIC PERTAINING TO TOVS
C     PROCESSING
C
C USAGE:    CALL SNDPRP(MS,INSTR,MSTSAT,MST,KEP)
C   INPUT ARGUMENT LIST:
C     MS       - OVERLAND (=1), OCEANIC (=2) SWITCH
C     INSTR    - RETRIEVAL INSTRUMENT TYPE (PATH) SWITCH
C              - (EITHER 1 OR 3)
C     MSTSAT   - LOGICAL SWITCH TO PROCESS MOISTURE (IF = TRUE)
C
C   OUTPUT ARGUMENT LIST:
C     MST      - SWITCH IF MOISTURE WAS PROCESSED (=1, OTHERWISE =0)
C     KEP      - SWITCH IF REPORT IS TO BE KEPT (=1, OTHERWISE =0)
C
C REMARKS: CALLED BY SUBROUTINE 'SATEDS'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SNDPRP(MS,INSTR,MSTSAT,MST,KEP)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MAXOBS = 4500)
      LOGICAL  MSTSAT
      CHARACTER*8  STNID,SUBSET_d
      INTEGER  IDATA(MAXOBS)
      real(8)  alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      EQUIVALENCE  (IDATA,RDATA)
      DATA  XMISS/99999./,YMISS/99998.8/
      MST = 0
C IDENTIFY PROPER PREPBUFR REPORT TYPE FOR RTOVS OR ATOVS
C  RETRIEVALS....
C    OCEANIC  ---> 171 (CLEAR), 173 (CLOUDY)
C    OVERLAND ---> 161 (CLEAR), 163 (CLOUDY)
C ALL RETRIEVAL TYPES CONTAIN ONLY CATEGORY 1 (MANDATORY LEVEL) INFO.
      IDATA(15) = 0
      IDATA(17) = 0
      IDATA(19) = 0
      IDATA(21) = 0
      IDATA(31) = 0
      HDR(6) = 160 + (10 * (MS - 1)) + INSTR
C LEVPM NO LARGER THAN NUMBER OF MAND. LVLS; RESET LEVST & LEVQQ = LEVPM
      LEVPM = MIN(LEVPM,IDATA(13))
      LEVST = LEVPM
      LEVQQ = LEVPM
      L1 = IDATA(14)
      Z1000 = RDATA(L1+1)
      DO K = 1,LEVPM
         L = (11 * (K - 1)) + IDATA(14)
C HEIGHT IS CONVERTED TO THICKNESS RELATIVE TO 1000 MB HEIGHT
         IF(MAX(Z1000,RDATA(L+1)).LT.YMISS.AND.Z1000.NE.0.)
     $    RDATA(L+1) = RDATA(L+1) - Z1000
C CHECK FOR VALID MOISTURE DATA FOR SETTING SWITCH FOR TABLE
         IF(.NOT.MSTSAT)  RDATA(L+3) = XMISS
         IF(RDATA(L+3).LT.YMISS.AND.RDATA(L+3).GE.0)  MST = 1
         RDATA(L+4) = XMISS
         RDATA(L+5) = XMISS
      ENDDO
C CALL SUBR. GETUPA TO PROCESS THE RTOVS OR ATOVS SATELLITE RETRIEVAL
      CALL GETUPA(*30,*25)
   30 CONTINUE
      KEP = 1
      RETURN
   25 CONTINUE
      KEP = 0
      MST = 0
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SATBFR
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2001-10-10
C
C ABSTRACT: DECODES RADIANCES AND/OR 40-LEVEL RETRIEVALS FROM
C   INPUT RTOVS AND ATOVS BUFR DATA DUMP FILES, PROCESSING ONE REPORT
C   AT A TIME.  PERFORMS SEVERAL CHECKS ON THE DATA, AND ACCUMULATES
C   COUNTS FOR VALID REPORTS BEFORE CALLING SUBROUTINES TO ACTUALLY
C   PROCESS REPORTS INTO THE REQUESTED OUTPUT FORMAT.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1993-05-31  D. A. KEYSER -- ORIGINAL AUTHOR
C 1993-11-02  D. A. KEYSER -- VARIABLE IFLUA WHEN SET TO 1 WILL FLAG
C     ALL VARIABLES WITH PREPBUFR T. VAL=15; CAN NOW PROCESS MIXTURE OF
C     NESDIS 40LVL & NMC I/A RETR.
C 1993-12-21  D. A. KEYSER -- ONLY TOVS I/A RETR. SET ELEV TO HGHT OF
C     1ST (SFC) LVL & ONLY TOVS I/A RETR. SET PSTN (1ST LVL) TO PBOT
C     VALUE RETURNED FROM W3FI80, NESDIS 40-LVL RETR. CAN'T GET A PSTN
C 1996-09-03  D. A. KEYSER -- PROCESSING OF TOVS RADIANCES PARTIALLY
C     DONE (SWITCH "TOVRAD")
C 1996-10-24  D. A. KEYSER -- LOGIC ADDED TO PROCESS TOVS RADIANCES
C     FROM BUFR DUMP FILE AND ENCODE THEM INTO PREPBUFR FILE, CALL TO
C     W3FI80 REPLACED BY W3TOVUNP, N-LIST SWITCHES "TOVRAD" AND
C     "TOVRTV" ADDED TO PROCESS RADIANCES AND RETRIEVALS RESP.; LOGIC
C     RELATED TO INTERACTIVE RETR. PROCESSING REMOVED; ADDED CALL TO
C     BUFRLIB "DATEBF" TO RETURN CENTER DATE FOR TOVS BUFR DATA DUMP
C     FILES (SIMPLIFIES OTHER TIME-CHECKING PROCEDURES)
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C     TYPES (CURRENTLY JUST 100); STDOUT EXPANDED TO INCL. REASON CODES
C 1998-05-15  D. A. KEYSER -- ADDED PROCESSING OF RTOVS DATA BASED ON
C     NEW NAMELIST SWITCH "RTOVS", NEW IN-LINE ROUTINE W3RTVUNP ADDED
C     FOR INTERFACE WITH RTOVS DATA RETURNING 40-LVL/RADIANCES
C 1998-06-15  D. A. KEYSER -- REMOVED ALL LOGIC PERTAINING TO TOVS
C     PROCESSING (SUBR. 'TOVSID' & 'TDEW' NO LONGER CALLED - REMOVED,
C     N-LIST SWITCH 'RTOVS' REMOVED; N*/PTLY-CLDY PATH NO LONGER
C     POSSIBLE); RTOVS 250KM SUB-SAMPLING NOW DEPENDS UPON VALUE IN
C     FILTER FLAG AS WAS THE CASE FOR TOVS (FIX BY NESDIS) (BEFORE
C     250KM SUB-SAMPLING WAS EST. BY PROCESSING EVERY 4'TH RTOVS REPORT)
C 1999-01-20  D. A. KEYSER -- REPL. N-LIST SWITCH "SATLND" WITH NEW
C     SWITCHES "ISATLS" AND "JSATLS" TO HANDLE LAND/SEA SELECTION FOR
C     SATELLITE SNDGS/RADIANCES AND GOES PW RETR. SEPARATELY (ALSO CAN
C     NOW SELECT JUST LAND AS WELL AS JUST SEA OR EVERYWHERE)
C 2000-02-17  D. A. KEYSER -- SUBR. W3RTVUNP RENAMED TO W3RTOVSUNP; CAN
C     NOW PROCESS ATOVS DATA VIA NEW SUBR. W3ATOVSUNP (40-LVL/35
C     RADIANCES); IF FILTER FLAG=-99 AND TR80KM=F, PROCESS ONLY EVERY
C     4'TH UNPACKED RTOVS RETRIEVAL TO SIMULATE 250 KM SUB-SAMPLING
C     (RTOVS DUMP FILE PRIOR TO 7/1/1998 - NO FILTER FLAG INFORMATION
C     AVAILABLE - NEEDED FOR HISTORICAL CDAS RUNS)
C 2001-04-06  D. A. KEYSER -- SUBR. "RPTLBL" NOW HAS INPUT ARGS.
C     "TIMWIN_e" (EARLIEST TIME WINDOW) AND "TIMWIN_l" (LATEST TIME
C     WINDOW) REPL. "TIMWIN" (+/- TIME WINDOW) ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME), ALLOWS THE 2 TO BE DIFFERENT
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"; N-LIST SWITCHES "IWINDO", "SATMST",
C     "ISATLS", "IRTRV" AND "KTOP" NOW MORE SPECIFIC TO POINT TO PAIRS
C     OF EVEN OR ODD GOES SATS. (NOT USEFUL HERE) AND TO THE 4 POSSIBLE
C     REPORT TYPES THAT CAN BE GENERATED FROM RTOVS/ ATOVS AND GOES
C     SNDG/RAD/RETR. DATA
C 2001-08-01  D. A. KEYSER -- N-LIST SWITCH IWINDO SPLIT INTO IWINDO_e
C     (EARLIEST TIME WINDOW) AND IWINDO_l (LATEST TIME WINDOW) FOR
C     SATELLITE SOUNDING/RETRIEVAL/RADIANCE REPORTS ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE); IN
C     RESPONSE TO CHANGE TO SUBR. W3ATOVSUNP, NOW PASSES IER=0 INTO
C     SUBR. UPON FIRST CALL FOR ATOVS DATA (SIGNALS INPUT BUFR FILE
C     IS A DATA DUMP)
C 2001-10-10  D. A. KEYSER -- STORES BUFR SATELLITE ID IN UNPACKED
C     IW3UNPBF WORD 6 SO IT CAN LATER BE ENCODED INTO PREPBUFR FILE
C 2020-08-20 J. Dong -- Defined IDSDAT to eliminate Boundary Run-Time
C     Check Failures.
C
C USAGE:    CALL SATBFR
C   INPUT FILES:
C     UNIT GG   - RTOVS BUFR DATA FILE (SOUNDINGS/RETRIEVALS/RADIANCES)
C     UNIT GG+1 - ATOVS BUFR DATA FILE (SOUNDINGS/RETRIEVALS/RADIANCES)
C    (WHERE GG IS UNIT NUMBER DEFINED AS IUNIT(7) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.  FOR PROCESSING OF RTOVS OR
C   ATOVS DATA RETURNED IN UNPACKED NMCEDS FORMAT, SEE SUBROUTINE
C   SATEDS.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SATBFR
CCC
C  SATELLITE AND PATH (INSTR.) INDICATED BY  CHARACTER 8 OF STN. ID
C  SAT. NO. DESIG'N: ODD1  - 3,7,11,15,19,...; ODD2  - 1,5, 9,13,17,...
C                    EVEN1 - 2,6,10,14,18,...; EVEN2 - 4,8,12,16,20,...
C          SUFFIX A,E ---> CLEAR  PATH FROM ODD1  (A) OR ODD2  (E) SAT.
C          SUFFIX S,W ---> CLEAR  PATH FROM EVEN1 (S) OR EVEN2 (W) SAT.
C          SUFFIX C,G ---> CLOUDY PATH FROM ODD1  (C) OR ODD2  (G) SAT.
C          SUFFIX U,Y ---> CLOUDY PATH FROM EVEN1 (U) OR EVEN2 (Y) SAT.
C
C  RTOVS VS. ATOVS INDICATED BY CHARACTER 7 OF STN. ID ("R" OR "A")
C
CCC
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS))
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*4  SAMPLE(2)
      CHARACTER*5  CTYPE(2)
      CHARACTER*8  STNID,STNPRT,DSNAME,SUBSET_d
      LOGICAL  TR80KM,SATMST,TOVRAD,TOVRTV,TOVBFR
      INTEGER  NUMOB(5,4,2,4,4),KEPOB(5,4,2,4),MSTOB(5,4,2,4),JRTRV(3),
     $ IPRT(2),IQ(MXLVL,NUMQMS),JQ(MXLVL,NUMQMS),IDATA(MAXOBS),
     $ IR(MXLVL,NUMQMS),JR(MXLVL,NUMQMS),KSATOB(11),IRTCHN(35),IDSAT(4),
     $ ISAMPLE(2)
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL  PP(MXLVL),ZP(MXLVL),TP(MXLVL),QP(MXLVL),TMP(MXLVL,NUMDAT),
     $ CLAL(MXLVL),CLAM(MXLVL),RSATOB(17)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/TVSWCH/TOVEDS(2),TOVBFR(2),TR80KM,KNTTOV(2),
     $ KSKPTV(2),KNOPTV(2),KIPTTV(2),KMSGTV(2),KBDYTV(2),KTIMTV(2),
     $ KLNDTV(2),KSEATV(2),KREDTV(2),KJFLAG(2)
      COMMON/SATSW2/PHI(6),IRTRV(5,4,4),KTOP(5,4,4),IWINDO_e(5,4,4),
     $ IWINDO_l(5,4,4),SATMST(5,4,4),ISATLS(5,4,4)
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE (DAT,PP),(DAT(1,2),ZP),(DAT(1,3),TP),(DAT(1,4),QP),
     $ (DAT(1,NUMVAR+1),IQ),(TMP(1,NUMVAR+1),JQ),(RDATA,IDATA)
      EQUIVALENCE(DAT(1,NUMVAR+NUMQMS+1),IR),(TMP(1,NUMVAR+NUMQMS+1),JR)
      DATA  XMISS/99999./,JRTRV/272,99999,544/,CTYPE/'RTOVS','ATOVS'/,
     $ MFIRST/0/,SAMPLE/' 4TH','11TH'/,ISAMPLE/4,11/,IMISS/99999/,
     $ YMISS/99998.8/
      NN = 1
  700 CONTINUE
C KOUNT COUNTS NO. OF REPORTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
C NN WILL INDICATE WHICH FILE IS BEING EXAMINED:
C    NN = 1 ===> RTOVS
C    NN = 2 ===> ATOVS
      IF(.NOT.TOVBFR(NN))  GO TO 110
C INITIALIZE NUMOB, KEPOB, AND MSTOB ARRAYS
      NUMOB = 0
      KEPOB = 0
      MSTOB = 0
      IDSAT = 0
      NFILE = IUNIT(7) + NN - 1
      PRINT 9013, CTYPE(NN),NFILE
 9013 FORMAT(//28X,'***** ',A5,' SATELLITE RADIANCE/40-LEVEL ',
     $ 'RETRIEVAL FILE    UNIT =',I4,' *****')
      PRINT 550, IDATE
  550 FORMAT(25X,'LOOKING FOR FILE WITH CENTER DATE: ',2X,I4.4,
     $ 2('-',I2.2),1X,I2.2,'Z  BASED ON PRODUCTION DATE')
      IF(.NOT.TR80KM)  THEN
         PRINT 581
  581    FORMAT(/27X,'-->  ORIGINAL FULL RESOLUTION REPORTS ARE ',
     $    'FILTERED TO 250 KM RESOLUTION  <--'/)
      ELSE
         PRINT 583
  583    FORMAT(/37X,'-->  ALL REPORTS (AT FULL RESOLUTION) ARE ',
     $    'PROCESSED  <--'/)
      END IF
C KNTRPT WILL COUNT NUMBER OF RPTS SUCCESSFULLY DECODED FOR EACH FILE
      KNTRPT = 0
C INITIALIZE RTRAD, DAT, CLAL & CLAM ARRAYS {ONLY NEED TO DO THIS PRIOR
C  TO 1ST CALL TO W3RTOVSUNP/W3ATOVSUNP SINCE THESE SUBR. WILL ALWAYS
C  INITALIZE 1ST 40 WORDS IN THESE ARRAYS (IF APPLICABLE TO SUBROUTINE)
C  PRIOR TO DECODING EACH RETRIEVAL}
      RTRAD = XMISS
      DAT   = XMISS
      CLAL  = XMISS
      CLAM  = XMISS
C FOR ATOVS REPORTS, SET IER TO 0 TO INDICATE TO W3ATOVSUNP THAT INPUT
C  BUFR FILE IS A DATA DUMP
      IF(NN.EQ.2)  IER   = 0
      GO TO 1400
C#######################################################################
C#######################################################################
 1410 CONTINUE
C KSKPTV WILL COUNT NO. OF DECODED REPORTS SKIPPED (VARIOUS REASONS)
      KSKPTV(NN) = KSKPTV(NN) + 1
 1400 CONTINUE
C INITIALIZE IQ, TMP AND JQ ARRAYS PRIOR TO EACH CALL
      IQ  = 16
      TMP = XMISS
      JQ  = 16
C INITIALIZE ALL REASON CODES AS 100 (ORIGINAL DATA) PRIOR TO EACH CALL
      IR = 100
      JR = 100
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
      IF(NN.EQ.1)  THEN
C ATTEMPT TO DECODE THE NEXT RTOVS REPORT
         CALL W3RTOVSUNP(NFILE,IDATEM,PP,TP,QP,CLAL,CLAM,NLVL,IRTCHN,
     $    RTRAD,NCHN,STNID,KSATOB,RSATOB,DSNAME,IDSDAT,IDSDMP_8,IER)
      ELSE
C ATTEMPT TO DECODE THE NEXT ATOVS REPORT
         CALL W3ATOVSUNP(NFILE,IDATEM,PP,TP,QP,NLVL,IRTCHN,RTRAD,NCHN,
     $    STNID,KSATOB,RSATOB,DSNAME,IDSDAT,IDSDMP_8,IER)
      END IF
      IFLUA = 0
C.......................................................................
      IF(IER.EQ.-3)  THEN
         PRINT 8002, NFILE
 8002    FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN FIRST ',
     $    'CALL TO FILE IN UNIT',I4,' -- THIS MAY BE A NULL FILE -- ',
     $    'GO TO NEXT FILE'/)
         RETURN
C.......................................................................
      ELSE  IF(IER.EQ.1)  THEN
C IER = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
         PRINT 7000, DSNAME,IDSDAT,IDSDMP_8
 7000    FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $    I10.10,'; DUMP TIME: ',I12.12,' <--'//)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
         IF(IDSDAT.NE.IDAT10)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
            RETURN
         END IF
         GO TO 1400
C.......................................................................
      ELSE  IF(IER.LT.0.OR.IER.GT.2)  THEN
C ERROR DECODING REPORT, DO NOT DECODE ANY MORE REPORTS AT THIS POINT
         PRINT 572, NFILE,KNTRPT+1,IER
  572 FORMAT(/' >>>>>  B U F R   D E C O D E   E R R O R   O N   UNIT',
     $ I3,'   --   R E P O R T   C N T .   ',I5,'   --   I E R   ',I5,
     $ '  <<<<<'/)
         GO TO 10
C.......................................................................
      ELSE  IF(IER.EQ.2)  THEN
C IF IER = 2, HAVE HIT END-OF-FILE, ALL REPORTS PROCESSED
         GO TO 10
C.......................................................................
      END IF
C A REPORT WAS SUCCESSFULLY DECODED
      SKINT  = RSATOB(6)
      OZONE  = RSATOB(8)
      SOZANG = RSATOB(11)
      SAZANG = RSATOB(12)
      KNTRPT = KNTRPT + 1
      CYCLET = IDATE(4) + idatmm / 60.d0
C INITIALIZE UNPACKED IW3UNPBF FORMATTED ARRAY FOR THIS REPORT
      RDATA = XMISS
      RDATA(3) =  0.
      RDATA(5) =  0.
      IDATA(6) = KSATOB(1)
      RDATA(7) = RSATOB(4)
      IDATA(8) = IMISS
      IDATA(9) = 61
      RDATA(10)=  0.
      IDATA(13:42) = 0
C FILL UNPACKED IW3UNPBF RDATA WORDS 1, 2, 4 WITH LAT, LON, OBS. TIME
      IF(RSATOB(2).LT.XMISS)  RDATA(1) = RSATOB(2)
      IF(RSATOB(3).LT.XMISS)  RDATA(2) = RSATOB(3)
      IF(RSATOB(1).LT.XMISS)  RDATA(4) = RSATOB(1)
cfix? IF(RSATOB(2).LT.YMISS)  RDATA(1) = RSATOB(2)
cfix? IF(RSATOB(3).LT.YMISS)  RDATA(2) = RSATOB(3)
cfix? IF(RSATOB(1).LT.YMISS)  RDATA(4) = RSATOB(1)
C-----------------------------------------------------------------------
C         REPORT COUNTS STORED IN ARRAY: NUMOB(IBAND,INSTR,MS,NS,1)
C         WHERE: IBAND IS LAT. BAND INDEX, INSTR IS PATH TYPE INDEX
C               MS IS LAND/OCEAN SWITCH AND NS IS SAT # INDEX
C   ** PERFORM CHECKS ON SATELLITE NUMBER AND PATH, TOSS IF PROBLEM **
C-----------------------------------------------------------------------
C.......................................................................
C IDENTIFY LATITUDE (PHI) BAND INDEX ---> IBAND
C.......................................................................
      DO IBAND = 1,4
         IF(NINT(RDATA(1)*100.).LT.(NINT(PHI(IBAND+1)*100.)-0.5))
     $    GO TO 1800
      ENDDO
C NOTE: IN RARE EVENT THAT LAT. MSG, IBAND SET TO 5 (RPT. LATER SKIPPED)
      IBAND = 5
 1800 CONTINUE
C.......................................................................
C IDENTIFY SATELLITE NUMBER INDEX ---> NS (=1 EVEN SAT. ; =2 ODD  SAT.)
C.......................................................................
      NS = 0
      IF(STNID(8:8).GE.'S'.AND.STNID(8:8).LE.'Z')  THEN
         NS = 1
      ELSE  IF(STNID(8:8).GE.'A'.AND.STNID(8:8).LE.'H')  THEN
         NS = 2
      ELSE
C IF REPORT NOT FROM AN OPERATIONAL SATELLITE SKIP IT
         KNOPTV(NN) = KNOPTV(NN) + 1
         PRINT 8758, STNID,RDATA(1),RDATA(2)
 8758 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - FROM NON-OPERATIONAL SATELLITE')
C GO BACK AND DECODE NEXT REPORT
         GO TO 1410
      END IF
      IDSAT(NS) = KSATOB(1)
C.......................................................................
C IDENTIFY PATH ---> INSTR {=1 CLEAR; =3 CLOUDY}
C  (NOTE: INSTR = 2 IS NOT A POSSIBILITY)
C.......................................................................
      INSTR = MOD(KSATOB(2),10)
      IF(INSTR.NE.1.AND.INSTR.NE.3)  THEN
C IF PATH (INSTRUMENT) NOT RECOGNIZED SKIP (NOTE: SHOULD NEVER HAPPEN)
         KIPTTV(NN) = KIPTTV(NN) + 1
         PRINT 8759, STNID,RDATA(1),RDATA(2),KSATOB(2)
 8759 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - HAS INVALID PATH')
C GO BACK AND DECODE NEXT REPORT
         GO TO 1410
      END IF
C.......................................................................
C IDENTIFY OVERLAND/OCEANIC SWITCH ---> MS (=1 OVERLAND; =2 OCEANIC)
C.......................................................................
      MS = 2
      IF(KSATOB(2).LT.170)  MS = 1
C-----------------------------------------------------------------------
C  PERFORM SERIES OF CHECKS ON THE UNPACKED REPORT, MAY TOSS IF PROBLEM
C-----------------------------------------------------------------------
C NUMOB ACCUMULATES TOTAL NUMBER OF REPORTS
      NUMOB(IBAND,INSTR,MS,NS,1) = NUMOB(IBAND,INSTR,MS,NS,1) + 1
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
      CALL CHKREP(KMSGTV(NN),KBDYTV(NN),*1410)
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
C TIMWIN_e AND TIMWIN_l ARE THE TIME WINDOWS (RELATIVE TO CYCLE TIME)
C  FOR ACCEPTING REPORTS (EARLIEST AND LATEST, RESPECTIVELY)
      TIMWIN_e = IWINDO_e(IBAND,NS,1)
      TIMWIN_l = IWINDO_l(IBAND,NS,1)
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMTV(NN) = KTIMTV(NN) + 1
         GO TO 1410
      END IF
C.......................................................................
      IF(MS.EQ.1)  THEN
C CHECK IF OVERLAND REPORTS ARE TO BE EXCLUDED {ISATLS(IBAND,NS,1) = 2}
         IF(ISATLS(IBAND,NS,1).EQ.2)  THEN
            KLNDTV(NN) = KLNDTV(NN) + 1
            GO TO 1410
         END IF
      ELSE
C CHECK IF OCEANIC REPORTS ARE TO BE EXCLUDED {ISATLS(IBAND,NS,1) = 1}
         IF(ISATLS(IBAND,NS,1).EQ.1)  THEN
            KSEATV(NN) = KSEATV(NN) + 1
            GO TO 1410
         END IF
      END IF
C.......................................................................
C CHECK FILTER FLAG - IF TR80KM=F PROCESS ONLY "GOOD" REPORTS (250 KM
C  RESOLUTION); IF TR80KM=T PROCESS BOTH "GOOD" AND "REDUNDANT" REPORTS
C  (FULL RESOLUTION - 80 KM FOR RTOVS AND 40 KM FOR ATOVS)
      IF(KSATOB(7).GT.1)  THEN
C INVALID FILTER FLAG, SKIP TO NEXT REPORT
         KREDTV(NN) = KREDTV(NN) + 1
         PRINT 8757, STNID,RDATA(1),RDATA(2),KSATOB(7)
 8757 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - INVALID FILTER FLAG ( > 1) OF ',I2)
         GO TO 1410
      END IF
      IF(.NOT.TR80KM)  THEN
         IF(KSATOB(7).EQ.1)  THEN
C FILTER FLAG =1 INDICATES REDUNDANT RETRIEVAL, SKIP TO NEXT REPORT
            KREDTV(NN) = KREDTV(NN) + 1
            GO TO 1410
         ELSE  IF(KSATOB(7).EQ.-99) THEN
C FILTER FLAG IS MISSING (=-99), ESTIMATE 250 KM SAMPLING BY PROCESSING
C  ONLY EVERY 4'TH RETRIEVAL FOR RTOVS AND EVERY 11'TH RETRIEVAL FOR
C  ATOVS
            IF(MFIRST.EQ.0)  THEN
               PRINT 9823, SAMPLE(NN)
 9823 FORMAT(/10X,'-->  WARNING: FILTER FLAG IS MISSING -- ESTIMATE 25',
     $ '0 KM SAMPLING BY PROCESSING ONLY EVERY ',A4,', RETRIEVAL  <--'/)
               MFIRST = 1
            END IF
            IF(MOD(KNTRPT-1,ISAMPLE(NN)).NE.0)  THEN
               KREDTV(NN) = KREDTV(NN) + 1
               GO TO 1410
            END IF
         END IF
      END IF
C.......................................................................
C CHECK IF RPTS FROM ALL PATHS ARE TO BE KEPT {IRTRV(IBAND,NS,1) = 0}
C  (WHERE IBAND IS LAT BAND AND NS IS SAT. NO. INDEX) -- NO MORE CHECKS
      IF(IRTRV(IBAND,NS,1).EQ.0)  THEN
C.......................................................................
C CHECK IF RPTS FROM ALL PATHS ARE TO BE FLAGGED {IRTRV(IBAND,NS,1) =
C  9999} (WHERE IBAND AND NS AS BEFORE) - DOES NOT APPLY TO RADIANCES!!
      ELSE  IF(IRTRV(IBAND,NS,1).EQ.9999)  THEN
         IFLUA = 1
C.......................................................................
C CHECK IF RPTS FROM ONLY ONE PATH ARE TO BE FLAGGED {IRTRV(IBAND,NS,1)
C  = 272 OR 544} (WHERE IBAND AND NS AS BEFORE) - DOES NOT APPLY TO
C  RADIANCES!!
      ELSE  IF(IRTRV(IBAND,NS,1).EQ.JRTRV(INSTR))  THEN
         IFLUA = 1
C.......................................................................
C CHECK IF RPTS FROM ONLY ONE PATH ARE TO BE NON-FLAGGED
C  {IRTRV(IBAND,NS,1) = 1, 2, OR 3} (WHERE IBAND AND NS AS BEFORE) -
C  DOES NOT APPLY TO RADIANCES!!
      ELSE  IF(IRTRV(IBAND,NS,1).LE.3.AND.IRTRV(IBAND,NS,1).NE.INSTR)
     $ THEN
         IFLUA = 1
      END IF
C.......................................................................
      IF(TOVRAD)  KOUNT = KOUNT + 1
      HDR(6) = KSATOB(2)
      IQBEST = 99
      IF(.NOT.TOVRTV)  THEN
         CALL FILLX(-1,IERF)
         IF(IERF.EQ.1)  THEN
            KOUNT = KOUNT - 1
            GO TO 1410
         END IF
         GO TO 6666
      END IF
C*********************************************************************
C            40-LEVEL RETRIEVAL PART OF REPORT IS PROCESSED HERE
C***********************************************************************
C IF MOISTURE IS TO BE EXCLUDED, RESET QP ARRAY TO MISSING
      IF(.NOT.SATMST(IBAND,NS,1))  QP = XMISS
C-----------------------------------------------------------------------
C            LOOP THROUGH ALL LEVELS OF DECODED RETRIEVAL
C       LEVELS ABOVE PMAND(KTOP(IBAND,NS,1)) ARE NOT PROCESSED
C           LEVELS BELOW BOTTOM PRESSURE ARE NOT PROCESSED
C ASSIGN DEFAULT PREPBUFR TBL VALUES TO NON-MSG PRESS, TEMP, SPEC. HUM.
C-----------------------------------------------------------------------
      NLEV = 0
      DO N = 1,NLVL
         IF(PP(N)+.000005.LT.PMAND(KTOP(IBAND,NS,1)))  EXIT
         IF(PP(N).GT.RSATOB(5))  CYCLE
         NLEV = NLEV + 1
         IF(PP(N).LT.XMISS)  IQ(N,5) = 2
         IF(TP(N).LT.XMISS)  IQ(N,2) = 2
         IF(QP(N).GE.0.0.AND.QP(N).LT.XMISS)  IQ(N,3) = 2
cfix?    IF(PP(N).LT.YMISS)  IQ(N,5) = 2
cfix?    IF(TP(N).LT.YMISS)  IQ(N,2) = 2
cfix?    IF(QP(N).GE.0.0.AND.QP(N).LT.YMISS)  IQ(N,3) = 2
C IQBEST: BEST (LOWEST) MOISTURE PREPBUFR TBL V. AMONGST ALL VALID LVLS
         IQBEST = MIN(IQ(N,3),IQBEST)
C TEMPORARILY STORE DATA ON ALL VALID LEVELS IN "TMP" ARRAY
         TMP(NLEV,1:NUMDAT) = DAT(N,1:NUMDAT)
      ENDDO
C-----------------------------------------------------------------------
      IF(NLEV.LE.0)  THEN
C.......................................................................
C IF NLEV IS ZERO (SHOULD NEVER HAPPEN), SKIP RETRIEVAL PART OF REPORT
C  (MAY STILL HAVE RADIANCE PART) AND PRINT DIAGNOSTIC
         IF(.NOT.TOVRAD)  THEN
            PRINT 9954, STNID,RDATA(1),RDATA(2)
 9954 FORMAT(' # # TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - NO LEVELS PROCESSED IN SUBROUTINE SATBFR')
            GO TO 1410
         ELSE
            PRINT 9955, STNID,RDATA(1),RDATA(2)
 9955 FORMAT(' * * RETR. PART SKIPPED   -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - NO LEVELS PROCESSED IN SUBROUTINE SATBFR')
            GO TO 6666
         END IF
C.......................................................................
      END IF
C TRANSFER "TMP" ARRAY BACK TO "DAT" ARRAY
      DAT = TMP
C PSTA HOLDS STN. PRESS., HERE NOT AVAILABLE, SO SET PSTA TO 1099.50 SO
C  NO OTHER LEVEL WILL EVER MATCH IT
      PSTA = 1099.50
      IF(.NOT.TOVRAD)  KOUNT = KOUNT + 1
      IPRT(1) = 0
      IPRT(2) = 0
C PRINT OUT COMPLETE LISTING OF REPORT (BASED ON MODPRT)
      IF(MOD((KOUNT-1),MODPRT).EQ.0)  IPRT(1) = 1
      IF(MODPRT.LT.0)  IPRT(1) = 0
C ALSO, CAN PRINT OUT COMPLETE LISTING FOR SPECIFIC REPORT(S)
      IF(STNID.EQ.STNPRT(1).OR.STNID.EQ.STNPRT(2).OR.STNID.EQ.STNPRT(3))
     $ IPRT(2) = 1
      IF(IPRT(1).EQ.1.OR.IPRT(2).EQ.1)  THEN
         PRINT 1903, STNID
 1903 FORMAT(//,37X,'>>> COMPLETE LISTING OF DATA FOR STATION ID ',A8,
     $ ' <<<',//)
         PRINT 899
  899 FORMAT(2X,'PRESSURE',6X,'HEIGHT',4X,'TEMPERATURE',4X,'SP. HUM.',
     $ 4X,'U-WIND',7X,'V-WIND',5X,'HGHT',5X,'TEMP',5X,'SP. HUM',5X,
     $ 'WIND',3X,'VERT. COORD.'/,4X,'(MB)',9X,'(GPM)',8X,'(K)',9X,
     $ '(G/G)',7X,'(M/S)',8X,'(M/S)',4X,'TV/RC',4X,'TV/RC',6X,'TV/RC',
     $ 5X,'TV/RC',6X,'TV/RC'/)
         PRINT 7901, ((DAT(N,K),K=1,6),(IQ(N,K),IR(N,K),K=1,5),N=1,NLEV)
 7901 FORMAT(1X,F8.2,F13.2,F13.2,F14.5,F11.2,F13.2,I5,'/',I3,I5,'/',
     $ I3,I7,'/',I3,I6,'/',I3,I7,'/',I3)
         PRINT 7902
 7902    FORMAT(//)
      END IF
C-----------------------------------------------------------------------
C CALL SUBR. 'STOROB' TO WRITE REPORT PIECES IN MOBS ARRAY
      CALL STOROB(NLEV,PSTA,0,IPRT,*1410)
 6666 CONTINUE
C***********************************************************************
C      BOTH 40-LEVEL RETRIEVAL AND RADIANCE PART OF REPORT COME HERE
C***********************************************************************
C KEPOB ACCUM. NO. OF RPTS PROCESSED AND MSTOB ACCUM. NO. OF RPTS WITH
C  RETR. MOISTURE PROCESSED, BOTH ACCORDING TO OVERLAND OR OCEANIC
      KEPOB(IBAND,INSTR,MS,1) = KEPOB(IBAND,INSTR,MS,1) + 1
      IF(IQBEST.LT.16) MSTOB(IBAND,INSTR,MS,1) =
     $                 MSTOB(IBAND,INSTR,MS,1) + 1
C GO BACK AND DECODE NEXT REPORT
      GO TO 1400
   10 CONTINUE
C***********************************************************************
C***********************************************************************
C FINISHED PROCESSING RPTS IN THIS FILE; SUBR. SNDTBL SUMMARIZES IN TBL
      CALL SNDTBL(IDSAT,NUMOB,KEPOB,MSTOB,NN)
  110 CONTINUE
      KNTTOV(NN) = KOUNT
      NN = NN + 1
      IF(NN.LE.2)  GO TO 700
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GOESDG
C   PRGMMR: Keyser           ORG: NP22       DATE: 2017-10-20
C
C ABSTRACT: DECODES GOES REPORTS FROM INPUT BUFR DATA DUMP FILE,
C   PROCESSING ONE REPORT AT A TIME.  DEPENDING UPON USER REQUEST MAY
C   PROCESS SOUNDINGS/RADIANCES, AND/OR PRECIP. WATER RETRIEVALS, AND/
C   OR CLOUD TOP RETRIEVALS INTO UNIQUE OUTPUT REPORTS.  IN ADDITION
C   USER MAY SELECT BETWEEN 5x5 FOV (LOW-RESOLUTION) OR 1x1 FOV (HIGH-
C   RESOLUTION).  FINALLY, ACCUMULATES COUNTS FOR VALID REPORTS BEFORE
C   CALLING SUBROUTINES TO ACTUALLY PROCESS REPORTS INTO THE REQUESTED
C   OUTPUT FORMAT.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1995-07-12  D. A. KEYSER -- ORIGINAL AUTHOR
C 1995-08-24  D. A. KEYSER -- GOES SNDG SFC DATA (T,Q,Z) PREPDA
C     TABLE VALUES SET TO AT BEST SUSPECT
C 1996-09-03  D. A. KEYSER -- CAN PROCESS RETR. FROM GOES-ODD SAT (AS
C     WAS FOR GOES-EVEN SAT)
C 1997-05-01  D. A. KEYSER -- EST. REASON CODES FOR UPPER-AIR DATA
C     TYPES (CURRENTLY JUST 100); STDOUT EXPANDED TO INCL. REASON CODES
C 1997-07-02  D. A. KEYSER -- MODIFIED THE PROCESSING OF GOES DATA
C     TO READ FROM SINGLE BUFR DUMP FILE USING W3LIB ROUTINE W3UNPK77
C     (RATHER THAN OLD READ FROM 2 WMO BUFR FILES WHICH USED W3FI77),
C     ALSO READS IN AND PROCESSES 18-CHANNELS OF BRIGHTNESS TEMPERATURE
C     (IF REQUESTED FROM NEW N-LIST SWITCH "GOESRD")
C 1997-07-22  D. A. KEYSER -- NAMELIST SWITCH "IWINDO" FOR GOES DATA
C     (LAST 10 WORDS) REDEFINED FROM WHOLE HOURS TO HOURS * 100 TO GIVE
C     MORE PRECISION IN DEFINING GOES TIME WINDOW
C 1997-08-28  D. A. KEYSER -- CORRECTS FOR CALC. NEGATIVE TOP LAYER P.
C     WATER WHICH CAN NOW OCCUR DUE TO ROUND-OFF ERROR IN INPUT BUFR
C     DUMP FILE - SETS TO ZERO IF > -1 MM, ELSE TOSSES PWATER REPORT;
C     TOSSES PWATER REPORT IF ANY OF THE LAYER VALUES ARE MISSING OR
C     < ZERO
C 1997-09-18  D. A. KEYSER -- STORES SKIN TEMP., CLOUD AMT., SOLAR
C     ZENITH ANG., AND SAT. ZENITH ANG. IN COMMON WHEN PROCESSING GOES
C     RADIANCES (LATER ENCODED INTO PREPBUFR)
C 1997-10-06  D. A. KEYSER -- STORES FOV# INTO COMMON FOR LATER
C     ENCODING INTO PREPBUFR
C 1998-06-14  D. A. KEYSER -- NEW LOGICAL N-LIST SWITCH "FLGOES" IS A
C     4-WORD ARRAY WHICH ALLOWS ALL SNDG/RETR DATA FROM EVERY OTHER
C     EVEN OR ODD GOES SATELLITE TO BE FLAGGED FOR NON-USE BY THE
C     ANALYSIS (NEEDED WHEN 2 EVENS OR ODDS ARE PRODUCING DATA BUT ONLY
C     ONE IS USED OPERATIONALLY), CHAR. 6 OF GOES STNID IS NOW UNIQUE
C     FOR TWO DIFFERENT, BUT CONSECUTIVE, EVEN OR ODD SATELLITES)
c 1999-01-20  D. A. KEYSER -- REPL. N-LIST SWITCH "SATLND" WITH NEW
C     SWITCHES "ISATLS" AND "JSATLS" TO HANDLE LAND/SEA SELECTION FOR
C     SATELLITE SNDGS/RADIANCES AND GOES PW RETR. SEPARATELY (ALSO CAN
C     NOW SELECT JUST LAND AS WELL AS JUST SEA OR EVERYWHERE)
C 2000-12-05  D. A. KEYSER -- RECOGNIZES GOES SNDG/RAD REPORTS WITH
C     NEW 8-CHAR. STNID FORMAT
C 2001-04-06  D. A. KEYSER -- PRINTS DIAG. IF TDEW < TDLIM; SUBR.
C     "PWATER" RENAMED TO "GETPWATER", NOW RETURNS IERF=1 IF REPORT NOT
C     ENCODED INTO PREPBUFR FILE (INSTEAD OF MST=0); ACCOUNTS FOR SUBR.
C     W3UNPKB7 OUTPUTTING GOES RAD. AS K (PRECISE TO 10**2) RATHER THAN
C     K*100; ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES PWATER AS AS
C     MM (PRECISE TO 10**2) RATHER THAN MM*100; ACCOUNTS FOR SUBR.
C     W3UNPKB7 OUTPUTTING GOES SKIN TEMP AS K (PRECISE TO 10**2) RATHER
C     THAN K*100; ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES SOLAR AND
C     SAT. ZENITH ANGLE AS DEGREES (PRECISE TO 10**2) RATHER THAN
C     DEG*100; SUBR. "RPTLBL" NOW HAS INPUT ARGS. "TIMWIN_e" (EARLIEST
C     TIME WINDOW) AND "TIMWIN_l" (LATEST TIME WINDOW) REPL. "TIMWIN"
C     (+/- TIME WINDOW) ("-" PRIOR TO CYCLE TIME, "+" AFTER CYCLE
C     TIME), ALLOWS THE 2 TO BE DIFFERENT; READS IN GOES SFC PRESSURE
C     (FROM CAT. 8, CF 262) FOR PW REPORTS
C 2001-06-19  D. A. KEYSER -- CAN NOW PROCESS GOES 1x1 FOV CLOUD TOP
c     REPORTS INTO PREPBUFR FILE UNDER R.T. 151 (MNEMONICS ARE "CDTP"/
C     CLOUD TOP PRESSURE, "TOCC"/CLOUD COVER, "GCDTT"/CLOUD TOP TEMP.);
C     NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK SEPARATE FROM "RPTLBL";
C     SUBR. STREAMLINED, WITH NEW SUBR. "GOESCHK" NOW PERFORMING CHECKS
C     ON SEPARATE RPT TYPES BEING PROCESSED; N-LIST SWITCHES "GOESND",
C     "GOESPW", "GOESRD" AND NEW "GOESCT" NOW LENGTH 2 TO PROCESS THE
C     4 GOESND TYPES FORM EITHER 5X5 OR 1X1 FOV; N-LIST SWITCHES
C     "IWINDO", "SATMST", "ISATLS", "IRTRV" AND "KTOP" NOW MORE
C     SPECIFIC TO POINT TO PAIRS OF EVEN OR ODD GOES SATS. AND TO THE
C     4 POSSIBLE REPORT TYPES THAT CAN BE GENERATED FROM RTOVS/ATOVS
C     AND GOES SNDG/RAD/RETR. DATA (OLD SWITCHES "JSATLS" AND "FLGOES"
C     NO LONGER NEEDED AND REMOVED)
C 2001-08-01  D. A. KEYSER -- N-LIST SWITCH IWINDO SPLIT INTO IWINDO_e
C     (EARLIEST TIME WINDOW) AND IWINDO_l (LATEST TIME WINDOW) FOR
C     SATELLITE SOUNDING/RETRIEVAL/RADIANCE REPORTS ("-" PRIOR TO CYCLE
C     TIME, "+" AFTER CYCLE TIME) (SAME DEFAULTS AS BEFORE)
C 2002-01-14  D. A. KEYSER -- LEVELS WITH REPORTED DWPT < "TDLIM" VALUE
C     NOW CALC. SPEC. HUM AND RETAIN DWPT IN PREPBUFR FILE, BUT
C     MOISTURE PREPBUFR TABLE VALUE IS FLAGGED WITH Q.M.=15 IN SUBR.
C     FIZZ01 (BEFORE, SPEC. HUM. AND DWPT SET TO MISSING) VIRT. TEMP.
C     CALC. AND ENCODED IN THIS CASE  (BEFORE, SET TO SENSIBLE TEMP.)
C 2007-09-14  D. A. KEYSER -- MODIFIED TO HANDLE RETURN OF NEW ARGUMENT
C     "RDATA2" FROM CALLS TO W3UNPKB7 [1-DIM 21-WORD ARRAY WHICH HOLDS
C     ADDITIONAL VALUES DECODED DIRECTLY FROM BUFR (AND NOT IN "RDATA"
C     ARRAY), FOR SOME PARAMETERS REPLACING WHAT HAD BEEN RETURNED IN
C     "RDATA" ARRAY (IN THE HEADER)]; CAN NOW HANDLE GOES 1x1
C     SOUNDINGS/PW/RADIANCES IN MESSAGE TYPE "NC003003"; GOES
C     SOUNDINGS/PW/RADIANCES ONLY PROCESSED IF MESSAGE TYPE IS
C     "NC003001" (5x5) OR "NC003003" (1x1), GOES CLOUD-TOP RETR ONLY
C     PROCESSED IF MESSAGE TYPE IS "NC003002" (NEEDED WHEN 1x1 SNDGS
C     ARE STORED WITH CLOUD IN GOESND DUMP SINCE FORMER ALSO CONTAIN
C     CLOUD INFO WHICH WE DO NOT WANT TO PROCESS)
C 2015-04-16 JWhiting -- Fixed bug in GOES TOCC encoding; now populates
C     CLTOP(1,2) with TOCC value directly from RDATA2(25) passed from
C     W3UNPKB7 (had looked for it in cat 8 c.f. 258 passed in from
C     W3UNPKB7 in RDATA array but this was changed long ago to hold
C     cloud amount and not total cloud cover, and the former is missing
C     in GOES cloud reports).
C 2016-11-30  D. A. KEYSER -- Accounts for new output argument "OBS8_8"
C     returned from W3UNPKB7 for unpacked reports (REAL*8 2-word array
C     containing latitude and longitude of report).
C 2017-10-20  D. A. KEYSER --
C      - Added minutes to every print statement that includes the
C        central dump time.  Central dump time minutes is obtained from
C        Section 1 of first (dummy) message of input dump file via call
C        to BUFRLIB routine IUPVS01. Fixed bug that did not test central
C        dump time minutes against center (cycle) PRPBUFR minutes in
C        date check (i.e., only YYYYMMDDHH were tested for a match).
C        BENEFIT: Until now, central dump time minutes was always zero.
C                 However, with the implementation of the new RTMA_RU,
C                 central dump time can now also have minutes = 15, 30
C                 or 45 (since the RTMA_RU runs 4 times per hour). This
C                 change allows the print statements to reflect this new
C                 center dump time format. It also ensures that the dump
C                 vs. PREPBUFR center dates are correctly tested.
C      - Added minutes to print statement listing center (cycle) date in
C        PREPBUFR file.
C        BENEFIT: Accounts for possibility of center (cycle) date in
C                 PREPBUFR file not being zero with addition of new
C                 RTMA_RU where minutes here can be 15, 30 or 45.
C 2020-08-20 J. Dong -- Changed subset to subset_t. Defined subset_t
C        and IDSDAT to eliminate Boundary Run-Time Check Failures.
C
C USAGE:    CALL GOESDG
C   INPUT FILES:
C     UNIT HH   - GOES BUFR DATA FILE (5x5 AND/OR 1x1 FOV SOUNDINGS/
C                 RETRIEVALS/RADIANCES)
C    (WHERE HH IS UNIT NUMBER DEFINED AS IUNIT(8) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GOESDG
CCC
C  SATELLITE & PATH (INSTRUMENT) INDICATED BY CHARACTER 8 OF STN. ID

C          SUFFIX I ---> CLEAR COLUMN PATH FROM EVEN-1 SATELLITE
C          SUFFIX J ---> CLOUDY       PATH FROM EVEN-1 SATELLITE
C          SUFFIX K ---> UNKNOWN      PATH FROM EVEN-1 SATELLITE
C                {GOES-04(248), GOES-08(252), GOES-12(256), ...}

C          SUFFIX O ---> CLEAR COLUMN PATH FROM EVEN-2 SATELLITE
C          SUFFIX P ---> CLOUDY       PATH FROM EVEN-2 SATELLITE
C          SUFFIX S ---> UNKNOWN      PATH FROM EVEN-2 SATELLITE
C                {GOES-06(250), GOES-10(254), GOES-14(258), ...}

C          SUFFIX L ---> CLEAR COLUMN PATH FROM ODD-1  SATELLITE
C          SUFFIX M ---> CLOUDY       PATH FROM ODD-1  SATELLITE
C          SUFFIX N ---> UNKNOWN      PATH FROM ODD-1  SATELLITE
C                {GOES-09(253), GOES-13(257), ...}

C          SUFFIX Q ---> CLEAR COLUMN PATH FROM ODD-2  SATELLITE
C          SUFFIX R ---> CLOUDY       PATH FROM ODD-2  SATELLITE
C          SUFFIX T ---> UNKNOWN      PATH FROM ODD-2  SATELLITE
C                {GOES-07(251), GOES-11(255), GOES-15(259), ...}

CCC
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXLVL = 600)
      PARAMETER (NUMVAR = 6, NUMQMS = 5)
      PARAMETER (NUMDAT = NUMVAR + (2 * NUMQMS))
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*1  CIDGST(4,4)
      CHARACTER*8  STNID,STNPRT,DSNAME,SUBSET_d,subset_t
      LOGICAL  SATMST,GOESND,GOESPW,GOESCT,GOESRD
      INTEGER  NUMOB(5,4,2,4,4),KEPOB(5,4,2,4),MSTOB(5,4,2,4),
     $ IDATA(MAXOBS),JRTRV(4),IQ(MXLVL,NUMQMS),IPRT(2),IRTYP(3),
     $ JCAT8(4),JNDEX(4),ITYPP(2,3),IR(MXLVL,NUMQMS),IDSAT(4)
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL  PP(MXLVL),ZP(MXLVL),TP(MXLVL),DP(MXLVL)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/LNDSEA/GDSH(145,37),GDUS(362,91),GDNH(362,91)
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/GOSWCH/GOESND(2),GOESPW(2),GOESCT(2),KNTGIT,KNTGIS,KNTGIP,
     $ KSKPGI,KNDCGI,KNOPGI,KMSGGI,KBDYGI,KTIMGI(3),KLNDGI(3),KSEAGI(3),
     $ KNTGIC,KNOCTP
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/CLDTOP/CLTOP(2,3)
      COMMON/SATSW2/PHI(6),IRTRV(5,4,4),KTOP(5,4,4),IWINDO_e(5,4,4),
     $ IWINDO_l(5,4,4),SATMST(5,4,4),ISATLS(5,4,4)
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/SNDATA/DAT(MXLVL,NUMDAT)
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/PWSWCH/PWT(5),IQMPW
      COMMON/SFCBFR/ALTIMR,PRSS
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE (DAT,PP),(DAT(1,2),ZP),(DAT(1,3),TP),(DAT(1,4),DP),
     $ (DAT(1,NUMVAR+1),IQ),(RDATA,IDATA)
      EQUIVALENCE  (DAT(1,NUMVAR+NUMQMS+1),IR)
      DATA  JRTRV/272,99999,544,118/,IRTYP/0,99999,1/,
C               -- EVEN-1 -      -- ODD-1 --
     $ CIDGST/'I','?','J','K', 'L','?','M','N',
C               -- EVEN-2 -      -- ODD-2 --
     $        'O','?','P','S', 'Q','?','R','T'/,
     $ XMISS/99999./,YMISS/99998.8/,IMISS/99999/
     $ ITYPP/6,8,-99,-99,7,9/
      DATA  JCAT8/251,252,253,254/,JNDEX/  5,  2,  3,  4/
      PWT = XMISS
C KNTALL COUNTS NO. OF RPTS SUCESSFULLY UNPKD (MAY OR MAY NOT HAVE BEEN
C  SKIPPED)
      KNTALL = 0
C KOUNT COUNTS NO. OF REPORTS SUCCESSFULLY UNPACKED AND NOT SKIPPED
      KOUNT = 0
C KNTGIS COUNTS NO. OF SOUNDING/RADIANCE REPORTS ACTUALLY PROCESSED
      KNTGIS= 0
C KNTGIP COUNTS NO. OF PRECIP. WATER RETRIEVALS ACTUALLY PROCESSED
      KNTGIP= 0
C KNTGIC COUNTS NO. OF CLOUD TOP RETRIEVALS ACTUALLY PROCESSED
      KNTGIC= 0
C INITIALIZE NUMOB, KEPOB, AND MSTOB ARRAYS
      NUMOB = 0
      KEPOB = 0
      MSTOB = 0
      IDSAT = 0
      PRINT 9003, IUNIT(8)
 9003 FORMAT(//32X,' ***** GOES SATELLITE SOUNDING/RETRIEVAL/RADIANCE',
     $ ' FILE    UNIT =',I4,' *****')
      PRINT 550, IDATE,idatmm
  550 FORMAT(31X,'LOOKING FOR FILE WITH CENTER DATE: ',2X,I4.4,
     $ 2('-',I2.2),1X,I2.2,':',i2.2,'Z  BASED ON CENTER (CYCLE) DATE')
      IF(GOESRD(1))  PRINT 588
  588 FORMAT(/49X,'==>  WILL PROCESS 5x5 RADIANCES  <==')
      IF(GOESRD(2))  PRINT 688
  688 FORMAT(/49X,'==>  WILL PROCESS 1x1 RADIANCES  <==')
      IF(GOESND(1))  PRINT 586
  586 FORMAT(/44X,'==>  WILL PROCESS 5x5 PROFILE SOUNDINGS  <==')
      IF(GOESND(2))  PRINT 686
  686 FORMAT(/44X,'==>  WILL PROCESS 1x1 PROFILE SOUNDINGS  <==')
      IF(GOESPW(1))  PRINT 587
  587 FORMAT(/44X,'==>  WILL PROCESS 5x5 PRECIPITABLE WATER  <==')
      IF(GOESPW(2))  PRINT 687
  687 FORMAT(/44X,'==>  WILL PROCESS 1x1 PRECIPITABLE WATER  <==')
      IF(GOESCT(1))  PRINT 689
  689 FORMAT(/46X,'==>  WILL PROCESS 5x5 CLOUD TOP DATA  <==')
      IF(GOESCT(2))  PRINT 690
  690 FORMAT(/46X,'==>  WILL PROCESS 1x1 CLOUD TOP DATA  <==')
      CYCLET = IDATE(4) + idatmm / 60.d0
C ASSUME THAT ALL MESSAGES IN BUFR DUMP FILE SHOULD BE READ AND DECODED
C  (TIME WINDOW CHECK LATER ON CAN FILTER REPORTS OUTSIDE OF
C  REQUESTED TIME LIMITS) -- SET RANGE TO - 3-HOURS + 2-HOURS
      IETIME = -3
      ILTIME = +2
C KNTRPT WILL COUNT NUMBER OF CALLS TO REPORT DECODER
      KNTRPT = 0
      IFLAG = 0
      GO TO 1400
C***********************************************************************
C***********************************************************************
 1410 CONTINUE
C KSKPGI WILL COUNT NO. OF DECODED REPORTS SKIPPED (VARIOUS REASONS)
      KSKPGI = KSKPGI + 1
 1400 CONTINUE
C INIT. GRAD, IGCHN ARRAYS ALONG W/ OTHER RADIANCE ANCILLARY INFO
      GRAD   = XMISS
      IGCHN  = IMISS
      SOZANG = XMISS
      SAZANG = XMISS
      SKINT  = XMISS
      CLDAMT = XMISS
C INIT. CLOUD TOP DATA
      CLTOP  = XMISS
C ATTEMPT TO DECODE THE NEXT REPORT
      IRET = 0
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
      CALL W3UNPKB7(IDATE,IETIME,ILTIME,IUNIT(8),RDATA,STNID,DSNAME,
     $ RDATA2,obs8_8,IDSDAT,IDSDMP_8,SUBSET_d,SUBSKP,IRET)
C.......................................................................
      IF(IRET.EQ.1)  THEN
         IFLAG = 1
C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(IUNIT(8),subset_t,ibdate,kret)
         iminu = iupvs01(IUNIT(8),'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(IUNIT(8))
         call openbf(IUNIT(8),'IN',IUNIT(8))
c-----------------------------------------------------------------------
         PRINT 7000, DSNAME,IDSDAT,iminu,IDSDMP_8
 7000    FORMAT(//22X,'--> DATA SET INFORMATION: NAME: ',A8,'; DATE: ',
     $    I10.10,':',i2.2,'; DUMP TIME: ',I12.12,' <--'//)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
         IF(IDSDAT.NE.IDAT10 .and. iminu.ne.idatmm)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
            RETURN
         END IF
         GO TO 1400
C.......................................................................
      ELSE  IF(IRET.GT.2)  THEN
C ERROR DECODING THIS REPORT, GO ON TO NEXT REPORT
         PRINT 572, IUNIT(8),KNTRPT+1,IRET
  572    FORMAT(/' * * ERROR DECODING GOES REPORT ON UNIT',I3,' -- ',
     $    'REPORT CNT. ',I5,' -- IRET ',I5,' --> GO ON TO NEXT RPT'/)
         KNDCGI = KNDCGI + 1
         GO TO 1410
C.......................................................................
      ELSE  IF(IRET.EQ.2)  THEN
C IF IER = 2, HAVE HIT END-OF-FILE, ALL GOES REPORTS PROCESSED
         IF(IFLAG.LE.0)  THEN
            PRINT 8003, IUNIT(8)
 8003       FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN ',
     $       'FIRST CALL TO FILE IN UNIT ',I3,' -- THIS MAY BE A NULL',
     $       ' FILE -- GO TO NEXT FILE'/)
         ELSE  IF(IFLAG.EQ.1)  THEN
            PRINT 8002
 8002    FORMAT(/' * * NO REPORTS CURRENTLY PRESENT IN THIS DATA FILE,',
     $    ' GO TO NEXT FILE'/)
         END IF
         GO TO 110
C.......................................................................
      END IF
C A REPORT WAS SUCCESSFULLY DECODED
      IFLAG = 2
      KNTRPT = KNTRPT + 1
      KNTALL = KNTALL + 1
C-----------------------------------------------------------------------
C  REPORT COUNTS LATER STORED IN ARRAY: NUMOB(IBAND,INSTR,MS,NSS,NTYP)
C        WHERE: IBAND IS LAT. BAND INDEX, INSTR IS PATH TYPE INDEX
C             MS IS LAND/OCEAN SWITCH, NSS IS SAT # INDEX, AND
C     NTYP IS REPORT TYPE (=2 RAD/SNDG, =3 PW RETR., =4 CL. TOP RETR.)
C    ** WILL LATER PERFORM CHECKS SATELLITE NUMBER AND PATH FOR EACH
C    TYPE OF REPORT PROCESSED INTO PREPBUFR FILE AND TOSS IF PROBLEM **
C-----------------------------------------------------------------------
C.......................................................................
C IDENTIFY LATITUDE (PHI) BAND INDEX ---> IBAND
C.......................................................................
      DO IBAND = 1,4
         IF(NINT(RDATA(1)*100.).LT.(NINT(PHI(IBAND+1)*100.)-0.5))
     $    GO TO 1800
      ENDDO
C NOTE: IN RARE EVENT THAT LAT. MSG, IBAND SET TO 5 (RPT. LATER SKIPPED)
      IBAND = 5
 1800 CONTINUE
C.......................................................................
C IDENTIFY SAT. NO. INDEX ---> NSS (=1 EVEN-1 SAT.; =2 ODD-1  SAT.;
C                                   =3 EVEN-2 SAT.; =4 ODD-2  SAT.)
C IDENTIFY PATH ------> INSTR (=1 CLEAR; =3 CLOUDY; =4 UNKNOWN)
C  (NOTE: INSTR = 2 IS NOT A POSSIBILITY)
C              (BOTH BASED ON CHARACTER 8 OF STATION ID)
C.......................................................................
      DO II = 1,4
         DO JJ = 1,4
            IF(STNID(8:8).EQ.CIDGST(JJ,II))  GO TO 1501
         ENDDO
      ENDDO
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C IF SATELLITE NUMBER/ PATH NOT RECOGNIZED, SKIP REPORT
      KNOPGI = KNOPGI + 1
      PRINT 8758, STNID,RDATA(1),RDATA(2)
 8758 FORMAT(' * * DECODED REPORT TOSSED-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - SATELLITE NUMBER/PATH NOT RECOGNIZED')
      GO TO 1410
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
 1501 CONTINUE
      NSS   = II
      INSTR = JJ
      IDSAT(NSS) = IDATA(6)
C.......................................................................
C IDENTIFY OVERLAND/OCEANIC SWITCH ---> MS (=1 OVERLAND; =2 OCEANIC)
C.......................................................................
      MS = 2
      IF(NINT(RDATA(1)*100.).LT.0)  THEN
         CALL LNDCHK(RDATA(1),RDATA(2),1,4,2,GDSH,145,37,0.5,ILAND)
      ELSE
         CALL LNDCHK(RDATA(1),RDATA(2),1,4,2,GDNH,362,91,0.5,ILAND)
      END IF
      IF(ILAND.NE.0)  MS = 1
C.......................................................................
C CALL CHKREP TO CHECK DECODED RPT FOR MSG LAT/LON OR O-SIDE SEARCH AREA
C  (WILL APPLY RESULT OF CHECK LATER IN EACH INDIVIDUAL PROCESSED RPT)
      KFLG_CHKREP = 0
      CALL CHKREP(KMSGGI,KBDYGI,*1078)
      GO TO 1079
 1078 CONTINUE
      KFLG_CHKREP = 1
 1079 CONTINUE
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
      NFILE = IUNIT(8)
      NRAD = 0
      NLEV = 0
      NPW  = 0
      NCT  = 0
C***********************************************************************
C            SOUNDING AND/OR RADIANCE REPORT IS PROCESSED HERE
C     (NOTE 1: 1x1 FOV HAVE "H" IN CHAR. 1 OF STNID; 5x5 FOV DO NOT)
C  (NOTE 2: ASSUMED TO BE ONLY IN INPUT MSG TYPES NC003001 OR NC003003)
C
C***********************************************************************
      IF(SUBSET_d.EQ.'NC003001'.OR.SUBSET_d.EQ.'NC003003') THEN
      IF(((GOESRD(1).OR.GOESND(1)).AND.STNID(1:1).NE.'H').OR.
     $   ((GOESRD(2).OR.GOESND(2)).AND.STNID(1:1).EQ.'H'))  THEN
C NUMOB ACCUMULATES TOTAL NUMBER OF REPORTS
         NUMOB(IBAND,INSTR,MS,NSS,2) = NUMOB(IBAND,INSTR,MS,NSS,2) + 1
C CALL SUBR. GOESCHK TO PERFORM CHECKS ON THE REPORT
         CALL GOESCHK(1,KFLG_CHKREP,MS,INSTR,HDR(4),
     $    IWINDO_e(IBAND,NSS,2),IWINDO_l(IBAND,NSS,2),
     $    ISATLS(IBAND,NSS,2),IRTRV(IBAND,NSS,2),IFLUA,IERG)
         IF(IERG.EQ.1) GO TO 13
C REPORT HAS PASSED ALL CHECKS
         IF(GOESRD(1).OR.GOESRD(2))  THEN
C-----------------------------------------------------------------------
C                   PROCESS RADIANCE PART OF REPORT
C     (INCLUDES ANCILLARY INFORMATION FOUND IN DATA LEVEL CAT. 8)
C-----------------------------------------------------------------------
            J = IDATA(42) - 3
            IF(IDATA(41).GT.0)  THEN
               NRADL = MAX(IDATA(41),18)
               IF(IDATA(41).NE.18)  THEN
                  PRINT 9757, STNID,RDATA(1),RDATA(2),IDATA(41)
 9757 FORMAT(' # # RADIANCE REPORT PROB.-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E - NUMBER OF CHANNELS=',I2,'(NOT 18); ONLY 1-18 ',
     $ 'PROCESSED')
               END IF
               DO I = 1,NRADL
                  J = J + 3
                  IGCHN(I) = IDATA(J)
                  GRAD(I)  = RDATA(J+1)
               ENDDO
               IF(IDATA(27).GT.0)  THEN
                  L8 = IDATA(28) - 4
                  DO I = 1,IDATA(27)
                     L8 = L8 + 4
                     IF(NINT(RDATA(L8+1)).LT.255) CYCLE
                     IF(NINT(RDATA(L8+1)).EQ.255)  THEN
                        SKINT = RDATA(L8)
                     ELSE  IF(NINT(RDATA(L8+1)).EQ.258)  THEN
                        CLDAMT = NINT(RDATA(L8))
                     ELSE  IF(NINT(RDATA(L8+1)).EQ.260)  THEN
                        SOZANG = RDATA(L8)
                     ELSE  IF(NINT(RDATA(L8+1)).EQ.261)  THEN
                        SAZANG = RDATA(L8)
                     END IF
                  ENDDO
               END IF
               KOUNT = KOUNT + 1
               NRAD = 1
            ELSE
               IF(.NOT.GOESND(1).AND..NOT.GOESND(2))  THEN
                  PRINT 9758, STNID,RDATA(1),RDATA(2)
 9758 FORMAT(' * * TOT. RPT TOSSED- STNID = ',A8,'(SNDG/RADIANCE) @ ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- NO RADIANCES FOUND')
               ELSE
                  PRINT 9759, STNID,RDATA(1),RDATA(2)
 9759 FORMAT(' # # RAD. PART SKPPD- STNID = ',A8,'(SNDG/RADIANCE) @ ',
     $ 'LAT = ',F6.2,' N  LON =',F8.2,' E    -- NO RADIANCES FOUND')
               END IF
            END IF
         END IF
         HDR(6) = 164 + (10 * (MS - 1)) + IRTYP(INSTR)
         IQBEST = 99
         IF(GOESND(1).OR.GOESND(2))  THEN
C-----------------------------------------------------------------------
C              PROCESS SOUNDING (PROFILE) PART OF REPORT
C-----------------------------------------------------------------------
            PBOT = XMISS
            IF(IDATA(39).GT.0)  THEN
C INITIALIZE DAT AND IQ ARRAYS
               DAT = XMISS
               IQ  = 16
C INITIALIZE ALL REASON CODES AS 100 (ORIGINAL DATA)
               IR = 100
               IF(RDATA(IDATA(40)).LT.YMISS)
     $          PBOT = NINT(RDATA(IDATA(40))) * 0.1
               II = IDATA(40) - 9
               DO N = 1,IDATA(39)
                  II = II + 9
                  IF(RDATA(II).GE.YMISS)  CYCLE
C LEVELS ABOVE PMAND(KTOP(IBAND,NSS,2)) ARE NOT PROCESSED
                  IF(NINT(RDATA(II))*0.1.LT.PMAND(KTOP(IBAND,NSS,2)))
     $             EXIT
                  NLEV = NLEV + 1
                  PP(NLEV) = NINT(RDATA(II)) * 0.1
C PREPBUFR TBL VALUE FOR VRT. COORD. (PRESS) SET TO DEF.(2)
                  IQ(NLEV,5) = 2
                  IF(RDATA(II+1).LT.YMISS)  THEN
                     ZP(NLEV) = NINT(RDATA(II+1))
                     IQ(NLEV,1) = NINT(RDATA(II+6))
                  END IF
                  IF(RDATA(II+2).LT.YMISS)  THEN
                     TP(NLEV) = (NINT(RDATA(II+2)) * 0.1) + 273.16
                     IQ(NLEV,2) = NINT(RDATA(II+7))
                  END IF
                  DEWPT = (NINT(RDATA(II+3)) * 0.1) + 273.16
                  IF(SATMST(IBAND,NSS,2).AND.RDATA(II+3).LT.YMISS.AND.
     $             NINT(RDATA(II)).GE.1000)  THEN
C DWPT MUST BE ON PRESSURE .GE. 100 MB TO BE PROCESSED
                     DP(NLEV) = DEWPT
                     IQ(NLEV,3) = NINT(RDATA(II+8))
                  END IF
C IQBEST: BEST (LOWEST) MOISTURE PREPBUFR TBL V. AMONGST ALL VALID LVLS
                  IQBEST = MIN(IQ(NLEV,3),IQBEST)
                  IF(N.EQ.1)  THEN
C IF THIS IS THE 1ST (SFC) LVL & SEQNLT=T, SET PREPBUFR TBL VALUE TO AT
C  BEST SUSPECT (3) FOR ALL DATA ON THIS LEVEL
                     IQ(NLEV,1) = MAX(IQ(NLEV,1),3)
                     IQ(NLEV,2) = MAX(IQ(NLEV,2),3)
                     IQ(NLEV,3) = MAX(IQ(NLEV,3),3)
                  END IF
               ENDDO
            END IF
            IF(NLEV.LT.1)  THEN
C.......................................................................
C IF NLEV IS 0 (SHOULD NEVER HAPPEN), SKIP SOUNDING PART OF REPORT (MAY
C  STILL HAVE RADIANCE PART) AND PRINT DIAGNOSTIC
               IF(NRAD.EQ.0)  THEN
                  PRINT 9954, STNID,RDATA(1),RDATA(2)
 9954 FORMAT(' * * TOT. RPT TOSSED- STNID = ',A8,'(SNDG/RADIANCE) @ ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- NO LVLS PROCESSED IN ',
     $ 'SUBR. GOESDG')
               ELSE
                  PRINT 9955, STNID,RDATA(1),RDATA(2)
 9955 FORMAT(' # # SNDG PART SKPPD- STNID = ',A8,'(SNDG/RADIANCE) @ ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- NO LVLS PROCESSED IN ',
     $ 'SUBR. GOESDG')
               END IF
               GO TO 13
C.......................................................................
            END IF
C PSTA HOLDS SURFACE (STN) PRESSURE, PBOT; IF PBOT IS MSG SET PSTA TO
C  1099.50 SO NO OTHER LEVEL WILL EVER MATCH IT
            PSTA = MIN(PBOT,1099.50)
            IF(NRAD.EQ.0)  KOUNT = KOUNT + 1
            IPRT(1) = 0
            IPRT(2) = 0
C PRINT OUT COMPLETE LISTING OF REPORT (BASED ON MODPRT)
            IF(MOD((KOUNT-1),MODPRT).EQ.0)  IPRT(1) = 1
            IF(MODPRT.LT.0)  IPRT(1) = 0
C ALSO, CAN PRINT OUT COMPLETE LISTING FOR SPECIFIC REPORT(S)
            IF(STNID.EQ.STNPRT(1).OR.STNID.EQ.STNPRT(2).OR.STNID.EQ.
     $       STNPRT(3))  IPRT(2) = 1
            IF(IPRT(1).EQ.1.OR.IPRT(2).EQ.1)  THEN
               PRINT 1903, STNID
 1903 FORMAT(//32X,'>>> COMPLETE LISTING OF SOUNDING DATA FOR STATION ',
     $ 'ID ',A8,' <<<',//)
               PRINT 899
  899 FORMAT(2X,'PRESSURE',6X,'HEIGHT',4X,'TEMPERATURE',4X,'DEWPOINT',
     $ 4X,'U-WIND',7X,'V-WIND',5X,'HGHT',5X,'TEMP',5X,'DEWPOINT',5X,
     $ 'WIND',3X,'VERT. COORD.'/4X,'(MB)',9X,'(GPM)',8X,'(K)',9X,
     $ '(K)',9X,'(M/S)',8X,'(M/S)',4X,'TV/RC',4X,'TV/RC',6X,'TV/RC',6X,
     $ 'TV/RC',6X,'TV/RC'/)
               PRINT 7901, ((DAT(N,K),K=1,6),(IQ(N,K),IR(N,K),K=1,5),
     $          N=1,NLEV)
 7901 FORMAT(1X,F8.2,F13.2,F13.2,F11.2,F14.2,F13.2,I5,'/',I3,I5,'/',I3,
     $    I7,'/',I3,I7,'/',I3,I7,'/',I3)
               PRINT 7902
 7902          FORMAT(//)
            END IF
         END IF
C-----------------------------------------------------------------------
      END IF
      END IF
   13 CONTINUE
      IF(NRAD.EQ.1.AND.NLEV.EQ.0)  THEN
C COME HERE WHEN SNDG/RAD REPORT HAS ONLY A RADIANCE PART
C CALL FILLX TO PROCESS RADIANCE DATA
         CALL FILLX(-1,IERF)
         IF(IERF.EQ.1)  THEN
            KOUNT = KOUNT - 1
            NRAD = 0
         END IF
      ELSE IF(NRAD.EQ.0.AND.NLEV.GT.0)  THEN
C COME HERE WHEN SNDG/RAD REPORT HAS ONLY A SOUNDING PART
C CALL SUBR. 'STOROB' TO WRITE REPORT PIECES FROM SOUNDING IN MOBS ARRAY
         CALL STOROB(NLEV,PSTA,0,IPRT,*14)
      ELSE  IF(NRAD.EQ.1.AND.NLEV.GT.0)  THEN
C COME HERE WHEN SNDG/RAD REPORT HAS BOTH A SOUNDING AND RADIANCE PART
C CALL SUBR. 'STOROB' TO WRITE REPORT PIECES FROM SOUNDING IN MOBS ARRAY
C  AND PROCESS RADIANCE PART AS WELL
         CALL STOROB(NLEV,PSTA,0,IPRT,*14)
      END IF
      GO TO 15
   14 CONTINUE
      NLEV = 0
   15 CONTINUE
      IF(NLEV+NRAD.GT.0)  THEN
         KNTGIS = KNTGIS + 1
C KEPOB ACCUM. NO. OF RPTS PROCESSED AND MSTOB ACCUM. NO. OF RPTS WITH
C  RETR. MOISTURE PROCESSED, BOTH ACCORDING TO OVERLAND OR OCEANIC
         KEPOB(IBAND,INSTR,MS,2) = KEPOB(IBAND,INSTR,MS,2) + 1
         IF(IQBEST.LT.16) MSTOB(IBAND,INSTR,MS,2) =
     $    MSTOB(IBAND,INSTR,MS,2)+1
      END IF
C SET IGCHN(1) = -99999 TO SIGNAL ANY SUBSEQUENT CALLS TO SUBR.
C  FILLX FOR THIS DECODED REPORT TO NOT PRINT RADIANCES AGAIN
      IGCHN(1) = -99999
C***********************************************************************
C              PRECIPITABLE WATER REPORT IS PROCESSED HERE
C      (THIS IS A UNIQUE REPORT FROM THE SOUNDING/RADIANCE REPORT)
C      (NOTE 1: 1x1 FOV HAVE "H" IN CHAR. 1 OF STNID; 5x5 FOV DO NOT)
C  (NOTE 2: ASSUMED TO BE ONLY IN INPUT MSG TYPES NC003001 OR NC003003)
C
C***********************************************************************
      IF(SUBSET_d.EQ.'NC003001'.OR.SUBSET_d.EQ.'NC003003') THEN
      IF((GOESPW(1).AND.STNID(1:1).NE.'H').OR.
     $   (GOESPW(2).AND.STNID(1:1).EQ.'H'))  THEN
C-----------------------------------------------------------------------
C                  STORE PRECIPITABLE WATER RETRIEVALS
C   A REPORT MAY CONTAIN PRECIP. WATER IN THE ANY/ALL OF THE FOLLOWING:
C                          1.0 TO 0.9 SIGMA LAYER
C                          0.9 TO 0.7 SIGMA LAYER
C                          0.7 TO 0.3 SIGMA LAYER
C                          0.3 TO 0.0 SIGMA LAYER
C            (PRECIPITABLE WATER STORED IN UNITS OF MILLIMETERS)
C     THE PREPBUFR TABLE VALUE IS ASSUMED TO BE THE SAME FOR ALL LAYERS
C   THE REPORT MAY ALSO CONTAIN SURFACE PRESSURE (STORED IN PASCALS)
C-----------------------------------------------------------------------
C NUMOB ACCUMULATES TOTAL NUMBER OF REPORTS
         NUMOB(IBAND,INSTR,MS,NSS,3) = NUMOB(IBAND,INSTR,MS,NSS,3) + 1
C CALL SUBR. GOESCHK TO PERFORM CHECKS ON THE REPORT
         CALL GOESCHK(2,KFLG_CHKREP,MS,INSTR,HDR(4),
     $    IWINDO_e(IBAND,NSS,3),IWINDO_l(IBAND,NSS,3),
     $    ISATLS(IBAND,NSS,3),IRTRV(IBAND,NSS,3),IFLUA,IERG)
         IF(IERG.EQ.1) GO TO 1811
C REPORT HAS PASSED ALL CHECKS
         PWT(2:5) = XMISS
         PRSS = XMISS
         IQMPW = 16
         IF(IDATA(27).NE.0)  THEN
            II = IDATA(28) - 4
            MATCH = 0
            LOOP1: DO N = 1,IDATA(27)
               II = II + 4
               IF(NINT(RDATA(II+1)).EQ.262)  THEN
                  IF(RDATA(II).LT.XMISS)  PRSS = RDATA(II)
cfix?             IF(RDATA(II).LT.YMISS)  PRSS = RDATA(II)
                  CYCLE LOOP1
               END IF
               IF(NINT(RDATA(II+1)).LT.251) CYCLE LOOP1
               IF(NINT(RDATA(II+1)).GT.254) CYCLE LOOP1
               IF(RDATA(II).GE.YMISS)  CYCLE LOOP1
               IF(MATCH.GT.3)  CYCLE LOOP1
               NSTRT = MATCH + 1
               LOOP1n1: DO NN = NSTRT,4
                  IF(NINT(RDATA(II+1)).EQ.JCAT8(NN)) THEN
                     PWT(JNDEX(NN)) = RDATA(II)
                     IQMPW = NINT(RDATA(II+2))
                     MATCH = NN
                     CYCLE LOOP1
                  END IF
               ENDDO LOOP1n1
            ENDDO LOOP1
         END IF
C TOTAL & ALL LAYER P.W. VALUES MUST BE > 0 & NON-MISSING TO PROCESS RPT
         IF(MAX(PWT(5),PWT(2),PWT(3),PWT(4)).LT.YMISS.AND.
     $    MIN(NINT(PWT(5)*10.),NINT(PWT(2)*10.),NINT(PWT(3)*10.),
     $    NINT(PWT(4)*10.)).GE.0)  THEN
C CALCULATE TOP LAYER PRECIPTABLE WATER (THIS IS STORED, NOT TOTAL P.W.)
            PWT(5) = PWT(5) - (PWT(2) + PWT(3) + PWT(4))
            IF(NINT(PWT(5)*10.).LT.0)  THEN
C IF TOP LAYER PRECIP. WATER IS NEG. BUT > -1 MM, STORE AS 0, ELSE SKIP
               IF(NINT(PWT(5)*10.).LT.-10)  THEN
               PRINT 9985, STNID,RDATA(1),RDATA(2)
 9985 FORMAT(' * * TOT. RPT TOSSED- STNID = ',A8,'(P. WATER)     AT ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- CALC. TOP LAYER ',
     $ 'P.WATER NEGATIVE')
                  GO TO 1811
               END IF
               PRINT 9986, STNID,RDATA(1),RDATA(2),PWT(5)
 9986 FORMAT(' # # TOP LYR PW CHGD- STNID = ',A8,'(P. WATER)     AT ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- CALC. NEG. (',F4.1,
     $ ' MM), SET TO 0')
               PWT(5) = 0.0
            END IF
C CALL GETPWATER TO STORE THIS REPORT (IF INPUT DECODED REPORT DID NOT
C  PRODUCE A SNDG/RADIANCE REPORT, INCREMENT KOUNT BY ONE
            IF(NLEV+NRAD.LT.1)  KOUNT = KOUNT + 1
            CALL GETPWATER(ITYPP(MS,INSTR),IFLUA,IERF)
            IF(IERF.EQ.0)  THEN
C PRECIP. WATER REPORT SUCCESFULLY STORED (AT LEAST 1 LAYER PRESENT)
               KNTGIP = KNTGIP + 1
               NPW = 1
C KEPOB ACCUM. NO. OF RPTS PROCESSED ACCORDING TO OVERLAND OR OCEANIC
               KEPOB(IBAND,INSTR,MS,3) = KEPOB(IBAND,INSTR,MS,3) + 1
            ELSE
C IF PWATER NOT STORED & INPUT DECODED REPORT ALSO DID NOT PRODUCE A
C  SNDG/RADNCE REPORT, DECREASE KOUNT BY 1
               IF(NLEV+NRAD.LT.1)  KOUNT = KOUNT - 1
            END IF
         ELSE
            IF(MAX(PWT(5),PWT(2),PWT(3),PWT(4)).GE.YMISS)  THEN
               PRINT 9987, STNID,RDATA(1),RDATA(2)
 9987 FORMAT(' * * TOT. RPT TOSSED- STNID = ',A8,'(P. WATER)     AT ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- 1 OR MORE INPUT ',
     $ 'P.WATERS MISSING')
            ELSE
               PRINT 9988, STNID,RDATA(1),RDATA(2)
 9988 FORMAT(' * * TOT. RPT TOSSED- STNID = ',A8,'(P. WATER)     AT ',
     $ 'LAT = ',F6.2,' N  LON = ',F7.2,' E    -- 1 OR MORE INPUT ',
     $ 'P.WATRS NEGATIVE')
            END IF
         END IF
C-----------------------------------------------------------------------
      END IF
      END IF
 1811 CONTINUE
C***********************************************************************
C                  CLOUD TOP REPORT IS PROCESSED HERE
C   (THIS IS A UNIQUE REPORT FROM THE SOUNDING/RADIANCE AND PW REPORTS)
C      (NOTE 1: 1x1 FOV HAVE "H" IN CHAR. 1 OF STNID; 5x5 FOV DO NOT)
C           (NOTE 2: ASSUMED TO BE ONLY IN INPUT MSG TYPE NC003002)
C
C***********************************************************************
      IF(SUBSET_d.EQ.'NC003002') THEN
      IF((GOESCT(1).AND.STNID(1:1).NE.'H').OR.
     $   (GOESCT(2).AND.STNID(1:1).EQ.'H'))  THEN
C-----------------------------------------------------------------------
C                      STORE CLOUD TOP RETRIEVALS
C                     CLOUD TOP PRESSURE (PASCALS)
C                     TOTAL CLOUD COVER (PER CENT)
C                    CLOUD TOP TEMPERATURE (KELVIN)
C-----------------------------------------------------------------------
C NUMOB ACCUMULATES TOTAL NUMBER OF REPORTS
         NUMOB(IBAND,INSTR,MS,NSS,4) = NUMOB(IBAND,INSTR,MS,NSS,4) + 1
C CALL SUBR. GOESCHK TO PERFORM CHECKS ON THE REPORT
         CALL GOESCHK(3,KFLG_CHKREP,MS,INSTR,HDR(4),
     $    IWINDO_e(IBAND,NSS,4),IWINDO_l(IBAND,NSS,4),
     $    ISATLS(IBAND,NSS,4),IRTRV(IBAND,NSS,4),IFLUA,IERG)
         IF(IERG.EQ.1) GO TO 1911
C REPORT HAS PASSED ALL CHECKS
         IF(IDATA(27).GT.0)  THEN
            L8 = IDATA(28) - 4
            DO I = 1,IDATA(27)
               L8 = L8 + 4
               IF(NINT(RDATA(L8+1)).LT.256)  THEN
                  CYCLE
               ELSE  IF(NINT(RDATA(L8+1)).GT.257)  THEN
                  EXIT
               ELSE  IF(NINT(RDATA(L8+1)).EQ.256)  THEN
                  CLTOP(1,3) = RDATA(L8) ! store c.t. temperature
               ELSE  IF(NINT(RDATA(L8+1)).EQ.257)  THEN
                  CLTOP(1,1) = RDATA(L8) ! store c.t. pressure
                  CLTOP(2,1) = 2.
                  IF(IFLUA.EQ.1)  CLTOP(2,1)= 15
                  NCT = 1   ! NOTE REPORTS WITH VALID CLOUD TOP PRESSURE
               END IF
            ENDDO
            IF(RDATA2(25).LT.YMISS) CLTOP(1,2) = RDATA2(25) ! store TOCC
C CURRENTLY, ONLY REPORTS WITH VALID CLOUD TOP PRESSURE ARE PROCESSED
            IF(NCT.EQ.1)  THEN
C CALL FILLX TO PROCESS THIS REPORT (IF INPUT DECODED REPORT DID NOT
C  PRODUCE A SNDG/RADIANCE OR PW REPORT, INCREMENT KOUNT BY ONE)
               IF(NLEV+NRAD+NPW.LT.1)  KOUNT = KOUNT + 1
C PREPBUFR REPORT TYPE IS SET TO 151
               HDR(6) = 151
               CALL FILLX(-2,IERF)
               IF(IERF.NE.0)  THEN
C IF CLOUD TOP REPORT NOT STORED & INPUT DECODED REPORT ALSO DID NOT
C  PRODUCE A SNDG/RADNCE OR PW REPORT, DECREASE KOUNT BY 1
                  IF(NLEV+NRAD+NPW.LT.1)  KOUNT = KOUNT - 1
                  NCT = 0
               ELSE
C CLOUD TOP REPORT SUCCESFULLY STORED
C KEPOB ACCUM. NO. OF RPTS PROCESSED ACCORDING TO OVERLAND OR OCEANIC
                  KEPOB(IBAND,INSTR,MS,4) = KEPOB(IBAND,INSTR,MS,4) + 1
                  KNTGIC = KNTGIC + 1
               END IF
            ELSE
C KEEP A COUNT OF REPORTS WITH MISSING CLOUD TOP PRESSURE BUT WITH
C  OTHER VALID CLOUD TOP DATA
               KNOCTP = KNOCTP + 1
            END IF
         END IF
      END IF
      END IF ! SUBSET_d.EQ.'NC003002'
C***********************************************************************
 1911 CONTINUE
C GO BACK AND DECODE NEXT REPORT (ACCUMULATE SKIPPED INPUT REPORT COUNT
C  IF NEITHER A GOES SOUNDING/RADIANCE NOR A PRECIP. WATER REPORT NOR A
C  CLOUD TOP REPORT GENERATED)
      IF(NPW+NCT+NLEV+NRAD.EQ.0)  GO TO 1410
      GO TO 1400
  110 CONTINUE
C***********************************************************************
C***********************************************************************
      PRINT 950, KNTALL
  950 FORMAT(13X,'===>  A TOTAL OF ',I6,'  REPORTS WERE DECODED, ',
     $ 'WHETHER KEPT OR SKIPPED  <===',/)
      KNTGIT = KOUNT
C FINISHED PROCESSING GOES REPORTS.; SUBR. SNDTBL SUMMARIZES IN TABLE
      NN = 3
      CALL SNDTBL(IDSAT,NUMOB,KEPOB,MSTOB,NN)
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GOESCHK
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2001-08-01
C
C ABSTRACT: PERFORMS CHECKS ON GOES SOUNDING/RADIANCE, GOES
C   PRECIPITABLE WATER AND GOES CLOUD TOP REPORTS.  SUCH THINGS AS
C   REPORT OUTSIDE DOMAIN, REPORT OUTSIDE TIME WINDOW, REPORT OVER LAND
C   OR OVER OCEAN (WHEN OR OTHER NOT WANTED), OR REPORT WITH UNWANTED
C   PATH (E.G., CLEAR. CLOUDY, ETC.) ARE CHECKED.  REPORTS FAILING
C   CHECKS MAY RETURN WITH IER = 1 (IN WHICH CASE THEY ARE SKIPPED) OR
C   WITH IER = 0 BUT IFLUA = 1 {IN WHICH CASE THEY WILL BE PROCESSED
C   BUT WITH Q.M. = 15 (EXCEPT FOR RADIANCES WHICH ARE STILL PROCESSED
C   SINCE THAT CANNOT BE FLAGGED)}.
C
C PROGRAM HISTORY LOG:
C 2001-06-13  D. A. KEYSER -- ORIGINAL AUTHOR
C 2001-08-01  D. A. KEYSER -- REPLACED INPUT ARGUMENT "JWINDO" WITH
C     NEW INPUT ARGUMENTS "JWINDO_e" AND "JWINDO_l" TO ALLOW THE
C     EARLIEST TIME WINDOW TO BE DIFFERENT FROM THE LATEST TIME WINDOW
C     IN TIME CHECK (FOR BOTH, "-" MEANS PRIOR TO CYCLE TIME, "+"
C     MEANS AFTER CYCLE TIME)
C
C USAGE:    CALL GOESCHK(ITP,KFLG_CHKREP,MS,INSTR,HDR4,JWINDO_e,
C                        JWINDO_l,JSATLS,JRTRV,IFLUA,IER)
C   INPUT ARGUMENT LIST:
C     ITP      - TYPE OF GOES REPORT (=1 RADIANCE/SOUNDING;
C              - =2 PRECIPITABLE WATER; =3 CLOUD TOP)
C     KFLG_CHKREP
C              - INDICATOR AS TO WHETHER PREVIOUS CALL TO SUBR. CHKREP
C              - RETURNED WITH MISSING LAT/LON OR LAT/LON OUTSIDE
C              - SEARCH AREA FOR DECODED REPORT
C     MS       - OVERLAND/OCEANIC SWITCH (=1 OVERLAND; =2 OCEANIC)
C     INSTR    - RETRIEVAL PATH TYPE INDEX (=1 CLEAR; =3 CLOUDY; =4
C              - UNKNOWN; =2 IS NOT A POSSIBILITY))
C     HDR4     - OBSERVATION TIME MINUS CYCLE TIME (IN HOURS, REAL
C              - PRECISION)
C     JWINDO_e - EARLIEST TIME WINDOW FOR ACCEPTING REPORTS (RELATIVE
C              - TO CYCLE TIME, "-" IS PRIOR, "+" IS AFTER) (IN HOURS
C              - * 100.) (BASED ON INPUT NAMELIST SWITCH "IWINDO_e"
C              - FOR THIS REPORT'S LATITUDE BAND, SATELLITE NUMBER,
C              - AND REPORT TYPE)
C     JWINDO_l - LATEST TIME WINDOW FOR ACCEPTING REPORTS (RELATIVE
C              - TO CYCLE TIME, "-" IS PRIOR, "+" IS AFTER) (IN HOURS
C              - * 100.) (BASED ON INPUT NAMELIST SWITCH "IWINDO_l"
C              - FOR THIS REPORT'S LATITUDE BAND, SATELLITE NUMBER,
C              - AND REPORT TYPE)
C     JSATLS   - LAND/SEA SWITCH (=0 PROCESS ALL REPORTS; =1 PROCESS
C              - ONLY REPORTS OVER LAND; =2 PROCESS ONLY REPORTS OVER
C              - OCEAN) (BASED ON INPUT NAMELIST SWITCH "JSATLS" FOR
C              - THIS REPORT'S LATITUDE BAND, SATELLITE NUMBER, AND
C              - REPORT TYPE)
C     JRTRV    - SATELLITE PATH TYPE SWITCH (BASED ON INPUT NAMELIST
C              - SWITCH "IRTRV" FOR THIS REPORT'S LATITUDE BAND,
C              - SATELLITE NUMBER, AND REPORT TYPE) (SEE MAIN PROGRAM
C              - DOCBLOCK FOR POSSIBLE VALUES FOR IRTRV)
C
C   OUTPUT ARGUMENT LIST:
C     IFLUA    - FLAG ALL VARIABLES WITH PREPBUFR TABLE VALUE OF 15 IF
C              - THIS IS 1; OTHERWISE DO NOT FLAG (= 0)
C     IER      - RETURN CODE (=0 REPORT SHOULD NOT BE SKIPPED
C              - REGARDLESS OF VALUE FOR IFLUA; =1 REPORT SHOULD BE
C              - SKIPPED)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'GOESDG'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GOESCHK(ITP,KFLG_CHKREP,MS,INSTR,HDR4,JWINDO_e,
     $ JWINDO_l,JSATLS,JRTRV,IFLUA,IER)
      INTEGER  KRTRV(4)
      COMMON/GOSWCH/GOESND(2),GOESPW(2),GOESCT(2),KNTGIT,KNTGIS,KNTGIP,
     $ KSKPGI,KNDCGI,KNOPGI,KMSGGI,KBDYGI,KTIMGI(3),KLNDGI(3),KSEAGI(3),
     $ KNTGIC,KNOCTP
      DATA  KRTRV/272,99999,544,118/
      IER = 0
      IFLUA = 0
C-----------------------------------------------------------------------
C       PERFORM SERIES OF CHECKS ON REPORT, MAY TOSS IF PROBLEM
C-----------------------------------------------------------------------
C CHECK RESULTS FROM EARLIER CALL TO CHKREP AND FLAG REPORTS WITH
C  MISSING LAT/LON OR OUTSIDE REPORT AREA
      IF(KFLG_CHKREP.EQ.1) THEN
         IER = 1
         RETURN
      END IF
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
C TIMWIN_e AND TIMWIN_l ARE THE TIME WINDOWS (RELATIVE TO CYCLE TIME)
C  FOR ACCEPTING REPORTS (EARLIEST AND LATEST, RESPECTIVELY)
C  (HERE JWINDO_e AND JWINDO_l ARE IN UNITS OF HOURS * 100.)
      TIMWIN_e = REAL(JWINDO_e) * .01
      TIMWIN_l = REAL(JWINDO_l) * .01
      CALL TIMCHK(HDR4,TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMGI(ITP) = KTIMGI(ITP) + 1
         RETURN
      END IF
C.......................................................................
      IF(MS.EQ.1)  THEN
C CHECK IF OVERLAND REPORTS ARE TO BE EXCLUDED (JSATLS = 2)
         IF(JSATLS.EQ.2)  THEN
            KLNDGI(ITP) = KLNDGI(ITP) + 1
            IER = 1
            RETURN
         END IF
      ELSE
C.......................................................................
C CHECK IF OCEANIC REPORTS ARE TO BE EXCLUDED (JSATLS = 1)
         IF(JSATLS.EQ.1)  THEN
            KSEAGI(ITP) = KSEAGI(ITP) + 1
            IER = 1
            RETURN
         END IF
      END IF
C.......................................................................
C UNKNOWN PATH NOT ALLOWED UNLESS TYPE IS CLOUD TOP
      IF(INSTR.EQ.4.AND.ITP.NE.3)  THEN
         IER = 1
         RETURN
      END IF
C.......................................................................
C CHECK IF RPTS FROM ALL PATHS ARE TO BE KEPT (JRTRV = 0) -- NO MORE
C  CHECKS NECESSARY IF THIS IS THE CASE
      IF(JRTRV.EQ.0)  THEN
C.......................................................................
C CHECK IF RPTS FROM ALL PATHS TO BE FLAGGED (JRTRV =9999) - DOES NOT
C  APPLY TO RADIANCES!!
      ELSE  IF(JRTRV.EQ.9999)  THEN
         IFLUA = 1
C.......................................................................
C CHECK IF RPTS FROM ONLY ONE PATH ARE TO BE FLAGGED (JRTRV = 272, 544,
C  OR 118) - DOES NOT APPLY TO RADIANCES!!
      ELSE  IF(JRTRV.EQ.KRTRV(INSTR))  THEN
         IFLUA = 1
C.......................................................................
C CHECK IF RPTS FROM ONLY ONE PATH ARE TO BE NON-FLAGGED
C  (JRTRV = 1, 3, OR 4) - DOES NOT APPLY TO RADIANCES!!
      ELSE IF(JRTRV.LE.4.AND.JRTRV.NE.INSTR) THEN
         IFLUA = 1
C.......................................................................
      END IF
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GETPWATER
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2007-09-14
C
C ABSTRACT: PREPROCESSES PRECIP. WATER AS A UNIQUE REPORT.  THERE CAN
C   BE AS MANY AS 5 TYPES STORED (TOTAL COLUMN - SSM/I OR GPS-IPW; 1.0
C   TO 0.9 SIGMA LAYER - GOES; 0.9 TO 0.7 SIGMA LAYER - GOES; 0.7 TO
C   0.3 SIGMA LAYER - GOES; AND 0.3 TO 0.0 SIGMA LAYER - GOES).  THE
C   PRECIP. WATER OBS AND PREPBUFR TABLE VALUE ARE STORED IN THE PWAT
C   ARRAY.  ASSUMES THAT HDR(4), HDR(5), HDR(7), HDR(9)-HDR(15), ALAT_8
C   AND ALON_8 HAVE ALREADY BEEN FILLED IN FOR REPORT.
C
C PROGRAM HISTORY LOG:
C 1990-09-17  D. A. KEYSER (W/NMC22)
C 1993-05-12  D. A. KEYSER -- SET-UP EXPANDED REPORT FORMAT WORD 2 FOR
C     EACH MASS/WIND LVL IS PRESS. X 10MB, NEW WORD 5 FOR EACH LEVEL
C     CONTAINS 4 PACKED "PREPBUFR TBL VALUES" WHICH CAN RANGE FROM 0-15
C     AND CORRESPOND TO ON29 Q. MARKERS OR PREPRO-GENERATED Q. MARKERS;
C     ALL NON-MISSING DATA ARE NOW PACKED INTO PREPBUFR FILE
C 1993-07-28  D. A. KEYSER -- R.TYPE 151-153 PWATER NOW STORED IN MM*10
C     RATHER THAN MM
C 1995-07-12  D. A. KEYSER -- PRECIP. WATER 'NOBS' PROCESSING MODIFIED
C     TO HANDLE > 1 LEVEL, P-SLOT VALUE IDENTIFIES PRECIP. WATER
C     'TYPE'; R.TYPES 151-159 USED FOR PRECIP. WATER
C 1998-02-17  D. A. KEYSER -- REMOVED LOGIC RE: PROCESSING OF RAOB AND
C     TOVS PWATER
C 2001-04-06  D. A. KEYSER -- SUBR. "PWATER" RENAMED TO "GETPWATER",
C     NOW RETURNS IERF=1 IF REPORT NOT ENCODED INTO PREPBUFR FILE
C     (INSTEAD OF MST=0); ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES
C     PWATER AS AS MM (PRECISE TO 10**2) RATHER THAN MM*100;  ACCOUNTS
C     FOR SUBR. IW3UNPBF OUTPUTTING SSM/I TPW IN MM (PRECISE TO 10**1)
C     RATHER THAN MM*10
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF GPS-IPW DATA, READ
C     FROM "GPSIPW" DUMP FILE DUMP R. TYPE 74, GET PREPBUFR R. TYPE
C     153, PROCESSED BY NEW SUBR. "GETGPSIPW" INTO PREPBUFR FILE UNDER
C     NEW TBL A ENTRY "GPSIPW"; REMOVED INPUT ARGUMENT "MS" (LAND/SEA
C     SWITCH) AS IT IS NOT USED ANYWHERE IN CODE (ELEVATION PROCESSING
C     REMOVED LONG AGO)
C 2007-09-14  D. A. KEYSER -- CASES WHERE OBS ARE SET TO QM=15 IN ORDER
C     TO FLAG A REPORT FOR NON-USE BY ANALYSIS (EVEN THOUGH OBS MAY NOT
C     NECESSARILY BE BAD) NOW FIRST CHECK TO MAKE SURE OBS QM ISN'T
C     ALREADY "BAD" (> 3 AND < 15) (PREVENTS GSI FROM MONITORING TRULY
C     BAD OBS WHICH JUST HAPPEN TO BE IN REPORT GROUPS FLAGGED FOR NON-
C     USE BY ANALYSIS)
C 2008-09-25  D. A. KEYSER -- UPPER LIMIT FOR STORING Q CHANGED FROM
C     32767 MG/KG TO 99999 MG/KG TO ENSURE THAT REPORTS WITH VERY
C     HIGH SPECIFIC HUMIDITY ARE PROCESSED (THE 32767 LIMIT WAS A
C     VESTIGE FROM THE OLD I*2 PREPDA DAYS)
C
C USAGE:    CALL GETPWATER(ITYP,IFLUA,IERF)
C   INPUT ARGUMENT LIST:
C     ITYP     - TYPE OF DATA (=2 SSM/I; =3 GPS-IPW; =6 GOES/LAND/
C              - CLEAR; =7 GOES/LAND/CLOUDY; =8 GOES/OCEAN/CLEAR; =9
C              - GOES/OCEAN/CLOUDY - THESE ARE CURRENTLY THE ONLY
C              - POSSIBILITIES)
C     IFLUA    - FLAG ALL VARIABLES WITH PREPBUFR TABLE VALUE OF 15 IF
C              - THIS IS 1; OTHERWISE DO NOT FLAG (= 0)
C
C   OUTPUT ARGUMENT LIST:
C     IERF     - RETURN CODE (=0 - REPORT SUCCESSFULLY ENCODED INTO
C              - PREPBUFR FILE; =1 - REPORT NOT ENCODED INTO PREPBUFR
C              - FILE - PROBLEM!)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CURRENTLY SET-UP TO PROCESSES EITHER SSM/I P. WATER (AS R.
C   TYPE 152), GPS-IPW P. WATER (AS R. TYPE 153) OR GOES P. WATER (AS
C   R. TYPES 156-159, BASED ON RETR. TYPE AND LAND/OCEAN).  CALLED BY
C   SUBROUTINES 'GOESDG', 'GETSMI' AND 'GETGPSIPW'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GETPWATER(ITYP,IFLUA,IERF)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXPWT =  5)
      PARAMETER (MAXOBS = 4500)
      CHARACTER*8  STNID,SUBSET_d
      INTEGER  IDATA(MAXOBS)
      real(8)  alon_8,alat_8
      COMMON/STRPWT/PWAT(MXTYPV,MXPWT)
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/PWSWCH/PWT(5),IQMPW
      DATA XMISS/99999./,IMISS/99999/
      EQUIVALENCE  (RDATA,IDATA)
      IERF = 1
      HDR(6) = 150 + ITYP
      LLFLAG = 0
C INITIALIZE PWAT ARRAY
      PWAT = XMISS
      DO KK = 1,5
C "PWT" IS PRECIP. WATER (MM) {MUST BE > 0 AND < IMISS (99999)}
         IF(NINT(PWT(KK)*10.).LT.0.OR.NINT(PWT(KK)*10.).GE.IMISS)
     $    CYCLE
         LLFLAG = 1
         IF(IFLUA.EQ.1.AND.(IQMPW.LE.3.OR.IQMPW.GT.15))  IQMPW = 15
C STORE PRECIPITABLE WATER OBS (MM TO NEAREST 10**1 PRECISION) AND
C  PREPBUFR TABLE VALUE IN PWAT ARRAY
         PWAT(1,KK) = PWT(KK)
         PWAT(2,KK) = REAL(IQMPW)
 1300    CONTINUE
      ENDDO
      IF(LLFLAG.EQ.0)  RETURN
C CALL FILLX TO FILL RPT INTO OUTPUT BUFFER (KOUNT KEPT BY CALLING PGM)
      CALL FILLX(-2,IERF)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CCCCC IF(IERF.EQ.0)  THEN
C OPTION TO PRINT LISTING OF ALL PRECIP. WATER RPTS (NORM. COMM. OUT)
CCCCC    PRINT 9091, STNID,IDATA(9),NINT(HDR(6)),IQMPW
C9091 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
CCCCC$ 'TYPE =',I4,' PWATER PREPBUFR TBL VAL. =',I3)
CCCCC END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    SFCDTA
C   PRGMMR: KEYSER           ORG: NP22       DATE: 2015-04-16
C
C ABSTRACT: PERFORMS SEVERAL FUNCTIONS: UNPACKS SURFACE RPTS (IW3UNPBF
C   FORMAT) ONE AT A TIME, PERFORMING SEVERAL CHECKS SUCH AS WHETHER
C   REPORT IS WITHIN TIME LIMIT OR DATA EXTRACTION BOUNDARY.  {HANDLES
C   FOUR SFC DATA FILES: 'ADPSFC', 'SFCSHP', 'SFCBOG' AND 'MSONET' AS
C   WELL AS U-AIR FILE 'ADPUPA' (LATTER FOR SPLASH-LEVEL DATA FROM
C   EITHER DROPWINSONDES OR RECCOS WITH PMSL OBS)}.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1986-12-10  D. A. KEYSER (W/NMC22)
C 1987-06-14  D. A. KEYSER -- PLACED MINIMUM ON DEWPOINT REPORTS
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING; STREAMLINED
C 1988-09-14  D. A. KEYSER -- PROCESS SPLASH-LVL DROPS. AS MARINE SFC.
C 1988-12-22  D. A. KEYSER -- SUBR. 'SFCDTA' STREAMLINED, SWITCH PBOGUS
C    ADDED, SWITCH SFSHIP RENAMED SFMRNE, SWITCH SFC512 RENAMED SFCMAN
C 1989-02-16  D. A. KEYSER -- TIME WINDOW TYPE DEPENDENT; KEEP/TOSS
C    TYPE DEPENDENT; LAND CHECK IN SEPARATE SUBROUTINE
C 1989-12-13  D. A. KEYSER -- REMOVED PROCESSING OF WIND PART OF SPL-LVL
C    DROPS; OI R.T.=282 NOW USED FOR BUOYS W/ MSG. PRESSURE BUT VALID
C    WINDS, PRESS. SET TO 1013 MB; WIND R.T=283 (CHGD TO 284 ON
C    90-10-23 TO MAKE ROOM FOR SSM/I W. SPD) NOW ANALOGOUS TO MASS R.T.
C    =183; FOR OUTPUT TO OI, ADD'L OI R.TYPES ADDED FOR CASES OF MSG
C    PMSL AND/OR MSG PSTN THESE CAN NOW BE KEPT IN MOST CASES
C 1990-01-05  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77) & RESTRUCTURED
C 1990-10-25  D. A. KEYSER -- NEW SUBR. 'UNPO29' + ENTRIES NOW FORMATS
C    REPORTS IN UNPACKED ON29 (STREAMLINED)
C 1991-01-03  D. A. KEYSER -- PMSL BOGUS R. TYPE EXPANDED (190-POINT,
C    191-PAOBS, 193-DIGIT.)
C 1991-05-14  D. A. KEYSER -- HONORS OPC PMSL AND WIND Q.M. FOR MARINE
C    RPTS; MARINE RPTS NOT TOSSED IF ONLY TEMP BAD; G.LAKES MARINE W/
C    GOOD ELEV SET R.T.=183 & W/ ELEV=0 TOSSED
C 1991-09-10  D. A. KEYSER -- ATLAS BUOY TEST MORE STRINGENT
C 1991-11-19  D. A. KEYSER -- SWITCH 'WNDADJ' ALLOWS W. SPEED FROM
C    MOORED BUOYS W/ ANEM. HGHT .LT. 10 M TO BE ADJUSTED TO HGHT OF 10
C    M VIA CALL TO SUBR. 'CFL'
C 1992-07-09  D. A. KEYSER -- RMVED. SUBPR. FCN "QFRMTP" & REPL. W/
C    IN-LINE FCN STMNT.; NOBS ARRAY NOT FILLED W/ VARIABLE IF .GT.
C    32767
C 1992-08-07  D. A. KEYSER -- ATLAS BUOY TEST MORE STRINGENT
C 1993-05-12  D. A. KEYSER -- SET-UP EXPANDED REPORT FORMAT, WORD 2 FOR
C    EACH MASS/WIND LVL IS PRESS. X 10MB, NEW WORD 5 FOR EACH LEVEL
C    CONTAINS 4 PACKED "PREPBUFR TBL VALUES" WHICH CAN RANGE FROM 0-15
C    AND CORRESPOND TO ON29 Q. MARKERS OR PREPRO-GENERATED Q. MARKERS;
C    ALL NON-MISSING DATA ARE NOW PACKED INTO PREPBUFR FILE
C 1993-05-31  D. A. KEYSER -- CHANGED DEF. VALUES & ORDER FOR NAMELIST
C    SWITCH "IUNIT"
C 1993-07-28  D. A. KEYSER -- REPORT TYPE 183 NOW ESTIMATES PSTN FROM
C    REPORTED PMSL AND TEMP RATHER THAN FROM STAND. ATMOS.
C 1993-09-14  D. A. KEYSER -- ADDED N-LIST SWITCH "TVIRT" TO OUTPUT
C    TEMP. AS VIRTUAL (=TRUE, DEFAULT) OR AS SENSIBLE (=FALSE)
C 1993-10-07  D. A. KEYSER -- PGM RUNS TO COMPL. W/ C.CODE=04 IF EITHER
C    ADPUPA OR ADPSFC CONTAIN NO RPTS; MSG VALUE IN NOBS ARRAY IS
C    99999, ACTUAL HEIGHT (NO D-VAL) STORED IN NOBS ARRAY; ORDER FOR
C    PROCESSING SFC DATA REARRANGED S.T.: 1ST ALL LAND TYPES, NEXT ALL
C    MARINE TYPES, FINALLY ALL PMSL BOGUS TYPES
C 1993-11-02  D. A. KEYSER -- VARIABLE IFLSF WHEN SET TO 1 WILL FLAG
C    ALL VARIABLES WITH PREPBUFR T. VALUE=15
C 1993-12-21  D. A. KEYSER -- FOR REPORTS WITH BAD PMSL TBL VALUE, SETS
C    PSTN TBL VALUE TO 15 (AND VICE VERSA), ALSO IF PSTN MADE FROM PMSL
C    VIA FCN, SET ITS TBL VAL. TO MAXIMUM OF 8 OR PMSL TBL VAL.
C 1994-07-19  D. A. KEYSER -- ATLAS BUOYS HAVE ON29 R. TYPE 562 NOT
C    561 AFTER 2/23/94, CHANGED TEST (ALSO TIGHTENED LAT TEST TO +/- 10
C    DEG. N. LAT FROM +/- 20 DEG. N. LAT)
C 1994-08-11  D. A. KEYSER -- WORDS 6 AND 7 OF MASS LVL NOW CONTAIN
C    SENS. TEMP AND DWPT TEMP, RESP. WHILE WORDS 6 AND 7 OF WIND LVL
C    CONTAIN WIND DIR. AND SPEED, RESP.; ALSO WORD 3 OF MASS LVL NOW
C    CONTAINS "REPORTED" TEMP
C 1995-08-24  D. A. KEYSER -- R.T. 182 RECCOS W/ EST. PMSL CORRECTED TO
C    GET SFC. HGHT OF ZERO RATHER THAN FROM REPORTED ELEV (P-ALT); DVAL
C    CHECK ON R.T. 182 PRESS. CHGD FROM LOW- LIMIT OF -75MB TO -215MB
C    TO ACCEPT PRESS. IN HURRICANE SITUATIONS
C 1996-03-04  D. A. KEYSER -- FOR RGL-BUFR OUTPUT: MORE FIXES TO MAKE
C    BUFR-PREPDA FILE CONTAIN DATA EXPECTED BY FERR PGM & OI-ANAL
C    (PRESSURE ENCODED IN BUFR IS TO NEAREST WHOLE MILLIBAR W/ ZERO IN
C    TENTHS); ALL SURFACE REPORTS SET HEIGHT Q.M. TO PSTN Q.M. VALUE
C    PRIOR TO STORING RPT IN NOBS ARRAY & SUBSEQ. ENCODING IN PREPBUFR
C    (USED TO ALWAYS ASSIGN HEIGHT A NEUTRAL Q.M.)
C 1996-09-03  D. A. KEYSER -- ADDED SWITCH "MSGPSF" TO PROCESS SFC LAND
C    RPTS W/ MISSING PSTN AND PMSL (STD. ATMS. PSTN USED) (NOT PROC. IN
C    OPERATIONS); CAN READ WSPD IN M/S X 10 FROM ON29 CAT.8, C.FIG. 924
C    IF AVAILABLE
C 1997-09-18  D. A. KEYSER -- REDEFINED N-LIST SWITCH "MSGPSF=T" TO USE
C    ALTIMETER SETTING FOR PMSL WHEN OBS. PMSL & PSTN ARE MISSING; CAN
C    STORE ALTIM. SETTING IN COMMON (LATER ENCODES INTO PREPBUFR)
C 1997-10-06  D. A. KEYSER -- ALL LOGIC RE: PROCESSING OF ASYNPOTIC SFC
C    REPORTS (OBSOLETE) REMOVED
C 1998-02-17  D. A. KEYSER -- WSPD IN M/SEC * 10 NOW READ DIRECTLY FROM
C    CAT 6. (NOT CAT. 8); REMOVED LOGIC TO ADJ. MOORED BUOY WSPD TO
C    ALT. OF 10 METERS
C 1998-06-15  D. A. KEYSER -- STREAMLINED THE PROCESSING OF CAT. 6
C    RECCOS W/ EITHER MAND LVL GEOPOT. OBS OR MEAN SEA-LVL PRESS. OBS
C 1999-08-04  D. A. KEYSER -- UPDATED LOGIC TO PROPERLY PROCESS
C    AUSTRALIAN SEA-LEVEL PRESSURE BOGUS DATA (PAOBS); R.C. =4 NOW
C    OCCURS IF EITHER NO ADPUPA OR ADPSFC REPORTS WERE PROCESSED INTO
C    PREPBUFR FILE, BEFORE IT OCCURRED ONLY IF EITHER NO ADPUPA OR
C    ADPSFC REPORTS WERE READ IN
C 1999-11-04  D. A. KEYSER -- SWITCHES "FWINDO", "JSURFM" AND "JSURFW"
C    ARE NOW ABLE TO ACT ON SURFACE LAND SYNOPTIC AND METAR DATA
C    SEPARATELY; CAN NOW SKIP OVER INPUT BUFR MESSAGES IN DATA DUMP
C    FILES IF THE BUFR TYPE/SUBTYPE IS SET TO BE EXCLUDED (BEFORE
C    EXCLUSION OCCURRED ONLY AFTER REPORT WAS DECODED FROM DUMP FILE),
C    THIS MAKES THIS PROGRAM MORE EFFICIENT IN THESE CASES (NOTE:
C    APPLIES ONLY TO U-AIR AND SURFACE LAND DATA READ IN VIA FUNCTION
C    IW3UNPBF)
C 2000-09-22  D. A. KEYSER -- ADDED PROCESSING OF AUTOMATED TIDE GAUGE
C     STN DATA (SFC MARINE TYPE, ON29 R.T. 533), N-LIST SWITCHES
C     "FWINDO", "JSURFM" AND "JSURFW" EXPANDED FROM 8 TO 9 WORDS
C 2000-12-05  D. A. KEYSER -- CHANGED ON29 REPORT TYPE (T29) FOR SFC
C     MARINE AUTOMATED TIDE GAUGE REPORTS FROM 533 TO 532 SO THEY AGREE
C     WITH REPORT TYPE IN QUIPS PROCESSING; N-LIST SWITCH "MSGPSF"
C     REPL. BY SWITCH "PFRALT" WHICH PROCESSES METARS W/ MISSING
C     PRESSURE BY CALC. PSTN FROM ALTIMETER, THESE GET NEW R.T.
C     187/287; METARS W/ MISSING WDIR & WSPD .LE. 3M/SEC ENCODE WSPD
C     OBS/QM IN NEW MNEM. "SOB" AND "SQM"; FOR IRNMRK=4 (RUC) ALL BUOYS
C     W/ MISSING PRESSURE BUT VALID WIND ARE PROC. W/ R.T. 282 (PRESS.
C     SET TO 1013.3MB, JUST LIKE ATLAS BUOYS)
C 2001-04-06  D. A. KEYSER -- PRINTS DIAG. IF TDEW < TDLIM; SUBR.
C     "RPTLBL" NOW HAS INPUT ARGS. "TIMWIN_e" (EARLIEST TIME WINDOW)
C     AND "TIMWIN_l" (LATEST TIME WINDOW) REPL. "TIMWIN" (+/- TIME
C     WINDOW) ("-" PRIOR TO CYCLE TIME, "+" AFTER CYCLE TIME), ALLOWS
C     THE 2 TO BE DIFFERENT
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"
C 2001-09-14  D. A. KEYSER -- REPORT SEQ. NUMBER STORED IN HDR(11) FOR
C     SURFACE LAND AND SURFACE MARINE REPORTS LATER ENCODED IN PREPBUFR
C     FILE UNDER MESSAGE TYPES "ADPSFC" AND "SFCSHP"
C 2002-01-14  D. A. KEYSER -- LEVELS WITH REPORTED DWPT < "TDLIM" VALUE
C     NOW CALC. SPEC. HUM AND RETAIN DWPT IN PREPBUFR FILE, BUT
C     MOISTURE PREPBUFR TABLE VALUE IS FLAGGED WITH Q.M.=15 IN SUBR.
C     FIZZ01 (BEFORE, SPEC. HUM. AND DWPT SET TO MISSING) VIRT. TEMP.
C     CALC. AND ENCODED IN THIS CASE  (BEFORE, SET TO SENSIBLE TEMP.)
C 2002-01-28  D. A. KEYSER -- CORRECTED ERROR INTRODUCED ~1/9/2001
C     WHICH RESULTED IN NO MASS REPORTS BEING ENCODED INTO THE RUC
C     VERSION OF THE PREPBUFR FILE FOR MOORED AND DRIFTING BUOYS
C     (AFFECTED ONLY THE RUC AND ONLY THESE DATA TYPES)
C 2004-01-09  D. A. KEYSER -- SWITCH SUBSKP (NOW IN NAMELIST) SECOND
C     DIMENSION CHANGED FROM 1:200 TO 0:200 TO ACCOUNT FOR WMO RES. 40
C     SYNOP REPORTS WITH BUFR SUBTYPE 000; ITYP = 1 (AND PROCESSING
C     SWITCHES ASSOCIATED WITH IT) NOW INCLUDE WMO RES. 40 SYNOPS
C     (THIS WAS AN OVERSIGHT WHEN RES. 40 SYNOPS WERE SPLIT FROM
C     REMAINING SYNOPS IN ADPSFC DUMP FILE IN SUMMER OF 2003, BUT
C     IT CAUSED NO HARM TO DATE)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF MESONET DATA, READ
C     FROM "MSONET" DUMP FILE DUMP R. TYPE 540, GET PREPBUFR R. TYPE
C     188/288, PROCESSED INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "MSONET", THESE CAN HAVE AN ELEVATION Q.M. - IF IT'S POOR SET
C     PSTN AND PMSL (IF PRESENT) Q.M. TO 15 (BAD), IF IT'S FAIR SET
C     PSTN AND PMSL (IF PRESENT) Q.M. TO 3 (SUSPECT); EXPANDED
C     NAMELIST SWITCHES FWINDO, JSURFM AND JSURFW FROM 9-WORDS TO 11-
C     WORDS TO ADD MESONET IN WORD 9 AND MOBILE SYNOPTIC LAND IN WORD
C     10; IF MESONET REPORT HAS A MISSING PSTN (PMSL ALWAYS MISSING)
C     BUT A VALID ALTIMETER SETTING, GENERATE PSTN FROM OBSERVED
C     ALTIMETER AND ELEV. (CHAR. 8 OF STNID IS SET TO 'a' TO IDENTIFY
C     THESE); IF MESONET REPORT HAS A MISSING PSTN (PMSL ALWAYS
C     MISSING) AND A MISSING ALTIMETER SETTING, GENERATE PSTN FROM STD.
C     ATMOS. PMSL, OBSERVED TEMP. AND ELEV. (CHAR. 8 OF STNID IS SET
C     TO 'x' TO IDENTIFY THESE); ADDED PROCESSING OF MOBILE SFC
C     SYNOPTIC LAND RPTS NOW POSSIBLY INCL. IN "ADPSFC" DUMP FILE DUMP
C     R. TYPE 514, INCL. WITH EXISTING PREPBUFR R. TYPES 181/183/281/
C     284, PROCESSED INTO PREPBUFR FILE UNDER EXISTING TBL A ENTRY
C     "ADPSFC"; NOW RETURNS 41-WORD (RATHER THAN 2-WORD) ARRAY "OBS2"
C     OUT OF CALL TO IW3UNPBF, WHERE WORDS 3-41 CONTAIN ALTIMETER
C     SETTING (WHICH HAD BEEN RETURNED IN CAT. 8, C.F. 20, NOW ONLY
C     ALTIMETER TBL. VAL. RETURNED FROM HERE), SEA-SURFACE TEMPERATURE,
C     SINGLE-LEVEL SENSIBLE WEATHER ELEMENTS AND SST TABLE VALUE
C     (Q.M.); RETURNS NEW ARRAY ARGUMENTS "OBS3" {(5,MXBLVL,5)} AND
C     "NOBS3" {(5)} OUT OF CALL TO IW3UNPBF WHERE OBS3 CONTAINS
C     MULTIPLE-LEVEL SENSIBLE WEATHER ELEMENTS AND NOBS3 DEFINES THE
C     NUMBER OF LEVELS OF DATA IN THE OBS3(X,Y,1) TO OBS3(X,Y,5) ARRAYS
C     (SEE IW3UNPBF DOCBLOCK FOR MORE INFO); ALL NEW PARAMETERS (I.E.,
C     SST AND SENSIBLE WEATHER ELEMENTS) IN OBS2 AND OBS3 ARE ENCODED
C     INTO PREPBUFR FILE, BUT ONLY IN THE MASS "PIECE" OF A REPORT
C     (UNLESS THERE IS NO MASS PIECE, THEN THEY ARE ENCODED INTO WIND
C     PIECE)
C 2006-08-17  D. A. KEYSER -- MODIFIED THE FUNCTION WHICH CALC. PSTN
C     FROM ALTIMETER SETTING BASED ON REQUEST BY JOHN DERBER
C 2007-09-14  D. A. KEYSER -- CASES WHERE OBS ARE SET TO QM=15 IN ORDER
C     TO FLAG A REPORT FOR NON-USE BY ANALYSIS (EVEN THOUGH OBS MAY NOT
C     NECESSARILY BE BAD) NOW FIRST CHECK TO MAKE SURE OBS QM ISN'T
C     ALREADY "BAD" (> 3 AND < 15) (PREVENTS GSI FROM MONITORING TRULY
C     BAD OBS WHICH JUST HAPPEN TO BE IN REPORT GROUPS FLAGGED FOR NON-
C     USE BY ANALYSIS)
C 2008-09-25  D. A. KEYSER -- UPPER LIMIT FOR STORING Q CHANGED FROM
C     32767 MG/KG TO 99999 MG/KG TO ENSURE THAT LEVELS WITH VERY
C     HIGH SPECIFIC HUMIDITY ARE PROCESSED (THE 32767 LIMIT WAS A
C     VESTIGE FROM THE OLD I*2 PREPDA DAYS); IF NEAREST INTEGER FOR Q
C     IS 0 MG/KG, IT IS RESET TO 1 MG/KG (.001 G/KG) TO ENSURE THAT
C     LEVELS WITH VERY LOW SPECIFIC HUMIDITY ARE PROCESSED (Q MUST BE >
C     0 TO BE PROCESSED)
C 2010-06-07  D. A. KEYSER -- NOW CHECKS FOR ALTIMETER Q.M. IN CODE
C     FIG. 20 OF CAT. 8 FOR METARS (AS WELL AS FOR MESONETS AS BEFORE)
C     SINCE IW3UNPBF IS ALSO MODIFIED HERE TO STORE THIS FOR METARS
C     (BUT ONLY IF Q.M. VALUE IS 12-REJECT or 14-PURGE); CORRECTED BUG
C     WHICH WAS NOT PROPERLY INTERPRETING ALTIMETER Q.M. IN CODE FIG.
C     20 OF CAT. 8 FOR MESONETS (MANY MESONET PRESS. Q.M.'S WERE SET TO
C     2 OR 15 WHEN THEY SHOULD HAVE BEEN SET TO 3 OR 13, RESP.) (NOTE
C     THAT MESONETS TO NOT REPORT PRESS. SO ALTIMETER SETTING IS USED
C     TO CALCULATE PRESS. AND THE ALTIMETER Q.M. IS TRANSFERRED TO
C     PRESS.)
C 2014-04-25  S. Melchior  --
C          - Added processing of Coast Guard tide gauge data (read from
C     SFCSHP dump, dump report type 534). A 12'th word added to
C     following namelist switches to account for these new reports:
C     FWINDO, JSURFM, JSURFW.
C          - Added new namelist switch NPKRPT, if TRUE all of the below
C     occurs: will process reports that would otherwise be tossed due
C     to their having a missing pstn; these reports estimate pstn from
C     the reported or U.S. std. atmosphere pmsl, the reported or U.S.
C     std. atmosphere sensible temperature, and the reported elevation
C     (only marine reports > 7.5 m can have a reported pmsl and fall
C     into this category); this estimated pstn (POB) is used to
C     estimate q (QOB); both POB and QOB are assigned minimum q.m.'s
C     (PQM, QQM) of 3; estimated POB is encoded into PREPBUFR file;
C     these reports are then assigned new PREPBUFR report types 192/292
C     (SYNOP), 193/293 (METAR), 194/294 (marine), 195/295 (mesonet);
C     ATLAS buoy wind reports which also have missing pstn and pmsl
C     will continue to be processed as before (PREPBUFR report type 282
C     - note: this means that if an ATLAS buoy ever had T,q info, its
C     mass piece would still be tossed rather than getting into
C     PREPBUFR file under report type 194 (may need to fix this logic
C     someday); MESONETS will no longer have "x" in character 8 of id,
C     instead they will get PREPBUFR report types 195/295 rather than
C     188/288.
C          - Modified to trap reports whose wind information exceeds
C     the 32767 limit.  If the limit is exceeded, the entire report
C     will skip being encoded into the output PREPBUFR file.
C          - Modified to always encode wind speed obs in m/sec ("SOB")
C     and wind direction obs ("DDO") for all types of surface reports
C     (even if one or the other are missing but also if both are
C     present); removed old logic which encoded "SOB" only for METAR
C     reports when direction was missing and speed was .LE. 3 m/sec
C     (direction was never encoded in any situation for surface
C     reports), also removed encoding of "SQM" (wind speed quality
C     mark) for these types of METAR reports - all surface reports now
C     encode wind qm as "WQM" regardless of whether or not it also
C     encodes direction, speed, u-comp or v-comp.
C          - Report type 183 now stores moisture quality mark no lower
C     than 3 (suspect) (before type 183 stored observed moisture
C     quality mark read from the ADPSFC dump file).
C 2015-04-16  D. A. Keyser -- Call to subr. LNDCHK now uses new 16
C     point check for determining if marine reports in the N.H. are
C     over land or sea.
C 2020-08-20 J. Dong -- Defined IDSDAT to eliminate Boundary Run-time
C     Check Failures.
C
C USAGE:    CALL SFCDTA
C   INPUT FILES:
C          {FF IS UNIT NUMBER DEFINED AS IUNIT(6)  IN NAMELIST "&PARM"}
C          {EE IS UNIT NUMBER DEFINED AS IUNIT(5)  IN NAMELIST "&PARM"}
C     UNIT FF   - 'ADPSFC' BUFR DATA DUMP FILE {SYNOPTIC (INCL. WMO RES.
C                 40)/METAR LAND SFC)
C     UNIT FF+1 - 'SFCSHP' BUFR DATA DUMP FILE (MARINE SURFACE)
C     UNIT EE   - 'ADPUPA' BUFR DATA DUMP FILE (RAOB/PIBAL/DROPS/RECCOS)
C     UNIT FF+2 - 'SFCBOG' BUFR DATA DUMP FILE (MEAN SEA-LVL PRES BOGUS)
C     UNIT FF+3 - 'MSONET' BUFR DATA DUMP FILE (COOPERATIVE NETWORKS)
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.  SIMILAR TO SUBROUTINE 'PREP'
C   BUT HANDLES ONLY SURFACE DATA.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE SFCDTA
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*8   STNID,FILNAM(5),DSNAME,SUBSET_d
      CHARACTER*41  NAME1
      LOGICAL  LFM,MARLND,MSLBOG,ATLAS,PFRALT,SFLAND,SUBSKP,PFRALT_save,
     $ npkrpt
      INTEGER  IDATA(MAXOBS),NC(5),ISQNUM(3),NOBS3_SAVE(7)
      INTEGER(8)  IDSDAT,IDSDMP_8
      REAL OBS2_SAVE(4:NUMOBS2),OBS3_SAVE(5,MXBLVL,7)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/RUNSW/IRNMRK
      COMMON/STRMSL/IPMSL(MXTYPV)
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/LNDSEA/GDSH(145,37),GDUS(362,91),GDNH(362,91)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/LFMSFC/LFMAXI,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,MARLND,
     $ JSURFM(12),JSURFW(12),FWINDO(12),PFRALT,npkrpt(12)
      COMMON/PARM4/ICODE
      COMMON/SKPCNT/KSKPUA,KSKPSF,KMSGUA,KMSGSF,KBDYUA,KBDYSF,KTIMUA,
     $ KTIMSF,KSKNSW,KSKREC,KNOATS,KNTUPA,KNTCAR,KNTAIR,KNTSWN,KNTPRO,
     $ KNTVAD,KNTRAS,KNTDUM(3),KNTSSS(5),KSKSWN,KSKACF,KNDCDE(3),
     $ KSKCLS,KSKTHN,KSKOMR(2),KSKALM(9),KSKAHM(9),KSKNOW(9),KSKDRP
      COMMON/SFCBFR/ALTIMR,PRSS
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      common/pstnflg/ipstnflg
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE  (IDATA,RDATA)
      DATA  NC/1,2,4,5,3/
      DATA XMISS/99999./,YMISS/99998.8/,IMISS/99999/
      DATA  FILNAM/'ADPSFC  ','SFCSHP  ','MSONET  ','ADPUPA  ',
     $             'SFCBOG  '/
C FCN PR GETS PSTN FROM PMSL, TEMPERATURE AND ELEVATION (ELEV < 11000M)
      PR(PMSL,TEMP,ELEV) =PMSL * (((TEMP - (.0065 * ELEV))/TEMP)**5.256)
C FCNS BELOW CONVERT TEMP/TD (K) & PRESS (MB) INTO SAT./ SPEC. HUM.(G/G)
      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 FCN P_f_A GETS PSTN (MB) FROM ALTIMETER SETTING (MB) AND ELEVATION (M)
      P_f_A(ALT,ELEV) = (ALT**0.190284 - (((1013.25**0.190284)*
     $ 0.0065/288.15)*ELEV))**5.2553026
ccccc      P_f_A(ALT,ELEV) = (ALT**0.190284 - (((1013.25**0.190284)*
ccccc     $ 0.0065/288.15)*ELEV))**5.2553026 + 0.3
      PRINT 8001
 8001 FORMAT(//31X,21('-'),' ***** SURFACE DATA ***** ',21('-'))
      IATLAS = 562  ! Atlas buoys have this dump report type (drifting)
C IQMLIM IS PREPBUFR TBL VAL. LIMIT FOR ACCEPTING REPORTS
      IQMLIM = 16
      NN = 1
      ISQNUM = 0
      MNDX = 1
      PFRALT_save=PFRALT ! namelist switch PFRALT will be hardwired to
                         !  true if mesonet reports (NN=3) are
                         !  processed - save original value so it can
                         !  be set back for subsequent sfc types (NN>3)
  700 CONTINUE
      IOPENED   = 0
      DSNAME    = 'ZZZZZZZZ'
      IDSDAT    = 0
      IDSDMP_8  = 0
      SUBSET_d  = 'XXXXXXXX'
C KNTALL COUNTS NO. OF REPORTS UNPACKED FROM FILE (ALL REPORTS)
      KNTALL = 0
C KOUNT COUNTS NO. OF REPORTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
C NN WILL INDICATE WHICH SURFACE FILE IS BEING EXAMINED:
C    NN = 1 ===> ADPSFC (LAND SURFACE)
C    NN = 2 ===> SFCSHP (MARINE SHIP, BUOY, C-MAN, TIDE GAUGE)
C    NN = 3 ===> MESONET SURFACE (COOPERATIVE NETWORKS)
C    NN = 4 ===> ADPUPA (SPLASH-LEVEL REPORTS OVER WATER FROM EITHER
C                DROPWINSONDES OR RECCOS WITH PMSL OBS)
C    NN = 5 ===> SFCBOG (MEAN S-LVL PRESS. BOGUS OVER WATER -BOTH TYPES)
      NNN = NC(NN)
      IF(NN.EQ.1)  THEN
C CHECK TO SEE IF ANY BUFR MESSAGES CAN BE SKIPPED IN INPUT ADPSFC DUMP
         IF(MIN(JSURFM(1),JSURFW(1)).EQ.9999)  THEN
            SUBSKP(000,000) = .TRUE.
            SUBSKP(000,001) = .TRUE.
         END IF
         IF(MIN(JSURFM(11),JSURFW(11)).EQ.9999) SUBSKP(000,002) = .TRUE.
         IF(MIN(JSURFM(8), JSURFW(8)) .EQ.9999) SUBSKP(000,007) = .TRUE.
C CHECK TO SEE IF ADPSFC DATA SHOULD BE PROCESSED
         IF(SUBSKP(000,000).AND.SUBSKP(000,001).AND.SUBSKP(000,002).AND.
     $    SUBSKP(000,007))  GO TO 7008
      ELSE  IF(NN.EQ.5)  THEN
C CHECK TO SEE IF SFCBOG DATA SHOULD BE PROCESSED
         IF(MIN(JSURFM(3),JSURFM(7)).GT.0)  GO TO 7008
      ELSE  IF(NN.EQ.3)  THEN
         IF(MIN(JSURFM(10),JSURFW(10)).EQ.9999) GO TO 7008
C MESONET REPORTS ALWAYS GET PFRALT=.TRUE.
         PFRALT=.TRUE.
      ELSE  IF(NN.GT.3)  THEN
         PFRALT=PFRALT_save ! set PFRALT back to its original value
                            !  since it was hardwired as TRUE for
                            !  mesonets
      END IF
C OTHERWISE SET-UP PROPER UNIT NOS. TO READ IN FOR NN = 1-5
      NFILE = NNN + IUNIT(6) - 1
      IF(NN.EQ.4)  THEN
C CHECK TO SEE IF SPLASH-LEVEL REPORTS FROM DROPS OR RECCOS WITH PMSL
C  OBS (ADPUPA) SHOULD BE PROCESSED; OTHERWISE SET-UP UNIT NO. FOR NN=4
         IF(JSURFM(5).NE.0)  GO TO 7008
         NFILE = IUNIT(5)
      END IF
      IFLAG = 0
      PRINT 5678, FILNAM(NN)
 5678 FORMAT(/130('.')/15X,'Next Dataset should be ',A8/130('.')/)
      GO TO 2100
C***********************************************************************
C***********************************************************************
 2090 CONTINUE
C COUNT ALL SKIPPED REPORTS
      KSKPSF = KSKPSF + 1
C***********************************************************************
C***********************************************************************
 2100 CONTINUE
C initialize ipstnflg as 0 prior to unpacking each new report (will be
C  set to 1 if a report has missing pressure and it is to be kept,
C  i.e., npkrpt=T for the particular type)
      ipstnflg = 0
C CALL UNPREPBF TO UNPACK THE NEXT REPORT
      CALL UNPREPBF(IFLAG,CYCLET,IOPENED,DSNAME,IDSDAT,IDSDMP_8,*7000)
      IF(IFLAG.EQ.1)  THEN
C.......................................................................
C IFLAG = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
         PRINT 871
  871 FORMAT(/40X,'+++  TIME WINDOW  (+/- HRS X 100) ON REPORTS  +++',/)
         IF(NN.EQ.1)  THEN
            NAME1 = 'SFC SYNP LAND (FIXED) (INCL WMO RES 40) .'
            IF(.NOT.SUBSKP(000,000) .OR. .NOT.SUBSKP(000,001))
     $       PRINT 873, NAME1,FWINDO(1)
            NAME1 = 'SURFACE SYNOPTIC LAND (MOBILE) ..........'
            IF(.NOT.SUBSKP(000,002))  PRINT 873, NAME1,FWINDO(11)
            NAME1 = 'SURFACE METAR LAND ......................'
            IF(.NOT.SUBSKP(000,007))  PRINT 873, NAME1,FWINDO(8)
  873 FORMAT(42X,A41,F5.0)
            PRINT'(1X)'
         ELSE  IF(NN.EQ.4)  THEN
            NAME1 = 'SPLASH-LEVEL REPORTS (MASS) .............'
            PRINT 873, NAME1,FWINDO(5)
            PRINT'(1X)'
         ELSE  IF(NN.EQ.2)  THEN
            PRINT 872, FWINDO(2),FWINDO(4),FWINDO(6),FWINDO(9),
     $                 fwindo(12)
  872 FORMAT(42X,'SURFACE SHIP ',28('.'),F5.0/42X,'BUOY ',36('.'),F5.0/
     $ 42X,'C-MAN PLATFORM ',26('.'),F5.0/42X,'AUTOMATED TIDE GAUGE ',
     $ 'STATIONS ',11('.'),F5.0/42X,'COAST GUARD TIDE GAUGE STATIONS ',
     $ 9('.'),F5.0/)
         ELSE  IF(NN.EQ.5)  THEN
            PRINT 2872, FWINDO(3),FWINDO(7)
 2872 FORMAT(42X,'OPC/NOS POINT SEA-LEVEL PRESSURE BOGUS ..',F5.0,
     $  /,42X,'AUSTRALIAN (PAOBS) SEA-LVL PRESS. BOGUS..',F5.0/)
         ELSE  IF(NN.EQ.3)  THEN
            PRINT 3872, FWINDO(10)
 3872 FORMAT(42X,'MESONET COOPERATIVE NETWORK .............',F5.0/)
         END IF
         GO TO 2100
C.......................................................................
      END IF
      KNTALL = KNTALL + 1
C 'ICALLM' INDICATES WHETHER MASS PIECE STORED IN OUTPUT FILE (IF SO =1)
C 'ICALLW' INDICATES WHETHER WIND PIECE STORED IN OUTPUT FILE (IF SO =1)
      ICALLM = 0
      ICALLW = 0
      ITYP = -99999
      ICF352 = 0
      AMSLPR = XMISS
C  SAVE OBS2 AND OBS3 VARIABLES SINCE THESE ARE NORMALLY ONLY ENCODED
C   WITH MASS REPORT {OBS2(1-3) - RSRD, EXPRSRD, ALSE NOT SAVED SINCE
C   THESE ARE ENCODED WITH BOTH MASS AND WIND REPORTS}
      OBS2_SAVE(4:NUMOBS2) = OBS2(4:NUMOBS2)
      OBS3_SAVE = OBS3
      NOBS3_SAVE = NOBS3
      IF(NN.EQ.4)  THEN
C EXAMINE REPORTS IN "ADPUPA" FILE ...
         IF(IDATA(9).NE.31)  THEN
C  ... SIPHON OFF ANY NON-RECCO OR NON-DROPS
            GO TO 2100
         ELSE
C  ... CHECK FOR RECCOS WITH PMSL OBS - VALID SPLASH-LVL REPORTS
            IF(IDATA(27).GT.0)  THEN
               L8 = IDATA(28) - 4
               DO I = 1,IDATA(27)
                  L8 = L8 + 4
                  IF(NINT(RDATA(L8+1)).EQ.352)  THEN
                     IF(RDATA(L8).LT.YMISS)  THEN
                        ICF352 = 1
                        AMSLPR = RDATA(L8)
                        ITYP = 5
                     END IF
                  END IF
               ENDDO
            END IF
         END IF
      END IF
      IF(ITYP.EQ.-99999)  ITYP = ISSEL(IDATA(9))

C THE TYPE OF REPORT JUST UNPACKED IS INDICATED BY 'ITYP'
C   ITYP =  1 ===> SURFACE SYNOPTIC LAND STATION (FIXED)
C                  (INCLUDING WMO RESOLUTION 40)
C   ITYP =  2 ===> SHIP (FIXED AND MOVING)
C   ITYP =  3 ===> OPC/NOS POINT MEAN SEA-LEVEL PRESSURE BOGUS
C   ITYP =  4 ===> BUOY (FIXED AND DRIFTING))
C   ITYP =  5 ===> SPLASH-LEVEL MASS FROM DROPS/RECCO WITH PMSL OBS
C   ITYP =  6 ===> C-MAN PLATFORM
C   ITYP =  7 ===> AUSTRALIAN SEA-LEVEL PRESSURE BOGUS - PAOBS
C   ITYP =  8 ===> SURFACE METAR LAND
C   ITYP =  9 ===> AUTOMATED TIDE GAUGE STATION
C   ITYP = 10 ===> MESONET SURFACE (COOPERATIVE NETWORKS)
C   ITYP = 11 ===> SURFACE SYNOPTIC LAND STATION (MOBILE)
C   ITYP = 12 ===> COAST GUARD TIDE GAUGE STATION
C   ITYP = 13-19 > RESERVED FOR FUTURE TYPES
C   ITYP = 20 ===> RECCO/DROPWINSONDE WITH NO SPLASH-LEVEL MASS
C                  INFORMATION (INVALID TYPE)
C   ITYP = 30 ===> "OTHER" (INVALID TYPE)

      IFLSF = 0
      IFLTH = 0
      ATLAS = .FALSE.
                                         ! Consider Mesonet as land here
      SFLAND = (ITYP.EQ.1.OR.ITYP.EQ.8.OR.ITYP.EQ.10.OR.ITYP.EQ.11)
      MSLBOG = (ITYP.EQ.3.OR.ITYP.EQ.7)
C FOR NON-BOGUS RPTS, 'INSTR' WILL SPECIFICALLY IDENTIFY THE LAST DIGIT
C  OF THE SFC R. TYPE - DEFAULT IS 0 ==> OCEANIC WITH VALID PSTN
      INSTR = 0
      IF(SFLAND)  INSTR = 1
      IF(ITYP.EQ.5)  THEN
         INSTR = 2
      ELSE  IF(ITYP.EQ.10)  THEN
         INSTR = 8
      ELSE  IF(ITYP.GT.19)  THEN
C SKIP ALL INVALID SURFACE TYPES (WITH NO COUNT)
CCCCC    IF(ITYP.EQ.20)  PRINT 8755, STNID,RDATA(1),RDATA(2),IDATA(9)
C8755 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
CCCCC$ 'LON=',F8.2,'E, RTYP',I4,' - RECCO/DROP, NOT SPLASH-LEVEL MASS')
CCCCC    IF(ITYP.EQ.30)  PRINT 8757, STNID,RDATA(1),RDATA(2),IDATA(9)
C8757 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
CCCCC$ 'LON=',F8.2,'E, RTYP',I4,' - NOT A VALID SURFACE REPORT')
         GO TO 2100
      END IF
C-----------------------------------------------------------------------
C BEGIN A SERIES OF CHECKS ON THE UNPACKED REPORT -- IF ANY ONE OF THEM
C               FAILS, THE REPORT WILL BE SKIPPED
C-----------------------------------------------------------------------
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
      CALL CHKREP(KMSGSF,KBDYSF,*2090)
C TEST FOR DATA THINNING OUTSIDE LFM GRID (BASED ON LFMAXI VALUE);
C  THINNING APPLIED LATER
      LFM = .TRUE.
      IF(LFMAXI.GT.0.AND.LFMAXJ.GT.0)  THEN
C DATA THINNING TURNED ON - LFM=T IF REPORT W/I LFM GRID (OTHERWISE = F)
         XFMI = 0
         YFMJ = 0
         IF(ABS(NINT(RDATA(1)*100.)).LE.8999)  THEN
            WLON = 360. - RDATA(2)
            IF(NINT(WLON*100.).EQ.36000)  WLON = 0.
            CALL W3FB04(RDATA(1),WLON,FMESHL,FLONVT,XFMI,YFMJ)
         END IF
         XFMI = XFMI + FPOLEI
         YFMJ = YFMJ + FPOLEJ
         LFM = (XFMI.GE.1.0.AND.XFMI.LE.REAL(LFMAXI).AND.YFMJ.GE.1.0
     $    .AND.YFMJ.LE.REAL(LFMAXJ))
      END IF
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
      TIMWIN_e = -FWINDO(ITYP) * .01
      TIMWIN_l =  FWINDO(ITYP) * .01
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMSF = KTIMSF + 1
         GO TO 2090
      END IF
C TEST FOR OVERLAND MARINE REPORTS
      IF(MARLND)  GO TO 1490
C-----------------------------------------------------------------------
C TEST FOR ALL SURFACE MARINE TYPES EXCEPT C-MAN, AUTOMATED TIDE
C           GAUGE STNS, AND COAST GUARD TIDE GAUGE STNS
C                       FOR OVER LAND CRITERIA
C              IF MET SUCH RPTS ARE GIVEN PREPBUFR T.V.=15
C-----------------------------------------------------------------------
C EXCLUDE SFC LAND (+ MESONET), C-MAN, AUTOMATED TIDE GAUGE AND COAST
C  GUARD TIDE GAUGE STNS FROM TEST
      IF(SFLAND.OR.ITYP.EQ.6.OR.ITYP.EQ.9.OR.ityp.EQ.12)  GO TO 1490
C EXCLUDE PMSL BOGUS REPORTS OVER GREENLAND FROM TEST
      IF(MSLBOG.AND.NINT(RDATA(1)*100.).GE.6000.AND.
     $ NINT(RDATA(1)*100.).LE.8500.AND.NINT(RDATA(2)*100.).GE.30000.AND.
     $ NINT(RDATA(2)*100.).LE.34000)  GO TO 1490
C OTHERWISE, CALL SUBR. LNDCHK, SEE IF RPT SATISFIES OVER LAND CRITERIA
      IF(NINT(RDATA(1)*100.).LT.0)  THEN
         CALL LNDCHK(RDATA(1),RDATA(2),1,4,1,GDSH,145,37,0.5,ILAND)
      ELSE
ccccc    CALL LNDCHK(RDATA(1),RDATA(2),1, 4,1,GDNH,362,91,0.5,ILAND)
         CALL LNDCHK(RDATA(1),RDATA(2),1,16,1,GDNH,362,91,0.5,ILAND)
      END IF
      IF(ILAND.EQ.0)  GO TO 1490
C REPORT SATISFIES OVER LAND CRITERIA PROCESS BUT FLAG ALL VARIABLES W/
C  PREPBUFR T.V. OF 15
      IF((.NOT.MSLBOG.OR.(MSLBOG.AND.JSURFM(ITYP).NE.9999)).AND.IPRINT
     $ .EQ.0)  PRINT 929, STNID,RDATA(1),RDATA(2),IDATA(9)
  929 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVER LAND MARINE REPORT')
      IF(IFLSF.EQ.0)  KSKOMR(2) = KSKOMR(2) + 1
      IFLSF = 1
C-----------------------------------------------------------------------
 1490 CONTINUE
C FOR EVERY UNPACKED REPORT, INITIALIZE ALL STATE VARIABLES AS MISSING
      PMSL = XMISS
      PSTN = XMISS
      TEMP = XMISS
      DPDP = XMISS
      UCOMP= XMISS
      VCOMP= XMISS
C FOR ALL REPORTS, INITIALIZE ALL PREPBUFR TABLE VALUES = 15
      IM0 = 15
      IMP = 15
      IMT = 15
      IMQ = 15
      IMW = 15
      IMZ = 15
      IMA = 15
      ALTIMR = XMISS
      IME = IMISS
      IFOUND_20 = 0
      IF(ITYP.EQ.10.OR.ITYP.EQ.8)  THEN
C MESONETS AND METARS STORE ALTIMETER TABLE VALUE IN CAT. 8, C.F. 20
         IF(IDATA(27).GT.0)  THEN
            L8 = IDATA(28) - 4
            DO I = 1,IDATA(27)
               L8 = L8 + 4
               IF(NINT(RDATA(L8+1)).EQ.20)  THEN
                  IFOUND_20 = 1
                  IF(OBS2(3).LT.BMISS)  THEN
                     IF(PFRALT.AND.SFLAND) THEN
                        IMA = 2
                        IF(NINT(RDATA(L8)).LT.16)  IMA = NINT(RDATA(L8))
                     END IF
                     GO TO 779
                  END IF
                  GO TO 779
               END IF
            ENDDO
         END IF
      END IF
  779 CONTINUE
C CHECK FOR VALID ALTIMETER SETTING IN OBS2(3), MAY STORE/USE IT LATER
      IF(OBS2(3).LT.BMISS)  THEN
         IF(PFRALT.AND.SFLAND) THEN
            ALTIMR = NINT(OBS2(3)*0.1)
                ! Altimeter table value hardwired to 2 for non-mesonets,
                !  non-METARs, and METARs which did not have an altim.
                !  table value in cat,. 8, code figure 20
            IF(ITYP.NE.10.AND.(ITYP.NE.8.OR.IFOUND_20.EQ.0))  IMA = 2
         END IF
      END IF
      IF(IDATA(29).EQ.0.AND.ITYP.NE.5)  THEN
C ALL SURFACE TYPES EXCEPT SPLASH-LVL RPTS ARE EXPECTED TO BE IN CAT. 51
         PRINT 8759, STNID,RDATA(1),RDATA(2),IDATA(9)
 8759 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - NO VALID DATA IN SFCDTA')
         GO TO 2090
      END IF
      ELEV = NINT(RDATA(7))
      IF(MSLBOG)  THEN
C***********************************************************************
C                MEAN SEA-LEVEL PRESSURE BOGUS REPORT
C            AUSTRALIAN (PAOBS) BOGUS IN DATA LEVEL CAT. 51
C               OPC/NOS POINT BOGUS IN DATA LEVEL CAT. 51
C***********************************************************************
         IF(ITYP.EQ.7)  THEN
C PAOBS GET PREPBUFR REPORT TYPE 191
            HDR(6) = 191
C SET PREPBUFR TABLE VALUES FOR BOTH PMSL AND PSTN TO 1 FOR PAOBS BOGUS
            IM0 = 1
            IMP = 1
         ELSE
C POINT BOGUS GET PREPBUFR REPORT TYPE 190
            HDR(6) = 190
C SET PREPBUFR TABLE VALUES FOR BOTH PMSL AND PSTN TO 0 FOR POINT BOGUS
            IM0 = 0
            IMP = 0
         END IF
         L = IDATA(30)
         PMSL = NINT(RDATA(L))
         IF(PMSL.GE.XMISS)  THEN
cfix?    IF(PMSL.GE.YMISS)  THEN
            PRINT 8779, STNID,RDATA(1),RDATA(2),IDATA(9)
 8779 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PMSL IS MISSING')
            GO TO 2090
         END IF
         DPVL = (PMSL * 0.1) - 1013.25
C IF PMSL UNREASONABLE, FLAG PSTN AND PMSL PREPBUFR TABLE VALUE
         IF(DPVL.LE.-75..OR.DPVL.GE.50.)  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
            IM0 = 15
            IMP = 15
            PRINT 1919, STNID,RDATA(1),RDATA(2),IDATA(9),DPVL,ELEV
 1919 FORMAT(' + + PMSL BOGUS RPT FLAGGD-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PMSL DVAL(',F7.1,') BAD, ELEV =',
     $ F7.1)
         END IF
         PSTN = PMSL
         GO TO 2150
      END IF
C***********************************************************************
C               ALL OTHER NON-BOGUS SURFACE REPORTS
C
C   ALL INPUT DATA ARE IN DATA LEVEL CAT.  51 EXCEPT FOR SPLASH-LEVEL
C  REPORTS WHICH ARE IN EITHER DATA LEVEL CAT. 8 (RECCOS WITH PMSL OBS)
C           OR DATA LEVEL CAT. 2 (DROPS) OF THE ADPUPA FILE
C***********************************************************************
      L = IDATA(30)
C-----------------------------------------------------------------------
C              SPECIAL TESTS FOR SURFACE MASS REPORTS
C-----------------------------------------------------------------------
C CHECK ELEVATION -- THIS IS THE GEOPOTENTIAL OBSERVATION (NOTE: AN
C  ELEVATION > 10000 OR MISSING CAN NEVER GET THROUGH HERE!!)
      ELEV = NINT(RDATA(7))  ! was this already set further above??
      IF(ITYP.EQ.5)  THEN
C.......................................................................
C SPLASH-LEVEL REPORTS COME HERE ...
         IF(ICF352.EQ.1)  THEN
C  ... THESE ARE THE RECCOS WITH PMSL OBS
            PSTN = AMSLPR
            IMP  = 2
C      MUST SET ELEVATION TO 0 BECAUSE RDATA(7) HOLDS P-ALTITUDE
            ELEV = 0.
         ELSE
C  ... THESE ARE THE DROPWINSONDES (HAVE NON-MISSING PSML & CAT. 2 DATA)
            IMM = IDATA(16)
            PSTN = NINT(RDATA(IMM))
            IMP  = NINT(RDATA(IMM+3))
            IF(IMP.LE.3)  THEN
               TEMP = NINT(RDATA(IMM+1))
               DPDP = NINT(RDATA(IMM+2))
               IMT = NINT(RDATA(IMM+4))
               IMQ = NINT(RDATA(IMM+5))
            END IF
         END IF
      END IF
C.......................................................................
      IF(ELEV.GT.10000.)  THEN
C WILL TOSS LAND OR GREAT LAKES REPORTS W/ MISSING OR STRANGE ELEVATION
C  BUT ALL OTHER MARINE REPORTS GET ELEVATION SET TO 0 IN THIS CASE
         IF(SFLAND)  THEN
            PRINT 954, STNID,RDATA(1),RDATA(2),IDATA(9)
  954 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVER LAND, MISSING ELEVATION ')
            GO TO 2090
         ELSE  IF(NINT(RDATA(1)*100.).GE.4100.AND.NINT(RDATA(1)*100.)
     $    .LE.5000.AND.NINT(RDATA(2)*100.).GE.26700.AND.
     $    NINT(RDATA(2)*100.).LE.28500)  THEN
            PRINT 3954, STNID,RDATA(1),RDATA(2),IDATA(9)
 3954 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVER GREAT LAKES, MISSING ELEV')
            GO TO 2090
         ELSE
            PRINT 959, STNID,RDATA(1),RDATA(2),IDATA(9)
  959 FORMAT(' > > MARINE ELEV. MISSING -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - ELEVATION SET TO 0.0 M')
            ELEV = 0.0
            HDR(10) = ELEV
         END IF
      END IF
C MOBILE SYNOPTIC LAND REPORTS CAN HAVE AN ELEVATION Q.M. (BUFR C. FIG.)
C  (IF IT'S POOR, SET PRESS Q.M. TO BAD; IF IT'S FAIR SET PRESS Q.M. TO
C   SUSPECT)
      IF(NINT(RDATA(12)).GT.0.AND.NINT(RDATA(12)).LT.9)
     $ IME = NINT(RDATA(12))
      IF(ITYP.EQ.5)  GO TO 7005
C CHECK TEMP WILL NEED LATER TO HYDROSTATICALLY ADJUST LAND REPORTS
      TEMP = NINT(RDATA(L+4))
      IMT = NINT(RDATA(L+11))
      IF(IMT.EQ.4)  THEN
         IMT = 1
         PRINT 1101, STNID,IDATA(9)
 1101 FORMAT(' > > MARINE TEMP  - STNID = ',A8,'  TYPE = ',I4,' - ',
     $ 'CORRECTED BY O.P.C. MANUAL Q. CONTROL, TEMP PREPBUFR TBL VAL=1',
     $ ', ORIG Q.M. = 4')
      ELSE  IF(SFLAND.AND.IMT.GE.IQMLIM)  THEN
C IF LAND REPORT AND TEMP IS BAD, SKIP THE ENTIRE REPORT (MASS AND WIND)
C  (CAN THIS EVER HAPPEN?)
         PRINT 112, STNID,RDATA(1),RDATA(2),IDATA(9),TEMP,IMT
  112 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BAD TEMP,',F7.2,'K PREPBUFR TABLE ',
     $ 'VALUE = ',I2)
         GO TO 2090
      END IF
C GET PMSL AND PSTN PREPBUFR TABLE VALUES
      IM0 = NINT(RDATA(L+8))
      IF(IM0.EQ.4)  THEN
         IM0 = 1
         PRINT 1102, STNID,IDATA(9)
 1102 FORMAT(' > > MARINE PMSL  - STNID = ',A8,'  TYPE = ',I4,' - ',
     $ 'CORRECTED BY O.P.C. MANUAL Q. CONTROL, PMSL PREPBUFR TBL VAL=1',
     $ ', ORIG Q.M. = 4')
      END IF
      IMP = NINT(RDATA(L+9))
      IF(IMP.EQ.4)  THEN
         IMP = 1
         PRINT 1103, STNID,IDATA(9)
 1103 FORMAT(' > > MARINE PSTN  - STNID = ',A8,'  TYPE = ',I4,' - ',
     $ 'CORRECTED BY O.P.C. MANUAL Q. CONTROL, PSTN PREPBUFR TBL VAL=1',
     $ ', ORIG Q.M. = 4')
      END IF
      PMSL = NINT(RDATA(L))
      PSTN = NINT(RDATA(L+1))
      IF(IME.EQ.4.OR.IME.EQ.8)  THEN
         IF(PSTN.LT.XMISS)  THEN
cfix?    IF(PSTN.LT.YMISS)  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
            IMP = 15
            PRINT 1969, STNID,RDATA(1),RDATA(2),IDATA(9),IME
 1969 FORMAT(' + + REPORT PSTN FLAGGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BUFR ELEV QM(',I2,') POOR')
         END IF
         IF(PMSL.LT.XMISS)  THEN
cfix?    IF(PMSL.LT.YMISS)  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
            IM0 = 15
            PRINT 1968, STNID,RDATA(1),RDATA(2),IDATA(9),IME
 1968 FORMAT(' + + REPORT PMSL FLAGGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BUFR ELEV QM(',I2,') POOR')
         END IF
      ELSE IF(IME.EQ.3.OR.IME.EQ.7)  THEN
         IF(PSTN.LT.XMISS)  THEN
cfix?    IF(PSTN.LT.YMISS)  THEN
            IMP =  3
            PRINT 1971, STNID,RDATA(1),RDATA(2),IDATA(9),IME
 1971 FORMAT(' + + REPORT PSTN SUSPECT  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BUFR ELEV QM(',I2,') FAIR')
         END IF
         IF(PMSL.LT.XMISS)  THEN
cfix?    IF(PMSL.LT.YMISS)  THEN
            IM0 =  3
            PRINT 1970, STNID,RDATA(1),RDATA(2),IDATA(9),IME
 1970 FORMAT(' + + REPORT PMSL SUSPECT  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BUFR ELEV QM(',I2,') FAIR')
         END IF
      END IF
      IF(PMSL.LT.XMISS)  THEN
cfix? IF(PMSL.LT.YMISS)  THEN
         DPVL = (PMSL * 0.1) - 1013.25
C IF NON-MISSING PMSL UNREASONABLE, FLAG ITS PREPBUFR TBL VAL.
         IF(DPVL.LE.-75..OR.DPVL.GE.50.)  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
            IM0 = 15
            PRINT 1918, STNID,RDATA(1),RDATA(2),IDATA(9),DPVL,ELEV
 1918 FORMAT(' + + REPORT PMSL FLAGGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PMSL DVAL(',F7.1,') BAD, ELEV =',
     $ F7.1)
         END IF
C TOSS REPORT IF PRESSURE IS MISSING (CAN THIS EVER HAPPEN?)
         IF(IM0.GE.IQMLIM)  THEN
            PRINT 111, STNID,RDATA(1),RDATA(2),IDATA(9),IM0
  111 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BAD PMSL Q. MARK = ',I2.2)
            GO TO 2090
         END IF
         IF(IM0.GT.3)  THEN
C FLAG THE PSTN PREPBUFR T.V. WITH 15 WHEN PMSL IS BAD
            PRINT 2918, STNID,RDATA(1),RDATA(2),IDATA(9),ELEV
 2918 FORMAT(' + + REPORT PSTN FLAGGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PMSL IS BAD, ELEV =',F7.1)
          ! this should not be monitored by GSI!! (but is since qm=15)
            IMP = 15
         END IF
      END IF
 7005 CONTINUE
      IF(PSTN.GE.XMISS)  THEN
cfix? IF(PSTN.GE.YMISS)  THEN
         IF(ALTIMR.LT.YMISS.AND.ALTIMR.GT.0)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C   REPORTS WITH MISSING PSTN BUT VALID ALTIMETER SETTING COME HERE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C IF OVER LAND AND PFRALT=T, CALCULATE PSTN FROM ALTIMETER AND ELEV
C  (THESE WILL GET PREPBUFR REPORT TYPE 187/287 UNLESS MESONETS WHICH
C  STILL GET 188/288 BUT ALSO GET AN 'a' STAMPED IN CHARACTER 8 OF
C  STNID) - THESE REPORTS NOW CONSIDERED TO HAVE A VALID PSTN; ALSO
C  SET PSTN TABLE VALUE TO THAT OF ALTIMETER
            PSTN = P_f_A(ALTIMR*0.1,ELEV) * 10.
            IMP = IMA
            IF(ITYP.NE.10)  THEN
               INSTR = 7
            ELSE
               STNID(8:8) = 'a'
            END IF
         END IF
      END IF
      IF(PSTN.LT.XMISS)  THEN
cfix? IF(PSTN.LT.YMISS)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C                   REPORTS WITH VALID PSTN COME HERE
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         IF(IMP.LT.10)  THEN
C USE VALID ELEVATION & U.S. STD. ATMOS. TO TEST PSTN VALUE
            DVAL = (PSTN * 0.1) - PR(1013.25,288.15,ELEV)
C IF NON-MSG, NON-BAD PSTN UNREASONABLE, FLAG ITS PREPBUFR TBL VALUE;
C  (SPLASH-LVL REPORTS ARE GIVEN A LARGER ALLOWABLE MIN. PSTN IN ORDER
C  TO ACCOUNT FOR VERY LOW PRESS. IN HURRICANE SITUATIONS - SUBSEQ.
C  OIQC PROGRAM SHOULD FLAG IF DATA BAD)
            DVALMN = -75.
            IF(ITYP.EQ.5)  DVALMN = -215.
            IF(DVAL.LE.DVALMN.OR.DVAL.GE.50.)  THEN
          ! this should not be monitored by GSI!! (but is since qm=15)
               IMP = 15
               PRINT 1115, STNID,RDATA(1),RDATA(2),HDR(13),IDATA(9),
     $          DVAL,ELEV
 1115 FORMAT(' + + REPORT PSTN FLAGGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, TIME',F11.5,'UTC, RTYP',I4,' - PSTN DVAL(',F7.1,
     $ ') BAD, ELV=',F7.1)
            END IF
         END IF
C TOSS REPORT IF PRESSURE IS MISSING (CAN THIS EVER HAPPEN?)
         IF(IMP.GE.IQMLIM)  THEN
            PRINT 169, STNID,RDATA(1),RDATA(2),IDATA(9),IMP
  169 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BAD PSTN Q. MARK = ',I2.2)
            GO TO 2090
         END IF
         IF(IMP.GT.3.AND.PMSL.LT.XMISS)  THEN
cfix?    IF(IMP.GT.3.AND.PMSL.LT.YMISS)  THEN
C FLAG THE NON-MSG PMSL PREPBUFR T.V. WITH 15 WHEN PSTN IS BAD
            PRINT 2115, STNID,RDATA(1),RDATA(2),IDATA(9),ELEV
 2115 FORMAT(' + + REPORT PMSL FLAGGED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,'; PSTN IS BAD, ELEV =',F7.1)
          ! this should not be monitored by GSI!! (but is since qm=15)
            IM0 = 15
         END IF
         IF(ITYP.NE.10.AND.PMSL.GE.XMISS.AND.ELEV.LE.7.5)  THEN
cfix?    IF(ITYP.NE.10.AND.PMSL.GE.YMISS.AND.ELEV.LE.7.5)  THEN
C.......................................................................
C     REPORTS WITH VALID PSTN BUT PMSL MISSING -- SET PMSL = PSTN IF
C               ELEVATION < 7.5 M (OTHERWISE KEEP MISSING)
C                  (DOES NOT APPLY TO MESONET REPORTS)
C.......................................................................
            IM0 = MAX(2,IMP)
            PMSL = PSTN
         END IF
      ELSE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C                  REPORTS WITH MISSING PSTN COME HERE
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         IF(PMSL.LT.XMISS)  GO TO 1762
cfix?    IF(PMSL.LT.YMISS)  GO TO 1762
C.......................................................................
C               REPORTS WITH MISSING PSTN AND MISSING PMSL
C.......................................................................
C DETERMINE IF REPORT IS AN ATLAS (PMEL) BUOY
C  IMPORTANT: FOR RAP (AND BEFORE THAT RUC2A) VERSION, ALL BUOYS
C             (MOORED OR DRIFTING) WITH MISSING PRESSURE BUT VALID WIND
C             DATA ARE PROCESSED AS IF THEY WERE ATLAS BUOYS (I.E.,
C             WILL BE PROCESSED W/ PREPBUFR REPORT TYPE 282, ETC.) -
C             ALL REFERENCES TO "ATLAS" BUOYS FROM HERE ON REFER TO
C             THESE BUOYS IN THE RAP (AND BEFORE THAT RUC2A) VERSION
C  Also important: ATLAS buoy processing is not affected by value of
C                  npkrpt.  Even if npkrpt=T, only a wind piece will be
C                  processed (as report type 282). This means that if
C                  an ATLAS buoy ever had T,q info, its mass piece
C                  would still be tossed rather than getting into
C                  PREPBUFR file under report type 194.  It is believed
C                  that most TRUE ATLAS buoys do not have T,q info, but
C                  that is not for certain.  However, note from point
C                  above that the RAP treats all buoys w/ missing pmsl
C                  & pstn as if they were ATLAS, so it could
C                  potentially lose a number of 194-type mass reports
C                  here.  LOOK INTO UPGRADING THIS LOGIC-??

         ATLAS = (IRNMRK.EQ.4.AND.ITYP.EQ.4)
         IF(.NOT.ATLAS)  THEN
            IF(IDATA(9).EQ.IATLAS) THEN
               ATLAS = ((STNID(1:2).EQ.'32'.OR.STNID(1:2).EQ.'51'.OR.
     $                   STNID(1:2).EQ.'52'.OR.STNID(1:5).EQ.'43001'.OR.
     $                   STNID(1:5).EQ.'43301') .AND.
     $                  (STNID(3:3).EQ.'0'.OR.STNID(3:3).EQ.'3') .AND.
     $                  (NINT(RDATA(1)*100.).GE.-1000.AND.
     $                   NINT(RDATA(1)).LE.1000.AND.
     $                   NINT(RDATA(2)*100.).GE.12000.AND.
     $                   NINT(RDATA(2)*100.).LE.28000))
            END IF
         END IF
         IF(ATLAS)  THEN
C ATLAS BUOYS ARE PROCESSED; SET PMSL=1013; INSTR WILL IDENTIFY
C  SPECIFIC R. TYPE (ONLY WIND IS ACTUALLY PROCESSED)
            PMSL = 10130.
            INSTR = 22
         else  if(npkrpt(ityp)) then
C All other surface types are processed if NPKRPT is TRUE for that type
C Generate PSTN from standard atmosphere PMSL (1013.25 mb), observed
C  temperature and elevation (via fcn "PR") (use standard atmosphere
C  temperature if temperature missing (should use virt. temperature
C  here, but can't calculate it since pstn missing!)
            tt = 288.15
            if(temp.lt.xmiss) tt = (temp * 0.1) + 273.16
cfix?       if(temp.lt.ymiss) tt = (temp * 0.1) + 273.16
            pstn = pr(1013.25,tt,elev) * 10
            ipstnflg=1
c           pstn pb tbl val set to min of 3
            imp = max(3,imp)
c           q pb tbl val set to min of 3
            imq = imp
            go to 1862
         ELSE  IF(ITYP.EQ.10)  THEN
C OTHERWISE, IF MESONET GENERATE PSTN FROM STANDARD ATMOSPHERE PMSL
C  (1013.25 MB), OBSERVED TEMPERATURE AND ELEVATION (VIA FCN "PR") (USE
C  STANDARD ATMOSPHERE TEMPERATURE IF TEMPERATURE MISSING (SHOULD USE
C  VIRT. TEMPERATURE HERE, BUT CAN'T CALCULATE IT SINCE PSTN MISSING!)
            TT = 288.15
            IF(TEMP.LT.XMISS.AND.TEMP.GT.-1000.) TT= (TEMP * 0.1)+273.16
cfix?       IF(TEMP.LT.YMISS.AND.TEMP.GT.-1000.) TT= (TEMP * 0.1)+273.16
            PSTN = PR(1013.25,TT,ELEV) * 10.
C PSTN PREPBUFR TABLE VALUE SET TO MINIMUM OF 3 HERE
            IMP = MAX(3,IMP)
C CHARACTER 8 OF STNID SET TO 'x' TO IDENTIFY THESE (SINCE THEY STILL
C  GET PREPBUFR REPORT TYPE 188/288)
            STNID(8:8) = 'x'
            GO TO 1862
         ELSE
C OTHERWISE, TOSS REPORT
            IF(IPRINT.EQ.0)  PRINT 955, STNID,RDATA(1),RDATA(2),HDR(13),
     $       IDATA(9)
  955 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, TIME',F11.5,'UTC, RTYP',I4,' - PMSL AND PSTN ',
     $ 'MISSING  ')
            GO TO 2090
         END IF
 1762    CONTINUE
C......................................................................
C             REPORTS WITH MISSING PSTN AND VALID PMSL
C               (Note: MESONETS CAN NEVER COME HERE!!)
C.......................................................................
C TEST FOR MARINE REPORTS OVER GREAT LAKES; IF ELEV = 0 TOSS REPORT;
C  OTHERWISE TREAT AS LAND REPORT WITH MISSING PSTN
         IF(NINT(RDATA(1)*100.).GE.4100.AND.NINT(RDATA(1)*100.).LE.5000
     $    .AND.NINT(RDATA(2)*100.).GE.26700.AND.NINT(RDATA(2)*100.).LE.
     $    28500.AND..NOT.SFLAND)  THEN
            IF(ELEV.LE.7.5)  THEN
              IF(IPRINT.EQ.0) PRINT 960,STNID,RDATA(1),RDATA(2),IDATA(9)
  960 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - ON GREAT LAKES WITH ELEV = 0')
               GO TO 2090
            ELSE
               PRINT 961, STNID,RDATA(1),RDATA(2),IDATA(9)
  961 FORMAT(' > > PSTN MISSING, G.LAKES-ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,'-TREAT AS FIXED SYNOPTIC LAND, RTYP ',
     $ '183/284')
               ITYP = 1
               INSTR = 1
               SFLAND = .TRUE.
            END IF
         END IF
         IF(ELEV.LE.7.5) THEN
C IF ELEV < 7.5M SET PSTN=PMSL

C FOR NON-MARINE RPTS: PSTN PREPBUFR TBL VALUE SET TO GREATER OF 2 OR
C  PMSL PREPBUFR TABLE VALUE
            IMP = MAX(2,IM0)
C FOR MARINE REPORTS, PSTN PREPBUFR TBL VALUE SET EQUAL TO PMSL TBL VAL.
            IF(.NOT.SFLAND)  IMP = IM0
C FOR ATLAS BUOYS WHERE PSTN & PMSL ORIG. MSG, PSTN PREPBUFR TV SET TO 3
            IF(INSTR.EQ.22)  IMP = 3
            PSTN = PMSL
         ELSE
C IF ELEV > 7.5 M:
C    For marine reports:
C         If npkrpt=F, SKIP
C         If npkrpt=T, RETAIN, estimate pstn (and use to get a value
C                      for q), will later set report type to 194/294,
C                      and will encode this estimated pstn into
C                      PREPBUFR file
C    For land reports:
C         RETAIN, estimate pstn, will later set report type to 183/
C          284, and will encode this estimated pstn into PREPBUFR
C          file
C
C    For either land or marine reports that are RETAINED:
C      --> If outside LFM grid and data thinning turned on (LFM=F) give
C           all variables PREPBUFR table value of 15
C      --> If inside LFM grid and data thinning turned off (LFM=T)
C           pressure and moisture PREPBUFR table values both set to a
C           minimum of 3
C
C      pstn is estimated from reported pmsl, sensible temperature (if
C        missing use std. atmos. temperature), and elevation via fcn PR
C        Note: Should use virtual temperature here but can't calculate
C              this since pstn is missing

            IF(.NOT.SFLAND)  THEN
               if(npkrpt(ityp)) then
                  ipstnflg=1
               else
                  IF(IPRINT.EQ.0) PRINT 956,STNID,RDATA(1),RDATA(2),
     $             IDATA(9),ELEV
  956 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - MARINE WITH PSTN MISSING, ELEV=',
     $ F5.0,', > 7.5M')
                  GO TO 2090
               end if
            END IF
            IF(.NOT.LFM)  THEN
               IF(IPRINT.EQ.0)  PRINT 957, STNID,RDATA(1),RDATA(2),
     $          IDATA(9),ELEV
  957 FORMAT(' + + TOTAL REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - PSTN MISSING, ELEV=',F5.0,', > ',
     $ '7.5M, THINNED')
               IF(IFLSF.EQ.0)  KSKTHN = KSKTHN + 1
               IFLTH = 1
               IFLSF = 1
            END IF
            TT = 288.15
            IF(TEMP.LT.XMISS.AND.TEMP.GT.-1000.) TT= (TEMP * 0.1)+273.16
cfix?       IF(TEMP.LT.YMISS.AND.TEMP.GT.-1000.) TT= (TEMP * 0.1)+273.16
            PSTN = PR(PMSL*0.1,TT,ELEV) * 10.
            IMP = MAX(3,IM0)
            imq = imp
C  report type: land get 183/284 via this change of INSTR to 3
C               marine remain 180/280 as INSTR stays 0 (default)
c                but will later be changed to 194/294
            IF(INSTR.EQ.1.OR.INSTR.EQ.7)  INSTR = 3
            DVAL = 0.0  ! is this needed??
         END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      END IF
 1862 CONTINUE
C-----------------------------------------------------------------------
C               SPECIAL TESTS FOR SURFACE WIND REPORTS
C-----------------------------------------------------------------------
C SPLASH-LEVEL REPORTS CONTAIN ONLY MASS PART - SKIP WIND PART
      IF(ITYP.EQ.5)  GO TO 1800
c If neither wind direction nor speed available, SKIP wind part
      IF(min(RDATA(L+2),RDATA(L+3)).GE.XMISS)  GO TO 1800
cfix? IF(min(RDATA(L+2),RDATA(L+3)).GE.YMISS)  GO TO 1800
C SKIP PARTICULAR TYPE OF SURFACE WIND REPORT IF JSURFW(ITYP) = 9999
      IF(JSURFW(ITYP).NE.0)  GO TO 1800
C FLAG ALL SFC LAND WINDS OUTSIDE LFM GRD IF THINNING HAS BEEN TURNED ON
      IF(SFLAND.AND..NOT.LFM)  THEN
      IF(IFLTH.EQ.0.AND.IPRINT.EQ.0) PRINT 2957,STNID,RDATA(1),RDATA(2),
     $    IDATA(9),ELEV
 2957 FORMAT(' + + WIND  REPORT FLAGGED -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - OVER LAND, ELEV=',F5.0,' - THINNED')
         IFLTH = 1
      END IF
C GET WIND PREPBUFR TABLE VALUE
      IMW = NINT(RDATA(L+10))
      IF(IMW.EQ.4)  THEN
         IMW = 1
         PRINT 1104, STNID,IDATA(9)
 1104 FORMAT(' > > MARINE WIND  - STNID = ',A8,'  TYPE = ',I4,' - ',
     $ 'CORRECTED BY O.P.C. MANUAL Q. CONTROL, WIND PREPBUFR TBL VAL=1',
     $ ', ORIG Q.M. = 4')
      END IF
C TOSS REPORT IF WIND IS MISSING (CAN THIS EVER HAPPEN?)
      IF(IMW.GE.IQMLIM)  THEN
         PRINT 679, STNID,IMW,IQMLIM
  679    FORMAT(15X,'* * * * *   SURFACE WIND REPORT TOSSED, ID = ',A8,
     $   ', PREPBUFR TABLE VALUE IMW(=',I2,') .GE. ',I2,'   * * * * *')
         GO TO 1800
      END IF
C CONVERT WIND DIRECTION & SPEED TO U- AND V-COMPONENTS if BOTH present
      IF(max(RDATA(L+2),RDATA(L+3)).lt.xmiss)
cfix? IF(max(RDATA(L+2),RDATA(L+3)).lt.ymiss)
     $ CALL UV(RDATA(L+2),RDATA(L+3)*0.1,UCOMP,VCOMP)
C-----------------------------------------------------------------------
 1800 CONTINUE
C DO SURFACE DEWPOINT DEPRESSION NEXT
      IF(ITYP.EQ.5)  GO TO 2150
      DPDP = NINT(RDATA(L+5))
      if(imq.eq.15) then
        IMQ = NINT(RDATA(L+12))
      else
        IMQ = max(imq,NINT(RDATA(L+12)))
      endif
 2150 CONTINUE
C***********************************************************************
C     SURFACE DATA IN BOTH DATA LEVEL CATEGORIES 8 AND 51 COME HERE
C              SPLASH-LEVEL REPORTS ALSO COME HERE
C***********************************************************************
      KOUNT = KOUNT + 1
      IF(.NOT.SFLAND)  THEN
         MNDX = 2
      ELSE IF(ITYP.EQ.10)  THEN
         MNDX = 3
      END IF
      ISQNUM(MNDX) = ISQNUM(MNDX) + 1
      IF(MAX(UCOMP,VCOMP).GE.XMISS.and.min(rdata(l+2),rdata(l+3)).ge.
     $ xmiss)  THEN
cfix? IF(MAX(UCOMP,VCOMP).GE.YMISS.and.min(rdata(l+2),rdata(l+3)).ge.
cfix?$ ymiss)  THEN
C Come here if either u-comp or v-comp (or both) missing -- AND --
C  direction and speed BOTH missing
         IF(ATLAS)  THEN
C .. ATLAS BUOY (MSG PSTN & PMSL) REPORTS COMPLETELY SKIPPED in this
C    case (there is no mass piece)
            KOUNT = KOUNT - 1
            ISQNUM(MNDX) = ISQNUM(MNDX) - 1
            IF(IRNMRK.NE.4)  THEN
               PRINT 2713, STNID,RDATA(1),RDATA(2),IDATA(9)
 2713 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - ATLAS BUOY WITH MISSING WIND')
            ELSE
               PRINT 6713, STNID,RDATA(1),RDATA(2),IDATA(9)
 6713 FORMAT(' * * TOTAL REPORT TOSSED  -ID=',A8,', LAT=',F7.2,'N, ',
     $ 'LON=',F8.2,'E, RTYP',I4,' - BUOY WITH MISSING PRESS & WIND')
            END IF
            GO TO 2090
         else
C .. All other (non-ATLAS) reports skip wind processing in this case
C    (move on to mass piece processing)
            GO TO 11
         END IF
      END IF
C-----------------------------------------------------------------------
C      FILL IN WIND INFORMATION FOR SURFACE LAND OR MARINE REPORT
C-----------------------------------------------------------------------
C PREPBUFR REPORT TYPE IS BASED ON INSTR
      HDR(6) = 280 + MOD(INSTR,20)
C RESET PREPBUFR REPORT TYPE 283 TO 284 (SSM/I W. SPEED WILL USE
C  PREPBUFR REPORT TYPE 283)
      IF(HDR(6).EQ.283)  HDR(6) = 284
C INITIALIZE BOTTOM LEVEL OF MOBS ARRAY
      MOBS(1:MXTYPV,1:MXWRDL,1:1) = IMISS
      if(ipstnflg.eq.1) then
C For reports with missing pressure {ipstnflg=1 when npkrpt(ityp)=T},
C  assign new PREPBUFR report type based on dump report type
         if(idata(9).eq.511.or.idata(9).eq.514) then
            hdr(6) = 292  ! synoptic land (fixed or mobile)
         else if(idata(9).eq.512) then
            hdr(6) = 293  ! METAR
         else if(idata(9)/10.eq.52) then
            hdr(6) = 294  ! ship
         else if(idata(9)/10.eq.53) then
            hdr(6) = 294  ! Platform (C-MAN, tide gauge, Coast Guard)
         else if(idata(9).eq.540) then
            hdr(6) = 295  ! mesonet
         else if(idata(9).eq.561) then
            hdr(6) = 294  ! buoys arriving in WMO FM13 format (fixed)
         else if(idata(9).eq.562.and..not.ATLAS) then
            hdr(6) = 294  ! buoys arriving in WMO FM18 format (fixed or
                          ! drifting - but EXCLUDING ATLAS
         else
C ... would not expect to get here but just in case should trap report
            print 3955, stnid,rdata(1),rdata(2),hdr(13),idata(9)
 3955 FORMAT('--> should never see below print, due to ipstnflg=1 for ',
     $ 'unrecongized T29 value:'/' * * TOTAL REPORT TOSSED  -ID=',A8,
     $ ', LAT=',F7.2,'N, LON=',F8.2,'E, TIME',F11.5,'UTC, RTYP',I4,
     $ ' - PMSL AND PSTN MISSING  ')
            go to 2090
         endif
      endif
C INITIALIZE IPMSL ARRAY (WILL REMAIN MISSING FOR WIND REPORTS)
      IPMSL = IMISS
C STORE STATION PRESSURE OBS (*10 MB) IN WORD 1 OF MOBS WIND LEVEL 1
      MOBS(1,1,1) = NINT(PSTN)
      IMPW = IMP
      IF(IFLSF.EQ.1.OR.IFLTH.EQ.1)  THEN
         IF(IMPW.LE.3.OR.IMPW.GT.15) IMPW = 15
         IF(IMW .LE.3.OR.IMW .GT.15) IMW  = 15
      END IF
C STORE P, W PREPBUFR TABLE VALUES IN WORDS 1,3,4 OF MOBS WIND LEVEL 1
      MOBS(2,1,1) = IMPW
      MOBS(2,3,1) = IMW
      MOBS(2,4,1) = IMW
      IF(MAX(NINT(UCOMP*100.),NINT(VCOMP*100.)).LT.32767)  THEN
C STORE U-COMP OBS (*100 M/SEC) IN WORD 3 OF MOBS WIND LEVEL 1
         MOBS(1,3,1) = NINT((UCOMP * 100.0) + 0.005)
C STORE V-COMP OBS (*100 M/SEC) IN WORD 4 OF MOBS WIND LEVEL 1
         MOBS(1,4,1) = NINT((VCOMP * 100.0) + 0.005)
      END IF
C store wind direction obs (degrees) in word 5 of mobs wind level 1
      if(nint(rdata(l+2)).lt.32767)  mobs(1,5,1) = nint(rdata(l+2))
C store wind speed obs (*10 m/sec) in word 6 of mobs wind level 1
      if(nint(rdata(l+3)).lt.32767)  mobs(1,6,1) = nint(rdata(l+3))
C SET REPORT SEQ. NUMBER TO "ISQNUM(1)" IF SURFACE LAND (EXCL.
C  MESONETS), TO "ISQNUM(2) IF SURFACE MARINE, OR TO "ISQNUM(3)" IF
C  MESONET AND STORE IN HDR(11)
      HDR(11) = ISQNUM(MNDX)
      IF(.NOT.ATLAS)  THEN
C  DO NOT ENCODE OBS2 OR OBS3 VARIABLES WITH WIND REPORT UNLESS IT IS
C   AN ATLAS BUOY {EXCEPTIONS: OBS2(1-3) - RSRD, EXPRSRD, ALSE}
         OBS2(4:NUMOBS2) = BMISS
         OBS3 = BMISS
         NOBS3 = 0
      END IF
C NOW CALL FILLX TO INITIATE PROCESS TO ENCODE RPT INTO PREPBUFR FILE
      CALL FILLX(1,IERF)
      IF(IERF.EQ.0)  THEN
         ICALLW = 1
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C OPTION TO PRINT LISTING OF ALL SFC WIND RPTS (NORMALLY COMMENTED OUT)
C        PRINT 9091, STNID,IDATA(9),NINT(HDR(6)),IMW
C9091 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
C    $ 'TYPE = ',I3,'  WIND PREPBUFR TBL VAL. = ',I2)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      END IF
   11 CONTINUE
C-----------------------------------------------------------------------
C  FILL IN MASS INFORMATION FOR SFC LAND, MARINE REPORT & PMSL BOGUS
C-----------------------------------------------------------------------
C SKIP PARTICULAR TYPE OF SURFACE MASS REPORT IF JSURFM(ITYP) = 9999
      IF(JSURFM(ITYP).NE.0)  GO TO 592
C ONLY WIND IS PROCESSED FOR ATLAS BUOYS (MSG PMSL,PSTN)
      IF(ATLAS)  GO TO 592
C  RESTORE OBS2 AND OBS3 VARIABLES SINCE THEY ARE ONLY ENCODED WITH
C   MASS REPORT (EXCEPT FOR ATLAS BUOYS WHICH ONLY HAVE A WIND REPORT)
C   {OBS2(1-3) - RSRD, EXPRSRD, ALSE ARE NOT RESTORED SINCE THEY WERE
C   NEVER SET TO MISSING IN WIND REPORT - THESE ARE ENCODED WITH BOTH
C   MASS AND WIND REPORTS}
      OBS2(4:NUMOBS2) = OBS2_SAVE(4:NUMOBS2)
      OBS3 = OBS3_SAVE
      NOBS3 = NOBS3_SAVE
C FOR NON-BOGUS TYPES, PREPBUFR REPORT TYPE IS BASED ON INSTR
      IF(.NOT.MSLBOG)  HDR(6) = 180 + INSTR
C INITIALIZE BOTTOM LEVEL OF MOBS ARRAY
      MOBS(1:MXTYPV,1:MXWRDL,1:1) = IMISS
      if(ipstnflg.eq.1) then
C For reports with missing pressure {ipstnflg=1 when npkrpt(ityp)=T},
C  assign new PREPBUFR report type based on dump report type
         if(idata(9).eq.511.or.idata(9).eq.514) then
            hdr(6) = 192  ! synoptic land (fixed or mobile)
         else if(idata(9).eq.512) then
            hdr(6) = 193  ! METAR
         else if(idata(9)/10.eq.52) then
            hdr(6) = 194  ! ship
         else if(idata(9)/10.eq.53) then
            hdr(6) = 194  ! Platform (C-MAN, tide gauge, Coast Guard)
         else if(idata(9).eq.540) then
            hdr(6) = 195  ! mesonet
         else if(idata(9)/10.eq.56) then
            hdr(6) = 194  ! buoys (all types)
         else
C ... would not expect to get here but just in case should trap report
            print 3955, stnid,rdata(1),rdata(2),hdr(13),idata(9)
            go to 2090
         endif
      endif
C INITIALIZE IPMSL ARRAY
      IPMSL = IMISS
      PRESS = PSTN * 0.1
C STORE STATION PRESSURE OBS (*10 MB) IN WORD 1 OF MOBS MASS LEVEL 1
      MOBS(1,1,1) = NINT(PSTN)
C STORE GEOPOTENTIAL (ELEV) OBS (METERS) IN WORD 2 OF MOBS MASS LEVEL 1
      MOBS(1,2,1) = NINT(ELEV)
C HGHT TBL. VAL. SET TO PSTN T.V. FOR ALL RPTS (LAND & MARINE)
      IMZ = IMP
      IF(IFLSF.EQ.1)  THEN
         IF(IMP.LE.3.OR.IMP.GT.15) IMP = 15
         IF(IMZ.LE.3.OR.IMZ.GT.15) IMZ = 15
         IF(IMT.LE.3.OR.IMT.GT.15) IMT = 15
         IF(IMQ.LE.3.OR.IMQ.GT.15) IMQ = 15
      END IF
C STORE P, Z, T, Q PREPBUFR TBL VALUES IN WORDS 1-4 OF MOBS MASS LEVEL 1
      MOBS(2,1,1) = IMP
      MOBS(2,2,1) = IMZ
      MOBS(2,3,1) = IMT
      MOBS(2,4,1) = IMQ
C IF TEMP MISSING, SKIP PROCESSING OF TEMP AND MOISTURE
      IF(TEMP.GE.XMISS.OR.IMT.GE.IQMLIM)  GO TO 15
cfix? IF(TEMP.GE.YMISS.OR.IMT.GE.IQMLIM)  GO TO 15
      JT = NINT((TEMP/10.) * 100.0)
      IF(JT.LT.32767)  THEN
C STORE "REPORTED" (SENSIBLE) TEMP OBS (*100 DEG. C) IN WORD 3 OF MOBS
C  MASS LEVEL 1
         MOBS(1,3,1) = JT
      ELSE
         TEMP = XMISS + 0.5
cfix?    TEMP = YMISS + 0.5
         GO TO 15
      END IF
C IF MOISTURE MISSING OR GROSSLY BAD, OR TEMPERATURE GROSSLY BAD, SKIP
C  PROCESSING OF MOISTURE
      IF(TEMP.LE.-1000..OR.DPDP.LT.0.0.OR.DPDP.GT.999..OR.IMQ.GE.
     $ IQMLIM)  GO TO 15
      DP = ((TEMP - DPDP) * 0.1) + 273.16
C STORE DEWPOINT TEMP OBS (*100 DEG. C) IN WORD 6 OF MOBS MASS LEVEL 1
      TMPCEL = (DP - 273.16) * 100.
      IF(NINT(TMPCEL).LT.32767)  MOBS(1,6,1) = NINT(TMPCEL)
      Q = QFRMTP(DP,PRESS)
C IF SPECIFIC HUMIDITY FROM QFRMTP .LT. 0 G/G  KEEP WORD 3 TEMP SENS.
      IF(Q.LT.0.0)  GO TO 15
      TT = (TEMP * 0.1) + 273.16
      X = 100.0 * ((TT * (1.0 + (.61*Q))) - 273.16)
      IF(X.GT.2.1E09) GO TO 15 ! this is the limit for nint below with
                               !  4 byte reals on WCOSS (if hit keep
                               !  word 3 temperature sens. & Q missing,
                               !  either dewpt or press or both bad)
      JT = NINT(X)
C STORE VIRTUAL TEMPERATURE (*100 DEG. C) IN WORD 5 OF MOBS MASS LEVEL 1
      IF(JT.LT.32767)  MOBS(1,5,1) = JT
      IF(Q*1.E6.GT.99999) THEN
         INTQ = IMISS
      ELSE
         INTQ = NINT(Q * 1.E6)
      END IF
      IF(INTQ.EQ.0)  INTQ = 1
C STORE SPECIFIC HUMIDITY (*10**6 G/G) IN WORD 4 OF MOBS MASS LEVEL 1;
C  MUST BE < IMISS (99999) AND > 0 - IF NOT SET TO MISSING
      IF(INTQ.LT.IMISS.AND.INTQ.GT.0)  MOBS(1,4,1) = INTQ
   15 CONTINUE
      if(pmsl.lt.xmiss)  then
cfix? if(pmsl.lt.ymiss)  THEN
C IF PMSL VALID, STORE PMSL OBS (*10 MB) AND PREPBUFR TABLE VALUE IN
C  IPMSL ARRAY
         IF(NINT(PMSL).LT.32767)  THEN
            IPMSL(1) = NINT(PMSL)
            IF(IFLSF.EQ.1.AND.(IM0.LE.3.OR.IM0.GT.15))  IM0 = 15
            IPMSL(2) = IM0
C IF VALID PSTN FOR land RPT HAS PREPBUFR TBL VAL=3, CHG R.T. FROM 181
C  OR 187 TO 183 (AS IF CALC. FROM PMSL & ELEV. USING STD. ATMOS.)
C  (UNLESS MESONET)
            IF(IMP.EQ.3.AND.ITYP.NE.10.and.sfland)  HDR(6) = 183
         END IF
      END IF
C SET REPORT SEQ. NUMBER TO "ISQNUM(1)" IF SURFACE LAND (EXCL.
C  MESONETS), TO "ISQNUM(2) IF SURFACE MARINE, OR TO "ISQNUM(3)" IF
C  MESONET AND STORE IN HDR(11)
      HDR(11) = ISQNUM(MNDX)
C NOW CALL FILLX TO INITIATE PROCESS TO ENCODE RPT INTO PREPBUFR FILE
      CALL FILLX(1,IERF)
      IF(IERF.EQ.0)  ICALLM = 1
C     IF(ICALLM.EQ.1)  THEN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C OPTION TO PRINT LISTING OF ALL SFC MASS RPTS (NORMALLY COMMENTED OUT)
C        PRINT 9090, STNID,IDATA(9),NINT(HDR(6)),IM0,IMP
C9090 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
C    $ 'TYPE = ',I3,'  PMSL PREPBUFR T VAL = ',I2,'  PSTN PREPBUFR T ',
C    $ 'VAL = ',I2)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     END IF
  592 CONTINUE
      IF(ICALLM.EQ.0.AND.ICALLW.EQ.0)  THEN
         KOUNT = KOUNT - 1
         ISQNUM(MNDX) = ISQNUM(MNDX) - 1
         GO TO 2090
      END IF
C GO BACK AND UNPACK NEXT REPORT
      GO TO 2100
C-----------------------------------------------------------------------
C HIT END-OF FILE - TIME TO LOOK AT NEXT IW3UNPBF FORMAT SURFACE FILE
 7000 CONTINUE
      PRINT 950, KNTALL
  950 FORMAT(/,19X,'===>  A TOTAL OF ',I6,'  REPORTS WERE UNPACKED ',
     $ 'FROM THIS FILE, WHETHER KEPT OR SKIPPED  <===',/)
      KNTSSS(NNN) = KOUNT
      IF(NN.EQ.1.AND.KOUNT.EQ.0)  ICODE = 4
      REWIND NFILE
 7008 CONTINUE
      NN = NN + 1
      IF(NN.LE.5)  GO TO 700
      PRINT 5679
 5679 FORMAT(/130('.')/130('.')/)
C YOU HAVE LOOKED AT ALL SFC DATA FILES, RETURN
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    ISSEL
C   PRGMMR: MELCHIOR/KEYSER  ORG: NP22       DATE: 2014-04-25
C
C ABSTRACT: FUNCTION -- TRANSLATES THE SURFACE DUMP REPORT TYPE TO AN
C   INTEGER VALUE USED BY SUBROUTINE SFCDTA TO DIFFERENTIATE TYPES OF
C   SURFACE REPORTS BEING PROCESSED {EITHER LAND (SYNOPTIC FIXED,
C   SYNOPTIC MOBILE, OR METAR), MARINE (SHIP, BUOY, SPLASH-LEVEL
C   DROPWINSONDE, C-MAN PLATFORM, AUTOMATED TIDE GAUGE, COAST GUARD
C   TIDE GAUGE), PMSL BOGUS (OPC/NOS POINT, AUSTRALIAN PAOBS), MESONET,
C   OR "OTHER" (DEFAULT, INVALID)}.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING/COMMENTING
C 1988-09-14  D. A. KEYSER -- EXPANDED TO INCLUDE SPLASH-LEVEL DROPS
C 1988-12-22  D. A. KEYSER -- EXPANDED TO INCLUDE C-MAN PLATFORM
C 1989-02-03  D. A. KEYSER -- RECOGNIZES SAT. MOISTURE BOGUS AND RAOB/
C    PIBAL AND PUTS THEM IN ADDITIONAL "OTHER" CATEGORIES
C 1990-01-11  D. A. KEYSER -- CONVERTED TO VS FORTRAN(77), RESTRUCTURED
C 1991-01-03  D. A. KEYSER -- 3 PMSL BOGUS TYPES (POINT, PAOBS, DIGIT.)
C 1995-08-24  D. A. KEYSER -- R.TYPE 182'S NOW NOT PROCESSED IF CAT. 2
C    SFC PRESSURE MISSING (UNLESS CAT. 3 SFC PRESSURE AVAILABLE), OR IF
C    CAT. 2 SFC PRESSURE IS LESS THAN 1 MB
C 1998-06-09  D. A. KEYSER -- STREAMLINED PROCESSING
C 1999-08-04  D. A. KEYSER -- UPDATED LOGIC TO PROPERLY PROCESS
C    AUSTRALIAN SEA-LEVEL PRESSURE BOGUS DATA (PAOBS)
C 2000-09-22  D. A. KEYSER -- ADDED PROCESSING OF AUTOMATED TIDE GAUGE
C    STN DATA (READ FROM "SFCSHP" DUMP, DUMP REPORT TYPE 533)
C 2000-12-05  D. A. KEYSER -- CHANGED DUMP REPORT TYPE FOR SURFACE
C    MARINE AUTOMATED TIDE GAUGE REPORTS FROM 533 TO 532 SO THEY AGREE
C    WITH REPORT TYPE IN QUIPS PROCESSING
C 2004-09-09  D. A. KEYSER -- NOW CHECKS ACTUAL DUMP REPORT TYPE RATHER
C    THAN DUMP REPORT TYPE DIVIDED BY TEN; ADDED PROCESSING OF MESONET
C    DATA (READ FROM "MSONET" DUMP, DUMP REPORT TYPE 540); ADDED
C    PROCESSING OF MOBILE SURFACE SYNOPTIC LAND REPORTS (READ FROM
C    "ADPSFC" DUMP, DUMP REPORT TYPE 514)
C 2014-04-25  S. Melchior  -- Added processing of Coast Guard tide
C    gauge data (read from SFCSHP dump, dump report type 534).
C 2014-04-25  D. A. Keyser -- Invalid "other" (default) output "type"
C    changed from 13 TO 30.  Invalid RECCO/DROPWINSONDE with no splash-
C    level mass output type changed from 12 to 20.
c 2019-12-05 JWhiting - added dump report types 563-4 in function 
c    ISSEL() for BUFR feed fixed/drift buoys
c 2021-03-30 JWhiting 
c    - added dump report types 524-5 in function ISSEL() for BUFR-feed 
c      ships named & unnamed reports, respecitvely.
c    - added dump report type 530 in function ISSEL() for BUFR-feed 
c      C-MAN reports
C
C USAGE:    XX = ISSEL(ITYPDMP)
C   INPUT ARGUMENT LIST:
C     ITYPDMP - DUMP REPORT TYPE
C
C REMARKS: CALLED BY SUBROUTINE 'SFCDTA'.
C   'ISSEL' RETURNED IS TRANSLATED INTEGER VALUE USED BY SUBROUTINE
C   SFCDTA TO DIFFERENTIATE TYPES OF SURFACE REPORTS BEING PROCESSED:
C         1 ..... SURFACE SYNOPTIC LAND STATION (FIXED)
C                 (INCLUDING WMO RESOLUTION 40)
C         2 ..... SHIP (FIXED AND MOVING)
C         3 ..... OPC/NOS POINT MEAN SEA-LEVEL PRESSURE BOGUS
C         4 ..... BUOY (FIXED AND DRIFTING))
C         5 ..... SPLASH-LEVEL MASS FROM DROPS/RECCO WITH PMSL OBS
C         6 ..... C-MAN PLATFORM
C         7 ..... AUSTRALIAN SEA-LEVEL PRESSURE BOGUS - PAOBS
C         8 ..... SURFACE METAR LAND
C         9 ..... AUTOMATED TIDE GAUGE STATION
C        10 ..... MESONET SURFACE (COOPERATIVE NETWORKS)
C        11 ..... SURFACE SYNOPTIC LAND STATION (MOBILE)
C        12 ..... COAST GUARD TIDE GAUGE STATION
C        13-19 .. RESERVED FOR FUTURE TYPES
C        20 ..... RECCO/DROPWINSONDE WITH NO SPLASH-LEVEL MASS
C                 INFORMATION (INVALID TYPE)
C        30 ..... "OTHER" (INVALID TYPE)
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      FUNCTION ISSEL(ITYPDMP)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MAXOBS = 4500)
      INTEGER  JTYPE(31:564),IDATA(MAXOBS)
      real(8)  alon_8,alat_8
      CHARACTER*8  STNID,SUBSET_d
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      EQUIVALENCE  (IDATA,RDATA)

      DATA  JTYPE/

C      31         511 512     514       522 523                --> RTYPE
C      --         --- ---     ---       --- ---
     $  5, 479*30,  1,  8, 30, 11, 7*30,  2,  2,

C                                       524 525       530 531 532  --> RTYPE
c                                       --- ---       --- --- ---
     $                                    2,  2, 4*30,  6,  6,  9,

C          534        540        551         561 562 563 564  --> RTYPE
C          ---        ---        ---         --- --- --- ---
     $ 30,  12, 5*30,  10, 10*30,  3, 9*30,    4,  4,  4,  4 /

      DATA  YMISS/99998.8/

      ISSEL0 = 30

      IF(ITYPDMP.GT.30.AND.ITYPDMP.LT.565)  ISSEL0 = JTYPE(ITYPDMP)

      IF(ISSEL0.EQ.3)  THEN
C AUSTRALIAN PAOBS RESET ISSEL0=7 (OPC/NOS POINT BOGUS RETAIN ISSEL0=3)
         IF(STNID(1:1).EQ.'P')  ISSEL0 = 7
      ELSE  IF(ISSEL0.EQ.5)  THEN

C COME HERE FOR RECCOS/DROPS (EXCEPT FOR RECCOS WITH PMSL -
C                 THESE HAVE ALREADY BEEN EXAMINED)
C ------------------------------------------------------------------

         IF(IDATA(15).EQ.0)  THEN
C  ... IF NO CAT. 2 LEVELS, THEN NOT A SPLASH-LEVEL DROP, RESET ISSEL0=20
            ISSEL0 = 20
         ELSE  IF(NINT(RDATA(IDATA(16))).GE.32750.OR.
     $    (NINT(RDATA(IDATA(16)))*0.1).LT.PMAND(LEVST))  THEN
            IF(NINT(RDATA(IDATA(16))).GE.YMISS)  THEN
               IF(IDATA(17).GT.0)  THEN
                  IF(NINT(RDATA(IDATA(18))).LT.32750.AND.
     $             (NINT(RDATA(IDATA(18)))*0.1).GE.PMAND(LEVST))  THEN
                     RDATA(IDATA(16)) = RDATA(IDATA(18))
                     RDATA(IDATA(16)+3) = RDATA(IDATA(18)+3)
                     GO TO 999
                  END IF
               END IF
            END IF
C  ... IF PRESS ON 1ST CAT. 2 LVL MISSING OR < PMAND(LEVST) RESET
C      ISSEL0 TO 20
            ISSEL0 = 20
         END IF
      END IF

  999 CONTINUE

      ISSEL = ISSEL0

      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GETSMI
C   PRGMMR: D. A. KEYSER     ORG: NP22       DATE: 2001-06-19
C
C ABSTRACT: UNPACKS SSM/I (DMSP SATELLITE) REPORTS FROM ANY ONE OR
C   MORE OF THE FOLLOWING TYPES: WIND SPEED, TOTAL PRECIPITABLE WATER,
C   RAIN RATE OR 7-CHANNEL BRIGHTNESS TEMPERATURES FROM REPROCESSED
C   SSM/I BUFR FILE (SPSSMI) GENERATED BY PROGRAM PREPSSMI.  ALL ARE
C   UNPACKED FROM UNIQUE REPORTS ORIGINATING IN DATA LEVEL CATEGORY 8.
C   HANDLES ONE REPORT AT A TIME, PERFORMING SEVERAL CHECKS SUCH AS
C   WHETHER THE REPORT IS WITHIN THE TIME LIMIT OR THE DATA EXTRACTION
C   BOUNDARY.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1990-10-25  D. A. KEYSER (W/NMC22)
C 1993-05-12  D. A. KEYSER -- SET-UP EXPANDED REPORT FORMAT, WORD 2 FOR
C     EACH MASS/WIND LVL IS PRESS. X 10MB, NEW WORD 5 FOR EACH LEVEL
C     CONTAINS 4 PACKED "PREPBUFR TBL VALUES" WHICH CAN RANGE FROM 0-15
C     AND CORRESPOND TO ON29 Q. MARKERS OR PREPRO-GENERATED Q. MARKERS;
C     ALL NON-MISSING DATA ARE NOW PACKED INTO PREPBUFR FILE
C 1993-05-31  D. A. KEYSER -- CHANGED DEF. VALUES & ORDER FOR NAMELIST
C     SWITCH "IUNIT"
C 1993-07-28  D. A. KEYSER -- N-LIST SWITCHES JPSSMI & XWINDO NOW 2-DIM
C     ARRAYS WITH 1ST ELEMENT INDICATING LATITUDE BAND (CAN PROCESS/NO
C     PROCESS FOR 6 LATITUDE BANDS); ADDED TABLE AT END WHICH
C     SUMMARIZES SSM/I COUNTS BY LAT. BAND
C 1995-07-12  D. A. KEYSER -- CAN NOW PROCESS SSM/I 7- CHANNEL
C     BRIGHTNESS TEMPERATURE REPORTS W/ R. TYPE=102
C 1999-08-04  D. A. KEYSER -- MODIFIED TO READ REPROCESSED SSM/I
C     (SPSSMI) DATA FROM "JACK WOOLLEN" BUFR FILES RATHER THAN FROM
C     ON29 FILES, REMOVED SUBR. UNPREP AND CALL TO IT, SUBR. IW3UNPBF
C     (VIA SUBR. UNPREPBF) MOD. TO HANDLE SSM/I REPROC. DATA IN "JACK"
C     BUFR
C 2001-04-06  D. A. KEYSER -- NOW PROCESSES SSM/I RAIN RATE UNDER R.TYP
C     150; SUBR. "GETSMI" STREAMLINED; SUBR. "PWATER" RENAMED TO
C     "GETPWATER", NOW RETURNS IERF=1 IF REPORT NOT ENCODED INTO
C     PREPBUFR FILE (INSTEAD OF MST=0); ACCOUNTS FOR SUBR. IW3UNPBF
C     OUTPUTTING SSM/I WIND SPEED IN M/SEC (PRECISE TO 10**1) RATHER
C     THAN M/SEC*10; ACCOUNTS FOR SUBR. IW3UNPBF OUTPUTTING SSM/I TPW
C     IN MM (PRECISE TO 10**1) RATHER THAN MM*10; ACCOUNTS FOR SUBR.
C     IW3UNPBF OUTPUTTING SSM/I BRIGHTNESS TEMPS IN K (PRECISE TO
C     10**2) RATHER THAN K*100; "RPTLBL" NOW HAS INPUT ARGS. "TIMWIN_e"
C     (EARLIEST TIME WINDOW) AND "TIMWIN_l" (LATEST TIME WINDOW) REPL.
C     "TIMWIN" (+/- TIME WINDOW) ("-" PRIOR TO CYCLE TIME, "+" AFTER
C     CYCLE TIME), ALLOWS THE 2 TO BE DIFFERENT
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"
C 2020-08-20 J. Dong -- Defined IDSDAT to eliminate Boundary Run-Time
C     Check Failure.
C
C USAGE:    CALL GETSMI
C   INPUT FILES:
C     UNIT FF+4 - 'SPSSMI' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL SSM/I DATA DUMP - USUALLY CONTAINS TOTAL
C                 PRECIP. WATER, WIND SPEED AND MAYBE ALSO RAIN RATE)
C     (FF IS UNIT NUMBER DEFINED AS IUNIT(6) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: UNITS FOR INPUT DATA ARE: WIND SPEED - M/SEC (TO NEAREST
C     10**1 PRECISION); PRECIP. WATER - MM (TO NEAREST 10**1 PRECISION);
C     BRIGHTNESS TEMPERATURE - DEG. K TIMES 100.; RAIN RATE MM/SEC
C     (TO NEAREST 10**6 PRECISION).  CALLED BY SUBROUTINE 'PREP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GETSMI
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MAXOBS = 4500)
      CHARACTER*8  STNID,DSNAME,SUBSET_d
      CHARACTER*46 CTEXT(4)
      INTEGER  KOUNT_MI(6,4),IDATA(MAXOBS),ITYP(189:198)
      INTEGER(8)  IDSDAT,IDSDMP_8
      REAL  PHISMI(7)
      real(8)  alon_8,alat_8
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/STRRRT/REQV
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/MISWCH/XWINDO(6,4),JPSSMI(6,4),SRAD(7),KNTSMI(4),KTIMM(4),
     $ KSKPMI,KMSGMI,KBDYMI
      COMMON/PWSWCH/PWT(5),IQMPW
      EQUIVALENCE  (RDATA,IDATA)
      DATA  PHISMI/-90.,-70.,-20.,0.,20.,70.,90./,YMISS/99998.8/,
     $ XMISS/99999./,IMISS/99999/
      DATA  CTEXT/'OCEANIC WIND SPEED (6 LAT BANDS) (- & +)      ',
     $            'OCEANIC TOT. PREC. WATER (6 LAT BANDS) (- & +)',
     $            'RAIN RATE (6 LAT BANDS) (- & +)               ',
     $            '7-CHN. BRIGHTNESS TEMP. (6 LAT BANDS)  (- & +)'/
C DATA LEVEL CAT. 8 CODE FIGURE: 189-195 196 197 198
      DATA  ITYP/       7*4,   1,  2,  3  /
      IOPENED   = 0
      DSNAME    = 'ZZZZZZZZ'
      IDSDAT    = 0
      IDSDMP_8  = 0
      SUBSET_d  = 'XXXXXXXX'
      PWT       = XMISS
C KNTALL COUNTS NO. OF REPORTS UNPACKED FROM FILE (ALL REPORTS)
      KNTALL = 0
C KOUNT COUNTS TOTAL NO. OF RPTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
C KOUNT_MI COUNTS NO. OF WIND SPEED (x,1), P. WATER (x,2), RAIN RATE
C  (x,3), AND BRT. TEMP (x,4) REPORTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT_MI = 0
C IQMLIM IS PREPBUFR TBL VAL. LIMIT FOR ACCEPTING REPORTS
      IQMLIM = 16
      NFILE = IUNIT(6) + 4
      IFLAG = 0
      PRINT 5678
 5678 FORMAT(/130('.')/15X,'Next Dataset should be SPSSMI  '/130('.')/)
      GO TO 2100
C***********************************************************************
C***********************************************************************
 2090 CONTINUE
C COUNT ALL SKIPPED REPORTS
      KSKPMI = KSKPMI + 1
C***********************************************************************
C***********************************************************************
 2100 CONTINUE
C INITIALIZE REQV AS MISSING
      REQV   = XMISS
C CALL UNPREPBF TO UNPACK THE NEXT REPORT
      CALL UNPREPBF(IFLAG,CYCLET,IOPENED,DSNAME,IDSDAT,IDSDMP_8,*7000)
      IF(IFLAG.EQ.1)  THEN
C.......................................................................
C IFLAG = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
         PRINT 871
  871 FORMAT(/42X,'+++  TIME WINDOW  (HRS X 100) ON REPORTS  +++',/)
         DO  K = 1,4
            IF(MIN(JPSSMI(1,K),JPSSMI(2,K),JPSSMI(3,K),JPSSMI(4,K),
     $       JPSSMI(5,K),JPSSMI(6,K)).EQ.0)
     $       PRINT 872, CTEXT(K),(XWINDO(II,K),II=1,6)
  872       FORMAT(25X,A46,6F6.0)
         END DO
         GO TO 2100
C.......................................................................
      END IF
C A REPORT WAS SUCCESSFULLY DECODED
      IF(IDATA(27).LT.1)  GO TO 2100
C THE REPORT HAS DATA IN DATA LEVEL CATEGORY 8 OF UNPACKED IW3UNPBF FMT
      L = IDATA(28)
      KNTALL = KNTALL + 1
C IDENTIFY LATITUDE (PHISMI) BAND INDEX ---> IBAND
      DO IBAND = 1,5
         IF(NINT(RDATA(1)*100.).LT.(NINT(PHISMI(IBAND+1)*100.)-0.5))
     $    GO TO 1701
      ENDDO
      IBAND = 6
 1701 CONTINUE
      IF(NINT(RDATA(L+1)).GT.188.AND.NINT(RDATA(L+1)).LT.199)  THEN
         JTYP = ITYP(NINT(RDATA(L+1)))
      ELSE
         GO TO 2100
      END IF
      IF(JPSSMI(IBAND,JTYP).EQ.0)  THEN
C-----------------------------------------------------------------------
C                THE REPORT IS ONE OF THE TYPES WANTED
C BEGIN SERIES OF CHECKS ON UNPACKED REPORT -- IF ANY ONE FAILS SKIP IT
C-----------------------------------------------------------------------
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
         CALL CHKREP(KMSGMI,KBDYMI,*2090)
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
         CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
         TIMWIN_e = -XWINDO(IBAND,JTYP) * .01
         TIMWIN_l =  XWINDO(IBAND,JTYP) * .01
         CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
         IF(IER.EQ.1)  THEN
            KTIMM(JTYP) = KTIMM(JTYP) + 1
            GO TO 2090
         END IF
C-----------------------------------------------------------------------
C THE UNPACKED REPORT HAS SUCCESSFULLY PASSED ALL CHECKS -- CONTINUE ON
C-----------------------------------------------------------------------
         KOUNT = KOUNT + 1
         IF(JTYP.EQ.1)  THEN
C RPT IS SFC WIND SPEED (JTYP=1), STORED IN DATA LEVEL CAT.8, C.F. 196
            IMW = 2   ! PREPBUFR table value here is always default (2)
C WIND SPEED (WSPD) STORED HERE IN UNITS OF M/SEC (TO 10**1 PRECISION)
C  (NOTE: W. SPEED CAN NEVER BE MISSING, ELSE C. FIG.196 WOULDN'T EXIST)
            WSPD = RDATA(L)
C PREPBUFR REPORT TYPE IS SET TO 283
            HDR(6) = 283
C INITIALIZE BOTTOM LEVEL OF MOBS ARRAY
            MOBS(1:MXTYPV,1:MXWRDL,1:1) = IMISS
C STORE PRESSURE OBS (*10 MB) (HARDWIRED TO 1013.0 MB) AND PREPBUFR
C  TABLE VALUE (HARDWIRED TO 2) IN WORD 1 OF MOBS WIND LEVEL 1
            MOBS(1,1,1) = 1013 * 10
            MOBS(2,1,1) = 2
C STORE U-COMP OBS (*100 M/SEC) (HARDWIRED TO 0.00 M/SEC) & PREPBUFR TBL
C  VALUE IN WORD 3 OF MOBS WIND LEVEL 1
            MOBS(1,3,1) = 0
            MOBS(2,3,1) = IMW
C STORE V-COMP OBS (*100 M/SEC) (= - WSPD) AND PREPBUFR TABLE VALUE IN
C  WORD 4 OF MOBS WIND LEVEL 1
            MOBS(1,4,1) = NINT(-WSPD * 100.0)
            MOBS(2,4,1) = IMW
            CALL FILLX(1,IERF)
         ELSE  IF(JTYP.EQ.2)  THEN
C RPT IS TOTAL COL. PWATER (JTYP=2), STORED IN DATA LVL CAT.8, C.F. 197
            IQMPW = 2   ! PREPBUFR tbl value here is always default (2)
C TPW (PWT(1) STORED HERE IN UNITS OF MM (TO 10**1 PRECISION)
C  (NOTE: TPW CAN NEVER BE MISSING, ELSE C. FIG.197 WOULDN'T EXIST)
            PWT(1) = RDATA(L)
C CALL GETPWATER TO PROCESS THE PWATER REPORT (GETS R. TYPE 152)
            CALL GETPWATER(2,0,IERF)
         ELSE  IF(JTYP.EQ.3)  THEN
C REPORT IS RAIN RATE (JTYP=3), STORED IN DATA LEVEL CAT.8, C.F. 198
C REQV STORED HERE IN UNITS OF MM/SEC (TO 10**6 PRECISION)
C  (NOTE: REQV CAN NEVER BE MISSING, ELSE C. FIG.198 WOULDN'T EXIST)
            REQV = RDATA(L)
C PREPBUFR REPORT TYPE IS SET TO 150
            HDR(6) = 150
            CALL FILLX(-2,IERF)
         ELSE  IF(JTYP.EQ.4)  THEN
C RPT IS 7-CHN B. TEMP (JTYP=4), STORED IN DATA LVL CAT.8, C.F. 189-195
C-----------------------------------------------------------------------
C   LOOP THROUGH THE 7-CHANNELS CONTAINING BRIGHTNESS TEMPERATURE
C               1 - 19GHZ-VERTICAL ANTENNA POLARIZATION
C               2 - 19GHZ-HORIZONTAL ANTENNA POLARIZATION
C               3 - 22GHZ-VERTICAL ANTENNA POLARIZATION
C               4 - 37GHZ-VERTICAL ANTENNA POLARIZATION
C               5 - 37GHZ-HORIZONTAL ANTENNA POLARIZATION
C               6 - 85GHZ-VERTICAL ANTENNA POLARIZATION
C               7 - 85GHZ-HORIZONTAL ANTENNA POLARIZATION
C-----------------------------------------------------------------------
            IGOOD = 0
            L = L - 4
            DO I = 1,IDATA(27)
               L = L + 4
               INDX = -188 + NINT(RDATA(L+1))
               IF(INDX.GT.7)  EXIT
               IF(RDATA(L).LT.YMISS)  THEN
                  SRAD(INDX) = RDATA(L)
                  IGOOD = 1
               END IF
            ENDDO
            IF(IGOOD.EQ.0)  THEN
               KOUNT = KOUNT - 1
               GO TO 2100
            END IF
C PREPBUFR REPORT TYPE IS SET TO 102
            HDR(6) = 102
            CALL FILLX(-1,IERF)
         ELSE
            GO TO 2090
         END IF
         IF(IERF.EQ.1)  THEN
            KOUNT = KOUNT - 1
            GO TO 2090
         END IF
         KOUNT_MI(IBAND,JTYP) = KOUNT_MI(IBAND,JTYP) + 1
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CCCCC    IF(JTYP.EQ.1)  THEN
C OPTION TO PRINT LISTING OF ALL SSM/I SFC WIND RPTS (NORM. COMM. OUT)
CCCCC PRINT 9091, STNID,IDATA(9),NINT(HDR(6)),MOBS(1,4,1),IMW
C9091 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
CCCCC$ 'TYPE = ',I3,'  W. SPD (M/S*100) =',I5,'  WIND PREPBUFR TBL ',
CCCCC$ 'VAL.=',I3)
CCCCC    END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CCCCC    IF(JTYP.EQ.2)  THEN
C OPTION TO PRINT LISTING OF ALL SSM/I P. WATER RPTS (NORM. COMM. OUT)
CCCCC PRINT 9090, STNID,IDATA(9),NINT(HDR(6)),PWT(1),IQMPW
C9090 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
CCCCC$ 'TYPE = ',I3,'  PRECIP. WATER(MM) =',F8.2,'  PW PREPBUFR TBL ',
CCCCC$ 'VAL.= ',I2)
CCCCC    END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CCCCC    IF(JTYP.EQ.3)  THEN
C OPTION TO PRINT LISTING OF ALL SSM/I RAIN RATE RPTS (NORM. COMM. OUT)
CCCCC PRINT 9090, STNID,IDATA(9),NINT(HDR(6)),REQV*3600.
C9090 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
CCCCC$ 'TYPE = ',I3,'  RAIN RATE(MM/HR) =',F8.3)
CCCCC    END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CCCCC    IF(JTYP.EQ.4)  THEN
C OPTION TO PRINT LISTING OF ALL SSM/I BBT RPTS (NORM. COMM. OUT)
CCCCC PRINT 9092, STNID,IDATA(9),NINT(HDR(6)),(SRAD(I),I=1,7)
C9092 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  PREPBUFR REPORT ',
CCCCC$ TYPE = ',I3,'  7-CHN BBTS (DEG.K*100) =',7F6.2)
CCCCC    END IF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      END IF
C***********************************************************************
C GO BACK AND UNPACK NEXT REPORT
      GO TO 2100
C HIT END-OF-FILE - ALL DONE
 7000 CONTINUE
      KNTSMI = KOUNT_MI(1,:) + KOUNT_MI(2,:) + KOUNT_MI(3,:) +
     $         KOUNT_MI(4,:) + KOUNT_MI(5,:) + KOUNT_MI(6,:)
      REWIND NFILE
C BRIEFLY SUMMARIZE
      PRINT 881, ((KOUNT_MI(I,J),I=1,6),J=1,4)
  881 FORMAT(/34X,'***** TABLE DETAILING THE USE OF SSM/I RETRIEVAL ',
     $ 'DATUM *****'//20X,86('_')/43X,'||',19X,'COUNTS BY LATITUDE',
     $ ' BAND',17X,'||'
     $ /20X,'SSM/I RETRIEVAL PRODUCT|| 90S-70S | 70S-20S | 20S-EQ  |  ',
     $ 'EQ-20N | 20N-70N | 70N-90N ||'/43X,'||',6(9X,'|'),'|'
     $ /21X,'OCEANIC WIND SPEED    ||',6(I6,3X,'|'),'|'
     $ /21X,'OCEANIC PRECIP. WATER ||',6(I6,3X,'|'),'|'
     $ /21X,'RAIN RATE             ||',6(I6,3X,'|'),'|'
     $ /21X,'7-CHN BRIGHTNESS TEMP ||',6(I6,3X,'|'),'|'
     $ /20X,86('_')/)
      PRINT 950, KNTALL
  950 FORMAT(//19X,'===>  A TOTAL OF ',I6,'  REPORTS WERE UNPACKED ',
     $ 'FROM THIS FILE, WHETHER KEPT OR SKIPPED  <===',/)
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GETSCATT
C   PRGMMR: Keyser           ORG: NP22       DATE: 2017-10-20
C
C ABSTRACT: UNPACKS ERS, QUIKSCAT, WINDSAT OR ASCAT SCATTEROMETER WIND
C   PRODUCT REPORTS FROM BUFR FILE.  HANDLES ONE REPORT AT A TIME,
C   PERFORMING SEVERAL CHECKS SUCH AS WHETHER THE REPORT IS WITHIN THE
C   TIME LIMIT OR THE DATA EXTRACTION BOUNDARY.  STORES INTO MOBS ARRAY
C   FOR LATER ENCODING INTO OUTPUT PREPBUFR DATA SET.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1996-10-28  D. A. KEYSER -- ORIGINAL AUTHOR
C 1999-08-04  D. A. KEYSER -- MODIFIED TO READ REPROCESSED ERS WIND
C    (ERSCAT) DATA FROM "JACK WOOLLEN" BUFR FILES RATHER THAN FROM WMO
C    BUFR FILES, REMOVED SUBR. W3ERSUNB AND CALL TO IT, SUBR. W3UNPKB7
C    MOD. TO HANDLE ERS REPROC. DATA IN "JACK" BUFR, INPUT TABLEB AND
C    TABLED FILES REMOVED
C 2000-09-22  D. A. KEYSER -- ADDED THE PROCESSING OF QUIKSCAT SCATTER-
C    OMETER WINDS (ALONG WITH NEW N-LIST SWITCHES "JPQKSD", "IQWNDO",
C    "IQKSLM" & "IQKSSP"), A TEMPORARY INSERTION IS THE THINNING OF
C    THE DATA BY PROCESSING ONLY EVERY-OTHER UNPACKED REPORT; SUBR.
C    GETERS CHANGED TO GETSCATT SINCE IT PROCESSES BOTH ERS AND
C    QUIKSCAT SCATTEROMETER REPORTS
C 2000-12-05  D. A. KEYSER -- RECOGNIZES ERS AND QUIKSCAT REPORTS WITH
C     NEW 8-CHAR. FORMAT
C 2001-04-06  D. A. KEYSER -- NAMELIST SWITCH IQKSLM NOW 2-WORD ARRAY
C     (WORD 2 - QUIKSCAT P.O.R. THESHOLD FOR SUSPECT Q.M.); "RPTLBL"
C     NOW HAS INPUT ARGS. "TIMWIN_e" (EARLIEST TIME WINDOW) AND
C     "TIMWIN_l" (LATEST TIME WINDOW) REPL. "TIMWIN" (+/- TIME WINDOW)
C     ("-" PRIOR TO CYCLE TIME, "+" AFTER CYCLE TIME), ALLOWS THE 2 TO
C     BE DIFFERENT
C 2001-06-19  D. A. KEYSER -- NEW SUBR. "TIMCHK" DOES TIME WINDOW CHECK
C     SEPARATE FROM "RPTLBL"
C 2001-10-10  D. A. KEYSER -- N-LIST SWITCHES "IQKSLM" AND "IQKSSP" NOu
C     LONGER READ AND REMOVED AS QUIKSCAT Q.C. WRT PROB. OF RAIN AND
C     SWATH EDGE NOW PERFORMED IN UPSTREAM PGM "WAVE_DCODQUIKSCAT";
C     RECOGNIZES QUIKSCAT SUPEROBS (NOW GENERATED IN
C     "WAVE_DCODQUIKSCAT") WITH "S" IN CHAR. 2 OF REPORT ID; NO LONGER
C     THINS DATA BY PROCESSING ONLY EVERY OTHER REPORT
C     ("WAVE_DCODQUIKSCAT" NOW HAS OPTION TO SUPEROB)
C 2004-09-09  D. A. KEYSER -- CORRECTED BUG IN QUIKSCAT PROCESSING
C     WHICH WOULD HAVE STORED ALONG-TRACK ROW NUMBER INTO INSTRUMENT
C     TYPE LOCATION (NOW STORES MISSING)
C 2007-09-14  D. A. KEYSER -- MODIFIED TO PROCESS WINDSAT SCATTEROMETER
C     REPORTS, READ FROM NEW "WDSATR" DUMP FILE (GETS PREPBUFR REPORT
C     TYPE 289 AND ENCODES NEW PARAMETERS MRWVC, MRLWC, WSST, MWD10,
C     MWS10, WSEQC1, CHSQ, PHER, SPDE, SSTE, CLDE AND VPRE IN PREPBUFR
C     FILE UNDER NEW MESSAGE TYPE "WDSATR); MODIFIED TO HANDLE RETURN
C     OF NEW ARGUMENT "RDATA2" FROM CALLS TO W3UNPKB7 [1-DIM 21-WORD
C     ARRAY WHICH HOLDS ADDITIONAL VALUES DECODED DIRECTLY FROM BUFR
C     (AND NOT IN "RDATA" ARRAY), FOR SOME PARAMETERS REPLACING WHAT
C     HAD BEEN RETURNED IN "RDATA" ARRAY (IN THE HEADER)]
C 2008-09-25  D. A. KEYSER -- CAN NOW PROCESS ASCAT SCATTEROMETER
C     WIND DATA READING FROM REPROCESSED DUMP FILE IN UNIT 39, ENCODING
C     INTO NEW PREPBUFR REPORT TYPE 290 UNDER NEW PREPBUFR MESSAGE TYPE
C     "ASCATW" VIA NEW NAMELIST SWITCHES "JPASCD" (DEF=6*9999) AND
C     IAWNDO (DEF=-3,+3) (1-DIM ARRAY RDATA2 RETURNED FROM W3UNPKB7
C     INCREASED FROM 21 TO 24 WORDS TO HANDLE NEW ANCILLARY INFO
C     ENCODED WITH ASCAT REPORTS)
C 2016-11-30  D. A. KEYSER -- Accounts for new output argument "OBS8_8"
C     returned from W3UNPKB7 for unpacked reports (REAL*8 2-word array
C     containing latitude and longitude of report).
C 2017-10-20  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01. Fixed bug that did not
C     test central dump time minutes against center (cycle) PRPBUFR
C     minutes in date check (i.e., only YYYYMMDDHH were tested for a
C     match).
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30 or
C              45 (since the RTMA_RU runs 4 times per hour). This change
C              allows the print statements to reflect this new center
C              dump time format.  It also ensures that the dump vs.
C              PREPBUFR center dates are correctly tested.
C 2020-08-20 J. Dong -- Changed subset to subset_t. Defined subset_t
C              and IDSDAT to eliminate Boundary Run-Time Check
C              Failures.
C
C USAGE:    CALL GETSCATT(ISCTP)
C   INPUT ARGUMENT LIST:
C     ISCTP    - INDICATOR FOR TYPE OF SCATTEROMETER DATA (=1 - ERS;
C                =2 - QUIKSCAT; =3 - WINDSAT; =4 - ASCAT)
C
C   INPUT FILES:
C     UNIT FF+5 - 'ERS1DA' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL ERS SCATTEROMETER DATA DUMP - CONTAINS
C                 WIND INFORMATION)
C     UNIT FF+6 - 'QKSWND' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL QUIKSCAT SCATTEROMETER DATA DUMP -
C                 CONTAINS WIND INFORMATION)
C     UNIT FF+7 - 'WDSATR' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL WINDSAT SCATTEROMETER DATA DUMP - CONTAINS
C                 WIND, MOISTURE AND RAINRATE INFORMATION)
C     UNIT FF+8 - 'ASCATW' BUFR DATA DUMP FILE (REPROCESSED FROM
C                 ORIGINAL ASCAT SCATTEROMETER DATA DUMP - CONTAINS
C                 WIND INFORMATION)
C     (FF IS UNIT NUMBER DEFINED AS IUNIT(6) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GETSCATT(ISCTP)
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*6  NAME(4)
      CHARACTER*8  STNID,STNPRT,DSNAME,DNAME(4),SUBSET_d,subset_t
      INTEGER  KOUNW(6),IDATA(MAXOBS),IBWNDO(2,4),MDATE(4),IRPTY(4)
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL  PHISCT(7)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/STRRRT/REQV
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/SCTWCH/IEWNDO(2),JPERSD(6),IQWNDO(2),JPQKSD(6),IWWNDO(2),
     $ JPWDSD(6),KSKPSC(4),KMSGSC(4),KBDYSC(4),KTIMSC(4),KNTSCT(4),
     $ JPASCD(6),IAWNDO(2)
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE  (RDATA,IDATA)
      DATA  PHISCT/-90.,-70.,-20.,0.,20.,70.,90./,YMISS/99998.8/,
     $ IRPTY/286,285,289,290/,XMISS/99999./,IMISS/99999/
      DATA  NAME/'ERS1DA','QKSWND','WDSATR','ASCATW'/
      DATA  DNAME/'  ERS   ','QUIKSCAT','WINDSAT ',' ASCAT  '/
      IBWNDO(1,1) = IEWNDO(1)
      IBWNDO(2,1) = IEWNDO(2)
      IBWNDO(1,2) = IQWNDO(1)
      IBWNDO(2,2) = IQWNDO(2)
      IBWNDO(1,3) = IWWNDO(1)
      IBWNDO(2,3) = IWWNDO(2)
      IBWNDO(1,4) = IAWNDO(1)
      IBWNDO(2,4) = IAWNDO(2)
      SUBSET_d  = 'XXXXXXXX'
      subset_t  = 'XXXXXXXX'
C KNTALL COUNTS NO. OF REPORTS UNPACKED FROM FILE (ALL REPORTS)
      KNTALL = 0
C KOUNT COUNTS TOTAL NO. OF RPTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
      KOUNW = 0
      NFILE = IUNIT(6) + 4 + ISCTP
      IFLAG = 0
      PRINT 5678, NAME(ISCTP)
 5678 FORMAT(/130('.')/15X,'Next Dataset should be ',A6,'  '/130('.')/)
      GO TO 2100
C***********************************************************************
C***********************************************************************
 2090 CONTINUE
C COUNT ALL SKIPPED REPORTS
      KSKPSC(ISCTP) = KSKPSC(ISCTP) + 1
C***********************************************************************
C***********************************************************************
 2100 CONTINUE
C INITIALIZE REQV AS MISSING
      REQV   = XMISS
      IRET = 0
C CALL W3UNPKB7 TO READ/DECODE NEXT ERS, QUIKSCAT, WINDSAT OR ASCAT
C  WIND REPORT
      IDSDAT    = 0
      IDSDMP_8  = 0
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
      CALL W3UNPKB7(IDATE,IBWNDO(1,ISCTP),IBWNDO(2,ISCTP),NFILE,RDATA,
     $ STNID,DSNAME,RDATA2,obs8_8,IDSDAT,IDSDMP_8,SUBSET_d,SUBSKP,IRET)
C.......................................................................
      IF(IRET.EQ.1)  THEN
         IFLAG = 1
C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
         PRINT 102, DSNAME,NFILE
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')
C SPLIT CENTER DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(nfile,subset_t,ibdate,kret)
         iminu = iupvs01(nfile,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(nfile)
         call openbf(nfile,'IN',nfile)
c-----------------------------------------------------------------------
         PRINT 1101, DSNAME,MDATE,iminu,IDSDMP_8
 1101 FORMAT(/20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $ 1X,I2.2,':',i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
         IF(IDSDAT.NE.IDAT10 .and. iminu.ne.idatmm)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
            GO TO 7000
         END IF
C CYCLET IS TIME THE ERS, QUIKSCAT, WINDSAT OR ASCAT WIND DATA IS
C  CENTERED ON (CYCLE TIME, to fraction of an hr if IDATMM non-zero)
         CYCLET = IDATE(4) + idatmm / 60.d0
         PRINT 871
  871 FORMAT(/42X,'+++  TIME WINDOW  (HRS X 100) ON REPORTS  +++'/)
         PRINT 875, DNAME(ISCTP),IBWNDO(1,ISCTP),IBWNDO(2,ISCTP)
  875 FORMAT(42X,A8,' WIND DATA - .............',I4,'00. TO',I4,'00.'/)
         GO TO 2100
C.......................................................................
      ELSE  IF(IRET.GT.2)  THEN
C PROBLEM READING ERS, QUIKSCAT, WINDSAT OR ASCAT WIND RPT, GO ON TO
C  NEXT RPT
         PRINT 912, DNAME(ISCTP)
  912    FORMAT(/' * * ERROR READING ',A8,' SCATTEROMETER WIND REPORT'/)
         GO TO 2090
C.......................................................................
      ELSE  IF(IRET.EQ.2)  THEN
C IF IER = 2, HAVE HIT END-OF-FILE, ALL ERS, QUIKSCAT, WINDSAT OR ASCAT
C  WIND REPORTS PROCESSED
         IF(IFLAG.LE.0)  THEN
            PRINT 8003, NFILE
 8003       FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN ',
     $       'FIRST CALL TO FILE IN UNIT ',I3,' -- THIS MAY BE A NULL',
     $       ' FILE -- GO TO NEXT FILE'/)
         ELSE  IF(IFLAG.EQ.1)  THEN
            PRINT 8002
 8002    FORMAT(/' * * NO REPORTS CURRENTLY PRESENT IN THIS DATA FILE,',
     $    ' GO TO NEXT FILE'/)
         END IF
         GO TO 7000
C.......................................................................
      END IF
      IF(IDATA(35).NE.1.OR.IDATA(36).EQ.0)  THEN
         PRINT 919, DNAME(ISCTP)
  919    FORMAT(/' * * ERROR: NO. OF "LEVELS" FOR ',A8,' SCATTEROMETER',
     $    ' WIND REPORT .NE. 1'/)
         GO TO 2090
      END IF
C.......................................................................
C A REPORT WAS SUCCESSFULLY DECODED
      IFLAG = 2
      L = IDATA(36)
      KNTALL = KNTALL + 1
C IDENTIFY LATITUDE (PHISCT) BAND INDEX ---> IBAND
      DO IBAND = 1,5
         IF(NINT(RDATA(1)*100.).LT.(NINT(PHISCT(IBAND+1)*100.)-0.5))
     $    GO TO 1701
      ENDDO
      IBAND = 6
 1701 CONTINUE
C CHECK TO SEE IF DATA IN THIS LATITUDE BAND IS REQUESTED FOR PROCESSING
      IF(ISCTP.EQ.1)  THEN
         IF(JPERSD(IBAND).NE.0)  GO TO 2100
      ELSE IF(ISCTP.EQ.2)  THEN
         IF(JPQKSD(IBAND).NE.0)  GO TO 2100
      ELSE IF(ISCTP.EQ.3)  THEN
         IF(JPWDSD(IBAND).NE.0)  GO TO 2100
      ELSE IF(ISCTP.EQ.4)  THEN
         IF(JPASCD(IBAND).NE.0)  GO TO 2100
      END IF
C SKIP REPORT IF WIND IS MISSING
      IF(MAX(RDATA(L+2),RDATA(L+3)).GE.YMISS)  GO TO 2090
C-----------------------------------------------------------------------
C BEGIN SERIES OF CHECKS ON UNPACKED REPORT - IF ANY FAIL, SKIP REPORT
C-----------------------------------------------------------------------
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
      CALL CHKREP(KMSGSC(ISCTP),KBDYSC(ISCTP),*2090)
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      DATA4 = RDATA(4)
      CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
      TIMWIN_e = -MAX(IABS(IBWNDO(1,ISCTP)),IABS(IBWNDO(2,ISCTP)))
      TIMWIN_l =  MAX(IABS(IBWNDO(1,ISCTP)),IABS(IBWNDO(2,ISCTP)))
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMSC(ISCTP) = KTIMSC(ISCTP) + 1
         GO TO 2090
      END IF
C-----------------------------------------------------------------------
C UNPACKED REPORT HAS SUCCESSFULLY PASSED ALL CHECKS -- CONTINUE ON
C-----------------------------------------------------------------------
C.......................................................................
C   IF REQUESTED, PRINT CONTENTS OF "DECODED" ERS, QUIKSCAT, WINDSAT
C                     OR ASCAT SCATTEROMETER RPT HERE
C.......................................................................
CVVVVVTEMPORARY
      MPRINT = 0
cdak  MPRINT = 1
      IF(MPRINT.EQ.1)  THEN
         MODKNT = -1
         IF(MODPRT.GE.0)  THEN
            NEWPRT = MODPRT/4
            MODKNT = MOD((KOUNT),NEWPRT)
         END IF
         IF(MODKNT.EQ.0)  THEN
C PRINT OUT REPORT AS FOUND IN OUTPUT ARRAYS 'RDATA','IDATA' AND STNID
            PRINT 8890,(IDATA(K),K=35,36),RDATA(1),RDATA(2),DATA4,
     $       IDATA(5),RDATA(7),IDATA(9),STNID,RDATA(L+2),
     $       RDATA(L+3)
 8890 FORMAT(1X,'>> PRINTOUT OF OUTPUT RDATA/IDATA ARRAY:'//1X,'NO. ',
     $ 'CAT. 10 LVLS=',I1,';  CAT. 10 DATA SUBSCRIPT=',I2/
     $ '     LAT(DEG)       LON(DEG. E)        OBS.TIME(HRS)      YYYY',
     $ 'MMDDHH     ELEV(M)   R.TYPE    STNID    WDIR   WSPD(*10M/S)'/
     $ F10.2,12X,F6.2,11X,F8.5,10X,I10.10,4X,F8.2,2X,I5,5X,A8,
     $ F7.0,F11.0)
            PRINT 8894
 8894       FORMAT(/)
C.......................................................................
         END IF
      END IF
CAAAAATEMPORARY
C PREPBUFR REPORT TYPE IS SET TO 286 FOR ERS, 285 FOR QUIKSCAT, 289 FOR
C  WINDSAT OR 290 FOR ASCAT REPORTS
      HDR(6) = IRPTY(ISCTP)
C INITIALIZE BOTTOM LEVEL OF MOBS ARRAY
      MOBS(1:MXTYPV,1:MXWRDL,1:1) = IMISS
C STORE PRESURE OBS (*10 MB) (HARDWIRED TO 1013.0 MB) AND PREPBUFR TABLE
C  VALUE (HARDWIRED TO 2) IN WORD 1 OF MOBS WIND LEVEL 1
      MOBS(1,1,1) = 1013 * 10
      MOBS(2,1,1) = 2
      CALL UV(RDATA(L+2),RDATA(L+3)*0.1,UCOMP,VCOMP)
C WIND PREPBUFR TBL VAL FOR ERS, QUIKSCAT, WINDSAT OR ASCAT RPTS
C  HARDWIRED TO 2
      IVM = 2
      IF(MAX(NINT(UCOMP*100.),NINT(VCOMP*100.)).LT.32767)  THEN
C STORE U-COMP OBS (*100 M/SEC) AND PREPBUFR TABLE VALUE IN WORD 3 OF
C  MOBS WIND LEVEL 1
         MOBS(1,3,1) = NINT((UCOMP * 100.0) + 0.005)
         MOBS(2,3,1) = IVM
C STORE V-COMP OBS (*100 M/SEC) AND PREPBUFR TABLE VALUE IN WORD 4 OF
C  MOBS WIND LEVEL 1
         MOBS(1,4,1) = NINT((VCOMP * 100.0) + 0.005)
         MOBS(2,4,1) = IVM
      END IF
      JDD = NINT(RDATA(L+2))
      JFF = NINT(RDATA(L+3) * 0.19425)
      IF(MAX(JDD,JFF).LT.32767)  THEN
C STORE WIND DIRECTION OBS (DEGREES) IN WORD 5 OF MOBS WIND LEVEL 1
         MOBS(1,5,1) = JDD
C STORE WIND SPEED OBS (KNOTS) IN WORD 6 OF MOBS WIND LEVEL 1
         MOBS(1,6,1) = JFF
      END IF
      KOUNT = KOUNT + 1
C SET REPORT SEQ. NUMBER TO NUMERIC KOUNT VALUE IN STNID AND STORE IN
C  HDR(11)
      IF(ISCTP.EQ.1)  THEN
         READ(STNID(1:7),'(I7)') ISEQ
      ELSE IF(ISCTP.EQ.2)  THEN
         IF(STNID(2:2).EQ.'S')  THEN
            READ(STNID(3:7),'(I5)') ISEQ
         ELSE
            READ(STNID(2:7),'(I6)') ISEQ
         END IF
      ELSE IF(ISCTP.EQ.3.OR.ISCTP.EQ.4)  THEN
         IF(STNID(1:1).EQ.'S')  THEN
            READ(STNID(2:7),'(I6)') ISEQ
         ELSE
            READ(STNID(1:7),'(I7)') ISEQ
         END IF
      END IF
      HDR(11) = ISEQ
C FOR WINDSAT REPORTS, STORE RAINFALL RATE
      IF(ISCTP.EQ.3)  REQV = RDATA(L+6)
      CALL FILLX(1,IERF)
      IF(IERF.EQ.1)  THEN
         KOUNT = KOUNT - 1
         GO TO 2090
      END IF
      KOUNW(IBAND) = KOUNW(IBAND) + 1
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C OPTION TO PRINT LISTING OF ALL ERS, QUIKSCAT, WINDSAT OR ASCAT
C  SCATTER. RPTS (NORMALLY COMMENTED OUT)
CCCCC PRINT 9091, STNID,IDATA(9),NINT(HDR(6)),MOBS(1,3,1),MOBS(1,4,1),
CCCCC$ IWM
C9091 FORMAT(1X,'STN. ',A8,'  DUMP R. TYPE = ',I3,'  RPT TYPE = ',I3,
CCCCC$ '  W. U/V (M/S*100) =',2I6,'  WIND PREPBUFR TBL VAL.=',I3)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C GO BACK AND UNPACK NEXT REPORT
      GO TO 2100
 7000 CONTINUE
C HIT END-OF-FILE - ALL DONE
      KNTSCT(ISCTP) = KOUNT
      REWIND NFILE
C BRIEFLY SUMMARIZE
      PRINT 881, DNAME(ISCTP),(KOUNW(I),I=1,6)
  881 FORMAT(/34X,'***** TABLE DETAILING THE USE OF ',A8,
     $ ' SCATTEROMETER DATUM *****'//,20X,86('_')/43X,'||',19X,'COUNTS',
     $ ' BY LATITUDE BAND',17X,'||'/20X,'SCATTEROMETER WINDS    || ',
     $ '90S-70S | 70S-20S | 20S-EQ  |  EQ-20N | 20N-70N | 70N-90N ||'
     $ /43X,'||',6(9X,'|'),'|'/21X,'WIND SPEED/DIRECTION  ||',6(I6,3X,
     $ '|'),'|'/20X,86('_')/)
      PRINT 950, KNTALL
  950 FORMAT(//19X,'===>  A TOTAL OF ',I6,'  REPORTS WERE UNPACKED ',
     $ 'FROM THIS FILE, WHETHER KEPT OR SKIPPED  <===',/)
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    GETGPSIPW
C   PRGMMR: Keyser           ORG: NP22       DATE: 2017-10-20
C
C ABSTRACT: DECODES GLOBAL POSITIONING SATELLITE INTEGRATED PRECIPITABLE
C   WATER/ZENITH TOTAL DELAY (GPS-IPW/ZTD) DUMP FILE ("GPSIPW"),
C   PROCESSING ONE REPORT AT A TIME.  ACCUMULATES COUNT FOR VALID
C   REPORTS BEFORE CALLING SUBROUTINE TO ACTUALLY PROCESS REPORTS INTO
C   THE REQUESTED OUTPUT FORMAT.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 2004-09-09  D. A. KEYSER -- ORIGINAL AUTHOR
C 2007-09-14  D. A. KEYSER -- MODIFIED TO HANDLE RETURN OF NEW ARGUMENT
C     "RDATA2" FROM CALLS TO W3UNPKB7 [1-DIM 21-WORD ARRAY WHICH HOLDS
C     ADDITIONAL VALUES DECODED DIRECTLY FROM BUFR (AND NOT IN "RDATA"
C     ARRAY), FOR SOME PARAMETERS REPLACING WHAT HAD BEEN RETURNED IN
C     "RDATA" ARRAY (IN THE HEADER)]; NEW NAMELIST SWITCH "SKGP45",
C     WHEN TRUE SKIPS ALL GPS-IPW REPORTS WITH REPORT TIME MINUTES
C     GREATER THAN 30 (xx:45 REPORTS CONSIDERED TO BE OF POORER QUALITY
C     THAN xx:15 REPORTS)
C 2016-08-15 JWhiting -- Set SKGP45 to apply to reports with subset
C      NC012003 only;
C     Included trap to toss reports with precipitable water value zero
C      for all GPS data types;
C     Added logic to toss reports with subset NC012004 if they are from
C      a non-ENI provider (i.e., characters 5-8 of report id not being
C      "GPSS") as GSI may not be able to handle these properly at this
C      time. Controlled by new namelist switch SKGNSS = T (default).
C 2016-11-30  D. A. KEYSER -- Accounts for new output argument "OBS8_8"
C     returned from W3UNPKB7 for unpacked reports (REAL*8 2-word array
C     containing latitude and longitude of report).
C 2017-10-20  D. A. KEYSER -- Added minutes to every print statement
C     that includes the central dump time.  Central dump time minutes is
C     obtained from Section 1 of first (dummy) message of input dump
C     file via call to BUFRLIB routine IUPVS01. Fixed bug that did not
C     test central dump time minutes against center (cycle) PRPBUFR
C     minutes in date check (i.e., only YYYYMMDDHH were tested for a
C     match).
C     BENEFIT: Until now, central dump time minutes was always zero.
C              However, with the implementation of the new RTMA_RU,
C              central dump time can now also have minutes = 15, 30 or
C              45 (since the RTMA_RU runs 4 times per hour). This change
C              allows the print statements to reflect this new center
C              dump time format.  It also ensures that the dump vs.
C              PREPBUFR center dates are correctly tested.
C 2020-08-20 J. Dong -- Changed subset to subset_ti. Defined subset_t
C              and IDSDAT to eliminate Boundary Run-Time Check
C              Failures.
C
C USAGE:    CALL GETGPSIPW
C   INPUT FILES:
C     UNIT II   - 'GPSIPW' BUFR DUMP FILE (GPS INTEGR. PRECIP. WATER/
C                  ZENITH TOTAL DELAY)
C    (WHERE II IS UNIT NUMBER DEFINED AS IUNIT(9) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS: CALLED BY SUBROUTINE 'PREP'.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE GETGPSIPW
      PARAMETER (MXWRDH = 15)
      PARAMETER (MXBLVL = 255)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (NUMOBS2 = 43)
      CHARACTER*8  STNID,DSNAME,SUBSET_d,subset_t
      LOGICAL  SKGP45
      LOGICAL  SKGNSS
      INTEGER  IDATA(MAXOBS),KOUNG(6),MDATE(4)
      INTEGER(8) IDSDAT,IDSDMP_8
      REAL  PHIIPW(7)
      REAL(8)  BMISS,obs8_8,alon_8,alat_8
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/PWSWCH/PWT(5),IQMPW
      COMMON/GPSWCH/JPGPSD(6),GWINDO,KNTGPS,KSKPGP,KMSGGP,KBDYGP,KTIMGP,
     $ KMISGP,KT45GP,SKGP45,SKGNSS,KTGNSS
      COMMON/SFCBFR/ALTIMR,PRSS
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON /BUFRLIB_MISSING/BMISS
      EQUIVALENCE (RDATA,IDATA)
      DATA  PHIIPW/-90.,-70.,-20.,0.,20.,70.,90./,YMISS/99998.8/,
     $ XMISS/99999./
C KNTALL COUNTS NO. OF REPORTS UNPACKED FROM FILE (ALL REPORTS)
      KNTALL = 0
C KOUNT COUNTS TOTAL NO. OF RPTS UNPACKED (& NOT SKIPPED) FROM FILE
      KOUNT = 0
      KOUNG = 0
      NFILE = IUNIT(9)
C ASSUME THAT ALL MESSAGES IN BUFR DUMP FILE SHOULD BE READ AND DECODED
C  (TIME WINDOW CHECK LATER ON CAN FILTER REPORTS OUTSIDE OF
C  REQUESTED TIME LIMITS) -- SET RANGE TO - 3-HOURS + 2-HOURS
      IETIME = -3
      ILTIME = +2
      IFLAG = 0
      PRINT 5678
 5678 FORMAT(/130('.')/15X,'Next Dataset should be GPSIPW  '/130('.')/)
      GO TO 1400
C***********************************************************************
C***********************************************************************
 1410 CONTINUE
C KSKPGP WILL COUNT NO. OF DECODED REPORTS SKIPPED (VARIOUS REASONS)
      KSKPGP = KSKPGP + 1
C***********************************************************************
C***********************************************************************
 1400 CONTINUE
C INITIALIZE PRECIPITABLE WATER AS MISSING
      PWT = XMISS
      IRET = 0
C CALL W3UNPKB7 TO READ/DECODE THE NEXT GPS-IPW/ZTD REPORT
      OBS2   = BMISS  ! initialize obs2   array before reading any rpts
      OBS3   = BMISS  ! initialize OBS3   array before reading any rpts
      NOBS3  = 0      ! initialize NOBS3  array before reading any rpts
      obs8_8 = bmiss  ! initialize obs8_8 array before reading any rpts
      RDATA2 = BMISS  ! initialize rdata2 array before reading any rpts
      CALL W3UNPKB7(IDATE,IETIME,ILTIME,NFILE,RDATA,STNID,DSNAME,RDATA2,
     $ obs8_8,IDSDAT,IDSDMP_8,SUBSET_d,SUBSKP,IRET)
C.......................................................................
      IF(IRET.EQ.1)  THEN
         IFLAG = 1
C IRET = 1 RETURNS DATA SET INFO (ONLY) AFTER FIRST CALL
         PRINT 102, DSNAME,NFILE
  102    FORMAT(//46X,'*****  ',A8,'  --  UNIT =',I3,'  *****')
C SPLIT CENTER DATE INTO COMPONENTS (MDATE)
         MDATE(1) = IDSDAT/1000000
         MDATE(2) = MOD((IDSDAT/10000),100)
         MDATE(3) = MOD((IDSDAT/100),100)
         MDATE(4) = MOD(IDSDAT,100)
c-----------------------------------------------------------------------
c  Read 1st dummy message in file so can then call iupvs01 to get iminu
         call readmg(nfile,subset_t,ibdate,kret)
         iminu = iupvs01(nfile,'MINU')
c  Close file and reopen so W3UNPKB7 will handle things as though this
c   block of code never exited
         call closbf(nfile)
         call openbf(nfile,'IN',nfile)
c-----------------------------------------------------------------------
         PRINT 101, DSNAME,MDATE,iminu,IDSDMP_8
  101 FORMAT(/20X,'DATASET NAME: ',A8,'  --  DATE: ',I4.4,2('-',I2.2),
     $ 1X,I2.2,':',i2.2,'Z  -- DUMP DATE (I12 FORMAT): ',I12.12/)
C DOES DATE FROM DATA SET MATCH CENTER (CYCLE) DATE?
         IF(IDSDAT.NE.IDAT10 .and. iminu.ne.idatmm)  THEN
            PRINT 324
  324 FORMAT(/13X,'>>>>>   P R O B L E M :   D A T E   D O E S   N O T',
     $ '   M A T C H   C E N T E R  (C Y C L E)  D A T E   <<<<<'/)
            GO TO 110
         END IF
C CYCLET IS TIME THE GPS-IPW DATA IS CENTERED ON (CYCLE TIME, to
C  fraction of an hr if IDATMM non-zero)
         CYCLET = IDATE(4) + idatmm / 60.d0
         PRINT 871
  871 FORMAT(/42X,'+++  TIME WINDOW  (HRS X 100) ON REPORTS  +++'/)
         PRINT 875, GWINDO
  875 FORMAT(42X,'GLOBAL POS. SAT. - INTEG. PWATER/ZTD ...',F5.0/)
      if(SKGNSS .and. SUBSET_d.eq.'NC012004') print 878
  878 FORMAT(/34X,'+++++ SKGNSS=T - ALL NON-ENI PROVIDERS ARE TOSSED ',
     $            '+++++'/)
         GO TO 1400
C.......................................................................
      ELSE  IF(IRET.GT.2)  THEN
C PROBLEM READING GPS-IPW/ZTD REPORT, GO ON TO NEXT REPORT
         PRINT 572
  572    FORMAT(/' * * ERROR READING GPS-IPW/ZTD REPORT'/)
         GO TO 1410
C.......................................................................
      ELSE  IF(IRET.EQ.2)  THEN
C IF IER = 2, HAVE HIT END-OF-FILE, ALL GPS-IPW/ZTD REPORTS PROCESSED
         IF(IFLAG.LE.0)  THEN
            PRINT 8003, NFILE
 8003       FORMAT(/' *** ERROR RETURNING DATA SET INFORMATION IN ',
     $       'FIRST CALL TO FILE IN UNIT ',I3,' -- THIS MAY BE A NULL',
     $       ' FILE'/)
         ELSE  IF(IFLAG.EQ.1)  THEN
            PRINT 8002
 8002    FORMAT(/' * * NO REPORTS CURRENTLY PRESENT IN THIS DATA FILE'/)
         END IF
         GO TO 110
      END IF
C.......................................................................
C A REPORT WAS SUCCESSFULLY DECODED
      IFLAG = 2
      L = IDATA(44)
      KNTALL = KNTALL + 1
C IDENTIFY LATITUDE (PHIIPW) BAND INDEX ---> IBAND
      DO IBAND = 1,5
         IF(NINT(RDATA(1)*100.).LT.(NINT(PHIIPW(IBAND+1)*100.)-0.5))
     $    GO TO 1701
      ENDDO
      IBAND = 6
 1701 CONTINUE
C CHECK TO SEE IF DATA IN THIS LATITUDE BAND IS REQUESTED FOR PROCESSING
      IF(JPGPSD(IBAND).NE.0)  GO TO 1400
C-----------------------------------------------------------------------
C BEGIN SERIES OF CHECKS ON UNPACKED REPORT - IF ANY FAIL, SKIP REPORT
C-----------------------------------------------------------------------
C CALL CHKREP TO CHECK FOR MSG LAT/LON & FOR REPORT OUTSIDE SEARCH AREA
      CALL CHKREP(KMSGGP,KBDYGP,*1410)
C-----------------------------------------------------------------------
C CALL SUBR. 'RPTLBL' TO STORE REPORT HEADER INTO HDR(4),HDR(5),HDR(7),
C                          HDR(9)-HDR(15), ALAT_8, ALON_8
C-----------------------------------------------------------------------
      CALL RPTLBL(CYCLET)
C-----------------------------------------------------------------------
C IF REPORT HAS SUBSET NC012003 AND SKGP45 = TRUE, CHECK TO SEE IF THIS
C  REPORT SHOULD BE SKIPPED BASED ON ITS OBSERVATION TIME (ALL REPORTS
C  WITH OBS TIME MINUTES GREATER THAN 30 ARE SKIPPED, ASSUMPTION IS THAT
C  xx:45 REPORTS ARE CONSIDERED TO BE OF POORER QUALITY THAN xx:15
C  REPORTS)
      IF(SKGP45 .and. SUBSET_d.EQ.'NC012003') THEN
         IF(MOD(NINT(HDR(13)*100.),100).GT.50)  THEN
            PRINT 9997, STNID,RDATA(1),RDATA(2),HDR(13)
 9997 FORMAT(' * * TOTAL REPORT TOSSED- STNID = ',A8,' AT LAT = ',F6.2,
     $ ' N  LON = ',F7.2,' E, TIME',F11.5,'UTC -- OBS TIME MINUTES > ',
     $ '30')
            KT45GP = KT45GP + 1
            GO TO 1410
         END IF
      END IF

C IF REPORT HAS SUBSET NC012004 AND SKGNSS = TRUE, SKIP IT IF NOT FROM
C  U.S.-BASED ENI (BASED ON CHARACTERS 5-8 OF REPORT ID NOT BEING
C  "GPSS") - GSI MAY NOT BE ABLE TO HANDLE THESE PROPERLY AT THIS TIME
      if(SKGNSS.and.SUBSET_d.eq.'NC012004'.and.stnid(5:8).ne.'GPSS')then
ccccc    PRINT 9990, STNID,RDATA(1),RDATA(2),HDR(13)
c9990 FORMAT(' * * TOTAL REPORT TOSSED- STNID = ',A8,' AT LAT = ',F6.2,
ccccc$' N  LON = ',F7.2,' E, TIME',F11.5,'UTC -- NON-ENI PROVIDER')
         KTGNSS = KTGNSS + 1
         GO TO 1410
      end if

C SKIP REPORT IF PRECIP. WATER IS MISSING OR NEGATIVE, or zero
C  (GSI may have problems; this may be updated once ZTD is used by GSI
C   since many rpts outside U.S. seems to have missing PW but valid ZTD)
      IF(RDATA(L+3).GE.YMISS)  THEN
         PRINT 9987, STNID,RDATA(1),RDATA(2),HDR(13)
 9987 FORMAT(' * * TOTAL REPORT TOSSED- STNID = ',A8,' AT LAT = ',F6.2,
     $ ' N  LON = ',F7.2,' E, TIME',F11.5,'UTC -- INPUT PWATER MISSING')
         KMISGP = KMISGP + 1
         GO TO 1410
      ELSE  IF(RDATA(L+3).LT.0.)  THEN
         PRINT 9988, STNID,RDATA(1),RDATA(2),HDR(13)
 9988 FORMAT(' * * TOTAL REPORT TOSSED- STNID = ',A8,' AT LAT = ',F6.2,
     $' N  LON = ',F7.2,' E, TIME',F11.5,'UTC -- INPUT PWATER NEGATIVE')
         GO TO 1410
      ELSE  IF(RDATA(L+3).eq.0.)  THEN
         PRINT 9989, STNID,RDATA(1),RDATA(2),HDR(13)
 9989 FORMAT(' * * TOTAL REPORT TOSSED- STNID = ',A8,' AT LAT = ',F6.2,
     $' N  LON = ',F7.2,' E, TIME',F11.5,'UTC -- INPUT PWATER ZERO')
         GO TO 1410
      END IF

C-----------------------------------------------------------------------
C        CALL SUBR. 'TIMCHK' TO CHECK IF REPORT IS W/I PROPER
C              TIME WINDOW OF CYCLE TIME (IER =1 TOSS RPT)
C-----------------------------------------------------------------------
      TIMWIN_e = -GWINDO * .01
      TIMWIN_l =  GWINDO * .01
      CALL TIMCHK(HDR(4),TIMWIN_e,TIMWIN_l,IER)
      IF(IER.EQ.1)  THEN
         KTIMGP = KTIMGP + 1
         GO TO 1410
      END IF
C-----------------------------------------------------------------------
C UNPACKED REPORT HAS SUCCESSFULLY PASSED ALL CHECKS -- CONTINUE ON
C-----------------------------------------------------------------------
      PRSS = XMISS
C TPW (PWT(1) STORED HERE IN UNITS OF MM (TO 10**1 PRECISION)
      IQMPW = 2 ! PREPBUFR tbl value here is always default
      PWT(1) = RDATA(L+3)
      IF(RDATA(L).LT.XMISS)  PRSS = RDATA(L)
cfix? IF(RDATA(L).LT.YMISS)  PRSS = RDATA(L)
      KOUNT = KOUNT + 1
C CALL GETPWATER TO PROCESS THE PWATER REPORT (GETS R. TYPE 153)
C  (ZTD WILL BE ENCODED INTO PREPBUFR DIRECTLY FROM RDATA ARRAY LATER
C   IN SUBR. FIZZ01/W3FIZZ)
      CALL GETPWATER(3,0,IERF)
      IF(IERF.NE.0)  THEN
C PRECIPITABLE WATER REPORT NOT STORED
         KOUNT = KOUNT - 1
         GO TO 1410
      END IF
      KOUNG(IBAND) = KOUNG(IBAND) + 1
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C GO BACK AND DECODE NEXT REPORT
      GO TO 1400
C-----------------------------------------------------------------------
  110 CONTINUE
C HIT END-OF-FILE - ALL DONE
      KNTGPS = KOUNT
      REWIND NFILE
C BRIEFLY SUMMARIZE
      PRINT 881, (KOUNG(I),I=1,6)
  881 FORMAT(/38X,'***** TABLE DETAILING THE USE OF GPS-IPW DATUM ',
     $ '*****'//,20X,86('_')/43X,'||',19X,'COUNTS',
     $ ' BY LATITUDE BAND',17X,'||'/43X,'|| ',
     $ '90S-70S | 70S-20S | 20S-EQ  |  EQ-20N | 20N-70N | 70N-90N ||'
     $ /43X,'||',6(9X,'|'),'|'/21X,'TOTAL PRECIP. WATER   ||',6(I6,3X,
     $ '|'),'|'/20X,86('_')/)
      PRINT 950, KNTALL
  950 FORMAT(13X,'===>  A TOTAL OF ',I6,'  REPORTS WERE DECODED, ',
     $ 'WHETHER KEPT OR SKIPPED  <===',/)
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    W3FIZZ
C   PRGMMR: Keyser           ORG: EMC        DATE: 2017-10-20
C
C ABSTRACT: INTERFACES BETWEEN A PREPROCESSED REPORT (IN "HDR/MOBS
C   IPMSL/PWAT/xRAD/REQV/CLTOP" ARRAYS) AND THE GENERALIZED BUFR
C   ENCODING PROGRAMS WRITTEN BY JACK WOOLLEN OF GSC.  EACH REPORT IS
C   WRITTEN TO A PREPBUFR DATA SET.
C
C PROGRAM HISTORY LOG:
C 1993-09-14  J. WOOLLEN (GENERAL SCIENCES CORPORATION)
C 1993-11-02  D. A. KEYSER -- STREAMLINED CODE; MORE INPUTS PASSED VIA
C    COMMON BLOCKS; ORIGINAL TABLE A ENTRY 'PREPOB' BROKEN INTO
C    SEPARATE TABLE A ENTRIES BASED ON DATA TYPES; INPUT MNEMONIC
C    STRINGS SPECIFIC TO TABLE A ENTRY
C 1993-12-21  D. A. KEYSER -- ADDED CALL TO SUBROUTINE FIZZ02 TO MAKE
C    AN OLD 16-BIT PREPDA DATA SET FROM NOBS ARRAY
C 1994-08-11  D. A. KEYSER -- IF, UPON LAST CALL TO SUBR., ABSOLUTELY
C    NO DATA WERE PROCESSED THEN AN EMPTY 'ADPUPA' TABLE A ENTRY MSG IS
C    OPENED SO THE DATE IS AVAILABLE ON D-SET; ELEVATION AND REPORT
C    SEQUENCE NUMBER ENCODED INTO REPORT HEADER (ALONG W/ OTHER DATA
C    USED BY REANALYSIS PREPDATA ONLY); VIRTUAL/REPORTED/DEWPOINT
C    TEMP., WIND DIRECTION AND WIND SPEED ALL ENCODED INTO REPORT LVL;
C    RECEIPT TIME, REPORT SUB-TYPE AND QCACFT WIND SPEED INCR. Q.M.
C    (CONV'L/AMDAR AIRCFT WIND REPORTS ONLY) ENCODED INTO REPORT HEADER
C 1995-07-12  D. A. KEYSER -- CALLS BUFR.O SUBROUTINE 'UFBQMD' TO
C    GET PROGRAM CODE FOR PREPDATA; MNEMONICS ADDED TO ENCODE PROGRAM
C    CODE INTO BUFR/PREPDA FOR ALL OBS. TYPES; MNEMONICS ADDED TO
C    ENCODE 7-CHN SSM/I BRIGHT. TEMPS INTO BUFR/PREPDA; MNEMONICS ADDED
C    ENCODE GOES PRECIP. WATER IN FOUR LAYERS INTO BUFR/PREPDA; ADDED
C    OUTPUT ARG. 'IER' (RETURN CODE, SEE BELOW); MNEMONICS ADDED ENCODE
C    VAD (NEXRAD) WINDS INTO BUFR/PREPDA; MNEMONIC 'TSB' (REPORT SUB-
C    TYPE) NOW USED TO HOLD INDICATOR FOR MISSING PHASE OF FLIGHT FOR
C    AIRCRAFT AMDAR REPORTS
C 1996-09-03  D. A. KEYSER -- PROCESSING OF TOVS RADIANCES PARTIALLY
C    DONE (SWITCH "TOVRAD")
C 1996-10-24  D. A. KEYSER -- LOGIC ADDED TO ENCODE TOVS RADIANCES
C    AND OTHER RELATED INFORMATION INTO PREPBUFR FILE, NEW MEMONICS
C    ADDED TO ACCOMPLISH THIS; N-LIST SWITCHES "TOVRAD" AND "TOVRTV"
C    ADDED TO PROCESS RADIANCES AND RETRIEVALS RESP.; HARDWIRED TO NO
C    LONGER WRITE TO SEQ'L. 16-BIT PREPDA DATA SET; ADDED LOGIC TO
C    ENCODE ERS SCATTEROMETER WIND REPORTS (R.TYPE=286) IN PREPBUFR D-
C    SET (USED TO BE APPENDED LATER); CORRECTED ERROR IN ENCODING OF
C    INITIAL VALUES FOR HEADER MNEMONICS "RQM", "DUP", "PRG", "SRC",
C    AND "RUD" (ONLY USED FOR REANALYSIS VERSION)
C 1997-05-01  D. A. KEYSER -- REASON CODES ENCODED INTO PREPBUFR
C 1997-07-02  D. A. KEYSER -- ADDED LOGIC TO ENCODE GOES RADIANCES
C    INTO PREPBUFR FILE, USES SAME MNEMONICS AS TOVS RADIANCES (NEW N-
C    LIST SWITCH "GOESRD" ADDED TO SELECT PROCESSING OF GOES RADIANCES)
C 1997-07-22  D. A. KEYSER -- ESTABLISHED NEW BUFR TABLE A MESSAGE
C    TYPE "GOESND" TO HOLD GOES RADIANCES/RETRIEVALS (BEFORE THEY WERE
C    COMBINED WITH TOVS IN "SATEMP")
C 1997-09-18  D. A. KEYSER -- CAN ENCODE ALTIM. SETTING IN PREPBUFR
C    WHEN PROCESSING SFC LAND DATA; ENCODES SKIN TEMP., CLOUD AMT.,
C    SOLAR ZENITH ANG., AND SAT. ZENITH ANG. IN PREPBUFR WHEN
C    PROCESSING GOES RADIANCES
C 1997-10-06  D. A. KEYSER -- ENCODES FOV# AS 'ACAV' INTO PREPBUFR FOR
C    GOES REPORTS
C 1998-06-15  D. A. KEYSER -- ADDED CALL TO PREVENTS (MERGED IN PREVENTS
C    PROGRAM, NOW A SUBR.); REMOVED OBSOLETE R.H. MNEMONICS & 'SFCBOG'
C    TABLE A ENTRY; STREAMLINED TO NO LONGER SEPARATE SINGLE- & MULTI-
C    LVL TABLE A TYPES; ENCODES SOLAR & IR RAD. CORRECTION INDICATOR
C    INTO PREPBUFR FILE AS MNEMONIC 'SIRC' (FOR "ADPUPA" TYPES W/ VALID
C    INSTR. TYPE)
C 1998-12-11  D. A. KEYSER -- NO LONGER ENCODES ERS SCATTEROMETER
C    INCIDENT ANGLE, AZIMUTH ANGLE, BACKSCATTER AND ERROR ESTIMATE IN
C    PREPBUFR FILE (WERE ALWAYS SET TO ZERO AND NEVER USED) - SAVES A
C    LOT OF SPACE IN THE PREPBUFR FILES
C 1999-08-04  D. A. KEYSER -- REMOVED ENCODING OF 'RQM', 'DUP', 'PRG',
C    'SRC', 'RUD' AS THEY WERE ALWAYS MISSING (REANALYSIS RELATED) AND
C    WASTED LOTS OF SPACE; ADDED ENCODING OF PHASE OF FLIGHT ('POAF')
C    FOR ALL ACFT TYPES AND DEGREE OF TURBULENCE (DGOT) FOR NON-MDCRS
C    ACFT TYPES; ADDED PROCESSING OF MDCRS MOISTURE DATA; RADIOSONDE
C    BALLOON DRIFT LAT/LON ON EACH LEVEL NOW ENCODED INTO PREPBUFR FILE
C    WITH MNEMONICS "YDR" AND "XDR"; REPLACED CALL TO SUBROUTINE
C    "PREVENTS" WITH CALL TO W3LIB ROUTINE "GBLEVENTS"
C 2000-02-17 D. A. KEYSER -- ADDED ENCODING OF NESDIS RECURSIVE FILTER
C    FLAG ('RFFL') FOR NESDIS (GOES) SATWND TYPES; UPDATED DEL-TIME ON
C    UPPER-AIR RAOB AND PIBAL LVLS (ALREADY CALC. BASED ON BALLOON
C    DRIFT) AND ENCODED INTO PREPBUFR FILE W/ MNEMONIC "HRDR"; ADDED
C    MNEMONICS "RPT" (ORIG. OBS. TIME) AND "TCOR" (IND. FOR CORRECTED
C    OBS. TIME IN"DHR") ENCODED INTO PREPBUFR FILE
C 2000-09-22  D. A. KEYSER -- ADDED THE PROCESSING OF QUIKSCAT SCATTER-
C     OMETER WINDS; ADDED ABILITY TO APPEND DATA TO AN EXISTING
C     PREPBUFR FILE VIA NEW N-LIST SWITCH "APPEND" (WHEN APPENDING,
C     THE INTERNAL BUFR MNEM. TBL. IN THE EXISTING PREPBUFR FILE IS
C     USED, NEW R.C.=30 VALID ONLY WHEN APPEND=T AND EXISTING FILE DATE
C     DOES NOT MATCH EXPECTED (PRODUCTION) DATE
C 2000-12-05  D. A. KEYSER -- METARS W/ PSTN CALC. FROM ALTIMETER GET
C     NEW R.T. 187/287; METARS W/ MISSING WDIR & WSPD .LE. 3M/SEC ENCODE
C     WSPD OBS/QM IN NEW MNEM. "SOB" AND "SQM"
C 2001-04-06  D. A. KEYSER -- NOW PROCESSES SSM/I RAIN RATE UNDER R.TYP
C     150; FOR ALL SATELLITE TYPES EXCEPT SSM/I SUPEROBED PRODUCTS, NOW
C     ENCODES SATELLITE ID AS "SAID" IN PREPBUFR FILE; ENCODES THE 4
C     MDCRS TURBULENCE INDECES INTO THE PREPBUFR FILE UNDER MNEMONICS
C     "TRBX10", "TRBX21", "TRBX32" AND "TRBX43"; ENCODES SURFACE
C     PRESSURE INTO PREPBUFR FILE UNDER MNEMONIC "PRSS" FOR GOES PW
C     RETR. REPORTS
C 2001-06-19  D. A. KEYSER -- CAN NOW PROCESS GOES 1x1 FOV CLOUD TOP
C     REPORTS INTO PREPBUFR FILE UNDER R.T. 151 (MNEMONICS ARE "CDTP"/
C     CLOUD TOP PRESSURE, "TOCC"/CLOUD COVER, "GCDTT"/CLOUD TOP TEMP.)
C 2001-10-10  D. A. KEYSER -- PROCESS NUMBER FROM THE MPI RUN (READ IN
C     VIA NAMELIST IN STDIN) ENCODED IN PREPBUFR UNDER MNEMONIC
C     "PROCN"; MODIFIED TO NOW PASS TWO SPANNING GLOBAL SIGMA GUESS
C     FILES INTO W3LIB ROUTINE GBLEVENTS IN SITUATIONS WHERE THE CENTER
C     DATE FOR THE PREPBUFR FILE HAS AN HOUR THAT IS NOT A MULTIPLE OF
C     3 (SEE 2001-10-10 CHANGES TO GBLEVENTS)
C 2002-01-28  D. A. KEYSER -- ENCODES PRECISION OF TEMP. OBS. INTO
C     PREPBUFR FILE UNDER MNEMONIC "PCAT" FOR MESSAGE TYPES "AIRCAR"
C     AND "AIRCFT" (ONLY AVAIL. FOR AMDAR AND MDCRS)
C 2003-07-10  D. A. KEYSER -- ENCODES "RESTRICTIONS ON
C     REDISTRIBUTION" (BUFR F.T. 0-35-200) AND "EXPIRATION OF
C     RESTRICTIONS ON REDISTRIBUTION" (HRS) INTO PREPBUFR FILE UNDER
C     NEW MNEMONICS "RSRD" AND "EXPRSRD", RESP.
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF MESONET DATA, READ
C     FROM "MSONET" DUMP FILE DUMP R. TYPE 540, GET PREPBUFR R. TYPE
C     188/288, PROCESSED INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "MSONET" {INCL, ENCODING OF ID STRINGS FOR PROVIDER (MNEMONIC
C     "PRVSTG") AND SUB-PROVIDER (MNEMONIC "SPRVSTG")}; ADDED
C     PROCESSING OF GPS-IPW DATA, READ FROM "GPSIPW" DUMP FILE DUMP R.
C     TYPE 74, GET PREPBUFR R. TYPE 153, PROCESSED BY NEW SUBR.
C     "GETGPSIPW" INTO PREPBUFR FILE UNDER NEW TBL A ENTRY "GPSIPW";
C     ADDED PROCESSING OF NPN AND CAP RASS DATA READ FROM "RASSDA" DUMP
C     FILE IN NEW DATA LVL CAT. 15, DUMP R. TYPE 77, GET PREPBUFR R.
C     TYPE 126, PROCESSED INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "RASSDA"; NOW ENCODES MDCRS FLIGHT NUMBER (MNEMONIC "ACID") INTO
C     MDCRS REPORTS; ADDED PROCESSING OF COOPERATIVE AGENCY AND JAPANESE
C     WIND PROFILERS NOW POSSIBLY INCL. IN "PROFLR" DUMP FILE DUMP R.
C     TYPES 75 AND 76, RESP., GETS PREPBUFR R. TYPES 227 AND 228, RESP.,
C     PROCESSED INTO PREPBUFR FILE UNDER EXISTING TBL A ENTRY "PROFLR",
C     WIND PROFILER RPTS ORIGINATING FROM PILOT (PIBAL) BULLETINS NOW
C     GET A UNIQUE PREPBUFR R. TYPE OF 229; ADDED LOGIC (CURRENTLY NOT
C     INVOKED) TO SEPARATE METAR REPORTS INTO THEIR OWN MESSAGES IN THE
C     ADPSFC MESSAGE TYPE, BUT WITH A UNIQUE MESSAGE SUB-TYPE OF 7 (SEE
C     COMMENTS IN SUBROUTINE); SST AND SENSIBLE WEATHER ELEMENTS (IN
C     OBS2 AND OBS3 ARRAYS RETURNED FROM IW3UNPBF) ENCODED INTO PREPBUFR
C     FILE (MANY NEW MNEMONICS) BUT ONLY IN APPROPRIATE MESSAGE TYPES
C 2007-09-14  D. A. KEYSER -- MODIFIED TO ENCODE NEW PARAMTERS "TRBX"
C     AND "ROLF" INTO PREPBUFR FILE FOR TAMDAR AIRCRAFT REPORTS;
C     REPLACED CALL TO BUFRLIB ROUTINE OVRBS1 WITH CALL TO BUFRLIB
C     ROUTINE PKBS1 (OVRBS1 OBSOLETE WITH 1/31/2006 VERSION OF BUFRLIB)
C     (THIS IS CURRENTLY NEVER CALLED IN PREPDATA); INCREASED SIZE OF
C     COMMON BLOCK /BITBUF/ ARRAYS IBAY AND MBAY FROM (5000) AND
C     (5000,32) TO (12500) AND (12500,32), RESP. TO MATCH SIZES IN THIS
C     COMMON BLOCK IN 1/31/2006 VERSION OF BUFRLIB; MODIFIED TO ENCODE
C     NEW PARAMETERS MRWVC, MRLWC, WSST, MWD10, MWS10, WSEQC1, CHSQ,
C     PHER, SPDE, SSTE, CLDE AND VPRE IN PREPBUFR FILE FOR WINDSAT
C     SCATTEROMETER REPORTS, UNDER NEW MESSAGE TYPE "WDSATR"; MODIFIED
C     TO HANDLE RETURN OF NEW ARGUMENT "RDATA2" FROM CALLS TO W3UNPKB7
C     [1-DIM 21-WORD ARRAY WHICH HOLDS ADDITIONAL VALUES DECODED
C     DIRECTLY FROM BUFR (AND NOT IN "RDATA" ARRAY), FOR SOME
C     PARAMETERS REPLACING WHAT HAD BEEN RETURNED IN "RDATA" ARRAY (IN
C     THE HEADER)];  ADDED ENCODING OF PERCENT CONFIDENCE BASED ON -
C     EUMETSAT QUALITY INDEX WITH FORECAST CONSISTENCY TEST (MNEMONIC
C     "QIFY"), EUMETSAT QUALITY INDEX WITHOUT FORECAST CONSISTENCY TEST
C     (MNEMONIC "QIFN") AND NESDIS EXPECTED ERROR (MNEMONIC "EEQF") FOR
C     SATWND TYPES; EXPANDED ARRAYS OBS3 FROM (5,255,5) TO (5,255,7)
C     AND NOBS3 FROM (5) TO (7) (RETURNED OUT OF CALL TO IW3UNPBF) TO
C     ACCOUNT FOR PROCESSING OF ADDITIONAL MULTIPLE-LEVEL SENSIBLE
C     WEATHER ELEMENTS CONTAINING AIRFRAME ICING (RECCOS, PIREPS,
C     EAMDAR, CANADIAN AMDAR, TAMDAR), ENCODED INTO PREPBUFR FILE IN
C     NEW MNEMONICS "AFIC", "HBOI" AND "HTOI" (TYPE OF ICING, HEIGHT OF
C     BOTTOM AND TOP OF ICING LAYER), AND DEGREE OF TURBULENCE (RECCOS
C     AND ALL AIRCRAFT), ENCODED INTO PREPBUFR FILE IN EXISTING
C     MNEMONIC "DGOT" (DEGREE OF TURBULENCE) AND NEW MNEMONICS "HBOT"
C     AND "HTOT" (HEIGHT OF BOTTOM AND TOP OF TURBULENCE LAYER); ADDED
C     NEW N-LIST SWITCH WRMISS (DEF=T) - IF TRUE, REPORTS WITH NO VALID
C     OBS (WIND/TEMP) LEVELS AND NO VALID BRIT. TEMP. CHANNELS, BUT
C     WITH OTHER ANCILLARY INFO (E.G., SENSIBLE WX ELEMENTS) ARE NOW
C     ENCODED INTO PREPBUFR FILE - CURRENTLY APPLIES ONLY TO AIRCRAFT
C     REPORTS (MAINLY PIREPS WITH TURB, ICING, CLOUD BUT NO TEMP OR
C     WIND) - BEFORE SUCH OBS WITHOUT ANY DATA USED BY ASSIMILATION
C     WERE ALWAYS SKIPPED
C 2008-09-25  D. A. KEYSER -- CAN NOW PROCESS ASCAT SCATTEROMETER
C     WIND DATA READING FROM REPROCESSED DUMP FILE IN UNIT 39, ENCODING
C     INTO NEW PREPBUFR REPORT TYPE 290 UNDER NEW PREPBUFR MESSAGE TYPE
C     "ASCATW" VIA NEW NAMELIST SWITCHES "JPASCD" (DEF=6*9999) AND
C     IAWNDO (DEF=-3,+3) (1-DIM ARRAY RDATA2 RETURNED FROM W3UNPKB7
C     INCREASED FROM 21 TO 24 WORDS TO HANDLE NEW ANCILLARY INFO
C     ENCODED WITH ASCAT REPORTS); CHANGES TO PREPBUFR ENCODING IN
C     PREPARATION FOR FUTURE DOWNSTREAM NRL AIRCRAFT Q.C. MODULE
C     (REPLACING CURRENT DOWNSTREAM PREPACQC AND ACARSQC MODULES) WHICH
C     WILL REPLICATE LEVEL DATA IN ITS GENERATION OF "PROFILES": SOME
C     MNEMONICS THAT WERE IN HEADER MOVED TO LEVEL INFO, CALL TO
C     BUFRLIB ROUTINE DRFINI TO ALLOW FOR POSSIBLE NESTED REPLICATION
C     OF LEVEL INFO SEQUENCES; MOISTURE QUALITY (CODE TABLE) FOR MDCRS
C     REPORTS, ENCODED INTO PREPBUFR FILE (MNEMONIC MSTQ) FOR USE BY
C     FUTURE DOWNSTREAM NRL AIRCRAFT Q.C. MODULE
C 2014-04-25  D. A. Keyser -- Satellite zenith angle (mnemonic SAZA,
C     degrees) encoded into PREPBUFR file for all SATWND types for use
C     by GSI (to possibly screen SATWNDS with high SAZA values).
C 2014-04-25  S. Melchior  --
C          - Recognizes new PREPBUFR report types 192/292 (SYNOP),
C     193/293 (METAR), 194/294 (marine) and 195/295 (mesonet) for
C     surface reports that have a missing pstn (only present if
C     namelist switch NPKRPT is TRUE for the surface type in question).
C          - Removed encoding of "SQM" (wind speed quality mark) for
C     certain METAR reports which had encoded "SOB" as all surface
C     reports now encode wind qm as "WQM" regardless of whether or not
C     they also encode DDO, SOB, UOB or VOB.
C          - Added new mnemonic "PMIN" (mean sea-level pressure
C     indicator) which is encoded with a value of zero for all surface
C     reports with an observed mean sea-level pressure encoded in
C     "PMO".  "PMIN" will be encoded with a value of 1 in w3emc routine
C     GBLEVENTS for cases where a mean sea-level pressure is derived
C     (see docblock in GBLEVENTS for more information).
C 2014-07-10  D. A. Keyser -- Added encoding of "DFQ" (wind dir/speed
C     quality mark) for all types that aleady encode "DDO" (wind dir)
C     and either "FFO" (wind speed kts) or "SOB" (wind speed m/s)
C     {"DFQ" will now be encoded with overall wind quality mark in both
C     cases when "UOB" and "VOB" are encoded (then "DFQ" same as "WQM")
C     and cases when, for surface reports, "UOB" and "VOB" are not
C     encoded because either dir or speed is missing}.  Prior to this,
C     "DFQ" was always missing and the overall wind quality mark was
C     always encoded in "WQM" even when, for surface reports, "UOB" and
C     "VOB" were missing but either wind dir or speed was not.  Now,
C     the entire "W__EVENT" sequence "[UOB VOB WQM WPC WRC]" is skipped
C     for surface reports when "UOB" and "VOB" are both missing.
C 2016-01-28 JWhiting - Added generation of new CEILING field in METAR
C     reports, derived from existing CLAM & HOCB values.
C 2016-08-15 JWhiting -- For all GPS data streams (i.e., NC012003-004),
C     encode into PREPBUFR file zenith total delay (when present) and
C     its error, represented by "atmospheric path delay in satellite
C     signal" (mnemonic APDS) (m) and "error in atmospheric path delay
C     in satellite signal" (m) (mnemonic APDE), resp., in association
C     with hardwired azimuth angle (mnemonic BEARAZ) of 0.0 (deg) and
C     hardwired elevation angle (mnemonic ELEV) of 90.0 (deg).
C 2016-11-25  D. A. Keyser --
C      - Encodes instantaneous altitude rate (IALR) into PREPBUFR file
C        for TAMDARB reports in report type 134/234 (returned from c.f.
C        932 in call to IW3UNPBF).
C      - Flight number (returned from header reserve character word 2 in
C        call to IW3UNPBF) is now encoded into PREPBUFR file as ACID for
C        AMDARB reports (if non-missing).
C 2016-11-30  D. A. Keyser --
C      - Diagnostic output print statements formatted to accommodate
C        increased precision now in latitude and longitude.
C         - Replace machine length lat/lon {HDR(3), HDR(2)} with R*8
C           lat/lon (ALAT_8, ALON_8) in print statements.
C        BENEFIT: Values are now precise to 10**5 degrees.
C 2017-06-22 JWhiting - encode minutes value into section 1 of message
C         header if non-zero
C 2017-10-20  D. A. Keyser --
C      - Added minutes to print statements invoked when a new message
C        type is opened in output PREPBUFR file or when no data is
C        written to PREPBUFR file (and a single ADPUPA message is
C        written just to store the date).
C        BENEFIT: Corrects a printout bug added in obsproc_prep.v5.0.0
C                 with the update to process 15 minute cycle RTMA_RU
C                 Rapid Update.
C      - Fixed a bug where minutes (if non-zero) were not encoded into
C        Section 1 of a newly opened BUFR message (via OPENMG) in some
C        logic that is currently not invoked.
C        BENEFIT: Ensures minutes will be encoded into Section 1 of
C                 messages if this logic is ever invoked.
C
C USAGE:    CALL W3FIZZ(IER)
C   OUTPUT ARGUMENT LIST:
C     IER      - RETURN CODE (=0 - REPORT ENCODED INTO PREPBUFR
C              - FILE; =1 - REPORT NOT ENCODED INTO PREPBUFR FILE)
C
C   INPUT FILES:
C     UNIT BB   - FILE CONTAINING PREPBUFR MNEMONIC TABLES A/B/D
C     (BB IS UNIT NUMBER DEFINED AS IUNIT(2) IN NAMELIST "&PARM")
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C     UNIT PP  - PREPBUFR DATA SET
C              - (WHERE PP IS UNIT NUMBER DEFINED AS IUNIT(16) IN
C              - NAMELIST "&PARM")
C
C REMARKS: CALLED BY MAIN PROGRAM AND SUBROUTINE FILLX.  WHEN INPUT
C   HDR(3) = IMISS (99999) THIS INDICATES THAT ALL PREPROCESSED REPORTS
C   HAVE BEEN ENCODED INTO THE PREPBUFR DATA SET.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE W3FIZZ(IER)
      PARAMETER (MXWRDH = 15)
      PARAMETER (NUMOBS2 = 43)
      PARAMETER (MAXOBS = 4500)

C PARAMETER NAME "MHDRWD"  THROUGHOUT PGM SETS MAXIMUM NO. OF REPORT
C  HEADER MNEMONICS THAT CAN BE PROCESSED
C PARAMETER NAME "MOBSWD"  THROUGHOUT PGM SETS MAXIMUM NO. OF REPORT
C  OBSERVATION MNEMONICS THAT CAN BE PROCESSED
      PARAMETER (MXBLVL = 255, MHDRWD = 29, MOBSWD = 12, MOB2WD = 6)
C PARAMETER NAME "MQMSWD"  THROUGHOUT PGM SETS MAXIMUM NO. OF REPORT
C  QUALITY MARKER MNEMONICS THAT CAN BE PROCESSED
      PARAMETER (MQMSWD =  9)
C PARAMETER NAME "MPGMWD"  THROUGHOUT PGM SETS MAXIMUM NO. OF REPORT
C  PROGRAM/REASON CODE MNEMONICS THAT CAN BE PROCESSED
      PARAMETER (MPGMWD =  9)
C PARAMETER NAME "IBTBLA"  THROUGHOUT PGM SETS NUMBER OF PREPBUFR
C  TABLE-A MESSAGE TYPES
      PARAMETER (IBTBLA = 20)

      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/FIZZAA/IPCODE,IUNITP,NLV,NBT,HDR_8(MHDRWD),
     $ OBS(MOBSWD,MXBLVL),OB2(MOB2WD,MXBLVL),QMS(MQMSWD,MXBLVL),
     $ PGM(MPGMWD,MXBLVL),RSN(MPGMWD,MXBLVL),BTO(2,MXBLVL),RAD(5),
     $ IUNITG(2)
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/XTRHD2/CRES1,CRES2,CBULL
      COMMON/DATA/DMY3,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/PREVSW/PREVEN
      COMMON/APDNSW/APPEND
      COMMON/DIRECT/OBS3(5,MXBLVL,7),OBS2(NUMOBS2),NOBS3(7),RDATA2(25),
     $ obs8_8(2)

      COMMON /BUFRLIB_MISSING/BMISS

      common /bitbuf/ maxbyt,ibit,ibay(12500),mbyt(32),mbay(12500,32)
      character*8  subset_d_last
      CHARACTER*11 CBULL
      data SUBSET_d_last/'XXXXXXXX'/
      LOGICAL  SEPARATE_METARS


      LOGICAL  SINGLE(IBTBLA),PREVEN,APPEND,WRMISS

      LOGICAL  db_ceiling

      DIMENSION  KTYP(100:299),AERS(12)

      CHARACTER*4   CTYPE
      CHARACTER*8   SUBSET(IBTBLA),STNID,CHDR,CRES1,CRES2,CPRV(2),CACID,
     $ SUBSET_d
      CHARACTER*47  QMSSTR(IBTBLA),PGMSTR(IBTBLA),RSNSTR(IBTBLA)
      CHARACTER*50  HEADR1,HEADR2,HEADR3
      CHARACTER*55  OBSSTR1(IBTBLA),OBSSTR2(IBTBLA)

      REAL(8) HDR_8,OBS_8(MOBSWD,MXBLVL),OB2_8(MOB2WD,MXBLVL),
     $ QMS_8(MQMSWD,MXBLVL),PGM_8(MPGMWD,MXBLVL),RSN_8(MPGMWD,MXBLVL),
     $ BTO_8(2,MXBLVL),RAD_8(5),AERS_8(12),OBS2_8(NUMOBS2),
     $ OBS3_8(5,MXBLVL,7),RPRV_8(2),RACID_8,RDATA2_8(25),obs8_8,
     $ alon_8,alat_8

      REAL(8) cldamt_8, cldbas_8

      INTEGER  IDATA(MAXOBS)

      EQUIVALENCE (CHDR,HDR_8(1)),(CPRV,RPRV_8),(CACID,RACID_8),
     $ (RDATA,IDATA)

C SEE /nwprod/fix/prepobs_prep.bufrtable FOR THE DEFINITION OF THE
C  MNEMONICS PASSED INTO SUBROUTINE "UFBINT".

      SAVE

      DATA HEADR1/'SID  XOB YOB DHR NUL TYP T29 TSB ITP ELV SQN SIRC '/
      DATA HEADR2/'NUL   NUL NUL RFFL RPT TCOR NUL  NUL  SAID        '/
      DATA HEADR3/'PROCN NUL NUL NUL  NUL QIFY QIFN EEQF             '/

      DATA  OBSSTR1/
       ! PROFLR vvvvv
     $     'POB UOB  VOB  NUL NUL ZOB CAT NUL NUL DDO  FFO  NUL    ',
       ! VADWND vvvvv
     $     'POB UOB  VOB  NUL NUL ZOB CAT NUL NUL DDO  FFO  NUL    ',
       ! ADPUPA vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  FFO  XDR    ',
       ! AIRCAR vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  FFO  TRBX10 ',
       ! AIRCFT vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  FFO  RCT    ',
       ! SATWND vvvvv
     $     'POB UOB  VOB  TOB NUL ZOB CAT TVO NUL DDO  FFO  NUL    ',
       ! SATEMP vvvvv
     $     'POB NUL  NUL  TOB QOB ZOB CAT TVO TDO NUL  NUL  NUL    ',
       ! SPSSMI vvvvv
     $     'POB UOB  VOB  NUL NUL NUL CAT NUL NUL DDO  FFO  PWO    ',
       ! ADPSFC vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  SOB  NUL    ',
       ! SFCSHP vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  SOB  NUL    ',
       ! SFCBOG vvvvv
     $     'POB NUL  NUL  NUL NUL ZOB CAT NUL NUL NUL  NUL  NUL    ',
       ! ERS1DA vvvvv
     $     'POB UOB  VOB  NUL NUL NUL CAT NUL NUL DDO  FFO  NUL    ',
       ! GOESND vvvvv
     $     'POB PW1O PW2O TOB QOB ZOB CAT TVO TDO PW3O PW4O PRSS   ',
       ! QKSWND vvvvv
     $     'POB UOB  VOB  NUL NUL NUL CAT NUL NUL DDO  FFO  NUL    ',
       ! MSONET vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  SOB  NUL    ',
       ! GPSIPW vvvvv
     $     'NUL NUL  NUL  NUL NUL NUL CAT NUL NUL NUL  PRSS PWO    ',
       ! RASSDA vvvvv
     $     'POB NUL  NUL  TOB NUL ZOB CAT TVO NUL NUL  NUL  NUL    ',
       ! WDSATR vvvvv
     $     'POB UOB  VOB  NUL NUL NUL CAT NUL NUL DDO  FFO  NUL    ',
       ! ASCATW vvvvv
     $     'POB UOB  VOB  NUL NUL NUL CAT NUL NUL DDO  FFO  NUL    ',
       ! UPRAIR vvvvv
     $     'POB UOB  VOB  TOB QOB ZOB CAT TVO TDO DDO  FFO  XDR    '/

      DATA  OBSSTR2/
       ! PROFLR vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! VADWND vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! ADPUPA vvvvv
     $     ' YDR    HRDR NUL   NUL    NUL    NUL                   ',
       ! AIRCAR vvvvv
     $     ' TRBX21 POAF PCAT  TRBX32 TRBX43 MSTQ                  ',
       ! AIRCFT vvvvv
     $     ' ROLF   POAF PCAT  TRBX   IALR   NUL                   ',
       ! SATWND vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! SATEMP vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! SPSSMI vvvvv
     $     ' REQV   NUL  NUL   NUL    NUL    NUL                   ',
       ! ADPSFC vvvvv
     $     ' PMO    ALSE PMIN  NUL    NUL    NUL                   ',
       ! SFCSHP vvvvv
     $     ' PMO    NUL  PMIN  NUL    NUL    NUL                   ',
       ! SFCBOG vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! ERS1DA vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! GOESND vvvvv
     $     ' CDTP   TOCC GCDTT NUL    NUL    NUL                   ',
       ! QKSWND vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! MSONET vvvvv
     $     ' NUL    ALSE NUL   NUL    NUL    NUL                   ',
       ! GPSIPW vvvvv
     $     ' BEARAZ ELEV APDS  APDE   NUL    NUL                   ',
       ! RASSDA vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! WDSATR vvvvv
     $     ' REQV   NUL  NUL   NUL    NUL    NUL                   ',
       ! ASCATW vvvvv
     $     ' NUL    NUL  NUL   NUL    NUL    NUL                   ',
       ! UPRAIR vvvvv
     $     ' YDR    HRDR NUL   NUL    NUL    NUL                   '/

      DATA  QMSSTR/
       ! PROFLR vvvvv
     $             'PQM WQM  NUL NUL ZQM NUL  NUL   DFQ   NUL   ',
       ! VADWND vvvvv
     $             'PQM WQM  NUL NUL ZQM NUL  NUL   DFQ   NUL   ',
       ! ADPUPA vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  NUL   DFQ   NUL   ',
       ! AIRCAR vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  NUL   DFQ   NUL   ',
       ! AIRCFT vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  NUL   DFQ   NUL   ',
       ! SATWND vvvvv
     $             'PQM WQM  TQM NUL ZQM NUL  NUL   DFQ   NUL   ',
       ! SATEMP vvvvv
     $             'PQM NUL  TQM QQM ZQM NUL  NUL   NUL   NUL   ',
       ! SPSSMI vvvvv
     $             'PQM WQM  NUL NUL NUL PWQ  RRTQM DFQ   NUL   ',
       ! ADPSFC vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  PMQ   DFQ   NUL   ',
       ! SFCSHP vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  PMQ   DFQ   NUL   ',
       ! SFCBOG vvvvv
     $             'PQM NUL  NUL NUL ZQM NUL  NUL   NUL   NUL   ',
       ! ERS1DA vvvvv
     $             'PQM WQM  NUL NUL NUL NUL  NUL   DFQ   NUL   ',
       ! GOESND vvvvv
     $             'PQM PW1Q TQM QQM ZQM PW2Q PW3Q  PW4Q  CTPQM ',
       ! QKSWND vvvvv
     $             'PQM WQM  NUL NUL NUL NUL  NUL   DFQ   NUL   ',
       ! MSONET vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  NUL   DFQ   NUL   ',
       ! GPSIPW vvvvv
     $             'NUL NUL  NUL NUL NUL PWQ  NUL   NUL   NUL   ',
       ! RASSDA vvvvv
     $             'PQM NUL  TQM NUL ZQM NUL  NUL   NUL   NUL   ',
       ! WDSATR vvvvv
     $             'PQM WQM  NUL NUL NUL NUL  NUL   DFQ   NUL   ',
       ! ASCATW vvvvv
     $             'PQM WQM  NUL NUL NUL NUL  NUL   DFQ   NUL   ',
       ! UPRAIR vvvvv
     $             'PQM WQM  TQM QQM ZQM NUL  NUL   DFQ   NUL   '/

      DATA  PGMSTR/
       ! PROFLR vvvvv
     $             'PPC ZPC WPC  DFP  NUL NUL NUL   NUL   NUL   ',
       ! VADWND vvvvv
     $             'PPC ZPC WPC  DFP  NUL NUL NUL   NUL   NUL   ',
       ! ADPUPA vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   ',
       ! AIRCAR vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   ',
       ! AIRCFT vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   ',
       ! SATWND vvvvv
     $             'PPC ZPC WPC  DFP  TPC NUL NUL   NUL   NUL   ',
       ! SATEMP vvvvv
     $             'PPC ZPC NUL  NUL  TPC QPC NUL   NUL   NUL   ',
       ! SPSSMI vvvvv
     $             'PPC NUL WPC  DFP  NUL NUL PWP   RRTPC NUL   ',
       ! ADPSFC vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   ',
       ! SFCSHP vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   ',
       ! SFCBOG vvvvv
     $             'PPC ZPC NUL  NUL  NUL NUL NUL   NUL   NUL   ',
       ! ERS1DA vvvvv
     $             'PPC NUL WPC  DFP  NUL NUL NUL   NUL   NUL   ',
       ! GOESND vvvvv
     $             'PPC ZPC PW1P PW2P TPC QPC PW3P  PW4P  CTPPC ',
       ! QKSWND vvvvv
     $             'PPC NUL WPC  DFP  NUL NUL NUL   NUL   NUL   ',
       ! MSONET vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   ',
       ! GPSIPW vvvvv
     $             'NUL NUL NUL  NUL  NUL NUL PWP   NUL   NUL   ',
       ! RASSDA vvvvv
     $             'PPC ZPC NUL  NUL  TPC NUL NUL   NUL   NUL   ',
       ! WDSATR vvvvv
     $             'PPC NUL WPC  DFP  NUL NUL NUL   NUL   NUL   ',
       ! ASCATW vvvvv
     $             'PPC NUL WPC  DFP  NUL NUL NUL   NUL   NUL   ',
       ! UPRAIR vvvvv
     $             'PPC ZPC WPC  DFP  TPC QPC NUL   NUL   NUL   '/

      DATA  RSNSTR/
       ! PROFLR vvvvv
     $             'PRC ZRC WRC  DFR  NUL NUL NUL   NUL   NUL   ',
       ! VADWND vvvvv
     $             'PRC ZRC WRC  DFR  NUL NUL NUL   NUL   NUL   ',
       ! ADPUPA vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   ',
       ! AIRCAR vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   ',
       ! AIRCFT vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   ',
       ! SATWND vvvvv
     $             'PRC ZRC WRC  DFR  TRC NUL NUL   NUL   NUL   ',
       ! SATEMP vvvvv
     $             'PRC ZRC NUL  NUL  TRC QRC NUL   NUL   NUL   ',
       ! SPSSMI vvvvv
     $             'PRC NUL WRC  DFR  NUL NUL PWR   RRTRC NUL   ',
       ! ADPSFC vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   ',
       ! SFCSHP vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   ',
       ! SFCBOG vvvvv
     $             'PRC ZRC NUL  NUL  NUL NUL NUL   NUL   NUL   ',
       ! ERS1DA vvvvv
     $             'PRC NUL WRC  DFR  NUL NUL NUL   NUL   NUL   ',
       ! GOESND vvvvv
     $             'PRC ZRC PW1R PW2R TRC QRC PW3R  PW4R  CTPRC ',
       ! QKSWND vvvvv
     $             'PRC NUL WRC  DFR  NUL NUL NUL   NUL   NUL   ',
       ! MSONET vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   ',
       ! GPSIPW vvvvv
     $             'NUL NUL NUL  NUL  NUL NUL PWR   NUL   NUL   ',
       ! RASSDA vvvvv
     $             'PRC ZRC NUL  NUL  TRC NUL NUL   NUL   NUL   ',
       ! WDSATR vvvvv
     $             'PRC NUL WRC  DFR  NUL NUL NUL   NUL   NUL   ',
       ! ASCATW vvvvv
     $             'PRC NUL WRC  DFR  NUL NUL NUL   NUL   NUL   ',
       ! UPRAIR vvvvv
     $             'PRC ZRC WRC  DFR  TRC QRC NUL   NUL   NUL   '/

      DATA SUBSET/'PROFLR  ','VADWND  ','ADPUPA  ','AIRCAR  ',
     $            'AIRCFT  ','SATWND  ','SATEMP  ','SPSSMI  ',
     $            'ADPSFC  ','SFCSHP  ','SFCBOG  ','ERS1DA  ',
     $            'GOESND  ','QKSWND  ','MSONET  ','GPSIPW  ',
     $            'RASSDA  ','WDSATR  ','ASCATW  ','UPRAIR  '/

      DATA  ICALL/0/,SINGLE/3*.FALSE.,3*.TRUE.,.FALSE.,5*.TRUE.,
     $ .FALSE.,3*.TRUE.,.FALSE.,2*.TRUE.,.FALSE./,ITYPL/0/,ISUB/0/,
     $ ISUBT/0/,IRECL/0/,AERS/12*0.0/
      DATA YMISS/99998.8/,IMISS/99999/

      DATA  KTYP/
CCC              100-101  102  103-109   110-119
     $              2*0 ,  8 ,    7*0 ,    10*0 ,
CCC              120  121  122  123-125  126  127-229
     $            3 ,  0 ,  3 ,    3*0 , 17 ,    3*0 ,
CCC              130-131  132  133  134  135  136-139   140-149
     $              2*5,   3 ,  4 ,  5 ,  5 ,    4*0 ,    10*6 ,
CCC              150  151  152  153  154  155  156-159
     $            8 , 13 ,  8 , 16 ,  0 ,  0 ,    4*13,
CCC              160-163  164-165  166-169
     $              4*7 ,    2*13,    4*0 ,
CCC              170-173  174-175  176-179
     $              4*7 ,    2*13,    4*0 ,
CCC              180  181  182  183  184-186  187  188  189
     $           10 ,  9 , 10 ,  9 ,    3*0 ,  9 , 15 ,  0 ,
CCC              190-191  192-193  194  195  196-199
     $              2*11,   2*9,    10,  15,   4*0 ,
CCC              200-209   210-219
     $             10*0 ,    10*0 ,
CCC              220-222  223  224  225  226  227  228  229
     $              3*3 ,  1 ,  2 ,  0 ,  0 ,  1 ,  1 ,  1 ,
CCC              230-231  232  233  234  235  236-239
     $              2*5,   3 ,  4 ,  5 ,  5 ,    4*0 ,
CCC              240-249   250-259   260-269   270-279
     $             10*6 ,    10*6 ,    10*0 ,    10*0 ,
CCC              280  281  282  283  284  285  286  287  288  289
     $           10 ,  9 , 10 ,  8 ,  9 , 14 , 12 ,  9 , 15 , 18 ,
CCC              290  291  292-293  294  295  296-299
     $           19 ,  0,   2*9,     10,  15,   4*0 /

      IER = 1
      IF(ICALL.EQ.0)  THEN
C-----------------------------------------------------------------------
C              COME HERE FIRST TIME INTO SUBROUTINE
C-----------------------------------------------------------------------
         IUNITP    = IUNIT(16)
         IUNITG(1) = IUNIT(4)
         IUNITG(2) = IUNIT(4) + 1
         CALL DATELEN(10)
         IF(APPEND)  THEN
C IF APPEND=TRUE, OPEN EXISTING PREPBUFR FILE - NEW BUFR MESSAGES WILL
C  BE APPENDED TO IT BASED ON ITS INTERNAL BUFR MNEMONIC TABLES A/B/D
            CALL DATEBF(IUNITP,MEAR,MMON,MDAY,MOUR,JDAT10)
            CALL OPENBF(IUNITP,'APX',IUNITP)
            PRINT 7100, IUNITP,JDAT10
 7100 FORMAT(/8X,'===> EXISTING PREPBUFR DATA SET IN UNIT',I3,
     $ ' SUCCESSFULLY OPENED FOR OUTPUT; NEW BUFR MESSAGES WILL BE ',
     $ 'APPENDED TO'/13X,'IT BASED ON ITS INTERNAL BUFR MNEMONIC ',
     $ 'TABLES A/B/D'/13X,'THIS DATA SET HAS THE DATE: ',I10/)
C DOES DATE FROM THE EXISTING PREPBUFR DATA SET MATCH THE EXPECTED
C  (NCEP PRODUCTION) DATE?
            IF(JDAT10.NE.IDAT10)  THEN
               PRINT 7789
 7789 FORMAT(/5X,'######  THE DATE FOUND IN THE EXISTING PREPBUFR DATA',
     $ ' SET DOES NOT MATCH THE EXPECTED (PRODUCTION) DATE FOR THIS ',
     $ 'RUN, STOP 30'/)
               CALL W3TAGE('PREPOBS_PREPDATA')
               CALL ERREXIT(30)
            END IF
         ELSE
C IF APPEND=FALSE, OPEN NEW PREPBUFR FILE - WRITE OUT FIRST MESSAGE
C  (TABLE A, B, D ENTRIES) FROM INPUT FILE CONTAINING BUFR MNEMONIC
C  TABLES A/B/D
            CALL OPENBF(IUNITP,'OUT',IUNIT(2))
             CALL MAXOUT(50000)                 ! CH 08/12/21
            PRINT 100, IUNITP,IUNIT(2)
  100 FORMAT(/8X,'===> NEW PREPBUFR DATA SET IN UNIT',I3,
     $ ' SUCCESSFULLY OPENED FOR OUTPUT; BUFR MNEMONIC TABLES A,B,D IN',
     $ ' UNIT',I3/13X,'READ IN AND ENCODED INTO BEGINNING MESSAGES OF ',
     $ 'OUTPUT DATA SET'/)
         END IF
C GET THE "PROGRAM CODE" CORRESPONDING TO "PREPRO" (PREPDATA)
         CALL UFBQCD(IUNITP,'PREPRO',IPCODE)
         PRINT 400, IPCODE
  400    FORMAT(/30X,'==> THIS PROGRAM IS "PREPRO" (PREPDATA) AND HAS ',
     $    'A PROGRAM CODE',I5.5,' <=='/)
         IF(.NOT.PREVEN)  THEN
            PRINT 7300
 7300 FORMAT(/1X,100('#')/' =====> W3EMC ROUTINE GBLEVENTS NOT INVOKED',
     $ ' -- NAMELIST SWITCH "PREVEN" IS FALSE'/1X,100('#')/)
            WRITE(IUNIT(17),7300)
            WRITE(IUNIT(17),7301)
 7301 FORMAT(130('#')//40X,'*** NO "PREVENT" EVENTS DATA FILTERING ***'
     $ //)
         END IF
         ICALL = 1
C-----------------------------------------------------------------------
      END IF
      IF(HDR(3).EQ.IMISS)  THEN
C-----------------------------------------------------------------------
C COME HERE AFTER ALL REPORTS HAVE BEEN PROCESSED

         IF(ITYPL.EQ.0)  THEN
            IF(.NOT.APPEND)  THEN
C IF NO DATA WAS WRITTEN TO DATA SET AND NOT APPENDING, THEN OPEN AN
C  EMPTY 'ADPUPA' TABLE A ENTRY MESSAGE SO THAT THE DATE IS AVAILABLE
C  ON THE DATA SET
               CALL OPENMB(IUNITP,'ADPUPA  ',IDAT10)
C ENCODE MINUTES VALUE INTO SECTION 1 OF MESSAGE HEADER IF NON-ZERO
C  (NOTE DEFAULT IS ZERO)
               IF (IDATMM.NE.0) call MINIMG(IUNITP,IDATMM)
               PRINT 9105, IUNITP,IDAT10,idatmm
 9105 FORMAT(/' $$$$ NO DATA WRITTEN TO PREPBUFR DATA SET, WILL WRITE ',
     $ 'A SINGLE MESSAGE WITH NO DATA IN ORDER TO STORE THE DATE'/
     $ ' ===> NEW TABLE A MESSAGE OPENED IN PREPBUFR DATA SET IN UNIT',
     $ I3,' -- TABLE A ENTRY IS "ADPUPA" AND DATE IS',I11,':',i2.2/)
            ELSE
C IF NO DATA WAS WRITTEN TO DATA SET AND APPENDING, PRINT A DIAGNOSTIC
C  WARNING
               PRINT 9705
 9705 FORMAT(/' $$$$ WARNING: NO NEW DATA APPENDED TO PREPBUFR DATA ',
     $ 'SET'/)
            END IF
         END IF
C CLOSE PREPBUFR DATA SET
         CALL UFBCNT(IUNITP,IREC,ISUB)
         ISUBT = ISUBT + ISUB
         PRINT 1253, IREC,ISUB,ISUBT
 1253 FORMAT(/' --- WROTE BUFR DATA MSG NO.',I10,' WITH',I5,' REPORTS ',
     $ '(TOTAL NO. REPORTS WRITTEN =',I7,')'/)
         CALL CLOSBF(IUNITP)
         PRINT 101, IUNITP
  101 FORMAT(/5X,'===> PREPBUFR DATA SET IN UNIT',I3,' SUCCESSFULLY',
     $ ' CLOSED'/)
         WRITE(IUNIT(17),7302)
 7302    FORMAT(/130('#')//)
         GO TO 999
C-----------------------------------------------------------------------
      END IF
      KI  = HDR(6)/100
      NI  = MOD((NINT(HDR(6))/10),10)
      JI  = MOD(NINT(HDR(6)),10)
      CTYPE = 'MASS'
      IF(KI.EQ.2)  CTYPE = 'WIND'
C-----------------------------------------------------------------------
C     DETERMINE TABLE A ENTRY TO USE BASED ON PREPBUFR REPORT TYPE
C     (NOTE: IF INPUT FILE IS "SFCSHP", THEN FORCE ALL REPORTS TO GO
C            TO "SFCSHP" TABLE A ENTRY (NEEDED BECAUSE PREPBUFR REPORT
C            TYPES 183 AND 284 CAN APPEAR IN EITHER "ADPSFC" OR
C            "SFCSHP" INPUT FILE)
C-----------------------------------------------------------------------
      ITYP = KTYP(NINT(HDR(6)))
      IF(NFILE.EQ.IUNIT(6)+1)  ITYP = 10
      IF(ITYP.LE.0)  THEN
C NOTE REPORTS WITH A PREPBUFR REPORT TYPE THAT IS NOT RECOGNIZED HERE
C  -- SKIP
         PRINT 113, CTYPE,STNID,alat_8,alon_8,NINT(HDR(6))
  113 FORMAT(' + + ',A4,' REPORT TOSSED   -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - NOT RECOGNIZED IN SUBROUTINE ',
     $ 'W3FIZZ')
         GO TO 999
      END IF
C-----------------------------------------------------------------------
C  TEST PREPBUFR REPORT TYPE TO DETERMINE IF TABLE A ENTRY SHOULD CHANGE
C-----------------------------------------------------------------------
      NEWTYP = 0
C IF 'ITYP' FOR THIS RPT DIFFERENT THAN FOR PREVIOUS RPT, SUBR. OPENMB
C  WILL OPEN A NEW BUFR MSG WITH THE NEW TABLE A ENTRY & RETURN A DATE
      IF(ITYPL.GT.0)  THEN
C WILL NOT PRINT HERE IF THIS IS THE FIRST MESSAGE IN THE DATA SET
         IF(ITYPL.NE.ITYP)  THEN
            CALL UFBCNT(IUNITP,IREC,ISUB)
            ISUBT = ISUBT + ISUB
            PRINT 1253, IREC,ISUB,ISUBT
         END IF
      END IF
      CALL OPENMB(IUNITP,SUBSET(ITYP),IDAT10)
C ENCODE MINUTES VALUE INTO SECTION 1 OF MESSAGE HEADER IF NON-ZERO
C  (NOTE DEFAULT IS ZERO)
      IF (IDATMM.NE.0) call MINIMG(IUNITP,IDATMM)
      IF(ITYPL.NE.ITYP)  THEN
         PRINT 105, IUNITP,SUBSET(ITYP),IDAT10,idatmm
  105 FORMAT(/' ===> NEW TABLE A MESSAGE OPENED IN PREPBUFR DATA SET ',
     $ 'IN UNIT',I3,' -- TABLE A ENTRY IS "',A8,'" AND DATE IS',I11,':',
     $ i2.2/)
         CALL UFBCNT(IUNITP,IRECL,ISUB)
         NEWTYP = 1
      END IF
      ITYPL = ITYP

      SEPARATE_METARS = .FALSE.
      IF(SEPARATE_METARS) THEN

C This logic was designed to separate the METAR reports in the ADPSFC
C  message types being written out - they would never be combined with
C  non-METARS (i.e., SYNOPS) and their messages would be given a new
C  sub-type of 7 - this was going to be done in order to speed up the
C  subsequent REMOREST processing since only the non-METARs in the
C  ADPSFC really need to be checked (only the WMO Res. 40 SYNOPS
C  are restricted).
C
C The problem is that OIQCBUFR "reshuffles" messages in the same Table
C  A message type so there is no guarantee that METARS will remain
C  separate from SYNOPS in the final q.c.'d Global PREPBUFR file, and
C  there is no guarantee that the METAR messages will still have a
C  sub-type of 7.  The logic is kept in case we ever want to revisit
C  this issue (such as if OIQCBUFR ever goes away).

         if(subset(ityp).eq.'ADPSFC  ')  then
C IF THIS PREPBUFR TABLE A ENTRY IS ADPSFC, THEN ....
cppppp
            print'(" %%% subset_d = ",A8,"; subset_d_last = ",A8)',
     $       subset_d,subset_d_last
cppppp
            if(subset_d.eq.'NC000007')  then
C .... IF THIS IS A METAR REPORT (I.E., IT COMES FROM A METAR TABLE A
C      MESSAGE IN THE INPUT ADPSFC DUMP FILE) ....
               call status(iunitp,lun,idummy1,idummy2)
               if(subset_d_last.ne.'NC000007'.and.newtyp.ne.1) then
C     .... IF THE PREVIOUS REPORT WAS NOT A METAR BUT IT WAS ANOTHER
C          TYPE IN PREPBUFR TABLE A ENTRY ADPSFC, THEN CLOSE CURRENT
C          PREPBUFR ADPSFC MESSAGE AND OPEN A NEW ONE WHERE THE MESSAGE
C          SUBTYPE IN SEC. 1 (NORMALLY HARDWIRED TO ZERO) IS
C          OVERWRITTEN WITH 7 TO UNIQUELY IDENTIFY THIS MESSAGE AS
C          CONTAINING ONLY METAR REPORTS (USEFUL FOR LATER PARSING OF
C          RESTRICTED RES. 40 SYNOPS WHICH WILL NEVER BE IN THESE METAR
C          SUBTYPE MESSAGES)
                  call closmg(iunitp)
                  call openmg(iunitp,subset(ityp),idat10)
C Encode minutes value into Section 1 of message header if non-zero
C  (note default is zero)
                  if(idatmm.ne.0) call MINIMG(IUNITP,IDATMM)
                  print'(" First METAR encountered, close last ",
     $             "(SYNOP) message and open new message")'
               end if
               msbt = 7
               call pkbs1(msbt,mbay(1,lun),'MSBT')
            else
C .... IF THIS IS NOT A METAR REPORT (I.E., IT COMES FROM A TABLE A
C      MESSAGE OTHER THAN METAR IN THE INPUT ADPSFC DUMP FILE) ....
               if(subset_d_last.eq.'NC000007') then
C     .... IF THE PREVIOUS REPORT WAS A METAR, THEN OVERWRITE THE
C          MESSAGE SUBTYPE IN SEC. 1 OF THE CURRENT OPEN MESSAGE WITH 7
C          TO UNIQUELY IDENTIFY THIS MESSAGE AS CONTAINING ONLY METAR
C          REPORTS (USEFUL FOR LATER PARSING OF RESTRICTED RES. 40
C          SYNOPS WHICH WILL NEVER BE IN THESE METAR SUBTYPE MESSAGES)
C          (NOTE: THIS IS MOST LIKELY REDUNDANT SINCE IT SHOULD ALREADY
C          HAVE BEEN OVERWRITTEN WHEN FIRST OPENED - SEE ABOVE), THEN
C          CLOSE THIS MESSAGE AND OPEN A NEW ONE TO WRITE THIS NON-
C          METAR REPORT INTO
                  msbt = 7
                  call pkbs1(msbt,mbay(1,lun),'MSBT')
                  call closmg(iunitp)
                  call openmg(iunitp,subset(ityp),idat10)
C Encode minutes value into Section 1 of message header if non-zero
C  (note default is zero)
                  if(idatmm.ne.0) call MINIMG(IUNITP,IDATMM)
                  print'(" First SYNOP encountered, close last ",
     $             "(METAR) message and open new message")'
               end if
            end if
            subset_d_last = subset_d
         end if
CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
      ENDIF

C-----------------------------------------------------------------------
C CALL SUBR. FIZZ01 TO PROCESS THE NEXT REPORT
      CALL FIZZ01(KI,NI,JI,SUBSET(ITYP),SINGLE(ITYP))
      NMOBS2 = 0
      NMOBS3 = 0
      NMHDR  = 0
      IF(WRMISS) THEN
         IF(MAX(NLV,NBT).EQ.0) THEN
C IF N-LIST SWITCH WRMISS IS TRUE AND NO VALID OBS LEVELS OR BRIGHTNESS
C  TEMP CHANNELS PRESENT FOR THIS BUFR SUBSET, CHECK FOR PRESENCE OF
C  ANY ANCILLARY INFORMATION (E.G., SENSIBLE WEATHER ELEMENTS) - IF
C  SOME IS FOUND, ENCODE SUBSET INTO PREPBUFR FILE (EVEN THOUGH THIS
C  INFO IS NOT DIRECTLY USED BY ASSIMILATION, IT MIGHT BE USEFUL FOR
C  VERIFICATION OR IN OTHER WAYS) {RIGHT NOW ONLY APPLIES TO AIRCRAFT
C  DATA (MAINLY PIREPS) BASED ON LOGIC IN SUBR. GETC06}
            IF(MAX(NOBS3(1),NOBS3(2),NOBS3(3),NOBS3(4),NOBS3(5),
     $       NOBS3(6),NOBS3(7)).EQ.0) THEN
               DO I = 1,NUMOBS2
                  IF(OBS2(I).LT.YMISS) THEN
                     NMOBS2 = 1
                     EXIT
                  END IF
               ENDDO
               IF(NMOBS2.EQ.0) THEN
                  DO I = 13,15
                     IF(HDR_8(I).LT.YMISS) THEN
                        NMHDR = 1
                        EXIT
                     END IF
                  ENDDO
                  IF(NMHDR.EQ.0) THEN
                     DO I = 19,20
                        IF(HDR_8(I).LT.YMISS) THEN
                           NMHDR = 1
                           EXIT
                        END IF
                     ENDDO
                  END IF
                  IF(NMHDR.EQ.0) THEN
                     DO I = 23,26
                        IF(HDR_8(I).LT.YMISS) THEN
                           NMHDR = 1
                           EXIT
                        END IF
                     ENDDO
                  END IF
               END IF
            ELSE
               NMOBS3 = 1
            END IF
         END IF
      END IF
      IF(MAX(NLV,NBT,NMOBS2,NMOBS3,NMHDR).GT.0) THEN
C-----------------------------------------------------------------------
C      ENCODE ALL VARIABLES/LEVELS MAKING UP THIS REPORT (SUBSET)
C-----------------------------------------------------------------------
C STORE THE STATION ID ("HDR_8" WORD 1)
         CHDR = STNID
         CALL UFBINT(IUNITP,HDR_8(1), 12,1,IRET,HEADR1)
         CALL UFBINT(IUNITP,HDR_8(13), 9,1,IRET,HEADR2)
         CALL UFBINT(IUNITP,HDR_8(22),MHDRWD-21,1,IRET,HEADR3)
C STORE VARIABLES THAT ARE IN SINGLE-LVL OBS2 & MULTI-LVL OBS3 ARRAYS
         OBS2_8=OBS2
         OBS3_8=OBS3
         RDATA2_8=RDATA2
         CALL UFBINT(IUNITP,OBS2_8,2,1,IRET,'RSRD EXPRSRD')

         IF(SUBSET(ITYP).EQ.'ADPSFC  ') THEN
            CALL UFBINT(IUNITP,OBS2_8( 4),10,1,IRET,
     $        'SST1 NUL MSST .REHOVI HOVI VTVI PSW1 PSW2 PKWDSP PKWDDR')
            CALL UFBINT(IUNITP,OBS2_8(14),11,1,IRET,
     $     '.DTMMXGS MXGS NUL TP01 TP03 TP06 TP12 TP24 TOSS TOCC HBLCS')
            CALL UFBINT(IUNITP,OBS2_8(29),12,1,IRET,
     $  '.DTHDOFS DOFS TOSD HOWV POWV HOWW POWW NUL NUL CHPT 3HPC 24PC')
            CALL UFBINT(IUNITP,OBS2_8(41),1,1,IRET,'SSTQM')
            IF(NOBS3(1).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,1),5,
     $                                    NOBS3(1),IRET,'.DTHTOPC TOPC')
            IF(NOBS3(2).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,2),5,
     $                                             NOBS3(2),IRET,'PRWE')
            IF(NOBS3(3).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,3),5,
     $                         NOBS3(3),IRET,'VSSO CLAM CLTP HOCB HOCT')


C Process CEILING data
c-----------
C  for METAR reports only, use cloud amount (CLAM) and cloud base (HOCB)
c  values to populate CEILING.

c - method: Find lowest cloud layer that has an amount that is
c    "either Broken (6-9 tenths sky cover) or Overcast (10 tenths cover)"
c    otherwise, set CEILING to missing.

c    for fog conditions (CLAM values of 9 or 10), use corresponding HOCB
c     as CEILING.

c   if ob exists w/ less than broken (0 to 5 tenths) and non-fog conditions,
c    fill CEILING w/ arbitrarily high value (currently 20000m).
c-----------

c  check for at least 1 cloud layer (nobs(3)>0) in METAR reports (TYP=512)
      if(NOBS3(3).gt.0 .and. int(hdr_8(7)).eq.512) then

c-- debug of ceiling: available cloud amount & cloud base values
c---  DATA HEADR1/'SID  XOB YOB DHR NUL TYP T29 TSB ITP ELV SQN SIRC '/
c---  OBS3_8(5,MXBLVL,7)
      db_ceiling=.false.  ! set to .true. to debug
      if ( db_ceiling ) then
        write(*,'(a,1x,a8,$)') 'db: ',stnid
        write(*,'(3(1x,f6.2),$)') (hdr_8(i),i=2,4)
        write(*,'(2(1x,i5),$)') (int(hdr_8(i)),i=6,7)
        write(*,'(2x,a,i2)') "n= ",NOBS3(3)

        do i=1,NOBS3(3)
          write(*,'(a,4x,i2,1x,":",3(2x,i3),2(3x,i5))') 'db: ',i,
     $      (idint(OBS3_8(j,i,3)),j=1,3),
     $      (idint(OBS3_8(j,i,3)),j=4,5)
        enddo ! i=1,NOBS3(3)
       endif ! db_ceiling
c--

c - loop thru available cloud layers, low to high
        ndx_amt=0
        ndx_bas=0
        do i=1,NOBS3(3)
          cldamt_8=OBS3_8(2,i,3)
          cldbas_8=OBS3_8(4,i,3)

c - if cld amount missing or indiscernable, skip this level/layer
          if ( ibfms(cldamt_8).eq.1 ) cycle                ! CLAM missing
          if ( cldamt_8.eq.15. ) cycle               ! CLAM indiscernable

          ndx_amt=ndx_amt+1

c - if cld base missing, skip this level/layer
          if ( ibfms(cldbas_8).eq.1 ) cycle                ! HOCB missing

c - check for sufficient cloud amount in this layer, break out of loop if found
          if ( idnint(cldamt_8).eq.12 .or.
     $       ( cldamt_8.ge.5. .and. cldamt_8.le.10. ) ) then  ! >5/10 or fog
            ndx_bas=i
            exit
          endif ! if broken or betw 6-10 tenths cover

        enddo ! i=1,NOBS3(3)

c - specify infinite or missing ceiling values
        if ( ndx_amt.ne.0 ) then                  ! some clouds found
          if ( ndx_bas.eq.0 ) cldbas_8=20000.d0   ! no dense cloud found,
c                                                 !  ceiling infinite (20k)
        else ! ndx_amt not 0
          cldbas_8=bmiss

        endif ! ndx_amt not 0

c - write out ceiling value
          if (db_ceiling)
     &      write(*,'(a,1x,i5)') 'db: ceil= ', idint(cldbas_8)
          call UFBINT(iunitp,cldbas_8,1,1,iret,'CEILING')

      endif ! NOBS3(3)>0 & hdr_8(7)=512 (metar)
c - end of CEILING processing


            IF(NOBS3(4).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,4),5,
     $                      NOBS3(4),IRET,'.DTHMXTM MXTM .DTHMITM MITM')
            IF(NOBS3(5).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,5),5,
     $                                   NOBS3(5),IRET,'DOSW HOSW POSW')

         ELSE IF(SUBSET(ITYP).EQ.'SFCSHP  ') THEN
            CALL UFBINT(IUNITP,OBS2_8( 4),12,1,IRET,
     $   'SST1 DBSS MSST NUL HOVI VTVI PSW1 PSW2 PKWDSP PKWDDR .DTMMXGS
     $ MXGS')
            CALL UFBINT(IUNITP,OBS2_8(23), 4,1,IRET,
     $                                           'TOCC HBLCS XS10 XS20')
            CALL UFBINT(IUNITP,OBS2_8(32),10,1,IRET,
     $             'HOWV POWV HOWW POWW TDMP ASMP CHPT 3HPC 24PC SSTQM')
            IF(NOBS3(2).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,2),5,
     $                                             NOBS3(2),IRET,'PRWE')
            IF(NOBS3(3).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,3),5,
     $                          NOBS3(3),IRET,'VSSO CLAM CLTP HOCB NUL')
            IF(NOBS3(5).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,5),5,
     $                                   NOBS3(5),IRET,'DOSW HOSW POSW')

         ELSE IF(SUBSET(ITYP).EQ.'MSONET  ') THEN
            CALL UFBINT(IUNITP,OBS2_8( 8), 1,1,IRET,'HOVI')
            CALL UFBINT(IUNITP,OBS2_8(15), 2,1,IRET,'MXGS MXGD')
            IF(NOBS3(1).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,1),5,
     $                                    NOBS3(1),IRET,'.DTHTOPC TOPC')

         ELSE IF(SUBSET(ITYP).EQ.'ADPUPA  ') THEN
            CALL UFBINT(IUNITP,OBS2_8( 4), 1,1,IRET,'SST1')
            CALL UFBINT(IUNITP,OBS2_8(24), 5,1,IRET,
     $                                      'HBLCS NUL NUL WDIR1 WSPD1')
            CALL UFBINT(IUNITP,OBS2_8(41), 1,1,IRET,'SSTQM')
            IF(NOBS3(2).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,2),5,
     $                                             NOBS3(2),IRET,'PRWE')
            IF(NOBS3(3).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,3),5,
     $                         NOBS3(3),IRET,'VSSO CLAM CLTP HOCB HOCT')
            IF(NOBS3(6).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,6),5,
     $                                   NOBS3(6),IRET,'AFIC HBOI HTOI')
            IF(NOBS3(7).GT.0) CALL UFBINT(IUNITP,OBS3_8(1,1,7),5,
     $                                   NOBS3(7),IRET,'DGOT HBOT HTOT')

         ELSE IF(SUBSET(ITYP).EQ.'GOESND  ') THEN
            CALL UFBINT(IUNITP,RDATA2_8(2), 1,1,IRET,'ACAV')
         ELSE IF(SUBSET(ITYP).EQ.'QKSWND  ') THEN
            CALL UFBINT(IUNITP,RDATA2_8(3), 2,1,IRET,'CTCN ATRN')
            CALL UFBINT(IUNITP,RDATA2_8(8), 1,1,IRET,'SPRR')
         ELSE IF(SUBSET(ITYP).EQ.'WDSATR  ') THEN
            CALL UFBINT(IUNITP,RDATA2_8(2), 1,1,IRET,'ACAV')
            CALL UFBINT(IUNITP,RDATA2_8(9), 8,1,IRET,
     $       'SST1 MRWVC MRLWC WSST MWD10 MWS10 WSEQC1 CHSQ')
            CALL UFBINT(IUNITP,RDATA2_8(17), 5,1,IRET,
     $       'PHER SPDE SSTE CLDE VPRE ')
         ELSE IF(SUBSET(ITYP).EQ.'ASCATW  ') THEN
            CALL UFBINT(IUNITP,RDATA2_8(3) ,1,1,IRET,'CTCN')
            CALL UFBINT(IUNITP,RDATA2_8(22),3,1,IRET,'WVCQ BSCD LKCS')
         ELSE IF(SUBSET(ITYP).EQ.'SATWND  ') THEN
            CALL UFBINT(IUNITP,OBS2_8(43), 1,1,IRET,'SAZA')
         END IF

         IF(NLV.GT.0)  THEN
            OBS_8=OBS
            CALL UFBINT(IUNITP,OBS_8,MOBSWD,NLV,IRET,OBSSTR1(ITYP))
            OB2_8=OB2
            IF(SUBSET(ITYP)(1:3).EQ.'AIR'.OR.SUBSET(ITYP)(1:3).EQ.'ADP'
     $    .OR. SUBSET(ITYP).EQ.'SPSSMI  '.OR.SUBSET(ITYP).EQ.'SFCSHP  '
     $    .OR. SUBSET(ITYP).EQ.'GOESND  '.OR.SUBSET(ITYP).EQ.'MSONET  '
     $    .OR. SUBSET(ITYP).EQ.'GPSIPW  '
     $    .OR. SUBSET(ITYP).EQ.'WDSATR  ')
     $       CALL UFBINT(IUNITP,OB2_8,MOB2WD,NLV,IRET,OBSSTR2(ITYP))
            QMS_8=QMS
            CALL UFBINT(IUNITP,QMS_8,MQMSWD,NLV,IRET,QMSSTR(ITYP))
            PGM_8=PGM
            CALL UFBINT(IUNITP,PGM_8,MPGMWD,NLV,IRET,PGMSTR(ITYP))
            RSN_8=RSN
            CALL UFBINT(IUNITP,RSN_8,MPGMWD,NLV,IRET,RSNSTR(ITYP))
            IF(SUBSET(ITYP).EQ.'AIRCFT  '.AND.NLV.EQ.1)  THEN
               IF(NOBS3(2).GT.0)  THEN
    ! Tell BUFRLIB there are NOBS3(2) PREWXSEQ replications for this rpt
                  CALL DRFINI(IUNITP,NOBS3(2),1,'{PREWXSEQ}')
    ! Store PREWXSEQ replications for this rpt
                  CALL UFBSEQ(IUNITP,OBS3_8(1,1,2),1,NOBS3(2),IRET,
     $             'PREWXSEQ')
	       END IF
               IF(NOBS3(3).GT.0)  THEN
    ! Tell BUFRLIB there are NOBS3(3) CLOUDSEQ replications for this rpt
                  CALL DRFINI(IUNITP,NOBS3(3),1,'{CLOUDSEQ}')
    ! Store CLOUDSEQ replications for this rpt
                  CALL UFBSEQ(IUNITP,OBS3_8(1,1,3),5,NOBS3(3),IRET,
     $             'CLOUDSEQ')
	       END IF
               IF(NOBS3(6).GT.0)  THEN
    ! Tell BUFRLIB there are NOBS3(6) AFIC_SEQ replications for this rpt
                  CALL DRFINI(IUNITP,NOBS3(6),1,'{AFIC_SEQ}')
    ! Store AFIC_SEQ replications for this rpt
                  CALL UFBSEQ(IUNITP,OBS3_8(1,1,6),3,NOBS3(6),IRET,
     $             'AFIC_SEQ')
	       END IF
               IF(NOBS3(7).GT.0)  THEN
    ! Tell BUFRLIB there are NOBS3(7) TURB3SEQ replications for this rpt
                  CALL DRFINI(IUNITP,NOBS3(7),1,'{TURB3SEQ}')
    ! Store TURB3SEQ replications for this rpt
                  CALL UFBSEQ(IUNITP,OBS3_8(1,1,7),3,NOBS3(7),IRET,
     $             'TURB3SEQ')
	       END IF
	    END IF
cdak        IF(HDR(6).EQ.286)  THEN
C.......................................................................
C     ERS SCATTEROMETER WIND REPORTS ZERO OUT THE INCIDENT ANGLE,
C     AZIMUTH ANGLE, BACKSCATTER AND ERROR ESTIMATE FOR #1, 2, 3
C   NOTICE: These are not used by any code and are commented out
C           until such time as they are used (saves a lot of
C           space in the PREPBUFR files)
C.......................................................................
cdak           AERS_8=AERS
cdak           CALL UFBINT(IUNITP,AERS_8,12,1,IRET,
cdak $                            'A1 A2 A3 B1 B2 B3 S1 S2 S3 E1 E2 E3')
cdak        END IF
            IF(HDR(6).EQ.188.OR.HDR(6).EQ.288
     $     .or.hdr(6).eq.195.or.hdr(6).eq.295) THEN
C.......................................................................
C     MESONET SURFACE REPORTS ENCODE PROVIDER AND SUBPROVIDER ID
C                         CHARACTER STRINGS
C.......................................................................
               CPRV(1) = CRES1
               CPRV(2) = CRES2
               CALL UFBINT(IUNITP,RPRV_8,2,1,IRET,'PRVSTG SPRVSTG')
            END IF
            IF((HDR(6).EQ.133.OR.HDR(6).EQ.233) .OR.
     $        ((HDR(6).EQ.131.OR.HDR(6).EQ.231).AND.IDATA(10).eq.103))
     $       THEN
C.......................................................................
C      MDCRS AND AMDARB REPORTS ENCODE FLIGHT NUMBER (CHARACTER*8)
C.......................................................................
               CACID = CRES2
               CALL UFBINT(IUNITP,RACID_8,1,1,IRET,'ACID')
            END IF
            IF((HDR(6).EQ.134.OR.HDR(6).EQ.234).AND.HDR(8).EQ.0)THEN
C.......................................................................
C    TAMDARM REPORTS ENCODE FLIGHT NUMBER (SAME AS STNID) (CHARACTER*8)
C.......................................................................
               CACID = STNID
               CALL UFBINT(IUNITP,RACID_8,1,1,IRET,'ACID')
            END IF
C.......................................................................
         END IF
         IF(NBT.GT.0)  THEN
            IF(NI.EQ.6.OR.NI.EQ.7)  THEN
               RAD_8=RAD
               CALL UFBINT(IUNITP,RAD_8,5,1,IRET,
     $                                       'ELEV SOEL OZON TMSK CLAM')
            END IF
            BTO_8=BTO
            CALL UFBINT(IUNITP,BTO_8,2,NBT,IRET,'CHNM TMBR')
         END IF
C-----------------------------------------------------------------------
C CALL W3EMC ROUTINE GBLEVENTS TO ENCODE BACKGROUND EVENTS FOR THIS RPT
         IF(PREVEN)  CALL GBLEVENTS(IDAT10,IUNITG,IUNIT(4)+2,IUNITP,
     $                              IUNIT(17),SUBSET(ITYP),NEWTYP)
C WRITE THIS REPORT (SUBSET) INTO BUFR MESSAGE
         CALL WRITSB(IUNITP)
         IER = 0
      ELSE
C NOTE THAT THIS REPORT (SUBSET) NOT PROCESSED DUE TO NO. LEVELS = 0
         PRINT 213, CTYPE,STNID,alat_8,alon_8,NINT(HDR(6))
  213 FORMAT(' + + ',A4,' REPORT TOSSED   -ID=',A8,', LAT=',F10.5,'N,',
     $ ' LON=',F11.5,'E, RTYP',I4,' - ZERO LEVELS PROCESSED IN ',
     $ 'SUBROUTINE W3FIZZ')
      END IF
      CALL UFBCNT(IUNITP,IREC,ISUBN)
      IF(IREC.GT.IRECL)  THEN
         IRECL = IREC
         ISUBT = ISUBT + ISUB
         PRINT 1254, IREC-1,ISUB,ISUBT
 1254 FORMAT(/' --- THIS REPORT OPENS NEW MSG (SAME TABLE A): LAST MSG',
     $ ' WAS NO.',I10,' (DATA) WITH',I5,' RPTS (TOTAL NO. RPTS ',
     $ 'WRITTEN=',I7,')'/)
      END IF
      ISUB = ISUBN
  999 CONTINUE
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    FIZZ01
C   PRGMMR: Keyser           ORG: NP22       DATE: 2016-11-30
C
C ABSTRACT: PARSES THE "HDR/MOBS/IPMSL/PWAT/xRAD/REQV/CLTOP" ARRAYS
C   (HOLDING ONE PREPROCESSED REPORT) INTO THE APPROPRIATE ARRAYS
C   ASSOCIATED WITH THE MNEMONICS DEFINED FOR THE DATA TYPE'S BUFR
C   TABLE A ENTRY (MESSAGE TYPE).
C
C PROGRAM HISTORY LOG:
C 1993-09-14  J. WOOLLEN (GENERAL SCIENCES CORPORATION)
C 1993-11-02  D. A. KEYSER -- STREAMLINED CODE; MORE INPUTS PASSED VIA
C     COMMON BLOCKS; ORIGINAL TABLE A ENTRY 'PREPOB' BROKEN INTO
C     SEPARATE TABLE A ENTRIES BASED ON DATA TYPES; INPUT MNEMONIC
C     STRINGS SPECIFIC TO TABLE A ENTRY
C 1994-08-11  D. A. KEYSER -- ELEV. AND RPT SEQ. NUMBER ENCODED INTO
C     REPORT HEADER (ALONG W/ OTHER DATA USED BY REANALYSIS PREPDATA
C     ONLY); VIRTUAL/REPORTED/DEWPOINT TEMP., WIND DIRECTION AND WIND
C     SPEED ALL ENCODED INTO REPORT LVL; RECEIPT TIME, REPORT SUB-TYPE
C     AND QCACFT WIND SPEED INCR. Q.M. (CONV'L/AMDAR AIRCFT WIND
C     REPORTS ONLY) ENCODED INTO REPORT HEADER
C 1995-07-12  D. A. KEYSER -- CAN PROCESS RGL/BUFR PREPDA (TEMPORARILY
C     DIFFERENT THAN GBL/PREPDA); PROGRAM CODE NOW ENCODED INTO BUFR/
C     PREPDA FOR ALL OBS. TYPES; THE FOLLOWING TYPES CAN NOW BE ENCODED
C     INTO BUFR/PREPDA (IF REQ.): 7-CHANNEL SSM/I BRIGHTNESS TEMPS AND
C     GOES PRECIP. WATER IN FOUR LAYERS; GOES & TOVS(BUFR) NOW ENCODE
C     MOISTURE Q.M. DIRECTLY FROM 'NOBS' Q.M. VALUE FOR MOISTURE,
C     BEFORE THEY ENCODED TEMP. Q.M. VALUE INTO MOISTURE Q.M. POSITION
C     LIKE ALL OTHER DATA TYPES; MNEMONIC 'TSB' (REPORT SUB-TYPE) NOW
C     USED TO HOLD INDICATOR FOR MISSING PHASE OF FLIGHT FOR AIRCRAFT
C     AMDAR REPORTS
C 1996-09-03  D. A. KEYSER -- PROCESSING OF TOVS RADIANCES PARTIALLY
C     DONE (SWITCH "TOVRAD")
C 1996-10-24  D. A. KEYSER -- LOGIC ADDED TO ENCODE TOVS RADIANCES
C     AND OTHER RELATED INFORMATION INTO PREPBUFR FILE, NEW MEMONICS
C     ADDED TO ACCOMPLISH THIS; N-LIST SWITCHES "TOVRAD" AND "TOVRTV"
C     ADDED TO PROCESS RADIANCES AND RETRIEVALS RESP.; ADDED LOGIC TO
C     ENCODE ERS SCATTEROMETER WIND REPORTS (R.TYPE=286) IN PREPBUFR
C     D-SET (USED TO BE APPENDED LATER); CORRECTED ERROR IN ENCODING OF
C     INITIAL VALUES FOR HEADER MNEMONICS "RQM", "DUP", "PRG", "SRC",
C     AND "RUD" (ONLY USED FOR REANALYSIS VERSION)
C 1997-05-01  D. A. KEYSER -- REASON CODES ENCODED INTO PREPBUFR
C 1997-06-02  D. A. KEYSER -- BUFR MNEMONIC "DHR" (REPORT D-TIME) SCALE
C     CHGED FROM 10**2 TO 10**3 FOR MORE PRECISION IN RPT TIME; ADDED
C     N-LIST SWITCH "FLDMGS" TO FLAG MOISTURE DATA ON ALL LEVELS FOR
C     GULF STREAM DROPS (IF TRUE)
C 1997-07-02  D. A. KEYSER -- ADDED LOGIC TO ENCODE GOES RADIANCES
C     INTO PREPBUFR FILE, USES SAME MNEMONICS AS TOVS RADIANCES (NEW
C     N-LIST SWITCH "GOESRD" ADDED TO SELECT PROCESSING OF GOES
C     RADIANCES)
C 1997-09-18   D. A. KEYSER -- CAN ENCODE ALTIM. SETTING IN PREPBUFR
C     WHEN PROCESSING SFC LAND DATA; ENCODES SKIN TEMP., CLOUD AMT.,
C     SOLAR ZENITH ANG., AND SAT. ZENITH ANG. IN PREPBUFR WHEN
C     PROCESSING GOES RADIANCES
C 1997-10-06  D. A. KEYSER -- ENCODES FOV# AS 'ACAV' INTO PREPBUFR FOR
C     GOES REPORTS
C 1998-02-17  D. A. KEYSER -- RECEIPT TIME NOW READ FROM HDR(5)
C 1998-06-15  D. A. KEYSER -- ENCODES SOLAR & IR RAD. CORRECTION
C     INDICATOR INTO PREPBUFR FILE AS MNEMONIC 'SIRC' (FOR "ADPUPA"
C     TYPES W/ VALID INSTR. TYPE)
C 1998-12-11  D. A. KEYSER -- REPLACED CALL TO "ABORT" WITH CALL TO
C     "BORT" (BUFRLIB ROUTINE)
C 1999-01-20  D. A. KEYSER -- ADDED N-LIST SWITCH "FLDMAF" WHICH CAN
C     FLAG MOISTURE DATA ON ALL LEVELS FOR USAF DROPS (IF TRUE)
C 1999-08-04  D. A. KEYSER -- REMOVED ENCODING OF 'RQM', 'DUP', 'PRG',
C     'SRC', 'RUD' AS THEY WERE ALWAYS MISSING (REANALYSIS RELATED) AND
C     WASTED LOTS OF SPACE; ADDED ENCODING OF PHASE OF FLIGHT ('POAF')
C     FOR ALL ACFT TYPES AND DEGREE OF TURBULENCE (DGOT) FOR NON-MDCRS
C     ACFT TYPES; ADDED PROCESSING OF MDCRS MOISTURE DATA BUT THEY ARE
C     FLAGGED FOR ALL REPORTS; RADIOSONDE BALLOON DRIFT LAT/LON ON EACH
C     LEVEL NOW ENCODED INTO PREPBUFR FILE WITH MNEMONICS "YDR" AND
C     "XDR"
C 2000-02-17  D. A. KEYSER -- CAN NOW PROCESS ATOVS DATA; ADDED
C     ENCODING OF NESDIS RECURSIVE FILTER FLAG ('RFFL') FOR NESDIS
C     (GOES) SATWND TYPES; UPDATED DEL-TIME ON UPPER-AIR RAOB AND PIBAL
C     LVLS (ALREADY CALC. BASED ON BALLOON DRIFT) AND ENCODED INTO
C     PREPBUFR FILE W/ MNEMONIC "HRDR"; ADDED MNEMONICS "RPT" (ORIG.
C     OBS. TIME) AND "TCOR" (IND. FOR CORRECTED OBS. TIME IN "DHR")
C     ENCODED INTO PREPBUFR FILE
C 2000-12-05  D. A. KEYSER -- NEW N-LIST SWITCH "FLACMS", WHEN TRUE
C     (DEF.) FLAGS ALL MDCRS MOISTURE DATA (WAS HARDWIRED AS FLAGGED);
C     METARS W/ MISSING WDIR & WSPD .LE. 3M/S ENCODE WSPD OBS/QM IN NEW
C     MNEM. "SOB" AND "SQM"
C 2001-04-06  D. A. KEYSER -- NOW PROCESSES SSM/I RAIN RATE UNDER R.TYP
C     150; ACCOUNTS FOR SUBR. W3UNPKB7 OUTPUTTING GOES PWATER AS AS MM
C     (PRECISE TO 10**2) RATHER THAN MM*100;  ACCOUNTS FOR SUBR.
C     IW3UNPBF OUTPUTTING SSM/I TPW IN MM (PRECISE TO 10**1) RATHER
C     THAN MM*10; FOR ALL SATELLITE TYPES EXCEPT SSM/I SUPEROBED
C     PRODUCTS, NOW ENCODES SATELLITE ID AS "SAID" IN PREPBUFR FILE;
C     ENCODES THE 4 MDCRS TURBULENCE INDECES INTO THE PREPBUFR FILE
C     UNDER MNEMONICS "TRBX10", "TRBX21", "TRBX32" AND "TRBX43";
C     ENCODES SURFACE PRESSURE INTO PREPBUFR FILE UNDER MNEMONIC "PRSS"
C     FOR GOES PW RETR. REPORTS
C 2001-06-19  D. A. KEYSER -- CAN NOW PROCESS GOES 1x1 FOV CLOUD TOP
C     REPORTS INTO PREPBUFR FILE UNDER R.T. 151 (MNEMONICS ARE "CDTP"/
C     CLOUD TOP PRESSURE, "TOCC"/CLOUD COVER, "GCDTT"/CLOUD TOP TEMP.);
C     SET GOES PW REPORT REASON CODES TO 100 (WERE MISSING); SET SSM/I
C     PW REPORT REASON CODE TO 100 (WAS MISSING); SET SSM/I RAINFALL
C     RATE REASON CODE TO 100 (WAS MISSING)
C 2001-09-14  D. A. KEYSER -- CORRECTED AN ERROR IN CALCULATING
C     RADIOSONDE BALLOON DRIFT D-TIME ("HRDR") FOR WIND REPORT
C     PRESSURE LEVELS THAT ARE ALSO FOUND IN THE CORRESPONDING MASS
C     REPORT ("HRDR" IS CALCULATED CORRECTLY FOR THE MASS REPORT LEVELS)
C 2001-10-10  D. A. KEYSER -- PROCESS NUMBER FROM THE MPI RUN (READ IN
C     VIA NAMELIST IN STDIN) ENCODED IN PREPBUFR UNDER MNEMONIC "PROCN"
C 2002-01-14  D. A. KEYSER -- LEVELS WITH REPORTED/CALC. DWPT < "TDLIM"
C     VALUE NOW CALC./RETAIN SPEC. HUM AND RETAIN/CALC. DWPT BUT
C     MOISTURE PREPBUFR TABLE VALUE IS FLAGGED WITH Q.M.=15 (BEFORE,
C     SPEC. HUM. AND DWPT HAD BEEN SET TO MISSING IN PREV. SUBROUTINES)
C 2002-01-28  D. A. KEYSER -- ENCODES PRECISION OF TEMP. OBS. INTO
C     PREPBUFR FILE UNDER MNEMONIC "PCAT" FOR MESSAGE TYPES "AIRCAR"
C     AND "AIRCFT" (ONLY AVAIL. FOR AMDAR AND MDCRS)
C 2004-09-09  D. A. KEYSER -- ADDED PROCESSING OF MESONET DATA, READ
C     FROM "MSONET" DUMP FILE DUMP R. TYPE 540, GET PREPBUFR R. TYPE
C     188/288, PROCESSED INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "MSONET"; ADDED PROCESSING OF GPS-IPW DATA, READ FROM "GPSIPW"
C     DUMP FILE DUMP R. TYPE 74, GET PREPBUFR R. TYPE 153, PROCESSED BY
C     NEW SUBR. "GETGPSIPW" INTO PREPBUFR FILE UNDER NEW TBL A ENTRY
C     "GPSIPW"; ADDED PROCESSING OF NPN AND CAP RASS DATA READ FROM
C     "RASSDA" DUMP FILE IN NEW DATA LVL CAT. 15, DUMP R. TYPE 77, GET
C     PREPBUFR R. TYPE 126, PROCESSED INTO PREPBUFR FILE UNDER NEW TBL
C     A ENTRY "RASSDA"; REPLACED CALL TO BUFRLIB ROUTINE "BORT" WITH
C     CALL TO W3LIB ROUTINE ERREXIT, WITH CONDITION CODE 59 IF THERE
C     ARE MORE THAN "MXBLVL" LEVELS IN A REPORT AT THE TIME IT IS ABOUT
C     TO BE ENCODED INTO THE PREPBUFR FILE
C 2006-07-14  D. A. KEYSER -- NO LONGER FAILS IF LIMIT OF "MXBLVL"
C     OUTPUT LEVELS IN PREPBUFR REPORT IS HIT, NOW PROCESSES BOTTOM
C     "MXBLVL" LEVELS AND SENDS DIAGNOSTIC TO JOBLOG
C 2007-09-14  D. A. KEYSER -- MODIFIED TO ENCODE NEW PARAMETERS "TRBX"
C     AND "ROLF" INTO PREPBUFR FILE FOR TAMDAR AIRCRAFT REPORTS;
C     MODIFIED TO ENCODE NEW PARAMETERS MRWVC, MRLWC, WSST, MWD10,
C     MWS10, WSEQC1, CHSQ, PHER, SPDE, SSTE, CLDE AND VPRE IN PREPBUFR
C     FILE FOR WINDSAT SCATTEROMETER REPORTS, UNDER NEW MESSAGE TYPE
C     "WDSATR"; MODIFIED TO HANDLE RETURN OF NEW ARGUMENT "RDATA2" FROM
C     CALLS TO W3UNPKB7 [1-DIM 21-WORD ARRAY WHICH HOLDS ADDITIONAL
C     VALUES DECODED DIRECTLY FROM BUFR (AND NOT IN "RDATA" ARRAY), FOR
C     SOME PARAMETERS REPLACING WHAT HAD BEEN RETURNED IN "RDATA" ARRAY
C     (IN THE HEADER)]; ADDED ENCODING OF PERCENT CONFIDENCE BASED ON -
C     EUMETSAT QUALITY INDEX WITH FORECAST CONSISTENCY TEST (MNEMONIC
C     "QIFY"), EUMETSAT QUALITY INDEX WITHOUT FORECAST CONSISTENCY TEST
C     (MNEMONIC "QIFN") AND NESDIS EXPECTED ERROR (MNEMONIC "EEQF") FOR
C     SATWND TYPES; FIXED BUG WHICH STORED BALLOON DRIFT COORDINATES
C     FROM PREVIOUS RAOB/PIBAL REPORT INTO DROPWINSONDE REPORT (DROPS
C     SHOULD HAVE MISSING BALLOON DRIFT COORDINATES); CASES WHERE OBS
C     ARE SET TO QM=15 IN ORDER TO FLAG A REPORT FOR NON-USE BY
C     ANALYSIS (EVEN THOUGH OBS MAY NOT NECESSARILY BE BAD) NOW FIRST
C     CHECK TO MAKE SURE OBS QM ISN'T ALREADY "BAD" (> 3 AND < 15)
C     (PREVENTS GSI FROM MONITORING TRULY BAD OBS WHICH JUST HAPPEN TO
C     BE IN REPORT GROUPS FLAGGED FOR NON- USE BY ANALYSIS); CHANGED
C     PROCESSING OF DROPSONDE MOISTURE: ACFT USING SWITCH "FLDMGS" (ALL
C     NOAA, INCL. P-3 AND GULF STREAM) MORE PRECISELY DEFINED TO ENSURE
C     THAT ONLY NOAA ACFT ARE AFFECTED BY THIS SWITCH, SWITCH "FLDMAF"
C     NOW REFERS EXCLUSIVELY TO USAF ACFT (HAD REFERRED TO ALL NON-NOAA
C     ACFT), NEW SWITCH "FLDMFR" REFERS TO NON-US (NON-NOAA AND NON-
C     USAF) ACFT (DEFAULTS TO TRUE - FLAG MOISTURE DATA ON ALL LEVELS)
C 2008-09-25  D. A. KEYSER -- CHANGES TO PREPBUFR ENCODING IN
C     PREPARATION FOR FUTURE DOWNSTREAM NRL AIRCRAFT Q.C. MODULE
C     (REPLACING CURRENT DOWNSTREAM PREPACQC AND ACARSQC MODULES) WHICH
C     WILL REPLICATE LEVEL DATA IN ITS GENERATION OF "PROFILES": SOME
C     MNEMONICS THAT WERE IN HEADER MOVED TO LEVEL INFO;  MOISTURE
C     QUALITY (CODE TABLE) FOR MDCRS REPORTS, ENCODED INTO PREPBUFR
C     FILE (MNEMONIC MSTQ) FOR USE BY FUTURE DOWNSTREAM NRL AIRCRAFT
C     Q.C. MODULE
C 2012-11-27  D. A. KEYSER -- INCREASED MAXIMUM POSSIBLE VALUE FOR SQN
C     (SEQUENCE NUMBER) ENCODED INTO PREPBUFR FILE FROM 99998 TO 524286
C     (NEEDED BECAUSE THERE CAN NOW BE > 99998 MDCRS REPORTS IN A
C     MONOLITHIC "AIRCAR" DUMP FILE - THIS CAUSES PREPACQC TO FAIL IN
C     SERIAL PREPBUFR PROCESSING RUNS, E.G. IN SDMEDIT)
C 2014-04-25  S. Melchior  --
C          - Modified to always encode wind speed obs in m/sec ("SOB")
C     and wind direction obs ("DDO") for all types of surface reports
C     (even if one or the other are missing but also if both are
C     present); removed old logic which encoded "SOB" only for METAR
C     reports when direction was missing and speed was .LE. 3 m/sec
C     (direction was never encoded in any situation for surface
C     reports), also removed encoding of "SQM" (wind speed quality
C     mark) for these types of METAR reports - all surface reports now
C     encode wind qm as "WQM" regardless of whether or not it also
C     encodes direction, speed, u-comp or v-comp {note this change does
C     not affect non-surface reports which can still encode speed
C     in knots ("FFO") and direction ("DDO") when "UOB" and "VOB" are
C     also encoded.
C          - Added new mnemonic "PMIN" (mean sea-level pressure
C     indicator) which is encoded with a value of zero for all surface
C     reports with an observed mean sea-level pressure encoded in
C     "PMO".  "PMIN" will be encoded with a value of 1 in w3emc routine
C     GBLEVENTS for cases where a mean sea-level pressure is derived
C     (see docblock in GBLEVENTS for more information).
C          - Report type 183 now stores moisture quality mark no lower
C     than 3 (suspect) (before type 183 stored observed moisture
C     quality mark read from the ADPSFC dump file).
C 2014-07-10  D. A. Keyser --
C          - Added encoding of "DFQ" (wind dir/speed quality mark) for
C     all types that aleady encode "DDO" (wind dir) and either "FFO"
C     (wind speed kts) or "SOB" (wind speed m/s) {"DFQ" will now be
C     encoded with overall wind quality mark in both cases when "UOB"
C     and "VOB" are encoded (then "DFQ" same as "WQM") and cases when,
C     for surface reports, "UOB" and "VOB" are not encoded because
C     either dir or speed is missing}.  Prior to this, "DFQ" was always
C     missing and the overall wind quality mark was always encoded in
C     "WQM" even when, for surface reports, "UOB" and "VOB" were
C     missing but either wind dir or speed was not.  Now, the entire
C     "W__EVENT" sequence "[UOB VOB WQM WPC WRC]" is skipped for
C     surface reports when "UOB" and "VOB" are both missing.
C          - Added encoding of "DFP" (wind dir/speed program code) for
C     surface reports in both cases when "UOB" and "VOB" are encoded
C     (then "DFP" same as "WPC") and when "UOB" and "VOB" are not
C     encoded because either dir or speed is missing.  Prior to this,
C     "DFP" was always missing in this case.
C          - Added encoding of "DFR" (wind dir/speed reason code), if
C     it is non-missing, in both cases when "UOB" and "VOB" are encoded
C     (then "DFR" same as "WRC") and cases when, for surface reports,
C     "UOB" and "VOB" are not encoded because either dir or speed is
C     missing.  Prior to this, "DFR" was always missing in either case.
C 2014-07-10  S. Melchior  -- Added logic to reset longitude to 0.0
C     when it is very close to 360.0. This ensures that array
C     clobbering will not occur if a report (with high precision
C     native lat/lon) is right at Prime Meridian.
C 2015-04-10  D. A. Keyser -- New namelist switch TDMAX, defined as the
C     upper limit for acceptable dewpoint temperature obs (the moisture
C     on any level, for any report type, with dewpoint temperature on
C     that level > TDMAX will be flagged with QM=15 here and encoded in
C     the PREPBUFR file if it is not already flagged as bad).
C 2016-08-15 JWhiting -- For all GPS data streams (i.e., NC012003-004),
C     store zenith total delay (m) and its error (m), along with
C     hardwired azimuth (0.0 deg) and elevation (90.0 deg) angles into
C     holding arrays for subsequent output.
C 2016-09-01  D. A. Keyser -- New BUFRLIB routine NEMSPECS is
C     integrated into code.
C 2016-11-25  D. A. Keyser --
C      - Encodes instantaneous altitude rate (IALR) into PREPBUFR file
C        for TAMDARB reports in report type 134/234 (returned from c.f.
C        932 in call to IW3UNPBF).
C 2016-11-30  D. A. Keyser --
C      - Diagnostic output print statements formatted to accommodate
C        increased precision now in latitude and longitude.
C         - Replace machine length lat/lon {HDR(3), HDR(2)} with R*8
C           lat/lon (ALAT_8, ALON_8) in print statements.
C        BENEFIT: Values are now precise to 10**5 degrees.
C
C USAGE:    CALL FIZZ01(KI,NI,JI,SUBSET,SINGLE)
C   INPUT ARGUMENT LIST:
C     KI       - HUNDRED'S DIGIT OF RPT'S PREPBUFR REPORT TYPE (1-2)
C     NI       - TEN'S  DIGIT OF REPORT'S PREPBUFR REPORT TYPE (0-9)
C     JI       - UNIT'S DIGIT OF REPORT'S PREPBUFR REPORT TYPE (0-9)
C     SUBSET   - CHARACTER*8 TABLE A ENTRY (MESSAGE TYPE) FOR THIS
C              - PARTICULAR REPORT
C     SINGLE   - LOGICAL SWITCH DEFINING WHETHER THIS TABLE A ENTRY
C              - (MESSAGE TYPE) IS SINGLE-LEVEL
C
C REMARKS: CALLED BY SUBROUTINE W3FIZZ.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      SUBROUTINE FIZZ01(KI,NI,JI,SUBSET,SINGLE)

      PARAMETER (MXWRDH = 15)
      PARAMETER (MXTYPV =  3)
      PARAMETER (MXWRDL =  6)
      PARAMETER (MXLVL = 600)
      PARAMETER (MXPWT =  5)
      PARAMETER (MXBLVL = 255, MHDRWD = 29, MOBSWD = 12, MOB2WD = 6)
      PARAMETER (MQMSWD =  9)
      PARAMETER (MPGMWD =  9)
      PARAMETER (MAXOBS = 4500)

      DIMENSION IPWOBT(2:5),IPWQMT(2:5),IPWPCT(2:5)

      LOGICAL  CAT6,OUT,SINGLE,LMAND(0:1200),TOVRAD,FLAGM1,FLAGM2,
     $ FLAGM3,FLAGM4,FLAGM5,FLAGM6,FLDMGS,FLDMAF,FLDMFR,FLACMS,GOESRD,
     $ FLRECO

      REAL(8)  BMISS,alon_8,alat_8,hdr_8

      INTEGER  IDATA(MAXOBS)

      CHARACTER*5  CMXBLVL
      CHARACTER*8  SUBSET,STNID,SUBSET_d

      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/STRCTY/ICAT(MXLVL)
      COMMON/STRMOB/MOBS(MXTYPV,MXWRDL,MXLVL)
      COMMON/STRMSL/IPMSL(MXTYPV)
      COMMON/STRPWT/PWAT(MXTYPV,MXPWT)
      COMMON/STRRRT/REQV
      COMMON/FIZZAA/IPCODE,IUNITP,NLV,NBT,HDR_8(MHDRWD),
     $ OBS(MOBSWD,MXBLVL),OB2(MOB2WD,MXBLVL),QMS(MQMSWD,MXBLVL),
     $ PGM(MPGMWD,MXBLVL),RSN(MPGMWD,MXBLVL),BTO(2,MXBLVL),RAD(5),
     $ IUNITG(2)
      COMMON/RPTHDR/SUBSET_d,STNID,HDR(2:MXWRDH),alon_8,alat_8
      COMMON/LEVELS/MLEV
      COMMON/PARM3/RECCON,RWINDO,UWINDO,RECSLM,FLRECO,VWINDO,VADWIN,
     $ IVADFL,IVADSP,FLDMGS,FLDMAF,FLDMFR,DROPSN,DWINDO,UPRAIR
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/CLDTOP/CLTOP(2,3)
      COMMON/ACFTSW/AWINDO(2,9),AIRLND(6,9),JAWIND(6,9),JAMASS(6,9),
     $ IACFTL(9),IACFTH(9),PHIACF(7),KEPAC(6,9),AIFNOW(9),POAF,TRBX(5),
     $ FLACMS(9),PCAT,ROLF,aMSTQ,RIALR
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      COMMON/MISWCH/XWINDO(6,4),JPSSMI(6,4),SRAD(7),KNTSMI(4),KTIMM(4),
     $ KSKPMI,KMSGMI,KBDYMI
      COMMON/SFCBFR/ALTIMR,PRSS
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/DRIFT/DFTLON(MXLVL),DFTLAT(MXLVL),DFTTIM(MXLVL)
      COMMON/DATA/KOUNT,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON /BUFRLIB_MISSING/BMISS

      EQUIVALENCE  (RDATA,IDATA)

      DATA  YMISS/99998.8/,IPWOBT/2,3,10,11/,IPWQMT/2,6,7,8/,
     $ IPWPCT/3,4,7,8/,IMISS/99999/
      DATA  LMAND/.FALSE.,3*.TRUE.,.FALSE.,.TRUE.,.FALSE.,.TRUE.,
     $ 2*.FALSE.,.TRUE.,9*.FALSE.,.TRUE.,9*.FALSE.,.TRUE.,19*.FALSE.,
     $ .TRUE.,19*.FALSE.,.TRUE.,29*.FALSE.,.TRUE.,49*.FALSE.,.TRUE.,
     $ 49*.FALSE.,.TRUE.,49*.FALSE.,.TRUE.,49*.FALSE.,.TRUE.,99*.FALSE.,
     $ .TRUE.,99*.FALSE.,.TRUE.,199*.FALSE.,.TRUE.,149*.FALSE.,.TRUE.,
     $ 74*.FALSE.,.TRUE.,74*.FALSE.,.TRUE.,200*.FALSE./

      CAT6 = (SUBSET(1:3).EQ.'AIR'.OR.SUBSET.EQ.'SATWND  ')

C INITIALIZE ARRAYS AS MISSING (BMISS), NUMBER OF LEVELS AS ZERO
      HDR_8  = BMISS
      OBS  = BMISS
      OB2  = BMISS
      QMS  = BMISS
      PGM  = BMISS
      RSN  = BMISS
      BTO  = BMISS
      RAD  = BMISS
      PSFC = BMISS
      NLV  = 0
      NBT  = 0

C STORE THE LON, LAT, REPORT D-TIME, PREPBUFR R. TYPE, DUMP R. TYPE,
C  REPORT SUBTYPE, INSTRUMENT TYPE, ELEVATION, REPORT SEQUENCE NUMBER,
C  SOLAR AND INFRARED RADIATION CORRECTION INDICATOR, NESDIS RECURSIVE
C  FILTER FLAG {NUMERIC (SUBSET=SATWND ONLY)}, REPORTED OBSERVATION
C  TIME, INDICATOR FOR CORRECTED OBSERVATION TIME, SATELLITE ID
C  (SATELLITE DATA TYPES ONLY), PROCESS NUMBER FOR THIS MPI RUN,
C  {"HDR_8" WORDS 2-29 (NOTE: SOME WORDS HERE ARE SKIPPED)}

C If reported lon is 360. (to PREPBUFR table precision), change it
C  to 0. . {Note: prior to BUFRLIB v11.0.0, the scaling for XOB in
C  the PREPBUFR table was 2 (0.01 precision), so this will be the
C  default - beginning with BUFRLIB v11.0.0 the scale in the PREPBUFR
C  table will be determined via a call to BUFRLIB routine NEMSPECS
C  (will allow for future increases in precision)}

      NSCL0 = 2
      call NEMSPECS(iunitp,'XOB',1,NSCL, NREF, NBTS, IRET)
      if(IRET.eq.0)  NSCL0 = NSCL
      IF(NINT(alon_8*10**NSCL0).EQ.360*10**NSCL0) alon_8 = 0.0
      HDR_8(2) = alon_8
      HDR_8(3) = alat_8
      HDR_8(4) = HDR(4)
      IF(SUBSET.EQ.'SATWND  ')  THEN
C FOR SUBSET = SATWND .....
         IF(RFFL.LT.YMISS)  HDR_8(16) = RFFL
         IF(QIFY.LT.YMISS)  HDR_8(27) = QIFY
         IF(QIFN.LT.YMISS)  HDR_8(28) = QIFN
         IF(EEQF.LT.YMISS)  HDR_8(29) = EEQF
      END IF
      HDR_8(6) = HDR(6)
      HDR_8(7) = HDR(7)
      IF(HDR(8).LT.YMISS)  HDR_8(8) = HDR(8)
      HDR_8(9) = HDR(9)
      IF(HDR(10).LT.YMISS)  HDR_8(10) = HDR(10)
ccdak IF(HDR(11).LT.YMISS)  HDR_8(11) = HDR(11)
                                       !SQN can now be > XMISS (99999.)
      IF(HDR(11).LT.YMISS*10.) HDR_8(11)= HDR(11)
      IF(HDR(12).LT.YMISS)  HDR_8(12) = HDR(12)
      HDR_8(17) = HDR(13)
      HDR_8(18) = HDR(14)
      IF(HDR(15).LT.YMISS)  HDR_8(21) = HDR(15)
      HDR_8(22) = MP_PROCESS

      IF(HDR(6).GT.151.AND.HDR(6).LT.160)  THEN
C***********************************************************************
C          PRECIPITABLE WATER & ZENITH TOTAL DELAY (LATTER GPS ONLY)
C                           PROCESSING COMES HERE
C   UNIQUE REPORTS - NOTHING ELSE WILL BE ENCODED INTO PREPBUFR FILE
C***********************************************************************
C STORE PRECIPITABLE WATER OBS., TABLE VALUE, PROGRAM CODE & REASON CODE
C DATA LEVEL CATEGORY IS STORED AS 6 (NOT DEFINED IN ICAT ARRAY)
         OBS(7,1) = 6
         IF(HDR(6).EQ.152.OR.HDR(6).EQ.153)  THEN
C   --> SSM/I OR GPS-IPW TOTAL COLUMN
            IF(PWAT(1,1).LT.YMISS.AND.NINT(PWAT(1,1)*10.).GE.0)  THEN
               OBS(12,1) = PWAT(1,1)
               QMS(6,1)  = MIN(15,NINT(PWAT(2,1)))
               PGM(7,1)  = IPCODE
               RSN(7,1)  = 100.
               NLV = 1
               IF(HDR(6).EQ.153.AND.PRSS.LT.YMISS) OBS(11,1) =PRSS*100.
            END IF

            IF(HDR(6).EQ.153)  THEN
C FOR GPS-IPW/ZTD REPORTS, STORE NON-MISSING ATMOSPHERIC PATH DELAY IN
C  SATELLITE SIGNAL (M) AND ITS ERROR (M) (from ZTD and Error in ZTD
C  previously read into cat 14 rdata array slots  5 & 6), ALONG WITH
C  HARDWIRED AZIMUTH ANGLE OF 0.0 (DEG) AND ELEVATION ANGLE OF 90.0
C  (DEG) - THESE WILL LATER BE OUTPUT IN SUBR. W3FIZZ
               LL=idata(44)
               if(idata(43).gt.0)  then
                  if (rdata(LL+4).lt.ymiss) then
                     ob2(3,1)=rdata(LL+4)                          !APDS
                     if (rdata(LL+5).lt.ymiss) ob2(4,1)=rdata(LL+5)!APDE
                     ob2(1,1) =  0.0                               !BEARAZ
                     ob2(2,1) = 90.0                               !ELEV
                  end if
               end if
            end if ! hdr(6) == 153
         ELSE
C   --> GOES SIGMA LAYER (1. TO .9, .9 TO .7, .7 TO .3, AND .3 TO 0.)
            DO IPWTYP = 2,5
               IF(PWAT(1,IPWTYP).LT.YMISS.AND.NINT(PWAT(1,IPWTYP)*10.)
     $          .GE.0)  THEN
                  OBS(IPWOBT(IPWTYP),1) = PWAT(1,IPWTYP)
                  QMS(IPWQMT(IPWTYP),1) = MIN(15,NINT(PWAT(2,IPWTYP)))
                  PGM(IPWPCT(IPWTYP),1) = IPCODE
                  RSN(IPWPCT(IPWTYP),1) = 100.
                  NLV = 1
               END IF
            ENDDO
            IF(PRSS.LT.YMISS)  OBS(12,1) = PRSS * 100.
         END IF

      ELSE  IF(HDR(6).EQ.150)  THEN
C***********************************************************************
C                SSM/I RAIN RATE PROCESSING COMES HERE
C    UNIQUE REPORTS - NOTHING ELSE WILL BE ENCODED INTO PREPBUFR FILE
C                (CAN NEVER BE MISSING FOR R.TYPE 150)
C***********************************************************************
C DATA LEVEL CATEGORY IS STORED AS 6 (NOT DEFINED IN ICAT ARRAY)
         OBS(7,1) = 6
C STORE RAIN RATE OBS., TABLE VALUE, PROGRAM CODE AND REASON CODE
         OB2(1,1) = REQV
         QMS(7,1) = 2
         PGM(8,1) = IPCODE
         RSN(8,1)  = 100.
         NLV = 1

      ELSE  IF(HDR(6).EQ.151)  THEN
C***********************************************************************
C                GOES CLOUD TOP PROCESSING COMES HERE
C    UNIQUE REPORTS - NOTHING ELSE WILL BE ENCODED INTO PREPBUFR FILE
C        (CLOUD TOP PRESSURE CAN NEVER BE MISSING FOR R.TYPE 151)
C***********************************************************************
C DATA LEVEL CATEGORY IS STORED AS 6 (NOT DEFINED IN ICAT ARRAY)
         OBS(7,1) = 6
C STORE CLOUD TOP PRESSURE OBS., TABLE VALUE, PROGRAM CODE & REASON CODE
         OB2(1,1) = CLTOP(1,1) * 100.
         QMS(9,1)  = MIN(15,NINT(CLTOP(2,1)))
         PGM(9,1)  = IPCODE
         RSN(9,1)  = 100.
C STORE TOTAL CLOUD COVER OBS. AND CLOUD TOP TEMPERATURE OBS. (THESE
C  CAN BE MISSING)
         IF(CLTOP(1,2).LT.YMISS)  OB2(2,1) = CLTOP(1,2)
         IF(CLTOP(1,3).LT.YMISS)  OB2(3,1) = CLTOP(1,3)
         NLV = 1

      ELSE  IF(HDR(6).EQ.102)  THEN
C***********************************************************************
C          STORE SSM/I BRIGHTNESS TEMPERATURE FOR SEVEN CHANNELS
C    UNIQUE REPORTS - NOTHING ELSE WILL BE ENCODED INTO PREPBUFR FILE
C***********************************************************************
         IRFLG = 0
         DO LL = 1,7
            NBT = NBT + 1
            BTO(1,NBT) = LL
            IF(SRAD(LL).LT.YMISS)  THEN
               BTO(2,NBT) = SRAD(LL)
               IRFLG = 1
            END IF
         ENDDO
         IF(IRFLG.EQ.0)  NBT = 0

      ELSE
C***********************************************************************
C                     EVERYTHING ELSE COMES HERE
C (INCLUDING TRADITIONAL DATA STORED IN MOBS ARRAY, PLUS RTOVS OR ATOVS)
C                     RADIANCES, GOES RADIANCES)
C***********************************************************************
C-----------------------------------------------------------------------
C  MLEV = 0 MEANS THERE ARE NO DATA IN THE MOBS ARRAY FOR THIS REPORT
C THIS REPORT IS PROBABLY A RADIANCE REPORT, EITHER RTOVS, ATOVS OR GOES
C-----------------------------------------------------------------------
C   MLEV > 0 MEANS THERE ARE DATA IN THE MOBS ARRAY FOR THIS REPORT
C  THERE MAY ALSO BE RADIANCES FOR THIS REPORT IF IT IS AN RTOVS, ATOVS
C      OR GOES REPORT (THE SOUNDINGS AND RADIANCES ARE COMBINED
C       AS A SINGLE REPORT WITH A COMMON PREPBUFR REPORT TYPE)
C-----------------------------------------------------------------------
         IF(MLEV.EQ.0)  GO TO 111
C-----------------------------------------------------------------------
C    LOOP THRU ALL LEVELS OF OBSERVATION - STORE APPROPRIATE DATA
C     (DOESN'T INCLUDE RTOVS, ATOVS AND GOES RADIANCE OBS- LATER)
C-----------------------------------------------------------------------
         IFRST1 = 1
         IFRST2 = 1
         IFRST3 = 1
         DO L = 1,MLEV
C PARSE OUT DATA IN MOBS ARRAY FOR THIS LEVEL
            OBS1 = MOBS(1,1,L)
C IF PRESSURE ON THIS LEVEL IS MISSING, SKIP THIS LEVEL
            IF(OBS1.GE.YMISS)  CYCLE
            QMS1 = MIN(15,MOBS(2,1,L))
            RSN1 = MOBS(3,1,L)
            OBS2 = MOBS(1,2,L)
            QMS2 = MIN(15,MOBS(2,2,L))
            RSN2 = MOBS(3,2,L)
            OBS3 = MOBS(1,3,L)
            QMS3 = MIN(15,MOBS(2,3,L))
            RSN3 = MOBS(3,3,L)
            OBS4 = MOBS(1,4,L)
            QMS4 = MIN(15,MOBS(2,4,L))
            RSN4 = MOBS(3,4,L)
            OBS5 = MOBS(1,5,L)
            OBS6 = MOBS(1,6,L)
C OUT=.TRUE. --> NO VALID DATA ON THIS LEVEL
            OUT = (MIN(OBS2,OBS3,OBS4,OBS5,OBS6).GE.YMISS)
            IF(L.EQ.1)  THEN

C --> PROCESSING UNIQUE TO FIRST MOBS LEVEL

               IF(IPMSL(1).LT.YMISS)  THEN
C STORE MEAN SEA-LEVEL PRESSURE OBS., TABLE VALUE, and indicator
C  {CURRENTLY IPMSL(1) VALID ONLY FOR SURFACE MASS REPORTS}
                  OB2(1,1) = IPMSL(1) * 0.1
                  QMS(7,1)  = MIN(15,IPMSL(2))
                  ob2(3,1) = 0.! indicator (PMIN) is 0 for observed PMSL
               END IF
               IF(MOBS(2,1,1).EQ.99.OR.NI.GE.8)  THEN
C RAOB, PIBAL, MULTI-LEVEL RECCOS, DROPS, CLASS, PROFILER, VAD WINDS,
C  RASS, ALL SAT. RETR. TYPES & ALL SFC TYPES HOLD SURFACE (STN)
C  PRESSURE IN FIRST LVL
                  PSFC = OBS1
               ELSE  IF((FLRECO.AND.ICAT(1).EQ.2).AND.SUBSET.EQ.
     $          'ADPUPA  ')  THEN
C RECCOS WITH PMSL OBS ALSO HOLD SFC PRESSURE IN FIRST LVL
                  PSFC = OBS1
               END IF
            END IF

C IF NO VALID DATA ON THIS LEVEL, GO ON TO NEXT LEVEL
            IF(OUT)  CYCLE

            IF(NLV+1.LE.MXBLVL) THEN
               NLV = NLV + 1
C.......................................................................
C STORE LEVEL PRESSURE OBS, TABLE VALUE, PROGRAM CODE AND REASON CODE
C If ipstnflg=0, Pstn (OBS1) was never manipulated so encode original/
C current value. If ipstnflg=1, Pstn was estimated for surface reports
C with missing pressure that are set to be kept (npkrpt=T for the
C particular type) - this pstn is also encoded (q.m. is minimum of 3)
C (Note: ipstnflg is not passed into this subroutine as it is not used)
               OBS(1,NLV) = OBS1 * 0.1
               QMS(1,NLV) = QMS1
               PGM(1,NLV) = IPCODE
               IF(RSN1.LT.YMISS)  RSN(1,NLV) = RSN1
C DATA LEVEL CATEGORY PROCESSING
               IF(.NOT.SINGLE)  THEN
C FOR SINGLE = FALSE, THE DEFAULT DATA LEVEL CATEGORY IS SET TO 2
                  OBS(7,NLV) = 2
               ELSE
C FOR SINGLE = TRUE, THE DEFAULT DATA LEVEL CATEGORY IS SET TO 6
                  OBS(7,NLV) = 6
               END IF
               IF(ICAT(L).LT.IMISS)  THEN
C FOR THOSE TYPES WITH A VALID DATA LEVEL CATEGORY IN ICAT ARRAY
C  (SUBSET = PROFLR, ADPUPA, VADWND, RASSDA, AIRCAR, AIRCFT OR SATWND)
C  STORE THIS DIRECTLY
                  OBS(7,NLV) = ICAT(L)
               ELSE  IF(SUBSET.EQ.'SATEMP  '.OR.SUBSET.EQ.'GOESND  ')
     $          THEN
C FOR SUBSET = SATEMP OR GOESND - IF PRESSURE IS MAND SET CAT. TO 1
                  IF(MOD(MOBS(1,1,L),10).EQ.0)  THEN
                     IF(LMAND(MOBS(1,1,L)/10))  OBS(7,NLV) = 1
                  END IF
               END IF
C.......................................................................
               IF(SUBSET.EQ.'ADPSFC  '.OR.SUBSET.EQ.'MSONET  ')  THEN
C FOR SUBSET = ADPSFC OR MSONET, STORE ALTIMETER SETTING OBS. IF NON-
C  MISSING
                  IF(ALTIMR.LT.YMISS)  OB2(2,NLV) = ALTIMR * 10.
               ELSE  IF(HDR(6).EQ.120.OR.HDR(6).EQ.220.OR.
     $                  HDR(6).EQ.221)  THEN
C FOR REPORT TYPES 120, 220 OR 221 (IN SUBSET = ADPUPA), STORE RAOB/
C  PIBAL BALLOON DRIFT LAT/LON AND TIME OBS. IF NON-MISSING
                  IF(MAX(DFTLON(L),DFTLAT(L)).LT.YMISS) THEN
                     OBS(12,NLV) = DFTLON(L)
                     OB2( 1,NLV) = DFTLAT(L)
                     IF(DFTTIM(L).LT.YMISS)  THEN
                        D_DFTTIM = DFTTIM(L) - IDATE(4)
                        IF(D_DFTTIM.GT. 12.)  D_DFTTIM = D_DFTTIM - 24.
                        IF(D_DFTTIM.LT.-12.)  D_DFTTIM = D_DFTTIM + 24.
                        OB2(2,NLV) = D_DFTTIM
                     END IF
                  END IF
               ELSE IF(SUBSET.EQ.'AIRCFT  '.OR.SUBSET.EQ.'AIRCAR  ')THEN
C FOR SUBSET = AIRCFT or AIRCAR, STORE PHASE OF FLIGHT (NUMERIC) AND
C  PRECISION OF TEMPERATURE OBSERVATION, IF NON-MISSING
                  IF(POAF.LT.YMISS)  OB2(2,NLV) = POAF
                  IF(PCAT.LT.YMISS)  OB2(3,NLV) = PCAT
                  IF(SUBSET.EQ.'AIRCFT  ')  THEN
C FOR SUBSET = AIRCFT, STORE THE RECEIPT TIME (HOURS), ROLL FLAG
C  (NUMERIC), TURBULENCE INDEX (NUMERIC), INSTANTANEOUS ALTITUDE RATE IF
C  NON-MISSING
                     IF(HDR(5).LT.YMISS)  OBS(12,NLV) = HDR(5)
                     IF(ROLF.LT.YMISS)     OB2( 1,NLV) = ROLF
                     IF(TRBX(5).LT.YMISS)  OB2( 4,NLV) = TRBX(5)
                     IF(RIALR.LT.YMISS)    OB2( 5,NLV) = RIALR
                  ELSE
C FOR SUBSET = AIRCAR, STORE TURBULENCE INDEX-TIME BASED (NUMERIC) AND
C  MOISTURE QUALITY (CODE TABLE)
                     IF(TRBX(1).LT.YMISS)  OBS(12,NLV) = TRBX(1)
                     IF(TRBX(2).LT.YMISS)  OB2( 1,NLV) = TRBX(2)
                     IF(TRBX(3).LT.YMISS)  OB2( 4,NLV) = TRBX(3)
                     IF(TRBX(4).LT.YMISS)  OB2( 5,NLV) = TRBX(4)
                     IF(aMSTQ  .LT.YMISS)  OB2( 6,NLV) = aMSTQ
                  END IF
               END IF
               IF(KI.EQ.2)  THEN
C-----------------------------------------------------------------------
C                    WIND PROCESSING COMES HERE
C-----------------------------------------------------------------------
                  IF(RSN3.NE.RSN4)  THEN
      PRINT'(" ~~ R.C. FOR U- AND V- WIND DO NOT AGREE FOR THIS STN -",
     $ " USE LOWER OF 2 R.C. FOR WIND R.C. IN PREPBUFR FILE")'
                     RSN4 = MIN(RSN3,RSN4)
                  END IF
                  IF(MAX(OBS3,OBS4).LT.YMISS) THEN
C STORE U- & V-COMP OBS; WIND TABLE VALUE, PROGRAM CODE AND REASON CODE
                     OBS(2,NLV) = OBS3 * .01
                     OBS(3,NLV) = OBS4 * .01
                     IF(QMS3.NE.QMS4)  THEN
      PRINT'(" ~~ Q.M. FOR U- AND V- WIND DO NOT AGREE FOR THIS STN -",
     $ " USE HIGHER OF 2 Q.M. FOR WIND Q.M. IN PREPBUFR FILE")'
                        QMS4 = MAX(QMS3,QMS4)
                     END IF
                     QMS(2,NLV) = QMS4
                     PGM(3,NLV) = IPCODE
                     IF(RSN4.LT.YMISS)  RSN(3,NLV) = RSN4
C.......................................................................
                     if(subset.ne.'ADPSFC'.and.subset.ne.'SFCSHP'.and.
     $                  subset.ne.'MSONET') then
                        IF(MAX(OBS5,OBS6).LT.YMISS) THEN
C For non-surface reports, STORE WIND DIRECTION AND SPEED (KNOTS) OBS
C  if BOTH are present - also store WIND direction/speed PROGRAM CODE
C  (note: this can only happen if u-comp and v-comp wind obs are also
C         BOTH present)
                           OBS(10,NLV) = OBS5
                           OBS(11,NLV) = OBS6
                           qms(8,nlv)  = qms4
                           PGM(4,NLV)  = IPCODE
                           if(rsn4.lt.ymiss)  rsn(4,nlv) = rsn4
                        END IF
                     end if
C.......................................................................
                     IF(OBS2.LT.YMISS)  THEN
C IF SUBSET = AIRCAR, AIRCFT, OR SATWND (CAT. 6 LVLS) OR IF A CAT. 4
C  LVL (SUBSET = ADPUPA, PROFLR, OR VADWND) OR A CAT. 6 LVL (SUBSET
C  = ADPUPA FOR RECCOS), STORE PRESS-ALT. OBS, TABLE VALUE, PROGRAM CODE
C  AND REASON CODE
                        IF(CAT6.OR.OBS(7,NLV).EQ.4.OR.OBS(7,NLV).EQ.6)
     $                   THEN
C May need to fix above to next line after testing????
cdak                    IF(CAT6.OR.OBS(7,NLV).EQ.4.OR.(.NOT..SINGLE.AND.
cdak $                   OBS(7,NLV).EQ.6) THEN
                           OBS(6,NLV) = OBS2
                           QMS(5,NLV) = QMS2
                           PGM(2,NLV) = IPCODE
                           IF(RSN2.LT.YMISS)  RSN(2,NLV) = RSN2
                        END IF
                     END IF
C.......................................................................
C FOR SUBSET = WDSATR, STORE RAIN RATE (MM/SEC) OBS
C.......................................................................
                     IF(SUBSET.EQ.'WDSATR  ')  OB2(1,NLV) = REQV
                  end if
                  if(subset.eq.'ADPSFC'.or.subset.eq.'SFCSHP'.or.
     $                  subset.eq.'MSONET') then
                     if(obs5.lt.ymiss)  then
C.......................................................................
C For surface reports, store wind direction obs if present (note: this
C  can happen even if u-comp wind, v-comp wind and/or wind speed obs
C  are missing) - also store wind table value in case not stored above
C.......................................................................
                        obs(10,nlv) = obs5
                        qms(8,nlv)  = qms4
                        pgm(4,nlv)  = Ipcode
                        if(rsn4.lt.ymiss)  rsn(4,nlv) = rsn4
                     end if
                     if(obs6.lt.ymiss)  then
C.......................................................................
C For surface reports, store wind speed obs (m/sec) if present (note:
C  this can happen even if u-comp wind, v-comp wind and/or wind
C  direction obs are missing) - also store wind table value in case not
C  stored above
C.......................................................................
                        obs(11,nlv) = obs6 * 0.1
                        qms(8,nlv)  = qms4
                        pgm(4,nlv)  = Ipcode
                        if(rsn4.lt.ymiss)  rsn(4,nlv) = rsn4
                     end if
                  end if
               ELSE  IF(KI.EQ.1)  THEN
C-----------------------------------------------------------------------
C                    MASS PROCESSING COMES HERE
C-----------------------------------------------------------------------
C IF PRESSURE ON THIS LEVEL MATCHES VALUE STORED EARLIER IN "PSFC", SET
C  DATA LEVEL CATEGORY TO ZERO TO IDENTIFY THIS LEVEL AS THE SURFACE
                  IF(NINT(PSFC).EQ.NINT(OBS1))  OBS(7,NLV) = 0
C.......................................................................
                  IF(OBS2.LT.YMISS) THEN
C STORE GEOPOTENTIAL OBS, TABLE VALUE, PROGRAM CODE AND REASON CODE
                     OBS(6,NLV) = OBS2
                     QMS(5,NLV) = QMS2
                     PGM(2,NLV) = IPCODE
                     IF(RSN2.LT.YMISS)  RSN(2,NLV) = RSN2
                  END IF
C NO OTHER DATA IS PROCESSED FOR SUBSET = SFCBOG
                  IF(SUBSET.EQ.'SFCBOG  ')  CYCLE
C.......................................................................
                  IF(OBS3.LT.YMISS) THEN
C STORE REPORTED TEMPERATURE OBS, TABLE VALUE, PGM CODE AND REASON CODE
                     OBS(4,NLV) = OBS3 * .01
                     QMS(3,NLV) = QMS3
                     PGM(5,NLV) = IPCODE
                     IF(RSN3.LT.YMISS)  RSN(5,NLV) = RSN3
                  END IF
C.......................................................................
C STORE VIRTUAL TEMPERATURE OBS
                  IF(OBS5.LT.YMISS)  OBS(8,NLV) = OBS5 * .01
C NO OTHER DATA IS PROCESSED FOR SUBSET = SATWND OR RASSDA
                  IF((CAT6.AND.SUBSET.NE.'AIRCAR  '.AND.SUBSET.NE.
     $             'AIRCFT  ').OR.SUBSET.EQ.'RASSDA  ')  CYCLE
C.......................................................................
C STORE DEWPOINT TEMPERATURE OBSERVATION
                  FLAGM4 = .FALSE.
                  FLAGM6 = .FALSE.
                  IF(OBS6.LT.YMISS)  THEN
                     OBS(9,NLV) = OBS6 * .01
                     FLAGM4 = (OBS(9,NLV)+273.16.LT.TDLIM)
                     FLAGM6 = (OBS(9,NLV)+273.16.GT.TDMAX)
                  END IF
C.......................................................................
                  IF(OBS4.LT.YMISS)  THEN
C STORE SPECIFIC HUMIDITY OBS, TABLE VALUE PROGRAM CODE AND REASON CODE
C  (NOTE: IN SUBR. STOROB, ALL TYPES EXCEPT 40-LEVEL RTOVS, ATOVS AND
C         GOES SAT. SOUNDINGS COPY SPEC. HUM. TABLE VALUE FROM TEMP)
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
                     FLAGM1 = .FALSE.
                     FLAGM2 = .FALSE.
                     FLAGM3 = .FALSE.
                     FLAGM5 = .FALSE.
                     IF(HDR(6).EQ.132)  THEN
                        IF(IDATA(10).EQ.2)  THEN
                           IF(STNID(1:2).EQ.'AA'.AND.
     $                        STNID(6:8).EQ.'A  ')  THEN
                              IF((STNID(3:3).GE.'2'.AND.
     $                            STNID(3:3).LE.'4').OR.
     $                           STNID(3:3).EQ.'9') THEN
C  ... NOAA P-3 (NOAA2:"AA2xxA  ", NOAA3:"AA3xxA  ",
C                future NOAA4:"AA4xxA  ") or
C      NOAA Gulf Stream (G-IV) (NOAA9:"AA9xxA  ") DROPS COME HERE
                                 FLAGM1 = (FLDMGS)
                              END IF
                           ELSE IF((STNID(1:1).GE.'0'.AND.
     $                              STNID(1:1).LE.'9').AND.
     $                             STNID(6:8).EQ.'A  ')  THEN
                              IF((STNID(2:2).GE.'0'.AND.
     $                            STNID(2:2).LE.'9').AND.
     $                           (STNID(3:3).GE.'0'.AND.
     $                            STNID(3:3).LE.'9'))  THEN

C  ... USAF ("nnnxxA  ") DROPS COME HERE
                                 FLAGM2 = (FLDMAF)
                              END IF
                           ELSE
C  ... NON-US OR UNKNOWN (UK:"xxxxAUK", OTHERS:"DRP99A  ") DROPS COME
C      HERE
                              FLAGM5 = (FLDMFR)
                           END IF
                        END IF
                     ELSE  IF(HDR(6).EQ.133)  THEN
                        FLAGM3 = (FLACMS(4))
                     ELSE  IF(HDR(6).EQ.134)  THEN
                        FLAGM3 = (FLACMS(5))
                     END IF
                     IF(FLAGM1.OR.FLAGM2.OR.FLAGM5)   THEN
C IF FLDMGS=T, NOAA (P-3 OR GULF STREAM) DROPS GET MOISTURE FLAGGED ON
C  ALL LEVELS
C IF FLDMAF=T, USAF DROPS GET MOISTURE FLAGGED ON ALL LEVELS
C IF FLDMFR=T, NON-US OR UNKNOWN DROPS GET MOISTURE FLAGGED ON ALL LVLS
                        IF(QMS4.LE.3.OR.QMS4.GT.15) QMS4 = 15
                        IF(FLAGM1)  THEN
                           IF(IFRST1.EQ.1)
     $                     PRINT 213,STNID,alat_8,alon_8,NINT(HDR(6))
  213 FORMAT(' + + ALL Q LVLS FLAGGED   -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - NOAA (P-3 OR GULF STREAM) ',
     $ 'DROPWINSONDE')
                           IFRST1 = 0
                        ELSE  IF(FLAGM2)  THEN
                           IF(IFRST2.EQ.1)
     $                     PRINT 293,STNID,alat_8,alon_8,NINT(HDR(6))
  293 FORMAT(' + + ALL Q LVLS FLAGGED   -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - USAF DROPWINSONDE')
                           IFRST2 = 0
                        ELSE  IF(FLAGM5)  THEN
                           IF(IFRST3.EQ.1)
     $                     PRINT 294,STNID,alat_8,alon_8,NINT(HDR(6))
  294 FORMAT(' + + ALL Q LVLS FLAGGED   -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - NON-US OR UNKNOWN DROPWINSONDE')
                           IFRST3 = 0
                        END IF
                     ELSE  IF(FLAGM3)  THEN
C IF FLACMS(X)=T, AIRCRAFT REPORT (OF TYPE X, SEE NAC IN SUBR. GETC06)
C  GET MOISTURE FLAGGED
                        IF(QMS4.LE.3.OR.QMS4.GT.15) QMS4 = 15
                        PRINT 8213, STNID,alat_8,alon_8,NINT(HDR(6))
 8213 FORMAT(' + + SP. HUMIDITY FLAGGED -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,' - AIRCRAFT')
                     ELSE  IF(FLAGM4)  THEN
C IF DEWPOINT (K) .LT. TDLIM, MOISTURE FLAGGED FOR ALL DATA TYPES
                        IF(QMS4.LE.3.OR.QMS4.GT.15) THEN
                           QMS4 = 15
                           IF(SUBSET.NE.'ADPUPA  ')  PRINT 8214, STNID,
     $                      alat_8,alon_8,NINT(HDR(6)),OBS1*0.1,
     $                      OBS(9,NLV)+273.16,TDLIM
                        END IF

 8214 FORMAT(' + + SP. HUMIDITY FLAGGED -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,', PRES=',F7.2,'MB - TD (',F5.1,') <',
     $ ' TDLIM (',F5.1,')')
                     ELSE  IF(FLAGM6)  THEN
C IF DEWPOINT (K) .GT. TDMAX, MOISTURE FLAGGED FOR ALL DATA TYPES
                        IF(QMS4.LE.3.OR.QMS4.GT.15) THEN
                           QMS4 = 15
                           PRINT 8215, STNID,alat_8,alon_8,
     $                      NINT(HDR(6)),OBS1*0.1,OBS(9,NLV)+273.16,
     $                      TDMAX
                        END IF
 8215 FORMAT(' + + SP. HUMIDITY FLAGGED -ID=',A8,', LAT=',F10.5,'N, ',
     $ 'LON=',F11.5,'E, RTYP',I4,', PRES=',F7.2,'MB - TD (',F5.1,') >',
     $ ' TDMAX (',F5.1,')')
                     END IF
C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
                     OBS(5,NLV) = OBS4
                     QMS(4,NLV) = QMS4
                     PGM(6,NLV) = IPCODE
                     IF(RSN4.LT.YMISS)  RSN(6,NLV) = RSN4
                  END IF
               END IF
            ELSE
C TOO MANY REPORT LEVELS -- PROCESS WHAT YOU HAVE, PRINT DIAGNOSTIC AND
C   MOVE ON TO NEXT REPORT
               PRINT 102, MXBLVL,STNID,MXBLVL
  102 FORMAT(/5X,'++++++ WARNING, TOO MANY REPORT LEVELS (> ',I4,') -',
     $ 'ID=',A8,' -- PROCESS BOTTOM ',I4,' LEVELS'/)
               WRITE(CMXBLVL,'(I5)') MXBLVL
               CALL SYSTEM('[ -n "$jlogfile" ] && $DATA/postmsg'//
     $          ' "$jlogfile" "***WARNING: TOO MANY REPORT LEVELS '//
     $          '(> '//CMXBLVL//' ) -ID='//STNID//' -- PROCESS '//
     $          'BOTTOM '//CMXBLVL//' LEVELS"')
               EXIT
            END IF
         ENDDO
  111    CONTINUE
C-----------------------------------------------------------------------
C       NEXT COME THE RTOVS, ATOVS OR GOES RADIANCES IF APROPRIATE
C-----------------------------------------------------------------------
         IF(NI.EQ.6.OR.NI.EQ.7)  THEN
            IF(JI.LT.4.AND.TOVRAD) THEN
               IF(NFILE.EQ.IUNIT(7))  THEN
C-----------------------------------------------------------------------
C   STORE RTOVS RADIANCES (BRIGHTNESS TEMPERATURE) FOR 32 CHANNELS
C    ALSO STORE SOLAR ZENITH ANGLE, SATELLITE ZENITH ANGLE, OZONE,
C                      AND SKIN TEMPERATURE
C  (THESE ARE COMBINED WITH 40-LEVEL RETRIEVALS IF THEY WERE PROCESSED)
C-----------------------------------------------------------------------
                  IRFLG = 0
                  DO LL = 1,32
                     NBT = NBT + 1
                     BTO(1,NBT) = LL
                     IF(RTRAD(LL).LT.YMISS)  THEN
                        BTO(2,NBT) = RTRAD(LL)
                        IRFLG = 1
                     END IF
                  ENDDO
                  IF(IRFLG.EQ.0)  NBT = 0
                  IF(NBT.GT.0)  THEN
                     IF(SAZANG.LT.YMISS)  RAD(1) = SAZANG
                     IF(SOZANG.LT.YMISS)  RAD(2) = SOZANG
                     IF(OZONE .LT.YMISS)  RAD(3) = OZONE
                     IF(SKINT .LT.YMISS)  RAD(4) = SKINT
                  END IF
               ELSE  IF(NFILE.EQ.IUNIT(7)+1)  THEN
C-----------------------------------------------------------------------
C   STORE ATOVS RADIANCES (BRIGHTNESS TEMPERATURE) FOR 35 CHANNELS
C    ALSO STORE SOLAR ZENITH ANGLE, SATELLITE ZENITH ANGLE, OZONE,
C                      AND SKIN TEMPERATURE
C  (THESE ARE COMBINED WITH 40-LEVEL RETRIEVALS IF THEY WERE PROCESSED)
C-----------------------------------------------------------------------
                  IRFLG = 0
                  DO LL = 1,35
                     NBT = NBT + 1
                     BTO(1,NBT) = LL
                     IF(RTRAD(LL).LT.YMISS)  THEN
                        BTO(2,NBT) = RTRAD(LL)
                        IRFLG = 1
                     END IF
                  ENDDO
                  IF(IRFLG.EQ.0)  NBT = 0
                  IF(NBT.GT.0)  THEN
                     IF(SAZANG.LT.YMISS)  RAD(1) = SAZANG
                     IF(SOZANG.LT.YMISS)  RAD(2) = SOZANG
                     IF(OZONE .LT.YMISS)  RAD(3) = OZONE
                     IF(SKINT .LT.YMISS)  RAD(4) = SKINT
                  END IF
               END IF
            ELSE IF(JI.GT.3.AND.((GOESRD(1).AND.STNID(1:1).NE.'H').OR.
     $                           (GOESRD(2).AND.STNID(1:1).EQ.'H')))THEN
C-----------------------------------------------------------------------
C      STORE GOES RADIANCES (BRIGHTNESS TEMPERATURE) FOR 18 CHANNELS
C          ALSO STORE SOLAR ZENITH ANGLE, SATELLITE ZENITH ANGLE,
C            SKIN TEMPERATURE, AND CLOUD AMOUNT BUFR CODE TABLE
C        (THESE ARE COMBINED WITH SOUNDINGS IF THEY WERE PROCESSED)
C-----------------------------------------------------------------------
               IRFLG = 0
               DO LL = 1,18
                  NBT = NBT + 1
                  BTO(1,NBT) = IGCHN(LL)
                  IF(GRAD(LL).LT.YMISS)  THEN
                     BTO(2,NBT) = GRAD(LL)
                     IRFLG = 1
                  END IF
               ENDDO
               IF(IRFLG.EQ.0)  NBT = 0
               IF(NBT.GT.0)  THEN
                  IF(SAZANG.LT.YMISS)  RAD(1) = SAZANG
                  IF(SOZANG.LT.YMISS)  RAD(2) = SOZANG
                  IF(SKINT .LT.YMISS)  RAD(4) = SKINT
                  IF(CLDAMT.LT.YMISS)  RAD(5) = CLDAMT
               END IF
            END IF
         END IF
C***********************************************************************
      END IF
      RETURN
      END
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    BLOCK DATA
C   PRGMMR: C. Hill          ORG: NP22       DATE: 2017-01-11
C
C ABSTRACT: INITIALIZES COMMON BLOCK PARAMETERS.
C
C PROGRAM HISTORY LOG:
C   UNKNOWN
C 1988-04-11  D. A. KEYSER -- DOCBLOCKING; STREAMLINED
C 2016-10-27  C. Hill -- Most recent updates to the sizes and default
C             values of arrays AWINDO, AIRLND, JAWIND, JAMASS, IACFTL,
C             IACFTH, AIFNOW, FLACMS, KSKALM, KSKAHM, KEPAC, and KSKNOW
C             to accommodate TAMDARB reports.
C 2017-01-11  C. Hill -- The default value for IACFTH(9) is changed from
C             3050 to 16500 meters to provide capability to process the
C             full vertical profile of TAMDARB reports (made available
C             by ARINC 01/17/2017). 
C 2020-08-20 J. Dong -- Modified to handle Hong Kong wind profiler data
C            (NC002014). Future feature.
C
C REMARKS: THIS IS UPDATED AS NEEDED TO ACCOUNT FOR CHANGES IN COMMON
C   BLOCKS AND FOR NEW COMMON BLOCKS AS THEY ARE ADDED.  NO PROGRAM
C   HISTORY LOG IS MAINTAINED; REFER TO INDIVIDUAL SUBPROGRAM HISTORY
C   LOGS FOR CHANGES IN COMMON BLOCK VARIABLES.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE:  NCEP WCOSS
C
C$$$
      BLOCK DATA
      PARAMETER (MXLVL = 600)
      PARAMETER (MAXOBS = 4500)
      PARAMETER (XMISS = 99999.)
      PARAMETER (IMISS = 99999)
      COMMON/DATA/DMY3,IDATE(4),IDAT10,MP_PROCESS,WRMISS,IDATMM
      COMMON/ADP/ISATOB,PMAND(23),RDATA(MAXOBS),IPRINT
      COMMON/LEVELS/MLEV
      COMMON/UNITNO/NFILE,IUNIT(28)
      COMMON/GRID/IGRD,JGRD,POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL,YNLIM,
     $ YSLIM
      COMMON/SATSW2/PHI(6),IRTRV(5,4,4),KTOP(5,4,4),IWINDO_e(5,4,4),
     $ IWINDO_l(5,4,4),SATMST(5,4,4),ISATLS(5,4,4)
      COMMON/SATSW3/PHISWN(7),SWNLND(6,8,10),SWINDO_e(6,8,10),
     $ SWINDO_l(6,8,10),JSWIND(6,8,10),JSMASS(6,8,10),KEPSW(6,8,10),
     $ KSKSWD(10),RFFL,QIFY,QIFN,EEQF
      COMMON/ACFTSW/AWINDO(2,9),AIRLND(6,9),JAWIND(6,9),JAMASS(6,9),
     $ IACFTL(9),IACFTH(9),PHIACF(7),KEPAC(6,9),AIFNOW(9),POAF,TRBX(5),
     $ FLACMS(9),PCAT,ROLF,aMSTQ,RIALR
      COMMON/TVSWCH/TOVEDS(2),TOVBFR(2),TR80KM,KNTTOV(2),
     $ KSKPTV(2),KNOPTV(2),KIPTTV(2),KMSGTV(2),KBDYTV(2),KTIMTV(2),
     $ KLNDTV(2),KSEATV(2),KREDTV(2),KJFLAG(2)
      COMMON/GOSWCH/GOESND(2),GOESPW(2),GOESCT(2),KNTGIT,KNTGIS,KNTGIP,
     $ KSKPGI,KNDCGI,KNOPGI,KMSGGI,KBDYGI,KTIMGI(3),KLNDGI(3),KSEAGI(3),
     $ KNTGIC,KNOCTP
      COMMON/LFMSFC/LFMAXI,LFMAXJ,FMESHL,FLONVT,FPOLEI,FPOLEJ,MARLND,
     $ JSURFM(12),JSURFW(12),FWINDO(12),PFRALT,npkrpt(12)
      COMMON/UPALIM/LEVPM,LEVST,LEVQQ,TDLIM,TDMAX,SPCIAL,ISQNUM_UPA
      COMMON/COUNT/KKTYPE(100:299)
      COMMON/PARM2/PG4243,KTEMP,i2many_lvls
      COMMON/PARM3/RECCON,RWINDO,UWINDO,RECSLM,FLRECO,VWINDO,VADWIN,
     $ IVADFL,IVADSP,FLDMGS,FLDMAF,FLDMFR,DROPSN,DWINDO,UPRAIR
      COMMON/PARM4/ICODE
      COMMON/PARM5/FILLZ,FILLT,FILLW,FILLM,LSWIND,LSMASS,CWINDO,NPZ
      COMMON/PARM6/MODPRT,IFLUA,STNPRT(3)
      COMMON/SFCBFR/ALTIMR,PRSS
      COMMON/SKPCNT/KSKPUA,KSKPSF,KMSGUA,KMSGSF,KBDYUA,KBDYSF,KTIMUA,
     $ KTIMSF,KSKNSW,KSKREC,KNOATS,KNTUPA,KNTCAR,KNTAIR,KNTSWN,KNTPRO,
     $ KNTVAD,KNTRAS,KNTDUM(3),KNTSFC,KNTSHP,KNTSLP,KNTMSO,KNTSPL,
     $ KSKSWN,KSKACF,KNDCDE(3),KSKCLS,KSKTHN,KSKOMR(2),KSKALM(9),
     $ KSKAHM(9),KSKNOW(9),KSKDRP
      COMMON/MISWCH/XWINDO(6,4),JPSSMI(6,4),SRAD(7),KNTSMI(4),KTIMM(4),
     $ KSKPMI,KMSGMI,KBDYMI
      COMMON/SCTWCH/IEWNDO(2),JPERSD(6),IQWNDO(2),JPQKSD(6),IWWNDO(2),
     $ JPWDSD(6),KSKPSC(4),KMSGSC(4),KBDYSC(4),KTIMSC(4),KNTSCT(4),
     $ JPASCD(6),IAWNDO(2)
      COMMON/GPSWCH/JPGPSD(6),GWINDO,KNTGPS,KSKPGP,KMSGGP,KBDYGP,KTIMGP,
     $ KMISGP,KT45GP,SKGP45,SKGNSS,KTGNSS
      COMMON/RADANC/RTRAD(35),GRAD(18),IGCHN(18),SOZANG,SAZANG,OZONE,
     $ SKINT,CLDAMT,TOVRAD,TOVRTV,GOESRD(2)
      COMMON/CLDTOP/CLTOP(2,3)
      COMMON/PREVSW/PREVEN
      COMMON/APDNSW/APPEND
      COMMON/SKPSUB/SUBSKP(0:255,0:200)
      COMMON/LAUNCH/ALNCH
      COMMON/PFSWCH/PRFLER(5),PWINDO(5),PROFILERinADPUPA
      COMMON/RASSSW/RASS,TWINDO
      COMMON/DRIFT/DFTLON(MXLVL),DFTLAT(MXLVL),DFTTIM(MXLVL)
      COMMON/SBDRIFT/ZDRIFT(MXLVL),TDRIFT(MXLVL),TDRIFTLL(MXLVL),
     $ UDRIFT(MXLVL),VDRIFT(MXLVL),XDRIFT(MXLVL),YDRIFT(MXLVL),
     $ TDRIFT_LL(MXLVL),KFLAG(5),LFLAG(3),GPSFLAG(2),PLO,IFLTIM,JJ,II
      common/pstnflg/ipstnflg
      LOGICAL TOVEDS,GOESND,SATMST,MARLND,RECCON,SWNLND,AIRLND,DROPSN,
     $ PG4243,SPCIAL,KTEMP,TR80KM,FILLZ,FILLT,FILLW,FILLM,PRFLER,
     $ TOVBFR,RECSLM,GOESPW,VADWIN,TOVRAD,TOVRTV,PFRALT,AIFNOW,FLDMGS,
     $ FLDMAF,FLDMFR,FLACMS,GOESRD,PREVEN,SUBSKP,APPEND,
     $ PROFILERinADPUPA,GOESCT,RASS,WRMISS,SKGP45,npkrpt,SKGNSS,UPRAIR
      CHARACTER*8  STNPRT
      DATA TOVEDS/2*.TRUE./,GOESND/2*.FALSE./,TOVBFR/2*.FALSE./,
     $ SATMST/80*.FALSE./,MARLND/.FALSE./,RECCON/.TRUE./,
     $ SWNLND/480*.TRUE./,AIRLND/54*.TRUE./,PG4243/.TRUE./,
     $ SPCIAL/.FALSE./,KTEMP/.FALSE./,TR80KM/.FALSE./,FILLZ/.FALSE./,
     $ FILLT/.FALSE./,FILLW/.FALSE./,FILLM/.FALSE./,PRFLER/5*.TRUE./,
     $ GOESPW/2*.FALSE./,GOESCT/2*.FALSE./,STNPRT/3*'        '/,
     $ RECSLM/.TRUE./,VADWIN/.FALSE./,TOVRAD/.FALSE./,PFRALT/.FALSE./,
     $ TOVRTV/.FALSE./,AIFNOW/9*.TRUE./,FLDMGS/.TRUE./,
     $ FLACMS/9*.TRUE./,GOESRD/2*.FALSE./,PREVEN/.FALSE./,
     $ FLDMAF/.TRUE./,FLDMFR/.TRUE./,DROPSN/.TRUE./,
     $ SUBSKP/51456*.FALSE./,APPEND/.FALSE./,PROFILERinADPUPA/.FALSE./,
     $ RASS/.FALSE./,WRMISS/.TRUE./,SKGP45/.TRUE./,npkrpt/12*.false./
      DATA  SKGNSS/.TRUE./
      DATA  UPRAIR/.TRUE./
      DATA  MODPRT/500/,IGRD/73/,JGRD/37/
      DATA  PMAND/1000.,925.,850.,700.,500.,400.,300.,250.,200.,150.,
     $  100.,70., 50., 30., 20., 10.,  7.,  5.,  3.,  2.,  1.,  .4,  .1/
      DATA  PHI/-90.,-70.,-20.,20.,74.,90./
      DATA  PHISWN/-90.,-70.,-20.,0.,20.,70.,90./
      DATA  PHIACF/-90.,-70.,-20.,0.,20.,70.,90./
      DATA  IWINDO_e/20*-3,60*-300/,IWINDO_l/20*+3,60*+300/,
     $ FWINDO/4*300.,600.,7*300./,RWINDO/300./,UWINDO/300./,
     $ AWINDO/6*325.,2*325.,10*325./,SWINDO_e/12*-300.,6*-700.,
     $ 6*-300.,12*-300.,12*-300.,12*-300.,6*-700.,6*-300.,12*-300.,
     $ 12*-300.,12*-300.,6*-700.,6*-300.,12*-300.,12*-300.,336*-300./,
     $ SWINDO_l/12*+300.,6*+700.,6*+300.,12*+300.,12*+300.,12*+300.,
     $ 6*+700.,6*+300.,12*+300.,12*+300.,12*+300.,6*+700.,6*+300.,
     $ 12*+300.,12*+300.,336*+300./,XWINDO/24*300./,JPSSMI/24*9999/,
     $ IEWNDO/-3,3/,JPERSD/6*9999/,PWINDO/5*300./,JPQKSD/6*9999/,JPWDSD/
     $ 6*9999/,IQWNDO/-3,3/,IWWNDO/-3,3/,CWINDO/300./,VWINDO/300./,
     $ DWINDO/300./,JPGPSD/6*9999/,GWINDO/300./,TWINDO/300./,JPASCD/
     $ 6*9999/,IAWNDO/-3,3/
      DATA IRTRV/2*0,544,2*0,2*0,544,2*0,2*0,544,2*0,2*0,544,2*0,60*0/,
     $ KTOP/80*16/,NPZ/0/
      DATA  IUNIT/11,12,15,18,21,31,41,46,48,6*0,51,52,11*0/,NFILE/0/,
     $ ISATOB/0/,IPRINT/0/,ISATLS/80*2/
      DATA  JAWIND/54*0/,JAMASS/54*0/,JSURFM/12*0/,
     $      JSURFW/2*0,9999,0,9999,0,9999,5*0/,
     $      JSWIND/12*9999,6*9999,6*0,12*0,12*9999,
     $             12*9999,6*9999,6*9999,12*9999,12*9999,
     $             12*9999,6*9999,6*0,12*0,12*9999,
     $             12*0,6*9999,6*9999,12*9999,12*9999,
     $             12*9999,6*9999,6*9999,12*9999,12*9999,
     $             12*0,6*9999,6*9999,12*9999,12*9999,
     $             12*9999,6*9999,6*9999,12*9999,12*9999,
     $             12*9999,6*9999,6*9999,12*9999,12*9999,
     $             12*9999,6*9999,6*9999,12*9999,12*9999,
     $             12*9999,6*9999,6*9999,12*9999,12*9999/,
     $      JSMASS/480*9999/,KEPSW/480*0/,
     $      RTRAD/35*XMISS/,GRAD/18*XMISS/,SRAD/7*XMISS/,
     $      IACFTL/100,8*-200/,IACFTH/3*18000,16500,4*18000,16500/,
     $      LSMASS/9999/,LSWIND/9999/,KEPAC/54*0/,IGCHN/18*IMISS/,
     $      KKTYPE/200*0/,SOZANG/XMISS/,SAZANG/XMISS/,OZONE/XMISS/,
     $      SKINT/XMISS/,CLDAMT/XMISS/,MLEV/0/,ALTIMR/XMISS/,IVADFL/5/,
     $      IVADSP/2/,POAF/XMISS/,RFFL/XMISS/,ALNCH/XMISS/,
     $      TRBX/5*XMISS/,PRSS/XMISS/,CLTOP/6*XMISS/,PCAT/XMISS/,
     $      ROLF/XMISS/,RIALR/XMISS/,QIFY/XMISS/,QIFN/XMISS/,
     $      EEQF/XMISS/,aMSTQ/XMISS/
      DATA  LFMAXI/53/,LFMAXJ/45/,FMESHL/190.5/,FLONVT/105./,
     $      FPOLEI/27./,FPOLEJ/49./,LEVPM/16/,LEVST/13/,LEVQQ/8/,
     $      TDLIM/215./,TDMAX/999./,ISQNUM_UPA/0/
      DATA  KSKPUA/0/,KSKPSF/0/,KTIMUA/0/,KTIMSF/0/,KBDYUA/0/,KBDYSF/0/,
     $      KSKNSW/0/,KSKREC/0/,KMSGUA/0/,KMSGSF/0/,KNOATS/0/,KNTUPA/0/,
     $      KNTAIR/0/,KNTSWN/0/,KNTCAR/0/,KNTSFC/0/,KNTSHP/0/,KNTSLP/0/,
     $      KNTMSO/0/,KNTSPL/0/,KSKSWN/0/,KSKACF/0/,KSKPMI/0/,KMSGMI/0/,
     $      KBDYMI/0/,KTIMM/4*0/,KNTSMI/4*0/,KNTVAD/0/,KNTDUM/3*0/,
     $      KNTPRO/0/,KSKCLS/0/,KNTTOV/2*0/,KSKPTV/2*0/,KBDYTV/2*0/,
     $      KTIMTV/2*0/,KMSGTV/2*0/,KNOPTV/2*0/,KREDTV/2*0/,KLNDTV/2*0/,
     $      KIPTTV/2*0/,KSKTHN/0/,KJFLAG/2*0/,KSKOMR/2*0/,KSKALM/9*0/,
     $      KMSGGI/0/,KSKPGI/0/,KLNDGI/3*0/,KNDCGI/0/,KNOPGI/0/,
     $      KBDYGI/0/,KTIMGI/3*0/,KNTGIS/0/,KNTGIT/0/,KNTGIP/0/,
     $      KNDCDE/3*0/,KSKPSC/4*0/,KMSGSC/4*0/,KBDYSC/4*0/,KTIMSC/4*0/,
     $      KNTSCT/4*0/,KSKNOW/9*0/,KSKSWD/10*0/,KSEATV/2*0/,KNTGIC/0/,
     $      KSEAGI/3*0/,KSKDRP/0/,KNOCTP/0/,KSKAHM/9*0/,KNTGPS/0/,
     $      KSKPGP/0/,KMSGGP/0/,KBDYGP/0/,KTIMGP/0/,KMISGP/0/,KT45GP/0/,
     $      KTGNSS/0/
      DATA  DFTLON/MXLVL*XMISS/,DFTLAT/MXLVL*XMISS/,DFTTIM/MXLVL*XMISS/,
     $      ZDRIFT/MXLVL*XMISS/,TDRIFT/MXLVL*XMISS/,
     $      TDRIFTLL/MXLVL*XMISS/,UDRIFT/MXLVL*XMISS/,
     $      VDRIFT/MXLVL*XMISS/,XDRIFT/MXLVL*XMISS/,YDRIFT/MXLVL*XMISS/,
     $      TDRIFT_LL/MXLVL*XMISS/,KFLAG/5*0/,LFLAG/3*0/,GPSFLAG/2*0/,
     $      PLO/XMISS/,IFLTIM/0/,JJ/0/,II/0/,ipstnflg/0/,i2many_lvls/0/
      END
