Home

Context Navigation

source: palm/trunk/SOURCE/pmc_mpi_wrapper.f90 @ 1801

Last change on this file since 1801 was 1780, checked in by raasch, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 18.1 KB

Rev	Line
[1762]	1	MODULE pmc_mpi_wrapper
	2
	3	!--------------------------------------------------------------------------------!
	4	! This file is part of PALM.
	5	!
	6	! PALM is free software: you can redistribute it and/or modify it under the terms
	7	! of the GNU General Public License as published by the Free Software Foundation,
	8	! either version 3 of the License, or (at your option) any later version.
	9	!
	10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	!
	14	! You should have received a copy of the GNU General Public License along with
	15	! PALM. If not, see <http://www.gnu.org/licenses/>.
	16	!
	17	! Copyright 1997-2015 Leibniz Universitaet Hannover
	18	!--------------------------------------------------------------------------------!
	19	!
	20	! Current revisions:
	21	! ------------------
	22	!
[1780]	23	!
[1762]	24	! Former revisions:
	25	! -----------------
	26	! $Id: pmc_mpi_wrapper.f90 1780 2016-03-03 08:39:40Z raasch $
	27	!
[1780]	28	! 1779 2016-03-03 08:01:28Z raasch
	29	! kind=dp replaced by wp
	30	!
[1765]	31	! 1764 2016-02-28 12:45:19Z raasch
	32	! cpp-statement added (nesting can only be used in parallel mode),
	33	! kind-parameters adjusted to PALM-kinds
	34	!
[1763]	35	! 1762 2016-02-25 12:31:13Z hellstea
	36	! Initial revision by K. Ketelsen
[1762]	37	!
	38	! Description:
	39	! ------------
	40	!
	41	! MPI Wrapper of Palm Model Coupler
	42	!------------------------------------------------------------------------------!
	43
[1764]	44	#if defined( __parallel )
[1762]	45	use, intrinsic :: iso_c_binding
	46
[1764]	47	#if defined( __lc )
	48	USE MPI
	49	#else
	50	INCLUDE "mpif.h"
	51	#endif
	52	USE kinds
