Home

Context Navigation

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

Last change on this file since 4187 was 4182, checked in by scharf, 5 years ago
corrected "Former revisions" section minor formatting in "Former revisions" section added "Author" section
Property svn:keywords set to `Id`
File size: 32.1 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |