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

Last change on this file since 1321 was 1321, checked in by raasch, 7 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 32.2 KB
Line 
1 SUBROUTINE resort_for_xy( f_in, f_inv )
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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: transpose.f90 1321 2014-03-20 09:40:40Z raasch $
27!
28! 1320 2014-03-20 08:40:49Z raasch
29! ONLY-attribute added to USE-statements,
30! kind-parameters added to all INTEGER and REAL declaration statements,
31! kinds are defined in new module kinds,
32! old module precision_kind is removed,
33! revision history before 2012 removed,
34! comment fields (!:) to be used for variable explanations added to
35! all variable declaration statements
36!
37! 1318 2014-03-17 13:35:16Z raasch
38! cpu_log_nowait parameter added to cpu measurements of the transpositions
39! required for solving the Poisson equation (poisfft),
40! module interfaces removed
41!
42! 1257 2013-11-08 15:18:40Z raasch
43! openacc loop and loop vector clauses removed
44!
45! 1216 2013-08-26 09:31:42Z raasch
46! re-sorting of the transposed / to be transposed arrays moved to separate
47! routines resort_for_...
48!
49! 1111 2013-03-08 23:54:10Z raasch
50! openACC directives added,
51! resorting data from/to work changed, work got 4 dimensions instead of 1
52!
53! 1106 2013-03-04 05:31:38Z raasch
54! preprocessor lines rearranged so that routines can also be used in serial
55! (non-parallel) mode
56!
57! 1092 2013-02-02 11:24:22Z raasch
58! unused variables removed
59!
60! 1036 2012-10-22 13:43:42Z raasch
61! code put under GPL (PALM 3.9)
62!
63! 1003 2012-09-14 14:35:53Z raasch
64! indices nxa, nya, etc. replaced by nx, ny, etc.
65!
66! Revision 1.1  1997/07/24 11:25:18  raasch
67! Initial revision
68!
69!------------------------------------------------------------------------------!
70! Description:
71! ------------
72! Resorting data for the transposition from x to y. The transposition itself
73! is carried out in transpose_xy
74!------------------------------------------------------------------------------!
75
76     USE indices,                                                              &
77         ONLY:  nx
78
79     USE kinds
80
81     USE transpose_indices,                                                    &
82         ONLY:  nxl_z, nxr_z, nyn_x, nyn_z, nys_x, nys_z, nzb_x, nzt_x
83
84     IMPLICIT NONE
85
86     REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !:
87     REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
88
89
90     INTEGER(iwp) ::  i !:
91     INTEGER(iwp) ::  j !:
92     INTEGER(iwp) ::  k !:
93!
94!-- Rearrange indices of input array in order to make data to be send
95!-- by MPI contiguous
96    !$OMP  PARALLEL PRIVATE ( i, j, k )
97    !$OMP  DO
98    !$acc kernels present( f_in, f_inv )
99     DO  i = 0, nx
100         DO  k = nzb_x, nzt_x
101             DO  j = nys_x, nyn_x
102                 f_inv(j,k,i) = f_in(i,j,k)
103             ENDDO
104         ENDDO
105     ENDDO
106     !$acc end kernels
107     !$OMP  END PARALLEL
108
109 END SUBROUTINE resort_for_xy
110
111
112 SUBROUTINE transpose_xy( f_inv, f_out )
113
114!------------------------------------------------------------------------------!
115! Description:
116! ------------
117! Transposition of input array (f_in) from x to y. For the input array, all
118! elements along x reside on the same PE, while after transposition, all
119! elements along y reside on the same PE.
120!------------------------------------------------------------------------------!
121
122    USE cpulog,                                                                &
123        ONLY:  cpu_log, cpu_log_nowait, log_point_s
124
125    USE indices,                                                               &
126        ONLY:  nx, ny
127       
128    USE kinds
129
130    USE pegrid
131
132    USE transpose_indices,                                                     &
133        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
134
135    IMPLICIT NONE
136
137    INTEGER(iwp) ::  i  !:
138    INTEGER(iwp) ::  j  !:
139    INTEGER(iwp) ::  k  !:
140    INTEGER(iwp) ::  l  !:
141    INTEGER(iwp) ::  ys !:
142 
143    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
144    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !:
145
146    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work !:
147
148
149    IF ( numprocs /= 1 )  THEN
150
151#if defined( __parallel )
152!
153!--    Transpose array
154       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
155       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
156       !$acc update host( f_inv )
157       CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, &
158                          work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, &
159                          comm1dy, ierr )
160       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
161
162!
163!--    Reorder transposed array
164!$OMP  PARALLEL PRIVATE ( i, j, k, l, ys )
165!$OMP  DO
166       !$acc data copyin( work )
167       DO  l = 0, pdims(2) - 1
168          ys = 0 + l * ( nyn_x - nys_x + 1 )
169          !$acc kernels present( f_out, work )
170          DO  i = nxl_y, nxr_y
171             DO  k = nzb_y, nzt_y
172                DO  j = ys, ys + nyn_x - nys_x
173                   f_out(j,i,k) = work(j-ys+1,k,i,l)
174                ENDDO
175             ENDDO
176          ENDDO
177          !$acc end kernels
178       ENDDO
179       !$acc end data
180!$OMP  END PARALLEL
181#endif
182
183    ELSE
184
185!
186!--    Reorder transposed array
187!$OMP  PARALLEL PRIVATE ( i, j, k )
188!$OMP  DO
189       !$acc kernels present( f_inv, f_out )
190       DO  k = nzb_y, nzt_y
191          DO  i = nxl_y, nxr_y
192             DO  j = 0, ny
193                f_out(j,i,k) = f_inv(j,k,i)
194             ENDDO
195          ENDDO
196       ENDDO
197       !$acc end kernels
198!$OMP  END PARALLEL
199
200    ENDIF
201
202 END SUBROUTINE transpose_xy
203
204
205 SUBROUTINE resort_for_xz( f_inv, f_out )
206
207!------------------------------------------------------------------------------!
208! Description:
209! ------------
210! Resorting data after the transposition from x to z. The transposition itself
211! is carried out in transpose_xz
212!------------------------------------------------------------------------------!
213
214     USE indices,                                                              &
215         ONLY:  nxl, nxr, nyn, nys, nz
216
217     USE kinds
218
219     IMPLICIT NONE
220
221     REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !:
222     REAL(wp) ::  f_out(1:nz,nys:nyn,nxl:nxr) !:
223
224     INTEGER(iwp) ::  i !:
225     INTEGER(iwp) ::  j !:
226     INTEGER(iwp) ::  k !:
227!
228!-- Rearrange indices of input array in order to make data to be send
229!-- by MPI contiguous.
230!-- In case of parallel fft/transposition, scattered store is faster in
231!-- backward direction!!!
232    !$OMP  PARALLEL PRIVATE ( i, j, k )
233    !$OMP  DO
234    !$acc kernels present( f_inv, f_out )
235     DO  k = 1, nz
236         DO  i = nxl, nxr
237             DO  j = nys, nyn
238                 f_out(k,j,i) = f_inv(j,i,k)
239             ENDDO
240         ENDDO
241     ENDDO
242     !$acc end kernels
243     !$OMP  END PARALLEL
244
245 END SUBROUTINE resort_for_xz
246
247
248 SUBROUTINE transpose_xz( f_in, f_inv )
249
250!------------------------------------------------------------------------------!
251! Description:
252! ------------
253! Transposition of input array (f_in) from x to z. For the input array, all
254! elements along x reside on the same PE, while after transposition, all
255! elements along z reside on the same PE.
256!------------------------------------------------------------------------------!
257
258    USE cpulog,                                                                &
259        ONLY:  cpu_log, cpu_log_nowait, log_point_s
260
261    USE indices,                                                               &
262        ONLY:  nnx, nx, nxl, nxr, ny, nyn, nys, nz
263
264    USE kinds
265
266    USE pegrid,                                                                &
267        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
268               pdims, sendrecvcount_zx
269
270    USE transpose_indices,                                                     &
271        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
272
273    IMPLICIT NONE
274
275    INTEGER(iwp) ::  i  !:
276    INTEGER(iwp) ::  j  !:
277    INTEGER(iwp) ::  k  !:
278    INTEGER(iwp) ::  l  !:
279    INTEGER(iwp) ::  xs !:
280
281    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
282    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !:
283
284    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !:
285
286
287!
288!-- If the PE grid is one-dimensional along y, the array has only to be
289!-- reordered locally and therefore no transposition has to be done.
290    IF ( pdims(1) /= 1 )  THEN
291
292#if defined( __parallel )
293!
294!--    Reorder input array for transposition
295!$OMP  PARALLEL PRIVATE ( i, j, k, l, xs )
296!$OMP  DO
297       !$acc data copyout( work )
298       DO  l = 0, pdims(1) - 1
299          xs = 0 + l * nnx
300          !$acc kernels present( f_in, work )
301          DO  k = nzb_x, nzt_x
302             DO  i = xs, xs + nnx - 1
303                DO  j = nys_x, nyn_x
304                   work(j,i-xs+1,k,l) = f_in(i,j,k)
305                ENDDO
306             ENDDO
307          ENDDO
308          !$acc end kernels
309       ENDDO
310       !$acc end data
311!$OMP  END PARALLEL
312
313!
314!--    Transpose array
315       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
316       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
317       CALL MPI_ALLTOALL( work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, &
318                          f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, &
319                          comm1dx, ierr )
320       !$acc update device( f_inv )
321       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
322#endif
323
324    ELSE
325
326!
327!--    Reorder the array in a way that the z index is in first position
328!$OMP  PARALLEL PRIVATE ( i, j, k )
329!$OMP  DO
330       !$acc kernels present( f_in, f_inv )
331       DO  i = nxl, nxr
332          DO  j = nys, nyn
333             DO  k = 1, nz
334                f_inv(j,i,k) = f_in(i,j,k)
335             ENDDO
336          ENDDO
337       ENDDO
338       !$acc end kernels
339!$OMP  END PARALLEL
340
341    ENDIF
342
343 END SUBROUTINE transpose_xz
344
345
346 SUBROUTINE resort_for_yx( f_inv, f_out )
347
348!------------------------------------------------------------------------------!
349! Description:
350! ------------
351! Resorting data after the transposition from y to x. The transposition itself
352! is carried out in transpose_yx
353!------------------------------------------------------------------------------!
354
355     USE indices,                                                              &
356         ONLY:  nx
357
358     USE kinds
359
360     USE transpose_indices,                                                    &
361         ONLY:  nyn_x, nys_x, nzb_x, nzt_x
362
363     IMPLICIT NONE
364
365     REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
366     REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
367
368
369     INTEGER(iwp) ::  i !:
370     INTEGER(iwp) ::  j !:
371     INTEGER(iwp) ::  k !:
372!
373!-- Rearrange indices of input array in order to make data to be send
374!-- by MPI contiguous
375    !$OMP  PARALLEL PRIVATE ( i, j, k )
376    !$OMP  DO
377    !$acc kernels present( f_inv, f_out )
378     DO  i = 0, nx
379         DO  k = nzb_x, nzt_x
380             DO  j = nys_x, nyn_x
381                 f_out(i,j,k) = f_inv(j,k,i)
382             ENDDO
383         ENDDO
384     ENDDO
385     !$acc end kernels
386     !$OMP  END PARALLEL
387
388 END SUBROUTINE resort_for_yx
389
390
391 SUBROUTINE transpose_yx( f_in, f_inv )
392
393!------------------------------------------------------------------------------!
394! Description:
395! ------------
396! Transposition of input array (f_in) from y to x. For the input array, all
397! elements along y reside on the same PE, while after transposition, all
398! elements along x reside on the same PE.
399!------------------------------------------------------------------------------!
400
401    USE cpulog,                                                                &
402        ONLY:  cpu_log, cpu_log_nowait, log_point_s
403
404    USE indices,                                                               &
405        ONLY:  nx, ny
406
407    USE kinds
408
409    USE pegrid,                                                                &
410        ONLY:  collective_wait, comm1dy, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
411               numprocs, pdims, sendrecvcount_xy
412
413    USE transpose_indices,                                                     &
414        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
415
416    IMPLICIT NONE
417
418    INTEGER(iwp) ::  i  !:
419    INTEGER(iwp) ::  j  !:
420    INTEGER(iwp) ::  k  !:
421    INTEGER(iwp) ::  l  !:
422    INTEGER(iwp) ::  ys !:
423
424    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !:
425    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
426
427    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work !:
428
429
430    IF ( numprocs /= 1 )  THEN
431
432#if defined( __parallel )
433!
434!--    Reorder input array for transposition
435!$OMP  PARALLEL PRIVATE ( i, j, k, l, ys )
436!$OMP  DO
437       !$acc data copyout( work )
438       DO  l = 0, pdims(2) - 1
439          ys = 0 + l * ( nyn_x - nys_x + 1 )
440          !$acc kernels present( f_in, work )
441          DO  i = nxl_y, nxr_y
442             DO  k = nzb_y, nzt_y
443                DO  j = ys, ys + nyn_x - nys_x
444                   work(j-ys+1,k,i,l) = f_in(j,i,k)
445                ENDDO
446             ENDDO
447          ENDDO
448          !$acc end kernels
449       ENDDO
450       !$acc end data
451!$OMP  END PARALLEL
452
453!
454!--    Transpose array
455       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
456       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
457       CALL MPI_ALLTOALL( work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, &
458                          f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, &
459                          comm1dy, ierr )
460       !$acc update device( f_inv )
461       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
462#endif
463
464    ELSE
465
466!
467!--    Reorder array f_in the same way as ALLTOALL did it
468!$OMP  PARALLEL PRIVATE ( i, j, k )
469!$OMP  DO
470       !$acc kernels present( f_in, f_inv )
471       DO  i = nxl_y, nxr_y
472          DO  k = nzb_y, nzt_y
473             DO  j = 0, ny
474                f_inv(j,k,i) = f_in(j,i,k)
475             ENDDO
476          ENDDO
477       ENDDO
478       !$acc end kernels
479!$OMP  END PARALLEL
480
481    ENDIF
482
483 END SUBROUTINE transpose_yx
484
485
486 SUBROUTINE transpose_yxd( f_in, f_out )
487
488!------------------------------------------------------------------------------!
489! Description:
490! ------------
491! Transposition of input array (f_in) from y to x. For the input array, all
492! elements along y reside on the same PE, while after transposition, all
493! elements along x reside on the same PE.
494! This is a direct transposition for arrays with indices in regular order
495! (k,j,i) (cf. transpose_yx).
496!------------------------------------------------------------------------------!
497
498    USE cpulog,                                                                &
499        ONLY:  cpu_log, cpu_log_nowait, log_point_s
500
501    USE indices,                                                               &
502        ONLY:  nnx, nny, nnz, nx, nxl, nxr, nyn, nys, nz
503
504    USE kinds
505
506    USE pegrid,                                                                &
507        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
508               pdims, sendrecvcount_xy
509
510    USE transpose_indices,                                                     &
511        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
512
513    IMPLICIT NONE
514
515    INTEGER(iwp) ::  i  !:
516    INTEGER(iwp) ::  j  !:
517    INTEGER(iwp) ::  k  !:
518    INTEGER(iwp) ::  l  !:
519    INTEGER(iwp) ::  m  !:
520    INTEGER(iwp) ::  xs !:
521
522    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)          !:
523    REAL(wp) ::  f_inv(nxl:nxr,1:nz,nys:nyn)         !:
524    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
525    REAL(wp) ::  work(nnx*nny*nnz)                   !:
526#if defined( __parallel )
527
528!
529!-- Rearrange indices of input array in order to make data to be send
530!-- by MPI contiguous
531    DO  k = 1, nz
532       DO  j = nys, nyn
533          DO  i = nxl, nxr
534             f_inv(i,k,j) = f_in(k,j,i)
535          ENDDO
536       ENDDO
537    ENDDO
538
539!
540!-- Transpose array
541    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
542    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
543    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
544                       work(1),          sendrecvcount_xy, MPI_REAL, &
545                       comm1dx, ierr )
546    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
547
548!
549!-- Reorder transposed array
550    m = 0
551    DO  l = 0, pdims(1) - 1
552       xs = 0 + l * nnx
553       DO  j = nys_x, nyn_x
554          DO  k = 1, nz
555             DO  i = xs, xs + nnx - 1
556                m = m + 1
557                f_out(i,j,k) = work(m)
558             ENDDO
559          ENDDO
560       ENDDO
561    ENDDO
562
563#endif
564
565 END SUBROUTINE transpose_yxd
566
567
568 SUBROUTINE resort_for_yz( f_in, f_inv )
569
570!------------------------------------------------------------------------------!
571! Description:
572! ------------
573! Resorting data for the transposition from y to z. The transposition itself
574! is carried out in transpose_yz
575!------------------------------------------------------------------------------!
576
577     USE indices,                                                              &
578         ONLY:  ny
579
580     USE kinds
581
582     USE transpose_indices,                                                    &
583         ONLY:  nxl_y, nxr_y, nzb_y, nzt_y
584
585     IMPLICIT NONE
586
587     REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !:
588     REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
589
590     INTEGER(iwp) ::  i !:
591     INTEGER(iwp) ::  j !:
592     INTEGER(iwp) ::  k !:
593
594!
595!-- Rearrange indices of input array in order to make data to be send
596!-- by MPI contiguous
597    !$OMP  PARALLEL PRIVATE ( i, j, k )
598    !$OMP  DO
599    !$acc kernels present( f_in, f_inv )
600     DO  j = 0, ny
601         DO  k = nzb_y, nzt_y
602             DO  i = nxl_y, nxr_y
603                 f_inv(i,k,j) = f_in(j,i,k)
604             ENDDO
605         ENDDO
606     ENDDO
607     !$acc end kernels
608     !$OMP  END PARALLEL
609
610 END SUBROUTINE resort_for_yz
611
612
613 SUBROUTINE transpose_yz( f_inv, f_out )
614
615!------------------------------------------------------------------------------!
616! Description:
617! ------------
618! Transposition of input array (f_in) from y to z. For the input array, all
619! elements along y reside on the same PE, while after transposition, all
620! elements along z reside on the same PE.
621!------------------------------------------------------------------------------!
622
623    USE cpulog,                                                                &
624        ONLY:  cpu_log, cpu_log_nowait, log_point_s
625
626    USE indices,                                                               &
627        ONLY:  ny, nz
628
629    USE kinds
630
631    USE pegrid,                                                                &
632        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
633               pdims, sendrecvcount_yz
634
635    USE transpose_indices,                                                     &
636        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_z, nys_z, nzb_y, nzt_y
637
638    IMPLICIT NONE
639
640    INTEGER(iwp) ::  i  !:
641    INTEGER(iwp) ::  j  !:
642    INTEGER(iwp) ::  k  !:
643    INTEGER(iwp) ::  l  !:
644    INTEGER(iwp) ::  zs !:
645
646    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
647    REAL(wp) ::  f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !:
648
649    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work !:
650
651
652!
653!-- If the PE grid is one-dimensional along y, only local reordering
654!-- of the data is necessary and no transposition has to be done.
655    IF ( pdims(1) == 1 )  THEN
656
657!$OMP  PARALLEL PRIVATE ( i, j, k )
658!$OMP  DO
659       !$acc kernels present( f_inv, f_out )
660       DO  j = 0, ny
661          DO  k = nzb_y, nzt_y
662             DO  i = nxl_y, nxr_y
663                f_out(i,j,k) = f_inv(i,k,j)
664             ENDDO
665          ENDDO
666       ENDDO
667       !$acc end kernels
668!$OMP  END PARALLEL
669
670    ELSE
671
672#if defined( __parallel )
673!
674!--    Transpose array
675       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
676       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
677       !$acc update host( f_inv )
678       CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, &
679                          work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, &
680                          comm1dx, ierr )
681       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
682
683!
684!--    Reorder transposed array
685!$OMP  PARALLEL PRIVATE ( i, j, k, l, zs )
686!$OMP  DO
687       !$acc data copyin( work )
688       DO  l = 0, pdims(1) - 1
689          zs = 1 + l * ( nzt_y - nzb_y + 1 )
690          !$acc kernels present( f_out )
691          DO  j = nys_z, nyn_z
692             DO  k = zs, zs + nzt_y - nzb_y
693                DO  i = nxl_z, nxr_z
694                   f_out(i,j,k) = work(i,k-zs+1,j,l)
695                ENDDO
696             ENDDO
697          ENDDO
698          !$acc end kernels
699       ENDDO
700       !$acc end data
701!$OMP  END PARALLEL
702#endif
703
704   ENDIF
705
706 END SUBROUTINE transpose_yz
707
708
709 SUBROUTINE resort_for_zx( f_in, f_inv )
710
711!------------------------------------------------------------------------------!
712! Description:
713! ------------
714! Resorting data for the transposition from z to x. The transposition itself
715! is carried out in transpose_zx
716!------------------------------------------------------------------------------!
717
718     USE indices,                                                              &
719         ONLY:  nxl, nxr, nyn, nys, nz
720
721     USE kinds
722
723     IMPLICIT NONE
724
725     REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)  !:
726     REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !:
727
728     INTEGER(iwp) ::  i !:
729     INTEGER(iwp) ::  j !:
730     INTEGER(iwp) ::  k !:
731
732!
733!-- Rearrange indices of input array in order to make data to be send
734!-- by MPI contiguous
735    !$OMP  PARALLEL PRIVATE ( i, j, k )
736    !$OMP  DO
737    !$acc kernels present( f_in, f_inv )
738     DO  k = 1,nz
739         DO  i = nxl, nxr
740             DO  j = nys, nyn
741                 f_inv(j,i,k) = f_in(k,j,i)
742             ENDDO
743         ENDDO
744     ENDDO
745     !$acc end kernels
746     !$OMP  END PARALLEL
747
748 END SUBROUTINE resort_for_zx
749
750
751 SUBROUTINE transpose_zx( f_inv, f_out )
752
753!------------------------------------------------------------------------------!
754! Description:
755! ------------
756! Transposition of input array (f_in) from z to x. For the input array, all
757! elements along z reside on the same PE, while after transposition, all
758! elements along x reside on the same PE.
759!------------------------------------------------------------------------------!
760
761    USE cpulog,                                                                &
762        ONLY:  cpu_log, cpu_log_nowait, log_point_s
763
764    USE indices,                                                               &
765        ONLY:  nnx, nx, nxl, nxr, nyn, nys, nz
766
767    USE kinds
768
769    USE pegrid,                                                                &
770        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
771               pdims, sendrecvcount_zx
772
773    USE transpose_indices,                                                     &
774        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
775
776    IMPLICIT NONE
777
778    INTEGER(iwp) ::  i  !:
779    INTEGER(iwp) ::  j  !:
780    INTEGER(iwp) ::  k  !:
781    INTEGER(iwp) ::  l  !:
782    INTEGER(iwp) ::  xs !:
783
784    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)         !:
785    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
786
787    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !:
788
789
790!
791!-- If the PE grid is one-dimensional along y, only local reordering
792!-- of the data is necessary and no transposition has to be done.
793    IF ( pdims(1) == 1 )  THEN
794
795!$OMP  PARALLEL PRIVATE ( i, j, k )
796!$OMP  DO
797       !$acc kernels present( f_inv, f_out )
798       DO  k = 1, nz
799          DO  i = nxl, nxr
800             DO  j = nys, nyn
801                f_out(i,j,k) = f_inv(j,i,k)
802             ENDDO
803          ENDDO
804       ENDDO
805       !$acc end kernels
806!$OMP  END PARALLEL
807
808    ELSE
809
810#if defined( __parallel )
811!
812!--    Transpose array
813       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
814       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
815       !$acc update host( f_inv )
816       CALL MPI_ALLTOALL( f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, &
817                          work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, &
818                          comm1dx, ierr )
819       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
820
821!
822!--    Reorder transposed array
823!$OMP  PARALLEL PRIVATE ( i, j, k, l, xs )
824!$OMP  DO
825       !$acc data copyin( work )
826       DO  l = 0, pdims(1) - 1
827          xs = 0 + l * nnx
828          !$acc kernels present( f_out )
829          DO  k = nzb_x, nzt_x
830             DO  i = xs, xs + nnx - 1
831                DO  j = nys_x, nyn_x
832                   f_out(i,j,k) = work(j,i-xs+1,k,l)
833                ENDDO
834             ENDDO
835          ENDDO
836          !$acc end kernels
837       ENDDO
838       !$acc end data
839!$OMP  END PARALLEL
840#endif
841
842    ENDIF
843
844 END SUBROUTINE transpose_zx
845
846
847 SUBROUTINE resort_for_zy( f_inv, f_out )
848
849!------------------------------------------------------------------------------!
850! Description:
851! ------------
852! Resorting data after the transposition from z to y. The transposition itself
853! is carried out in transpose_zy
854!------------------------------------------------------------------------------!
855
856     USE indices,                                                              &
857         ONLY:  ny
858
859     USE kinds
860
861     USE transpose_indices,                                                    &
862         ONLY:  nxl_y, nxr_y, nzb_y, nzt_y
863
864     IMPLICIT NONE
865
866     REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
867     REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !:
868
869
870     INTEGER(iwp) ::  i !:
871     INTEGER(iwp) ::  j !:
872     INTEGER(iwp) ::  k !:
873
874!
875!-- Rearrange indices of input array in order to make data to be send
876!-- by MPI contiguous
877    !$OMP  PARALLEL PRIVATE ( i, j, k )
878    !$OMP  DO
879    !$acc kernels present( f_inv, f_out )
880     DO  k = nzb_y, nzt_y
881         DO  j = 0, ny
882             DO  i = nxl_y, nxr_y
883                 f_out(j,i,k) = f_inv(i,k,j)
884             ENDDO
885         ENDDO
886     ENDDO
887     !$acc end kernels
888     !$OMP  END PARALLEL
889
890 END SUBROUTINE resort_for_zy
891
892
893 SUBROUTINE transpose_zy( f_in, f_inv )
894
895!------------------------------------------------------------------------------!
896! Description:
897! ------------
898! Transposition of input array (f_in) from z to y. For the input array, all
899! elements along z reside on the same PE, while after transposition, all
900! elements along y reside on the same PE.
901!------------------------------------------------------------------------------!
902
903    USE cpulog,                                                                &
904        ONLY:  cpu_log, cpu_log_nowait, log_point_s
905
906    USE indices,                                                               &
907        ONLY:  ny, nz
908
909    USE kinds
910
911    USE pegrid,                                                                &
912        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
913               pdims, sendrecvcount_yz
914
915    USE transpose_indices,                                                     &
916        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_z, nys_z, nzb_y, nzt_y
917
918    IMPLICIT NONE
919
920    INTEGER(iwp) ::  i  !:
921    INTEGER(iwp) ::  j  !:
922    INTEGER(iwp) ::  k  !:
923    INTEGER(iwp) ::  l  !:
924    INTEGER(iwp) ::  zs !:
925
926    REAL(wp) ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !:
927    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
928
929    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work !:
930
931!
932!-- If the PE grid is one-dimensional along y, the array has only to be
933!-- reordered locally and therefore no transposition has to be done.
934    IF ( pdims(1) /= 1 )  THEN
935
936#if defined( __parallel )
937!
938!--    Reorder input array for transposition
939!$OMP  PARALLEL PRIVATE ( i, j, k, l, zs )
940!$OMP  DO
941       !$acc data copyout( work )
942       DO  l = 0, pdims(1) - 1
943          zs = 1 + l * ( nzt_y - nzb_y + 1 )
944          !$acc kernels present( f_in, work )
945          DO  j = nys_z, nyn_z
946             DO  k = zs, zs + nzt_y - nzb_y
947                DO  i = nxl_z, nxr_z
948                   work(i,k-zs+1,j,l) = f_in(i,j,k)
949                ENDDO
950             ENDDO
951          ENDDO
952          !$acc end kernels
953       ENDDO
954       !$acc end data
955!$OMP  END PARALLEL
956
957!
958!--    Transpose array
959       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
960       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
961       CALL MPI_ALLTOALL( work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, &
962                          f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, &
963                          comm1dx, ierr )
964       !$acc update device( f_inv )
965       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
966#endif
967
968    ELSE
969!
970!--    Reorder the array in the same way like ALLTOALL did it
971!$OMP  PARALLEL PRIVATE ( i, j, k )
972!$OMP  DO
973       !$acc kernels present( f_in, f_inv )
974       DO  k = nzb_y, nzt_y
975          DO  j = 0, ny
976             DO  i = nxl_y, nxr_y
977                f_inv(i,k,j) = f_in(i,j,k)
978             ENDDO
979          ENDDO
980       ENDDO
981       !$acc end kernels
982!$OMP  END PARALLEL
983
984    ENDIF
985
986 END SUBROUTINE transpose_zy
987
988
989 SUBROUTINE transpose_zyd( f_in, f_out )
990
991!------------------------------------------------------------------------------!
992! Description:
993! ------------
994! Transposition of input array (f_in) from z to y. For the input array, all
995! elements along z reside on the same PE, while after transposition, all
996! elements along y reside on the same PE.
997! This is a direct transposition for arrays with indices in regular order
998! (k,j,i) (cf. transpose_zy).
999!------------------------------------------------------------------------------!
1000
1001    USE cpulog,                                                                &
1002        ONLY:  cpu_log, cpu_log_nowait, log_point_s
1003
1004    USE indices,                                                               &
1005        ONLY:  nnx, nny, nnz, nxl, nxr, nyn, nys, ny, nz
1006
1007    USE kinds
1008
1009    USE pegrid,                                                                &
1010        ONLY:  collective_wait, comm1dy, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
1011               pdims, sendrecvcount_zyd
1012
1013    USE transpose_indices,                                                     &
1014        ONLY:  nxl_y, nxl_yd, nxr_y, nxr_yd, nzb_y, nzb_yd, nzt_y, nzt_yd
1015
1016    IMPLICIT NONE
1017
1018    INTEGER(iwp) ::  i  !:
1019    INTEGER(iwp) ::  j  !:
1020    INTEGER(iwp) ::  k  !:
1021    INTEGER(iwp) ::  l  !:
1022    INTEGER(iwp) ::  m  !:
1023    INTEGER(iwp) ::  ys !:
1024
1025    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)              !:
1026    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)             !:
1027    REAL(wp) ::  f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) !:
1028    REAL(wp) ::  work(nnx*nny*nnz)                       !:
1029
1030#if defined( __parallel )
1031
1032!
1033!-- Rearrange indices of input array in order to make data to be send
1034!-- by MPI contiguous
1035    DO  i = nxl, nxr
1036       DO  j = nys, nyn
1037          DO  k = 1, nz
1038             f_inv(j,i,k) = f_in(k,j,i)
1039          ENDDO
1040       ENDDO
1041    ENDDO
1042
1043!
1044!-- Move data to different array, because memory location of work1 is
1045!-- needed further below (work1 = work2).
1046!-- If the PE grid is one-dimensional along x, only local reordering
1047!-- of the data is necessary and no transposition has to be done.
1048    IF ( pdims(2) == 1 )  THEN
1049       DO  k = 1, nz
1050          DO  i = nxl, nxr
1051             DO  j = nys, nyn
1052                f_out(j,i,k) = f_inv(j,i,k)
1053             ENDDO
1054          ENDDO
1055       ENDDO
1056       RETURN
1057    ENDIF
1058
1059!
1060!-- Transpose array
1061    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
1062    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
1063    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
1064                       work(1),          sendrecvcount_zyd, MPI_REAL, &
1065                       comm1dy, ierr )
1066    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
1067
1068!
1069!-- Reorder transposed array
1070    m = 0
1071    DO  l = 0, pdims(2) - 1
1072       ys = 0 + l * nny
1073       DO  k = nzb_yd, nzt_yd
1074          DO  i = nxl_yd, nxr_yd
1075             DO  j = ys, ys + nny - 1
1076                m = m + 1
1077                f_out(j,i,k) = work(m)
1078             ENDDO
1079          ENDDO
1080       ENDDO
1081    ENDDO
1082
1083#endif
1084
1085 END SUBROUTINE transpose_zyd
Note: See TracBrowser for help on using the repository browser.