Home

Context Navigation

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

Last change on this file since 4798 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

Rev	Line
[4534]	1	!> @file shared_memory_io_mod.f90
[4591]	2	!--------------------------------------------------------------------------------------------------!
	3	! This file is part of the PALM model system.
[4534]	4	!
[4591]	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.
[4534]	8	!
[4591]	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.
[4534]	12	!
[4591]	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/>.
[4534]	15	!
	16	! Copyright 1997-2020 Leibniz Universitaet Hannover
[4591]	17	!--------------------------------------------------------------------------------------------------!
[4534]	18	!
[4591]	19	!
[4534]	20	! Current revisions:
	21	! -----------------
[4591]	22	!
	23	!
[4534]	24	! Former revisions:
[4620]	25	! -----------------
[4534]	26	! $Id: shared_memory_io_mod.f90 4778 2020-11-09 13:40:05Z schwenkel $
[4778]	27	! additions for output of particle time series
	28	!
	29	! 4629 2020-07-29 09:37:56Z raasch
[4629]	30	! support for MPI Fortran77 interface (mpif.h) removed
	31	!
	32	! 4628 2020-07-29 07:23:03Z raasch
[4628]	33	! extensions required for MPI-I/O of particle data to restart files
	34	!
	35	! 4620 2020-07-22 14:11:16Z raasch
[4620]	36	! bugfix: variable definition changed
[4534]	37	!
[4620]	38	! 4618 2020-07-22 11:21:08Z raasch
[4618]	39	! unused variable removed
	40	!
	41	!
[4617]	42	! Additions for cyclic fill mode
	43	!
	44	!
[4591]	45	! File re-formatted to follow the PALM coding standard
[4534]	46	!
[4591]	47	!
	48	! Initial version (Klaus Ketelsen)
[4534]	49	!
[4591]	50	!
	51	!
[4534]	52	! Description:
	53	! ------------
[4591]	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	!--------------------------------------------------------------------------------------------------!
[4534]	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, &
[4591]	67	ONLY: maximum_grid_level, &
	68	message_string, &
	69	mg_switch_to_pe0_level
[4534]	70
[4591]	71
[4534]	72	USE indices, &
[4591]	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
[4534]	89
	90	USE kinds, &
[4617]	91	ONLY: dp, &
[4628]	92	idp, &
	93	isp, &
[4617]	94	iwp, &
	95	sp, &
[4591]	96	wp
[4534]	97
	98	USE pegrid, &
[4591]	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
[4534]	116	#if defined( __parallel )
	117	USE pegrid, &
[4591]	118	ONLY: pcoord, &
	119	reorder
[4534]	120	#endif
	121
	122	IMPLICIT NONE
	123
	124	PRIVATE
	125
	126	SAVE
	127
	128	!
[4617]	129	!-- Type to store information about the domain decomposition grid
	130	TYPE, PUBLIC :: domain_decomposition_grid_features !<
[4534]	131
[4617]	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 !<
[4534]	143
[4617]	144	CONTAINS
[4591]	145
[4617]	146	PROCEDURE, PASS(this), PUBLIC :: activate_grid_from_this_class
	147	PROCEDURE, PASS(this), PUBLIC :: save_grid_into_this_class
[4591]	148
[4617]	149	END TYPE domain_decomposition_grid_features
[4591]	150
[4534]	151	!
	152	!-- Class definition for shared memory instances.
	153	!-- For every use of shared memory IO, one instance of this class is created.
[4591]	154	TYPE, PUBLIC :: sm_class !<
[4534]	155
[4778]	156	INTEGER(iwp) :: nr_io_pe_per_node !< typical configuration, 2 sockets per node
[4591]	157	LOGICAL :: no_shared_Memory_in_this_run !<
[4617]	158
	159	INTEGER(iwp) :: comm_model !< communicator of this model run
[4534]	160	!
	161	!-- Variables for the shared memory communicator
[4617]	162	INTEGER(iwp), PUBLIC :: comm_shared !< communicator for processes with shared array
[4591]	163	INTEGER(iwp), PUBLIC :: sh_npes !<
	164	INTEGER(iwp), PUBLIC :: sh_rank !<
[4534]	165
	166	LOGICAL, PUBLIC :: iam_io_pe = .TRUE. !< This PE is an IO-PE
	167	!
	168	!-- Variables for the I/O virtual grid
[4591]	169	INTEGER(iwp), PUBLIC :: comm_io !< Communicator for all IO processes
	170	INTEGER(iwp), PUBLIC :: io_npes !<
	171	INTEGER(iwp), PUBLIC :: io_rank !<
[4534]	172	!
	173	!-- Variables for the node local communicator
[4591]	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 !<
[4534]	178
[4617]	179	TYPE(domain_decomposition_grid_features), PUBLIC :: io_grid !< io grid features, depending on reading from prerun or restart run
[4534]	180
	181
