IDENTIFICATION DIVISION. PROGRAM-ID. CVT63-62-PG. ******THIS PROGRAM CHECKS FOR A CODE 71 IN TYPE-LEVEL AND IGNORES ******IT PRIOR TO 1993. * WRITTEN BY JEFF CAPPS AUGUST 1993 * COMPILE ECL = JC6300.C-CVT63 * PROGRAM IS WRITTEN TO CONVERT TD-6300 SERIES TO TD-6201. * CONVERTED 6201 DATA CONTAINS LATITUDE AND LONGITUDE * MULTIPLIED BY 60 AND ROUNDED FROM THE 6300 RECORD OF * WHICH CONTAINS MINUTES DIVIDED BY 60. * FORTRAN SUBROUTINES EXECUTED BY THIS PROGRAM ARE * R63REC PREP FILE = U63REC * FD6300 PREP FILE = UANREL * FD6302 PREP FILE = FD6302 * * SELECTIONS MAY BE MADE BY WBAN #, WMO #, OR CARDS #. * * SELECTION BY YEAR, MONTH, AND DAY. (HOUR IS NOT A CHOICE) * * ALL OUTPUT HAVE WBAN # WHEATHER SELECTED AS WBAN OR CHANGED * FROM A WMO #, CARDS #, OR OTHER DATA RECORDS. * * NOTICE****** * MINUTE WINDS ARE SELECTED UPON REQUEST AND ARE IDENTIFIED * BY A '6' IN COL-68 (TYPE-LEVEL). THESE WINDS INCREASE THE * LEVEL COUNT. THERE WILL BE TIMES THAT THE 200 MAX LEVEL * MAY BE EXCEEDED. I HAVE INCREASED THE MAX-LEVELS TO 250 FOR * RECORDING OF THESE WIND LEVELS. HOWEVER, THE 200 MAX WILL * REMAIN TRUE FOR TD6201 SELECTIONS WITHOUT MINUTE WINDS. * ON THE TYPE AND DENSITY HEADER LINE USE : * AV C N = ASCII VARIABLE CARTRIDGE 'WITHOUT' MINUTE WINDS. * AV S N = SAME AS ABOVE EXCEPT 6250 TAPE * AV V N = SAME AS ABOVE EXCEPT 1600 TAPE * AV C Y = ASCII VARIABLE CARTRIDGE 'WITH' MINUTE WINDS. * AV S Y = SAME AS ABOVE EXCEPT 6250 TAPE * AV V Y = SAME AS ABOVE EXCEPT 1600 TAPE * FIXED 'FE' SAME AS 'AV' FOR DENSITY AND WINDS. * FOR SELECTING TO DISC : * USE 'DS' FOR 68 CHAR., 'DV' FOR VRIABLE, 'DF' FOR 2876 * CHARACTERS IN PLACE OF 'AV' OR 'FE' AND DENSITY IS BLANK. * THE MINUTE WINDS IS 'YES' OR 'NO' EX. = DS Y * DS N * 'DS' IS 68 CHARACTER RECORDS FOR DISKETTE PROCESSING. * 'DF' IS 2876 CHARACTER RECORDS FOR DISKETTE PROCESSING. * 'DV' IS DISC VARIABLE LENGTH WITH A MAX OF 200 LEVELS * IF WINDS = 'N' AND A MAX OF 250 LEVELS IF WINDS = 'Y'. * NO DISKETTE RECORDING IS AVAILABLE FOR VARIABLE. A FILE * MAY BE CREATED AND DOWNLOADED USING 'FTP'. * * LIMIT LINES FOR SELECTION ARE AS FOLLOWS : * L 00012345 19930101 00012345 19930131 = WBAN STATIONS * W 123456 19930101 123456 19930131 = CARDS STATIONS * * ONLY AN 'L' OR A 'W' MAY BE USED FOR A SELECTION. NOT BOTH. * NOTE - * THIS PROGRAM SELECTS AND CONVERTS ANY OF THE TD-6300 * SERIES DATA TO TD-6201 FORMAT IN VARIABLE, FIXED, * 68-DISC, 2876 DISC, AND VARIABLE-DISC RECORD LENGTHS. * THIS PROGRAM OUTPUTS A 6 DIGIT NUMBER IN THE WBAN STATION * FIELD. THE INVENTORY AND MIXING HEIGHT PROGRAMS WILL USE * ONLY THE LAST 5 DIGITS. BE SURE TO USE ONLY THE LAST * 5 DIGITS WHEN FURTHER PROCESSING OUTPUT DATA FROM THIS * PROGRAM. EXAMPLE = INPUT CARDS # IS 723935 * OUTPUT CARDS # IS 723935 * USE FOR CARDS # 23935 ************************* *NOTE TO NOTE * CHANGED THE STATION NUMBER TO THE FIRST FIVE * DIGITS FOR WMO STATIONS. INVERTORY PROGRAM WAS * CONFUSING WMO STATION WITH WBAN STATION * TOM WHITEHUST ************************* * THIS PROGRAM COMPUTES A RELATIVE HUMIDITY FOR DATA SELECTED * FROM TD-6302. IT USES THE TEMPERATURE AND DEW POINT * DEPRESSION FOR THE COMPUTATION. *---------------------------------------------------------------- * * PROGRAM MODIFIED JUNE 1994 TO BUILD DISK FILE FOR 2876 * FIXED RECORDS FOR DISKETTE RECORDING. JEFF CAPPS. *---------------------------------------------------------------- *---------------------------------------------------------------- * * PROGRAM MODIFIED DECEMBER 1994 TO ADJUST TYPE LEVEL CODES * AND FLAGS TO MATCH TD-6201 DOCUMENTATION..JEFF CAPPS.. *---------------------------------------------------------------- * 4/17/97 program is outputing records with binary zeros * in some of the fields. I will initialize these to their * default value 999999 ......Tom Whitehurst * *LIMITED OUTPUT ERROR MESSAGES TO 100 TOM W * ************************************************************** *Program modified January 1999 to migrate from Unisys to Unix: *1) Tape devices are no longer used in this program. *2) Three Fortran subroutines have been eliminated to simplify * the program. *3) If the source code (cvt63-62-pg.cbl) needs to be further changed, * the number fiekd check switch shall be unset before using * tbox because the dates that are entered by ACCEPT clause * will be used for calculation. Unset the switch can be done * by entering below on the Unix command line: * -> COBSW=-F * -> export COBSW *4) Use ksh script to manage input and output files. Enter * selected information to cvt.script, the program will run * by typing the command below on Unix command line: * -> cvt.script * * Tony Wu (Marada) ************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. UNIVAC-11-62EIS. OBJECT-COMPUTER. UNIVAC-11-62EIS. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT U-A-RECORD ASSIGN TO "elem-in" ORGANIZATION IS LINE SEQUENTIAL. SELECT U-A-DISC-68 ASSIGN TO "disc-out" ORGANIZATION IS LINE SEQUENTIAL. SELECT U-A-FIX-2876 ASSIGN TO "disc-out" ORGANIZATION IS LINE SEQUENTIAL. SELECT UA-VAR-DISC ASSIGN TO "disc-out" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD U-A-RECORD LABEL RECORDS ARE OMITTED DATA RECORD U-A-RECORD-REC. 01 U-A-RECORD-REC. 02 ID-INFO. 1 03 I-BEG-REC PIC X. 1 03 I-WMO-NUM PIC X(6). 1 03 I-STN-IND PIC X. 03 I-STN-ID PIC X(8). 03 I-LATITUDE. 1 05 I-LATITUDE-NUM PIC 9(2). 1 05 I-LAT-MIN PIC 9(5). 05 I-LATITUDE-ALPH PIC X. 03 I-LONGITUDE. 1 05 I-LONGITUDE-NUM PIC 9(3). 1 05 I-LONG-MIN PIC 9(5). 05 I-LONGITUDE-ALPH PIC X. 1 03 I-ELEVATION PIC 9(5). 03 I-YR-MON-DAY PIC 9(8). 1 03 I-TIME-GP REDEFINES I-YR-MON-DAY. 1 05 I-YEAR PIC 9(4). 1 05 I-MONTH PIC 99. 1 05 I-DAYS PIC 99. 1 03 I-HOUR PIC 99. 1 03 I-RELSE-TIME PIC X(4). 1 03 I-CLOUD-WX PIC X(9). 1 03 I-OBSN-TYPE PIC XX. 1 03 I-SON-BAR-IND PIC X. 1 03 I-SON-BAR-NUM PIC X(20). 1 03 I-SONDE-TYPE PIC XXX. 1 03 I-QC-EFFORT PIC X. 1 03 I-DATA-SOURCE PIC XX. 1 03 I-TYPE-CORRECTION. 1 04 I-CORTYP-P PIC XX. 1 04 I-CORTYP-Z PIC XX. 1 04 I-CORTYP-T PIC XX. 1 04 I-CORTYP-H PIC XX. 1 04 I-CORTYP-TD PIC XX. 1 04 I-CORTYP-W PIC XX. 1 03 I-MORE-RECS PIC 999. 02 I-NUM-LEVELS PIC 999. 1 02 I-LEVEL-RECORD OCCURS 1 TO 175 TIMES DEPENDING ON I-NUM-LEVELS. 03 I-QUAL-IND PIC X. 1 03 I-ELAPSED-TIME. 05 I-EL-TIME PIC 999. 05 I-E-T PIC 99. 1 03 I-PRESSURE. 04 I-PRES PIC 99999. 04 I-P-R PIC 9. 1 03 I-HEIGHT. 04 I-HT-ALFA PIC X. 04 I-H-T PIC 9. 04 I-HGT-IN PIC 99999. 1 03 I-TEMPERATURE. 04 I-TMP-ALFA PIC X. 04 I-T-M PIC 9. 04 I-TEMP-IN PIC 999. 03 TEMP-REL REDEFINES I-TEMPERATURE. 04 TEMP-ALF PIC X. 04 TEMP-EXTRA PIC 9. 04 TEMP-TO-RH PIC 99V9. 1 03 I-RELATIVE-HUMIDITY. 04 I-REL-HM PIC 999. 04 I-R-H PIC 9. 1 03 I-DPDP PIC 99V9. 1 03 I-WIND-DIR PIC 9(3). 1 03 I-WIND-SPD. 04 I-W-SPEED PIC 999. 04 I-W-S PIC 9. 1 03 I-TYP-LEVEL PIC XX. 1 03 I-FLAGS. 1 04 I-EQET PIC XX. 1 04 I-EQP PIC XX. 1 04 I-EQH PIC XX. 1 04 I-EQT PIC XX. 1 04 I-EQU PIC XX. 1 04 I-EQD PIC XX. 1 04 I-EQWDS PIC XX. 1 04 I-RESERVE-SPACE PIC XX. FD U-A-FIX-2876 LABEL RECORDS ARE OMITTED DATA RECORD U-A-F-2876. 01 U-A-F-2876. 02 F-ID-2876 PIC X(29). 02 F-NUM-LEV-2876 PIC 999. 02 F-LEVEL-REC-2876 OCCURS 79 TIMES. 03 F-LEVEL-VAL-2876 PICTURE X(36). FD UA-VAR-DISC LABEL RECORDS ARE OMITTED DATA RECORD U-A-DISC-REC. 01 U-A-DISC-REC. 02 D-ID-INFO PIC X(29). 02 D-NUM-LEVELS PIC 999. 02 D-LEVEL-RECORD OCCURS 1 TO 250 TIMES DEPENDING ON D-NUM-LEVELS. 03 D-LEVEL-VALUES PICTURE X(36). FD U-A-DISC-68 LABEL RECORDS ARE OMITTED DATA RECORD U-A-DS-68. 01 U-A-DS-68. 02 68-ID-INFO PIC X(29). 02 68-NUM-LEVELS PIC 999. 02 68-LEVEL-VALUE PIC X(36). WORKING-STORAGE SECTION. 77 RH-TEMP PIC S99V9. 77 NUM-RECS PIC X VALUE '0'. 77 RH-SIGN PIC X. 77 SWITCH-YES PIC X VALUE 'N'. 77 SURFACE-YES PIC X VALUE 'N'. 01 INPUT-DATA. 02 IN-CODE PIC X. 02 FILLER PIC X. 02 IN-RANGE. 03 BEGIN-STN-IN PIC X(8). 03 FILLER PIC X. 03 BEGIN-YR-MON-DAY-IN PIC 9(8). 03 FILLER PIC X. 03 END-STN-IN PIC X(8). 03 FILLER PIC X. 03 END-YR-MON-DAY-IN PIC 9(8). 03 FILLER PIC X(40). 01 WMO-INPUT-DATA. 02 WMO-IN-CODE PIC X. 02 FILLER PIC X. 02 WMO-IN-RANGE. 03 BEGIN-WMO-STN PIC X(6). 03 FILLER PIC X. 03 B-WMO-YR-MON-DAY-IN PIC 9(8). 03 FILLER PIC X. 03 END-WMO-STN PIC X(6). 03 FILLER PIC X. 03 E-WMO-YR-MON-DAY-IN PIC 9(8). 03 FILLER PIC X(47). 01 HOLD-IN-CODE. 02 H-IN-CODE PIC X. 02 HOLD-W-IN-CODE PIC X. 01 WBAN-WMO. 02 WBAN-ALL. 03 WBAN-THREE PIC XXX VALUE '000'. 03 WBAN-FIVE PIC X(5). 02 TEMP-WMO. 03 TMP-WBAN-FIVE PIC X(5). 03 FILLER PIC X(1). 01 DOTPRH. 02 GETTMP PIC S99V9. 02 DEW-DEP PIC S99V9. 01 RH-BUILD. 02 F-TEMP PIC S999V9. 02 F-DEWPT PIC S999V9. 02 COMP-RH-1 PIC S999V9. 02 COMP-RH-2 PIC S999V9. 02 DIVIDE-TEMP PIC S9V9(6). 02 RH-FACTOR PIC S999V99. 02 R-HUM PIC S999. 01 CORRECT-WINDS. 02 WIND-TENTHS PIC X. 02 WIND-REST PIC 999. 01 ROUTDP. 02 DEW-POINT PIC 99V9. 01 COMPUTED-FACTOR. 02 GETTMP-1 PIC S99V9. 02 TEMP-SIGN PIC X. 02 RHGH-1 PIC 999. 01 SAVE-PRESS PIC 9(5). ******* THIS REMOVE-GRP IS TO REMOVE DUPLICATES IN THE DATA***** ******* REMOVE ALL STATEMENTS ASSOCIATED TO DUPS AFTER DATA***** ******* HAS BEEN CORRECTED. 01 REMOVE-GRP. 02 REM-YMD PIC 9(8). 02 REM-HR PIC 99. 01 WS-6201-REC. 02 WS-ID-INFO. 03 WS-STN-ID PIC X(8). 03 WS-LAT. 05 WS-LAT-NUM PICTURE 99. 05 WS-LAT-MIN PICTURE 99. 05 WS-LAT-ALPH PICTURE X. 03 WS-LONG. 05 WS-LONG-NUM PICTURE 999. 05 WS-LONG-MIN PICTURE 99. 05 WS-LONG-ALPH PICTURE X. 03 WS-YR-MON-DAY PIC 9(8). 03 WS-HOUR PIC X(2). 02 WS-NUM-LEVELS PIC 999. 02 WS-LEVEL-RECORD OCCURS 1 TO 250 TIMES DEPENDING ON WS-NUM-LEVELS. 03 WS-QUAL-IND PICTURE X. 03 WS-EL-TIME. 05 WS-EL-TM PIC 999. 05 WS-EL-T PIC 9. 03 WS-PRESS PICTURE 99999. 03 WS-HT-ALFA PIC X. 03 WS-HGT PICTURE 99999. 03 WS-TMP-ALFA PIC X. 03 WS-TEMP PICTURE 999. 03 WS-REL-HUM PICTURE 999. 03 WS-WIND PICTURE 9(3). 03 WS-WD-SPD PICTURE 9(3). * INITIALIZED TO ZERO BY TOM WHITEHURST 03 WS-FLAGS. 04 WS-QET PIC X. 04 WS-QP PIC X. 04 WS-QH PIC X. 04 WS-QT PIC X. 04 WS-QU PIC X. 04 WS-QWDS PIC X. 04 WS-T-LEVEL PIC X. 01 INFILE PIC X(12) VALUE 'TD-6300 '. 01 NUM-REELS PIC 9(8) COMP. 01 DISPLAY-CNT PIC 9(6) COMP VALUE 0. 01 INPUT-REEL PIC X(6). 01 OUT-REEL PIC X(6). 01 OUTFILE PIC X(12) VALUE 'TPOUT '. 01 RTN-CODE PIC 9(8) COMP VALUE 0. 01 START-READ PIC 9(8) COMP. 01 SKIP-COUNT PIC 9(8) COMP. 01 SRCH-STN PIC X(8). 1 01 SRCH-WMO PIC X(6). 01 SRCH-YR-MON-DAY PIC X(8). 01 CURRENT-ID PIC X(8). 01 USE-13 PIC X(22) VALUE '@USE 13.,TD-6300. . '. 01 OUTFILE-INFO. 02 OUT-TYPE PIC XX. 02 FILLER PIC X. 02 OUT-DENSITY PIC X. 02 FILLER PIC X. 02 MIN-WINDS PIC X. 02 FILLER PIC X(74). 01 WS-NUM-SAVE PIC 999. 01 CK-FOR-SFC PIC 9 VALUE 0. 01 GOT-SFC-LEV PIC X VALUE 'N'. 01 SELECTION-INFO. 02 LAST-STN PIC X(8). 1 02 LAST-WMO-STN REDEFINES LAST-STN. 1 03 LAST-WMO PIC X(6). 03 FILLER PIC XX. 02 LAST-YR-MON-DAY PIC X(8). 02 PREVIOUS-STN PIC X(8). 1 02 PREV-WMO-STN REDEFINES PREVIOUS-STN. 1 03 PREV-WMO PIC X(6). 03 FILLER PIC XX. 02 DEFAULT-LIMITS PIC X. 02 SEL-LEVELS-FLAG PIC X. 02 WITHIN-RANGE PIC X. 02 SELECTED-RANGE OCCURS 1500 TIMES. 03 BEGIN-STN PIC X(8). 1 03 BEGIN-WMO-1 REDEFINES BEGIN-STN. 1 05 BEGIN-WMO PIC X(6). 1 05 FILLER PIC XX. 03 BEGIN-YR-MON-DAY PIC 9(8). 03 END-STN PIC X(8). 1 03 END-WMO-1 REDEFINES END-STN. 1 05 END-WMO PIC X(6). 1 05 FILLER PIC XX. 03 END-YR-MON-DAY PIC 9(8). 02 LEVELS-RANGE OCCURS 26 TIMES. 04 LO-LVL PIC 999V99. 04 HI-LVL PIC 999V99. 04 TOTLVL PIC 9(6). 01 LAT-LON. 02 LAT-MINUTES PIC 9(7). 02 LAT-MINX REDEFINES LAT-MINUTES. 04 LAT-WHOLE-MIN PIC 99. 04 LAT-REST-MIN PIC 99999. 02 LON-MINUTES PIC 9(7). 02 LON-MINX REDEFINES LON-MINUTES. 04 LON-WHOLE-MIN PIC 99. 04 LON-REST-MIN PIC 99999. 01 HOLD-UPPER-LIMIT. 02 LEVEL-LIMIT PIC 999V99. 02 FILLER PIC X(71). 01 TIME-GP-CK PIC 9(8). 01 LEVELS-TO-PULL. 05 FILLER PIC XX. 05 LVLS-TO-PULL OCCURS 12 TIMES. 10 LVL-TO-PULL PIC X(5). 10 LVL-TO-PULL9 REDEFINES LVL-TO-PULL PIC 999V99. 10 LVL-SEPARATOR PIC X. 01 COUNTERS. 02 I PIC 9(6) COMP. 02 J PIC 9(6) COMP. 02 RANGE-NUM PIC 9(4) COMP. 02 NUM-LVLS PIC 9(4) COMP. 02 CURRENT-RANGE PIC 9(4) COMP. 02 ERROR-COUNT PIC 9(4) COMP VALUE 0. 02 READ-COUNT PIC 9(8) COMP VALUE 0. 02 WRITE-COUNT PIC 9(8) COMP VALUE 0. 02 TOTAL-WRITE-COUNT PIC 9(8) COMP VALUE 0. 02 TOTAL-READ-COUNT PIC 9(8) COMP VALUE 0. 02 BLOCKS-SKIPPED PIC 9(8) COMP VALUE 0. 02 CURRENT-REEL PIC 99 VALUE 1. 02 CURRENT-REEL-OUT PIC 99 VALUE 1. 02 OUTPUT-CHAR-MAX PIC 9(10) COMP. 02 CHAR-COUNT PIC 9(10) COMP VALUE 0. 02 PRINT-COUNT PIC Z(7)9. 02 HOLD-NUM-LEVELS PIC 9(4) COMP. 01 DATE-TIME-INFO. 02 CURRENT-DATE. 03 CURRENT-MON PIC XX. 03 FILLER PIC X VALUE '/'. 03 CURRENT-DAY PIC XX. 03 FILLER PIC X VALUE '/'. 03 CURRENT-YR PIC XX. 02 MACHINE-DATE. 03 DATE-YR PIC XX. 03 DATE-MON PIC XX. 03 DATE-DAY PIC XX. 02 COMPLETE-TIME. 03 CURRENT-TIME. 04 CURRENT-HR PIC XX. 04 CURRENT-MIN PIC XX. 03 FILLER PIC X(4) VALUE SPACES. PROCEDURE DIVISION. START-PARA. PERFORM PRINT-PROGRAM-HEADER. OPEN INPUT U-A-RECORD OUTPUT U-A-DISC-68 U-A-FIX-2876 UA-VAR-DISC. PERFORM READ-OUTPUT-FILE-INFO. PERFORM READ-SELECTION-CLAUSES THRU END-SELECTION. MOVE 1 TO START-READ. PERFORM READ-U-A-RECORDS THRU NO-MORE-DATA. STOP-RUN. STOP RUN. *--------------------------------------------------------------- / PRINT-PROGRAM-HEADER. ACCEPT MACHINE-DATE FROM DATE. ACCEPT COMPLETE-TIME FROM TIME. MOVE DATE-YR TO CURRENT-YR. MOVE DATE-MON TO CURRENT-MON. MOVE DATE-DAY TO CURRENT-DAY. DISPLAY ' '. DISPLAY '6301 TO 6201 VERSION 1 (DEC. 1992) ' 'BEGIN PROCESSING AT ' CURRENT-DATE ' ' CURRENT-HR ':' CURRENT-MIN. DISPLAY ' '. READ-OUTPUT-FILE-INFO. DISPLAY ' '. DISPLAY ' OUTPUT TYPE/DENSITY/MIN-WINDS ? '. ACCEPT INPUT-DATA. IF IN-CODE = ' ' DISPLAY ' ' DISPLAY '*** ERROR - NO OUTPUT FILE TYPE HAS BEEN' ' SPECIFIED' DISPLAY ' PROCESSING IS ABANDONED' GO TO STOP-RUN. MOVE INPUT-DATA TO OUTFILE-INFO. DISPLAY OUTFILE-INFO. / READ-SELECTION-CLAUSES. MOVE 0 TO RANGE-NUM, NUM-LVLS. MOVE 'T' TO DEFAULT-LIMITS. MOVE 'F' TO SEL-LEVELS-FLAG. DISPLAY ' '. DISPLAY 'SELECTION CLAUSES ?'. READ-NEXT-SELECTION-CLAUSE. ACCEPT INPUT-DATA. IF IN-CODE = ' ' GO TO END-SELECTION-INPUT. IF IN-CODE = 'L' MOVE IN-CODE TO H-IN-CODE. IF IN-CODE = 'P' MOVE IN-CODE TO H-IN-CODE. IF IN-CODE = 'W' MOVE IN-CODE TO H-IN-CODE. IF IN-CODE = 'W' MOVE IN-CODE TO HOLD-W-IN-CODE. IF IN-CODE = 'U' MOVE IN-CODE TO H-IN-CODE. 1 IF H-IN-CODE = 'L' PERFORM SET-STN-SELECTION THRU EXIT-SET-STN 1 ELSE 1 IF H-IN-CODE = 'W' MOVE INPUT-DATA TO WMO-INPUT-DATA 1 PERFORM SET-WMO-SELECTION THRU EXIT-SET-WMO ELSE DISPLAY '*** ERROR - INVALID CODE, FOLLOWING INPUT' ' IGNORED' DISPLAY INPUT-DATA ADD 1 TO ERROR-COUNT. GO TO READ-NEXT-SELECTION-CLAUSE. END-SELECTION-INPUT. DISPLAY ' '. IF ERROR-COUNT NOT = 0 MOVE ERROR-COUNT TO PRINT-COUNT DISPLAY ' ' DISPLAY PRINT-COUNT ' SELECTION CLAUSES IGNORED DUE TO' ' ERRORS' DISPLAY ' PROCESSING ABANDONED' GO TO STOP-RUN. IF DEFAULT-LIMITS = 'T' DISPLAY '*** DEFAULT LIMITS ASSUMED ' DISPLAY ' DATA FOR ALL STATIONS AND YR-MON-DAYS' ' WILL BE SELECTED'. DISPLAY ' '. DISPLAY '********** END SELECTION CLAUSES - BEGIN PROCESSING' ' **********'. DISPLAY ' '. END-SELECTION. EXIT. / SET-STN-SELECTION. DISPLAY 'BEGIN STN = ' BEGIN-STN-IN ' BEGIN YR-MON-DAY = ' BEGIN-YR-MON-DAY-IN ' END STN = ' END-STN-IN ' END YR-MON-DAY = ' END-YR-MON-DAY-IN . IF BEGIN-STN-IN > END-STN-IN DISPLAY 'ERROR - BEGINNING STN ' BEGIN-STN-IN ' AFTER ENDING STN ' END-STN-IN ', STATEMENT IGNORED' ADD 1 TO ERROR-COUNT GO TO EXIT-SET-STN. IF BEGIN-YR-MON-DAY-IN > END-YR-MON-DAY-IN DISPLAY 'ERROR - BEGINNING YR-MON-DAY ' BEGIN-YR-MON-DAY-IN ' AFTER ENDING YR-MON-DAY ' END-YR-MON-DAY-IN ', STATEMENT IGNORED' ADD 1 TO ERROR-COUNT GO TO EXIT-SET-STN. ADD 1 TO RANGE-NUM. IF RANGE-NUM > 1500 DISPLAY '*** ERROR - MORE THAN 1500 LIMITS SPECIFIED' ', THE FOLLOWING LIMITS IGNORED' DISPLAY INPUT-DATA MOVE 1500 TO RANGE-NUM ADD 1 TO ERROR-COUNT GO TO EXIT-SET-STN. MOVE BEGIN-STN-IN TO BEGIN-STN (RANGE-NUM). MOVE BEGIN-YR-MON-DAY-IN TO BEGIN-YR-MON-DAY (RANGE-NUM). MOVE END-STN-IN TO END-STN (RANGE-NUM). MOVE END-YR-MON-DAY-IN TO END-YR-MON-DAY (RANGE-NUM). MOVE 'F' TO DEFAULT-LIMITS. IF RANGE-NUM > 1 COMPUTE I = RANGE-NUM - 1 IF BEGIN-STN-IN < END-STN (I) DISPLAY '***ERROR - STATION LIMITS OUT OF SORT' ADD 1 TO ERROR-COUNT ELSE IF BEGIN-STN-IN = END-STN (I) AND BEGIN-YR-MON-DAY-IN < END-YR-MON-DAY (I) DISPLAY '***ERROR - STATION YR-MON-DAY LIMITS OUT' ' OF SORT' ADD 1 TO ERROR-COUNT. EXIT-SET-STN. EXIT. SET-WMO-SELECTION. 1 DISPLAY 'BEGIN STN = ' BEGIN-WMO-STN ' BEGIN YR-MON-DAY = ' 1 B-WMO-YR-MON-DAY-IN ' END STN = ' END-WMO-STN ' END YR-MON-DAY = ' E-WMO-YR-MON-DAY-IN. 1 IF BEGIN-WMO-STN > END-WMO-STN DISPLAY 'ERROR - BEGINNING STN ' BEGIN-WMO-STN 1 ' AFTER ENDING STN ' END-WMO-STN ', STATEMENT IGNORED' ADD 1 TO ERROR-COUNT 1 GO TO EXIT-SET-WMO. IF B-WMO-YR-MON-DAY-IN > E-WMO-YR-MON-DAY-IN DISPLAY 'ERROR - BEGINNING YR-MON-DAY ' BEGIN-YR-MON-DAY-IN ' AFTER ENDING YR-MON-DAY ' E-WMO-YR-MON-DAY-IN ', STATEMENT IGNORED' ADD 1 TO ERROR-COUNT 1 GO TO EXIT-SET-WMO. ADD 1 TO RANGE-NUM. IF RANGE-NUM > 1500 DISPLAY '*** ERROR - MORE THAN 1500 LIMITS SPECIFIED' ', THE FOLLOWING LIMITS IGNORED' DISPLAY WMO-INPUT-DATA MOVE 1500 TO RANGE-NUM ADD 1 TO ERROR-COUNT 1 GO TO EXIT-SET-WMO. 1 MOVE BEGIN-WMO-STN TO BEGIN-WMO (RANGE-NUM). MOVE B-WMO-YR-MON-DAY-IN TO BEGIN-YR-MON-DAY (RANGE-NUM). 1 MOVE END-WMO-STN TO END-WMO (RANGE-NUM). MOVE E-WMO-YR-MON-DAY-IN TO END-YR-MON-DAY (RANGE-NUM). MOVE 'F' TO DEFAULT-LIMITS. IF RANGE-NUM > 1 COMPUTE I = RANGE-NUM - 1 1 IF BEGIN-WMO-STN < END-WMO (I) DISPLAY '***ERROR - STATION LIMITS OUT OF SORT' ADD 1 TO ERROR-COUNT 1 ELSE IF BEGIN-WMO-STN = END-WMO (I) AND B-WMO-YR-MON-DAY-IN < END-YR-MON-DAY (I) DISPLAY '***ERROR - STATION YR-MON-DAY LIMITS OUT' ' OF SORT' ADD 1 TO ERROR-COUNT. EXIT-SET-WMO. EXIT. DETERMINE-OUTPUT-FILE. DISPLAY ' '. IF OUT-TYPE = 'AV' DISPLAY ' ANSI VARIABLE LENGTH OUTPUT SELECTED ' ELSE IF OUT-TYPE = 'FE' DISPLAY ' FIXED FORMAT OUTPUT SELECTED ' ELSE IF OUT-TYPE = 'DS' DISPLAY ' FIXED OUTPUT 68 RECORD LENGTH SELECTED' ELSE IF OUT-TYPE = 'DF' DISPLAY ' FIXED DISK O/P 2876 RECORD LENGTH SELECTED' ELSE IF OUT-TYPE = 'DV' DISPLAY ' VARIABLE OUTPUT RECORD LENGTH TO DISC SELECTED' ELSE DISPLAY '*** FATAL ERROR - UNKNOWN OUTPUT TYPE' ' SPECIFIED ' GO TO STOP-RUN. DISPLAY ' '. / READ-U-A-RECORDS. MOVE 'N' TO SURFACE-YES. READ U-A-RECORD AT END DISPLAY 'LAST RECORD DATE IS ' I-YR-MON-DAY GO TO STOP-RUN. IF RTN-CODE = 1 GO TO U-A-EOF ELSE IF RTN-CODE > 1 DISPLAY 'READ-ERROR AT RECORD ' READ-COUNT DISPLAY '**** ERROR STOP ****' GO TO STOP-RUN. IF READ-COUNT = 0 MOVE 1 TO CURRENT-RANGE PERFORM CK-SKIP IF TOTAL-READ-COUNT = 0 PERFORM DETERMINE-OUTPUT-FILE ADD 1 TO READ-COUNT. 1 IF H-IN-CODE = 'W' GO TO CHECK-WMO-ID-RANGE ELSE IF HOLD-W-IN-CODE = 'W' AND H-IN-CODE = 'P' GO TO CHECK-WMO-ID-RANGE 1 ELSE GO TO CHECK-ID-RANGE. 1 CK-SKIP. 1 IF H-IN-CODE = 'W' PERFORM SKIP-TO-WMO-DATA-WANTED ELSE IF HOLD-W-IN-CODE = 'W' AND H-IN-CODE = 'P' PERFORM SKIP-TO-WMO-DATA-WANTED ELSE PERFORM SKIP-TO-DATA-WANTED. CHECK-ID-RANGE. IF DEFAULT-LIMITS = 'F' 1 IF H-IN-CODE = 'W' GO TO CHECK-WMO-ID-RANGE 1 ELSE IF H-IN-CODE NOT = 'W' AND I-STN-ID < SRCH-STN GO TO READ-U-A-RECORDS ELSE IF H-IN-CODE NOT = 'W' AND I-STN-ID > LAST-STN OR (I-STN-ID = LAST-STN AND I-YR-MON-DAY > LAST-YR-MON-DAY) MOVE WRITE-COUNT TO PRINT-COUNT DISPLAY 'ALL DATA FOR INPUT KEY RANGE # ' CURRENT-RANGE ' SELECTED - ' PRINT-COUNT ' RECORDS NOW WRITTEN' ADD 1 TO CURRENT-RANGE IF CURRENT-RANGE > RANGE-NUM DISPLAY 'SCAN OF ' INPUT-REEL ' STOPS AS ' 'STN-YR-MON-DAY ' I-STN-ID '-' I-YR-MON-DAY ' IS BEYOND' ' DATA WANTED ' GO TO STOP-RUN ELSE PERFORM SKIP-TO-DATA-WANTED GO TO CHECK-ID-RANGE ELSE IF I-YR-MON-DAY > LAST-YR-MON-DAY OR < SRCH-YR-MON-DAY GO TO READ-U-A-RECORDS. * * IF NEARING THE END OF THE OUTPUT TAPE CHECK FOR A NEW STATION * TO BEGIN A NEW OUTPUT TAPE. * IF CHAR-COUNT > OUTPUT-CHAR-MAX IF H-IN-CODE = 'L' AND I-STN-ID NOT = PREVIOUS-STN ADD WRITE-COUNT TO TOTAL-WRITE-COUNT MOVE 0 TO WRITE-COUNT, CHAR-COUNT. MOVE I-STN-ID TO PREVIOUS-STN. 1 CHECK-WMO-ID-RANGE. IF DEFAULT-LIMITS = 'F' 1 IF H-IN-CODE = 'W' AND I-WMO-NUM < SRCH-WMO GO TO READ-U-A-RECORDS ELSE IF H-IN-CODE = 'W' AND I-WMO-NUM > LAST-WMO OR (I-WMO-NUM = LAST-WMO AND I-YR-MON-DAY > LAST-YR-MON-DAY) MOVE WRITE-COUNT TO PRINT-COUNT DISPLAY 'ALL DATA FOR INPUT KEY RANGE # ' CURRENT-RANGE ' SELECTED - ' PRINT-COUNT ' RECORDS NOW WRITTEN' ADD 1 TO CURRENT-RANGE IF CURRENT-RANGE > RANGE-NUM DISPLAY 'SCAN OF ' INPUT-REEL ' STOPS AS ' 'STN-YR-MON-DAY ' I-WMO-NUM '-' I-YR-MON-DAY ' IS BEYOND' ' DATA WANTED ' GO TO STOP-RUN ELSE 1 PERFORM SKIP-TO-WMO-DATA-WANTED GO TO CHECK-WMO-ID-RANGE ELSE IF I-YR-MON-DAY > LAST-YR-MON-DAY OR < SRCH-YR-MON-DAY GO TO READ-U-A-RECORDS. * * IF NEARING THE END OF THE OUTPUT TAPE CHECK FOR A NEW STATION * TO BEGIN A NEW OUTPUT TAPE. * IF CHAR-COUNT > OUTPUT-CHAR-MAX IF H-IN-CODE = 'W' AND I-WMO-NUM NOT = PREV-WMO ADD WRITE-COUNT TO TOTAL-WRITE-COUNT MOVE 0 TO WRITE-COUNT, CHAR-COUNT. 1 IF H-IN-CODE = 'W' AND I-WMO-NUM NOT = PREV-WMO MOVE I-WMO-NUM TO PREV-WMO. R-U-A-EXI. EXIT. / SEL-FORMATS. IF SWITCH-YES = 'Y' MOVE 'N' TO SWITCH-YES GO TO REPEAT-LOOP ELSE IF SWITCH-YES = 'N' GO TO BUILD-6201-REC ELSE DISPLAY '********* ERROR **********' DISPLAY '*ERROR* SELECT - AV, FE, DS, DV, OR DF - ONLY' GO TO STOP-RUN. EXTRA-REC. IF SWITCH-YES = 'Y' MOVE 0 TO I GO READ-U-A-RECORDS. *******THE CONVERSION PROCESS STARTS HERE. ************************ BUILD-MORE. IF J < 001 GO TO READ-U-A-RECORDS. IF OUT-TYPE = 'AV' MOVE J TO WS-NUM-LEVELS PERFORM WRITE-ANSI-RECORD THRU WR-ANSI-XIT ADD 1 TO WRITE-COUNT GO TO READ-U-A-RECORDS ELSE IF OUT-TYPE = 'FE' MOVE J TO WS-NUM-SAVE MOVE 0 TO J, I PERFORM WRITE-FIXED-RECORD THRU WRITE-XIT ADD 1 TO WRITE-COUNT GO TO READ-U-A-RECORDS ELSE IF OUT-TYPE = 'DF' MOVE J TO WS-NUM-SAVE MOVE 0 TO J, I PERFORM WRITE-FIXED-RECORD THRU WRITE-XIT ADD 1 TO WRITE-COUNT GO TO READ-U-A-RECORDS ELSE IF OUT-TYPE = 'DS' MOVE J TO WS-NUM-SAVE MOVE 0 TO J PERFORM WRITE-DISC-68 THRU WR-68-XIT ADD 1 TO WRITE-COUNT GO TO READ-U-A-RECORDS ELSE IF OUT-TYPE = 'DV' MOVE J TO WS-NUM-SAVE MOVE 0 TO J PERFORM WRITE-VAR-DISC THRU WR-VAR-XIT ADD 1 TO WRITE-COUNT GO TO READ-U-A-RECORDS. ******** THE CONVERSION RECORD IS BUILD HERE ******************* ******** ONE DATA RECORD IS READ INTO THE ARRAYS ******** ******** THE ENTIRE FLIGHT MAY CONTAIN MANY RECORDS ***** ******** WHICH ARE PROCESSED BEFORE WRITING IS DONE ***** ******** 10/28/1999 changed if loop to not remove some data ********* BUILD-6201-REC. IF I-DATA-SOURCE = '00' AND I-NUM-LEVELS < 002 GO TO READ-U-A-RECORDS ELSE IF I-DATA-SOURCE NOT = '00' AND I-NUM-LEVELS < 002 GO TO READ-U-A-RECORDS. MOVE I-YR-MON-DAY TO REM-YMD. MOVE I-HOUR TO REM-HR. IF H-IN-CODE = 'W' MOVE I-WMO-NUM TO TEMP-WMO MOVE TMP-WBAN-FIVE TO WBAN-FIVE MOVE WBAN-ALL TO WS-STN-ID ELSE MOVE I-STN-ID TO WS-STN-ID. MOVE I-LATITUDE-NUM TO WS-LAT-NUM MULTIPLY I-LAT-MIN BY 60 GIVING LAT-MINUTES ROUNDED. MOVE LAT-WHOLE-MIN TO WS-LAT-MIN. MOVE I-LATITUDE-ALPH TO WS-LAT-ALPH MOVE I-LONGITUDE-NUM TO WS-LONG-NUM MULTIPLY I-LONG-MIN BY 60 GIVING LON-MINUTES ROUNDED. MOVE LON-WHOLE-MIN TO WS-LONG-MIN. MOVE I-LONGITUDE-ALPH TO WS-LONG-ALPH. MOVE I-YR-MON-DAY TO WS-YR-MON-DAY MOVE I-HOUR TO WS-HOUR MOVE I-NUM-LEVELS TO WS-NUM-LEVELS MOVE 'N' TO GOT-SFC-LEV. MOVE 0 TO I. MOVE 0 TO J. ******** THE ARA ******** THE ARRAYS ARE BUILD HERE ELIMINATING UNWANTED ***** ******** RECORDS AND CODES. ALL OF THE FLIGHT IS PROCESSED **** REPEAT-LOOP. ADD 1 TO I. IF I = 175 AND I-MORE-RECS NOT < 001 MOVE 'Y' TO SWITCH-YES. IF I > I-NUM-LEVELS AND SWITCH-YES = 'Y' GO TO EXTRA-REC ELSE IF I > I-NUM-LEVELS GO TO BUILD-MORE. IF I-QUAL-IND(I) = '2' OR '3' OR '4' OR '5' OR '6' OR '7' GO TO REPEAT-LOOP. ******THE NEXT 8 LINE WERE ENTERED TO CORRECT SURFACE CODES**** IF I-QUAL-IND(I) = '1' AND I-DATA-SOURCE = '01' AND I-YEAR < 1993 AND I-TYP-LEVEL(I) = '71' GO TO REPEAT-LOOP ELSE IF I-QUAL-IND(I) = '1' AND I-DATA-SOURCE = '01' AND I-YEAR < 1993 AND I-TYP-LEVEL(I) = '12' AND I < 6 MOVE '31' TO I-TYP-LEVEL(I). IF I-QUAL-IND(I) = '0' AND I-DATA-SOURCE = '01' AND I-YEAR < 1993 AND I-TYP-LEVEL(I) = '83' AND I < 6 MOVE '31' TO I-TYP-LEVEL(I). IF MIN-WINDS = 'N' AND I-TYP-LEVEL(I) = '43' GO TO REPEAT-LOOP. IF I-WIND-DIR(I) NOT = 999 AND I-W-SPEED(I) > 140 GO TO REPEAT-LOOP. IF MIN-WINDS = 'N' AND I-PRES(I) = '99999' GO TO REPEAT-LOOP. MOVE I-WIND-SPD(I) TO CORRECT-WINDS. IF I-DATA-SOURCE = '00' AND I-EQP(I) = 'T ' MOVE I-PRES(I) TO SAVE-PRESS GO TO REPEAT-LOOP. IF I-DATA-SOURCE = '00' AND I-PRES(I) = SAVE-PRESS AND I-TYP-LEVEL(I) = '42' GO TO REPEAT-LOOP ELSE IF I-DATA-SOURCE = '00' AND I-PRES(I) = SAVE-PRESS AND I-TYP-LEVEL(I) = '44' GO TO REPEAT-LOOP ELSE MOVE I-PRES(I) TO SAVE-PRESS. ADD 1 TO J. IF MIN-WINDS = 'N' AND J > 199 DISPLAY 'MORE THAN 200 LEVELS' GO TO BUILD-MORE. IF MIN-WINDS = 'Y' AND J > 249 DISPLAY 'MORE THAN 250 LEVELS' GO TO BUILD-MORE. MOVE I-QUAL-IND(I) TO WS-QUAL-IND(J). IF I-QUAL-IND(I) = '8' MOVE '6' TO WS-QUAL-IND(J). IF I-PRES(I) NOT = '99999' AND I-P-R(I) > '4' ADD 1 TO I-PRES(I). IF I-E-T(I) < 06 MOVE 0 TO WS-EL-T(J). IF I-E-T(I) > 05 AND < 12 MOVE 1 TO WS-EL-T(J). IF I-E-T(I) > 11 AND < 18 MOVE 2 TO WS-EL-T(J). IF I-E-T(I) > 17 AND < 24 MOVE 3 TO WS-EL-T(J). IF I-E-T(I) > 23 AND < 30 MOVE 4 TO WS-EL-T(J). IF I-E-T(I) > 29 AND < 36 MOVE 5 TO WS-EL-T(J). IF I-E-T(I) > 35 AND < 42 MOVE 6 TO WS-EL-T(J). IF I-E-T(I) > 41 AND < 48 MOVE 7 TO WS-EL-T(J). IF I-E-T(I) > 47 AND < 54 MOVE 8 TO WS-EL-T(J). IF I-E-T(I) > 53 MOVE 9 TO WS-EL-T(J). MOVE I-EL-TIME(I) TO WS-EL-TM(J). MOVE I-PRES(I) TO WS-PRESS(J). IF I-HT-ALFA(I) = '-' MOVE '-' TO WS-HT-ALFA(J). IF I-HT-ALFA(I) = '+' MOVE '+' TO WS-HT-ALFA(J). MOVE I-HGT-IN(I) TO WS-HGT(J). IF I-TMP-ALFA(I) = '-' MOVE '-' TO WS-TMP-ALFA(J). IF I-TMP-ALFA(I) = '+' MOVE '+' TO WS-TMP-ALFA(J). MOVE TEMP-ALF(I) TO RH-SIGN. IF I-TEMP-IN(I) = 999 AND I-TMP-ALFA(I) = '+' MOVE '-' TO WS-TMP-ALFA(J). MOVE I-TEMP-IN(I) TO WS-TEMP(J). MOVE TEMP-TO-RH(I) TO RH-TEMP. IF I-REL-HM(I) NOT = '999' AND I-R-H(I) > '4' ADD 1 TO I-REL-HM(I). MOVE I-REL-HM(I) TO WS-REL-HUM(J). MOVE I-DPDP(I) TO DEW-POINT. MOVE I-WIND-DIR(I) TO WS-WIND(J). ****** WIND SPEED IS WRONG IN TD-6302 AND DUE TO THIS THE **** FOLLOWING SHIFT IN POSITIONS ARE MADE. ************CHANGED '00' TO '99' AFTER DATA WAS SUPPOSELY FIXED.. IF I-DATA-SOURCE = '99' MOVE WIND-REST TO WS-WD-SPD(J) ELSE IF I-W-SPEED(I) NOT = '999' AND I-W-S(I) > '4' ADD 1 TO I-W-SPEED(I). MOVE I-W-SPEED(I) TO WS-WD-SPD(J). MOVE '3' TO WS-T-LEVEL(J). * ADDED BY TOM WHITEHURST IF WS-T-LEVEL(J) = '3' MOVE '9999993' TO WS-FLAGS(J). IF CK-FOR-SFC > 8 MOVE 0 TO CK-FOR-SFC MOVE 'N' TO GOT-SFC-LEV ADD 1 TO DISPLAY-CNT IF DISPLAY-CNT < 100 DISPLAY 'NO SURFACE FOUND IN THIS OB' DISPLAY ID-INFO GO TO READ-U-A-RECORDS ELSE IF DISPLAY-CNT = 100 DISPLAY '100 Message limit exceeded ' GO TO READ-U-A-RECORDS ELSE GO TO READ-U-A-RECORDS. * IF CK-FOR-SFC < 9 * IF I-TYP-LEVEL(I) = '31' MOVE '0' TO WS-T-LEVEL(J) * MOVE 'Y' TO SURFACE-YES MOVE 0 TO CK-FOR-SFC * MOVE 'Y' TO GOT-SFC-LEV * ELSE IF GOT-SFC-LEV = 'N' AND I-TYP-LEVEL(I) NOT = '31' * ADD 1 TO CK-FOR-SFC * GO TO REPEAT-LOOP. IF I-TYP-LEVEL(I) = '31' MOVE '0' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '33' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '09' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '10' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '11' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '12' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '13' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '14' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '15' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '16' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '17' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '28' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '32' MOVE '1' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '37' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) > '68' AND < '78' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) > '81' AND < '89' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '51' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '13' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '44' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '38' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '39' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '42' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '22' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '23' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '24' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '25' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '34' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '35' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '36' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '45' MOVE '2' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '26' MOVE '4' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) > '58' AND < '68' MOVE '4' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '27' MOVE '5' TO WS-T-LEVEL(J). IF I-TYP-LEVEL(I) = '46' MOVE '9' TO WS-T-LEVEL(J). IF MIN-WINDS = 'Y' AND I-TYP-LEVEL(I) = '43' MOVE '6' TO WS-T-LEVEL(J). IF I-QUAL-IND(I) = '0' MOVE '0' TO WS-QET(J). IF I-QUAL-IND(I) = '8' AND I-EQET(I) > '00' MOVE '3' TO WS-QET(J) ELSE IF I-QUAL-IND(I) = '1' AND I-EQET(I) > '00' MOVE '4' TO WS-QET(J) ELSE IF I-QUAL-IND(I) = '9' AND I-EQET(I) > '00' MOVE '9' TO WS-QET(J) ELSE MOVE '0' TO WS-QET(J). IF I-QUAL-IND(I) = '0' MOVE '0' TO WS-QP(J). IF I-QUAL-IND(I) = '8' AND I-EQP(I) > '00' MOVE '3' TO WS-QP(J) ELSE IF I-QUAL-IND(I) = '1' AND I-EQP(I) > '00' MOVE '4' TO WS-QP(J) ELSE IF I-QUAL-IND(I) = '9' AND I-EQP(I) > '00' MOVE '9' TO WS-QP(J) ELSE MOVE '0' TO WS-QP(J). IF I-QUAL-IND(I) = '0' MOVE '0' TO WS-QH(J). IF I-QUAL-IND(I) = '8' AND I-EQH(I) > '00' MOVE '3' TO WS-QH(J) ELSE IF I-QUAL-IND(I) = '1' AND I-EQH(I) > '00' MOVE '4' TO WS-QH(J) ELSE IF I-QUAL-IND(I) = '9' AND I-EQH(I) > '00' MOVE '9' TO WS-QH(J) ELSE MOVE '0' TO WS-QH(J). IF I-QUAL-IND(I) = '0' MOVE '0' TO WS-QT(J). IF I-QUAL-IND(I) = '8' AND I-EQT(I) > '00' MOVE '3' TO WS-QT(J) ELSE IF I-QUAL-IND(I) = '1' AND I-EQT(I) > '00' MOVE '4' TO WS-QT(J) ELSE IF I-QUAL-IND(I) = '9' AND I-EQT(I) > '00' MOVE '9' TO WS-QT(J) ELSE MOVE '0' TO WS-QT(J). IF I-QUAL-IND(I) = '0' MOVE '0' TO WS-QU(J). IF I-QUAL-IND(I) = '8' AND I-EQU(I) > '00' MOVE '3' TO WS-QU(J) ELSE IF I-QUAL-IND(I) = '1' AND I-EQU(I) > '00' MOVE '4' TO WS-QU(J) ELSE IF I-QUAL-IND(I) = '9' AND I-EQU(I) > '00' MOVE '9' TO WS-QU(J) ELSE MOVE '0' TO WS-QU(J). IF I-QUAL-IND(I) = '0' MOVE '0' TO WS-QWDS(J). IF I-QUAL-IND(I) = '8' AND I-EQWDS(I) > '00' MOVE '3' TO WS-QWDS(J) ELSE IF I-QUAL-IND(I) = '1' AND I-EQWDS(I) > '00' MOVE '4' TO WS-QWDS(J) ELSE IF I-QUAL-IND(I) = '9' AND I-EQWDS(I) > '00' MOVE '9' TO WS-QWDS(J) ELSE MOVE '0' TO WS-QWDS(J). IF I-DATA-SOURCE = '00' PERFORM COMPUTE-RH THRU COMP-XIT. GO TO REPEAT-LOOP. BUILD-XIT. EXIT. COMPUTE-RH. IF RH-SIGN = '-' NEXT SENTENCE, ELSE GO TO 300. MULTIPLY RH-TEMP BY -1 GIVING GETTMP GETTMP-1. GO TO 310. 300. MOVE RH-TEMP TO GETTMP GETTMP-1 . IF RH-TEMP NEGATIVE OR RH-TEMP = 99.9 MOVE '-' TO TEMP-SIGN ELSE MOVE '+' TO TEMP-SIGN. 310. IF GETTMP-1 = 99.9 OR DEW-POINT = 99.9 MOVE 999 TO WS-REL-HUM(J) GO TO COMP-XIT. SUBTRACT DEW-POINT FROM GETTMP GIVING DEW-DEP. COMPUTE F-TEMP = ((1.8 * GETTMP) + 32). COMPUTE F-DEWPT = ((1.8 * DEW-DEP) + 32). COMPUTE COMP-RH-1 ROUNDED = (173 - (.1 * F-TEMP) + F-DEWPT). COMPUTE COMP-RH-2 ROUNDED = (173 + (.9 * F-TEMP)). COMPUTE DIVIDE-TEMP ROUNDED = COMP-RH-1 / COMP-RH-2. COMPUTE RH-FACTOR ROUNDED = DIVIDE-TEMP ** 8. COMPUTE R-HUM ROUNDED = RH-FACTOR * 100. IF R-HUM > 100 MOVE 100 TO R-HUM. IF RH-FACTOR NEGATIVE MOVE +0 TO R-HUM. MOVE R-HUM TO WS-REL-HUM(J). COMP-XIT. EXIT. U-A-EOF. ADD 1 TO CURRENT-REEL. IF CURRENT-REEL NOT > NUM-REELS ADD READ-COUNT TO TOTAL-READ-COUNT MOVE 0 TO READ-COUNT MOVE 1 TO START-READ GO TO READ-U-A-RECORDS. NO-MORE-DATA. EXIT. SKIP-TO-DATA-WANTED. IF DEFAULT-LIMITS = 'F' MOVE BEGIN-STN (CURRENT-RANGE) TO SRCH-STN MOVE END-STN (CURRENT-RANGE) TO LAST-STN MOVE BEGIN-YR-MON-DAY (CURRENT-RANGE) TO SRCH-YR-MON-DAY MOVE END-YR-MON-DAY (CURRENT-RANGE) TO LAST-YR-MON-DAY IF I-STN-ID < SRCH-STN OR (I-STN-ID = SRCH-STN AND I-YR-MON-DAY < SRCH-YR-MON-DAY) ADD SKIP-COUNT TO BLOCKS-SKIPPED IF RTN-CODE > 1 DISPLAY '****** ERROR STOP ******' DISPLAY ' RUN ABANDONED BECAUSE OF FATAL ERROR ' 'IN FD6300 AT BLOCK ' BLOCKS-SKIPPED GO TO STOP-RUN. 1 SKIP-TO-WMO-DATA-WANTED. IF DEFAULT-LIMITS = 'F' MOVE BEGIN-WMO (CURRENT-RANGE) TO SRCH-WMO MOVE END-WMO (CURRENT-RANGE) TO LAST-WMO MOVE BEGIN-YR-MON-DAY (CURRENT-RANGE) TO SRCH-YR-MON-DAY MOVE END-YR-MON-DAY (CURRENT-RANGE) TO LAST-YR-MON-DAY IF I-WMO-NUM < SRCH-WMO OR (I-WMO-NUM = SRCH-WMO AND I-YR-MON-DAY < SRCH-YR-MON-DAY) ADD SKIP-COUNT TO BLOCKS-SKIPPED IF RTN-CODE > 1 DISPLAY '****** ERROR STOP ******' DISPLAY ' RUN ABANDONED BECAUSE OF FATAL ERROR ' 'IN FD6302 AT BLOCK ' BLOCKS-SKIPPED GO TO STOP-RUN. WRITE-ANSI-RECORD. COMPUTE CHAR-COUNT = CHAR-COUNT + 40 + WS-NUM-LEVELS * 36. WR-ANSI-XIT. EXIT. *------------------------------------------------------------------- WRITE-FIXED-RECORD. MOVE WS-ID-INFO TO F-ID-2876. MOVE 79 TO F-NUM-LEV-2876. GO TO SET-LEV-2876. SET-LEV-2876. ADD 1 TO I, J. MOVE WS-LEVEL-RECORD(I) TO F-LEVEL-REC-2876(J). IF I < WS-NUM-SAVE AND J < 79 GO TO SET-LEV-2876. IF J = F-NUM-LEV-2876 AND I < WS-NUM-SAVE GO TO WRITE-REC-FIX-2876 ELSE IF I = WS-NUM-SAVE AND J < 79 PERFORM FIL-BLANK-LEVEL UNTIL J = 79. WRITE-REC-FIX-2876. MOVE WS-ID-INFO TO F-ID-2876. WRITE U-A-F-2876 COMPUTE CHAR-COUNT = CHAR-COUNT + (2876 * 1.25) MOVE 0 TO J. IF I = WS-NUM-SAVE GO TO WRITE-XIT ELSE GO TO WRITE-FIXED-RECORD. FIL-BLANK-LEVEL. ADD 1 TO J. MOVE '1999999999-99999-9999999999999999999' TO F-LEVEL-VAL-2876(J). WRITE-XIT. EXIT. WRITE-DISC-68. ADD 1 TO J. IF J > WS-NUM-SAVE GO TO WR-68-XIT. MOVE WS-ID-INFO TO 68-ID-INFO MOVE 1 TO 68-NUM-LEVELS. MOVE WS-LEVEL-RECORD(J) TO 68-LEVEL-VALUE. WRITE U-A-DS-68 COMPUTE CHAR-COUNT = CHAR-COUNT + 68 GO TO WRITE-DISC-68. WR-68-XIT. EXIT. WRITE-VAR-DISC. MOVE WS-ID-INFO TO D-ID-INFO. IF WS-NUM-SAVE > 250 MOVE 250 TO WS-NUM-SAVE. MOVE WS-NUM-SAVE TO D-NUM-LEVELS. LOOP-D-REC. ADD 1 TO J. IF J > WS-NUM-SAVE NEXT SENTENCE ELSE MOVE WS-LEVEL-RECORD(J) TO D-LEVEL-VALUES(J) GO TO LOOP-D-REC. WRITE U-A-DISC-REC. WR-VAR-XIT. EXIT. ERROR-STOP. DISPLAY ' EXTRA RECORDS ARE NOT PRESENT AS INDICATED' DISPLAY ' CONTACT DATABASE MANAGEMENT PERSONNEL' STOP RUN.