hwrf-baseline-20120103-1354/ungrib/src/ngl/w3/sbyte.f

   1        SUBROUTINE SBYTE(IPACKD,IUNPKD,NOFF,NBITS)
   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
   7 C THIS IS THE FORTRAN 32 bit VERSION OF SBYTE.
   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)
  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 ON OUTPUT              IPACKD
  44 C                          WORD OR CONSECUTIVE WORDS CONTAINING THE
  45 C                          REQUESTED BYTE.
  46 C***********************************************************************
  47
  48       INTEGER    IUNPKD
  49       INTEGER    IPACKD(*)
  50       INTEGER    MASKS(64)
  51 C
  52       SAVE
  53 C
  54       DATA IFIRST/1/
  55       IF(IFIRST.EQ.1) THEN
  56          CALL W3FI01(LW)
  57          NBITSW = 8 * LW
  58          JSHIFT = -1 * NINT(ALOG(FLOAT(NBITSW)) / ALOG(2.0))
  59          MASKS(1) = 1
  60          DO I=2,NBITSW-1
  61             MASKS(I) = 2 * MASKS(I-1) + 1
  62          ENDDO
  63          MASKS(NBITSW) = -1
  64          IFIRST = 0
  65       ENDIF
  66 C
  67 C NBITS MUST BE LESS THAN OR EQUAL TO NBITSW
  68 C
  69         ICON  = NBITSW - NBITS
  70         IF (ICON.LT.0) RETURN
  71         MASK  = MASKS(NBITS)
  72 C
  73 C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.
  74 C
  75         INDEX = ISHFT(NOFF,JSHIFT)
  76 C
  77 C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.
  78 C
  79         II    = MOD(NOFF,NBITSW)
  80 C
  81         J     = IAND(MASK,IUNPKD)
  82         MOVEL = ICON - II
  83 C
  84 C BYTE IS TO BE STORED IN MIDDLE OF WORD.  SHIFT LEFT.
  85 C
  86         IF (MOVEL.GT.0) THEN
  87           MSK           = ISHFT(MASK,MOVEL)
  88           IPACKD(INDEX+1) = IOR(IAND(NOT(MSK),IPACKD(INDEX+1)),
  89      &    ISHFT(J,MOVEL))
  90 C
  91 C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.
  92 C
  93         ELSE IF (MOVEL.LT.0) THEN
  94           MSK           = MASKS(NBITS+MOVEL)
  95           IPACKD(INDEX+1) = IOR(IAND(NOT(MSK),IPACKD(INDEX+1)),
  96      &    ISHFT(J,MOVEL))
  97           ITEMP         = IAND(MASKS(NBITSW+MOVEL),IPACKD(INDEX+2))
  98           IPACKD(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL))
  99 C
 100 C BYTE IS TO BE STORED RIGHT-ADJUSTED.
 101 C
 102         ELSE
 103           IPACKD(INDEX+1) = IOR(IAND(NOT(MASK),IPACKD(INDEX+1)),J)
 104         ENDIF
 105 C
 106       RETURN
 107       END