[4617]	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
[4778]	190	PROCEDURE, PASS(this), PUBLIC :: sm_init_data_output_particles
[4617]	191	PROCEDURE, PASS(this), PUBLIC :: sm_node_barrier
[4534]	192	#if defined( __parallel )
[4617]	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
[4628]	201	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3di_32
	202	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3di_64
[4534]	203
[4617]	204	GENERIC, PUBLIC :: sm_allocate_shared => &
[4628]	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
[4534]	210	#endif
	211	END TYPE sm_class
	212
	213
[4591]	214	CONTAINS
[4534]	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	!--------------------------------------------------------------------------------------------------!
[4617]	223	SUBROUTINE sm_init_comm( this, sm_active, comm_input )
[4534]	224
	225	IMPLICIT NONE
	226
[4617]	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
[4534]	229
	230	#if defined( __parallel )
[4617]	231	INTEGER :: color
	232	INTEGER :: max_n_npes !< maximum number of PEs/node
[4534]	233	#endif
	234
[4617]	235	LOGICAL, INTENT(IN) :: sm_active !< flag to activate shared-memory IO
[4534]	236
[4778]	237	this%nr_io_pe_per_node = 2
	238
[4617]	239	IF ( PRESENT( comm_input ) ) THEN
	240	this%comm_model = comm_input
	241	ELSE
	242	this%comm_model = comm2d
	243	ENDIF
[4534]	244
	245	this%no_shared_memory_in_this_run = .NOT. sm_active
[4617]	246	this%comm_io = this%comm_model ! preset in case of non shared-memory-IO
[4534]	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.
[4617]	257	CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &
	258	this%comm_node, ierr )
[4534]	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
[4617]	262	CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, this%comm_model, ierr )
[4534]	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
[4617]	303	CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
[4534]	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
[4617]	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
[4534]	326	#if defined( __parallel )
	327	CONTAINS
	328
	329	SUBROUTINE compute_color( color )
	330
	331	IMPLICIT NONE
	332
[4591]	333	INTEGER(iwp), INTENT(OUT) :: color !<
[4534]	334
[4591]	335	INTEGER(iwp) :: group_start !<
	336	INTEGER(iwp) :: my_color !<
	337	INTEGER(iwp) :: n !<
	338	INTEGER(iwp) :: pe !<
	339	INTEGER(iwp) :: sh_group_size !<
[4534]	340
[4591]	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 !<
[4534]	343
[4617]	344	TYPE(domain_decomposition_grid_features), DIMENSION(32) :: node_grid !<
[4534]	345
[4536]	346	!
[4591]	347	!-- No shared memory I/O on one node jobs
[4536]	348	IF ( numprocs < this%n_npes ) THEN
	349	this%no_shared_memory_in_this_run = .TRUE.
[4534]	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
[4536]	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
[4534]	414	END SUBROUTINE compute_color
	415	#endif
	416
	417	END SUBROUTINE sm_init_comm
	418
	419
[4617]	420	!
[4778]	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 )
[4534]	424
[4617]	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
[4620]	433	#endif
[4617]	434
	435	LOGICAL :: sm_active !<
	436
	437
[4778]	438	this%nr_io_pe_per_node = 2
	439
[4617]	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'
[4778]	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'
[4617]	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
[4778]	550	END SUBROUTINE sm_init_data_output_particles
[4617]	551
[4534]	552	!--------------------------------------------------------------------------------------------------!
	553	! Description:
	554	! ------------
	555	!> Function to return if shared Memory IO is active.
	556	!--------------------------------------------------------------------------------------------------!
[4591]	557	FUNCTION is_sm_active( this ) RESULT( ac )
[4534]	558
	559	IMPLICIT NONE
	560
[4591]	561	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	562
[4591]	563	LOGICAL :: ac !<
[4534]	564
	565	ac = .NOT. this%no_shared_memory_in_this_run
	566
	567	END FUNCTION is_sm_active
	568
	569
	570	#if defined( __parallel )
[4617]	571
[4534]	572	!--------------------------------------------------------------------------------------------------!
	573	! Description:
	574	! ------------
[4617]	575	!> Allocate shared 1d-REAL (64 Bit) array on ALL threads
[4534]	576	!--------------------------------------------------------------------------------------------------!
[4617]	577	SUBROUTINE sm_allocate_shared_1d_64( this, p1, d1, d2, win )
[4534]	578
	579	IMPLICIT NONE
	580
[4617]	581	CLASS(sm_class), INTENT(inout) :: this
[4534]	582
[4617]	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
[4534]	588
[4617]	589	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
	590	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
[4534]	591
[4617]	592	INTEGER, DIMENSION(1) :: buf_shape
[4534]	593
[4617]	594	REAL(dp), DIMENSION(:), POINTER :: buf
	595	REAL(dp), DIMENSION(:), POINTER :: p1
