Home

Context Navigation

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

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