[1762]	53	USE PMC_handle_communicator, ONLY: m_to_server_comm, m_to_client_comm, m_model_comm, m_model_rank
	54	IMPLICIT none
	55	PRIVATE
	56	SAVE
	57
	58	INTERFACE PMC_Send_to_Server
	59	MODULE PROCEDURE PMC_Send_to_Server_INTEGER
	60	MODULE PROCEDURE PMC_Send_to_Server_INTEGER_2
	61	MODULE PROCEDURE PMC_Send_to_Server_real_r1
	62	MODULE PROCEDURE PMC_Send_to_Server_real_r2
	63	MODULE PROCEDURE PMC_Send_to_Server_real_r3
	64	END INTERFACE PMC_Send_to_Server
	65
	66	INTERFACE PMC_Recv_from_Server
	67	MODULE PROCEDURE PMC_Recv_from_Server_INTEGER
	68	MODULE PROCEDURE PMC_Recv_from_Server_real_r1
	69	MODULE PROCEDURE PMC_Recv_from_Server_real_r2
	70	MODULE PROCEDURE PMC_Recv_from_Server_real_r3
	71	END INTERFACE PMC_Recv_from_Server
	72
	73	INTERFACE PMC_Send_to_Client
	74	MODULE PROCEDURE PMC_Send_to_Client_INTEGER
	75	MODULE PROCEDURE PMC_Send_to_Client_real_r1
	76	MODULE PROCEDURE PMC_Send_to_Client_real_r2
	77	MODULE PROCEDURE PMC_Send_to_Client_real_r3
	78	END INTERFACE PMC_Send_to_Client
	79
	80	INTERFACE PMC_Recv_from_Client
	81	MODULE PROCEDURE PMC_Recv_from_Client_INTEGER
	82	MODULE PROCEDURE PMC_Recv_from_Client_INTEGER_2
	83	MODULE PROCEDURE PMC_Recv_from_Client_real_r1
	84	MODULE PROCEDURE PMC_Recv_from_Client_real_r2
	85	MODULE PROCEDURE PMC_Recv_from_Client_real_r3
	86	END INTERFACE PMC_Recv_from_Client
	87
	88	INTERFACE PMC_Bcast
	89	MODULE PROCEDURE PMC_Bcast_INTEGER
	90	MODULE PROCEDURE PMC_Bcast_character
	91	END INTERFACE PMC_Bcast
	92
	93	INTERFACE PMC_Inter_Bcast
	94	MODULE PROCEDURE PMC_Inter_Bcast_INTEGER_1
	95	END INTERFACE PMC_Inter_Bcast
	96
	97	INTERFACE PMC_Alloc_mem
	98	MODULE PROCEDURE PMC_Alloc_mem_INTEGER_1
	99	MODULE PROCEDURE PMC_Alloc_mem_Real_1
	100	END INTERFACE PMC_Alloc_mem
	101
	102	INTERFACE PMC_TIME
	103	MODULE PROCEDURE PMC_TIME
	104	END INTERFACE PMC_TIME
	105
	106	PUBLIC PMC_Send_to_Server, PMC_Recv_from_Server
	107	PUBLIC PMC_Send_to_Client, PMC_Recv_from_Client
	108	PUBLIC PMC_Bcast, PMC_Inter_Bcast, PMC_Alloc_mem
	109	PUBLIC PMC_TIME
	110
	111	CONTAINS
	112
	113	SUBROUTINE PMC_Send_to_Server_INTEGER (buf, n, Server_rank, tag, ierr)
	114	IMPLICIT none
	115	INTEGER, DIMENSION(:), INTENT(IN) :: buf
	116	INTEGER, INTENT(IN) :: n
	117	INTEGER, INTENT(IN) :: Server_rank
	118	INTEGER, INTENT(IN) :: tag
	119	INTEGER, INTENT(OUT) :: ierr
	120
	121	ierr = 0
	122	CALL MPI_Send (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, ierr)
	123
	124	return
	125	END SUBROUTINE PMC_Send_to_Server_INTEGER
	126
	127	SUBROUTINE PMC_Recv_from_Server_INTEGER (buf, n, Server_rank, tag, ierr)
	128	IMPLICIT none
	129	INTEGER, DIMENSION(:), INTENT(OUT) :: buf
	130	INTEGER, INTENT(IN) :: n
	131	INTEGER, INTENT(IN) :: Server_rank
	132	INTEGER, INTENT(IN) :: tag
	133	INTEGER, INTENT(OUT) :: ierr
	134
	135	ierr = 0
	136	CALL MPI_Recv (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, &
	137	MPI_STATUS_IGNORE, ierr)
	138
	139	return
	140	END SUBROUTINE PMC_Recv_from_Server_INTEGER
	141
	142	SUBROUTINE PMC_Send_to_Server_INTEGER_2 (buf, n, Server_rank, tag, ierr)
	143	IMPLICIT none
	144	INTEGER, DIMENSION(:,:), INTENT(IN) :: buf
	145	INTEGER, INTENT(IN) :: n
	146	INTEGER, INTENT(IN) :: Server_rank
	147	INTEGER, INTENT(IN) :: tag
	148	INTEGER, INTENT(OUT) :: ierr
	149
	150	ierr = 0
	151	CALL MPI_Send (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, ierr)
	152
	153	return
	154	END SUBROUTINE PMC_Send_to_Server_INTEGER_2
	155
	156	SUBROUTINE PMC_Send_to_Server_real_r1 (buf, n, Server_rank, tag, ierr)
[1779]	157
[1762]	158	IMPLICIT none
	159
[1779]	160	REAL(wp), DIMENSION(:), INTENT(IN) :: buf
	161	INTEGER, INTENT(IN) :: n
	162	INTEGER, INTENT(IN) :: Server_rank
	163	INTEGER, INTENT(IN) :: tag
	164	INTEGER, INTENT(OUT) :: ierr
	165
