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

Last change on this file since 392 was 198, checked in by raasch, 13 years ago

file headers updated for the next release 3.5

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