w3fi64.f

Go to the documentation of this file.

C> @file
C> @brief NMC office note 29 report unpacker.
C> @author L. Marx @date 1990-01
 
C> 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> - L. Marx 1990-01 Converted code from assembler
C> to vs fortran; Expanded error return codes in 'NEXT'
C> - Dennis Keyser 1991-07-22 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> - Dennis Keyser 1991-08-12 Slight changes to make sub-
C> program more portable; Test for absence of end-
C> of-record indicator, will gracefully exit record.
C> - Dennis Keyser 1992-06-29 Convert to cray cft77 fortran
C> - Dennis Keyser 1992-08-06 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> @param[in] COCBUF Character*10 array containing a block of packed
C> reports in nmc office note 29/124 format.
C> @param[in] 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> @param[out] 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>   ***************************************************************
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> |  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> | 43-end| unpacked data groups     |(see remarks)         | mixed|
C>
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> @note 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>
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> @code{.F}
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> @endcode
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> ***************************************************************
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> @note 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> @author L. Marx @date 1990-01
      SUBROUTINE w3fi64(COCBUF,LOCRPT,NEXT)
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