| blob | 0f34bfe6c8b76dfe842de15b39b5af7f16cd880b |
1 !-----------------------------------------------------------------------
2 ! Choice of computers
3 !-----------------------------------------------------------------------
4 !
5 ! CRAY XMP,YMP/UNICOS (#define CRAY)
6 ! VAX/VMS (#define VAX)
7 ! Stardent 1500/3000/UNIX (#define STARDENT)
8 ! IBM RS/6000-AIX (#define IBM)
9 ! SUN Sparcstation (#define SUN)
10 ! SGI Silicon Graphics (#define SGI)
11 ! HP 7xx (#define HP)
12 ! DEC ALPHA (#define ALPHA)
13 ! +------------------------------------------------------------------+
14 ! _ SYSTEM DEPENDENT ROUTINES _
15 ! _ _
16 ! _ This module contains short utility routines that are not _
17 ! _ of the FORTRAN 77 standard and may differ from system to system. _
18 ! _ These include bit manipulation, I/O, JCL calls, and vector _
19 ! _ functions. _
20 ! +------------------------------------------------------------------+
21 ! +------------------------------------------------------------------+
22 !
23 ! DATA SET UTILITY AT LEVEL 003 AS OF 02/25/92
24 SUBROUTINE GBYTE_G1(IN,IOUT,ISKIP,NBYTE)
25 !
26 ! THIS PROGRAM WRITTEN BY.....
27 ! DR. ROBERT C. GAMMILL, CONSULTANT
28 ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
29 ! MAY 1972
30 !
31 ! CHANGES FOR CRAY Y-MP8/832
32 ! CRAY CFT77 FORTRAN
33 ! JULY 1992, RUSSELL E. JONES
34 ! NATIONAL WEATHER SERVICE
35 !
36 ! THIS IS THE FORTRAN VERSION OF GBYTE
37 !
38 INTEGER IN(*)
39 INTEGER IOUT
40 #if defined (CRAY) || defined (BIT64)
42 INTEGER MASKS(64)
43 !
44 DATA NBITSW/64/
45 !
46 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 64 BIT
47 ! COMPUTER
48 !
49 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
50 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
51 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
52 67108863, 134217727, 268435455, 536870911, 1073741823, &
53 2147483647, 4294967295, 8589934591, 17179869183, &
54 34359738367, 68719476735, 137438953471, 274877906943, &
55 549755813887, 1099511627775, 2199023255551, 4398046511103, &
56 8796093022207, 17592186044415, 35184372088831, &
57 70368744177663, 140737488355327, 281474976710655, &
58 562949953421311, 1125899906842623, 2251799813685247, &
59 4503599627370495, 9007199254740991, 18014398509481983, &
60 36028797018963967, 72057594037927935, 144115188075855871, &
61 288230376151711743, 576460752303423487, 1152921504606846975, &
62 2305843009213693951, 4611686018427387903, 9223372036854775807, &
63 -1/
64 #else
65 INTEGER MASKS(32)
66 !
67 DATA NBITSW/32/
68 !
69 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT
70 ! COMPUTER
71 !
72 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
73 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
74 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
75 67108863, 134217727, 268435455, 536870911, 1073741823, &
76 2147483647, -1/
77 #endif
78 !
79 ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW
80 !
81 ICON = NBITSW - NBYTE
82 IF (ICON.LT.0) RETURN
83 MASK = MASKS(NBYTE)
84 !
85 ! INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IN' THE NEXT BYTE APPEARS.
86 !
87 INDEX = ISKIP / NBITSW
88 !
89 ! II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD.
90 !
91 II = MOD(ISKIP,NBITSW)
92 !
93 ! MOVER SPECIFIES HOW FAR TO THE RIGHT NBYTE MUST BE MOVED IN ORDER
94 ! TO BE RIGHT ADJUSTED.
95 !
96 MOVER = ICON - II
97 !
98 IF (MOVER.GT.0) THEN
99 IOUT = IAND(ISHFT(IN(INDEX+1),-MOVER),MASK)
100 !
101 ! THE BYTE IS SPLIT ACROSS A WORD BREAK.
102 !
103 ELSE IF (MOVER.LT.0) THEN
104 MOVEL = - MOVER
105 MOVER = NBITSW - MOVEL
106 IOUT = IAND(IOR(ISHFT(IN(INDEX+1),MOVEL), &
107 & ISHFT(IN(INDEX+2),-MOVER)),MASK)
108 !
109 ! THE BYTE IS ALREADY RIGHT ADJUSTED.
110 !
111 ELSE
112 IOUT = IAND(IN(INDEX+1),MASK)
113 ENDIF
114 !
115 RETURN
116 END
117 !
118 ! +------------------------------------------------------------------+
119 SUBROUTINE GBYTES_G1(IN,IOUT,ISKIP,NBYTE,NSKIP,N)
120 !
121 ! THIS PROGRAM WRITTEN BY.....
122 ! DR. ROBERT C. GAMMILL, CONSULTANT
123 ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
124 ! MAY 1972
125 !
126 ! CHANGES FOR CRAY Y-MP8/832
127 ! CRAY CFT77 FORTRAN
128 ! JULY 1992, RUSSELL E. JONES
129 ! NATIONAL WEATHER SERVICE
130 !
131 ! THIS IS THE FORTRAN VERSION OF GBYTES.
132 !
133 INTEGER IN(*)
134 INTEGER IOUT(*)
135 #if defined (CRAY) || defined (BIT64)
136 !CDIR$ INTEGER=64
137 INTEGER MASKS(64)
138 !
139 DATA NBITSW/64/
140 !
141 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 64 BIT
142 ! COMPUTER
143 !
144 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
145 & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
146 & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
147 & 67108863, 134217727, 268435455, 536870911, 1073741823, &
148 & 2147483647, 4294967295, 8589934591, 17179869183, &
149 & 34359738367, 68719476735, 137438953471, 274877906943, &
150 & 549755813887, 1099511627775, 2199023255551, 4398046511103, &
151 & 8796093022207, 17592186044415, 35184372088831, &
152 & 70368744177663, 140737488355327, 281474976710655, &
153 & 562949953421311, 1125899906842623, 2251799813685247, &
154 & 4503599627370495, 9007199254740991, 18014398509481983, &
155 & 36028797018963967, 72057594037927935, 144115188075855871, &
156 & 288230376151711743, 576460752303423487, 1152921504606846975, &
157 & 2305843009213693951, 4611686018427387903, 9223372036854775807, &
158 & -1/
159 #else
160 INTEGER MASKS(32)
161 !
162 DATA NBITSW/32/
163 !
164 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT
165 ! COMPUTER
166 !
167 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
168 & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
169 & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
170 & 67108863, 134217727, 268435455, 536870911, 1073741823, &
171 & 2147483647, -1/
172 #endif
173 !
174 ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW
175 !
176 ICON = NBITSW - NBYTE
177 IF (ICON.LT.0) RETURN
178 MASK = MASKS(NBYTE)
179 !
180 ! INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IN' THE NEXT BYTE APPEARS.
181 !
182 INDEX = ISKIP / NBITSW
183 !
184 ! II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD.
185 !
186 II = MOD(ISKIP,NBITSW)
187 !
188 ! ISTEP IS THE DISTANCE IN BITS FROM THE START OF ONE BYTE TO THE NEXT.
189 !
190 ISTEP = NBYTE + NSKIP
191 !
192 ! IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.
193 !
194 IWORDS = ISTEP / NBITSW
195 !
196 ! IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.
197 !
198 IBITS = MOD(ISTEP,NBITSW)
199 !
200 DO 10 I = 1,N
201 !
202 ! MOVER SPECIFIES HOW FAR TO THE RIGHT A BYTE MUST BE MOVED IN ORDER
203 !
204 ! TO BE RIGHT ADJUSTED.
205 ! TO BE RIGHT ADJUSTED.
206 !
207 MOVER = ICON - II
208 !
209 ! THE BYTE IS SPLIT ACROSS A WORD BREAK.
210 !
211 IF (MOVER.LT.0) THEN
212 MOVEL = - MOVER
213 MOVER = NBITSW - MOVEL
214 IOUT(I) = IAND(IOR(ISHFT(IN(INDEX+1),MOVEL), &
215 & ISHFT(IN(INDEX+2),-MOVER)),MASK)
216 !
217 ! RIGHT ADJUST THE BYTE.
218 !
219 ELSE IF (MOVER.GT.0) THEN
220 IOUT(I) = IAND(ISHFT(IN(INDEX+1),-MOVER),MASK)
221 !
222 ! THE BYTE IS ALREADY RIGHT ADJUSTED.
223 !
224 ELSE
225 IOUT(I) = IAND(IN(INDEX+1),MASK)
226 ENDIF
227 !
228 ! INCREMENT II AND INDEX.
229 !
230 II = II + IBITS
231 INDEX = INDEX + IWORDS
232 IF (II.GE.NBITSW) THEN
233 II = II - NBITSW
234 INDEX = INDEX + 1
235 ENDIF
236 !
237 10 CONTINUE
238 RETURN
239 END
240 !
241 ! +------------------------------------------------------------------+
242 SUBROUTINE SBYTE_G1(IOUT,IN,ISKIP,NBYTE)
243 ! THIS PROGRAM WRITTEN BY.....
244 ! DR. ROBERT C. GAMMILL, CONSULTANT
245 ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
246 ! JULY 1972
247 ! THIS IS THE FORTRAN VERSIONS OF SBYTE.
248 ! FORTRAN 90
249 ! AUGUST 1990 RUSSELL E. JONES
250 ! NATIONAL WEATHER SERVICE
251 !
252 ! USAGE: CALL SBYTE (PCKD,UNPK,INOFST,NBIT)
253 !
254 ! INPUT ARGUMENT LIST:
255 ! UNPK - NBITS OF THE RIGHT SIDE OF UNPK IS MOVED TO
256 ! ARRAY PCKD. INOFST BITS ARE SKIPPED OVER BEFORE
257 ! THE DATA IS MOVED, NBITS ARE STORED.
258 ! INOFST - A FULLWORD INTEGER SPECIFYING THE INITAL OFFSET
259 ! IN BITS OF THE FIRST BYTE, COUNTED FROM THE
260 ! LEFTMOST BIT IN PCKD.
261 ! NBITS - A FULLWORD INTEGER SPECIFYING THE NUMBER OF BITS
262 ! IN EACH BYTE TO BE PACKED. LEGAL BYTE WIDTHS
263 ! ARE IN THE RANGE 1 - 32.
264 ! OUTPUT ARGUMENT LIST:
265 ! PCKD - THE FULLWORD IN MEMORY TO WHICH PACKING IS TO
266 ! BEGIN STARTING AT BIT INOFST. THE INOSTAT BITS
267 ! ARE NOT ALTERED.
268 !
269 INTEGER IN
270 INTEGER IOUT(*)
271 #if defined (CRAY) || defined (BIT64)
272 INTEGER MASKS(64)
273 !
274 DATA NBITSW/64/
275 !
276 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 64 BIT
277 ! COMPUTER
278 !
279 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
280 & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
281 & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
282 & 67108863, 134217727, 268435455, 536870911, 1073741823, &
283 & 2147483647, 4294967295, 8589934591, 17179869183, &
284 & 34359738367, 68719476735, 137438953471, 274877906943, &
285 & 549755813887, 1099511627775, 2199023255551, 4398046511103, &
286 & 8796093022207, 17592186044415, 35184372088831, &
287 & 70368744177663, 140737488355327, 281474976710655, &
288 & 562949953421311, 1125899906842623, 2251799813685247, &
289 & 4503599627370495, 9007199254740991, 18014398509481983, &
290 & 36028797018963967, 72057594037927935, 144115188075855871, &
291 & 288230376151711743, 576460752303423487, 1152921504606846975, &
292 & 2305843009213693951, 4611686018427387903, 9223372036854775807, &
293 & -1/
294 #else
295 INTEGER MASKS(32)
296 !
297 DATA NBITSW/32/
298 !
299 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT
300 ! COMPUTER
301 !
302 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
303 & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
304 & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
305 & 67108863, 134217727, 268435455, 536870911, 1073741823, &
306 & 2147483647, -1/
307 #endif
308 !
309 ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW
310 !
311 ICON = NBITSW - NBYTE
312 IF (ICON.LT.0) RETURN
313 MASK = MASKS(NBYTE)
314 !
315 ! INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.
316 !
317 INDEX = ISKIP / NBITSW
318 !
319 ! II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.
320 !
321 II = MOD(ISKIP,NBITSW)
322 !
323 J = IAND(MASK,IN)
324 MOVEL = ICON - II
325 !
326 ! BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT.
327 !
328 IF (MOVEL.GT.0) THEN
329 MSK = ISHFT(MASK,MOVEL)
330 IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), &
331 & ISHFT(J,MOVEL))
332 !
333 ! THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.
334 !
335 ELSE IF (MOVEL.LT.0) THEN
336 MSK = MASKS(NBYTE+MOVEL)
337 IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), &
338 & ISHFT(J,MOVEL))
339 ITEMP = IAND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2))
340 IOUT(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL))
341 !
342 ! BYTE IS TO BE STORED RIGHT-ADJUSTED.
343 !
344 ELSE
345 IOUT(INDEX+1) = IOR(IAND(NOT(MASK),IOUT(INDEX+1)),J)
346 ENDIF
347 !
348 RETURN
349 END
350 !
351 ! +------------------------------------------------------------------+
352 SUBROUTINE SBYTES_G1(IOUT,IN,ISKIP,NBYTE,NSKIP,N)
353 ! THIS PROGRAM WRITTEN BY.....
354 ! DR. ROBERT C. GAMMILL, CONSULTANT
355 ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
356 ! JULY 1972
357 ! THIS IS THE FORTRAN VERSIONS OF SBYTES.
358 !
359 ! FORTRAN 90
360 ! AUGUST 1990 RUSSELL E. JONES
361 ! NATIONAL WEATHER SERVICE
362 !
363 ! USAGE: CALL SBYTES (PCKD,UNPK,INOFST,NBIT, NSKIP,ITER)
364 !
365 ! INPUT ARGUMENT LIST:
366 ! UNPK - NBITS OF THE RIGHT SIDE OF EACH WORD OF ARRAY
367 ! UNPK IS MOVED TO ARRAY PCKD. INOFST BITS ARE
368 ! SKIPPED OVER BEFORE THE 1ST DATA IS MOVED, NBITS
369 ! ARE STORED, NSKIP BITS ARE SKIPPED OVER, THE NEXT
370 ! NBITS ARE MOVED, BIT ARE SKIPPED OVER, ETC. UNTIL
371 ! ITER GROUPS OF BITS ARE PACKED.
372 ! INOFST - A FULLWORD INTEGER SPECIFYING THE INITAL OFFSET
373 ! IN BITS OF THE FIRST BYTE, COUNTED FROM THE
374 ! LEFTMOST BIT IN PCKD.
375 ! NBITS - A FULLWORD INTEGER SPECIFYING THE NUMBER OF BITS
376 ! IN EACH BYTE TO BE PACKED. LEGAL BYTE WIDTHS
377 ! ARE IN THE RANGE 1 - 32.
378 ! NSKIP - A FULLWORD INTEGER SPECIFYING THE NUMBER OF BITS
379 ! TO SKIP BETWEEN SUCCESSIVE BYTES. ALL NON-NEGATIVE
380 ! SKIP COUNTS ARE LEGAL.
381 ! ITER - A FULLWORD INTEGER SPECIFYING THE TOTAL NUMBER OF
382 ! BYTES TO BE PACKED, AS CONTROLLED BY INOFST,
383 ! NBIT AND NSKIP ABOVE. ALL NON-NEGATIVE ITERATION
384 ! COUNTS ARE LEGAL.
385 !
386 ! OUTPUT ARGUMENT LIST:
387 ! PCKD - THE FULLWORD IN MEMORY TO WHICH PACKING IS TO
388 ! BEGIN STARTING AT BIT INOFST. THE INOSTAT BITS
389 ! ARE NOT ALTERED. NSKIP BITS ARE NOT ALTERED.
390 !
391 INTEGER IN(*)
392 INTEGER IOUT(*)
393 #if defined (CRAY) || defined (BIT64)
394 INTEGER MASKS(64)
395 !
396 DATA NBITSW/64/
397 !
398 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 64 BIT
399 ! COMPUTER
400 !
401 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
402 & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
403 & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
404 & 67108863, 134217727, 268435455, 536870911, 1073741823, &
405 & 2147483647, 4294967295, 8589934591, 17179869183, &
406 & 34359738367, 68719476735, 137438953471, 274877906943, &
407 & 549755813887, 1099511627775, 2199023255551, 4398046511103, &
408 & 8796093022207, 17592186044415, 35184372088831, &
409 & 70368744177663, 140737488355327, 281474976710655, &
410 & 562949953421311, 1125899906842623, 2251799813685247, &
411 & 4503599627370495, 9007199254740991, 18014398509481983, &
412 & 36028797018963967, 72057594037927935, 144115188075855871, &
413 & 288230376151711743, 576460752303423487, 1152921504606846975, &
414 & 2305843009213693951, 4611686018427387903, 9223372036854775807, &
415 & -1/
416 #else
417 INTEGER MASKS(32)
418 !
419 DATA NBITSW/32/
420 !
421 ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT
422 ! COMPUTER
423 !
424 DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, &
425 & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, &
426 & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, &
427 & 67108863, 134217727, 268435455, 536870911, 1073741823, &
428 & 2147483647, -1/
429 #endif
430 !
431 ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW
432 !
433 ICON = NBITSW - NBYTE
434 IF (ICON.LT.0) RETURN
435 MASK = MASKS(NBYTE)
436 !
437 ! INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.
438 !
439 INDEX = ISKIP / NBITSW
440 !
441 ! II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.
442 !
443 II = MOD(ISKIP,NBITSW)
444 !
445 ! ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT.
446 !
447 ISTEP = NBYTE + NSKIP
448 !
449 ! IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.
450 !
451 IWORDS = ISTEP / NBITSW
452 !
453 ! IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.
454 !
455 IBITS = MOD(ISTEP,NBITSW)
456 !
457 DO 10 I = 1,N
458 J = IAND(MASK,IN(I))
459 MOVEL = ICON - II
460 !
461 ! BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT.
462 !
463 IF (MOVEL.GT.0) THEN
464 MSK = ISHFT(MASK,MOVEL)
465 IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), &
466 & ISHFT(J,MOVEL))
467 !
468 ! THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.
469 !
470 ELSE IF (MOVEL.LT.0) THEN
471 MSK = MASKS(NBYTE+MOVEL)
472 IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), &
473 & ISHFT(J,MOVEL))
474 ITEMP = IAND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2))
475 IOUT(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL))
476 !
477 ! BYTE IS TO BE STORED RIGHT-ADJUSTED.
478 !
479 ELSE
480 IOUT(INDEX+1) = IOR(IAND(NOT(MASK),IOUT(INDEX+1)),J)
481 ENDIF
482 !
483 II = II + IBITS
484 INDEX = INDEX + IWORDS
485 IF (II.GE.NBITSW) THEN
486 II = II - NBITSW
487 INDEX = INDEX + 1
488 ENDIF
489 !
490 10 CONTINUE
491 !
492 RETURN
493 END