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

Last change on this file since 415 was 198, checked in by raasch, 16 years ago

file headers updated for the next release 3.5

  • Property svn:keywords set to Id
File size: 17.8 KB
RevLine 
[164]1 SUBROUTINE transpose_xy( f_in, work, f_out )
[1]2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
[198]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
[164]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
[1]16!
[198]17! February 2007
[3]18! RCS Log replace by Id keyword, revision history cleaned up
19!
[1]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),                    &
[164]53             work(nnx*nny*nnz)
[1]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
[164]63             f_inv(j,k,i) = f_in(i,j,k)
[1]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, &
[164]72                       work(1),              sendrecvcount_xy, MPI_REAL, &
[1]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
[164]85                f_out(j,i,k) = work(m)
[1]86             ENDDO
87          ENDDO
88       ENDDO
89    ENDDO
90
91#endif
92
93 END SUBROUTINE transpose_xy
94
95
[164]96 SUBROUTINE transpose_xz( f_in, work, f_out )
[1]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),             &
[164]117             f_inv(nys:nyna,nxl:nxra,1:nza),                    &
[1]118             f_out(1:nza,nys:nyna,nxl:nxra),                    &
[164]119             work(nnx*nny*nnz)
[1]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
[164]133             DO  i = xs, xs + nnx - 1
134                DO  j = nys_x, nyn_xa
[1]135                   m = m + 1
[164]136                   work(m) = f_in(i,j,k)
[1]137                ENDDO
138             ENDDO
139          ENDDO
140       ENDDO
141
142!
143!--    Transpose array
144       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
[164]145       CALL MPI_ALLTOALL( work(1),          sendrecvcount_zx, MPI_REAL, &
146                          f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
[1]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
[164]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)
[1]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
[164]165                f_inv(j,i,k) = f_in(i,j,k)
[1]166             ENDDO
167          ENDDO
168       ENDDO
169
[164]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
[1]175          ENDDO
176       ENDDO
177
[164]178    ENDIF
179
180
[1]181#endif
182
183 END SUBROUTINE transpose_xz
184
185
[164]186 SUBROUTINE transpose_yx( f_in, work, f_out )
[1]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),                    &
[164]209             work(nnx*nny*nnz)
[1]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
[164]222                work(m) = f_in(j,i,k)
[1]223             ENDDO
224          ENDDO
225       ENDDO
226    ENDDO
227
228!
229!-- Transpose array
230    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
[164]231    CALL MPI_ALLTOALL( work(1),              sendrecvcount_xy, MPI_REAL, &
[1]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
[164]241             f_out(i,j,k) = f_inv(j,k,i)
[1]242          ENDDO
243       ENDDO
244    ENDDO
245
246#endif
247
248 END SUBROUTINE transpose_yx
249
250
[164]251 SUBROUTINE transpose_yxd( f_in, work, f_out )
[1]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),                        &
[164]275             work(nnx*nny*nnz)
[1]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
[164]285             f_inv(i,k,j) = f_in(k,j,i)
[1]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, &
[164]294                       work(1),          sendrecvcount_xy, MPI_REAL, &
[1]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
[164]307                f_out(i,j,k) = work(m)
[1]308             ENDDO
309          ENDDO
310       ENDDO
311    ENDDO
312
313#endif
314
315 END SUBROUTINE transpose_yxd
316
317
[164]318 SUBROUTINE transpose_yz( f_in, work, f_out )
[1]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),                    &
[164]341             work(nnx*nny*nnz)
[1]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
[164]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)
[1]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
[164]365                f_out(i,j,k) = f_inv(i,k,j)
[1]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, &
[164]376                       work(1),              sendrecvcount_yz, MPI_REAL, &
[1]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
[164]389                f_out(i,j,k) = work(m)
[1]390             ENDDO
391          ENDDO
392       ENDDO
393    ENDDO
394
395#endif
396
397 END SUBROUTINE transpose_yz
398
399
[164]400 SUBROUTINE transpose_zx( f_in, work, f_out )
[1]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   
[164]420    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
[1]421             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
[164]422             work(nnx*nny*nnz)
[1]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
[164]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)
[1]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
[164]444          DO  i = nxl, nxra
445             DO  j = nys, nyna
446                f_out(i,j,k) = f_inv(j,i,k)
[1]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' )
[164]456    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
457                       work(1),          sendrecvcount_zx, MPI_REAL, &
[1]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
[164]467          DO  i = xs, xs + nnx - 1
468             DO  j = nys_x, nyn_xa
[1]469                m = m + 1
[164]470                f_out(i,j,k) = work(m)
[1]471             ENDDO
472          ENDDO
473       ENDDO
474    ENDDO
475
476#endif
477
478 END SUBROUTINE transpose_zx
479
480
[164]481 SUBROUTINE transpose_zy( f_in, work, f_out )
[1]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),                    &
[164]504             work(nnx*nny*nnz)
[1]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
[164]521                   work(m) = f_in(i,j,k)
[1]522                ENDDO
523             ENDDO
524          ENDDO
525       ENDDO
526
527!
528!--    Transpose array
529       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
[164]530       CALL MPI_ALLTOALL( work(1),              sendrecvcount_yz, MPI_REAL, &
[1]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
[164]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)
[1]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
[164]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
[1]557          DO  i = nxl_y, nxr_ya
558             DO  j = 0, nya
[164]559                f_out(j,i,k) = f_inv(i,k,j)
[1]560             ENDDO
561          ENDDO
562       ENDDO
[164]563
[1]564    ENDIF
565
566#endif
567
568 END SUBROUTINE transpose_zy
569
570
[164]571 SUBROUTINE transpose_zyd( f_in, work, f_out )
[1]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),                    &
[164]595             work(nnx*nny*nnz)
[1]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
[164]605             f_inv(j,i,k) = f_in(k,j,i)
[1]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
[164]619                f_out(j,i,k) = f_inv(j,i,k)
[1]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, &
[164]630                       work(1),          sendrecvcount_zyd, MPI_REAL, &
[1]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
[164]643                f_out(j,i,k) = work(m)
[1]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.