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

Last change on this file since 672 was 623, checked in by raasch, 14 years ago

last commit documented

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