Home

Context Navigation

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

Last change on this file since 4628 was 4628, checked in by raasch, 4 years ago
extensions required for MPI-I/O of particle data to restart files
Property svn:keywords set to `Id`
File size: 46.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |