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

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

last commit documented

  • Property svn:keywords set to Id
File size: 18.4 KB
Line 
1 SUBROUTINE transpose_xy( f_in, work, f_out )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: transpose.f90 623 2010-12-10 08:52:17Z raasch $
11!
12! 622 2010-12-10 08:08:13Z raasch
13! optional barriers included in order to speed up collective operations
14!
15! 164 2008-05-15 08:46:15Z raasch
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
19!
20! February 2007
21! RCS Log replace by Id keyword, revision history cleaned up
22!
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),                    &
56             work(nnx*nny*nnz)
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
66             f_inv(j,k,i) = f_in(i,j,k)
67          ENDDO
68       ENDDO
69    ENDDO
70
71!
72!-- Transpose array
73    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
74    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
75    CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
76                       work(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) = work(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, work, 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(nys:nyna,nxl:nxra,1:nza),                    &
122             f_out(1:nza,nys:nyna,nxl:nxra),                    &
123             work(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  i = xs, xs + nnx - 1
138                DO  j = nys_x, nyn_xa
139                   m = m + 1
140                   work(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       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
150       CALL MPI_ALLTOALL( work(1),          sendrecvcount_zx, MPI_REAL, &
151                          f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
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
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)
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
170                f_inv(j,i,k) = f_in(i,j,k)
171             ENDDO
172          ENDDO
173       ENDDO
174
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
180          ENDDO
181       ENDDO
182
183    ENDIF
184
185
186#endif
187
188 END SUBROUTINE transpose_xz
189
190
191 SUBROUTINE transpose_yx( f_in, work, f_out )
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),                    &
214             work(nnx*nny*nnz)
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
227                work(m) = f_in(j,i,k)
228             ENDDO
229          ENDDO
230       ENDDO
231    ENDDO
232
233!
234!-- Transpose array
235    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
236    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
237    CALL MPI_ALLTOALL( work(1),              sendrecvcount_xy, MPI_REAL, &
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
247             f_out(i,j,k) = f_inv(j,k,i)
248          ENDDO
249       ENDDO
250    ENDDO
251
252#endif
253
254 END SUBROUTINE transpose_yx
255
256
257 SUBROUTINE transpose_yxd( f_in, work, f_out )
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),                        &
281             work(nnx*nny*nnz)
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
291             f_inv(i,k,j) = f_in(k,j,i)
292          ENDDO
293       ENDDO
294    ENDDO
295
296!
297!-- Transpose array
298    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
299    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
300    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
301                       work(1),          sendrecvcount_xy, MPI_REAL, &
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
314                f_out(i,j,k) = work(m)
315             ENDDO
316          ENDDO
317       ENDDO
318    ENDDO
319
320#endif
321
322 END SUBROUTINE transpose_yxd
323
324
325 SUBROUTINE transpose_yz( f_in, work, f_out )
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),                    &
348             work(nnx*nny*nnz)
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
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)
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
372                f_out(i,j,k) = f_inv(i,k,j)
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' )
382    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
383    CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
384                       work(1),              sendrecvcount_yz, MPI_REAL, &
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
397                f_out(i,j,k) = work(m)
398             ENDDO
399          ENDDO
400       ENDDO
401    ENDDO
402
403#endif
404
405 END SUBROUTINE transpose_yz
406
407
408 SUBROUTINE transpose_zx( f_in, work, f_out )
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   
428    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
429             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
430             work(nnx*nny*nnz)
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
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)
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
452          DO  i = nxl, nxra
453             DO  j = nys, nyna
454                f_out(i,j,k) = f_inv(j,i,k)
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' )
464    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
465    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
466                       work(1),          sendrecvcount_zx, MPI_REAL, &
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
476          DO  i = xs, xs + nnx - 1
477             DO  j = nys_x, nyn_xa
478                m = m + 1
479                f_out(i,j,k) = work(m)
480             ENDDO
481          ENDDO
482       ENDDO
483    ENDDO
484
485#endif
486
487 END SUBROUTINE transpose_zx
488
489
490 SUBROUTINE transpose_zy( f_in, work, f_out )
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),                    &
513             work(nnx*nny*nnz)
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
530                   work(m) = f_in(i,j,k)
531                ENDDO
532             ENDDO
533          ENDDO
534       ENDDO
535
536!
537!--    Transpose array
538       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
539       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
540       CALL MPI_ALLTOALL( work(1),              sendrecvcount_yz, MPI_REAL, &
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
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)
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
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
567          DO  i = nxl_y, nxr_ya
568             DO  j = 0, nya
569                f_out(j,i,k) = f_inv(i,k,j)
570             ENDDO
571          ENDDO
572       ENDDO
573
574    ENDIF
575
576#endif
577
578 END SUBROUTINE transpose_zy
579
580
581 SUBROUTINE transpose_zyd( f_in, work, f_out )
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),                    &
605             work(nnx*nny*nnz)
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
615             f_inv(j,i,k) = f_in(k,j,i)
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
629                f_out(j,i,k) = f_inv(j,i,k)
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' )
639    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
640    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
641                       work(1),          sendrecvcount_zyd, MPI_REAL, &
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
654                f_out(j,i,k) = work(m)
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.