source: trunk/WRF.COMMON/WRFV3/external/RSL_LITE/f_pack.F90 @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

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