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

Last change on this file since 1107 was 1107, checked in by raasch, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 21.6 KB
Line 
1 SUBROUTINE transpose_xy( f_in, work, f_out )
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: transpose.f90 1107 2013-03-04 06:23:14Z raasch $
27!
28! 1106 2013-03-04 05:31:38Z raasch
29! preprocessor lines rearranged so that routines can also be used in serial
30! (non-parallel) mode
31!
32! 1092 2013-02-02 11:24:22Z raasch
33! unused variables removed
34!
35! 1036 2012-10-22 13:43:42Z raasch
36! code put under GPL (PALM 3.9)
37!
38! 1003 2012-09-14 14:35:53Z raasch
39! indices nxa, nya, etc. replaced by nx, ny, etc.
40!
41! 683 2011-02-09 14:25:15Z raasch
42! openMP parallelization of transpositions for 2d-domain-decomposition
43!
44! 622 2010-12-10 08:08:13Z raasch
45! optional barriers included in order to speed up collective operations
46!
47! 164 2008-05-15 08:46:15Z raasch
48! f_inv changed from subroutine argument to automatic array in order to do
49! re-ordering from f_in to f_inv in one step, one array work is needed instead
50! of work1 and work2
51!
52! February 2007
53! RCS Log replace by Id keyword, revision history cleaned up
54!
55! Revision 1.2  2004/04/30 13:12:17  raasch
56! Switched from mpi_alltoallv to the simpler mpi_alltoall,
57! all former transpose-routine files collected in this file, enlarged
58! transposition arrays introduced
59!
60! Revision 1.1  2004/04/30 13:08:16  raasch
61! Initial revision (collection of former routines transpose_xy, transpose_xz,
62!                   transpose_yx, transpose_yz, transpose_zx, transpose_zy)
63!
64! Revision 1.1  1997/07/24 11:25:18  raasch
65! Initial revision
66!
67!
68! Description:
69! ------------
70! Transposition of input array (f_in) from x to y. For the input array, all
71! elements along x reside on the same PE, while after transposition, all
72! elements along y reside on the same PE.
73!------------------------------------------------------------------------------!
74
75    USE cpulog
76    USE indices
77    USE interfaces
78    USE pegrid
79    USE transpose_indices
80
81    IMPLICIT NONE
82
83    INTEGER ::  i, j, k, l, m, ys
84   
85    REAL ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x),   &
86             f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx),  &
87             f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y),  &
88             work(nnx*nny*nnz)
89
90!
91!-- Rearrange indices of input array in order to make data to be send
92!-- by MPI contiguous
93!$OMP  PARALLEL PRIVATE ( i, j, k )
94!$OMP  DO
95    DO  i = 0, nx
96       DO  k = nzb_x, nzt_x
97          DO  j = nys_x, nyn_x
98             f_inv(j,k,i) = f_in(i,j,k)
99          ENDDO
100       ENDDO
101    ENDDO
102!$OMP  END PARALLEL
103
104    IF ( numprocs /= 1 )  THEN
105
106#if defined( __parallel )
107!
108!--    Transpose array
109       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
110       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
111       CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
112                          work(1),              sendrecvcount_xy, MPI_REAL, &
113                          comm1dy, ierr )
114       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
115
116!
117!--    Reorder transposed array
118!$OMP  PARALLEL PRIVATE ( i, j, k, l, m, ys )
119!$OMP  DO
120       DO  l = 0, pdims(2) - 1
121          m  = l * ( nxr_y - nxl_y + 1 ) * ( nzt_y - nzb_y + 1 ) * &
122                   ( nyn_x - nys_x + 1 )
123          ys = 0 + l * ( nyn_x - nys_x + 1 )
124          DO  i = nxl_y, nxr_y
125             DO  k = nzb_y, nzt_y
126                DO  j = ys, ys + nyn_x - nys_x
127                   m = m + 1
128                   f_out(j,i,k) = work(m)
129                ENDDO
130             ENDDO
131          ENDDO
132       ENDDO
133!$OMP  END PARALLEL
134#endif
135
136    ELSE
137
138!
139!--    Reorder transposed array
140!$OMP  PARALLEL PRIVATE ( i, j, k )
141!$OMP  DO
142       DO  k = nzb_y, nzt_y
143          DO  i = nxl_y, nxr_y
144             DO  j = 0, ny
145                f_out(j,i,k) = f_inv(j,k,i)
146             ENDDO
147          ENDDO
148       ENDDO
149!$OMP  END PARALLEL
150
151    ENDIF
152
153 END SUBROUTINE transpose_xy
154
155
156 SUBROUTINE transpose_xz( f_in, work, f_out )
157
158!------------------------------------------------------------------------------!
159! Description:
160! ------------
161! Transposition of input array (f_in) from x to z. For the input array, all
162! elements along x reside on the same PE, while after transposition, all
163! elements along z reside on the same PE.
164!------------------------------------------------------------------------------!
165
166    USE cpulog
167    USE indices
168    USE interfaces
169    USE pegrid
170    USE transpose_indices
171
172    IMPLICIT NONE
173
174    INTEGER ::  i, j, k, l, m, xs
175   
176    REAL ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x),  &
177             f_inv(nys:nyn,nxl:nxr,1:nz),         &
178             f_out(1:nz,nys:nyn,nxl:nxr),         &
179             work(nnx*nny*nnz)
180
181
182!
183!-- If the PE grid is one-dimensional along y, the array has only to be
184!-- reordered locally and therefore no transposition has to be done.
185    IF ( pdims(1) /= 1 )  THEN
186
187#if defined( __parallel )
188!
189!--    Reorder input array for transposition
190!$OMP  PARALLEL PRIVATE ( i, j, k, l, m, xs )
191!$OMP  DO
192       DO  l = 0, pdims(1) - 1
193          m  = l * ( nzt_x - nzb_x + 1 ) * nnx * ( nyn_x - nys_x + 1 )
194          xs = 0 + l * nnx
195          DO  k = nzb_x, nzt_x
196             DO  i = xs, xs + nnx - 1
197                DO  j = nys_x, nyn_x
198                   m = m + 1
199                   work(m) = f_in(i,j,k)
200                ENDDO
201             ENDDO
202          ENDDO
203       ENDDO
204!$OMP  END PARALLEL
205
206!
207!--    Transpose array
208       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
209       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
210       CALL MPI_ALLTOALL( work(1),          sendrecvcount_zx, MPI_REAL, &
211                          f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
212                          comm1dx, ierr )
213       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
214
215!
216!--    Reorder transposed array in a way that the z index is in first position
217!$OMP  PARALLEL PRIVATE ( i, j, k )
218!$OMP  DO
219       DO  k = 1, nz
220          DO  i = nxl, nxr
221             DO  j = nys, nyn
222                f_out(k,j,i) = f_inv(j,i,k)
223             ENDDO
224          ENDDO
225       ENDDO
226!$OMP  END PARALLEL
227#endif
228
229    ELSE
230
231!
232!--    Reorder the array in a way that the z index is in first position
233!$OMP  PARALLEL PRIVATE ( i, j, k )
234!$OMP  DO
235       DO  i = nxl, nxr
236          DO  j = nys, nyn
237             DO  k = 1, nz
238                f_inv(j,i,k) = f_in(i,j,k)
239             ENDDO
240          ENDDO
241       ENDDO
242!$OMP  END PARALLEL
243
244!$OMP  PARALLEL PRIVATE ( i, j, k )
245!$OMP  DO
246       DO  k = 1, nz
247          DO  i = nxl, nxr
248             DO  j = nys, nyn
249                f_out(k,j,i) = f_inv(j,i,k)
250             ENDDO
251          ENDDO
252       ENDDO
253!$OMP  END PARALLEL
254
255    ENDIF
256
257 END SUBROUTINE transpose_xz
258
259
260 SUBROUTINE transpose_yx( f_in, work, f_out )
261
262!------------------------------------------------------------------------------!
263! Description:
264! ------------
265! Transposition of input array (f_in) from y to x. For the input array, all
266! elements along y reside on the same PE, while after transposition, all
267! elements along x reside on the same PE.
268!------------------------------------------------------------------------------!
269
270    USE cpulog
271    USE indices
272    USE interfaces
273    USE pegrid
274    USE transpose_indices
275
276    IMPLICIT NONE
277
278    INTEGER ::  i, j, k, l, m, ys
279   
280    REAL ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y),  &
281             f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx), &
282             f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x), &
283             work(nnx*nny*nnz)
284
285    IF ( numprocs /= 1 )  THEN
286
287#if defined( __parallel )
288!
289!--    Reorder input array for transposition
290!$OMP  PARALLEL PRIVATE ( i, j, k, l, m, ys )
291!$OMP  DO
292       DO  l = 0, pdims(2) - 1
293          m  = l * ( nxr_y - nxl_y + 1 ) * ( nzt_y - nzb_y + 1 ) * &
294                   ( nyn_x - nys_x + 1 )
295          ys = 0 + l * ( nyn_x - nys_x + 1 )
296          DO  i = nxl_y, nxr_y
297             DO  k = nzb_y, nzt_y
298                DO  j = ys, ys + nyn_x - nys_x
299                   m = m + 1
300                   work(m) = f_in(j,i,k)
301                ENDDO
302             ENDDO
303          ENDDO
304       ENDDO
305!$OMP  END PARALLEL
306
307!
308!--    Transpose array
309       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
310       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
311       CALL MPI_ALLTOALL( work(1),              sendrecvcount_xy, MPI_REAL, &
312                          f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
313                          comm1dy, ierr )
314       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
315#endif
316
317    ELSE
318
319!
320!--    Reorder array f_in the same way as ALLTOALL did it
321!$OMP  PARALLEL PRIVATE ( i, j, k )
322!$OMP  DO
323       DO  i = nxl_y, nxr_y
324          DO  k = nzb_y, nzt_y
325             DO  j = 0, ny
326                f_inv(j,k,i) = f_in(j,i,k)
327             ENDDO
328          ENDDO
329       ENDDO
330!$OMP  END PARALLEL
331
332    ENDIF
333
334!
335!-- Reorder transposed array in a way that the x index is in first position
336!$OMP  PARALLEL PRIVATE ( i, j, k )
337!$OMP  DO
338    DO  i = 0, nx
339       DO  k = nzb_x, nzt_x
340          DO  j = nys_x, nyn_x
341             f_out(i,j,k) = f_inv(j,k,i)
342          ENDDO
343       ENDDO
344    ENDDO
345!$OMP  END PARALLEL
346
347 END SUBROUTINE transpose_yx
348
349
350 SUBROUTINE transpose_yxd( f_in, work, f_out )
351
352!------------------------------------------------------------------------------!
353! Description:
354! ------------
355! Transposition of input array (f_in) from y to x. For the input array, all
356! elements along y reside on the same PE, while after transposition, all
357! elements along x reside on the same PE.
358! This is a direct transposition for arrays with indices in regular order
359! (k,j,i) (cf. transpose_yx).
360!------------------------------------------------------------------------------!
361
362    USE cpulog
363    USE indices
364    USE interfaces
365    USE pegrid
366    USE transpose_indices
367
368    IMPLICIT NONE
369
370    INTEGER ::  i, j, k, l, m, xs
371
372    REAL ::  f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nxl:nxr,1:nz,nys:nyn), &
373             f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x),                     &
374             work(nnx*nny*nnz)
375
376#if defined( __parallel )
377
378!
379!-- Rearrange indices of input array in order to make data to be send
380!-- by MPI contiguous
381    DO  k = 1, nz
382       DO  j = nys, nyn
383          DO  i = nxl, nxr
384             f_inv(i,k,j) = f_in(k,j,i)
385          ENDDO
386       ENDDO
387    ENDDO
388
389!
390!-- Transpose array
391    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
392    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
393    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
394                       work(1),          sendrecvcount_xy, MPI_REAL, &
395                       comm1dx, ierr )
396    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
397
398!
399!-- Reorder transposed array
400    m = 0
401    DO  l = 0, pdims(1) - 1
402       xs = 0 + l * nnx
403       DO  j = nys_x, nyn_x
404          DO  k = 1, nz
405             DO  i = xs, xs + nnx - 1
406                m = m + 1
407                f_out(i,j,k) = work(m)
408             ENDDO
409          ENDDO
410       ENDDO
411    ENDDO
412
413#endif
414
415 END SUBROUTINE transpose_yxd
416
417
418 SUBROUTINE transpose_yz( f_in, work, f_out )
419
420!------------------------------------------------------------------------------!
421! Description:
422! ------------
423! Transposition of input array (f_in) from y to z. For the input array, all
424! elements along y reside on the same PE, while after transposition, all
425! elements along z reside on the same PE.
426!------------------------------------------------------------------------------!
427
428    USE cpulog
429    USE indices
430    USE interfaces
431    USE pegrid
432    USE transpose_indices
433
434    IMPLICIT NONE
435
436    INTEGER ::  i, j, k, l, m, zs
437   
438    REAL ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y),  &
439             f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny), &
440             f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz), &
441             work(nnx*nny*nnz)
442
443!
444!-- Rearrange indices of input array in order to make data to be send
445!-- by MPI contiguous
446!$OMP  PARALLEL PRIVATE ( i, j, k )
447!$OMP  DO
448    DO  j = 0, ny
449       DO  k = nzb_y, nzt_y
450          DO  i = nxl_y, nxr_y
451             f_inv(i,k,j) = f_in(j,i,k)
452          ENDDO
453       ENDDO
454    ENDDO
455!$OMP  END PARALLEL
456
457!
458!-- Move data to different array, because memory location of work1 is
459!-- needed further below (work1 = work2).
460!-- If the PE grid is one-dimensional along y, only local reordering
461!-- of the data is necessary and no transposition has to be done.
462    IF ( pdims(1) == 1 )  THEN
463
464!$OMP  PARALLEL PRIVATE ( i, j, k )
465!$OMP  DO
466       DO  j = 0, ny
467          DO  k = nzb_y, nzt_y
468             DO  i = nxl_y, nxr_y
469                f_out(i,j,k) = f_inv(i,k,j)
470             ENDDO
471          ENDDO
472       ENDDO
473!$OMP  END PARALLEL
474
475    ELSE
476
477#if defined( __parallel )
478!
479!--    Transpose array
480       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
481       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
482       CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
483                          work(1),              sendrecvcount_yz, MPI_REAL, &
484                          comm1dx, ierr )
485       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
486
487!
488!--    Reorder transposed array
489!$OMP  PARALLEL PRIVATE ( i, j, k, l, m, zs )
490!$OMP  DO
491       DO  l = 0, pdims(1) - 1
492          m  = l * ( nyn_z - nys_z + 1 ) * ( nzt_y - nzb_y + 1 ) * &
493                   ( nxr_z - nxl_z + 1 )
494          zs = 1 + l * ( nzt_y - nzb_y + 1 )
495          DO  j = nys_z, nyn_z
496             DO  k = zs, zs + nzt_y - nzb_y
497                DO  i = nxl_z, nxr_z
498                   m = m + 1
499                   f_out(i,j,k) = work(m)
500                ENDDO
501             ENDDO
502          ENDDO
503       ENDDO
504!$OMP  END PARALLEL
505#endif
506
507   ENDIF
508
509 END SUBROUTINE transpose_yz
510
511
512 SUBROUTINE transpose_zx( f_in, work, f_out )
513
514!------------------------------------------------------------------------------!
515! Description:
516! ------------
517! Transposition of input array (f_in) from z to x. For the input array, all
518! elements along z reside on the same PE, while after transposition, all
519! elements along x reside on the same PE.
520!------------------------------------------------------------------------------!
521
522    USE cpulog
523    USE indices
524    USE interfaces
525    USE pegrid
526    USE transpose_indices
527
528    IMPLICIT NONE
529
530    INTEGER ::  i, j, k, l, m, xs
531   
532    REAL ::  f_in(1:nz,nys:nyn,nxl:nxr), f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x), &
533             work(nnx*nny*nnz)
534
535    !$acc declare create ( f_inv )
536    REAL ::  f_inv(nys:nyn,nxl:nxr,1:nz)
537
538
539!
540!-- Rearrange indices of input array in order to make data to be send
541!-- by MPI contiguous
542!$OMP  PARALLEL PRIVATE ( i, j, k )
543!$OMP  DO
544    !$acc kernels present( f_in )
545    !$acc loop
546    DO  k = 1,nz
547       DO  i = nxl, nxr
548          !$acc loop vector( 32 )
549          DO  j = nys, nyn
550             f_inv(j,i,k) = f_in(k,j,i)
551          ENDDO
552       ENDDO
553    ENDDO
554!$OMP  END PARALLEL
555
556!
557!-- Move data to different array, because memory location of work1 is
558!-- needed further below (work1 = work2).
559!-- If the PE grid is one-dimensional along y, only local reordering
560!-- of the data is necessary and no transposition has to be done.
561    IF ( pdims(1) == 1 )  THEN
562
563!$OMP  PARALLEL PRIVATE ( i, j, k )
564!$OMP  DO
565       !$acc kernels present( f_out )
566       !$acc loop
567       DO  k = 1, nz
568          DO  i = nxl, nxr
569             !$acc loop vector( 32 )
570             DO  j = nys, nyn
571                f_out(i,j,k) = f_inv(j,i,k)
572             ENDDO
573          ENDDO
574       ENDDO
575!$OMP  END PARALLEL
576
577    ELSE
578
579#if defined( __parallel )
580!
581!--    Transpose array
582       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
583       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
584       CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
585                          work(1),          sendrecvcount_zx, MPI_REAL, &
586                          comm1dx, ierr )
587       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
588
589!
590!--    Reorder transposed array
591!$OMP  PARALLEL PRIVATE ( i, j, k, l, m, xs )
592!$OMP  DO
593       DO  l = 0, pdims(1) - 1
594          m  = l * ( nzt_x - nzb_x + 1 ) * nnx * ( nyn_x - nys_x + 1 )
595          xs = 0 + l * nnx
596          DO  k = nzb_x, nzt_x
597             DO  i = xs, xs + nnx - 1
598                DO  j = nys_x, nyn_x
599                   m = m + 1
600                   f_out(i,j,k) = work(m)
601                ENDDO
602             ENDDO
603          ENDDO
604       ENDDO
605!$OMP  END PARALLEL
606#endif
607
608    ENDIF
609
610 END SUBROUTINE transpose_zx
611
612
613 SUBROUTINE transpose_zy( f_in, work, f_out )
614
615!------------------------------------------------------------------------------!
616! Description:
617! ------------
618! Transposition of input array (f_in) from z to y. For the input array, all
619! elements along z reside on the same PE, while after transposition, all
620! elements along y reside on the same PE.
621!------------------------------------------------------------------------------!
622
623    USE cpulog
624    USE indices
625    USE interfaces
626    USE pegrid
627    USE transpose_indices
628
629    IMPLICIT NONE
630
631    INTEGER ::  i, j, k, l, m, zs
632   
633    REAL ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz),  &
634             f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny), &
635             f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), &
636             work(nnx*nny*nnz)
637
638!
639!-- If the PE grid is one-dimensional along y, the array has only to be
640!-- reordered locally and therefore no transposition has to be done.
641    IF ( pdims(1) /= 1 )  THEN
642
643#if defined( __parallel )
644!
645!--    Reorder input array for transposition
646!$OMP  PARALLEL PRIVATE ( i, j, k, l, m, zs )
647!$OMP  DO
648       DO  l = 0, pdims(1) - 1
649          m  = l * ( nyn_z - nys_z + 1 ) * ( nzt_y - nzb_y + 1 ) * &
650                   ( nxr_z - nxl_z + 1 )
651          zs = 1 + l * ( nzt_y - nzb_y + 1 )
652          DO  j = nys_z, nyn_z
653             DO  k = zs, zs + nzt_y - nzb_y
654                DO  i = nxl_z, nxr_z
655                   m = m + 1
656                   work(m) = f_in(i,j,k)
657                ENDDO
658             ENDDO
659          ENDDO
660       ENDDO
661!$OMP  END PARALLEL
662
663!
664!--    Transpose array
665       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
666       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
667       CALL MPI_ALLTOALL( work(1),              sendrecvcount_yz, MPI_REAL, &
668                          f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
669                          comm1dx, ierr )
670       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
671#endif
672
673    ELSE
674!
675!--    Reorder the array in the same way like ALLTOALL did it
676!$OMP  PARALLEL PRIVATE ( i, j, k )
677!$OMP  DO
678       DO  k = nzb_y, nzt_y
679          DO  j = 0, ny
680             DO  i = nxl_y, nxr_y
681                f_inv(i,k,j) = f_in(i,j,k)
682             ENDDO
683          ENDDO
684       ENDDO
685!$OMP  END PARALLEL
686
687    ENDIF
688
689!
690!-- Reorder transposed array in a way that the y index is in first position
691!$OMP  PARALLEL PRIVATE ( i, j, k )
692!$OMP  DO
693    DO  k = nzb_y, nzt_y
694       DO  i = nxl_y, nxr_y
695          DO  j = 0, ny
696             f_out(j,i,k) = f_inv(i,k,j)
697          ENDDO
698       ENDDO
699    ENDDO
700!$OMP  END PARALLEL
701
702 END SUBROUTINE transpose_zy
703
704
705 SUBROUTINE transpose_zyd( f_in, work, f_out )
706
707!------------------------------------------------------------------------------!
708! Description:
709! ------------
710! Transposition of input array (f_in) from z to y. For the input array, all
711! elements along z reside on the same PE, while after transposition, all
712! elements along y reside on the same PE.
713! This is a direct transposition for arrays with indices in regular order
714! (k,j,i) (cf. transpose_zy).
715!------------------------------------------------------------------------------!
716
717    USE cpulog
718    USE indices
719    USE interfaces
720    USE pegrid
721    USE transpose_indices
722
723    IMPLICIT NONE
724
725    INTEGER ::  i, j, k, l, m, ys
726   
727    REAL ::  f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nys:nyn,nxl:nxr,1:nz), &
728             f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd),                 &
729             work(nnx*nny*nnz)
730
731#if defined( __parallel )
732
733!
734!-- Rearrange indices of input array in order to make data to be send
735!-- by MPI contiguous
736    DO  i = nxl, nxr
737       DO  j = nys, nyn
738          DO  k = 1, nz
739             f_inv(j,i,k) = f_in(k,j,i)
740          ENDDO
741       ENDDO
742    ENDDO
743
744!
745!-- Move data to different array, because memory location of work1 is
746!-- needed further below (work1 = work2).
747!-- If the PE grid is one-dimensional along x, only local reordering
748!-- of the data is necessary and no transposition has to be done.
749    IF ( pdims(2) == 1 )  THEN
750       DO  k = 1, nz
751          DO  i = nxl, nxr
752             DO  j = nys, nyn
753                f_out(j,i,k) = f_inv(j,i,k)
754             ENDDO
755          ENDDO
756       ENDDO
757       RETURN
758    ENDIF
759
760!
761!-- Transpose array
762    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
763    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
764    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
765                       work(1),          sendrecvcount_zyd, MPI_REAL, &
766                       comm1dy, ierr )
767    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
768
769!
770!-- Reorder transposed array
771    m = 0
772    DO  l = 0, pdims(2) - 1
773       ys = 0 + l * nny
774       DO  k = nzb_yd, nzt_yd
775          DO  i = nxl_yd, nxr_yd
776             DO  j = ys, ys + nny - 1
777                m = m + 1
778                f_out(j,i,k) = work(m)
779             ENDDO
780          ENDDO
781       ENDDO
782    ENDDO
783
784#endif
785
786 END SUBROUTINE transpose_zyd
Note: See TracBrowser for help on using the repository browser.