Home

Context Navigation

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

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