Home

Context Navigation

shared_memory_io_mod.f90 @ 4896

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: