Home

Context Navigation

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

Last change on this file since 4598 was 4591, checked in by raasch, 4 years ago
files re-formatted to follow the PALM coding standard
Property svn:keywords set to `Id`
File size: 26.6 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 4591 2020-07-06 15:56:08Z suehring $
26	!
27	! File re-formatted to follow the PALM coding standard
28	!
29	!
30	!
31	! Initial version (Klaus Ketelsen)
32	!
33	!
34	!
35	! Description:
36	! ------------
37	!> Handle MPI-IO or NetCDF-IO shared memory arrays.
38	!> This module performs the organization of new communicators, adapted PE-grids and allocation of
39	!> shared memory arrays. The IO itself is not done here.
40	!--------------------------------------------------------------------------------------------------!
41	MODULE shared_memory_io_mod
42
43	#if defined( __parallel )
44	#if defined( __mpifh )
45	INCLUDE "mpif.h"
46	#else
47	USE MPI
48	#endif
49	#endif
50
51	USE, INTRINSIC :: ISO_C_BINDING
52
53	USE control_parameters, &
54	ONLY: maximum_grid_level, &
55	message_string, &
56	mg_switch_to_pe0_level
57
58
59	USE indices, &
60	ONLY: nbgp, &
61	nnx, &
62	nny, &
63	nnz, &
64	nx, &
65	nxl, &
66	nxlg, &
67	nxr, &
68	nxrg, &
69	ny, &
70	nyn, &
71	nyng, &
72	nys, &
73	nysg, &
74	nzb, &
75	nzt
76
77	USE kinds, &
78	ONLY: iwp, &
79	wp
80
81
82	USE transpose_indices, &
83	ONLY: nxl_z, &
84	nxr_z, &
85	nyn_x, &
86	nyn_z, &
87	nys_x, &
88	nys_z
89
90
91
92	USE pegrid, &
93	ONLY: comm1dx, &
94	comm1dy, &
95	comm2d, &
96	ierr, &
97	myid, &
98	myidx, &
99	myidy, &
100	npex, &
101	npey, &
102	numprocs, &
103	pdims, &
104	pleft, &
105	pnorth, &
106	pright, &
107	psouth, &
108	sendrecvcount_xy
109
110	#if defined( __parallel )
111	USE pegrid, &
112	ONLY: pcoord, &
113	reorder
114	#endif
115
116	IMPLICIT NONE
117
118	PRIVATE
119
120	SAVE
121
122	!
123	!-- Type to store grid information
124	TYPE, PUBLIC :: local_boundaries !<
125
126	INTEGER(iwp) :: nnx !<
127	INTEGER(iwp) :: nny !<
128	INTEGER(iwp) :: nx !<
129	INTEGER(iwp) :: nxl !<
130	INTEGER(iwp) :: nxr !<
131	INTEGER(iwp) :: ny !<
132	INTEGER(iwp) :: nyn !<
133	INTEGER(iwp) :: nys !<
134
135
136
137
138	END TYPE local_boundaries
139
140	!
141	!-- Class definition for shared memory instances.
142	!-- For every use of shared memory IO, one instance of this class is created.
143	TYPE, PUBLIC :: sm_class !<
144
145	INTEGER(iwp) :: nr_io_pe_per_node = 2 !< typical configuration, 2 sockets per node
146	LOGICAL :: no_shared_Memory_in_this_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	TYPE( local_boundaries ), PUBLIC :: io_grid
161
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	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_node_barrier !<
178	#if defined( __parallel )
179	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_1d !<
180	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2d !<
181	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2di !<
182	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3d !<
183
184	GENERIC, PUBLIC :: sm_allocate_shared => sm_allocate_shared_1d, sm_allocate_shared_2d, &
185	sm_allocate_shared_2di, sm_allocate_shared_3d !<
186	#endif
187	END TYPE sm_class
188
189
190	CONTAINS
191
192
193	!--------------------------------------------------------------------------------------------------!
194	! Description:
195	! ------------
196	!> Create the communicator for shared memory groups and IO-PEs.
197	!> Setup the grid for shared memory IO.
198	!--------------------------------------------------------------------------------------------------!
199	SUBROUTINE sm_init_comm( this, sm_active )
200
201	IMPLICIT NONE
202
203	CLASS(sm_class), INTENT(INOUT) :: this !< pointer to access internal variables of this call
204
205	#if defined( __parallel )
206	INTEGER :: color !<
207	INTEGER :: max_n_npes !< Maximum number of PEs/node
208	#endif
209
210	LOGICAL, INTENT(IN) :: sm_active !< Flag to activate shared-memory IO
211
212
213	this%no_shared_memory_in_this_run = .NOT. sm_active
214
215	IF ( this%no_shared_memory_in_this_run ) THEN
216	this%iam_io_pe = .TRUE.
217	RETURN
218	ENDIF
219
220	#if defined( __parallel )
221	!
222	!-- Determine, how many MPI threads are running on a node
223	this%iam_io_pe = .FALSE.
224	CALL MPI_COMM_SPLIT_TYPE( comm2d, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, this%comm_node, ierr )
225	CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
226	CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
227
228	CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
229	!
230	!-- Decide, if the configuration can run with shared-memory IO
231	IF ( max_n_npes > 64 ) THEN
232	!
233	!-- Special configuration on the HLRN-IV system with 4 shared memory blocks/node
234	this%nr_io_pe_per_node = 4
235
236	ELSEIF ( max_n_npes <= 32 ) THEN
237	!
238	!-- No shared memory IO with less than 32 threads/node
239	this%no_shared_memory_in_this_run = .TRUE.
240	this%iam_io_pe = .TRUE.
241	RETURN
242	ENDIF
243
244	!
245	!-- No shared memory IO with small setups
246	IF ( nx < 24 .OR. ny < 24 ) THEN
247	this%no_shared_memory_in_this_run = .TRUE.
248	this%iam_io_pe = .TRUE.
249	RETURN
250	ENDIF
251
252	!
253	!-- Divide a node into shared memory groups, depending on the virtual x-y grid
254	CALL compute_color( color )
255	!
256	!-- If no shared memory IO possible, nothing is left to be done here.
257	IF ( this%no_shared_memory_in_this_run ) RETURN
258
259	!
260	!-- Setup the shared memory area
261	CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
262	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
263	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
264
265	!
266	!-- Setup the communicator across the nodes depending on the shared memory rank.
267	!-- All threads with shared memory rank 0 will be I/O threads.
268	color = this%sh_rank
269	CALL MPI_COMM_SPLIT( comm2d, color, 0, this%comm_io, ierr )
270
271	IF ( this%comm_io /= MPI_COMM_NULL ) THEN
272	CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
273	CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
274	ELSE
275	this%io_npes = -1
276	this%io_rank = -1
277	ENDIF
278
279	IF ( this%sh_rank == 0 ) THEN
280	this%iam_io_pe = .TRUE.
281	this%io_pe_global_rank = myid
282	ENDIF
283	CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
284
285	#else
286	this%iam_io_pe = .TRUE.
287	#endif
288
289	#if defined( __parallel )
290	CONTAINS
291
292	SUBROUTINE compute_color( color )
293
294	IMPLICIT NONE
295
296	INTEGER(iwp), INTENT(OUT) :: color !<
297
298	INTEGER(iwp) :: group_start !<
299	INTEGER(iwp) :: my_color !<
300	INTEGER(iwp) :: n !<
301	INTEGER(iwp) :: pe !<
302	INTEGER(iwp) :: sh_group_size !<
303
304	INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) :: local_dim_s !<
305	INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) :: local_dim_r !<
306
307	TYPE(local_boundaries), DIMENSION(32) :: node_grid !<
308
309	!
310	!-- No shared memory I/O on one node jobs
311	IF ( numprocs < this%n_npes ) THEN
312	this%no_shared_memory_in_this_run = .TRUE.
313	RETURN
314	ENDIF
315
316	local_dim_s = 0
317	local_dim_s(1,this%n_rank) = nxl
318	local_dim_s(2,this%n_rank) = nxr
319	local_dim_s(3,this%n_rank) = nys
320	local_dim_s(4,this%n_rank) = nyn
321
322	node_grid%nyn = -1
323	!
324	!-- Distribute the x-y layout of all cores of a node to all node processes
325	CALL MPI_ALLREDUCE( local_dim_s, local_dim_r, SIZE( local_dim_s ), MPI_INTEGER, MPI_SUM, &
326	this%comm_node, ierr )
327	sh_group_size = ( max_n_npes + this%nr_io_pe_per_node - 1 ) / this%nr_io_pe_per_node
328
329	pe = 0
330	my_color = 1 ! color is used to split the shared memory communicator into a communicator for
331	! io groups
332	group_start = pe
333	node_grid(my_color)%nxl = local_dim_r(1,group_start)
334	node_grid(my_color)%nxr = local_dim_r(2,group_start)
335	node_grid(my_color)%nys = local_dim_r(3,group_start)
336
337	DO n = 1, this%n_npes-1
338
339	pe = n
340	IF ( n > 0 .AND. MOD( n,sh_group_size ) == 0 ) THEN
341	!
342	!-- If group boundary, start new IO group
343	node_grid(my_color)%nyn = local_dim_r(4,pe-1)
344	my_color = my_color + 1
345	group_start = pe
346	node_grid(my_color)%nxl = local_dim_r(1,group_start)
347	node_grid(my_color)%nxr = local_dim_r(2,group_start)
348	node_grid(my_color)%nys = local_dim_r(3,group_start)
349
350	ELSEIF ( local_dim_r(1,pe) /= node_grid(my_color)%nxl ) THEN
351	!
352	!-- If nxl changes, start new IO group
353	node_grid(my_color)%nyn = local_dim_r(4,pe-1)
354	my_color = my_color+1
355	group_start = pe
356	node_grid(my_color)%nxl = local_dim_r(1,group_start)
357	node_grid(my_color)%nxr = local_dim_r(2,group_start)
358	node_grid(my_color)%nys = local_dim_r(3,group_start)
359	ENDIF
360	!
361	!-- Save values for local PE
362	IF ( this%n_rank == pe ) THEN !
363	color = my_color
364	ENDIF
365	IF ( n == this%n_npes-1 ) node_grid(my_color)%nyn = local_dim_r(4,pe)
366
367	ENDDO
368
369	IF ( this%n_rank == 0 ) THEN
370	color = 1
371	ENDIF
372
373	this%io_grid = node_grid(color)
374	this%io_grid%nnx = this%io_grid%nxr - this%io_grid%nxl + 1
375	this%io_grid%nny = this%io_grid%nyn - this%io_grid%nys + 1
376
377	END SUBROUTINE compute_color
378	#endif
379
380	END SUBROUTINE sm_init_comm
381
382
383
384	!--------------------------------------------------------------------------------------------------!
385	! Description:
386	! ------------
387	!> Function to return if shared Memory IO is active.
388	!--------------------------------------------------------------------------------------------------!
389	FUNCTION is_sm_active( this ) RESULT( ac )
390
391	IMPLICIT NONE
392
393	CLASS(sm_class), INTENT(inout) :: this !<
394
395	LOGICAL :: ac !<
396
397	ac = .NOT. this%no_shared_memory_in_this_run
398
399	END FUNCTION is_sm_active
400
401
402	#if defined( __parallel )
403	!--------------------------------------------------------------------------------------------------!
404	! Description:
405	! ------------
406	!> Allocate shared 1d-REAL array on ALL threads
407	!--------------------------------------------------------------------------------------------------!
408	SUBROUTINE sm_allocate_shared_1d( this, p1, d1, d2, win )
409
410	IMPLICIT NONE
411
412	CLASS(sm_class), INTENT(inout) :: this !<
413	!<
414	INTEGER(iwp) :: disp_unit !<
415	INTEGER(iwp), INTENT(IN) :: d1 !<
416	INTEGER(iwp), INTENT(IN) :: d2 !<
417	INTEGER(iwp), SAVE :: pe_from = 0 !<
418	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
419	INTEGER(iwp), INTENT(OUT) :: win !<
420	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
421
422	INTEGER, DIMENSION(1) :: buf_shape !<
423
424	REAL(wp), DIMENSION(:), POINTER :: buf !<
425	REAL(wp), DIMENSION(:), POINTER :: p1 !<
426
427	TYPE(C_PTR), SAVE :: base_ptr !<
428	TYPE(C_PTR), SAVE :: rem_ptr !<
429
430
431	IF ( this%no_shared_memory_in_this_run ) RETURN
432	!
433	!-- Allocate shared memory on node rank 0 threads.
434	IF ( this%sh_rank == pe_from ) THEN
435	wsize = d2 - d1 + 1
436	ELSE
437	wsize = 1
438	ENDIF
439	wsize = wsize * 8 ! Please note, size is always in bytes, independently of the displacement
440	! unit
441
442	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
443	!
444	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
445	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
446	!
447	!-- Convert C- to Fortran-pointer
448	buf_shape(1) = d2 - d1 + 1
449	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
450	p1(d1:) => buf
451	!
452	!-- Allocate shared memory in round robin on all PEs of a node.
453	pe_from = MOD( pe_from, this%sh_npes )
454
455	END SUBROUTINE sm_allocate_shared_1d
456
457
458	!--------------------------------------------------------------------------------------------------!
459	! Description:
460	! ------------
461	!> Allocate shared 2d-REAL array on ALL threads
462	!--------------------------------------------------------------------------------------------------!
463	SUBROUTINE sm_allocate_shared_2d( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
464
465	IMPLICIT NONE
466
467	CLASS(sm_class), INTENT(INOUT) :: this !<
468
469	INTEGER(iwp) :: disp_unit !<
470	INTEGER(iwp), INTENT(IN) :: n_nxlg !<
471	INTEGER(iwp), INTENT(IN) :: n_nxrg !<
472	INTEGER(iwp), INTENT(IN) :: n_nyng !<
473	INTEGER(iwp), INTENT(IN) :: n_nysg !<
474	INTEGER(iwp), SAVE :: pe_from = 0 !<
475	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
476	INTEGER(iwp), INTENT(OUT) :: win !<
477	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
478
479	INTEGER(iwp), DIMENSION(2) :: buf_shape !<
480
481	REAL(wp), DIMENSION(:,:), POINTER :: buf !<
482	REAL(wp), DIMENSION(:,:), POINTER :: p2 !<
483
484	TYPE(C_PTR),SAVE :: base_ptr !<
485	TYPE(C_PTR),SAVE :: rem_ptr !<
486
487
488	IF ( this%no_shared_memory_in_this_run ) RETURN
489	!
490	!-- Allocate shared memory on node rank 0 threads.
491	IF ( this%sh_rank == pe_from ) THEN
492	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
493	ELSE
494	wsize = 1
495	ENDIF
496
497	wsize = wsize * 8 ! Please note, size is always in bytes, independently of the displacement
498	! unit
499
500	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
501	!
502	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
503	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
504	!
505	!-- Convert C- to Fortran-pointer
506	buf_shape(2) = n_nyng - n_nysg + 1
507	buf_shape(1) = n_nxrg - n_nxlg + 1
508	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
509	p2(n_nxlg:, n_nysg:) => buf
510	!
511	!-- Allocate shared memory in round robin on all PEs of a node.
512	pe_from = MOD( pe_from, this%sh_npes )
513
514	END SUBROUTINE sm_allocate_shared_2d
515
516
517	!--------------------------------------------------------------------------------------------------!
518	! Description:
519	! ------------
520	!> Allocate shared 2d-INTEGER array on ALL threads
521	!--------------------------------------------------------------------------------------------------!
522	SUBROUTINE sm_allocate_shared_2di( this, p2i, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
523
524	IMPLICIT NONE
525
526	CLASS(sm_class), INTENT(inout) :: this !<
527
528	INTEGER(iwp) :: disp_unit !<
529	INTEGER(iwp), INTENT(IN) :: n_nxlg !<
530	INTEGER(iwp), INTENT(IN) :: n_nxrg !<
531	INTEGER(iwp), INTENT(IN) :: n_nyng !<
532	INTEGER(iwp), INTENT(IN) :: n_nysg !<
533	INTEGER(iwp), SAVE :: pe_from = 0 !<
534	INTEGER(kind=MPI_ADDRESS_KIND) :: rem_size !<
535	INTEGER(iwp), INTENT(OUT) :: win !<
536	INTEGER(kind=MPI_ADDRESS_KIND) :: wsize !<
537
538	INTEGER(iwp), DIMENSION(2) :: buf_shape !<
539
540	INTEGER(iwp), DIMENSION(:,:), POINTER :: buf !<
541	INTEGER(iwp), DIMENSION(:,:), POINTER :: p2i !<
542
543	TYPE(C_PTR),SAVE :: base_ptr !<
544	TYPE(C_PTR),SAVE :: rem_ptr !<
545
546
547	IF ( this%no_shared_memory_in_this_run ) RETURN
548	!
549	!-- Allocate shared memory on node rank 0 threads.
550	IF ( this%sh_rank == pe_from ) THEN
551	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
552	ELSE
553	wsize = 1
554	ENDIF
555
556	wsize = wsize * 4 ! Please note, size is always in bytes, independently of the displacement
557	! unit
558
559	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 4, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
560	!
561	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
562	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
563	!
564	!-- Convert C- to Fortran-pointer
565	buf_shape(2) = n_nyng - n_nysg + 1
566	buf_shape(1) = n_nxrg - n_nxlg + 1
567	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
568	p2i(n_nxlg:, n_nysg:) => buf
569	!
570	!-- Allocate shared memory in round robin on all PEs of a node.
571	pe_from = MOD( pe_from, this%sh_npes )
572
573	END SUBROUTINE sm_allocate_shared_2di
574
575
576	!--------------------------------------------------------------------------------------------------!
577	! Description:
578	! ------------
579	!> Allocate shared 3d-REAL array on ALL threads
580	!--------------------------------------------------------------------------------------------------!
581	SUBROUTINE sm_allocate_shared_3d( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
582
583	IMPLICIT NONE
584
585	CLASS(sm_class), INTENT(inout) :: this !<
586
587	INTEGER :: disp_unit !<
588	INTEGER, INTENT(IN) :: d1e !<
589	INTEGER, INTENT(IN) :: d1s !<
590	INTEGER, INTENT(IN) :: d2e !<
591	INTEGER, INTENT(IN) :: d2s !<
592	INTEGER, INTENT(IN) :: d3e !<
593	INTEGER, INTENT(IN) :: d3s !<
594	INTEGER, SAVE :: pe_from = 0 !<
595	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
596	INTEGER, INTENT(OUT) :: win !<
597	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
598
599	INTEGER, DIMENSION(3) :: buf_shape !<
600
601	REAL(wp), DIMENSION(:,:,:), POINTER :: buf !<
602	REAL(wp), DIMENSION(:,:,:), POINTER :: p3 !<
603
604	TYPE(C_PTR), SAVE :: base_ptr !<
605	TYPE(C_PTR), SAVE :: rem_ptr !<
606
607
608	IF ( this%no_shared_memory_in_this_run ) RETURN
609	!
610	!-- Allocate shared memory on node rank 0 threads.
611	IF ( this%sh_rank == pe_from ) THEN
612	wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
613	ELSE
614	wsize = 1
615	ENDIF
616
617	wsize = wsize * 8 ! Please note, size is always in bytes, independently of the displacement
618	! unit
619
620	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
621	!
622	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
623	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
624	!
625	!-- Convert C- to Fortran-pointer
626	buf_shape(3) = d3e - d3s + 1
627	buf_shape(2) = d2e - d2s + 1
628	buf_shape(1) = d1e - d1s + 1
629	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
630	p3(d1s:,d2s:,d3s:) => buf
631	!
632	!-- Allocate shared memory in round robin on all PEs of a node.
633	pe_from = MOD( pe_from, this%sh_npes )
634
635	END SUBROUTINE sm_allocate_shared_3d
636	#endif
637
638
639	!--------------------------------------------------------------------------------------------------!
640	! Description:
641	! ------------
642	!> ???
643	!--------------------------------------------------------------------------------------------------!
644	SUBROUTINE sm_adjust_outer_boundary( this )
645
646	IMPLICIT NONE
647
648	CLASS(sm_class), INTENT(inout) :: this !<
649
650
651	IF ( this%no_shared_memory_in_this_run ) RETURN
652
653	IF ( this%io_grid%nxl == 0 ) THEN
654	this%io_grid%nxl = this%io_grid%nxl - nbgp
655	this%io_grid%nnx = this%io_grid%nnx + nbgp
656	ENDIF
657
658	IF ( this%io_grid%nxr == nx .OR. npex == -1 ) THEN ! npex == -1 if -D__parallel not set
659	this%io_grid%nxr = this%io_grid%nxr + nbgp
660	this%io_grid%nnx = this%io_grid%nnx + nbgp
661	ENDIF
662
663	IF ( this%io_grid%nys == 0 ) THEN
664	this%io_grid%nys = this%io_grid%nys - nbgp
665	this%io_grid%nny = this%io_grid%nny + nbgp
666	ENDIF
667
668	IF ( this%io_grid%nyn == ny .OR. npey == -1 ) THEN ! npey == -1 if -D__parallel not set
669	this%io_grid%nyn = this%io_grid%nyn + nbgp
670	this%io_grid%nny = this%io_grid%nny + nbgp
671	ENDIF
672
673	this%io_grid%nxl = this%io_grid%nxl + nbgp
674	this%io_grid%nxr = this%io_grid%nxr + nbgp
675	this%io_grid%nys = this%io_grid%nys + nbgp
676	this%io_grid%nyn = this%io_grid%nyn + nbgp
677	this%io_grid%nnx = this%io_grid%nnx
678	this%io_grid%nny = this%io_grid%nny
679
680	END SUBROUTINE sm_adjust_outer_boundary
681
682
683	!--------------------------------------------------------------------------------------------------!
684	! Description:
685	! ------------
686	!> Deallocate shared aray and free related window.
687	!--------------------------------------------------------------------------------------------------!
688	SUBROUTINE sm_free_shared( this, win )
689
690	IMPLICIT NONE
691
692	CLASS(sm_class), INTENT(inout) :: this !<
693
694	INTEGER(iwp), INTENT(INOUT) :: win !<
695
696	IF ( this%no_shared_memory_in_this_run .OR. win == -1234567890 ) RETURN
697	! win is used just to avoid compile errors because of unused arguments
698	#if defined( __parallel )
699	CALL MPI_WIN_FREE( win, ierr )
700	#endif
701
702	END SUBROUTINE sm_free_shared
703
704
705	!--------------------------------------------------------------------------------------------------!
706	! Description:
707	! ------------
708	!> ...
709	!--------------------------------------------------------------------------------------------------!
710	SUBROUTINE sm_node_barrier( this )
711
712	IMPLICIT NONE
713
714	CLASS(sm_class), INTENT(inout) :: this !<
715
716
717	IF ( this%no_shared_memory_in_this_run ) RETURN
718
719	#if defined( __parallel )
720	CALL MPI_BARRIER( this%comm_shared, ierr )
721	#endif
722
723	END SUBROUTINE sm_node_barrier
724
725	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 |