f_pack.f
References to this file elsewhere.
1
2
3 MODULE duplicate_of_driver_constants
4 ! These definitions must be the same as frame/module_driver_constants
5 ! and also the same as the definitions in rsl_lite.h
6 INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
7 INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
8 INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
9 INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
10 INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
11 INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
12 END MODULE duplicate_of_driver_constants
13
14 SUBROUTINE f_pack_int ( inbuf, outbuf, memorder, js, je, ks, ke, &
15 & is, ie, jms, jme, kms, kme, ims, ime, curs )
16 USE duplicate_of_driver_constants
17 IMPLICIT NONE
18 INTEGER, INTENT(IN) :: memorder
19 INTEGER ims, ime, jms, jme, kms, kme
20 INTEGER inbuf(*), outbuf(*)
21 INTEGER js, je, ks, ke, is, ie, curs
22 SELECT CASE ( memorder )
23 CASE ( DATA_ORDER_XYZ )
24 CALL f_pack_int_ijk( inbuf, outbuf, js, je, ks, ke, is, ie, &
25 & jms, jme, kms, kme, ims, ime, curs )
26 CASE ( DATA_ORDER_YXZ )
27 CALL f_pack_int_jik( inbuf, outbuf, js, je, ks, ke, is, ie, &
28 & jms, jme, kms, kme, ims, ime, curs )
29 CASE ( DATA_ORDER_XZY )
30 CALL f_pack_int_ikj( inbuf, outbuf, js, je, ks, ke, is, ie, &
31 & jms, jme, kms, kme, ims, ime, curs )
32 CASE ( DATA_ORDER_YZX )
33 CALL f_pack_int_jki( inbuf, outbuf, js, je, ks, ke, is, ie, &
34 & jms, jme, kms, kme, ims, ime, curs )
35 CASE ( DATA_ORDER_ZXY )
36 CALL f_pack_int_kij( inbuf, outbuf, js, je, ks, ke, is, ie, &
37 & jms, jme, kms, kme, ims, ime, curs )
38 CASE ( DATA_ORDER_ZYX )
39 CALL f_pack_int_kji( inbuf, outbuf, js, je, ks, ke, is, ie, &
40 & jms, jme, kms, kme, ims, ime, curs )
41 END SELECT
42 RETURN
43 END SUBROUTINE f_pack_int
44
45 SUBROUTINE f_pack_lint ( inbuf, outbuf, memorder, js, je, ks, ke, &
46 & is, ie, jms, jme, kms, kme, ims, ime, curs )
47 USE duplicate_of_driver_constants
48 IMPLICIT NONE
49 INTEGER, INTENT(IN) :: memorder
50 INTEGER jms, jme, kms, kme, ims, ime
51 INTEGER*8 inbuf(*), outbuf(*)
52 INTEGER js, je, ks, ke, is, ie, curs
53 SELECT CASE ( memorder )
54 CASE ( DATA_ORDER_XYZ )
55 CALL f_pack_lint_ijk( inbuf, outbuf, js, je, ks, ke, is, ie, &
56 & jms, jme, kms, kme, ims, ime, curs )
57 CASE ( DATA_ORDER_YXZ )
58 CALL f_pack_lint_jik( inbuf, outbuf, js, je, ks, ke, is, ie, &
59 & jms, jme, kms, kme, ims, ime, curs )
60 CASE ( DATA_ORDER_XZY )
61 CALL f_pack_lint_ikj( inbuf, outbuf, js, je, ks, ke, is, ie, &
62 & jms, jme, kms, kme, ims, ime, curs )
63 CASE ( DATA_ORDER_YZX )
64 CALL f_pack_lint_jki( inbuf, outbuf, js, je, ks, ke, is, ie, &
65 & jms, jme, kms, kme, ims, ime, curs )
66 CASE ( DATA_ORDER_ZXY )
67 CALL f_pack_lint_kij( inbuf, outbuf, js, je, ks, ke, is, ie, &
68 & jms, jme, kms, kme, ims, ime, curs )
69 CASE ( DATA_ORDER_ZYX )
70 CALL f_pack_lint_kji( inbuf, outbuf, js, je, ks, ke, is, ie, &
71 & jms, jme, kms, kme, ims, ime, curs )
72 END SELECT
73 RETURN
74 END SUBROUTINE f_pack_lint
75
76 SUBROUTINE f_unpack_int ( inbuf, outbuf, memorder, js, je, ks, ke, &
77 & is, ie, jms, jme, kms, kme, ims, ime, curs )
78 USE duplicate_of_driver_constants
79 IMPLICIT NONE
80 INTEGER, INTENT(IN) :: memorder
81 INTEGER jms, jme, kms, kme, ims, ime
82 INTEGER outbuf(*), inbuf(*)
83 INTEGER js, je, ks, ke, is, ie, curs
84 SELECT CASE ( memorder )
85 CASE ( DATA_ORDER_XYZ )
86 CALL f_unpack_int_ijk( inbuf, outbuf, js, je, ks, ke, &
87 & is, ie, jms, jme, kms, kme, ims, ime, curs )
88 CASE ( DATA_ORDER_YXZ )
89 CALL f_unpack_int_jik( inbuf, outbuf, js, je, ks, ke, &
90 & is, ie, jms, jme, kms, kme, ims, ime, curs )
91 CASE ( DATA_ORDER_XZY )
92 CALL f_unpack_int_ikj( inbuf, outbuf, js, je, ks, ke, &
93 & is, ie, jms, jme, kms, kme, ims, ime, curs )
94 CASE ( DATA_ORDER_YZX )
95 CALL f_unpack_int_jki( inbuf, outbuf, js, je, ks, ke, &
96 & is, ie, jms, jme, kms, kme, ims, ime, curs )
97 CASE ( DATA_ORDER_ZXY )
98 CALL f_unpack_int_kij( inbuf, outbuf, js, je, ks, ke, &
99 & is, ie, jms, jme, kms, kme, ims, ime, curs )
100 CASE ( DATA_ORDER_ZYX )
101 CALL f_unpack_int_kji( inbuf, outbuf, js, je, ks, ke, &
102 & is, ie, jms, jme, kms, kme, ims, ime, curs )
103 END SELECT
104 RETURN
105 END SUBROUTINE f_unpack_int
106
107 SUBROUTINE f_unpack_lint ( inbuf, outbuf, memorder, js, je, ks, &
108 & ke, is, ie, jms, jme, kms, kme, ims, ime, curs )
109 USE duplicate_of_driver_constants
110 IMPLICIT NONE
111 INTEGER, INTENT(IN) :: memorder
112 INTEGER jms, jme, kms, kme, ims, ime
113 INTEGER*8 outbuf(*), inbuf(*)
114 INTEGER js, je, ks, ke, is, ie, curs
115 SELECT CASE ( memorder )
116 CASE ( DATA_ORDER_XYZ )
117 CALL f_unpack_lint_ijk( inbuf, outbuf, js, je, ks, ke, &
118 & is, ie, jms, jme, kms, kme, ims, ime, curs )
119 CASE ( DATA_ORDER_YXZ )
120 CALL f_unpack_lint_jik( inbuf, outbuf, js, je, ks, ke, &
121 & is, ie, jms, jme, kms, kme, ims, ime, curs )
122 CASE ( DATA_ORDER_XZY )
123 CALL f_unpack_lint_ikj( inbuf, outbuf, js, je, ks, ke, &
124 & is, ie, jms, jme, kms, kme, ims, ime, curs )
125 CASE ( DATA_ORDER_YZX )
126 CALL f_unpack_lint_jki( inbuf, outbuf, js, je, ks, ke, &
127 & is, ie, jms, jme, kms, kme, ims, ime, curs )
128 CASE ( DATA_ORDER_ZXY )
129 CALL f_unpack_lint_kij( inbuf, outbuf, js, je, ks, ke, &
130 & is, ie, jms, jme, kms, kme, ims, ime, curs )
131 CASE ( DATA_ORDER_ZYX )
132 CALL f_unpack_lint_kji( inbuf, outbuf, js, je, ks, ke, &
133 & is, ie, jms, jme, kms, kme, ims, ime, curs )
134 END SELECT
135 RETURN
136 END SUBROUTINE f_unpack_lint
137
138 !ikj
139 SUBROUTINE f_pack_int_ikj ( inbuf, outbuf, js, je, ks, ke, &
140 & is, ie, jms, jme, kms, kme, ims, ime, curs )
141 IMPLICIT NONE
142 INTEGER jms, jme, kms, kme, ims, ime
143 INTEGER inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
144 INTEGER js, je, ks, ke, is, ie, curs
145 ! Local
146 INTEGER i,j,k,p
147 p = 1
148 DO j = js, je
149 DO k = ks, ke
150 DO i = is, ie
151 outbuf(p) = inbuf(i,k,j)
152 p = p + 1
153 ENDDO
154 ENDDO
155 ENDDO
156 curs = p - 1
157 RETURN
158 END SUBROUTINE f_pack_int_ikj
159
160 SUBROUTINE f_pack_lint_ikj ( inbuf, outbuf, js, je, ks, ke, &
161 & is, ie, jms, jme, kms, kme, ims, ime, curs )
162 IMPLICIT NONE
163 INTEGER jms, jme, kms, kme, ims, ime
164 INTEGER*8 inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
165 INTEGER js, je, ks, ke, is, ie, curs
166 ! Local
167 INTEGER i,j,k,p
168 p = 1
169 DO j = js, je
170 DO k = ks, ke
171 DO i = is, ie
172 outbuf(p) = inbuf(i,k,j)
173 p = p + 1
174 ENDDO
175 ENDDO
176 ENDDO
177 curs = p - 1
178 RETURN
179 END SUBROUTINE f_pack_lint_ikj
180
181 SUBROUTINE f_unpack_int_ikj ( inbuf, outbuf, js, je, ks, ke, &
182 & is, ie, jms, jme, kms, kme, ims, ime, curs )
183 IMPLICIT NONE
184 INTEGER jms, jme, kms, kme, ims, ime
185 INTEGER outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
186 INTEGER js, je, ks, ke, is, ie, curs
187 ! Local
188 INTEGER i,j,k,p
189 p = 1
190 DO j = js, je
191 DO k = ks, ke
192 DO i = is, ie
193 outbuf(i,k,j) = inbuf(p)
194 p = p + 1
195 ENDDO
196 ENDDO
197 ENDDO
198 curs = p - 1
199 RETURN
200 END SUBROUTINE f_unpack_int_ikj
201
202 SUBROUTINE f_unpack_lint_ikj ( inbuf, outbuf, js, je, ks, ke, &
203 & is, ie, jms, jme, kms, kme, ims, ime, curs )
204 IMPLICIT NONE
205 INTEGER jms, jme, kms, kme, ims, ime
206 INTEGER*8 outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
207 INTEGER js, je, ks, ke, is, ie, curs
208 ! Local
209 INTEGER i,j,k,p
210 p = 1
211 DO j = js, je
212 DO k = ks, ke
213 DO i = is, ie
214 outbuf(i,k,j) = inbuf(p)
215 p = p + 1
216 ENDDO
217 ENDDO
218 ENDDO
219 curs = p - 1
220 RETURN
221 END SUBROUTINE f_unpack_lint_ikj
222
223 !jki
224 SUBROUTINE f_pack_int_jki ( inbuf, outbuf, js, je, ks, ke, &
225 & is, ie, jms, jme, kms, kme, ims, ime, curs )
226 IMPLICIT NONE
227 INTEGER jms, jme, kms, kme, ims, ime
228 INTEGER inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
229 INTEGER js, je, ks, ke, is, ie, curs
230 ! Local
231 INTEGER i,j,k,p
232 p = 1
233 DO i = is, ie
234 DO k = ks, ke
235 DO j = js, je
236 outbuf(p) = inbuf(j,k,i)
237 p = p + 1
238 ENDDO
239 ENDDO
240 ENDDO
241 curs = p - 1
242 RETURN
243 END SUBROUTINE f_pack_int_jki
244
245 SUBROUTINE f_pack_lint_jki ( inbuf, outbuf, js, je, ks, ke, &
246 & is, ie, jms, jme, kms, kme, ims, ime, curs )
247 IMPLICIT NONE
248 INTEGER jms, jme, kms, kme, ims, ime
249 INTEGER*8 inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
250 INTEGER js, je, ks, ke, is, ie, curs
251 ! Local
252 INTEGER i,j,k,p
253 p = 1
254 DO i = is, ie
255 DO k = ks, ke
256 DO j = js, je
257 outbuf(p) = inbuf(j,k,i)
258 p = p + 1
259 ENDDO
260 ENDDO
261 ENDDO
262 curs = p - 1
263 RETURN
264 END SUBROUTINE f_pack_lint_jki
265
266 SUBROUTINE f_unpack_int_jki ( inbuf, outbuf, js, je, ks, ke, &
267 & is, ie, jms, jme, kms, kme, ims, ime, curs )
268 IMPLICIT NONE
269 INTEGER jms, jme, kms, kme, ims, ime
270 INTEGER outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
271 INTEGER js, je, ks, ke, is, ie, curs
272 ! Local
273 INTEGER i,j,k,p
274 p = 1
275 DO i = is, ie
276 DO k = ks, ke
277 DO j = js, je
278 outbuf(j,k,i) = inbuf(p)
279 p = p + 1
280 ENDDO
281 ENDDO
282 ENDDO
283 curs = p - 1
284 RETURN
285 END SUBROUTINE f_unpack_int_jki
286
287 SUBROUTINE f_unpack_lint_jki ( inbuf, outbuf, js, je, ks, ke, &
288 & is, ie, jms, jme, kms, kme, ims, ime, curs )
289 IMPLICIT NONE
290 INTEGER jms, jme, kms, kme, ims, ime
291 INTEGER*8 outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
292 INTEGER js, je, ks, ke, is, ie, curs
293 ! Local
294 INTEGER i,j,k,p
295 p = 1
296 DO i = is, ie
297 DO k = ks, ke
298 DO j = js, je
299 outbuf(j,k,i) = inbuf(p)
300 p = p + 1
301 ENDDO
302 ENDDO
303 ENDDO
304 curs = p - 1
305 RETURN
306 END SUBROUTINE f_unpack_lint_jki
307
308 !ijk
309 SUBROUTINE f_pack_int_ijk ( inbuf, outbuf, js, je, ks, ke, &
310 & is, ie, jms, jme, kms, kme, ims, ime, curs )
311 IMPLICIT NONE
312 INTEGER jms, jme, kms, kme, ims, ime
313 INTEGER inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
314 INTEGER js, je, ks, ke, is, ie, curs
315 ! Local
316 INTEGER i,j,k,p
317 p = 1
318 DO k = ks, ke
319 DO j = js, je
320 DO i = is, ie
321 outbuf(p) = inbuf(i,j,k)
322 p = p + 1
323 ENDDO
324 ENDDO
325 ENDDO
326 curs = p - 1
327 RETURN
328 END SUBROUTINE f_pack_int_ijk
329
330 SUBROUTINE f_pack_lint_ijk ( inbuf, outbuf, js, je, ks, ke, &
331 & is, ie, jms, jme, kms, kme, ims, ime, curs )
332 IMPLICIT NONE
333 INTEGER jms, jme, kms, kme, ims, ime
334 INTEGER*8 inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
335 INTEGER js, je, ks, ke, is, ie, curs
336 ! Local
337 INTEGER i,j,k,p
338 p = 1
339 DO k = ks, ke
340 DO j = js, je
341 DO i = is, ie
342 outbuf(p) = inbuf(i,j,k)
343 p = p + 1
344 ENDDO
345 ENDDO
346 ENDDO
347 curs = p - 1
348 RETURN
349 END SUBROUTINE f_pack_lint_ijk
350
351 SUBROUTINE f_unpack_int_ijk ( inbuf, outbuf, js, je, ks, ke, &
352 & is, ie, jms, jme, kms, kme, ims, ime, curs )
353 IMPLICIT NONE
354 INTEGER jms, jme, kms, kme, ims, ime
355 INTEGER outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
356 INTEGER js, je, ks, ke, is, ie, curs
357 ! Local
358 INTEGER i,j,k,p
359 p = 1
360 DO k = ks, ke
361 DO j = js, je
362 DO i = is, ie
363 outbuf(i,j,k) = inbuf(p)
364 p = p + 1
365 ENDDO
366 ENDDO
367 ENDDO
368 curs = p - 1
369 RETURN
370 END SUBROUTINE f_unpack_int_ijk
371
372 SUBROUTINE f_unpack_lint_ijk ( inbuf, outbuf, js, je, ks, ke, &
373 & is, ie, jms, jme, kms, kme, ims, ime, curs )
374 IMPLICIT NONE
375 INTEGER jms, jme, kms, kme, ims, ime
376 INTEGER*8 outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
377 INTEGER js, je, ks, ke, is, ie, curs
378 ! Local
379 INTEGER i,j,k,p
380 p = 1
381 DO k = ks, ke
382 DO j = js, je
383 DO i = is, ie
384 outbuf(i,j,k) = inbuf(p)
385 p = p + 1
386 ENDDO
387 ENDDO
388 ENDDO
389 curs = p - 1
390 RETURN
391 END SUBROUTINE f_unpack_lint_ijk
392
393 !jik
394 SUBROUTINE f_pack_int_jik ( inbuf, outbuf, js, je, ks, ke, &
395 & is, ie, jms, jme, kms, kme, ims, ime, curs )
396 IMPLICIT NONE
397 INTEGER jms, jme, kms, kme, ims, ime
398 INTEGER inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
399 INTEGER js, je, ks, ke, is, ie, curs
400 ! Local
401 INTEGER i,j,k,p
402 p = 1
403 DO k = ks, ke
404 DO i = is, ie
405 DO j = js, je
406 outbuf(p) = inbuf(j,i,k)
407 p = p + 1
408 ENDDO
409 ENDDO
410 ENDDO
411 curs = p - 1
412 RETURN
413 END SUBROUTINE f_pack_int_jik
414
415 SUBROUTINE f_pack_lint_jik ( inbuf, outbuf, js, je, ks, ke, &
416 & is, ie, jms, jme, kms, kme, ims, ime, curs )
417 IMPLICIT NONE
418 INTEGER jms, jme, kms, kme, ims, ime
419 INTEGER*8 inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
420 INTEGER js, je, ks, ke, is, ie, curs
421 ! Local
422 INTEGER i,j,k,p
423 p = 1
424 DO k = ks, ke
425 DO i = is, ie
426 DO j = js, je
427 outbuf(p) = inbuf(j,i,k)
428 p = p + 1
429 ENDDO
430 ENDDO
431 ENDDO
432 curs = p - 1
433 RETURN
434 END SUBROUTINE f_pack_lint_jik
435
436 SUBROUTINE f_unpack_int_jik ( inbuf, outbuf, js, je, ks, ke, &
437 & is, ie, jms, jme, kms, kme, ims, ime, curs )
438 IMPLICIT NONE
439 INTEGER jms, jme, kms, kme, ims, ime
440 INTEGER outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
441 INTEGER js, je, ks, ke, is, ie, curs
442 ! Local
443 INTEGER i,j,k,p
444 p = 1
445 DO k = ks, ke
446 DO i = is, ie
447 DO j = js, je
448 outbuf(j,i,k) = inbuf(p)
449 p = p + 1
450 ENDDO
451 ENDDO
452 ENDDO
453 curs = p - 1
454 RETURN
455 END SUBROUTINE f_unpack_int_jik
456
457 SUBROUTINE f_unpack_lint_jik ( inbuf, outbuf, js, je, ks, ke, &
458 & is, ie, jms, jme, kms, kme, ims, ime, curs )
459 IMPLICIT NONE
460 INTEGER jms, jme, kms, kme, ims, ime
461 INTEGER*8 outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
462 INTEGER js, je, ks, ke, is, ie, curs
463 ! Local
464 INTEGER i,j,k,p
465 p = 1
466 DO k = ks, ke
467 DO i = is, ie
468 DO j = js, je
469 outbuf(j,i,k) = inbuf(p)
470 p = p + 1
471 ENDDO
472 ENDDO
473 ENDDO
474 curs = p - 1
475 RETURN
476 END SUBROUTINE f_unpack_lint_jik
477
478 !kij
479 SUBROUTINE f_pack_int_kij ( inbuf, outbuf, js, je, ks, ke, &
480 & is, ie, jms, jme, kms, kme, ims, ime, curs )
481 IMPLICIT NONE
482 INTEGER jms, jme, kms, kme, ims, ime
483 INTEGER inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
484 INTEGER js, je, ks, ke, is, ie, curs
485 ! Local
486 INTEGER i,j,k,p
487 p = 1
488 DO j = js, je
489 DO i = is, ie
490 DO k = ks, ke
491 outbuf(p) = inbuf(k,i,j)
492 p = p + 1
493 ENDDO
494 ENDDO
495 ENDDO
496 curs = p - 1
497 RETURN
498 END SUBROUTINE f_pack_int_kij
499
500 SUBROUTINE f_pack_lint_kij ( inbuf, outbuf, js, je, ks, ke, &
501 & is, ie, jms, jme, kms, kme, ims, ime, curs )
502 IMPLICIT NONE
503 INTEGER jms, jme, kms, kme, ims, ime
504 INTEGER*8 inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
505 INTEGER js, je, ks, ke, is, ie, curs
506 ! Local
507 INTEGER i,j,k,p
508 p = 1
509 DO j = js, je
510 DO i = is, ie
511 DO k = ks, ke
512 outbuf(p) = inbuf(k,i,j)
513 p = p + 1
514 ENDDO
515 ENDDO
516 ENDDO
517 curs = p - 1
518 RETURN
519 END SUBROUTINE f_pack_lint_kij
520
521 SUBROUTINE f_unpack_int_kij ( inbuf, outbuf, js, je, ks, ke, &
522 & is, ie, jms, jme, kms, kme, ims, ime, curs )
523 IMPLICIT NONE
524 INTEGER jms, jme, kms, kme, ims, ime
525 INTEGER outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
526 INTEGER js, je, ks, ke, is, ie, curs
527 ! Local
528 INTEGER i,j,k,p
529 p = 1
530 DO j = js, je
531 DO i = is, ie
532 DO k = ks, ke
533 outbuf(k,i,j) = inbuf(p)
534 p = p + 1
535 ENDDO
536 ENDDO
537 ENDDO
538 curs = p - 1
539 RETURN
540 END SUBROUTINE f_unpack_int_kij
541
542 SUBROUTINE f_unpack_lint_kij ( inbuf, outbuf, js, je, ks, ke, &
543 & is, ie, jms, jme, kms, kme, ims, ime, curs )
544 IMPLICIT NONE
545 INTEGER jms, jme, kms, kme, ims, ime
546 INTEGER*8 outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
547 INTEGER js, je, ks, ke, is, ie, curs
548 ! Local
549 INTEGER i,j,k,p
550 p = 1
551 DO j = js, je
552 DO i = is, ie
553 DO k = ks, ke
554 outbuf(k,i,j) = inbuf(p)
555 p = p + 1
556 ENDDO
557 ENDDO
558 ENDDO
559 curs = p - 1
560 RETURN
561 END SUBROUTINE f_unpack_lint_kij
562
563 !kji
564 SUBROUTINE f_pack_int_kji ( inbuf, outbuf, js, je, ks, ke, &
565 & is, ie, jms, jme, kms, kme, ims, ime, curs )
566 IMPLICIT NONE
567 INTEGER jms, jme, kms, kme, ims, ime
568 INTEGER inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
569 INTEGER js, je, ks, ke, is, ie, curs
570 ! Local
571 INTEGER i,j,k,p
572 p = 1
573 DO i = is, ie
574 DO j = js, je
575 DO k = ks, ke
576 outbuf(p) = inbuf(k,j,i)
577 p = p + 1
578 ENDDO
579 ENDDO
580 ENDDO
581 curs = p - 1
582 RETURN
583 END SUBROUTINE f_pack_int_kji
584
585 SUBROUTINE f_pack_lint_kji ( inbuf, outbuf, js, je, ks, ke, &
586 & is, ie, jms, jme, kms, kme, ims, ime, curs )
587 IMPLICIT NONE
588 INTEGER jms, jme, kms, kme, ims, ime
589 INTEGER*8 inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
590 INTEGER js, je, ks, ke, is, ie, curs
591 ! Local
592 INTEGER i,j,k,p
593 p = 1
594 DO i = is, ie
595 DO j = js, je
596 DO k = ks, ke
597 outbuf(p) = inbuf(k,j,i)
598 p = p + 1
599 ENDDO
600 ENDDO
601 ENDDO
602 curs = p - 1
603 RETURN
604 END SUBROUTINE f_pack_lint_kji
605
606 SUBROUTINE f_unpack_int_kji ( inbuf, outbuf, js, je, ks, ke, &
607 & is, ie, jms, jme, kms, kme, ims, ime, curs )
608 IMPLICIT NONE
609 INTEGER jms, jme, kms, kme, ims, ime
610 INTEGER outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
611 INTEGER js, je, ks, ke, is, ie, curs
612 ! Local
613 INTEGER i,j,k,p
614 p = 1
615 DO i = is, ie
616 DO j = js, je
617 DO k = ks, ke
618 outbuf(k,j,i) = inbuf(p)
619 p = p + 1
620 ENDDO
621 ENDDO
622 ENDDO
623 curs = p - 1
624 RETURN
625 END SUBROUTINE f_unpack_int_kji
626
627 SUBROUTINE f_unpack_lint_kji ( inbuf, outbuf, js, je, ks, ke, &
628 & is, ie, jms, jme, kms, kme, ims, ime, curs )
629 IMPLICIT NONE
630 INTEGER jms, jme, kms, kme, ims, ime
631 INTEGER*8 outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
632 INTEGER js, je, ks, ke, is, ie, curs
633 ! Local
634 INTEGER i,j,k,p
635 p = 1
636 DO i = is, ie
637 DO j = js, je
638 DO k = ks, ke
639 outbuf(k,j,i) = inbuf(p)
640 p = p + 1
641 ENDDO
642 ENDDO
643 ENDDO
644 curs = p - 1
645 RETURN
646 END SUBROUTINE f_unpack_lint_kji
647