[1762]	166	ierr = 0
[1779]	167	CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
[1762]	168
	169	return
	170	END SUBROUTINE PMC_Send_to_Server_real_r1
	171
	172	SUBROUTINE PMC_Recv_from_Server_real_r1 (buf, n, Server_rank, tag, ierr)
[1779]	173
[1762]	174	IMPLICIT none
	175
[1779]	176	REAL(wp), DIMENSION(:), INTENT(OUT) :: buf
	177	INTEGER, INTENT(IN) :: n
	178	INTEGER, INTENT(IN) :: Server_rank
	179	INTEGER, INTENT(IN) :: tag
	180	INTEGER, INTENT(OUT) :: ierr
	181
[1762]	182	ierr = 0
[1779]	183	CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
	184	MPI_STATUS_IGNORE, ierr)
[1762]	185
	186	return
	187	END SUBROUTINE PMC_Recv_from_Server_real_r1
	188
	189	SUBROUTINE PMC_Send_to_Server_real_r2 (buf, n, Server_rank, tag, ierr)
[1779]	190
[1762]	191	IMPLICIT none
	192
[1779]	193	REAL(wp), DIMENSION(:,:), INTENT(IN) :: buf
	194	INTEGER, INTENT(IN) :: n
	195	INTEGER, INTENT(IN) :: Server_rank
	196	INTEGER, INTENT(IN) :: tag
	197	INTEGER, INTENT(OUT) :: ierr
	198
[1762]	199	ierr = 0
[1779]	200	CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
[1762]	201
	202	return
	203	END SUBROUTINE PMC_Send_to_Server_real_r2
	204
	205	SUBROUTINE PMC_Recv_from_Server_real_r2 (buf, n, Server_rank, tag, ierr)
[1779]	206
[1762]	207	IMPLICIT none
	208
[1779]	209	REAL(wp), DIMENSION(:,:), INTENT(OUT) :: buf
	210	INTEGER, INTENT(IN) :: n
	211	INTEGER, INTENT(IN) :: Server_rank
	212	INTEGER, INTENT(IN) :: tag
	213	INTEGER, INTENT(OUT) :: ierr
	214
[1762]	215	ierr = 0
[1779]	216	CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
[1762]	217	MPI_STATUS_IGNORE, ierr)
	218
	219	return
	220	END SUBROUTINE PMC_Recv_from_Server_real_r2
	221
	222	SUBROUTINE PMC_Send_to_Server_real_r3 (buf, n, Server_rank, tag, ierr)
[1779]	223
[1762]	224	IMPLICIT none
	225
[1779]	226	REAL(wp), DIMENSION(:,:,:), INTENT(IN) :: buf
	227	INTEGER, INTENT(IN) :: n
	228	INTEGER, INTENT(IN) :: Server_rank
	229	INTEGER, INTENT(IN) :: tag
	230	INTEGER, INTENT(OUT) :: ierr
	231
[1762]	232	ierr = 0
[1779]	233	CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
[1762]	234
	235	return
	236	END SUBROUTINE PMC_Send_to_Server_real_r3
	237
	238	SUBROUTINE PMC_Recv_from_Server_real_r3 (buf, n, Server_rank, tag, ierr)
[1779]	239
[1762]	240	IMPLICIT none
	241
[1779]	242	REAL(wp), DIMENSION(:,:,:), INTENT(OUT) :: buf
	243	INTEGER, INTENT(IN) :: n
	244	INTEGER, INTENT(IN) :: Server_rank
	245	INTEGER, INTENT(IN) :: tag
	246	INTEGER, INTENT(OUT) :: ierr
	247
[1762]	248	ierr = 0
[1779]	249	CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
[1762]	250	MPI_STATUS_IGNORE, ierr)
	251
	252	return
	253	END SUBROUTINE PMC_Recv_from_Server_real_r3
	254
	255
	256	SUBROUTINE PMC_Send_to_Client_INTEGER (Client_id, buf, n, Client_rank, tag, ierr)
	257	IMPLICIT none
	258	INTEGER, INTENT(IN) :: Client_id
	259	INTEGER, DIMENSION(:), INTENT(IN) :: buf
	260	INTEGER, INTENT(IN) :: n
	261	INTEGER, INTENT(IN) :: Client_rank
	262	INTEGER, INTENT(IN) :: tag
	263	INTEGER, INTENT(OUT) :: ierr
	264
	265	ierr = 0
	266	CALL MPI_Send (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), ierr)
	267
	268	return
	269	END SUBROUTINE PMC_Send_to_Client_INTEGER
	270
	271	SUBROUTINE PMC_Recv_from_Client_INTEGER (Client_id, buf, n, Client_rank, tag, ierr)
	272	IMPLICIT none
	273	INTEGER, INTENT(IN) :: Client_id
	274	INTEGER, DIMENSION(:), INTENT(INOUT) :: buf
	275	INTEGER, INTENT(IN) :: n
	276	INTEGER, INTENT(IN) :: Client_rank
	277	INTEGER, INTENT(IN) :: tag
	278	INTEGER, INTENT(OUT) :: ierr
	279
	280	ierr = 0
	281	CALL MPI_Recv (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), &
	282	MPI_STATUS_IGNORE, ierr)
	283
	284	return
	285	END SUBROUTINE PMC_Recv_from_Client_INTEGER
	286
	287	SUBROUTINE PMC_Recv_from_Client_INTEGER_2 (Client_id, buf, n, Client_rank, tag, ierr)
	288	IMPLICIT none
	289	INTEGER, INTENT(IN) :: Client_id
	290	INTEGER, DIMENSION(:,:), INTENT(OUT) :: buf
	291	INTEGER, INTENT(IN) :: n
	292	INTEGER, INTENT(IN) :: Client_rank
	293	INTEGER, INTENT(IN) :: tag
	294	INTEGER, INTENT(OUT) :: ierr
	295
	296	ierr = 0
	297	CALL MPI_Recv (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), &
	298	MPI_STATUS_IGNORE, ierr)
	299
	300	return
	301	END SUBROUTINE PMC_Recv_from_Client_INTEGER_2
	302
	303	SUBROUTINE PMC_Send_to_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]	304
[1762]	305	IMPLICIT none
	306
[1779]	307	INTEGER, INTENT(IN) :: Client_id
	308	REAL(wp), DIMENSION(:), INTENT(IN) :: buf
	309	INTEGER, INTENT(IN) :: n
	310	INTEGER, INTENT(IN) :: Client_rank
	311	INTEGER, INTENT(IN) :: tag
	312	INTEGER, INTENT(OUT) :: ierr
	313
[1762]	314	ierr = 0
[1779]	315	CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]	316	ierr)
	317
	318	return
	319	END SUBROUTINE PMC_Send_to_Client_real_r1
	320
	321	SUBROUTINE PMC_Recv_from_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]	322
[1762]	323	IMPLICIT none
	324
[1779]	325	INTEGER, INTENT(IN) :: Client_id
	326	REAL(wp), DIMENSION(:), INTENT(INOUT) :: buf
	327	INTEGER, INTENT(IN) :: n
	328	INTEGER, INTENT(IN) :: Client_rank
	329	INTEGER, INTENT(IN) :: tag
	330	INTEGER, INTENT(OUT) :: ierr
	331
[1762]	332	ierr = 0
[1779]	333	CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]	334	MPI_STATUS_IGNORE, ierr)
	335
	336	return
	337	END SUBROUTINE PMC_Recv_from_Client_real_r1
	338
	339	SUBROUTINE PMC_Send_to_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]	340
[1762]	341	IMPLICIT none
	342
[1779]	343	INTEGER, INTENT(IN) :: Client_id
	344	REAL(wp), DIMENSION(:,:), INTENT(IN) :: buf
	345	INTEGER, INTENT(IN) :: n
	346	INTEGER, INTENT(IN) :: Client_rank
	347	INTEGER, INTENT(IN) :: tag
	348	INTEGER, INTENT(OUT) :: ierr
	349
[1762]	350	ierr = 0
[1779]	351	CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]	352	ierr)
	353
	354	return
	355	END SUBROUTINE PMC_Send_to_Client_real_r2
	356
	357	SUBROUTINE PMC_Recv_from_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]	358
[1762]	359	IMPLICIT none
	360
[1779]	361	INTEGER, INTENT(IN) :: Client_id
	362	REAL(wp), DIMENSION(:,:), INTENT(OUT) :: buf
	363	INTEGER, INTENT(IN) :: n
	364	INTEGER, INTENT(IN) :: Client_rank
	365	INTEGER, INTENT(IN) :: tag
	366	INTEGER, INTENT(OUT) :: ierr
	367
[1762]	368	ierr = 0
[1779]	369	CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]	370	MPI_STATUS_IGNORE, ierr)
	371
	372	return
	373	END SUBROUTINE PMC_Recv_from_Client_real_r2
	374
	375	SUBROUTINE PMC_Send_to_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]	376
[1762]	377	IMPLICIT none
	378
[1779]	379	INTEGER, INTENT(IN) :: Client_id
	380	REAL(wp), DIMENSION(:,:,:), INTENT(IN) :: buf
	381	INTEGER, INTENT(IN) :: n
	382	INTEGER, INTENT(IN) :: Client_rank
	383	INTEGER, INTENT(IN) :: tag
	384	INTEGER, INTENT(OUT) :: ierr
	385
[1762]	386	ierr = 0
[1779]	387	CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]	388	ierr)
	389
	390	return
	391	END SUBROUTINE PMC_Send_to_Client_real_r3
	392
	393	SUBROUTINE PMC_Recv_from_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]	394
[1762]	395	IMPLICIT none
	396
[1779]	397	INTEGER, INTENT(IN) :: Client_id
	398	REAL(wp), DIMENSION(:,:,:), INTENT(OUT) :: buf
	399	INTEGER, INTENT(IN) :: n
	400	INTEGER, INTENT(IN) :: Client_rank
	401	INTEGER, INTENT(IN) :: tag
	402	INTEGER, INTENT(OUT) :: ierr
	403
[1762]	404	ierr = 0
[1779]	405	CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]	406	MPI_STATUS_IGNORE, ierr)
	407
	408	return
	409	END SUBROUTINE PMC_Recv_from_Client_real_r3
	410
	411	SUBROUTINE PMC_Bcast_INTEGER (buf, root_pe, comm, ierr)
	412	IMPLICIT none
	413	INTEGER, INTENT(INOUT) :: buf
	414	INTEGER, INTENT(IN) :: root_pe
	415	INTEGER, INTENT(IN),optional :: comm
	416	INTEGER, INTENT(OUT),optional :: ierr
	417	!-- local variables
	418	INTEGER :: myComm
	419	INTEGER :: myErr
	420
	421	if(present (comm)) then
	422	myComm = comm
	423	else
	424	myComm = m_model_comm
	425	end if
	426
	427	CALL MPI_Bcast (buf, 1, MPI_INTEGER, root_pe, myComm, myErr)
	428
	429	if(present (ierr)) then
	430	ierr = myErr
	431	end if
	432
	433	return
	434	END SUBROUTINE PMC_Bcast_INTEGER
	435
	436	SUBROUTINE PMC_Bcast_character (buf, root_pe, comm, ierr)
	437	IMPLICIT none
	438	character(len=*), INTENT(INOUT) :: buf
	439	INTEGER, INTENT(IN) :: root_pe
	440	INTEGER, INTENT(IN),optional :: comm
	441	INTEGER, INTENT(OUT),optional :: ierr
	442	!-- local variables
	443	INTEGER :: myComm
	444	INTEGER :: myErr
	445
	446	if(present (comm)) then
	447	myComm = comm
	448	else
	449	myComm = m_model_comm
	450	end if
	451
	452	CALL MPI_Bcast (buf, len(buf), MPI_Character, root_pe, myComm, myErr)
	453
	454	if(present (ierr)) then
	455	ierr = myErr
	456	end if
	457
	458	return
	459	END SUBROUTINE PMC_Bcast_character
	460
	461	SUBROUTINE PMC_Inter_Bcast_INTEGER_1 (buf, Client_id, ierr)
	462	IMPLICIT none
	463	INTEGER, INTENT(INOUT),DIMENSION(:) :: buf
	464	INTEGER, INTENT(IN),optional :: Client_id
	465	INTEGER, INTENT(OUT),optional :: ierr
	466	!-- local variables
	467	INTEGER :: myComm
	468	INTEGER :: myErr
	469	INTEGER :: root_pe
	470
	471	! PE 0 Server Broadcast to all Client PE's
	472
	473	if(present (Client_id)) then
	474	myComm = m_to_client_comm(Client_id)
	475	if(m_model_rank == 0) then
	476	root_pe = MPI_ROOT
	477	else
	478	root_pe = MPI_PROC_NULL
	479	end if
	480	else
	481	myComm = m_to_server_comm
	482	root_pe = 0
	483	end if
	484
	485	CALL MPI_Bcast (buf, size(buf), MPI_INTEGER, root_pe, myComm, myErr)
	486
	487	if(present (ierr)) then
	488	ierr = myErr
	489	end if
	490
	491	return
	492	END SUBROUTINE PMC_Inter_Bcast_INTEGER_1
	493
	494	! Allocate Memory with MPI_Alloc_mem using intermediate C-pointer
	495
	496	SUBROUTINE PMC_Alloc_mem_INTEGER_1 (iarray, idim1)
	497	IMPLICIT none
	498	INTEGER,DIMENSION(:),POINTER,INTENT(INOUT) :: iarray
	499	INTEGER,INTENT(IN) :: idim1
	500
	501	Type(c_ptr) :: p_myInd
	502	INTEGER,DIMENSION(1) :: aShape
	503	INTEGER(KIND=MPI_ADDRESS_KIND) :: WinSize
	504	INTEGER :: ierr
	505
	506	WinSize = idim1*c_sizeof(ierr) ! Length of INTEGER
	507
	508	CALL MPI_Alloc_mem (WinSize , MPI_INFO_NULL, p_myInd, ierr);
	509	aShape(1) = idim1
	510	CALL c_f_pointer(p_myInd,iarray,aShape)
	511
	512	return
	513	END SUBROUTINE PMC_Alloc_mem_INTEGER_1
	514
	515	SUBROUTINE PMC_Alloc_mem_Real_1 (array, idim1, base_ptr)
	516	IMPLICIT none
	517	REAL(kind=wp),DIMENSION(:),POINTER,INTENT(INOUT) :: array
[1764]	518	INTEGER(idp),INTENT(IN) :: idim1
[1762]	519	Type(c_ptr),INTENT(OUT),optional :: base_ptr
	520
	521
	522	Type(c_ptr) :: p_myInd
	523	INTEGER,DIMENSION(1) :: aShape
	524	INTEGER(KIND=MPI_ADDRESS_KIND) :: WinSize
	525	INTEGER :: ierr
	526
	527	WinSize = idim1*wp ! Length of INTEGER
	528
	529	CALL MPI_Alloc_mem (WinSize , MPI_INFO_NULL, p_myInd, ierr);
	530	aShape(1) = idim1
	531	CALL c_f_pointer(p_myInd,array,aShape)
	532
	533	if(present(base_ptr)) then
	534	base_ptr = p_myInd
	535	end if
	536
	537	return
	538	END SUBROUTINE PMC_Alloc_mem_Real_1
	539
	540	FUNCTION PMC_TIME ()
	541	REAL(kind=wp) :: PMC_TIME
	542
	543	PMC_TIME = MPI_Wtime ()
	544
	545	return
	546
	547	END FUNCTION PMC_TIME
	548
[1764]	549	#endif
[1762]	550	END MODULE pmc_mpi_wrapper

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |