source: XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.f90 @ 8

Last change on this file since 8 was 8, checked in by ymipsl, 15 years ago

Importation des sources du serveur XMLIO
File size: 10.9 KB
Line 
1  MODULE mod_pack
2    INTEGER,PARAMETER :: integer_size=4
3    INTEGER,PARAMETER :: pack_buffer_max_size=integer_size*1024*1024
4    INTEGER(kind=8),POINTER,SAVE      :: pack_buffer(:)
5    INTEGER,SAVE      :: pack_pos
6   
7    INTERFACE pack
8      MODULE PROCEDURE pack_r,pack_r1,pack_r2,pack_r3,pack_r4,                 &
9                       pack_i,pack_i1,pack_i2,pack_i3,pack_i4,                 &
10                       pack_l,pack_l1,pack_l2,pack_l3,pack_l4,                 &
11                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4
12    END INTERFACE pack
13
14    INTERFACE unpack
15      MODULE PROCEDURE unpack_r,unpack_r1,unpack_r2,unpack_r3,unpack_r4,       &
16                       unpack_i,unpack_i1,unpack_i2,unpack_i3,unpack_i4,       &
17                       unpack_l,unpack_l1,unpack_l2,unpack_l3,unpack_l4,       &
18                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4
19    END INTERFACE unpack
20
21    INTERFACE pack_field
22      MODULE PROCEDURE pack_field1,pack_field2,pack_field3,pack_field4       
23    END INTERFACE pack_field
24
25    INTERFACE unpack_field
26      MODULE PROCEDURE unpack_field1,unpack_field2,unpack_field3,unpack_field4 
27    END INTERFACE unpack_field
28           
29  CONTAINS
30 
31    SUBROUTINE set_pack_buffer(pack_buffer0,pack_pos0)
32    IMPLICIT NONE
33    INTEGER(kind=8),POINTER  :: pack_buffer0(:)
34    INTEGER                  :: pack_pos0
35   
36      pack_buffer=>pack_buffer0
37      pack_pos=pack_pos0
38
39    END SUBROUTINE set_pack_buffer
40   
41   
42    SUBROUTINE pack_r(arg)
43      IMPLICIT NONE
44        REAL :: arg
45         
46        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,1)
47     
48     END SUBROUTINE pack_r
49     
50     SUBROUTINE pack_r1(arg)
51      IMPLICIT NONE
52        REAL :: arg(:)
53       
54        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
55       
56     END SUBROUTINE pack_r1
57
58   
59     SUBROUTINE pack_r2(arg)
60      IMPLICIT NONE
61        REAL :: arg(:,:)
62       
63        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
64       
65     END SUBROUTINE pack_r2
66     
67     
68     SUBROUTINE pack_r3(arg)
69      IMPLICIT NONE
70        REAL :: arg(:,:,:)
71       
72        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
73       
74     END SUBROUTINE pack_r3
75
76     
77     SUBROUTINE pack_r4(arg)
78      IMPLICIT NONE
79        REAL :: arg(:,:,:,:)
80       
81        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
82       
83     END SUBROUTINE pack_r4
84
85
86    SUBROUTINE unpack_r(arg)
87      IMPLICIT NONE
88        REAL :: arg
89         
90        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,1)
91     
92     END SUBROUTINE unpack_r
93     
94     SUBROUTINE unpack_r1(arg)
95      IMPLICIT NONE
96        REAL :: arg(:)
97       
98        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
99       
100     END SUBROUTINE unpack_r1
101
102   
103     SUBROUTINE unpack_r2(arg)
104      IMPLICIT NONE
105        REAL :: arg(:,:)
106       
107        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
108       
109     END SUBROUTINE unpack_r2
110     
111     
112     SUBROUTINE unpack_r3(arg)
113      IMPLICIT NONE
114        REAL :: arg(:,:,:)
115       
116        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
117       
118     END SUBROUTINE unpack_r3
119
120     
121     SUBROUTINE unpack_r4(arg)
122      IMPLICIT NONE
123        REAL :: arg(:,:,:,:)
124       
125        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
126       
127     END SUBROUTINE unpack_r4
128
129
130
131
132    SUBROUTINE pack_i(arg)
133      IMPLICIT NONE
134        INTEGER :: arg
135         
136        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,1)
137     
138     END SUBROUTINE pack_i
139     
140     SUBROUTINE pack_i1(arg)
141      IMPLICIT NONE
142        INTEGER :: arg(:)
143       
144        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
145       
146     END SUBROUTINE pack_i1
147
148   
149     SUBROUTINE pack_i2(arg)
150      IMPLICIT NONE
151        INTEGER :: arg(:,:)
152       
153        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
154       
155     END SUBROUTINE pack_i2
156     
157     
158     SUBROUTINE pack_i3(arg)
159      IMPLICIT NONE
160        INTEGER :: arg(:,:,:)
161       
162        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
163       
164     END SUBROUTINE pack_i3
165
166     
167     SUBROUTINE pack_i4(arg)
168      IMPLICIT NONE
169        INTEGER :: arg(:,:,:,:)
170       
171        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
172       
173     END SUBROUTINE pack_i4
174     
175
176    SUBROUTINE unpack_i(arg)
177      IMPLICIT NONE
178        INTEGER :: arg
179         
180        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,1)
181     
182     END SUBROUTINE unpack_i
183     
184     SUBROUTINE unpack_i1(arg)
185      IMPLICIT NONE
186        INTEGER :: arg(:)
187       
188        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
189       
190     END SUBROUTINE unpack_i1
191
192   
193     SUBROUTINE unpack_i2(arg)
194      IMPLICIT NONE
195        INTEGER :: arg(:,:)
196       
197        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
198       
199     END SUBROUTINE unpack_i2
200     
201     
202     SUBROUTINE unpack_i3(arg)
203      IMPLICIT NONE
204        INTEGER :: arg(:,:,:)
205       
206        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
207       
208     END SUBROUTINE unpack_i3
209
210     
211     SUBROUTINE unpack_i4(arg)
212      IMPLICIT NONE
213        INTEGER :: arg(:,:,:,:)
214       
215        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
216       
217     END SUBROUTINE unpack_i4     
218
219
220
221
222
223
224
225    SUBROUTINE pack_l(arg)
226      IMPLICIT NONE
227        LOGICAL :: arg
228         
229        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,1)
230     
231     END SUBROUTINE pack_l
232     
233     SUBROUTINE pack_l1(arg)
234      IMPLICIT NONE
235        LOGICAL :: arg(:)
236       
237        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
238       
239     END SUBROUTINE pack_l1
240
241   
242     SUBROUTINE pack_l2(arg)
243      IMPLICIT NONE
244        LOGICAL :: arg(:,:)
245       
246        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
247       
248     END SUBROUTINE pack_l2
249     
250     
251     SUBROUTINE pack_l3(arg)
252      IMPLICIT NONE
253        LOGICAL :: arg(:,:,:)
254       
255        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
256       
257     END SUBROUTINE pack_l3
258
259     
260     SUBROUTINE pack_l4(arg)
261      IMPLICIT NONE
262        LOGICAL :: arg(:,:,:,:)
263       
264        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
265       
266     END SUBROUTINE pack_l4
267     
268
269    SUBROUTINE unpack_l(arg)
270      IMPLICIT NONE
271        LOGICAL :: arg
272         
273        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,1)
274     
275     END SUBROUTINE unpack_l
276     
277     SUBROUTINE unpack_l1(arg)
278      IMPLICIT NONE
279        LOGICAL :: arg(:)
280       
281        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
282       
283     END SUBROUTINE unpack_l1
284
285   
286     SUBROUTINE unpack_l2(arg)
287      IMPLICIT NONE
288        LOGICAL :: arg(:,:)
289       
290        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
291       
292     END SUBROUTINE unpack_l2
293     
294     
295     SUBROUTINE unpack_l3(arg)
296      IMPLICIT NONE
297        LOGICAL :: arg(:,:,:)
298       
299        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
300       
301     END SUBROUTINE unpack_l3
302
303     
304     SUBROUTINE unpack_l4(arg)
305      IMPLICIT NONE
306        LOGICAL :: arg(:,:,:,:)
307       
308        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
309       
310     END SUBROUTINE unpack_l4     
311
312
313
314
315   
316     
317   SUBROUTINE pack_c(arg)
318      IMPLICIT NONE
319        CHARACTER(len=*) :: arg
320         
321        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
322     
323     END SUBROUTINE pack_c
324     
325     SUBROUTINE pack_c1(arg)
326      IMPLICIT NONE
327        CHARACTER(len=*) :: arg(:)
328       
329        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
330       
331     END SUBROUTINE pack_c1
332
333   
334     SUBROUTINE pack_c2(arg)
335      IMPLICIT NONE
336        CHARACTER(len=*) :: arg(:,:)
337       
338        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
339       
340     END SUBROUTINE pack_c2
341     
342     
343     SUBROUTINE pack_c3(arg)
344      IMPLICIT NONE
345        CHARACTER(len=*) :: arg(:,:,:)
346       
347        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
348       
349     END SUBROUTINE pack_c3
350
351     
352     SUBROUTINE pack_c4(arg)
353      IMPLICIT NONE
354        CHARACTER(len=*) :: arg(:,:,:,:)
355       
356        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
357       
358     END SUBROUTINE pack_c4
359     
360
361    SUBROUTINE unpack_c(arg)
362      IMPLICIT NONE
363        CHARACTER(len=*) :: arg
364         
365        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
366     
367     END SUBROUTINE unpack_c
368     
369     SUBROUTINE unpack_c1(arg)
370      IMPLICIT NONE
371        CHARACTER(len=*) :: arg(:)
372       
373        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
374       
375     END SUBROUTINE unpack_c1
376
377   
378     SUBROUTINE unpack_c2(arg)
379      IMPLICIT NONE
380        CHARACTER(len=*) :: arg(:,:)
381       
382        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
383       
384     END SUBROUTINE unpack_c2
385     
386     
387     SUBROUTINE unpack_c3(arg)
388      IMPLICIT NONE
389        CHARACTER(len=*) :: arg(:,:,:)
390       
391        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
392       
393     END SUBROUTINE unpack_c3
394
395     
396     SUBROUTINE unpack_c4(arg)
397      IMPLICIT NONE
398        CHARACTER(len=*) :: arg(:,:,:,:)
399       
400        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
401       
402     END SUBROUTINE unpack_c4     
403     
404
405
406
407
408     SUBROUTINE pack_field1(arg)
409     IMPLICIT NONE
410       REAL :: arg(:)
411     
412       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
413     END SUBROUTINE pack_field1
414
415
416     SUBROUTINE pack_field2(arg)
417     IMPLICIT NONE
418       REAL :: arg(:,:)
419       
420       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
421     END SUBROUTINE pack_field2
422     
423     SUBROUTINE pack_field3(arg)
424     IMPLICIT NONE
425       REAL :: arg(:,:,:)
426     
427       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
428     END SUBROUTINE pack_field3
429
430     SUBROUTINE pack_field4(arg)
431     IMPLICIT NONE
432       REAL :: arg(:,:,:,:)
433     
434       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
435     END SUBROUTINE pack_field4
436
437
438
439     SUBROUTINE unpack_field1(arg)
440     IMPLICIT NONE
441       REAL :: arg(:)
442     
443       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
444     END SUBROUTINE unpack_field1
445
446
447     SUBROUTINE unpack_field2(arg)
448     IMPLICIT NONE
449       REAL :: arg(:,:)
450     
451       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
452     END SUBROUTINE unpack_field2
453     
454     SUBROUTINE unpack_field3(arg)
455     IMPLICIT NONE
456       REAL :: arg(:,:,:)
457     
458       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
459     END SUBROUTINE unpack_field3
460
461     SUBROUTINE unpack_field4(arg)
462     IMPLICIT NONE
463       REAL :: arg(:,:,:,:)
464     
465       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
466     END SUBROUTINE unpack_field4
467     
468  END MODULE mod_pack
Note: See TracBrowser for help on using the repository browser.