Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

gbytesys.F90 @ 3975

Last change on this file since 3975 was 11, checked in by aslmd, 15 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 16.8 KB

Line
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)
41
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format