Home

Context Navigation

source: palm/trunk/SOURCE/poisfft_hybrid.f90 @ 718

Last change on this file since 718 was 668, checked in by suehring, 14 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 31.5 KB

Line
1	MODULE poisfft_hybrid_mod
2	!------------------------------------------------------------------------------
3	!
4	! Current revisions:
5	! -----------------
6	!
7	! Former revisions:
8	! -----------------
9	! $Id: poisfft_hybrid.f90 668 2010-12-23 13:22:58Z gryschka $
10	!
11	! 667 2010-12-23 12:06:00Z suehring/gryschka
12	! ddzu replaced by ddzu_pres due to changes in zu(0)
13	!
14	! 415 2009-12-15 10:26:23Z raasch
15	! Dimension of array stat in cascade change to prevent type problems with
16	! mpi2 libraries
17	!
18	! 274 2009-03-26 15:11:21Z heinze
19	! Output of messages replaced by message handling routine.
20	!
21	! Feb. 2007
22	! RCS Log replace by Id keyword, revision history cleaned up
23	!
24	! Revision 1.11 2004/04/30 12:43:14 raasch
25	! Renaming of fft routines, additional argument in calls of fft_y_m
26	!
27	! Revision 1.2 2002/12/19 16:08:31 raasch
28	! Preprocessor directive KKMP introduced (OMP does NOT work),
29	! array tri will be a shared array in OpenMP loop, to get better cache
30	! utilization, the i index (x-direction) will be executed in stride
31	! "istride" as outer loop and in a shorter inner loop,
32	! overlapping of computation and communication realized by new routine
33	! poisfft_hybrid_nodes, name of old routine poisfft_hybrid changed to
34	! poisfft_hybrid_omp, STOP statement replaced by call of subroutine local_stop
35	!
36	!
37	! Description:
38	! ------------
39	! Solution of the Poisson equation with a 2D spectral method.
40	! Hybrid version for parallel computers using a 1D domain decomposition,
41	! realized with MPI, along x and parallelization with OPEN-MP along y
42	! (routine poisfft_hybrid_omp). In a second version (poisfft_hybrid_nodes),
43	! optimization is realized by overlapping of computation and communication
44	! and by simultaneously executing as many communication calls as switches
45	! per logical partition (LPAR) are available. This version comes into
46	! effect if more than one node is used and if the environment variable
47	! tasks_per_node is set in a way that it can be devided by switch_per_lpar
48	! without any rest.
49	!
50	! WARNING: In case of OpenMP, there are problems with allocating large
51	! arrays in parallel regions.
52	!
53	! Copyright Klaus Ketelsen / Siegfried Raasch May 2002
54	!------------------------------------------------------------------------------!
55
56	USE fft_xy
57	USE indices
58	USE pegrid
59
60	IMPLICIT NONE
61
62	PRIVATE
63	PUBLIC poisfft_hybrid, poisfft_hybrid_ini
64
65	INTEGER, PARAMETER :: switch_per_lpar = 2
66
67	INTEGER, SAVE :: nxl_a, nxr_a, & ! total x dimension
68	nxl_p, nxr_p, & ! partial x dimension
69	nys_a, nyn_a, & ! total y dimension
70	nys_p, nyn_p, & ! partial y dimension
71
72	npe_s, & ! total number of PEs for solver
73	nwords, & ! number of points to be exchanged
74	! with MPI_ALLTOALL
75	n_omp_threads ! number of OpenMP threads
76
77	!
78	!-- Variables for multi node version (cluster version) using routine
79	!-- poisfft_hybrid_nodes
80	INTEGER, SAVE :: comm_nodes, & ! communicater nodes
81	comm_node_all, & ! communicater all PEs node version
82	comm_tasks, & ! communicater tasks
83	me, me_node, me_task,& ! identity of this PE
84	nodes, & ! number of nodes
85	tasks_per_logical_node = -1 ! default no cluster
86
87
88	!
89	!-- Public interfaces
90	INTERFACE poisfft_hybrid_ini
91	MODULE PROCEDURE poisfft_hybrid_ini
92	END INTERFACE poisfft_hybrid_ini
93
94	INTERFACE poisfft_hybrid
95	MODULE PROCEDURE poisfft_hybrid
96	END INTERFACE poisfft_hybrid
97
98	!
99	!-- Private interfaces
100	INTERFACE poisfft_hybrid_omp
101	MODULE PROCEDURE poisfft_hybrid_omp
102	END INTERFACE poisfft_hybrid_omp
103
104	INTERFACE poisfft_hybrid_omp_vec
105	MODULE PROCEDURE poisfft_hybrid_omp_vec
106	END INTERFACE poisfft_hybrid_omp_vec
107
108	INTERFACE poisfft_hybrid_nodes
109	MODULE PROCEDURE poisfft_hybrid_nodes
110	END INTERFACE poisfft_hybrid_nodes
111
112	INTERFACE tridia_hybrid
113	MODULE PROCEDURE tridia_hybrid
114	END INTERFACE tridia_hybrid
115
116	INTERFACE cascade
117	MODULE PROCEDURE cascade
118	END INTERFACE cascade
119
120	CONTAINS
121
122
123	SUBROUTINE poisfft_hybrid_ini
124
125	USE control_parameters
126	USE pegrid
127
128	IMPLICIT NONE
129
130	CHARACTER(LEN=8) :: cdummy
131	INTEGER :: idummy, istat
132	INTEGER, DIMENSION(2) :: coords, dims
133
134	LOGICAL, DIMENSION(2) :: period = .false., re_dims
135
136
137	!
138	!-- Set the internal index values for the hybrid solver
139	#if defined( __parallel )
140	npe_s = pdims(1)
141	#else
142	npe_s = 1
143	#endif
144	nxl_a = 0
145	nxr_a = nx
146	nxl_p = 0
147	nxr_p = ( ( nx+1 ) / npe_s ) - 1
148	nys_a = nys
149	nyn_a = nyn
150	nys_p = 0
151	nyn_p = ( ( ny+1 ) / npe_s ) - 1
152
153	nwords = ( nxr_p-nxl_p+1 ) * nz * ( nyn_p-nys_p+1 )
154
155	#if defined( __KKMP )
156	CALL LOCAL_GETENV( 'OMP_NUM_THREADS', 15, cdummy, idummy )
157	READ ( cdummy, '(I8)' ) n_omp_threads
158	IF ( n_omp_threads > 1 ) THEN
159	WRITE( message_string, * ) 'Number of OpenMP threads = ', &
160	n_omp_threads
161	CALL message( 'poisfft_hybrid_ini', 'PA0280', 0, 0, 0, 6, 0 )
162	ENDIF
163	#else
164	n_omp_threads = 1
165	#endif
166	!
167	!-- Initialize the one-dimensional FFT routines
168	CALL fft_init
169
170	!
171	!-- Setup for multi node version (poisfft_hybrid_nodes)
172	IF ( n_omp_threads == 1 .AND. &
173	( host(1:4) == 'ibmh' .OR. host(1:4) == 'ibmb' ) ) THEN
174
175	IF ( tasks_per_node /= -9999 ) THEN
176	!
177	!-- Multi node version requires that the available number of
178	!-- switches per logical partition must be an integral divisor
179	!-- of the chosen number of tasks per node
180	IF ( MOD( tasks_per_node, switch_per_lpar ) == 0 ) THEN
181	!
182	!-- Set the switch which decides about usage of the multi node
183	!-- version
184	IF ( tasks_per_node / switch_per_lpar > 1 .AND. &
185	numprocs > tasks_per_node ) THEN
186	tasks_per_logical_node = tasks_per_node / switch_per_lpar
187	ENDIF
188
189	IF ( tasks_per_logical_node > -1 ) THEN
190
191	WRITE( message_string, * ) 'running optimized ', &
192	'multinode version', &
193	'&switch_per_lpar = ', &
194	switch_per_lpar, &
195	'&tasks_per_lpar = ', &
196	tasks_per_node, &
197	'tasks_per_logical_node = ', &
198	tasks_per_logical_node
199	CALL message( 'poisfft_hybrid_ini', 'PA0281', 0, 0, 0, 6, 0 )
200
201	ENDIF
202
203	ENDIF
204	ENDIF
205	ENDIF
206
207	!
208	!-- Determine sub-topologies for multi node version
209	IF ( tasks_per_logical_node >= 2 ) THEN
210
211	#if defined( __parallel )
212	nodes = ( numprocs + tasks_per_logical_node - 1 ) / &
213	tasks_per_logical_node
214	dims(1) = nodes
215	dims(2) = tasks_per_logical_node
216
217	CALL MPI_CART_CREATE( comm2d, 2, dims, period, .FALSE., &
218	comm_node_all, istat )
219	CALL MPI_COMM_RANK( comm_node_all, me, istat )
220
221	re_dims(1) = .TRUE.
222	re_dims(2) = .FALSE.
223	CALL MPI_CART_SUB( comm_node_all, re_dims, comm_nodes, istat )
224	CALL MPI_COMM_RANK( comm_nodes, me_node, istat )
225
226	re_dims(1) = .FALSE.
227	re_dims(2) = .TRUE.
228	CALL MPI_CART_SUB( comm_node_all, re_dims, comm_tasks, istat )
229	CALL MPI_COMM_RANK( comm_tasks, me_task, istat )
230
231	! write(0,*) 'who am i',myid,me,me_node,me_task,nodes,&
232	! tasks_per_logical_node
233	#else
234	message_string = 'parallel environment (MPI) required'
235	CALL message( 'poisfft_hybrid_ini', 'PA0282', 1, 2, 0, 6, 0 )
236	#endif
237	ENDIF
238
239	END SUBROUTINE poisfft_hybrid_ini
240
241
242	SUBROUTINE poisfft_hybrid( ar )
243
244	USE control_parameters
245	USE interfaces
246
247	IMPLICIT NONE
248
249	REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
250
251	IF ( host(1:3) == 'nec' ) THEN
252	CALL poisfft_hybrid_omp_vec( ar )
253	ELSE
254	IF ( tasks_per_logical_node == -1 ) THEN
255	CALL poisfft_hybrid_omp( ar )
256	ELSE
257	CALL poisfft_hybrid_nodes( ar )
258	ENDIF
259	ENDIF
260
261	END SUBROUTINE poisfft_hybrid
262
263
264	SUBROUTINE poisfft_hybrid_omp ( ar )
265
266	USE cpulog
267	USE interfaces
268
269	IMPLICIT NONE
270
271	INTEGER, PARAMETER :: istride = 4 ! stride of i loop
272	INTEGER :: i, ii, ir, iei, iouter, istat, j, jj, k, m, n, jthread
273
274	REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
275
276	REAL, DIMENSION(0:nx) :: fftx_ar
277	REAL, DIMENSION(0:ny,istride) :: ffty_ar
278
279	REAL, DIMENSION(0:nx,nz) :: tri_ar
280
281	REAL, DIMENSION(nxl_p:nxr_p,nz,nys_p:nyn_p,npe_s) :: work1, work2
282	#if defined( __KKMP )
283	INTEGER :: omp_get_thread_num
284	REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri
285	ALLOCATE( tri(5,0:nx,0:nz-1,n_omp_threads ) )
286	#else
287	REAL, DIMENSION(5,0:nx,0:nz-1,1) :: tri
288	#endif
289
290
291	CALL cpu_log( log_point_s(30), 'poisfft_hybrid_omp', 'start' )
292
293	CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
294
295	!$OMP PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n,ffty_ar)
296	!$OMP DO
297	!
298	!-- Store grid points to be transformed on a 1d-array, do the fft
299	!-- and sample the results on a 4d-array
300	DO iouter = nxl_p, nxr_p, istride ! stride loop, better cache
301	iei = MIN( iouter+istride-1, nxr_p )
302	DO k = 1, nz
303
304	DO i = iouter, iei
305	ii = nxl + i
306	ir = i - iouter + 1
307
308	DO j = nys_a, nyn_a
309	ffty_ar(j,ir) = ar(k,j,ii)
310	ENDDO
311
312	CALL fft_y( ffty_ar(:,ir), 'forward' )
313	ENDDO
314
315	m = nys_a
316	DO n = 1, npe_s
317	DO j = nys_p, nyn_p
318	DO i = iouter, iei
319	ir = i - iouter + 1
320	work1(i,k,j,n) = ffty_ar(m,ir)
321	ENDDO
322	m = m+1
323	ENDDO
324	ENDDO
325
326	ENDDO
327	ENDDO
328	!$OMP END PARALLEL
329
330	CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
331
332	#if defined( __parallel )
333	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
334
335	CALL MPI_ALLTOALL( work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
336	work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
337	comm2d, istat )
338
339	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
340	#else
341	work2 = work1
342	#endif
343
344	CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
345
346	#if defined( __KKMP )
347	!$OMP PARALLEL PRIVATE (i,j,jj,k,m,n,fftx_ar,tri_ar,jthread)
348	!$OMP DO
349	DO j = nys_p, nyn_p
350	jthread = omp_get_thread_num() + 1
351	#else
352	DO j = nys_p, nyn_p
353	jthread = 1
354	#endif
355	DO k = 1, nz
356
357	m = nxl_a
358	DO n = 1, npe_s
359	DO i = nxl_p, nxr_p
360	fftx_ar(m) = work2(i,k,j,n)
361	m = m+1
362	ENDDO
363	ENDDO
364
365	CALL fft_x( fftx_ar, 'forward' )
366
367	DO i = nxl_a, nxr_a
368	tri_ar(i,k) = fftx_ar(i)
369	ENDDO
370
371	ENDDO
372
373	jj = myid * (nyn_p-nys_p+1) + j
374	CALL tridia_hybrid( jj, tri_ar, tri(:,:,:,jthread))
375
376	DO k = 1, nz
377	DO i = nxl_a, nxr_a
378	fftx_ar(i) = tri_ar (i,k)
379	ENDDO
380
381	CALL fft_x( fftx_ar, 'backward' )
382
383	m = nxl_a
384	DO n = 1, npe_s
385	DO i = nxl_p, nxr_p
386	work2(i,k,j,n) = fftx_ar(m)
387	m = m+1
388	ENDDO
389	ENDDO
390
391	ENDDO
392	ENDDO
393	#if defined( __KKMP )
394	!$OMP END PARALLEL
395	#endif
396
397	CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
398
399	#if defined( __parallel )
400	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
401	nwords = (nxr_p-nxl_p+1) * nz * (nyn_p-nys_p+1)
402
403	CALL MPI_ALLTOALL( work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
404	work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
405	comm2d, istat )
406
407	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
408	#else
409	work1 = work2
410	#endif
411
412	CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
413
414	!$OMP PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n,ffty_ar)
415	!$OMP DO
416	DO iouter = nxl_p, nxr_p, istride
417	iei = MIN( iouter+istride-1, nxr_p )
418	DO k = 1, nz
419
420	m = nys_a
421	DO n = 1, npe_s
422	DO j = nys_p, nyn_p
423	DO i = iouter, iei
424	ir = i - iouter + 1
425	ffty_ar(m,ir) = work1 (i,k,j,n)
426	ENDDO
427	m = m+1
428	ENDDO
429	ENDDO
430
431	DO i = iouter, iei
432	ii = nxl + i
433	ir = i - iouter + 1
434	CALL fft_y( ffty_ar(:,ir), 'backward' )
435
436	DO j = nys_a, nyn_a
437	ar(k,j,ii) = ffty_ar(j,ir)
438	ENDDO
439	ENDDO
440
441	ENDDO
442	ENDDO
443	!$OMP END PARALLEL
444
445	CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
446
447	CALL cpu_log( log_point_s(30), 'poisfft_hybrid_omp', 'stop' )
448
449	#if defined( __KKMP )
450	DEALLOCATE( tri )
451	#endif
452
453	END SUBROUTINE poisfft_hybrid_omp
454
455
456	SUBROUTINE poisfft_hybrid_omp_vec ( ar )
457
458	USE cpulog
459	USE interfaces
460
461	IMPLICIT NONE
462
463	INTEGER, PARAMETER :: istride = 4 ! stride of i loop
464	INTEGER :: i, ii, ir, iei, iouter, istat, j, jj, k, m, n, jthread
465
466	REAL, DIMENSION(0:nx,nz) :: tri_ar
467
468	REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
469
470	REAL, DIMENSION(0:ny+3,nz,nxl_p:nxr_p) :: ffty_ar3
471	REAL, DIMENSION(0:nx+3,nz,nys_p:nyn_p) :: fftx_ar3
472
473	REAL, DIMENSION(nxl_p:nxr_p,nz,nys_p:nyn_p,npe_s) :: work1, work2
474	#if defined( __KKMP )
475	INTEGER :: omp_get_thread_num
476	REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri
477	ALLOCATE( tri(5,0:nx,0:nz-1,n_omp_threads ) )
478	#else
479	REAL, DIMENSION(5,0:nx,0:nz-1,1) :: tri
480	#endif
481
482
483	CALL cpu_log( log_point_s(30), 'poisfft_hybrid_vec', 'start' )
484
485	CALL cpu_log( log_point_s(7), 'fft_y_m', 'start' )
486
487	!$OMP PARALLEL PRIVATE (i,j,k,m,n)
488	!$OMP DO
489	!
490	!-- Store grid points to be transformed on a 1d-array, do the fft
491	!-- and sample the results on a 4d-array
492	DO i = nxl_p, nxr_p
493
494	DO j = nys_a, nyn_a
495	DO k = 1, nz
496	ffty_ar3(j,k,i) = ar(k,j,i+nxl)
497	ENDDO
498	ENDDO
499
500	CALL fft_y_m( ffty_ar3(:,:,i), ny+3, 'forward' )
501	ENDDO
502
503	!$OMP DO
504	DO k = 1, nz
505	m = nys_a
506	DO n = 1, npe_s
507	DO j = nys_p, nyn_p
508	DO i = nxl_p, nxr_p
509	work1(i,k,j,n) = ffty_ar3(m,k,i)
510	ENDDO
511	m = m+1
512	ENDDO
513	ENDDO
514	ENDDO
515	!$OMP END PARALLEL
516
517	CALL cpu_log( log_point_s(7), 'fft_y_m', 'pause' )
518
519	#if defined( __parallel )
520	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
521	CALL MPI_ALLTOALL( work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
522	work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
523	comm2d, istat )
524	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
525	#else
526	work2 = work1
527	#endif
528
529	CALL cpu_log( log_point_s(33), 'fft_x_m + tridia', 'start' )
530
531	#if defined( __KKMP )
532	!$OMP PARALLEL PRIVATE (i,j,jj,k,m,n,tri_ar,jthread)
533	!$OMP DO
534	DO j = nys_p, nyn_p
535	jthread = omp_get_thread_num() + 1
536	#else
537	DO j = nys_p, nyn_p
538	jthread = 1
539	#endif
540	DO k = 1, nz
541
542	m = nxl_a
543	DO n = 1, npe_s
544	DO i = nxl_p, nxr_p
545	fftx_ar3(m,k,j) = work2(i,k,j,n)
546	m = m+1
547	ENDDO
548	ENDDO
549	ENDDO
550
551	CALL fft_x_m( fftx_ar3(:,:,j), 'forward' )
552
553	DO k = 1, nz
554	DO i = nxl_a, nxr_a
555	tri_ar(i,k) = fftx_ar3(i,k,j)
556	ENDDO
557	ENDDO
558
559	jj = myid * (nyn_p-nys_p+1) + j
560	CALL tridia_hybrid( jj, tri_ar, tri(:,:,:,jthread))
561
562	DO k = 1, nz
563	DO i = nxl_a, nxr_a
564	fftx_ar3(i,k,j) = tri_ar (i,k)
565	ENDDO
566	ENDDO
567
568	CALL fft_x_m( fftx_ar3(:,:,j), 'backward' )
569
570	DO k = 1, nz
571	m = nxl_a
572	DO n = 1, npe_s
573	DO i = nxl_p, nxr_p
574	work2(i,k,j,n) = fftx_ar3(m,k,j)
575	m = m+1
576	ENDDO
577	ENDDO
578	ENDDO
579
580	ENDDO
581	#if defined( __KKMP )
582	!$OMP END PARALLEL
583	#endif
584
585	CALL cpu_log( log_point_s(33), 'fft_x_m + tridia', 'stop' )
586
587	#if defined( __parallel )
588	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
589	nwords = (nxr_p-nxl_p+1) * nz * (nyn_p-nys_p+1)
590	CALL MPI_ALLTOALL( work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
591	work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
592	comm2d, istat )
593	CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
594	#else
595	work1 = work2
596	#endif
597
598	CALL cpu_log( log_point_s(7), 'fft_y_m', 'continue' )
599
600	!$OMP PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n)
601	!$OMP DO
602	DO k = 1, nz
603	m = nys_a
604	DO n = 1, npe_s
605	DO j = nys_p, nyn_p
606	DO i = nxl_p, nxr_p
607	ffty_ar3(m,k,i) = work1(i,k,j,n)
608	ENDDO
609	m = m+1
610	ENDDO
611	ENDDO
612	ENDDO
613
614	!$OMP DO
615	DO i = nxl_p, nxr_p
616	CALL fft_y_m( ffty_ar3(:,:,i), ny+3, 'backward' )
617	DO j = nys_a, nyn_a
618	DO k = 1, nz
619	ar(k,j,i+nxl) = ffty_ar3(j,k,i)
620	ENDDO
621	ENDDO
622	ENDDO
623	!$OMP END PARALLEL
624
625	CALL cpu_log( log_point_s(7), 'fft_y_m', 'stop' )
626
627	CALL cpu_log( log_point_s(30), 'poisfft_hybrid_vec', 'stop' )
628
629	#if defined( __KKMP )
630	DEALLOCATE( tri )
631	#endif
632
633	END SUBROUTINE poisfft_hybrid_omp_vec
634
635
636	SUBROUTINE poisfft_hybrid_nodes ( ar )
637
638	USE cpulog
639	USE interfaces
640
641	IMPLICIT NONE
642
643	INTEGER, PARAMETER :: istride = 4 ! stride of i loop
644	INTEGER :: i, iei, ii, iouter, ir, istat, j, jj, k, m, &
645	n, nn, nt, nw1, nw2
646
647	REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
648
649	REAL, DIMENSION(0:nx) :: fftx_ar
650	REAL, DIMENSION(0:ny,istride) :: ffty_ar
651
652	REAL, DIMENSION(0:nx,nz) :: tri_ar
653
654	REAL, DIMENSION(nxl_p:nxr_p,nz,tasks_per_logical_node, &
655	nodes,nys_p:nyn_p) :: work1,work2
656	REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
657
658
659	CALL cpu_log( log_point_s(30), 'poisfft_hybrid_nodes', 'start' )
660
661	CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
662
663	!
664	!-- Store grid points to be transformed on a 1d-array, do the fft
665	!-- and sample the results on a 4d-array
666	DO iouter = nxl_p, nxr_p, istride ! stride loop, better cache
667	iei = MIN( iouter+istride-1, nxr_p )
668	DO k = 1, nz
669
670	DO i = iouter, iei
671	ii = nxl + i
672	ir = i - iouter + 1
673
674	DO j = nys_a, nyn_a
675	ffty_ar(j,ir) = ar(k,j,ii)
676	ENDDO
677
678	CALL fft_y( ffty_ar(:,ir), 'forward' )
679	ENDDO
680
681	m = nys_a
682	DO nn = 1, nodes
683	DO nt = 1, tasks_per_logical_node
684	DO j = nys_p, nyn_p
685	DO i = iouter, iei
686	ir = i - iouter + 1
687	work1(i,k,nt,nn,j) = ffty_ar(m,ir)
688	ENDDO
689	m = m+1
690	ENDDO
691	ENDDO
692	ENDDO
693
694	ENDDO
695	ENDDO
696
697	CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
698
699	CALL cpu_log( log_point_s(32), 'alltoall_task', 'start' )
700	nw1 = SIZE( work1, 1 ) * SIZE( work1, 2 )
701	DO nn = 1, nodes
702	DO j = nys_p, nyn_p
703	#if defined( __parallel )
704	CALL MPI_ALLTOALL( work1(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
705	work2(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
706	comm_tasks, istat )
707	#endif
708	ENDDO
709	ENDDO
710	CALL cpu_log( log_point_s(32), 'alltoall_task', 'stop' )
711
712
713	DO j = nys_p, nyn_p
714
715	CALL cascade( 1, j, nys_p, nyn_p )
716	nw2 = nw1 * SIZE( work1, 3 )
717	CALL cpu_log( log_point_s(37), 'alltoall_node', 'start' )
718	#if defined( __parallel )
719	CALL MPI_ALLTOALL( work2(nxl_p,1,1,1,j), nw2, MPI_REAL, &
720	work1(nxl_p,1,1,1,j), nw2, MPI_REAL, &
721	comm_nodes, istat )
722	#endif
723	CALL cpu_log( log_point_s(37), 'alltoall_node', 'pause' )
724	CALL cascade( 2, j, nys_p, nyn_p )
725
726	CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
727	DO k = 1, nz
728
729	m = nxl_a
730	DO nn = 1, nodes
731	DO nt = 1, tasks_per_logical_node
732	DO i = nxl_p, nxr_p
733	fftx_ar(m) = work1(i,k,nt,nn,j)
734	m = m+1
735	ENDDO
736	ENDDO
737	ENDDO
738
739	CALL fft_x( fftx_ar, 'forward' )
740
741	DO i = nxl_a, nxr_a
742	tri_ar(i,k) = fftx_ar(i)
743	ENDDO
744
745	ENDDO
746
747	jj = myid * (nyn_p-nys_p+1) + j
748	CALL tridia_hybrid( jj, tri_ar, tri(:,:,:) )
749
750	DO k = 1, nz
751	DO i = nxl_a, nxr_a
752	fftx_ar(i) = tri_ar(i,k)
753	ENDDO
754
755	CALL fft_x( fftx_ar, 'backward' )
756
757	m = nxl_a
758	DO nn = 1, nodes
759	DO nt = 1, tasks_per_logical_node
760	DO i = nxl_p, nxr_p
761	work1(i,k,nt,nn,j) = fftx_ar(m)
762	m = m+1
763	ENDDO
764	ENDDO
765	ENDDO
766	ENDDO
767
768	CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
769	nw2 = nw1 * SIZE( work1, 3 )
770	CALL cpu_log( log_point_s(37), 'alltoall_node', 'continue' )
771	#if defined( __parallel )
772	CALL MPI_ALLTOALL( work1(nxl_p,1,1,1,j), nw2, MPI_REAL, &
773	work2(nxl_p,1,1,1,j), nw2, MPI_REAL, &
774	comm_nodes, istat )
775	#endif
776	CALL cpu_log( log_point_s(37), 'alltoall_node', 'stop' )
777
778	ENDDO
779
780	CALL cpu_log( log_point_s(32), 'alltoall_task', 'start' )
781	DO nn = 1, nodes
782	DO j = nys_p, nyn_p
783	#if defined( __parallel )
784	CALL MPI_ALLTOALL( work2(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
785	work1(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
786	comm_tasks, istat )
787	#endif
788	ENDDO
789	ENDDO
790	CALL cpu_log( log_point_s(32), 'alltoall_task', 'stop' )
791
792	CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
793
794	DO iouter = nxl_p, nxr_p, istride
795	iei = MIN( iouter+istride-1, nxr_p )
796	DO k = 1, nz
797
798	m = nys_a
799	DO nn = 1, nodes
800	DO nt = 1, tasks_per_logical_node
801	DO j = nys_p, nyn_p
802	DO i = iouter, iei
803	ir = i - iouter + 1
804	ffty_ar(m,ir) = work1(i,k,nt,nn,j)
805	ENDDO
806	m = m+1
807	ENDDO
808	ENDDO
809	ENDDO
810
811	DO i = iouter, iei
812	ii = nxl + i
813	ir = i - iouter + 1
814	CALL fft_y( ffty_ar(:,ir), 'backward' )
815
816	DO j = nys_a, nyn_a
817	ar(k,j,ii) = ffty_ar(j,ir)
818	ENDDO
819	ENDDO
820
821	ENDDO
822	ENDDO
823
824	CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
825
826	CALL cpu_log( log_point_s(30), 'poisfft_hybrid_nodes', 'stop' )
827
828	END SUBROUTINE poisfft_hybrid_nodes
829
830
831
832	SUBROUTINE tridia_hybrid( j, ar, tri )
833
834	USE arrays_3d
835	USE control_parameters
836	USE grid_variables
837
838	IMPLICIT NONE
839
840	INTEGER :: i, j, k, nnyh
841	REAL, DIMENSION(0:nx,nz) :: ar
842	REAL, DIMENSION(0:nx,0:nz-1) :: ar1
843	REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
844
845	nnyh = (ny+1) / 2
846
847	tri = 0.0
848	!
849	!-- Define constant elements of the tridiagonal matrix.
850	DO k = 0, nz-1
851	DO i = 0,nx
852	tri(2,i,k) = ddzu_pres(k+1) * ddzw(k+1)
853	tri(3,i,k) = ddzu_pres(k+2) * ddzw(k+1)
854	ENDDO
855	ENDDO
856
857	IF ( j <= nnyh ) THEN
858	CALL maketri_hybrid( j )
859	ELSE
860	CALL maketri_hybrid( ny+1-j)
861	ENDIF
862	CALL zerleg_hybrid
863	CALL substi_hybrid( ar, tri )
864
865	CONTAINS
866
867	SUBROUTINE maketri_hybrid( j )
868
869	!----------------------------------------------------------------------!
870	! maketri !
871	! !
872	! computes the i- and j-dependent component of the matrix !
873	!----------------------------------------------------------------------!
874
875	USE constants
876
877	IMPLICIT NONE
878
879	INTEGER :: i, j, k, nnxh
880	REAL :: a, c
881
882	REAL, DIMENSION(0:nx) :: l
883
884
885	nnxh = (nx+1) / 2
886	!
887	!-- Provide the tridiagonal matrix for solution of the Poisson equation
888	!-- in Fourier space. The coefficients are computed following the method
889	!-- of Schmidt et al. (DFVLR-Mitteilung 84-15) --> departs from Stephan
890	!-- Siano's original version.
891	DO i = 0,nx
892	IF ( i >= 0 .AND. i < nnxh ) THEN
893	l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
894	FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
895	2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
896	FLOAT( ny+1 ) ) ) / ( dy * dy )
897	ELSEIF ( i == nnxh ) THEN
898	l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
899	FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
900	2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
901	FLOAT(ny+1) ) ) / ( dy * dy )
902	ELSE
903	l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
904	FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
905	2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
906	FLOAT( ny+1 ) ) ) / ( dy * dy )
907	ENDIF
908	ENDDO
909
910	DO k = 0,nz-1
911	DO i = 0, nx
912	a = -1.0 * ddzu_pres(k+2) * ddzw(k+1)
913	c = -1.0 * ddzu_pres(k+1) * ddzw(k+1)
914	tri(1,i,k) = a + c - l(i)
915	ENDDO
916	ENDDO
917	IF ( ibc_p_b == 1 .OR. ibc_p_b == 2 ) THEN
918	DO i = 0,nx
919	tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
920	ENDDO
921	ENDIF
922	IF ( ibc_p_t == 1 ) THEN
923	DO i = 0,nx
924	tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
925	ENDDO
926	ENDIF
927
928	END SUBROUTINE maketri_hybrid
929
930
931	SUBROUTINE zerleg_hybrid
932
933	!----------------------------------------------------------------------!
934	! zerleg !
935	! !
936	! Splitting of the tridiagonal matrix (Thomas algorithm) !
937	!----------------------------------------------------------------------!
938
939	USE indices
940
941	IMPLICIT NONE
942
943	INTEGER :: i, k
944
945	!
946	!-- Splitting
947	DO i = 0, nx
948	tri(4,i,0) = tri(1,i,0)
949	ENDDO
950	DO k = 1, nz-1
951	DO i = 0,nx
952	tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
953	tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
954	ENDDO
955	ENDDO
956
957	END SUBROUTINE zerleg_hybrid
958
959	SUBROUTINE substi_hybrid( ar, tri )
960
961	!----------------------------------------------------------------------!
962	! substi !
963	! !
964	! Substitution (Forward and Backward) (Thomas algorithm) !
965	!----------------------------------------------------------------------!
966
967	IMPLICIT NONE
968
969	INTEGER :: i, j, k
970	REAL, DIMENSION(0:nx,nz) :: ar
971	REAL, DIMENSION(0:nx,0:nz-1) :: ar1
972	REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
973
974	!
975	!-- Forward substitution
976	DO i = 0, nx
977	ar1(i,0) = ar(i,1)
978	ENDDO
979	DO k = 1, nz - 1
980	DO i = 0,nx
981	ar1(i,k) = ar(i,k+1) - tri(5,i,k) * ar1(i,k-1)
982	ENDDO
983	ENDDO
984
985	!
986	!-- Backward substitution
987	DO i = 0,nx
988	ar(i,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
989	ENDDO
990	DO k = nz-2, 0, -1
991	DO i = 0,nx
992	ar(i,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,k+2) ) &
993	/ tri(4,i,k)
994	ENDDO
995	ENDDO
996
997	END SUBROUTINE substi_hybrid
998
999	END SUBROUTINE tridia_hybrid
1000
1001
1002	SUBROUTINE cascade( loca, j, nys_p, nyn_p )
1003
1004	USE cpulog
1005
1006	IMPLICIT NONE
1007
1008	INTEGER :: ier, j, loca, nyn_p, nys_p, req, reqa(1)
1009	INTEGER, SAVE :: tag = 10
1010	#if defined( __parallel )
1011	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: stat
1012	INTEGER, DIMENSION(MPI_STATUS_SIZE,1) :: stata
1013	#endif
1014
1015	REAL :: buf, buf1
1016
1017
1018	buf = 1.0
1019	buf1 = 1.1
1020	IF ( me_node == 0 ) THEN ! first node only
1021
1022	SELECT CASE ( loca )
1023
1024	CASE ( 1 ) ! before alltoall
1025
1026	IF( me_task > 0 ) THEN ! first task does not wait
1027	#if defined( __parallel )
1028	CALL MPI_SENDRECV( buf, 1, MPI_REAL, me_task-1, 0, &
1029	buf1, 1, MPI_REAL, me_task-1, 0, &
1030	comm_tasks, stat, ierr )
1031	#endif
1032	ELSEIF ( j > nys_p ) THEN
1033	req = 0
1034	tag = MOD( tag-10, 10 ) + 10
1035	#if defined( __parallel )
1036	CALL MPI_IRECV( buf, 1, MPI_REAL, tasks_per_logical_node-1,&
1037	tag, comm_tasks, req, ierr )
1038	reqa = req
1039	CALL MPI_WAITALL( 1, reqa, stata, ierr )
1040	#endif
1041	ENDIF
1042
1043	CASE ( 2 ) ! after alltoall
1044
1045	IF ( me_task < tasks_per_logical_node-1 ) THEN ! last task
1046	#if defined( __parallel )
1047	CALL MPI_SENDRECV( buf, 1, MPI_REAL, me_task+1, 0, &
1048	buf1, 1, MPI_REAL, me_task+1, 0, &
1049	comm_tasks, stat, ierr)
1050	#endif
1051	ELSEIF ( j < nyn_p ) THEN
1052	req = 0
1053	tag = MOD( tag-10, 10 ) + 10
1054	#if defined( __parallel )
1055	CALL MPI_ISEND( buf, 1, MPI_REAL, 0, tag, comm_tasks, req, &
1056	ierr )
1057	#endif
1058	ENDIF
1059
1060	END SELECT
1061
1062	ENDIF
1063
1064	END SUBROUTINE cascade
1065
1066	END MODULE poisfft_hybrid_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |