Home

Context Navigation

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

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