NCEPLIBS-w3emc  2.11.0
sbytes.f
Go to the documentation of this file.
1 C> @file
2 C> @brief This is the fortran versions of sbytes().
3 C> @author Robert C. Gammill @date 1972-07
4 C>
5 C> @param IOUT
6 C> @param IN = unpacked array input
7 C> @param ISKIP = initial number of bits to skip
8 C> @param NBYTE = number of bits to pack
9 C> @param NSKIP = additional number of bits to skip on each iteration
10 C> @param N = number of iterations
11 C>
12 C> @author Robert C. Gammill @date 1972-07
13  SUBROUTINE sbytes(IOUT,IN,ISKIP,NBYTE,NSKIP,N)
14 C
15 C
16 C Changes for SiliconGraphics IRIS-4D/25
17 C SiliconGraphics 3.3 FORTRAN 77
18 C March 1991 RUSSELL E. JONES
19 C NATIONAL WEATHER SERVICE
20 C
21  INTEGER IN(*)
22  INTEGER IOUT(*)
23  INTEGER MASKS(32)
24 C
25  SAVE
26 C
27  DATA nbitsw/32/
28 C
29 C DATA MASKS /Z'00000001',Z'00000003',Z'00000007',Z'0000000F',
30 C & Z'0000001F',Z'0000003F',Z'0000007F',Z'000000FF',
31 C & Z'000001FF',Z'000003FF',Z'000007FF',Z'00000FFF',
32 C & Z'00001FFF',Z'00003FFF',Z'00007FFF',Z'0000FFFF',
33 C & Z'0001FFFF',Z'0003FFFF',Z'0007FFFF',Z'000FFFFF',
34 C & Z'001FFFFF',Z'003FFFFF',Z'007FFFFF',Z'00FFFFFF',
35 C & Z'01FFFFFF',Z'03FFFFFF',Z'07FFFFFF',Z'0FFFFFFF',
36 C & Z'1FFFFFFF',Z'3FFFFFFF',Z'7FFFFFFF',Z'FFFFFFFF'/
37 C
38 C MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT
39 C COMPUTER
40 C
41  DATA masks / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047,
42  & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287,
43  & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431,
44  & 67108863, 134217727, 268435455, 536870911, 1073741823,
45  & 2147483647, -1/
46 C
47 C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW
48 C
49  icon = nbitsw - nbyte
50  IF (icon.LT.0) RETURN
51  mask = masks(nbyte)
52 C
53 C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.
54 C
55  index = ishft(iskip,-5)
56 C
57 C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.
58 C
59  ii = mod(iskip,nbitsw)
60 C
61 C ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT.
62 C
63  istep = nbyte + nskip
64 C
65 C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.
66 C
67  iwords = istep / nbitsw
68 C
69 C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.
70 C
71  ibits = mod(istep,nbitsw)
72 C
73  DO 10 i = 1,n
74  j = iand(mask,in(i))
75  movel = icon - ii
76 C
77 C BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT.
78 C
79  IF (movel.GT.0) THEN
80  msk = ishft(mask,movel)
81  iout(index+1) = ior(iand(not(msk),iout(index+1)),
82  & ishft(j,movel))
83 C
84 C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.
85 C
86  ELSE IF (movel.LT.0) THEN
87  msk = masks(nbyte+movel)
88  iout(index+1) = ior(iand(not(msk),iout(index+1)),
89  & ishft(j,movel))
90  itemp = iand(masks(nbitsw+movel),iout(index+2))
91  iout(index+2) = ior(itemp,ishft(j,nbitsw+movel))
92 C
93 C BYTE IS TO BE STORED RIGHT-ADJUSTED.
94 C
95  ELSE
96  iout(index+1) = ior(iand(not(mask),iout(index+1)),j)
97  ENDIF
98 C
99  ii = ii + ibits
100  index = index + iwords
101  IF (ii.GE.nbitsw) THEN
102  ii = ii - nbitsw
103  index = index + 1
104  ENDIF
105 C
106 10 CONTINUE
107 C
108  RETURN
109  END