Home

Context Navigation

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

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