[4534]	596
[4617]	597	TYPE(C_PTR), SAVE :: base_ptr
	598	TYPE(C_PTR), SAVE :: rem_ptr
	599
	600
[4534]	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
[4617]	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
[4534]	666	! unit
	667
[4617]	668	CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
[4534]	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
[4617]	681	END SUBROUTINE sm_allocate_shared_1d_32
[4534]	682
	683
	684	!--------------------------------------------------------------------------------------------------!
	685	! Description:
	686	! ------------
[4617]	687	!> Allocate shared 1d-INTEGER array on ALL threads
[4534]	688	!--------------------------------------------------------------------------------------------------!
[4617]	689	SUBROUTINE sm_allocate_shared_1di( this, p1, d1, d2, win )
[4534]	690
	691	IMPLICIT NONE
	692
[4617]	693	CLASS(sm_class), INTENT(inout) :: this
[4534]	694
[4617]	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
[4534]	700
[4617]	701	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size
	702	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize
[4534]	703
[4617]	704	INTEGER, DIMENSION(1) :: buf_shape
[4534]	705
[4617]	706	INTEGER(iwp), DIMENSION(:), POINTER :: buf
	707	INTEGER(iwp), DIMENSION(:), POINTER :: p1
[4534]	708
[4617]	709	TYPE(C_PTR), SAVE :: base_ptr
	710	TYPE(C_PTR), SAVE :: rem_ptr
[4534]	711
[4617]	712
[4534]	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
[4617]	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
[4534]	775	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
	776	ELSE
	777	wsize = 1
	778	ENDIF
	779
[4617]	780	wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
	781	! unit
[4534]	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
[4617]	797	END SUBROUTINE sm_allocate_shared_2d_64
[4534]	798
	799
	800	!--------------------------------------------------------------------------------------------------!
	801	! Description:
	802	! ------------
[4617]	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	! ------------
[4534]	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
[4591]	869	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	870
[4591]	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 !<
[4617]	877	INTEGER(iwp), INTENT(OUT) :: win !<
	878
[4591]	879	INTEGER(kind=MPI_ADDRESS_KIND) :: rem_size !<
	880	INTEGER(kind=MPI_ADDRESS_KIND) :: wsize !<
[4534]	881
[4591]	882	INTEGER(iwp), DIMENSION(2) :: buf_shape !<
[4534]	883
[4591]	884	INTEGER(iwp), DIMENSION(:,:), POINTER :: buf !<
	885	INTEGER(iwp), DIMENSION(:,:), POINTER :: p2i !<
[4534]	886
[4617]	887	TYPE(C_PTR), SAVE :: base_ptr !<
	888	TYPE(C_PTR), SAVE :: rem_ptr !<
[4534]	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	! ------------
[4617]	923	!> Allocate shared 3d-REAL (64 Bit) array on ALL threads
[4534]	924	!--------------------------------------------------------------------------------------------------!
[4617]	925	SUBROUTINE sm_allocate_shared_3d_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
[4534]	926
	927	IMPLICIT NONE
	928
[4591]	929	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	930
[4591]	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 !<
[4617]	939	INTEGER, INTENT(OUT) :: win !<
	940
[4591]	941	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
	942	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
[4534]	943
[4591]	944	INTEGER, DIMENSION(3) :: buf_shape !<
[4534]	945
[4617]	946	REAL(dp), DIMENSION(:,:,:), POINTER :: buf !<
	947	REAL(dp), DIMENSION(:,:,:), POINTER :: p3 !<
[4534]	948
[4591]	949	TYPE(C_PTR), SAVE :: base_ptr !<
	950	TYPE(C_PTR), SAVE :: rem_ptr !<
[4534]	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
[4617]	962	wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
[4534]	963	! unit
	964
[4617]	965	CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
[4534]	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
[4617]	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
[4628]	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
[4534]	1171	#endif
	1172
	1173
	1174	!--------------------------------------------------------------------------------------------------!
	1175	! Description:
	1176	! ------------
	1177	!> ???
	1178	!--------------------------------------------------------------------------------------------------!
	1179	SUBROUTINE sm_adjust_outer_boundary( this )
	1180
	1181	IMPLICIT NONE
	1182
[4591]	1183	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	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
[4591]	1227	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	1228
[4591]	1229	INTEGER(iwp), INTENT(INOUT) :: win !<
[4534]	1230
[4617]	1231	IF ( this%no_shared_memory_in_this_run ) RETURN
[4534]	1232	#if defined( __parallel )
	1233	CALL MPI_WIN_FREE( win, ierr )
	1234	#endif
[4617]	1235	win = -1
[4534]	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
[4591]	1249	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	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
[4617]	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
[4534]	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 |