ungrib/src/ngl/w3/sbytes.f

   1       SUBROUTINE SBYTES(IPACKD,IUNPKD,NOFF,NBITS,ISKIP,ITER)
   2 C THIS PROGRAM WRITTEN BY.....
   3 C             DR. ROBERT C. GAMMILL, CONSULTANT
   4 C             NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
   5 C             JULY 1972
   6 C THIS IS THE FORTRAN VERSIONS OF SBYTES.
   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***********************************************************************
  14 C
  15 C SUBROUTINE SBYTE (IPACKD,IUNPKD,NOFF,NBITS,ISKIP,ITER)
  16 C
  17 C PURPOSE                GIVEN A BYTE, RIGHT-JUSTIFIED IN A WORD, TO
  18 C                        PACK THE BYTE INTO A TARGET WORD OR ARRAY.
  19 C                        BITS SURROUNDING THE BYTE IN THE TARGET
  20 C                        AREA ARE UNCHANGED.
  21 C
  22 C USAGE                  CALL SBYTE (IPACKD,IUNPKD,NOFF,NBITS)
  23 C
  24 C ARGUMENTS
  25 C ON INPUT               IPACKD
  26 C                          THE WORD OR ARRAY WHICH WILL CONTAIN THE
  27 C                          PACKED BYTE.  BYTE MAY CROSS WORD BOUNDARIES.
  28 C
  29 C                        IUNPKD
  30 C                          THE WORD CONTAINING THE RIGHT-JUSTIFIED BYTE
  31 C                          TO BE PACKED.
  32 C
  33 C                        NOFF
  34 C                          THE NUMBER OF BITS TO SKIP, LEFT TO RIGHT,
  35 C                          IN 'IPACKD' IN ORDER TO LOCATE WHERE THE
  36 C                          BYTE IS TO BE PACKED.
  37 C
  38 C                        NBITS
  39 C                          NUMBER OF BITS IN THE BYTE TO BE PACKED.
  40 C                          MAXIMUM OF 64 BITS ON 64 BIT MACHINE, 32
  41 C                          BITS ON 32 BIT MACHINE.
  42 C
  43 C                         ISKIP
  44 C                           THE NUMBER OF BITS TO SKIP BETWEEN EACH BYTE
  45 C                           IN 'IUNPKD' IN ORDER TO LOCATE THE NEXT BYTE
  46 C                           TO BE PACKED.
  47 C
  48 C                         ITER
  49 C                           THE NUMBER OF BYTES TO BE PACKED.
  50 C
  51 C ON OUTPUT              IPACKD
  52 C                          WORD OR CONSECUTIVE WORDS CONTAINING THE
  53 C                          REQUESTED BYTE.
  54 C
  55 C***********************************************************************
  56
  57       INTEGER     IUNPKD(*)
  58       INTEGER     IPACKD(*)
  59       INTEGER     MASKS(64)
  60 C
  61       SAVE
  62 C
  63       DATA IFIRST/1/
  64       IF(IFIRST.EQ.1) THEN
  65          CALL W3FI01(LW)
  66          NBITSW = 8 * LW
  67          JSHIFT = -1 * NINT(ALOG(FLOAT(NBITSW)) / ALOG(2.0))
  68          MASKS(1) = 1
  69          DO I=2,NBITSW-1
  70             MASKS(I) = 2 * MASKS(I-1) + 1
  71          ENDDO
  72          MASKS(NBITSW) = -1
  73          IFIRST = 0
  74       ENDIF
  75 C
  76 C NBITS MUST BE LESS THAN OR EQUAL TO NBITSW
  77 C
  78       ICON = NBITSW - NBITS
  79       IF (ICON.LT.0) RETURN
  80       MASK   = MASKS(NBITS)
  81 C
  82 C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.
  83 C
  84       INDEX  = ISHFT(NOFF,JSHIFT)
  85 C
  86 C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.
  87 C
  88       II     = MOD(NOFF,NBITSW)
  89 C
  90 C ISTEP IS THE DISTANCE IUNPKD BITS FROM ONE BYTE POSITION TO THE NEXT.
  91 C
  92       ISTEP  = NBITS + ISKIP
  93 C
  94 C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.
  95 C
  96       IWORDS = ISTEP / NBITSW
  97 C
  98 C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.
  99 C
 100       IBITS  = MOD(ISTEP,NBITSW)
 101 C
 102       DO 10 I = 1,ITER
 103         J     = IAND(MASK,IUNPKD(I))
 104         MOVEL = ICON - II
 105 C
 106 C BYTE IS TO BE STORED IN MIDDLE OF WORD.  SHIFT LEFT.
 107 C
 108         IF (MOVEL.GT.0) THEN
 109           MSK           = ISHFT(MASK,MOVEL)
 110           IPACKD(INDEX+1) = IOR(IAND(NOT(MSK),IPACKD(INDEX+1)),
 111      &    ISHFT(J,MOVEL))
 112 C
 113 C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.
 114 C
 115         ELSE IF (MOVEL.LT.0) THEN
 116           MSK           = MASKS(NBITS+MOVEL)
 117           IPACKD(INDEX+1) = IOR(IAND(NOT(MSK),IPACKD(INDEX+1)),
 118      &    ISHFT(J,MOVEL))
 119           ITEMP         = IAND(MASKS(NBITSW+MOVEL),IPACKD(INDEX+2))
 120           IPACKD(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL))
 121 C
 122 C BYTE IS TO BE STORED RIGHT-ADJUSTED.
 123 C
 124         ELSE
 125           IPACKD(INDEX+1) = IOR(IAND(NOT(MASK),IPACKD(INDEX+1)),J)
 126         ENDIF
 127 C
 128         II    = II + IBITS
 129         INDEX = INDEX + IWORDS
 130         IF (II.GE.NBITSW) THEN
 131           II    = II - NBITSW
 132           INDEX = INDEX + 1
 133         ENDIF
 134 C
 135 10    CONTINUE
 136 C
 137       RETURN
 138       END