Home

Context Navigation

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

Last change on this file since 83 was 4, checked in by raasch, 18 years ago
Id keyword set as property for all *.f90 files
Property svn:keywords set to `Id`
File size: 19.2 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |