Home

Context Navigation

pmc_mpi_wrapper.f90 @ 1838

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

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

Context Navigation

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

Download in other formats: