SUBROUTINE W3FI64(COCBUF,LOCRPT,NEXT) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: W3FI64 NMC OFFICE NOTE 29 REPORT UNPACKER C PRGMMR: KEYSER ORG: NMC22 DATE:92-08-06 C C ABSTRACT: UNPACKS AN ARRAY OF UPPER-AIR REPORTS THAT ARE PACKED IN C THE FORMAT DESCRIBED BY NMC OFFICE NOTE 29, OR UNPACKS AN ARRAY C OF SURFACE REPORTS THAT ARE PACKED IN THE FORMAT DESCRIBED BY NMC C OFFICE NOTE 124. INPUT CHARACTER DATA ARE CONVERTED TO INTEGER, C REAL OR CHARACTER TYPE AS SPECIFIED IN THE CATEGORY TABLES BELOW. C MISSING INTEGER DATA ARE REPLACED WITH 99999, MISSING REAL DATA C ARE REPLACED WITH 99999.0 AND MISSING CHARACTER DATA ARE REPLACED C WITH BLANKS. THIS LIBRARY IS SIMILAR TO W3AI02 EXCEPT W3AI02 C WAS WRITTEN IN ASSEMBLER AND COULD NOT HANDLE INTERNAL READ ERRORS C (PROGRAM CALLING W3AI02 WOULD FAIL IN THIS CASE W/O EXPLANATION). C C PROGRAM HISTORY LOG: C 90-01-?? L. MARX, UNIV. OF MD -- CONVERTED CODE FROM ASSEMBLER C TO VS FORTRAN; EXPANDED ERROR RETURN CODES IN 'NEXT' C 91-07-22 D. A. KEYSER, NMC22 -- USE SAME ARGUMENTS AS W3AI02; C STREAMLINED CODE; DOCBLOCKED AND COMMENTED; DIAG- C NOSTIC PRINT FOR ERRORS; ATTEMPTS TO SKIP TO NEXT C REPORT IN SAME RECORD RATHER THAN EXITING RECORD C 91-08-12 D. A. KEYSER, NMC22 -- SLIGHT CHANGES TO MAKE SUB- C PROGRAM MORE PORTABLE; TEST FOR ABSENCE OF END- C OF-RECORD INDICATOR, WILL GRACEFULLY EXIT RECORD C 92-06-29 D. A. KEYSER W/NMC22 -- CONVERT TO CRAY CFT77 FORTRAN C 92-08-06 D. A. KEYSER, NMC22 -- CORRECTED ERROR WHICH COULD C LEAD TO THE LENGTH FOR A CONCATENATION OPERATOR C BEING LESS THAN 1 WHEN AN INPUT PARAMETER SPANS C ACROSS TWO 10-CHARACTER WORDS C C USAGE: CALL W3FI64(COCBUF,LOCRPT,NEXT) C INPUT ARGUMENT LIST: C COCBUF - CHARACTER*10 ARRAY CONTAINING A BLOCK OF PACKED C - REPORTS IN NMC OFFICE NOTE 29/124 FORMAT. C NEXT - MARKER INDICATING RELATIVE LOCATION (IN BYTES) OF C - END OF LAST REPORT IN COCBUF. EXCEPTION: NEXT MUST C - BE SET TO ZERO PRIOR TO UNPACKING THE FIRST REPORT OF C - A NEW BLOCK OF REPORTS. SUBSEQUENTLY, THE VALUE OF C - NEXT RETURNED BY THE PREVIOUS CALL TO W3FI64 SHOULD C - BE USED AS INPUT. (SEE OUTPUT ARGUMENT LIST BELOW.) C - IF NEXT IS NEGATIVE, W3FI64 WILL RETURN IMMEDIATELY C - WITHOUT ACTION. C C OUTPUT ARGUMENT LIST: C LOCRPT - ARRAY CONTAINING ONE UNPACKED REPORT WITH POINTERS C - AND COUNTERS TO DIRECT THE USER. LOCRPT MUST BEGIN C - ON A FULLWORD BOUNDARY. FORMAT IS MIXED, USER MUST C - EQUIVALENCE REAL AND CHARACTER ARRAYS TO THIS ARRAY C - (SEE BELOW AND REMARKS FOR CONTENT). C *************************************************************** C WORD CONTENT UNIT FORMAT C ---- ---------------------- ------------------- --------- C 1 LATITUDE 0.01 DEGREES REAL C 2 LONGITUDE 0.01 DEGREES WEST REAL C 3 UNUSED C 4 OBSERVATION TIME 0.01 HOURS (UTC) REAL C 5 RESERVED (3RD BYTE IS 4-CHARACTERS CHAR*8 C ON29 "25'TH CHAR.; 4TH LEFT-JUSTIFIED C BYTE IS ON29 "26'TH C CHAR." (SEE ON29) C 6 RESERVED (3RD BYTE IS 3-CHARACTERS CHAR*8 C ON29 "27'TH CHAR. (SEE LEFT-JUSTIFIED C ON29) C 7 STATION ELEVATION METERS REAL C 8 INSTRUMENT TYPE ON29 TABLE R.2 INTEGER C 9 REPORT TYPE ON29 TABLE R.1 OR INTEGER C ON124 TABLE S.3 C 10 UNUNSED C 11 STN. ID. (FIRST 4 CHAR.) 4-CHARACTERS CHAR*8 C LEFT-JUSTIFIED C 12 STN. ID. (LAST 2 CHAR.) 2-CHARACTERS CHAR*8 C LEFT-JUSTIFIED C C 13 CATEGORY 1, NO. LEVELS COUNT INTEGER C 14 CATEGORY 1, DATA INDEX COUNT INTEGER C 15 CATEGORY 2, NO. LEVELS COUNT INTEGER C 16 CATEGORY 2, DATA INDEX COUNT INTEGER C 17 CATEGORY 3, NO. LEVELS COUNT INTEGER C 18 CATEGORY 3, DATA INDEX COUNT INTEGER C 19 CATEGORY 4, NO. LEVELS COUNT INTEGER C 20 CATEGORY 4, DATA INDEX COUNT INTEGER C 21 CATEGORY 5, NO. LEVELS COUNT INTEGER C 22 CATEGORY 5, DATA INDEX COUNT INTEGER C 23 CATEGORY 6, NO. LEVELS COUNT INTEGER C 24 CATEGORY 6, DATA INDEX COUNT INTEGER C 25 CATEGORY 7, NO. LEVELS COUNT INTEGER C 26 CATEGORY 7, DATA INDEX COUNT INTEGER C 27 CATEGORY 8, NO. LEVELS COUNT INTEGER C 28 CATEGORY 8, DATA INDEX COUNT INTEGER C 29 CATEGORY 51, NO. LEVELS COUNT INTEGER C 30 CATEGORY 51, DATA INDEX COUNT INTEGER C 31 CATEGORY 52, NO. LEVELS COUNT INTEGER C 32 CATEGORY 52, DATA INDEX COUNT INTEGER C 33 CATEGORY 9, NO. LEVELS COUNT INTEGER C 34 CATEGORY 9, DATA INDEX COUNT INTEGER C 35-42 ZEROED OUT - NOT USED INTEGER C C 43-END UNPACKED DATA GROUPS (SEE REMARKS) MIXED C *************************************************************** C C NEXT - MARKER INDICATING RELATIVE LOCATION (IN BYTES) C - OF END OF CURRENT REPORT IN COCBUF. NEXT WILL BE C - SET TO -1 IF W3FI64 ENCOUNTERS STRING 'END RECORD' C - IN PLACE OF THE NEXT REPORT. THIS IS THE END OF THE C - BLOCK. NO UNPACKING TAKES PLACE. NEXT IS SET TO-2 C - WHEN INTERNAL (LOGIC) ERRORS HAVE BEEN DETECTED. C - NEXT IS SET TO -3 WHEN DATA COUNT CHECK FAILS. IN C - BOTH OF THE LATTER CASES SOME DATA (E.G., HEADER C - INFORMATION) MAY BE UNPACKED INTO LOCRPT. C C OUTPUT FILES: C FT06F001 - PRINTOUT C C REMARKS: AFTER FIRST READING AND PROCESSING THE OFFICE NOTE 85 C (FIRST) DATE RECORD, THE USER'S FORTRAN PROGRAM BEGINS A READ C LOOP AS FOLLOWS.. FOR EACH ITERATION A BLOCKED INPUT REPORT IS C READ INTO ARRAY COCBUF. NOW TEST THE FIRST TEN CHARACTERS IN C COCBUF FOR THE STRING 'ENDOF FILE' (SIC). THIS STRING SIGNALS C THE END OF INPUT. OTHERWISE, SET THE MARKER 'NEXT' TO ZERO AND C BEGIN THE UNPACKING LOOP. C EACH ITERATION OF THE UNPACKING LOOP CONSISTS OF A CALL TO C W3FI64 WITH THE CURRENT VALUE OF 'NEXT'. IF 'NEXT' IS -1 UPON C RETURNING FROM W3FI64, IT HAS REACHED THE END OF THE INPUT C RECORD, AND THE USER'S PROGRAM SHOULD READ THE NEXT RECORD AS C ABOVE. IF 'NEXT' IS -2 OR -3 UPON RETURNING, THERE IS A GRIEVOUS C ERROR IN THE CURRENT PACKED INPUT RECORD, AND THE USER'S PROGRAM C SHOULD PRINT IT FOR EXAMINATION BY AUTOMATION DIVISION PERSONNEL. C IF 'NEXT' IS POSITIVE, THE OUTPUT STRUCTURE LOCRPT CONTAINS C AN UNPACKED REPORT, AND THE USER'S PROGRAM SHOULD PROCESS IT AT C THIS POINT, SUBSEQUENTLY REPEATING THE UNPACKING LOOP. C C EXAMPLE: C CHARACTER*10 COCBUF(644) C CHARACTER*8 COCRPT(1608) C CHARACTER*3 CQUMAN(20) C INTEGER LOCRPT(1608) C REAL ROCRPT(1608),GEOMAN(20),TMPMAN(20),DPDMAN(20), C $ WDRMAN(20),WSPMAN(20) C EQUIVALENCE (COCRPT,LOCRPT,ROCRPT) C .......... C C READ AND PROCESS THE OFFICE NOTE 85 DATE RECORD C .......... C C --- BEGIN READ LOOP C 10 CONTINUE C READ (UNIT=INP, IOSTAT=IOS, NUM=NBUF) COCBUF C IF(IOS .LT. 0) GO TO (END OF INPUT) C IF(IOS .GT. 0) GO TO (INPUT ERROR) C IF(NBUF .GT. 6432) GO TO (BUFFER OVERFLOW) C IF(COCBUF(1).EQ.'ENDOF FILE') GO TO (END OF INPUT) C NEXT = 0 C C ------ BEGIN UNPACKING LOOP C 20 CONTINUE C CALL W3FI64(COCBUF, LOCRPT, NEXT) C IF(NEXT .EQ. -1) GO TO 10 C IF(NEXT .LT. -1) GO TO (OFFICE NOTE 29/124 ERROR) C RLAT = 0.01 * ROCRPT(1) (LATITUDE) C ..... ETC ..... C C --- BEGIN CATEGORY 1 FETCH -- MANDATORY LEVEL DATA C IF(LOCRPT(13) .GT. 0) THEN C NLVLS = MIN(20,LOCRPT(13)) C INDX = LOCRPT(14) C DO 66 I = 1,NLVLS C GEOMAN(I) = ROCRPT(INDX) C TMPMAN(I) = 0.1 * ROCRPT(INDX+1) C DPDMAN(I) = 0.1 * ROCRPT(INDX+2) C WDRMAN(I) = ROCRPT(INDX+3) C WSPMAN(I) = ROCRPT(INDX+4) C CQUMAN(I) = COCRPT(INDX+5) C INDX = INDX + 6 C 66 CONTINUE C END IF C ..... ETC ..... C GO TO 20 C ............... C C DATA FROM THE ON29/124 RECORD IS UNPACKED INTO FIXED LOCATIONS C IN WORDS 1-12 AND INTO INDEXED LOCATIONS IN WORD 43 AND C FOLLOWING. STUDY ON29 APPENDIX C/ON124 APPENDIX S.2 CAREFULLY. C EACH CATEGORY (OR GROUP OF FIELDS) IN THE PACKED REPORT HAS A C CORRESPONDING LAYOUT IN LOCATIONS IN ARRAY LOCRPT THAT MAY BE C FOUND BY USING THE CORRESPONDING INDEX AMOUNT FROM WORDS 14, 16, C ..., 34, IN ARRAY LOCRPT. FOR INSTANCE, IF A REPORT CONTAINS C ONE OR MORE PACKED CATEGORY 3 DATA GROUPS (WIND DATA AT VARIABLE C PRESSURE LEVELS) THAT DATA WILL BE UNPACKED INTO BINARY AND C AND CHARACTER FIELDS IN ONE OR MORE UNPACKED CATEGORY 3 DATA C GROUPS AS DESCRIBED BELOW. THE NUMBER OF LEVELS WILL BE STORED C IN WORD 17 AND THE INDEX IN FULLWORDS OF THE FIRST LEVEL OF C UNPACKED DATA IN THE OUTPUT ARRAY WILL BE STORED IN WORD 18. C THE SECOND LEVEL, IF ANY, WILL BE STORED BEGINNING FOUR WORDS C FURTHER ON, AND SO FORTH UNTIL THE COUNT IN WORD 17 IS C EXHAUSTED. THE FIELD LAYOUT IN EACH CATEGORY IS GIVEN BELOW... C C CATEGORY 1 - MANDATORY LEVEL DATA C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 GEOPOTENTIAL METERS REAL C 2 TEMPERATURE 0.1 DEGREES C REAL C 3 DEWPOINT DEPRESSION 0.1 DEGREES C REAL C 4 WIND DIRECTION DEGREES REAL C 5 WIND SPEED KNOTS REAL C 6 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C GEOPOTENTIAL ON29 TABLE Q.A C TEMPERATURE ON29 TABLE Q.A C DEWPOINT DEPR. ON29 TABLE Q.C C WIND ON29 TABLE Q.A C C CATEGORY 2 - TEMPERATURE AT VARIABLE PRESSURE C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 PRESSURE 0.1 MILLIBARS REAL C 2 TEMPERATURE 0.1 DEGREES C REAL C 3 DEWPOINT DEPRESSION 0.1 DEGREES C REAL C 4 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C PRESSURE ON29 TABLE Q.B C TEMPERATURE ON29 TABLE Q.A C DEWPOINT DEPR. ON29 TABLE Q.C C NOT USED BLANK C C CATEGORY 3 - WINDS AT VARIABLE PRESSURE C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 PRESSURE 0.1 MILLIBARS REAL C 2 WIND DIRECTION DEGREES REAL C 3 WIND SPEED KNOTS REAL C 4 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C PRESSURE ON29 TABLE Q.B C WIND ON29 TABLE Q.A C NOT USED BLANK C NOT USED BLANK C C CATEGORY 4 - WINDS AT VARIABLE HEIGHTS C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 GEOPOTENTIAL METERS REAL C 2 WIND DIRECTION DEGREES REAL C 3 WIND SPEED KNOTS REAL C 4 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C GEOPOTENTIAL ON29 TABLE Q.B C WIND ON29 TABLE Q.A C NOT USED BLANK C NOT USED BLANK C C CATEGORY 5 - TROPOPAUSE DATA C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 GEOPOTENTIAL METERS REAL C 2 TEMPERATURE 0.1 DEGREES C REAL C 3 DEWPOINT DEPRESSION 0.1 DEGREES C REAL C 4 WIND DIRECTION DEGREES REAL C 5 WIND SPEED KNOTS REAL C 6 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C PRESSURE ON29 TABLE Q.B C TEMPERATURE ON29 TABLE Q.A C DEWPOINT DEPR. ON29 TABLE Q.C C WIND ON29 TABLE Q.A C C CATEGORY 6 - CONSTANT-LEVEL DATA (AIRCRAFT, SAT. CLOUD-DRIFT) C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 PRESSURE ALTITUDE METERS REAL C 2 TEMPERATURE 0.1 DEGREES C REAL C 3 DEWPOINT DEPRESSION 0.1 DEGREES C REAL C 4 WIND DIRECTION DEGREES REAL C 5 WIND SPEED KNOTS REAL C 6 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C PRESSURE ON29 TABLE Q.6 C TEMPERATURE ON29 TABLE Q.6 C DEWPOINT DEPR. ON29 TABLE Q.6 C WIND ON29 TABLE Q.6C C C CATEGORY 7 - CLOUD COVER C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 PRESSURE 0.1 MILLIBARS REAL C 2 AMOUNT OF CLOUDS PER CENT REAL C 3 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C PRESSURE ON29 TABLE Q.7 C CLOUD AMOUNT ON29 TABLE Q.7 C NOT USED BLANK C NOT USED BLANK C C CATEGORY 8 - ADDITIONAL DATA C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 SPECIFIED IN ON29 VARIABLE REAL C TABLE 101.1 OR C ON124 TABLE SM.8A.1 C 2 FORM OF ADD'L DATA CODE FIGURE FROM REAL C ON29 TABLE 101 OR C ON124 TABLE SM.8A C 3 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C VALUE 1 ON29 TABLE Q.8 OR C ON124 TABLE SM.8B C VALUE 2 ON29 TABLE Q.8A OR C ON124 TABLE SM.8C C NOT USED BLANK C NOT USED BLANK C C CATEGORY 51 - SURFACE DATA C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 SEA-LEVEL PRESSURE 0.1 MILLIBARS REAL C 2 STATION PRESSURE 0.1 MILLIBARS REAL C 3 WIND DIRECTION DEGREES REAL C 4 WIND SPEED KNOTS REAL C 5 AIR TEMPERATURE 0.1 DEGREES C REAL C 6 DEWPOINT DEPRESSION 0.1 DEGREES C REAL C 7 MAXIMUM TEMPERATURE 0.1 DEGREES C REAL C 8 MINIMUM TEMPERATURE 0.1 DEGREES C REAL C 9 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C S-LEVEL PRESS. ON124 TABLE SM.51 C STATION PRESS. ON124 TABLE SM.51 C WIND ON124 TABLE SM.51 C AIR TEMPERATURE ON124 TABLE SM.51 C 10 QUALITY MARKERS: EACH 1-CHARACTER CHAR*8 C LEFT-JUSTIFIED C DEWPOINT DEPR. ON124 TABLE SM.51 C NOT USED BLANK C NOT USED BLANK C NOT USED BLANK C 11 HORIZ. VISIBILITY WMO CODE TABLE 4300 INTEGER C 12 PRESENT WEATHER WMO CODE TABLE 4677 INTEGER C 13 PAST WEATHER WMO CODE TABLE 4561 INTEGER C 14 TOTAL CLOUD COVER N WMO CODE TABLE 2700 INTEGER C 15 CLOUD COVER OF C/LN WMO CODE TABLE 2700 INTEGER C 16 CLOUD TYPE OF C/L WMO CODE TABLE 0513 INTEGER C 17 CLOUD HEIGHT OF C/L WMO CODE TABLE 1600 INTEGER C 18 CLOUD TYPE OF C/M WMO CODE TABLE 0515 INTEGER C 19 CLOUD TYPE OF C/H WMO CODE TABLE 0509 INTEGER C 20 CHARACTERISTIC OF WMO CODE TABLE 0200 INTEGER C 3-HR PRESS TENDENCY C 21 AMT. PRESS TENDENCY 0.1 MILLIBARS REAL C (50.0 WILL BE ADDED TO INDICATE 24-HR TENDENCY) C C CATEGORY 52 - ADDITIONAL SURFACE DATA C WORD PARAMETER UNITS FORMAT C ---- --------- ----------------- ------------- C 1 6-HR PRECIPITATION 0.01 INCH INTEGER C 2 SNOW DEPTH INCH INTEGER C 3 24-HR PRECIPITATION 0.01 INCH INTEGER C 4 DURATION OF PRECIP. NO. 6-HR PERIODS INTEGER C 5 PERIOD OF WAVES SECONDS INTEGER C 6 HEIGHT OF WAVES 0.5 METERS INTEGER C 7 SWELL DIRECTION WMO CODE TABLE 0877 INTEGER C 8 SWELL PERIOD SECONDS INTEGER C 9 SWELL HEIGHT 0.5 METERS INTEGER C 10 SEA SFC TEMPERATURE 0.1 DEGREES C INTEGER C 11 SPECIAL PHEN, GEN'L INTEGER C 12 SPECIAL PHEN, DET'L INTEGER C 13 SHIP'S COURSE WMO CODE TABLE 0700 INTEGER C 14 SHIP'S AVERAGE SPEED WMO CODE TABLE 4451 INTEGER C 15 WATER EQUIVALENT OF 0.01 INCH INTEGER C SNOW AND/OR ICE C C CATEGORY 9 - PLAIN LANGUAGE DATA (ALPHANUMERIC TEXT) C WORD BYTES PARAMETER FORMAT C ---- ----- --------------------------------------- -------- C 1 1 INDICATOR OF CONTENT (ON124 TABLE SM.9) CHAR*8 C (1 CHARACTER) C 2-4 PLAIN LANGUAGE DATA, TEXT CHARACTERS 1-3 C 4-8 NOT USED (BLANK) C 2 1-4 PLAIN LANGUAGE DATA, TEXT CHARACTERS 4-7 CHAR*8 C 4-8 NOT USED (BLANK) C 3 1-4 PLAIN LANGUAGE DATA, TEXT CHARACTERS 8-11 CHAR*8 C 4-8 NOT USED (BLANK) C C ONE REPORT MAY UNPACK INTO MORE THAN ONE CATEGORY HAVING C MULTIPLE LEVELS. THE UNUSED PORTION OF LOCRPT IS NOT CLEARED. C C NOTE: ENTRY W3AI02 DUPLICATES PROCESSING IN W3FI64 SINCE NO C ASSEMBLY LANGUAGE CODE IN CRAY W3LIB. C C ATTRIBUTES: C LANGUAGE: CRAY CFT77 FORTRAN C MACHINE: CRAY Y-MP8/864 C C$$$ C CHARACTER*12 HOLD CHARACTER*10 COCBUF(*) CHARACTER*7 CNINES CHARACTER*4 COCRPT(10000),BLANK CHARACTER*2 KAT(11) C INTEGER LOCRPT(*),KATGC(20,11),KATGL(20,11),KATL(11),KATO(11), $ MOCRPT(5000) C REAL ROCRPT(5000) C EQUIVALENCE (ROCRPT,MOCRPT,COCRPT) C SAVE C DATA BLANK/' '/,CNINES/'9999999'/,IMSG/99999/,XMSG/99999./ DATA KATL/6,4,4,4,6,6,3,3,1,20,15/,KATO/13,15,17,19,21,23,25,27, $ 33,29,31/,IREC/2/ DATA KAT/'01','02','03','04','05','06','07','08','09','51','52'/ DATA KATGC/ 5*2,4,14*0, 3*2,4,16*0, 3*2,4,16*0, 3*2,4,16*0, $ 5*2,4,14*0, 5*2,4,14*0, 2*2,4,17*0, 2*2,4,17*0, 4,19*0, $ 8*2,4,10*1,2, 15*1,5*0/ DATA KATGL/ 5,4,3*3,4,14*0, 5,4,2*3,16*0, 5,2*3,2,16*0, $ 5,2*3,2,16*0, 5,4,3*3,4,14*0, 5,4,3*3,4,14*0, 5,3,2,17*0, $ 5,3,2,17*0, 12,19*0, $ 2*5,2*3,4,3,2*4,5,2*3,7*2,1,3, 4,3,4,1,5*2,4,2*2,1,2,7,5*0/ DATA LWFLAG/0/ C ENTRY W3AI02(COCBUF,LOCRPT,NEXT) C IF (LWFLAG.EQ.0) THEN C FIRST TIME CALLED, DETERMINE MACHINE WORD LG IN BYTES (=8 FOR CRAY) C DEPENDING ON WORD SIZE LW2*I-LW1 INDEXES THRU COCRPT C EITHER AS 1,2,3...I FOR LW = 4 OR C AS 1,3,5..2*I-1 FOR LW = 8 <------ HERE C NECESSITATED BY LEFT JUSTIFICATION OF EQUIVALENCE CALL W3FI01(LW) LW2 = LW/4 LW1 = LW/8 LWFLAG = 1 END IF 7000 CONTINUE IF(NEXT.LT.0) RETURN NEXTO = NEXT/10 N = NEXT/10 + 1 C IF(COCBUF(N).EQ.'END RECORD'.OR.COCBUF(N).EQ.'XXXXXXXXXX') THEN C HIT END-OF-RECORD; RETURN WITH NEXT = -1 IF(COCBUF(N).EQ.'XXXXXXXXXX') PRINT 109, IREC IREC = IREC + 1 NEXT = -1 RETURN END IF C INITIALIZE REPORT ID AS MISSING OR 0 FOR RESERVED WORDS ROCRPT(1) = XMSG ROCRPT(2) = XMSG ROCRPT(3) = 0. ROCRPT(4) = XMSG COCRPT(LW2*5-LW1) = ' ' COCRPT(LW2*6-LW1) = ' ' ROCRPT(7) = XMSG MOCRPT(8) = 99 MOCRPT(9) = IMSG MOCRPT(10) = 0. COCRPT(LW2*11-LW1) = ' ' COCRPT(LW2*12-LW1) = ' ' C INITIALIZE CATEGORY WORD PAIRS AS ZEROES DO 100 MB = 13,42 MOCRPT(MB) = 0 100 CONTINUE C WRITE OUT LATITUDE INTO WORD 1 (REAL) M = 1 IF(COCBUF(N)(1:5).NE.'99999') READ(COCBUF(N)(1:5),51) ROCRPT(M) C WRITE OUT LONGITUDE INTO WORD 2 (REAL) M = 2 IF(COCBUF(N)(6:10).NE.'99999') READ(COCBUF(N)(6:10),51) ROCRPT(M) C WORD 3 IS RESERVED (KEEP AS A REAL NUMBER OF 0.) C WRITE OUT STATION ID TO WORDS 11 AND 12 (CHAR*8) C (CHAR. 1-4 OF ID IN WORD 11, CHAR. 5-6 OF ID IN WORD 12, LEFT-JUSTIF.) M = 11 N = N + 1 COCRPT(LW2*M-LW1) = COCBUF(N)(1:4) M = 12 COCRPT(LW2*M-LW1) = COCBUF(N)(5:6)//' ' C WRITE OUT OBSERVATION TIME INTO WORD 4 (REAL) M = 4 IF(COCBUF(N)(7:10).NE.'9999') READ(COCBUF(N)(7:10),41) ROCRPT(M) C WORD 5 IS RESERVED (CHAR*8) (4 CHARACTERS, LEFT-JUSTIF.) M = 5 N = N + 1 COCRPT(LW2*M-LW1) = COCBUF(N)(3:6) C WORD 6 IS RESERVED (CHAR*8) (3 CHARACTERS, LEFT-JUSTIF.) M = 6 COCRPT(LW2*M-LW1) = COCBUF(N)(1:2)//COCBUF(N)(7:7)//' ' C WRITE OUT REPORT TYPE INTO WORD 9 (INTEGER) M = 9 READ(COCBUF(N)(8:10),30) MOCRPT(M) C WRITE OUT STATION ELEVATION INTO WORD 7 (REAL) N = N + 1 M = 7 IF(COCBUF(N)(1:5).NE.'99999') READ(COCBUF(N)(1:5),51) ROCRPT(M) C WRITE OUT INSTRUMENT TYPE INTO WORD 8 (INTEGER) M = 8 IF(COCBUF(N)(6:7).NE.'99') READ(COCBUF(N)(6:7),20) MOCRPT(M) C READ IN NWDS, THE TOTAL NO. OF 10-CHARACTER WORDS IN ENTIRE REPORT READ(COCBUF(N)(8:10),30) NWDS C 'MO' WILL BE STARTING LOCATION IN MOCRPT FOR THE DATA MO = 43 N = N + 1 700 CONTINUE IF(COCBUF(N).EQ.'END REPORT') THEN C----------------------------------------------------------------------- C HAVE HIT THE END OF THE REPORT IF(N-NEXTO.EQ.NWDS) THEN C EVERYTHING LOOKS GOOD, RETURN WITH NEXT SET TO LAST BYTE IN REPORT NEXT = N * 10 ELSE C PROBLEM, MAY EXIT WITH NEXT = -3 NEXTX = -3 PRINT 101, & COCRPT(LW2*11-LW1),COCRPT(LW2*12-LW1)(1:2),N-NEXTO,NWDS GO TO 99 END IF MWORDS = MO - 1 DO 1001 I =1, MWORDS LOCRPT(I) = MOCRPT(I) 1001 CONTINUE RETURN C----------------------------------------------------------------------- END IF C READ IN NWDSC, THE RELATIVE POSITION IN RPT OF THE NEXT CATEGORY READ(COCBUF(N)(3:5),30) NWDSC C READ IN LVLS, THE NUMBER OF LEVELS IN THE CURRENT CATEGORY READ(COCBUF(N)(6:7),20) LVLS C DETERMINE THE CATEGORY NUMBER OF THE CURRENT CATEGORY DO 800 NCAT = 1,11 IF(COCBUF(N)(1:2).EQ.KAT(NCAT)) GO TO 1000 800 CONTINUE C----------------------------------------------------------------------- C PROBLEM, CAT. CODE IN INPUT NOT VALID; MAY EXIT WITH NEXT = -2 NEXTX = -2 PRINT 102, $ COCRPT(LW2*11-LW1),COCRPT(LW2*12-LW1)(1:2),COCBUF(N)(1:2) GO TO 99 C----------------------------------------------------------------------- 1000 CONTINUE C 'M' IS THE WORD IN MOCRPT WHERE THE NO. OF LEVELS WILL BE WRITTEN M = KATO(NCAT) C WRITE THIS CATEGORY WORD PAIR OUT MOCRPT(M) = LVLS MOCRPT(M+1) = MO N = N + 1 I = 1 C*********************************************************************** C LOOP THROUGH ALL THE LEVELS IN THE CURRENT CATEGORY C*********************************************************************** DO 2000 L = 1,LVLS C NDG IS NO. OF OUTPUT PARAMETERS PER LEVEL IN THIS CATEGORY NDG = KATL(NCAT) C----------------------------------------------------------------------- C LOOP THROUGH ALL THE PARAMETERS IN THE CURRENT LEVEL C----------------------------------------------------------------------- DO 1800 K = 1,NDG C 'LL' IS THE NUMBER OF INPUT CHARACTERS PER PARAMETER FOR THIS CATEGORY LL = KATGL(K,NCAT) C 'I' IS POINTER FOR BEGINNING BYTE IN C*10 WORD FOR NEXT PARAMETER C 'J' IS POINTER FOR ENDING BYTE IN C*10 WORD FOR NEXT PARAMETER J = I + LL - 1 IF(J.GT.10) THEN C COME HERE IF INPUT PARAMETER SPANS ACROSS TWO C*10 WORDS HOLD(1:LL) = COCBUF(N)(I:10)//COCBUF(N+1)(1:J-10) N = N + 1 I = J - 9 IF(I.GE.11) THEN N = N + 1 I = 1 END IF ELSE HOLD(1:LL) = COCBUF(N)(I:J) I = J + 1 IF(I.GE.11) THEN N = N + 1 I = 1 END IF END IF C KATGC IS AN INDICATOR FOR THE OUTPUT FORMAT OF EACH INPUT PARAMETER C (=2 - REAL, =1 - INTEGER, =4 - CHARACTER*8) IF(KATGC(K,NCAT).EQ.4) GO TO 1500 IF(KATGC(K,NCAT).NE.1.AND.KATGC(K,NCAT).NE.2) THEN C....................................................................... C PROBLEM IN INTERNAL READ; MAY EXIT WITH NEXT = -2 NEXTX = -2 PRINT 104, COCRPT(LW2*11-LW1),COCRPT(LW2*12)(1:2) GO TO 99 C....................................................................... END IF IF(HOLD(1:LL).EQ.CNINES(1:LL)) THEN C INPUT PARAMETER IS MISSING OR NOT APPLICABLE -- OUTPUT IT AS SUCH IF(KATGC(K,NCAT).EQ.1) MOCRPT(MO) = IMSG IF(KATGC(K,NCAT).EQ.2) ROCRPT(MO) = XMSG GO TO 1750 END IF IF(LL.EQ.1) THEN C INPUT PARAMETER CONSISTS OF ONE CHARACTER IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),10) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),11) ROCRPT(MO) ELSE IF(LL.EQ.2) THEN C INPUT PARAMETER CONSISTS OF TWO CHARACTERS IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),20) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),21) ROCRPT(MO) ELSE IF(LL.EQ.3) THEN C INPUT PARAMETER CONSISTS OF THREE CHARACTERS IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),30) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),31) ROCRPT(MO) ELSE IF(LL.EQ.4) THEN C INPUT PARAMETER CONSISTS OF FOUR CHARACTERS IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),40) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),41) ROCRPT(MO) ELSE IF(LL.EQ.5) THEN C INPUT PARAMETER CONSISTS OF FIVE CHARACTERS IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),50) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),51) ROCRPT(MO) ELSE IF(LL.EQ.6) THEN C INPUT PARAMETER CONSISTS OF SIX CHARACTERS IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),60) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),61) ROCRPT(MO) ELSE IF(LL.EQ.7) THEN C INPUT PARAMETER CONSISTS OF SEVEN CHARACTERS IF(KATGC(K,NCAT).EQ.1) READ(HOLD(1:LL),70) MOCRPT(MO) IF(KATGC(K,NCAT).EQ.2) READ(HOLD(1:LL),71) ROCRPT(MO) ELSE C....................................................................... C INPUT PARAMETER CONSISTS OF MORE THAN SEVEN CHARACTERS (NOT PERMITTED) NEXTX = -2 PRINT 108, COCRPT(LW2*11-LW1),COCRPT(LW2*12-LW1)(1:2) GO TO 99 C....................................................................... END IF GO TO 1750 1500 CONTINUE C....................................................................... C OUTPUT CHARACTER (MARKER) PROCESSING COMES HERE IF(LL.LT.4) THEN C THERE ARE ONE, TWO OR THREE MARKERS IN THE INPUT WORD COCRPT(LW2*MO-LW1)(1:4)=HOLD(1:LL)//BLANK(1:4-LL) ELSE IF(LL.EQ.4) THEN C THERE ARE FOUR MARKERS IN THE INPUT WORD COCRPT(LW2*MO-LW1)(1:4) = HOLD(1:LL) ELSE C THERE ARE MORE THAN FOUR MARKERS IN THE INPUT WORD IP = 1 1610 CONTINUE JP = IP + 3 IF(JP.LT.LL) THEN C FILL FIRST FOUR MARKERS TO OUTPUT WORD COCRPT(LW2*MO-LW1)(1:4) = HOLD(IP:JP) MO = MO + 1 IP = JP + 1 GO TO 1610 ELSE IF(JP.EQ.LL) THEN C FILL FOUR REMAINING MARKERS TO NEXT OUTPUT WORD COCRPT(LW2*MO-LW1)(1:4) = HOLD(IP:JP) ELSE C FILL ONE, TWO, OR THREE REMAINING MARKERS TO NEXT OUTPUT WORD COCRPT(LW2*MO-LW1)(1:4) = HOLD(IP:LL)//BLANK(1:JP-LL) END IF END IF C....................................................................... 1750 CONTINUE MO = MO + 1 1800 CONTINUE C----------------------------------------------------------------------- 2000 CONTINUE C*********************************************************************** IF(I.GT.1) N = N + 1 IF(N-NEXTO.NE.NWDSC) THEN C----------------------------------------------------------------------- C PROBLEM, REL. LOCATION OF NEXT CAT. NOT WHAT'S EXPECTED; MAY EXIT C WITH NEXT = -3 C ERROR - RELATIVE LOCATION OF NEXT CATEGORY NOT WHAT'S EXPECTED NEXTX = -3 PRINT 105, COCRPT(LW2*11-LW1),COCRPT(LW2*12-LW1)(1:2), $ KAT(NCAT),N-NEXTO-1, $ NWDSC-1 GO TO 99 C----------------------------------------------------------------------- END IF C GO ON TO NEXT CATEGORY GO TO 700 C----------------------------------------------------------------------- C ALL OF THE PROBLEM REPORTS END UP HERE -- ATTEMPT TO MOVE AHEAD TO C NEXT REPORT, IF NOT POSSIBLE THEN EXIT WITH NEXT = -2 OR -3 MEANING C THE REST OF THE RECORD IS BAD, GO ON TO NEXT RECORD 99 CONTINUE DO 98 I = 1,644 N = N + 1 IF(N.GT.644) GO TO 97 IF(COCBUF(N).EQ.'END RECORD') GO TO 97 IF(COCBUF(N).EQ.'END REPORT') THEN C WE'VE MADE IT TO THE END OF THIS PROBLEM REPORT - START OVER WITH C NEXT ONE PRINT 106 NEXT = N * 10 GO TO 7000 END IF 98 CONTINUE 97 CONTINUE C COULDN'T GET TO THE END OF THIS PROBLEM REPORT - RETURN WITH ORIGINAL C NEXT VALUE (-2 OR -3) MEANING USER MUST GO ON TO NEXT RECORD NEXT = NEXTX PRINT 107, NEXT MWORDS = MO - 1 DO 1002 I =1, MWORDS LOCRPT(I) = MOCRPT(I) 1002 CONTINUE RETURN C----------------------------------------------------------------------- 10 FORMAT(I1) 11 FORMAT(F1.0) 20 FORMAT(I2) 21 FORMAT(F2.0) 30 FORMAT(I3) 31 FORMAT(F3.0) 40 FORMAT(I4) 41 FORMAT(F4.0) 50 FORMAT(I5) 51 FORMAT(F5.0) 60 FORMAT(I6) 61 FORMAT(F6.0) 70 FORMAT(I7) 71 FORMAT(F7.0) 101 FORMAT(/' *** W3FI64 ERROR- REPORT: ',A4,A2,'; ACTUAL NO. 10-CHAR' $,' WORDS:',I10,' NOT EQUAL TO VALUE READ IN WITH REPORT:',I10/6X, $ '- MAY BE DUE TO INTERNAL READ PROBLEM ASSOC. W/ EITHER ORIG. ', $ 'PACKING OR TRANSFER OF FILE RESULTING IN UNPROCESSABLE INFO.'/6X $,'- WILL ATTEMPT TO MOVE AHEAD TO NEXT REPORT, IF NOT POSSIBLE ', $ 'WILL EXIT RECORD WITH NEXT = -3'/) 102 FORMAT(/' *** W3FI64 ERROR- REPORT: ',A4,A2,'; PACKED CATEGORY ' $,'CODE: ',A2,' IS NOT A VALID O.N. 29 CATEGORY'/6X, $ '- MAY BE DUE TO INTERNAL READ PROBLEM ASSOC. W/ EITHER ORIG. ', $ 'PACKING OR TRANSFER OF FILE RESULTING IN UNPROCESSABLE INFO.'/6X $,'- WILL ATTEMPT TO MOVE AHEAD TO NEXT REPORT, IF NOT POSSIBLE ', $ 'WILL EXIT RECORD WITH NEXT = -2'/) 104 FORMAT(/' *** W3FI64 ERROR- REPORT: ',A4,A2,'; INTERNAL READ ', $ 'PROBLEM'/6X,'- EITHER ORIGINAL PACKING OF FILE OR TRANSFER ', $ 'OF FILE HAS RESULTED IN UNPROCESSABLE INFORMATION'/6X, $ '- WILL ATTEMPT TO MOVE AHEAD TO NEXT REPORT, IF NOT POSSIBLE ', $ 'WILL EXIT RECORD WITH NEXT = -2'/) 105 FORMAT(/' *** W3FI64 ERROR- REPORT: ',A4,A2,'; ACTUAL NO. 10-CHAR' $,' WORDS IN CAT. ',A2,',',I10,' .NE. TO VALUE READ IN WITH ', $ 'REPORT:',I10/6X, $ '- MAY BE DUE TO INTERNAL READ PROBLEM ASSOC. W/ EITHER ORIG. ', $ 'PACKING OR TRANSFER OF FILE RESULTING IN UNPROCESSABLE INFO.'/6X $,'- WILL ATTEMPT TO MOVE AHEAD TO NEXT REPORT, IF NOT POSSIBLE ', $ 'WILL EXIT RECORD WITH NEXT = -3'/) 106 FORMAT(/' +++ IT WAS POSSIBLE TO MOVE TO NEXT REPORT IN THIS ', $ 'RECORD -- CONTINUE WITH THE UNPACKING OF THIS NEW REPORT'/) 107 FORMAT(/' *** IT WAS NOT POSSIBLE TO MOVE TO NEXT REPORT IN THIS', $ ' RECORD -- MUST EXIT THIS RECORD WITH NEXT =',I3/) 108 FORMAT(/' *** W3FI64 ERROR- REPORT: ',A4,A2,'; AN INPUT ', $ 'PARAMETER CONSISTS OF MORE THAN SEVEN CHARACTERS'/6X, $ '- MAY BE DUE TO INTERNAL READ PROBLEM ASSOC. W/ EITHER ORIG. ', $ 'PACKING OR TRANSFER OF FILE RESULTING IN UNPROCESSABLE INFO.'/6X $,'- WILL ATTEMPT TO MOVE AHEAD TO NEXT REPORT, IF NOT POSSIBLE ', $ 'WILL EXIT RECORD WITH NEXT = -2'/) 109 FORMAT(/' *** W3FI64 ERROR- RECORD ',I4,' DOES NOT END WITH ', $ '"END RECORD" BUT INSTEAD CONTAINS "X" FILLERS AFTER LAST ', $ 'REPORT IN RECORD'/6X,'- WILL EXIT RECORD WITH NEXT = -1, NO ', $ 'REPORTS SHOULD BE LOST'/) END