Home

Context Navigation

source: palm/trunk/SOURCE/shared_memory_io_mod.f90 @ 4617

Last change on this file since 4617 was 4617, checked in by raasch, 5 years ago
cyclic fill mode implemented for MPI-IO, check, if boundary conditions in the prerun are both set to cyclic
Property svn:keywords set to `Id`
File size: 41.2 KB

Line
1	!> @file shared_memory_io_mod.f90
2	!--------------------------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
7	! (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11	! Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
14	! <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 1997-2020 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! $Id: shared_memory_io_mod.f90 4617 2020-07-22 09:48:50Z raasch $
26	!
27	! Additions for cyclic fill mode
28	!
29	!
30	! File re-formatted to follow the PALM coding standard
31	!
32	!
33	! Initial version (Klaus Ketelsen)
34	!
35	!
36	!
37	! Description:
38	! ------------
39	!> Handle MPI-IO or NetCDF-IO shared memory arrays.
40	!> This module performs the organization of new communicators, adapted PE-grids and allocation of
41	!> shared memory arrays. The IO itself is not done here.
42	!--------------------------------------------------------------------------------------------------!
43	MODULE shared_memory_io_mod
44
45	#if defined( __parallel )
46	#if defined( __mpifh )
47	INCLUDE "mpif.h"
48	#else
49	USE MPI
50	#endif
51	#endif
52
53	USE, INTRINSIC :: ISO_C_BINDING
54
55	USE control_parameters, &
56	ONLY: maximum_grid_level, &
57	message_string, &
58	mg_switch_to_pe0_level
59
60
61	USE indices, &
62	ONLY: nbgp, &
63	nnx, &
64	nny, &
65	nnz, &
66	nx, &
67	nxl, &
68	nxlg, &
69	nxr, &
70	nxrg, &
71	ny, &
72	nyn, &
73	nyng, &
74	nys, &
75	nysg, &
76	nzb, &
77	nzt
78
79	USE kinds, &
80	ONLY: dp, &
81	iwp, &
82	sp, &
83	wp
84
85	USE pegrid, &
86	ONLY: comm1dx, &
87	comm1dy, &
88	comm2d, &
89	ierr, &
90	myid, &
91	myidx, &
92	myidy, &
93	npex, &
94	npey, &
95	numprocs, &
96	pdims, &
97	pleft, &
98	pnorth, &
99	pright, &
100	psouth, &
101	sendrecvcount_xy
102
103	#if defined( __parallel )
104	USE pegrid, &
105	ONLY: pcoord, &
106	reorder
107	#endif
108
109	IMPLICIT NONE
110
111	PRIVATE
112
113	SAVE
114
115	!
116	!-- Type to store information about the domain decomposition grid
117	TYPE, PUBLIC :: domain_decomposition_grid_features !<
118
119	INTEGER(iwp) :: comm2d !<
120	INTEGER(iwp) :: myid !<
121	INTEGER(iwp) :: nnx !<
122	INTEGER(iwp) :: nny !<
123	INTEGER(iwp) :: nx !<
124	INTEGER(iwp) :: nxl !<
125	INTEGER(iwp) :: nxr !<
126	INTEGER(iwp) :: ny !<
127	INTEGER(iwp) :: nyn !<
128	INTEGER(iwp) :: nys !<
129	INTEGER(iwp) :: numprocs !<
130
131	CONTAINS
132
133	PROCEDURE, PASS(this), PUBLIC :: activate_grid_from_this_class
134	PROCEDURE, PASS(this), PUBLIC :: save_grid_into_this_class
135
136	END TYPE domain_decomposition_grid_features
137
138	!
139	!-- Class definition for shared memory instances.
140	!-- For every use of shared memory IO, one instance of this class is created.
141	TYPE, PUBLIC :: sm_class !<
142
143	INTEGER(iwp) :: nr_io_pe_per_node = 2 !< typical configuration, 2 sockets per node
144	LOGICAL :: no_shared_Memory_in_this_run !<
145
146	INTEGER(iwp) :: comm_model !< communicator of this model run
147	!
148	!-- Variables for the shared memory communicator
149	INTEGER(iwp), PUBLIC :: comm_shared !< communicator for processes with shared array
150	INTEGER(iwp), PUBLIC :: sh_npes !<
151	INTEGER(iwp), PUBLIC :: sh_rank !<
152
153	LOGICAL, PUBLIC :: iam_io_pe = .TRUE. !< This PE is an IO-PE
154	!
155	!-- Variables for the I/O virtual grid
156	INTEGER(iwp), PUBLIC :: comm_io !< Communicator for all IO processes
157	INTEGER(iwp), PUBLIC :: io_npes !<
158	INTEGER(iwp), PUBLIC :: io_rank !<
159	!
160	!-- Variables for the node local communicator
161	INTEGER(iwp) :: comm_node !< Communicator for all processes of current node
162	INTEGER(iwp) :: io_pe_global_rank !<
163	INTEGER(iwp) :: n_npes !<
164	INTEGER(iwp) :: n_rank !<
165
166	TYPE(domain_decomposition_grid_features), PUBLIC :: io_grid !< io grid features, depending on reading from prerun or restart run
167
168
169	CONTAINS
170
171	PRIVATE
172
173	PROCEDURE, PASS(this), PUBLIC :: is_sm_active
174	PROCEDURE, PASS(this), PUBLIC :: sm_adjust_outer_boundary
175	PROCEDURE, PASS(this), PUBLIC :: sm_free_shared
176	PROCEDURE, PASS(this), PUBLIC :: sm_init_comm
177	PROCEDURE, PASS(this), PUBLIC :: sm_init_part
178	PROCEDURE, PASS(this), PUBLIC :: sm_node_barrier
179	#if defined( __parallel )
180	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_1d_64
181	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_1d_32
182	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_1di
183	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2d_64
184	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2d_32
185	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2di
186	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3d_64
187	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3d_32
188
189	GENERIC, PUBLIC :: sm_allocate_shared => &
190	sm_allocate_shared_1d_64, sm_allocate_shared_1d_32, &
191	sm_allocate_shared_2d_64, sm_allocate_shared_2d_32, &
192	sm_allocate_shared_2di, sm_allocate_shared_3d_64, &
193	sm_allocate_shared_3d_32, sm_allocate_shared_1di
194	#endif
195	END TYPE sm_class
196
197
198	CONTAINS
199
200
201	!--------------------------------------------------------------------------------------------------!
202	! Description:
203	! ------------
204	!> Create the communicator for shared memory groups and IO-PEs.
205	!> Setup the grid for shared memory IO.
206	!--------------------------------------------------------------------------------------------------!
207	SUBROUTINE sm_init_comm( this, sm_active, comm_input )
208
209	IMPLICIT NONE
210
211	CLASS(sm_class), INTENT(INOUT) :: this !< pointer to access internal variables of this call
212	INTEGER, INTENT(IN), OPTIONAL :: comm_input !< main model communicator (comm2d) can optional be set
213
214	#if defined( __parallel )
215	INTEGER :: color
216	INTEGER :: max_n_npes !< maximum number of PEs/node
217	#endif
218
219	LOGICAL, INTENT(IN) :: sm_active !< flag to activate shared-memory IO
220
221	IF ( PRESENT( comm_input ) ) THEN
222	this%comm_model = comm_input
223	ELSE
224	this%comm_model = comm2d
225	ENDIF
226
227	this%no_shared_memory_in_this_run = .NOT. sm_active
228	this%comm_io = this%comm_model ! preset in case of non shared-memory-IO
229
230	IF ( this%no_shared_memory_in_this_run ) THEN
231	this%iam_io_pe = .TRUE.
232	RETURN
233	ENDIF
234
235	#if defined( __parallel )
236	!
237	!-- Determine, how many MPI threads are running on a node
238	this%iam_io_pe = .FALSE.
239	CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &
240	this%comm_node, ierr )
241	CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
242	CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
243
244	CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, this%comm_model, ierr )
245	!
246	!-- Decide, if the configuration can run with shared-memory IO
247	IF ( max_n_npes > 64 ) THEN
248	!
249	!-- Special configuration on the HLRN-IV system with 4 shared memory blocks/node
250	this%nr_io_pe_per_node = 4
251
252	ELSEIF ( max_n_npes <= 32 ) THEN
253	!
254	!-- No shared memory IO with less than 32 threads/node
255	this%no_shared_memory_in_this_run = .TRUE.
256	this%iam_io_pe = .TRUE.
257	RETURN
258	ENDIF
259
260	!
261	!-- No shared memory IO with small setups
262	IF ( nx < 24 .OR. ny < 24 ) THEN
263	this%no_shared_memory_in_this_run = .TRUE.
264	this%iam_io_pe = .TRUE.
265	RETURN
266	ENDIF
267
268	!
269	!-- Divide a node into shared memory groups, depending on the virtual x-y grid
270	CALL compute_color( color )
271	!
272	!-- If no shared memory IO possible, nothing is left to be done here.
273	IF ( this%no_shared_memory_in_this_run ) RETURN
274
275	!
276	!-- Setup the shared memory area
277	CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
278	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
279	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
280
281	!
282	!-- Setup the communicator across the nodes depending on the shared memory rank.
283	!-- All threads with shared memory rank 0 will be I/O threads.
284	color = this%sh_rank
285	CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
286
287	IF ( this%comm_io /= MPI_COMM_NULL ) THEN
288	CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
289	CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
290	ELSE
291	this%io_npes = -1
292	this%io_rank = -1
293	ENDIF
294
295	IF ( this%sh_rank == 0 ) THEN
296	this%iam_io_pe = .TRUE.
297	this%io_pe_global_rank = myid
298	ENDIF
299	CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
300
301	#else
302	this%iam_io_pe = .TRUE.
303	#endif
304
305	! write(9,'(a,8i7)') ' end of sm_init_comm ',this%sh_rank,this%sh_npes,this%io_rank,this%io_npes,this%io_pe_global_rank
306	! write(9,*) 'This process is IO Process ',this%iam_io_pe
307
308	#if defined( __parallel )
309	CONTAINS
310
311	SUBROUTINE compute_color( color )
312
313	IMPLICIT NONE
314
315	INTEGER(iwp), INTENT(OUT) :: color !<
316
317	INTEGER(iwp) :: group_start !<
318	INTEGER(iwp) :: my_color !<
319	INTEGER(iwp) :: n !<
320	INTEGER(iwp) :: pe !<
321	INTEGER(iwp) :: sh_group_size !<
322
323	INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) :: local_dim_s !<
324	INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) :: local_dim_r !<
325
326	TYPE(domain_decomposition_grid_features), DIMENSION(32) :: node_grid !<
327
328	!
329	!-- No shared memory I/O on one node jobs
330	IF ( numprocs < this%n_npes ) THEN
331	this%no_shared_memory_in_this_run = .TRUE.
332	RETURN
333	ENDIF
334
335	local_dim_s = 0
336	local_dim_s(1,this%n_rank) = nxl
337	local_dim_s(2,this%n_rank) = nxr
338	local_dim_s(3,this%n_rank) = nys
339	local_dim_s(4,this%n_rank) = nyn
340
341	node_grid%nyn = -1
342	!
343	!-- Distribute the x-y layout of all cores of a node to all node processes
344	CALL MPI_ALLREDUCE( local_dim_s, local_dim_r, SIZE( local_dim_s ), MPI_INTEGER, MPI_SUM, &
345	this%comm_node, ierr )
346	sh_group_size = ( max_n_npes + this%nr_io_pe_per_node - 1 ) / this%nr_io_pe_per_node
347
348	pe = 0
349	my_color = 1 ! color is used to split the shared memory communicator into a communicator for
350	! io groups
351	group_start = pe
352	node_grid(my_color)%nxl = local_dim_r(1,group_start)
353	node_grid(my_color)%nxr = local_dim_r(2,group_start)
354	node_grid(my_color)%nys = local_dim_r(3,group_start)
355
356	DO n = 1, this%n_npes-1
357
358	pe = n
359	IF ( n > 0 .AND. MOD( n,sh_group_size ) == 0 ) THEN
360	!
361	!-- If group boundary, start new IO group
362	node_grid(my_color)%nyn = local_dim_r(4,pe-1)
363	my_color = my_color + 1
364	group_start = pe
365	node_grid(my_color)%nxl = local_dim_r(1,group_start)
366	node_grid(my_color)%nxr = local_dim_r(2,group_start)
367	node_grid(my_color)%nys = local_dim_r(3,group_start)
368
369	ELSEIF ( local_dim_r(1,pe) /= node_grid(my_color)%nxl ) THEN
370	!
371	!-- If nxl changes, start new IO group
372	node_grid(my_color)%nyn = local_dim_r(4,pe-1)
373	my_color = my_color+1
374	group_start = pe
375	node_grid(my_color)%nxl = local_dim_r(1,group_start)
376	node_grid(my_color)%nxr = local_dim_r(2,group_start)
377	node_grid(my_color)%nys = local_dim_r(3,group_start)
378	ENDIF
379	!
380	!-- Save values for local PE
381	IF ( this%n_rank == pe ) THEN !
382	color = my_color
383	ENDIF
384	IF ( n == this%n_npes-1 ) node_grid(my_color)%nyn = local_dim_r(4,pe)
385
386	ENDDO
387
388	IF ( this%n_rank == 0 ) THEN
389	color = 1
390	ENDIF
391
392	this%io_grid = node_grid(color)
393	this%io_grid%nnx = this%io_grid%nxr - this%io_grid%nxl + 1
394	this%io_grid%nny = this%io_grid%nyn - this%io_grid%nys + 1
395
396	END SUBROUTINE compute_color
397	#endif
398
399	END SUBROUTINE sm_init_comm
400
401
402	!
403	!-- TODO: short description required, about the meaning of the following routine
404	!-- part must be renamed particles!
405	SUBROUTINE sm_init_part( this )
406
407	IMPLICIT NONE
408
409	CLASS(sm_class), INTENT(INOUT) :: this !< pointer to access internal variables of this call
410
411	#if defined( __parallel )
412	INTEGER(iwp) :: color !<
413	INTEGER(iwp) :: comm_shared_base !<
414	INTEGER(iwp) :: ierr !<
415	INTEGER(iwp) :: max_n_npes !< maximum number of PEs/node
416
417	LOGICAL :: sm_active !<
418	#endif
419
420
421	sm_active = .TRUE. ! particle IO always uses shared memory
422	this%comm_model = comm2d
423
424	this%no_shared_memory_in_this_run = .NOT. sm_active
425	this%comm_io = this%comm_model ! preset in case of non shared-memory-IO
426
427	IF ( this%no_shared_memory_in_this_run ) THEN
428	this%iam_io_pe = .TRUE.
429	RETURN
430	ENDIF
431
432	#if defined( __parallel )
433	!
434	!-- Determine, how many MPI threads are running on a node
435	this%iam_io_pe = .FALSE.
436	CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &
437	this%comm_node, ierr )
438	CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
439	CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
440
441	CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, this%comm_model, ierr )
442
443	!
444	!-- TODO: better explanation
445	!-- It has to be testet, if using memory blocks for an IO process (MPI shared Memory), or if it is
446	!-- even better to use the complete node for MPI shared memory (this%nr_io_pe_per_node = 1).
447	!- In the latter case, the access to the MPI shared memory buffer is slower, the number of
448	!-- particles to move between threads will be much smaller.
449	IF ( max_n_npes > 64 ) THEN
450	!
451	!-- Special configuration on the HLRN-IV system with 4 shared memory blocks/node
452	this%nr_io_pe_per_node = 4
453	ENDIF
454
455	IF ( this%nr_io_pe_per_node == 1 ) THEN
456	!
457	!-- This branch is not realized so far
458	this%iam_io_pe = ( this%n_rank == 0 )
459	this%comm_shared = this%comm_node
460	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
461	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
462
463	ELSEIF( this%nr_io_pe_per_node == 2 ) THEN
464
465	this%iam_io_pe = ( this%n_rank == 0 .OR. this%n_rank == this%n_npes/2 )
466	IF ( this%n_rank < this%n_npes/2 ) THEN
467	color = 1
468	ELSE
469	color = 2
470	ENDIF
471	CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
472	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
473	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
474
475	ELSEIF( this%nr_io_pe_per_node == 4 ) THEN
476
477	this%iam_io_pe = ( this%n_rank == 0 .OR. this%n_rank == this%n_npes/4 .OR. &
478	this%n_rank == this%n_npes/2 .OR. this%n_rank == (3*this%n_npes)/4 )
479	IF ( this%n_rank < this%n_npes/4 ) THEN
480	color = 1
481	ELSEIF( this%n_rank < this%n_npes/2 ) THEN
482	color = 2
483	ELSEIF( this%n_rank < (3*this%n_npes)/4 ) THEN
484	color = 3
485	ELSE
486	color = 4
487	ENDIF
488	CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
489	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
490	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
491
492	ELSE
493
494	WRITE( , ) 'shared_memory_io_mod: internal error'
495	WRITE( , ) 'only 2 or 4 shared memory groups per node are allowed'
496	STOP
497
498	ENDIF
499
500	!
501	!-- Setup the shared memory area
502	CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
503	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
504	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
505
506	!
507	!-- Setup the communicator across the nodes depending on the shared memory rank.
508	!-- All threads with shared memory rank 0 will be I/O threads.
509	color = this%sh_rank
510	CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
511
512	IF ( this%comm_io /= MPI_COMM_NULL ) THEN
513	CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
514	CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
515	ELSE
516	this%io_npes = -1
517	this%io_rank = -1
518	ENDIF
519
520	IF ( this%sh_rank == 0 ) THEN
521	this%iam_io_pe = .TRUE.
522	this%io_pe_global_rank = myid
523	ENDIF
524	CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
525
526	#else
527	this%iam_io_pe = .FALSE.
528	#endif
529
530	! write(9,'(a,8i7)') 'sm_init_comm_part ',this%sh_rank,this%sh_npes,this%io_rank,this%io_npes
531
532	END SUBROUTINE sm_init_part
533
534	!--------------------------------------------------------------------------------------------------!
535	! Description:
536	! ------------
537	!> Function to return if shared Memory IO is active.
538	!--------------------------------------------------------------------------------------------------!
539	FUNCTION is_sm_active( this ) RESULT( ac )
540
541	IMPLICIT NONE
542
543	CLASS(sm_class), INTENT(inout) :: this !<
544
545	LOGICAL :: ac !<
546
547	ac = .NOT. this%no_shared_memory_in_this_run
548
549	END FUNCTION is_sm_active
550
551
552	#if defined( __parallel )
553
554	!--------------------------------------------------------------------------------------------------!
555	! Description:
556	! ------------
557	!> Allocate shared 1d-REAL (64 Bit) array on ALL threads
558	!--------------------------------------------------------------------------------------------------!
559	SUBROUTINE sm_allocate_shared_1d_64( this, p1, d1, d2, win )
560
561	IMPLICIT NONE
562
563	CLASS(sm_class), INTENT(inout) :: this
564
565	INTEGER(iwp) :: disp_unit
566	INTEGER(iwp), INTENT(IN) :: d1
567	INTEGER(iwp), INTENT(IN) :: d2
568	INTEGER(iwp), SAVE :: pe_from = 0
569	INTEGER(iwp), INTENT(OUT) :: win
570
571	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
572	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
573
574	INTEGER, DIMENSION(1) :: buf_shape
575
576	REAL(dp), DIMENSION(:), POINTER :: buf
577	REAL(dp), DIMENSION(:), POINTER :: p1
578
579	TYPE(C_PTR), SAVE :: base_ptr
580	TYPE(C_PTR), SAVE :: rem_ptr
581
582
583	IF ( this%no_shared_memory_in_this_run ) RETURN
584	!
585	!-- Allocate shared memory on node rank 0 threads.
586	IF ( this%sh_rank == pe_from ) THEN
587	wsize = d2 - d1 + 1
588	ELSE
589	wsize = 1
590	ENDIF
591	wsize = wsize * dp ! please note, size is always in bytes, independently of the displacement
592	! unit
593
594	CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
595	!
596	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
597	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
598	!
599	!-- Convert C- to Fortran-pointer
600	buf_shape(1) = d2 - d1 + 1
601	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
602	p1(d1:) => buf
603	!
604	!-- Allocate shared memory in round robin on all PEs of a node.
605	pe_from = MOD( pe_from, this%sh_npes )
606
607	END SUBROUTINE sm_allocate_shared_1d_64
608
609
610	!--------------------------------------------------------------------------------------------------!
611	! Description:
612	! ------------
613	!> Allocate shared 1d-REAL (32 Bit) array on ALL threads
614	!--------------------------------------------------------------------------------------------------!
615	SUBROUTINE sm_allocate_shared_1d_32( this, p1, d1, d2, win )
616
617	IMPLICIT NONE
618
619	CLASS(sm_class), INTENT(inout) :: this
620
621	INTEGER(iwp) :: disp_unit
622	INTEGER(iwp), INTENT(IN) :: d1
623	INTEGER(iwp), INTENT(IN) :: d2
624	INTEGER(iwp), SAVE :: pe_from = 0
625	INTEGER(iwp), INTENT(OUT) :: win
626
627	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
628	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
629
630	INTEGER, DIMENSION(1) :: buf_shape
631
632	REAL(sp), DIMENSION(:), POINTER :: buf
633	REAL(sp), DIMENSION(:), POINTER :: p1
634
635	TYPE(C_PTR), SAVE :: base_ptr
636	TYPE(C_PTR), SAVE :: rem_ptr
637
638
639	IF ( this%no_shared_memory_in_this_run ) RETURN
640	!
641	!-- Allocate shared memory on node rank 0 threads.
642	IF ( this%sh_rank == pe_from ) THEN
643	wsize = d2 - d1 + 1
644	ELSE
645	wsize = 1
646	ENDIF
647	wsize = wsize * sp ! Please note, size is always in bytes, independently of the displacement
648	! unit
649
650	CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
651	!
652	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
653	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
654	!
655	!-- Convert C- to Fortran-pointer
656	buf_shape(1) = d2 - d1 + 1
657	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
658	p1(d1:) => buf
659	!
660	!-- Allocate shared memory in round robin on all PEs of a node.
661	pe_from = MOD( pe_from, this%sh_npes )
662
663	END SUBROUTINE sm_allocate_shared_1d_32
664
665
666	!--------------------------------------------------------------------------------------------------!
667	! Description:
668	! ------------
669	!> Allocate shared 1d-INTEGER array on ALL threads
670	!--------------------------------------------------------------------------------------------------!
671	SUBROUTINE sm_allocate_shared_1di( this, p1, d1, d2, win )
672
673	IMPLICIT NONE
674
675	CLASS(sm_class), INTENT(inout) :: this
676
677	INTEGER(iwp) :: disp_unit
678	INTEGER(iwp), INTENT(IN) :: d1
679	INTEGER(iwp), INTENT(IN) :: d2
680	INTEGER(iwp), SAVE :: pe_from = 0
681	INTEGER(iwp), INTENT(OUT) :: win
682
683	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
684	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
685
686	INTEGER, DIMENSION(1) :: buf_shape
687
688	INTEGER(iwp), DIMENSION(:), POINTER :: buf
689	INTEGER(iwp), DIMENSION(:), POINTER :: p1
690
691	TYPE(C_PTR), SAVE :: base_ptr
692	TYPE(C_PTR), SAVE :: rem_ptr
693
694
695	IF ( this%no_shared_memory_in_this_run ) RETURN
696	!
697	!-- Allocate shared memory on node rank 0 threads.
698	IF ( this%sh_rank == pe_from ) THEN
699	wsize = d2 - d1 + 1
700	ELSE
701	wsize = 1
702	ENDIF
703	wsize = wsize * iwp ! Please note, size is always in bytes, independently of the displacement
704	! unit
705
706	CALL MPI_WIN_ALLOCATE_SHARED( wsize, iwp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
707	!
708	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
709	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
710	!
711	!-- Convert C- to Fortran-pointer
712	buf_shape(1) = d2 - d1 + 1
713	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
714	p1(d1:) => buf
715	!
716	!-- Allocate shared memory in round robin on all PEs of a node.
717	pe_from = MOD( pe_from, this%sh_npes )
718
719	END SUBROUTINE sm_allocate_shared_1di
720
721
722	!--------------------------------------------------------------------------------------------------!
723	! Description:
724	! ------------
725	!> Allocate shared 2d-REAL array on ALL threads (64 Bit)
726	!--------------------------------------------------------------------------------------------------!
727	SUBROUTINE sm_allocate_shared_2d_64( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
728
729	IMPLICIT NONE
730
731	CLASS(sm_class), INTENT(INOUT) :: this
732
733	INTEGER(iwp) :: disp_unit
734	INTEGER(iwp), INTENT(IN) :: n_nxlg
735	INTEGER(iwp), INTENT(IN) :: n_nxrg
736	INTEGER(iwp), INTENT(IN) :: n_nyng
737	INTEGER(iwp), INTENT(IN) :: n_nysg
738	INTEGER(iwp), SAVE :: pe_from = 0
739	INTEGER(iwp), INTENT(OUT) :: win
740
741	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
742	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
743
744	INTEGER(iwp), DIMENSION(2) :: buf_shape
745
746	REAL(dp), DIMENSION(:,:), POINTER :: buf
747	REAL(dp), DIMENSION(:,:), POINTER :: p2
748
749	TYPE(C_PTR), SAVE :: base_ptr
750	TYPE(C_PTR), SAVE :: rem_ptr
751
752
753	IF ( this%no_shared_memory_in_this_run ) RETURN
754	!
755	!-- Allocate shared memory on node rank 0 threads.
756	IF ( this%sh_rank == pe_from ) THEN
757	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
758	ELSE
759	wsize = 1
760	ENDIF
761
762	wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
763	! unit
764
765	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
766	!
767	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
768	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
769	!
770	!-- Convert C- to Fortran-pointer
771	buf_shape(2) = n_nyng - n_nysg + 1
772	buf_shape(1) = n_nxrg - n_nxlg + 1
773	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
774	p2(n_nxlg:, n_nysg:) => buf
775	!
776	!-- Allocate shared memory in round robin on all PEs of a node.
777	pe_from = MOD( pe_from, this%sh_npes )
778
779	END SUBROUTINE sm_allocate_shared_2d_64
780
781
782	!--------------------------------------------------------------------------------------------------!
783	! Description:
784	! ------------
785	!> Allocate shared 2d-REAL (32 Bit) array on ALL threads
786	!--------------------------------------------------------------------------------------------------!
787	SUBROUTINE sm_allocate_shared_2d_32( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
788
789	IMPLICIT NONE
790
791	CLASS(sm_class), INTENT(INOUT) :: this
792
793	INTEGER(iwp) :: disp_unit
794	INTEGER(iwp), INTENT(IN) :: n_nxlg
795	INTEGER(iwp), INTENT(IN) :: n_nxrg
796	INTEGER(iwp), INTENT(IN) :: n_nyng
797	INTEGER(iwp), INTENT(IN) :: n_nysg
798	INTEGER(iwp), SAVE :: pe_from = 0
799	INTEGER(iwp), INTENT(OUT) :: win
800
801	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
802	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
803
804	INTEGER(iwp), DIMENSION(2) :: buf_shape
805
806	REAL(sp), DIMENSION(:,:), POINTER :: buf
807	REAL(sp), DIMENSION(:,:), POINTER :: p2
808
809	TYPE(C_PTR), SAVE :: base_ptr
810	TYPE(C_PTR), SAVE :: rem_ptr
811
812
813	IF ( this%no_shared_memory_in_this_run ) RETURN
814	!
815	!-- Allocate shared memory on node rank 0 threads.
816	IF ( this%sh_rank == pe_from ) THEN
817	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
818	ELSE
819	wsize = 1
820	ENDIF
821
822	wsize = wsize * sp ! Please note, size is always in bytes, independently of the displacement
823	! unit
824
825	CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
826	!
827	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
828	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
829	!
830	!-- Convert C- to Fortran-pointer
831	buf_shape(2) = n_nyng - n_nysg + 1
832	buf_shape(1) = n_nxrg - n_nxlg + 1
833	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
834	p2(n_nxlg:, n_nysg:) => buf
835	!
836	!-- Allocate shared memory in round robin on all PEs of a node.
837	pe_from = MOD( pe_from, this%sh_npes )
838
839	END SUBROUTINE sm_allocate_shared_2d_32
840
841
842	!--------------------------------------------------------------------------------------------------!
843	! Description:
844	! ------------
845	!> Allocate shared 2d-INTEGER array on ALL threads
846	!--------------------------------------------------------------------------------------------------!
847	SUBROUTINE sm_allocate_shared_2di( this, p2i, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
848
849	IMPLICIT NONE
850
851	CLASS(sm_class), INTENT(inout) :: this !<
852
853	INTEGER(iwp) :: disp_unit !<
854	INTEGER(iwp), INTENT(IN) :: n_nxlg !<
855	INTEGER(iwp), INTENT(IN) :: n_nxrg !<
856	INTEGER(iwp), INTENT(IN) :: n_nyng !<
857	INTEGER(iwp), INTENT(IN) :: n_nysg !<
858	INTEGER(iwp), SAVE :: pe_from = 0 !<
859	INTEGER(iwp), INTENT(OUT) :: win !<
860
861	INTEGER(kind=MPI_ADDRESS_KIND) :: rem_size !<
862	INTEGER(kind=MPI_ADDRESS_KIND) :: wsize !<
863
864	INTEGER(iwp), DIMENSION(2) :: buf_shape !<
865
866	INTEGER(iwp), DIMENSION(:,:), POINTER :: buf !<
867	INTEGER(iwp), DIMENSION(:,:), POINTER :: p2i !<
868
869	TYPE(C_PTR), SAVE :: base_ptr !<
870	TYPE(C_PTR), SAVE :: rem_ptr !<
871
872
873	IF ( this%no_shared_memory_in_this_run ) RETURN
874	!
875	!-- Allocate shared memory on node rank 0 threads.
876	IF ( this%sh_rank == pe_from ) THEN
877	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
878	ELSE
879	wsize = 1
880	ENDIF
881
882	wsize = wsize * 4 ! Please note, size is always in bytes, independently of the displacement
883	! unit
884
885	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 4, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
886	!
887	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
888	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
889	!
890	!-- Convert C- to Fortran-pointer
891	buf_shape(2) = n_nyng - n_nysg + 1
892	buf_shape(1) = n_nxrg - n_nxlg + 1
893	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
894	p2i(n_nxlg:, n_nysg:) => buf
895	!
896	!-- Allocate shared memory in round robin on all PEs of a node.
897	pe_from = MOD( pe_from, this%sh_npes )
898
899	END SUBROUTINE sm_allocate_shared_2di
900
901
902	!--------------------------------------------------------------------------------------------------!
903	! Description:
904	! ------------
905	!> Allocate shared 3d-REAL (64 Bit) array on ALL threads
906	!--------------------------------------------------------------------------------------------------!
907	SUBROUTINE sm_allocate_shared_3d_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
908
909	IMPLICIT NONE
910
911	CLASS(sm_class), INTENT(inout) :: this !<
912
913	INTEGER :: disp_unit !<
914	INTEGER, INTENT(IN) :: d1e !<
915	INTEGER, INTENT(IN) :: d1s !<
916	INTEGER, INTENT(IN) :: d2e !<
917	INTEGER, INTENT(IN) :: d2s !<
918	INTEGER, INTENT(IN) :: d3e !<
919	INTEGER, INTENT(IN) :: d3s !<
920	INTEGER, SAVE :: pe_from = 0 !<
921	INTEGER, INTENT(OUT) :: win !<
922
923	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
924	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
925
926	INTEGER, DIMENSION(3) :: buf_shape !<
927
928	REAL(dp), DIMENSION(:,:,:), POINTER :: buf !<
929	REAL(dp), DIMENSION(:,:,:), POINTER :: p3 !<
930
931	TYPE(C_PTR), SAVE :: base_ptr !<
932	TYPE(C_PTR), SAVE :: rem_ptr !<
933
934
935	IF ( this%no_shared_memory_in_this_run ) RETURN
936	!
937	!-- Allocate shared memory on node rank 0 threads.
938	IF ( this%sh_rank == pe_from ) THEN
939	wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
940	ELSE
941	wsize = 1
942	ENDIF
943
944	wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
945	! unit
946
947	CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
948	!
949	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
950	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
951	!
952	!-- Convert C- to Fortran-pointer
953	buf_shape(3) = d3e - d3s + 1
954	buf_shape(2) = d2e - d2s + 1
955	buf_shape(1) = d1e - d1s + 1
956	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
957	p3(d1s:,d2s:,d3s:) => buf
958	!
959	!-- Allocate shared memory in round robin on all PEs of a node.
960	pe_from = MOD( pe_from, this%sh_npes )
961
962	END SUBROUTINE sm_allocate_shared_3d_64
963
964
965	!--------------------------------------------------------------------------------------------------!
966	! Description:
967	! ------------
968	!> Allocate shared 3d-REAL (32 Bit) array on ALL threads
969	!--------------------------------------------------------------------------------------------------!
970	SUBROUTINE sm_allocate_shared_3d_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
971
972	IMPLICIT NONE
973
974	CLASS(sm_class), INTENT(inout) :: this
975
976	INTEGER :: disp_unit
977	INTEGER, INTENT(IN) :: d1e
978	INTEGER, INTENT(IN) :: d1s
979	INTEGER, INTENT(IN) :: d2e
980	INTEGER, INTENT(IN) :: d2s
981	INTEGER, INTENT(IN) :: d3e
982	INTEGER, INTENT(IN) :: d3s
983	INTEGER, SAVE :: pe_from = 0
984	INTEGER, INTENT(OUT) :: win
985
986	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
987	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
988
989	INTEGER, DIMENSION(3) :: buf_shape
990
991	REAL(sp), DIMENSION(:,:,:), POINTER :: buf
992	REAL(sp), DIMENSION(:,:,:), POINTER :: p3
993
994	TYPE(C_PTR), SAVE :: base_ptr
995	TYPE(C_PTR), SAVE :: rem_ptr
996
997
998	IF ( this%no_shared_memory_in_this_run ) RETURN
999	!
1000	!-- Allocate shared memory on node rank 0 threads.
1001	IF ( this%sh_rank == pe_from ) THEN
1002	wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
1003	ELSE
1004	wsize = 1
1005	ENDIF
1006
1007	wsize = wsize * sp ! Please note, size is always in bytes, independently of the displacement
1008	! unit
1009
1010	CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
1011	!
1012	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
1013	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
1014	!
1015	!-- Convert C- to Fortran-pointer
1016	buf_shape(3) = d3e - d3s + 1
1017	buf_shape(2) = d2e - d2s + 1
1018	buf_shape(1) = d1e - d1s + 1
1019	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
1020	p3(d1s:,d2s:,d3s:) => buf
1021	!
1022	!-- Allocate shared memory in round robin on all PEs of a node.
1023	pe_from = MOD( pe_from, this%sh_npes )
1024
1025	END SUBROUTINE sm_allocate_shared_3d_32
1026
1027	#endif
1028
1029
1030	!--------------------------------------------------------------------------------------------------!
1031	! Description:
1032	! ------------
1033	!> ???
1034	!--------------------------------------------------------------------------------------------------!
1035	SUBROUTINE sm_adjust_outer_boundary( this )
1036
1037	IMPLICIT NONE
1038
1039	CLASS(sm_class), INTENT(inout) :: this !<
1040
1041
1042	IF ( this%no_shared_memory_in_this_run ) RETURN
1043
1044	IF ( this%io_grid%nxl == 0 ) THEN
1045	this%io_grid%nxl = this%io_grid%nxl - nbgp
1046	this%io_grid%nnx = this%io_grid%nnx + nbgp
1047	ENDIF
1048
1049	IF ( this%io_grid%nxr == nx .OR. npex == -1 ) THEN ! npex == -1 if -D__parallel not set
1050	this%io_grid%nxr = this%io_grid%nxr + nbgp
1051	this%io_grid%nnx = this%io_grid%nnx + nbgp
1052	ENDIF
1053
1054	IF ( this%io_grid%nys == 0 ) THEN
1055	this%io_grid%nys = this%io_grid%nys - nbgp
1056	this%io_grid%nny = this%io_grid%nny + nbgp
1057	ENDIF
1058
1059	IF ( this%io_grid%nyn == ny .OR. npey == -1 ) THEN ! npey == -1 if -D__parallel not set
1060	this%io_grid%nyn = this%io_grid%nyn + nbgp
1061	this%io_grid%nny = this%io_grid%nny + nbgp
1062	ENDIF
1063
1064	this%io_grid%nxl = this%io_grid%nxl + nbgp
1065	this%io_grid%nxr = this%io_grid%nxr + nbgp
1066	this%io_grid%nys = this%io_grid%nys + nbgp
1067	this%io_grid%nyn = this%io_grid%nyn + nbgp
1068	this%io_grid%nnx = this%io_grid%nnx
1069	this%io_grid%nny = this%io_grid%nny
1070
1071	END SUBROUTINE sm_adjust_outer_boundary
1072
1073
1074	!--------------------------------------------------------------------------------------------------!
1075	! Description:
1076	! ------------
1077	!> Deallocate shared aray and free related window.
1078	!--------------------------------------------------------------------------------------------------!
1079	SUBROUTINE sm_free_shared( this, win )
1080
1081	IMPLICIT NONE
1082
1083	CLASS(sm_class), INTENT(inout) :: this !<
1084
1085	INTEGER(iwp), INTENT(INOUT) :: win !<
1086
1087	IF ( this%no_shared_memory_in_this_run ) RETURN
1088	#if defined( __parallel )
1089	CALL MPI_WIN_FREE( win, ierr )
1090	#endif
1091	win = -1
1092
1093	END SUBROUTINE sm_free_shared
1094
1095
1096	!--------------------------------------------------------------------------------------------------!
1097	! Description:
1098	! ------------
1099	!> ...
1100	!--------------------------------------------------------------------------------------------------!
1101	SUBROUTINE sm_node_barrier( this )
1102
1103	IMPLICIT NONE
1104
1105	CLASS(sm_class), INTENT(inout) :: this !<
1106
1107
1108	IF ( this%no_shared_memory_in_this_run ) RETURN
1109
1110	#if defined( __parallel )
1111	CALL MPI_BARRIER( this%comm_shared, ierr )
1112	#endif
1113
1114	END SUBROUTINE sm_node_barrier
1115
1116
1117	SUBROUTINE save_grid_into_this_class( this )
1118
1119	IMPLICIT NONE
1120
1121	CLASS(domain_decomposition_grid_features), INTENT(inout) :: this !<
1122
1123	this%myid = myid !<
1124	this%nnx = nnx !<
1125	this%nny = nny !<
1126	this%nx = nx !<
1127	this%nxl = nxl !<
1128	this%nxr = nxr !<
1129	this%ny = ny !<
1130	this%nyn = nyn !<
1131	this%nys = nys !<
1132	this%numprocs = numprocs !<
1133	this%comm2d = comm2d !<
1134
1135	END SUBROUTINE save_grid_into_this_class
1136
1137
1138	SUBROUTINE activate_grid_from_this_class( this )
1139
1140	IMPLICIT NONE
1141
1142	CLASS(domain_decomposition_grid_features), INTENT(inout) :: this !<
1143
1144	myid = this%myid !<
1145	nnx = this%nnx !<
1146	nny = this%nny !<
1147	nx = this%nx !<
1148	nxl = this%nxl !<
1149	nxr = this%nxr !<
1150	ny = this%ny !<
1151	nyn = this%nyn !<
1152	nys = this%nys !<
1153	numprocs = this%numprocs !<
1154	comm2d = this%comm2d !<
1155
1156	END SUBROUTINE activate_grid_from_this_class
1157
1158	END MODULE shared_memory_io_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |