Home

Context Navigation

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

Last change on this file since 4596 was 4591, checked in by raasch, 4 years ago
files re-formatted to follow the PALM coding standard
Property svn:keywords set to `Id`
File size: 26.6 KB

Rev	Line
[4534]	1	!> @file shared_memory_io_mod.f90
[4591]	2	!--------------------------------------------------------------------------------------------------!
	3	! This file is part of the PALM model system.
[4534]	4	!
[4591]	5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
	6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
	7	! (at your option) any later version.
[4534]	8	!
[4591]	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
	10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
	11	! Public License for more details.
[4534]	12	!
[4591]	13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
	14	! <http://www.gnu.org/licenses/>.
[4534]	15	!
	16	! Copyright 1997-2020 Leibniz Universitaet Hannover
[4591]	17	!--------------------------------------------------------------------------------------------------!
[4534]	18	!
[4591]	19	!
[4534]	20	! Current revisions:
	21	! -----------------
[4591]	22	!
	23	!
[4534]	24	! Former revisions:
	25	! $Id: shared_memory_io_mod.f90 4591 2020-07-06 15:56:08Z suehring $
	26	!
[4591]	27	! File re-formatted to follow the PALM coding standard
[4534]	28	!
[4591]	29	!
[4534]	30	!
[4591]	31	! Initial version (Klaus Ketelsen)
[4534]	32	!
[4591]	33	!
	34	!
[4534]	35	! Description:
	36	! ------------
[4591]	37	!> Handle MPI-IO or NetCDF-IO shared memory arrays.
	38	!> This module performs the organization of new communicators, adapted PE-grids and allocation of
	39	!> shared memory arrays. The IO itself is not done here.
	40	!--------------------------------------------------------------------------------------------------!
[4534]	41	MODULE shared_memory_io_mod
	42
	43	#if defined( __parallel )
	44	#if defined( __mpifh )
	45	INCLUDE "mpif.h"
	46	#else
	47	USE MPI
	48	#endif
	49	#endif
	50
	51	USE, INTRINSIC :: ISO_C_BINDING
	52
	53	USE control_parameters, &
[4591]	54	ONLY: maximum_grid_level, &
	55	message_string, &
	56	mg_switch_to_pe0_level
[4534]	57
[4591]	58
[4534]	59	USE indices, &
[4591]	60	ONLY: nbgp, &
	61	nnx, &
	62	nny, &
	63	nnz, &
	64	nx, &
	65	nxl, &
	66	nxlg, &
	67	nxr, &
	68	nxrg, &
	69	ny, &
	70	nyn, &
	71	nyng, &
	72	nys, &
	73	nysg, &
	74	nzb, &
	75	nzt
[4534]	76
	77	USE kinds, &
[4591]	78	ONLY: iwp, &
	79	wp
[4534]	80
[4591]	81
[4534]	82	USE transpose_indices, &
[4591]	83	ONLY: nxl_z, &
	84	nxr_z, &
	85	nyn_x, &
	86	nyn_z, &
	87	nys_x, &
	88	nys_z
[4534]	89
[4591]	90
	91
[4534]	92	USE pegrid, &
[4591]	93	ONLY: comm1dx, &
	94	comm1dy, &
	95	comm2d, &
	96	ierr, &
	97	myid, &
	98	myidx, &
	99	myidy, &
	100	npex, &
	101	npey, &
	102	numprocs, &
	103	pdims, &
	104	pleft, &
	105	pnorth, &
	106	pright, &
	107	psouth, &
	108	sendrecvcount_xy
	109
[4534]	110	#if defined( __parallel )
	111	USE pegrid, &
[4591]	112	ONLY: pcoord, &
	113	reorder
[4534]	114	#endif
	115
	116	IMPLICIT NONE
	117
	118	PRIVATE
	119
	120	SAVE
	121
	122	!
	123	!-- Type to store grid information
[4591]	124	TYPE, PUBLIC :: local_boundaries !<
[4534]	125
[4591]	126	INTEGER(iwp) :: nnx !<
	127	INTEGER(iwp) :: nny !<
	128	INTEGER(iwp) :: nx !<
	129	INTEGER(iwp) :: nxl !<
	130	INTEGER(iwp) :: nxr !<
	131	INTEGER(iwp) :: ny !<
	132	INTEGER(iwp) :: nyn !<
	133	INTEGER(iwp) :: nys !<
[4534]	134
[4591]	135
	136
	137
[4534]	138	END TYPE local_boundaries
	139
	140	!
	141	!-- Class definition for shared memory instances.
	142	!-- For every use of shared memory IO, one instance of this class is created.
[4591]	143	TYPE, PUBLIC :: sm_class !<
[4534]	144
[4591]	145	INTEGER(iwp) :: nr_io_pe_per_node = 2 !< typical configuration, 2 sockets per node
	146	LOGICAL :: no_shared_Memory_in_this_run !<
[4534]	147	!
	148	!-- Variables for the shared memory communicator
[4591]	149	INTEGER(iwp), PUBLIC :: comm_shared !< Communicator for processes with shared array
	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	TYPE( local_boundaries ), PUBLIC :: io_grid
	161
	162	!
	163	!-- Variables for the node local communicator
[4591]	164	INTEGER(iwp) :: comm_node !< Communicator for all processes of current node
	165	INTEGER(iwp) :: io_pe_global_rank !<
	166	INTEGER(iwp) :: n_npes !<
	167	INTEGER(iwp) :: n_rank !<
[4534]	168
[4591]	169	CONTAINS
[4534]	170
[4591]	171	PRIVATE
[4534]	172
[4591]	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_node_barrier !<
[4534]	178	#if defined( __parallel )
[4591]	179	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_1d !<
	180	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2d !<
	181	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_2di !<
	182	PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3d !<
[4534]	183
	184	GENERIC, PUBLIC :: sm_allocate_shared => sm_allocate_shared_1d, sm_allocate_shared_2d, &
[4591]	185	sm_allocate_shared_2di, sm_allocate_shared_3d !<
[4534]	186	#endif
	187	END TYPE sm_class
	188
	189
[4591]	190	CONTAINS
[4534]	191
	192
	193	!--------------------------------------------------------------------------------------------------!
	194	! Description:
	195	! ------------
	196	!> Create the communicator for shared memory groups and IO-PEs.
	197	!> Setup the grid for shared memory IO.
	198	!--------------------------------------------------------------------------------------------------!
	199	SUBROUTINE sm_init_comm( this, sm_active )
	200
	201	IMPLICIT NONE
	202
	203	CLASS(sm_class), INTENT(INOUT) :: this !< pointer to access internal variables of this call
	204
	205	#if defined( __parallel )
[4591]	206	INTEGER :: color !<
	207	INTEGER :: max_n_npes !< Maximum number of PEs/node
[4534]	208	#endif
	209
	210	LOGICAL, INTENT(IN) :: sm_active !< Flag to activate shared-memory IO
	211
	212
	213	this%no_shared_memory_in_this_run = .NOT. sm_active
	214
	215	IF ( this%no_shared_memory_in_this_run ) THEN
	216	this%iam_io_pe = .TRUE.
	217	RETURN
	218	ENDIF
	219
	220	#if defined( __parallel )
	221	!
	222	!-- Determine, how many MPI threads are running on a node
	223	this%iam_io_pe = .FALSE.
	224	CALL MPI_COMM_SPLIT_TYPE( comm2d, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, this%comm_node, ierr )
	225	CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
	226	CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
	227
	228	CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
	229	!
	230	!-- Decide, if the configuration can run with shared-memory IO
	231	IF ( max_n_npes > 64 ) THEN
	232	!
	233	!-- Special configuration on the HLRN-IV system with 4 shared memory blocks/node
	234	this%nr_io_pe_per_node = 4
	235
	236	ELSEIF ( max_n_npes <= 32 ) THEN
	237	!
	238	!-- No shared memory IO with less than 32 threads/node
	239	this%no_shared_memory_in_this_run = .TRUE.
	240	this%iam_io_pe = .TRUE.
	241	RETURN
	242	ENDIF
	243
	244	!
	245	!-- No shared memory IO with small setups
	246	IF ( nx < 24 .OR. ny < 24 ) THEN
	247	this%no_shared_memory_in_this_run = .TRUE.
	248	this%iam_io_pe = .TRUE.
	249	RETURN
	250	ENDIF
	251
	252	!
	253	!-- Divide a node into shared memory groups, depending on the virtual x-y grid
	254	CALL compute_color( color )
	255	!
	256	!-- If no shared memory IO possible, nothing is left to be done here.
	257	IF ( this%no_shared_memory_in_this_run ) RETURN
	258
	259	!
	260	!-- Setup the shared memory area
	261	CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
	262	CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
	263	CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
	264
	265	!
	266	!-- Setup the communicator across the nodes depending on the shared memory rank.
	267	!-- All threads with shared memory rank 0 will be I/O threads.
	268	color = this%sh_rank
	269	CALL MPI_COMM_SPLIT( comm2d, color, 0, this%comm_io, ierr )
	270
	271	IF ( this%comm_io /= MPI_COMM_NULL ) THEN
	272	CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
	273	CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
	274	ELSE
	275	this%io_npes = -1
	276	this%io_rank = -1
	277	ENDIF
	278
	279	IF ( this%sh_rank == 0 ) THEN
	280	this%iam_io_pe = .TRUE.
	281	this%io_pe_global_rank = myid
	282	ENDIF
	283	CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
	284
	285	#else
	286	this%iam_io_pe = .TRUE.
	287	#endif
	288
	289	#if defined( __parallel )
	290	CONTAINS
	291
	292	SUBROUTINE compute_color( color )
	293
	294	IMPLICIT NONE
	295
[4591]	296	INTEGER(iwp), INTENT(OUT) :: color !<
[4534]	297
[4591]	298	INTEGER(iwp) :: group_start !<
	299	INTEGER(iwp) :: my_color !<
	300	INTEGER(iwp) :: n !<
	301	INTEGER(iwp) :: pe !<
	302	INTEGER(iwp) :: sh_group_size !<
[4534]	303
[4591]	304	INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) :: local_dim_s !<
	305	INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) :: local_dim_r !<
[4534]	306
[4591]	307	TYPE(local_boundaries), DIMENSION(32) :: node_grid !<
[4534]	308
[4536]	309	!
[4591]	310	!-- No shared memory I/O on one node jobs
[4536]	311	IF ( numprocs < this%n_npes ) THEN
	312	this%no_shared_memory_in_this_run = .TRUE.
[4534]	313	RETURN
	314	ENDIF
	315
	316	local_dim_s = 0
	317	local_dim_s(1,this%n_rank) = nxl
	318	local_dim_s(2,this%n_rank) = nxr
	319	local_dim_s(3,this%n_rank) = nys
	320	local_dim_s(4,this%n_rank) = nyn
	321
	322	node_grid%nyn = -1
	323	!
	324	!-- Distribute the x-y layout of all cores of a node to all node processes
	325	CALL MPI_ALLREDUCE( local_dim_s, local_dim_r, SIZE( local_dim_s ), MPI_INTEGER, MPI_SUM, &
	326	this%comm_node, ierr )
	327	sh_group_size = ( max_n_npes + this%nr_io_pe_per_node - 1 ) / this%nr_io_pe_per_node
	328
	329	pe = 0
	330	my_color = 1 ! color is used to split the shared memory communicator into a communicator for
	331	! io groups
	332	group_start = pe
	333	node_grid(my_color)%nxl = local_dim_r(1,group_start)
	334	node_grid(my_color)%nxr = local_dim_r(2,group_start)
	335	node_grid(my_color)%nys = local_dim_r(3,group_start)
	336
	337	DO n = 1, this%n_npes-1
	338
	339	pe = n
	340	IF ( n > 0 .AND. MOD( n,sh_group_size ) == 0 ) THEN
	341	!
	342	!-- If group boundary, start new IO group
	343	node_grid(my_color)%nyn = local_dim_r(4,pe-1)
	344	my_color = my_color + 1
	345	group_start = pe
	346	node_grid(my_color)%nxl = local_dim_r(1,group_start)
	347	node_grid(my_color)%nxr = local_dim_r(2,group_start)
	348	node_grid(my_color)%nys = local_dim_r(3,group_start)
	349
	350	ELSEIF ( local_dim_r(1,pe) /= node_grid(my_color)%nxl ) THEN
	351	!
	352	!-- If nxl changes, start new IO group
	353	node_grid(my_color)%nyn = local_dim_r(4,pe-1)
	354	my_color = my_color+1
	355	group_start = pe
	356	node_grid(my_color)%nxl = local_dim_r(1,group_start)
	357	node_grid(my_color)%nxr = local_dim_r(2,group_start)
	358	node_grid(my_color)%nys = local_dim_r(3,group_start)
	359	ENDIF
	360	!
	361	!-- Save values for local PE
	362	IF ( this%n_rank == pe ) THEN !
	363	color = my_color
	364	ENDIF
	365	IF ( n == this%n_npes-1 ) node_grid(my_color)%nyn = local_dim_r(4,pe)
	366
	367	ENDDO
	368
	369	IF ( this%n_rank == 0 ) THEN
	370	color = 1
	371	ENDIF
	372
[4536]	373	this%io_grid = node_grid(color)
	374	this%io_grid%nnx = this%io_grid%nxr - this%io_grid%nxl + 1
	375	this%io_grid%nny = this%io_grid%nyn - this%io_grid%nys + 1
	376
[4534]	377	END SUBROUTINE compute_color
	378	#endif
	379
	380	END SUBROUTINE sm_init_comm
	381
	382
	383
	384	!--------------------------------------------------------------------------------------------------!
	385	! Description:
	386	! ------------
	387	!> Function to return if shared Memory IO is active.
	388	!--------------------------------------------------------------------------------------------------!
[4591]	389	FUNCTION is_sm_active( this ) RESULT( ac )
[4534]	390
	391	IMPLICIT NONE
	392
[4591]	393	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	394
[4591]	395	LOGICAL :: ac !<
[4534]	396
	397	ac = .NOT. this%no_shared_memory_in_this_run
	398
	399	END FUNCTION is_sm_active
	400
	401
	402	#if defined( __parallel )
	403	!--------------------------------------------------------------------------------------------------!
	404	! Description:
	405	! ------------
	406	!> Allocate shared 1d-REAL array on ALL threads
	407	!--------------------------------------------------------------------------------------------------!
	408	SUBROUTINE sm_allocate_shared_1d( this, p1, d1, d2, win )
	409
	410	IMPLICIT NONE
	411
[4591]	412	CLASS(sm_class), INTENT(inout) :: this !<
	413	!<
	414	INTEGER(iwp) :: disp_unit !<
	415	INTEGER(iwp), INTENT(IN) :: d1 !<
	416	INTEGER(iwp), INTENT(IN) :: d2 !<
	417	INTEGER(iwp), SAVE :: pe_from = 0 !<
	418	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
	419	INTEGER(iwp), INTENT(OUT) :: win !<
	420	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
[4534]	421
[4591]	422	INTEGER, DIMENSION(1) :: buf_shape !<
[4534]	423
[4591]	424	REAL(wp), DIMENSION(:), POINTER :: buf !<
	425	REAL(wp), DIMENSION(:), POINTER :: p1 !<
[4534]	426
[4591]	427	TYPE(C_PTR), SAVE :: base_ptr !<
	428	TYPE(C_PTR), SAVE :: rem_ptr !<
[4534]	429
	430
	431	IF ( this%no_shared_memory_in_this_run ) RETURN
	432	!
	433	!-- Allocate shared memory on node rank 0 threads.
	434	IF ( this%sh_rank == pe_from ) THEN
	435	wsize = d2 - d1 + 1
	436	ELSE
	437	wsize = 1
	438	ENDIF
	439	wsize = wsize * 8 ! Please note, size is always in bytes, independently of the displacement
	440	! unit
	441
	442	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
	443	!
	444	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
	445	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
	446	!
	447	!-- Convert C- to Fortran-pointer
	448	buf_shape(1) = d2 - d1 + 1
	449	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
	450	p1(d1:) => buf
	451	!
	452	!-- Allocate shared memory in round robin on all PEs of a node.
	453	pe_from = MOD( pe_from, this%sh_npes )
	454
	455	END SUBROUTINE sm_allocate_shared_1d
	456
	457
	458	!--------------------------------------------------------------------------------------------------!
	459	! Description:
	460	! ------------
	461	!> Allocate shared 2d-REAL array on ALL threads
	462	!--------------------------------------------------------------------------------------------------!
	463	SUBROUTINE sm_allocate_shared_2d( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
	464
	465	IMPLICIT NONE
	466
[4591]	467	CLASS(sm_class), INTENT(INOUT) :: this !<
[4534]	468
[4591]	469	INTEGER(iwp) :: disp_unit !<
	470	INTEGER(iwp), INTENT(IN) :: n_nxlg !<
	471	INTEGER(iwp), INTENT(IN) :: n_nxrg !<
	472	INTEGER(iwp), INTENT(IN) :: n_nyng !<
	473	INTEGER(iwp), INTENT(IN) :: n_nysg !<
	474	INTEGER(iwp), SAVE :: pe_from = 0 !<
	475	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
	476	INTEGER(iwp), INTENT(OUT) :: win !<
	477	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
[4534]	478
[4591]	479	INTEGER(iwp), DIMENSION(2) :: buf_shape !<
[4534]	480
[4591]	481	REAL(wp), DIMENSION(:,:), POINTER :: buf !<
	482	REAL(wp), DIMENSION(:,:), POINTER :: p2 !<
[4534]	483
[4591]	484	TYPE(C_PTR),SAVE :: base_ptr !<
	485	TYPE(C_PTR),SAVE :: rem_ptr !<
[4534]	486
	487
	488	IF ( this%no_shared_memory_in_this_run ) RETURN
	489	!
	490	!-- Allocate shared memory on node rank 0 threads.
	491	IF ( this%sh_rank == pe_from ) THEN
	492	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
	493	ELSE
	494	wsize = 1
	495	ENDIF
	496
	497	wsize = wsize * 8 ! Please note, size is always in bytes, independently of the displacement
	498	! unit
	499
	500	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
	501	!
	502	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
	503	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
	504	!
	505	!-- Convert C- to Fortran-pointer
	506	buf_shape(2) = n_nyng - n_nysg + 1
	507	buf_shape(1) = n_nxrg - n_nxlg + 1
	508	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
	509	p2(n_nxlg:, n_nysg:) => buf
	510	!
	511	!-- Allocate shared memory in round robin on all PEs of a node.
	512	pe_from = MOD( pe_from, this%sh_npes )
	513
	514	END SUBROUTINE sm_allocate_shared_2d
	515
	516
	517	!--------------------------------------------------------------------------------------------------!
	518	! Description:
	519	! ------------
	520	!> Allocate shared 2d-INTEGER array on ALL threads
	521	!--------------------------------------------------------------------------------------------------!
	522	SUBROUTINE sm_allocate_shared_2di( this, p2i, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
	523
	524	IMPLICIT NONE
	525
[4591]	526	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	527
[4591]	528	INTEGER(iwp) :: disp_unit !<
	529	INTEGER(iwp), INTENT(IN) :: n_nxlg !<
	530	INTEGER(iwp), INTENT(IN) :: n_nxrg !<
	531	INTEGER(iwp), INTENT(IN) :: n_nyng !<
	532	INTEGER(iwp), INTENT(IN) :: n_nysg !<
	533	INTEGER(iwp), SAVE :: pe_from = 0 !<
	534	INTEGER(kind=MPI_ADDRESS_KIND) :: rem_size !<
	535	INTEGER(iwp), INTENT(OUT) :: win !<
	536	INTEGER(kind=MPI_ADDRESS_KIND) :: wsize !<
[4534]	537
[4591]	538	INTEGER(iwp), DIMENSION(2) :: buf_shape !<
[4534]	539
[4591]	540	INTEGER(iwp), DIMENSION(:,:), POINTER :: buf !<
	541	INTEGER(iwp), DIMENSION(:,:), POINTER :: p2i !<
[4534]	542
[4591]	543	TYPE(C_PTR),SAVE :: base_ptr !<
	544	TYPE(C_PTR),SAVE :: rem_ptr !<
[4534]	545
	546
	547	IF ( this%no_shared_memory_in_this_run ) RETURN
	548	!
	549	!-- Allocate shared memory on node rank 0 threads.
	550	IF ( this%sh_rank == pe_from ) THEN
	551	wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
	552	ELSE
	553	wsize = 1
	554	ENDIF
	555
	556	wsize = wsize * 4 ! Please note, size is always in bytes, independently of the displacement
	557	! unit
	558
	559	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 4, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
	560	!
	561	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
	562	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
	563	!
	564	!-- Convert C- to Fortran-pointer
	565	buf_shape(2) = n_nyng - n_nysg + 1
	566	buf_shape(1) = n_nxrg - n_nxlg + 1
	567	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
	568	p2i(n_nxlg:, n_nysg:) => buf
	569	!
	570	!-- Allocate shared memory in round robin on all PEs of a node.
	571	pe_from = MOD( pe_from, this%sh_npes )
	572
	573	END SUBROUTINE sm_allocate_shared_2di
	574
	575
	576	!--------------------------------------------------------------------------------------------------!
	577	! Description:
	578	! ------------
	579	!> Allocate shared 3d-REAL array on ALL threads
	580	!--------------------------------------------------------------------------------------------------!
	581	SUBROUTINE sm_allocate_shared_3d( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
	582
	583	IMPLICIT NONE
	584
[4591]	585	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	586
[4591]	587	INTEGER :: disp_unit !<
	588	INTEGER, INTENT(IN) :: d1e !<
	589	INTEGER, INTENT(IN) :: d1s !<
	590	INTEGER, INTENT(IN) :: d2e !<
	591	INTEGER, INTENT(IN) :: d2s !<
	592	INTEGER, INTENT(IN) :: d3e !<
	593	INTEGER, INTENT(IN) :: d3s !<
	594	INTEGER, SAVE :: pe_from = 0 !<
	595	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !<
	596	INTEGER, INTENT(OUT) :: win !<
	597	INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !<
[4534]	598
[4591]	599	INTEGER, DIMENSION(3) :: buf_shape !<
[4534]	600
[4591]	601	REAL(wp), DIMENSION(:,:,:), POINTER :: buf !<
	602	REAL(wp), DIMENSION(:,:,:), POINTER :: p3 !<
[4534]	603
[4591]	604	TYPE(C_PTR), SAVE :: base_ptr !<
	605	TYPE(C_PTR), SAVE :: rem_ptr !<
[4534]	606
	607
	608	IF ( this%no_shared_memory_in_this_run ) RETURN
	609	!
	610	!-- Allocate shared memory on node rank 0 threads.
	611	IF ( this%sh_rank == pe_from ) THEN
	612	wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
	613	ELSE
	614	wsize = 1
	615	ENDIF
	616
	617	wsize = wsize * 8 ! Please note, size is always in bytes, independently of the displacement
	618	! unit
	619
	620	CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
	621	!
	622	!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
	623	CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
	624	!
	625	!-- Convert C- to Fortran-pointer
	626	buf_shape(3) = d3e - d3s + 1
	627	buf_shape(2) = d2e - d2s + 1
	628	buf_shape(1) = d1e - d1s + 1
	629	CALL C_F_POINTER( rem_ptr, buf, buf_shape )
	630	p3(d1s:,d2s:,d3s:) => buf
	631	!
	632	!-- Allocate shared memory in round robin on all PEs of a node.
	633	pe_from = MOD( pe_from, this%sh_npes )
	634
	635	END SUBROUTINE sm_allocate_shared_3d
	636	#endif
	637
	638
	639	!--------------------------------------------------------------------------------------------------!
	640	! Description:
	641	! ------------
	642	!> ???
	643	!--------------------------------------------------------------------------------------------------!
	644	SUBROUTINE sm_adjust_outer_boundary( this )
	645
	646	IMPLICIT NONE
	647
[4591]	648	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	649
	650
	651	IF ( this%no_shared_memory_in_this_run ) RETURN
	652
	653	IF ( this%io_grid%nxl == 0 ) THEN
	654	this%io_grid%nxl = this%io_grid%nxl - nbgp
	655	this%io_grid%nnx = this%io_grid%nnx + nbgp
	656	ENDIF
	657
	658	IF ( this%io_grid%nxr == nx .OR. npex == -1 ) THEN ! npex == -1 if -D__parallel not set
	659	this%io_grid%nxr = this%io_grid%nxr + nbgp
	660	this%io_grid%nnx = this%io_grid%nnx + nbgp
	661	ENDIF
	662
	663	IF ( this%io_grid%nys == 0 ) THEN
	664	this%io_grid%nys = this%io_grid%nys - nbgp
	665	this%io_grid%nny = this%io_grid%nny + nbgp
	666	ENDIF
	667
	668	IF ( this%io_grid%nyn == ny .OR. npey == -1 ) THEN ! npey == -1 if -D__parallel not set
	669	this%io_grid%nyn = this%io_grid%nyn + nbgp
	670	this%io_grid%nny = this%io_grid%nny + nbgp
	671	ENDIF
	672
	673	this%io_grid%nxl = this%io_grid%nxl + nbgp
	674	this%io_grid%nxr = this%io_grid%nxr + nbgp
	675	this%io_grid%nys = this%io_grid%nys + nbgp
	676	this%io_grid%nyn = this%io_grid%nyn + nbgp
	677	this%io_grid%nnx = this%io_grid%nnx
	678	this%io_grid%nny = this%io_grid%nny
	679
	680	END SUBROUTINE sm_adjust_outer_boundary
	681
	682
	683	!--------------------------------------------------------------------------------------------------!
	684	! Description:
	685	! ------------
	686	!> Deallocate shared aray and free related window.
	687	!--------------------------------------------------------------------------------------------------!
	688	SUBROUTINE sm_free_shared( this, win )
	689
	690	IMPLICIT NONE
	691
[4591]	692	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	693
[4591]	694	INTEGER(iwp), INTENT(INOUT) :: win !<
[4534]	695
	696	IF ( this%no_shared_memory_in_this_run .OR. win == -1234567890 ) RETURN
	697	! win is used just to avoid compile errors because of unused arguments
	698	#if defined( __parallel )
	699	CALL MPI_WIN_FREE( win, ierr )
	700	#endif
	701
	702	END SUBROUTINE sm_free_shared
	703
	704
	705	!--------------------------------------------------------------------------------------------------!
	706	! Description:
	707	! ------------
	708	!> ...
	709	!--------------------------------------------------------------------------------------------------!
	710	SUBROUTINE sm_node_barrier( this )
	711
	712	IMPLICIT NONE
	713
[4591]	714	CLASS(sm_class), INTENT(inout) :: this !<
[4534]	715
	716
	717	IF ( this%no_shared_memory_in_this_run ) RETURN
	718
	719	#if defined( __parallel )
	720	CALL MPI_BARRIER( this%comm_shared, ierr )
	721	#endif
	722
	723	END SUBROUTINE sm_node_barrier
	724
	725	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 |