Home

Context Navigation

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

Last change on this file since 4534 was 4534, checked in by raasch, 4 years ago
I/O on reduced number of cores added (using shared memory MPI)
Property svn:keywords set to `Id`
File size: 21.9 KB

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