source: palm/trunk/SOURCE/transpose.f90 @ 83

Last change on this file since 83 was 4, checked in by raasch, 18 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 19.2 KB
Line 
1 SUBROUTINE transpose_xy( f_in, work1, f_inv, work2, f_out )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: transpose.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.2  2004/04/30 13:12:17  raasch
14! Switched from mpi_alltoallv to the simpler mpi_alltoall,
15! all former transpose-routine files collected in this file, enlarged
16! transposition arrays introduced
17!
18! Revision 1.1  2004/04/30 13:08:16  raasch
19! Initial revision (collection of former routines transpose_xy, transpose_xz,
20!                   transpose_yx, transpose_yz, transpose_zx, transpose_zy)
21!
22! Revision 1.1  1997/07/24 11:25:18  raasch
23! Initial revision
24!
25!
26! Description:
27! ------------
28! Transposition of input array (f_in) from x to y. For the input array, all
29! elements along x reside on the same PE, while after transposition, all
30! elements along y reside on the same PE.
31!------------------------------------------------------------------------------!
32
33    USE cpulog
34    USE indices
35    USE interfaces
36    USE pegrid
37    USE transpose_indices
38
39    IMPLICIT NONE
40
41    INTEGER ::  i, j, k, l, m, ys
42   
43    REAL ::  f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                     &
44             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
45             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
46             work1(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), work2(nnx*nny*nnz)
47
48#if defined( __parallel )
49
50!
51!-- Rearrange indices of input array in order to make data to be send
52!-- by MPI contiguous
53    DO  k = nzb_x, nzt_xa
54       DO  j = nys_x, nyn_xa
55          DO  i = 0, nxa
56             work1(j,k,i) = f_in(i,j,k)
57          ENDDO
58       ENDDO
59    ENDDO
60
61!
62!-- Move data to different array, because memory location of work1 is
63!-- needed further below (work1 = work2)
64    DO  i = 0, nxa
65       DO  k = nzb_x, nzt_xa
66          DO  j = nys_x, nyn_xa
67             f_inv(j,k,i) = work1(j,k,i)
68          ENDDO
69       ENDDO
70    ENDDO
71
72!
73!-- Transpose array
74    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
75    CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
76                       work2(1),             sendrecvcount_xy, MPI_REAL, &
77                       comm1dy, ierr )
78    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
79
80!
81!-- Reorder transposed array
82    m = 0
83    DO  l = 0, pdims(2) - 1
84       ys = 0 + l * ( nyn_xa - nys_x + 1 )
85       DO  i = nxl_y, nxr_ya
86          DO  k = nzb_y, nzt_ya
87             DO  j = ys, ys + nyn_xa - nys_x
88                m = m + 1
89                f_out(j,i,k) = work2(m)
90             ENDDO
91          ENDDO
92       ENDDO
93    ENDDO
94
95#endif
96
97 END SUBROUTINE transpose_xy
98
99
100 SUBROUTINE transpose_xz( f_in, work1, f_inv, work2, f_out )
101
102!------------------------------------------------------------------------------!
103! Description:
104! ------------
105! Transposition of input array (f_in) from x to z. For the input array, all
106! elements along x reside on the same PE, while after transposition, all
107! elements along z reside on the same PE.
108!------------------------------------------------------------------------------!
109
110    USE cpulog
111    USE indices
112    USE interfaces
113    USE pegrid
114    USE transpose_indices
115
116    IMPLICIT NONE
117
118    INTEGER ::  i, j, k, l, m, xs
119   
120    REAL ::  f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),             &
121             f_inv(nxl:nxra,nys:nyna,1:nza),                    &
122             f_out(1:nza,nys:nyna,nxl:nxra),                    &
123             work1(1:nza,nys:nyna,nxl:nxra), work2(nnx*nny*nnz)
124
125#if defined( __parallel )
126
127!
128!-- If the PE grid is one-dimensional along y, the array has only to be
129!-- reordered locally and therefore no transposition has to be done.
130    IF ( pdims(1) /= 1 )  THEN
131!
132!--    Reorder input array for transposition
133       m = 0
134       DO  l = 0, pdims(1) - 1
135          xs = 0 + l * nnx
136          DO  k = nzb_x, nzt_xa
137             DO  j = nys_x, nyn_xa
138                DO  i = xs, xs + nnx - 1
139                   m = m + 1
140                   work2(m) = f_in(i,j,k)
141                ENDDO
142             ENDDO
143          ENDDO
144       ENDDO
145
146!
147!--    Transpose array
148       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
149       CALL MPI_ALLTOALL( work2(1),         sendrecvcount_zx, MPI_REAL, &
150                          f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
151                          comm1dx, ierr )
152       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
153
154!
155!--    Reorder transposed array in a way that the z index is in first position
156       DO  i = nxl, nxra
157          DO  j = nys, nyna
158             DO  k = 1, nza
159                work1(k,j,i) = f_inv(i,j,k)
160             ENDDO
161          ENDDO
162       ENDDO
163    ELSE
164!
165!--    Reorder the array in a way that the z index is in first position
166       DO  i = nxl, nxra
167          DO  j = nys, nyna
168             DO  k = 1, nza
169                work1(k,j,i) = f_in(i,j,k)
170             ENDDO
171          ENDDO
172       ENDDO
173    ENDIF
174
175!
176!-- Move data to output array
177    DO  i = nxl, nxra
178       DO  j = nys, nyna
179          DO  k = 1, nza
180             f_out(k,j,i) = work1(k,j,i)
181          ENDDO
182       ENDDO
183    ENDDO
184
185#endif
186
187 END SUBROUTINE transpose_xz
188
189
190 SUBROUTINE transpose_yx( f_in, work1, f_inv, work2, f_out )
191
192!------------------------------------------------------------------------------!
193! Description:
194! ------------
195! Transposition of input array (f_in) from y to x. For the input array, all
196! elements along y reside on the same PE, while after transposition, all
197! elements along x reside on the same PE.
198!------------------------------------------------------------------------------!
199
200    USE cpulog
201    USE indices
202    USE interfaces
203    USE pegrid
204    USE transpose_indices
205
206    IMPLICIT NONE
207
208    INTEGER ::  i, j, k, l, m, ys
209   
210    REAL ::  f_in(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                     &
211             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
212             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                    &
213             work1(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), work2(nnx*nny*nnz)
214
215#if defined( __parallel )
216
217!
218!-- Reorder input array for transposition
219    m = 0
220    DO  l = 0, pdims(2) - 1
221       ys = 0 + l * ( nyn_xa - nys_x + 1 )
222       DO  i = nxl_y, nxr_ya
223          DO  k = nzb_y, nzt_ya
224             DO  j = ys, ys + nyn_xa - nys_x
225                m = m + 1
226                work2(m) = f_in(j,i,k)
227             ENDDO
228          ENDDO
229       ENDDO
230    ENDDO
231
232!
233!-- Transpose array
234    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
235    CALL MPI_ALLTOALL( work2(1),             sendrecvcount_xy, MPI_REAL, &
236                       f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
237                       comm1dy, ierr )
238    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
239
240!
241!-- Reorder transposed array in a way that the x index is in first position
242    DO  i = 0, nxa
243       DO  k = nzb_x, nzt_xa
244          DO  j = nys_x, nyn_xa
245             work1(i,j,k) = f_inv(j,k,i)
246          ENDDO
247       ENDDO
248    ENDDO
249
250!
251!-- Move data to output array
252    DO  k = nzb_x, nzt_xa
253       DO  j = nys_x, nyn_xa
254          DO  i = 0, nxa
255             f_out(i,j,k) = work1(i,j,k)
256          ENDDO
257       ENDDO
258    ENDDO
259
260#endif
261
262 END SUBROUTINE transpose_yx
263
264
265 SUBROUTINE transpose_yxd( f_in, work1, f_inv, work2, f_out )
266
267!------------------------------------------------------------------------------!
268! Description:
269! ------------
270! Transposition of input array (f_in) from y to x. For the input array, all
271! elements along y reside on the same PE, while after transposition, all
272! elements along x reside on the same PE.
273! This is a direct transposition for arrays with indices in regular order
274! (k,j,i) (cf. transpose_yx).
275!------------------------------------------------------------------------------!
276
277    USE cpulog
278    USE indices
279    USE interfaces
280    USE pegrid
281    USE transpose_indices
282
283    IMPLICIT NONE
284
285    INTEGER ::  i, j, k, l, m, recvcount_yx, sendcount_yx, xs
286
287    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,1:nza,nys:nyna), &
288             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
289             work1(nxl:nxra,1:nza,nys:nyna), work2(nnx*nny*nnz)
290
291#if defined( __parallel )
292
293!
294!-- Rearrange indices of input array in order to make data to be send
295!-- by MPI contiguous
296    DO  k = 1, nza
297       DO  j = nys, nyna
298          DO  i = nxl, nxra
299             work1(i,k,j) = f_in(k,j,i)
300          ENDDO
301       ENDDO
302    ENDDO
303
304!
305!-- Move data to different array, because memory location of work1 is
306!-- needed further below (work1 = work2)
307    DO  j = nys, nyna
308       DO  k = 1, nza
309          DO  i = nxl, nxra
310             f_inv(i,k,j) = work1(i,k,j)
311          ENDDO
312       ENDDO
313    ENDDO
314
315!
316!-- Transpose array
317    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
318    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
319                       work2(1),         sendrecvcount_xy, MPI_REAL, &
320                       comm1dx, ierr )
321    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
322
323!
324!-- Reorder transposed array
325    m = 0
326    DO  l = 0, pdims(1) - 1
327       xs = 0 + l * nnx
328       DO  j = nys_x, nyn_xa
329          DO  k = 1, nza
330             DO  i = xs, xs + nnx - 1
331                m = m + 1
332                f_out(i,j,k) = work2(m)
333             ENDDO
334          ENDDO
335       ENDDO
336    ENDDO
337
338#endif
339
340 END SUBROUTINE transpose_yxd
341
342
343 SUBROUTINE transpose_yz( f_in, work1, f_inv, work2, f_out )
344
345!------------------------------------------------------------------------------!
346! Description:
347! ------------
348! Transposition of input array (f_in) from y to z. For the input array, all
349! elements along y reside on the same PE, while after transposition, all
350! elements along z reside on the same PE.
351!------------------------------------------------------------------------------!
352
353    USE cpulog
354    USE indices
355    USE interfaces
356    USE pegrid
357    USE transpose_indices
358
359    IMPLICIT NONE
360
361    INTEGER ::  i, j, k, l, m, zs
362   
363    REAL ::  f_in(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                     &
364             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
365             f_out(nxl_z:nxr_za,nys_z:nyn_za,1:nza),                    &
366             work1(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), work2(nnx*nny*nnz)
367
368#if defined( __parallel )
369
370!
371!-- Rearrange indices of input array in order to make data to be send
372!-- by MPI contiguous
373    DO  k = nzb_y, nzt_ya
374       DO  i = nxl_y, nxr_ya
375          DO  j = 0, nya
376             work1(i,k,j) = f_in(j,i,k)
377          ENDDO
378       ENDDO
379    ENDDO
380
381!
382!-- Move data to different array, because memory location of work1 is
383!-- needed further below (work1 = work2).
384!-- If the PE grid is one-dimensional along y, only local reordering
385!-- of the data is necessary and no transposition has to be done.
386    IF ( pdims(1) == 1 )  THEN
387       DO  j = 0, nya
388          DO  k = nzb_y, nzt_ya
389             DO  i = nxl_y, nxr_ya
390                f_out(i,j,k) = work1(i,k,j)
391             ENDDO
392          ENDDO
393       ENDDO
394       RETURN
395    ELSE
396       DO  j = 0, nya
397          DO  k = nzb_y, nzt_ya
398             DO  i = nxl_y, nxr_ya
399                f_inv(i,k,j) = work1(i,k,j)
400             ENDDO
401          ENDDO
402       ENDDO
403    ENDIF
404
405!
406!-- Transpose array
407    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
408    CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
409                       work2(1),             sendrecvcount_yz, MPI_REAL, &
410                       comm1dx, ierr )
411    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
412
413!
414!-- Reorder transposed array
415    m = 0
416    DO  l = 0, pdims(1) - 1
417       zs = 1 + l * ( nzt_ya - nzb_y + 1 )
418       DO  j = nys_z, nyn_za
419          DO  k = zs, zs + nzt_ya - nzb_y
420             DO  i = nxl_z, nxr_za
421                m = m + 1
422                f_out(i,j,k) = work2(m)
423             ENDDO
424          ENDDO
425       ENDDO
426    ENDDO
427
428#endif
429
430 END SUBROUTINE transpose_yz
431
432
433 SUBROUTINE transpose_zx( f_in, work1, f_inv, work2, f_out )
434
435!------------------------------------------------------------------------------!
436! Description:
437! ------------
438! Transposition of input array (f_in) from z to x. For the input array, all
439! elements along z reside on the same PE, while after transposition, all
440! elements along x reside on the same PE.
441!------------------------------------------------------------------------------!
442
443    USE cpulog
444    USE indices
445    USE interfaces
446    USE pegrid
447    USE transpose_indices
448
449    IMPLICIT NONE
450
451    INTEGER ::  i, j, k, l, m, xs
452   
453    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,nys:nyna,1:nza), &
454             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
455             work1(nxl:nxra,nys:nyna,1:nza), work2(nnx*nny*nnz)
456
457#if defined( __parallel )
458
459!
460!-- Rearrange indices of input array in order to make data to be send
461!-- by MPI contiguous
462    DO  i = nxl, nxra
463       DO  j = nys, nyna
464          DO  k = 1,nza
465             work1(i,j,k) = f_in(k,j,i)
466          ENDDO
467       ENDDO
468    ENDDO
469
470!
471!-- Move data to different array, because memory location of work1 is
472!-- needed further below (work1 = work2).
473!-- If the PE grid is one-dimensional along y, only local reordering
474!-- of the data is necessary and no transposition has to be done.
475    IF ( pdims(1) == 1 )  THEN
476       DO  k = 1, nza
477          DO  j = nys, nyna
478             DO  i = nxl, nxra
479                f_out(i,j,k) = work1(i,j,k)
480             ENDDO
481          ENDDO
482       ENDDO
483       RETURN
484    ELSE
485       DO  k = 1, nza
486          DO  j = nys, nyna
487             DO  i = nxl, nxra
488                f_inv(i,j,k) = work1(i,j,k)
489             ENDDO
490          ENDDO
491       ENDDO
492    ENDIF
493
494!
495!-- Transpose array
496    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
497    CALL MPI_ALLTOALL( f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
498                       work2(1),         sendrecvcount_zx, MPI_REAL, &
499                       comm1dx, ierr )
500    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
501
502!
503!-- Reorder transposed array
504    m = 0
505    DO  l = 0, pdims(1) - 1
506       xs = 0 + l * nnx
507       DO  k = nzb_x, nzt_xa
508          DO  j = nys_x, nyn_xa
509             DO  i = xs, xs + nnx - 1
510                m = m + 1
511                f_out(i,j,k) = work2(m)
512             ENDDO
513          ENDDO
514       ENDDO
515    ENDDO
516
517#endif
518
519 END SUBROUTINE transpose_zx
520
521
522 SUBROUTINE transpose_zy( f_in, work1, f_inv, work2, f_out )
523
524!------------------------------------------------------------------------------!
525! Description:
526! ------------
527! Transposition of input array (f_in) from z to y. For the input array, all
528! elements along z reside on the same PE, while after transposition, all
529! elements along y reside on the same PE.
530!------------------------------------------------------------------------------!
531
532    USE cpulog
533    USE indices
534    USE interfaces
535    USE pegrid
536    USE transpose_indices
537
538    IMPLICIT NONE
539
540    INTEGER ::  i, j, k, l, m, zs
541   
542    REAL ::  f_in(nxl_z:nxr_za,nys_z:nyn_za,1:nza),                     &
543             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
544             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
545             work1(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), work2(nnx*nny*nnz)
546
547#if defined( __parallel )
548
549!
550!-- If the PE grid is one-dimensional along y, the array has only to be
551!-- reordered locally and therefore no transposition has to be done.
552    IF ( pdims(1) /= 1 )  THEN
553!
554!--    Reorder input array for transposition
555       m = 0
556       DO  l = 0, pdims(1) - 1
557          zs = 1 + l * ( nzt_ya - nzb_y + 1 )
558          DO  j = nys_z, nyn_za
559             DO  k = zs, zs + nzt_ya - nzb_y
560                DO  i = nxl_z, nxr_za
561                   m = m + 1
562                   work2(m) = f_in(i,j,k)
563                ENDDO
564             ENDDO
565          ENDDO
566       ENDDO
567
568!
569!--    Transpose array
570       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
571       CALL MPI_ALLTOALL( work2(1),             sendrecvcount_yz, MPI_REAL, &
572                          f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
573                          comm1dx, ierr )
574       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
575
576!
577!--    Reorder transposed array in a way that the y index is in first position
578       DO  k = nzb_y, nzt_ya
579          DO  i = nxl_y, nxr_ya
580             DO  j = 0, nya
581                work1(j,i,k) = f_inv(i,k,j)
582             ENDDO
583          ENDDO
584       ENDDO
585    ELSE
586!
587!--    Reorder the array in a way that the y index is in first position
588       DO  k = nzb_y, nzt_ya
589          DO  i = nxl_y, nxr_ya
590             DO  j = 0, nya
591                work1(j,i,k) = f_in(i,j,k)
592             ENDDO
593          ENDDO
594       ENDDO
595    ENDIF
596
597!
598!-- Move data to output array
599    DO  k = nzb_y, nzt_ya
600       DO  i = nxl_y, nxr_ya
601          DO  j = 0, nya
602             f_out(j,i,k) = work1(j,i,k)
603          ENDDO
604       ENDDO
605    ENDDO
606
607#endif
608
609 END SUBROUTINE transpose_zy
610
611
612 SUBROUTINE transpose_zyd( f_in, work1, f_inv, work2, f_out )
613
614!------------------------------------------------------------------------------!
615! Description:
616! ------------
617! Transposition of input array (f_in) from z to y. For the input array, all
618! elements along z reside on the same PE, while after transposition, all
619! elements along y reside on the same PE.
620! This is a direct transposition for arrays with indices in regular order
621! (k,j,i) (cf. transpose_zy).
622!------------------------------------------------------------------------------!
623
624    USE cpulog
625    USE indices
626    USE interfaces
627    USE pegrid
628    USE transpose_indices
629
630    IMPLICIT NONE
631
632    INTEGER ::  i, j, k, l, m, ys
633   
634    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
635             f_out(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda),                    &
636             work1(nys:nyna,nxl:nxra,1:nza), work2(nnx*nny*nnz)
637
638#if defined( __parallel )
639
640!
641!-- Rearrange indices of input array in order to make data to be send
642!-- by MPI contiguous
643    DO  i = nxl, nxra
644       DO  j = nys, nyna
645          DO  k = 1, nza
646             work1(j,i,k) = f_in(k,j,i)
647          ENDDO
648       ENDDO
649    ENDDO
650
651!
652!-- Move data to different array, because memory location of work1 is
653!-- needed further below (work1 = work2).
654!-- If the PE grid is one-dimensional along x, only local reordering
655!-- of the data is necessary and no transposition has to be done.
656    IF ( pdims(2) == 1 )  THEN
657       DO  k = 1, nza
658          DO  i = nxl, nxra
659             DO  j = nys, nyna
660                f_out(j,i,k) = work1(j,i,k)
661             ENDDO
662          ENDDO
663       ENDDO
664       RETURN
665    ELSE
666       DO  k = 1, nza
667          DO  i = nxl, nxra
668             DO  j = nys, nyna
669                f_inv(j,i,k) = work1(j,i,k)
670             ENDDO
671          ENDDO
672       ENDDO
673    ENDIF
674
675!
676!-- Transpose array
677    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
678    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
679                       work2(1),         sendrecvcount_zyd, MPI_REAL, &
680                       comm1dy, ierr )
681    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
682
683!
684!-- Reorder transposed array
685    m = 0
686    DO  l = 0, pdims(2) - 1
687       ys = 0 + l * nny
688       DO  k = nzb_yd, nzt_yda
689          DO  i = nxl_yd, nxr_yda
690             DO  j = ys, ys + nny - 1
691                m = m + 1
692                f_out(j,i,k) = work2(m)
693             ENDDO
694          ENDDO
695       ENDDO
696    ENDDO
697
698#endif
699
700 END SUBROUTINE transpose_zyd
Note: See TracBrowser for help on using the repository browser.