Home

Context Navigation

poisfft_hybrid.f90 @ 534

Last change on this file since 534 was 482, checked in by raasch, 15 years ago

New:
---
compare_palm_logs is additionally compiled with mbuild -u (Makefile in trunk/UTIL)

make options (mopts) to be set by configuration file implemented (mrun, mbuild)

humidity=.T. is now usable for runs with topography. wall_humidityflux and
wall_scalarflux are the corresponding new parin arrays.
(check_parameters, init_3d_model, parin)

Large scale vertical motion (subsidence/ascent) can be applied to the
prognostic equation for the potential temperature. (check_parameters, header,
Makefile, modules, parin, prognostic_equations, read_var_list, subsidence,
write_var_list)

A simple method for installing and running palm (with limited features)
has been added. (Makefile, palm_simple_install, palm_simple_run)

Changed:

2d-decomposition is default for Cray-XT machines (init_pegrid)

var_ts is replaced by dots_max (modules,init_3d_model)

Every cloud droplet has now an own weighting factor and can be deleted due to
collisions. Condensation and collision of cloud droplets are adjusted
accordingly. (advec_particles)

Collision efficiency for large cloud droplets has changed according to table of
Rogers and Yau. (collision_efficiency)

Errors:

Bugfix for generating serial jobs (subjob)

Bugfix: index problem concerning gradient_level indices removed (header)

Dimension of array stat in cascade change to prevent type problems with
mpi2 libraries (poisfft_hybrid)

Loop was split to make runs reproducible when using ifort compiler.
(disturb_field)

Bugfix: exchange of ghost points for prho included (time_integration)

Bugfix: calculation of time-averaged surface heatfluxes (sum_up_3d_data)

Bugfix: calculation of precipitation_rate (calc_precipitation)

Bugfix: initial data assignments to some dvrp arrays changed due to error
messages from gfortran compiler (modules)

Bugfix: calculation of cloud droplet velocity (advec_particles)

Bugfix: transfer of particles at south/left edge (advec_particles)

Bugfix: calculation of collision_efficiency (collision_efficiency)

Bugfix: initialisation of var_mod (subsidence)

Property svn:keywords set to Id

File size: 31.4 KB

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

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

Context Navigation

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

Download in other formats: