ungrib/src/ngl/w3/gbytes.f

   1       SUBROUTINE GBYTES(IPACKD,IUNPKD,NOFF,NBITS,ISKIP,ITER)
   2 C
   3 C THIS PROGRAM WRITTEN BY.....
   4 C             DR. ROBERT C. GAMMILL, CONSULTANT
   5 C             NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
   6 C             MAY 1972
   7 C
   8 C             CHANGES FOR SiliconGraphics IRIS-4D/25
   9 C             SiliconGraphics 3.3 FORTRAN 77
  10 C             MARCH 1991, RUSSELL E. JONES
  11 C             NATIONAL WEATHER SERVICE
  12 C
  13 C THIS IS THE FORTRAN VERSION OF GBYTES.
  14 C
  15 C***********************************************************************
  16 C
  17 C SUBROUTINE GBYTES (IPACKD,IUNPKD,NOFF,NBITS,ISKIP,ITER)
  18 C
  19 C PURPOSE                TO UNPACK A SERIES OF BYTES INTO A TARGET
  20 C                        ARRAY.  EACH UNPACKED BYTE IS RIGHT-JUSTIFIED
  21 C                        IN ITS TARGET WORD, AND THE REMAINDER OF THE
  22 C                        WORD IS ZERO-FILLED.
  23 C
  24 C USAGE                  CALL GBYTES (IPACKD,IUNPKD,NOFF,NBITS,NSKIP,
  25 C                                     ITER)
  26 C
  27 C ARGUMENTS
  28 C ON INPUT                IPACKD
  29 C                           THE WORD OR ARRAY CONTAINING THE PACKED
  30 C                           BYTES.
  31 C
  32 C                         IUNPKD
  33 C                           THE ARRAY WHICH WILL CONTAIN THE UNPACKED
  34 C                           BYTES.
  35 C
  36 C                         NOFF
  37 C                           THE INITIAL NUMBER OF BITS TO SKIP, LEFT
  38 C                           TO RIGHT, IN 'IPACKD' IN ORDER TO LOCATE
  39 C                           THE FIRST BYTE TO UNPACK.
  40 C
  41 C                        NBITS
  42 C                          NUMBER OF BITS IN THE BYTE TO BE UNPACKED.
  43 C                          MAXIMUM OF 64 BITS ON 64 BIT MACHINE, 32
  44 C                          BITS ON 32 BIT MACHINE.
  45 C
  46 C                         ISKIP
  47 C                           THE NUMBER OF BITS TO SKIP BETWEEN EACH BYTE
  48 C                           IN 'IPACKD' IN ORDER TO LOCATE THE NEXT BYTE
  49 C                           TO BE UNPACKED.
  50 C
  51 C                         ITER
  52 C                           THE NUMBER OF BYTES TO BE UNPACKED.
  53 C
  54 C ARGUMENTS
  55 C ON OUTPUT               IUNPKD
  56 C                           CONTAINS THE REQUESTED UNPACKED BYTES.
  57 C***********************************************************************
  58
  59       INTEGER    IPACKD(*)
  60
  61       INTEGER    IUNPKD(*)
  62       INTEGER    MASKS(64)
  63 C
  64       SAVE
  65 C
  66       DATA IFIRST/1/
  67       IF(IFIRST.EQ.1) THEN
  68          CALL W3FI01(LW)
  69          NBITSW = 8 * LW
  70          JSHIFT = -1 * NINT(ALOG(FLOAT(NBITSW)) / ALOG(2.0))
  71          MASKS(1) = 1
  72          DO I=2,NBITSW-1
  73             MASKS(I) = 2 * MASKS(I-1) + 1
  74          ENDDO
  75          MASKS(NBITSW) = -1
  76          IFIRST = 0
  77       ENDIF
  78 C
  79 C NBITS MUST BE LESS THAN OR EQUAL TO NBITSW
  80 C
  81       ICON   = NBITSW - NBITS
  82       IF (ICON.LT.0) RETURN
  83       MASK   = MASKS(NBITS)
  84 C
  85 C INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IPACKD' THE NEXT BYTE
  86 C APPEARS.
  87 C
  88       INDEX  = ISHFT(NOFF,JSHIFT)
  89 C
  90 C II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD.
  91 C
  92       II     = MOD(NOFF,NBITSW)
  93 C
  94 C ISTEP IS THE DISTANCE IN BITS FROM THE START OF ONE BYTE TO THE NEXT.
  95 C
  96       ISTEP  = NBITS + ISKIP
  97 C
  98 C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.
  99 C
 100       IWORDS = ISTEP / NBITSW
 101 C
 102 C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.
 103 C
 104       IBITS  = MOD(ISTEP,NBITSW)
 105 C
 106       DO 10 I = 1,ITER
 107 C
 108 C MOVER SPECIFIES HOW FAR TO THE RIGHT A BYTE MUST BE MOVED IN ORDER
 109 C
 110 C    TO BE RIGHT ADJUSTED.
 111 C
 112       MOVER = ICON - II
 113 C
 114 C THE BYTE IS SPLIT ACROSS A WORD BREAK.
 115 C
 116       IF (MOVER.LT.0) THEN
 117         MOVEL   = - MOVER
 118         MOVER   = NBITSW - MOVEL
 119         IUNPKD(I) = IAND(IOR(ISHFT(IPACKD(INDEX+1),MOVEL),
 120      &            ISHFT(IPACKD(INDEX+2),-MOVER)),MASK)
 121 C
 122 C RIGHT ADJUST THE BYTE.
 123 C
 124       ELSE IF (MOVER.GT.0) THEN
 125         IUNPKD(I) = IAND(ISHFT(IPACKD(INDEX+1),-MOVER),MASK)
 126 C
 127 C THE BYTE IS ALREADY RIGHT ADJUSTED.
 128 C
 129       ELSE
 130         IUNPKD(I) = IAND(IPACKD(INDEX+1),MASK)
 131       ENDIF
 132 C
 133 C INCREMENT II AND INDEX.
 134 C
 135         II    = II + IBITS
 136         INDEX = INDEX + IWORDS
 137         IF (II.GE.NBITSW) THEN
 138           II    = II - NBITSW
 139           INDEX = INDEX + 1
 140         ENDIF
 141 C
 142    10 CONTINUE
 143         RETURN
 144       END