Home

Context Navigation

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

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