Home

Context Navigation

source: palm/trunk/SOURCE/pmc_client.f90 @ 1772

Last change on this file since 1772 was 1765, checked in by raasch, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 21.0 KB

Line
1	MODULE pmc_client
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	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: pmc_client.f90 1765 2016-02-28 13:30:40Z hoffmann $
27	!
28	! 1764 2016-02-28 12:45:19Z raasch
29	! cpp-statement added (nesting can only be used in parallel mode),
30	! all kinds given in PALM style
31	!
32	! 1762 2016-02-25 12:31:13Z hellstea
33	! Initial revision by K. Ketelsen
34	!
35	! Description:
36	! ------------
37	!
38	! Client part of Palm Model Coupler
39	!------------------------------------------------------------------------------!
40
41	#if defined( __parallel )
42
43	use, intrinsic :: iso_c_binding
44
45	#if defined( __lc )
46	USE MPI
47	#else
48	INCLUDE "mpif.h"
49	#endif
50	USE kinds
51	USE PMC_general, ONLY: ClientDef, DA_NameDef, DA_Namelen, PMC_STATUS_OK, PMC_DA_NAME_ERR, PeDef, ArrayDef, &
52	DA_Desclen, DA_Namelen, PMC_G_SetName, PMC_G_GetName
53	USE PMC_handle_communicator, ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_server_comm
54	USE PMC_MPI_wrapper, ONLY: PMC_Send_to_Server, PMC_Recv_from_Server, PMC_Time, &
55	PMC_Bcast, PMC_Inter_Bcast, PMC_Alloc_mem
56	IMPLICIT none
57	PRIVATE
58	SAVE
59
60	! data local to this MODULE
61	Type(ClientDef) :: me
62	!-- TO_DO: what is the meaning of this? Could variables declared in this module
63	!-- also have single precision?
64	! INTEGER, PARAMETER :: dp = wp
65
66	INTEGER, save :: myIndex = 0 !Counter and unique number for Data Arrays
67
68	! INTERFACE section
69
70	INTERFACE PMC_ClientInit
71	MODULE procedure PMC_ClientInit
72	END INTERFACE PMC_ClientInit
73
74	INTERFACE PMC_Set_DataArray_Name
75	MODULE procedure PMC_Set_DataArray_Name
76	MODULE procedure PMC_Set_DataArray_Name_LastEntry
77	END INTERFACE PMC_Set_DataArray_Name
78
79	INTERFACE PMC_C_Get_2D_index_list
80	MODULE procedure PMC_C_Get_2D_index_list
81	END INTERFACE PMC_C_Get_2D_index_list
82
83	INTERFACE PMC_C_GetNextArray
84	MODULE procedure PMC_C_GetNextArray
85	END INTERFACE PMC_C_GetNextArray
86
87	INTERFACE PMC_C_Set_DataArray
88	MODULE procedure PMC_C_Set_DataArray_2d
89	MODULE procedure PMC_C_Set_DataArray_3d
90	END INTERFACE PMC_C_Set_DataArray
91
92	INTERFACE PMC_C_setInd_and_AllocMem
93	MODULE procedure PMC_C_setInd_and_AllocMem
94	END INTERFACE PMC_C_setInd_and_AllocMem
95
96	INTERFACE PMC_C_GetBuffer
97	MODULE procedure PMC_C_GetBuffer
98	END INTERFACE PMC_C_GetBuffer
99
100	INTERFACE PMC_C_PutBuffer
101	MODULE procedure PMC_C_PutBuffer
102	END INTERFACE PMC_C_PutBuffer
103
104	! Public section
105
106	PUBLIC PMC_ClientInit , PMC_Set_DataArray_Name, PMC_C_Get_2D_index_list
107	PUBLIC PMC_C_GetNextArray, PMC_C_Set_DataArray
108	PUBLIC PMC_C_setInd_and_AllocMem , PMC_C_GetBuffer, PMC_C_PutBuffer ! ,PMC_C_GetServerType
109
110	CONTAINS
111
112	SUBROUTINE PMC_ClientInit
113	IMPLICIT none
114
115	INTEGER :: i
116	INTEGER :: istat
117
118
119	! Tailor MPI environment
120
121	me%model_comm = m_model_comm
122	me%inter_comm = m_to_server_comm
123
124	! Get rank and size
125	CALL MPI_Comm_rank (me%model_comm, me%model_rank, istat);
126	CALL MPI_Comm_size (me%model_comm, me%model_npes, istat);
127	CALL MPI_Comm_remote_size (me%inter_comm, me%inter_npes, istat);
128
129	! intra communicater is used for MPI_Get
130	CALL MPI_Intercomm_merge (me%inter_comm, .true., me%intra_comm, istat);
131	CALL MPI_Comm_rank (me%intra_comm, me%intra_rank, istat);
132
133	ALLOCATE (me%PEs(me%inter_npes))
134
135	do i=1,me%inter_npes
136	NULLIFY(me%PEs(i)%Arrays)
137	end do
138
139	if(me%model_rank == 0) write(0,'(a,5i6)') 'PMC_ClientInit ',me%model_rank,me%model_npes,me%inter_npes,me%intra_rank
140
141	return
142	END SUBROUTINE PMC_ClientInit
143
144	SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat, LastEntry)
145	IMPLICIT none
146	character(len=*),INTENT(IN) :: ServerArrayName
147	character(len=*),INTENT(IN) :: ServerArrayDesc
148	character(len=*),INTENT(IN) :: ClientArrayName
149	character(len=*),INTENT(IN) :: ClientArrayDesc
150	INTEGER,INTENT(OUT) :: istat
151	LOGICAL,INTENT(IN),optional :: LastEntry
152
153	!-- local variables
154	type(DA_NameDef) :: myName
155	INTEGER :: myPe
156	INTEGER :: my_AddiArray=0
157
158	istat = PMC_STATUS_OK
159	if(len(trim(ServerArrayName)) > DA_Namelen .or. &
160	len(trim(ClientArrayName)) > DA_Namelen) then !Name too long
161	istat = PMC_DA_NAME_ERR
162	end if
163
164	if(m_model_rank == 0) then
165	myIndex = myIndex+1
166	myName%couple_index = myIndex
167	myName%ServerDesc = trim(ServerArrayDesc)
168	myName%NameOnServer = trim(ServerArrayName)
169	myName%ClientDesc = trim(ClientArrayDesc)
170	myName%NameOnClient = trim(ClientArrayName)
171	end if
172
173	! Broadcat to all Client PEs
174
175	CALL PMC_Bcast ( myName%couple_index, 0, comm=m_model_comm)
176	CALL PMC_Bcast ( myName%ServerDesc, 0, comm=m_model_comm)
177	CALL PMC_Bcast ( myName%NameOnServer, 0, comm=m_model_comm)
178	CALL PMC_Bcast ( myName%ClientDesc, 0, comm=m_model_comm)
179	CALL PMC_Bcast ( myName%NameOnClient, 0, comm=m_model_comm)
180
181	! Broadcat to all Server PEs
182
183	if(m_model_rank == 0) then
184	myPE = MPI_ROOT
185	else
186	myPE = MPI_PROC_NULL
187	endif
188	CALL PMC_Bcast ( myName%couple_index, myPE, comm=m_to_server_comm)
189	CALL PMC_Bcast ( myName%ServerDesc, myPE, comm=m_to_server_comm)
190	CALL PMC_Bcast ( myName%NameOnServer, myPE, comm=m_to_server_comm)
191	CALL PMC_Bcast ( myName%ClientDesc, myPE, comm=m_to_server_comm)
192	CALL PMC_Bcast ( myName%NameOnClient, myPE, comm=m_to_server_comm)
193
194	if(present (LastEntry)) then
195	CALL PMC_Set_DataArray_Name_LastEntry ( LastEntry = LastEntry)
196	end if
197
198	CALL PMC_G_SetName (me, myName%couple_index, myName%NameOnClient)
199
200	return
201	END SUBROUTINE PMC_Set_DataArray_Name
202
203	SUBROUTINE PMC_Set_DataArray_Name_LastEntry (LastEntry)
204	IMPLICIT none
205	LOGICAL,INTENT(IN),optional :: LastEntry
206
207	!-- local variables
208	type(DA_NameDef) :: myName
209	INTEGER :: myPe
210
211	myName%couple_index = -1
212
213	if(m_model_rank == 0) then
214	myPE = MPI_ROOT
215	else
216	myPE = MPI_PROC_NULL
217	endif
218	CALL PMC_Bcast ( myName%couple_index, myPE, comm=m_to_server_comm)
219
220	return
221	END SUBROUTINE PMC_Set_DataArray_Name_LastEntry
222
223	SUBROUTINE PMC_C_Get_2D_index_list
224	IMPLICIT none
225
226	INTEGER :: i,j,i2,nr,ierr
227	INTEGER :: dummy
228	INTEGER :: indWin !: MPI window object
229	INTEGER :: indWin2 !: MPI window object
230	INTEGER(KIND=MPI_ADDRESS_KIND) :: win_size !: Size of MPI window 1 (in bytes)
231	INTEGER(KIND=MPI_ADDRESS_KIND) :: disp !: Displacement Unit (Integer = 4, floating poit = 8
232	INTEGER,DIMENSION(me%inter_npes*2) :: NrEle !: Number of Elements of a horizontal slice
233	TYPE(PeDef),POINTER :: aPE !: Pointer to PeDef strzcture
234	INTEGER(KIND=MPI_ADDRESS_KIND) :: WinSize !: Size of MPI window 2 (in bytes)
235	INTEGER,DIMENSION(:),POINTER :: myInd
236
237	! CALL PMC_C_CGet_Rem_index_list
238
239	win_size = c_sizeof(dummy)
240	CALL MPI_Win_create (dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm, indWin, ierr);
241	CALL MPI_Win_fence (0, indWin, ierr) ! Open Window on Server side
242	CALL MPI_Win_fence (0, indWin, ierr) ! Close Window on Server Side and opem on Client side
243
244	do i=1,me%inter_npes
245	disp = me%model_rank*2
246	CALL MPI_Get (NrEle((i-1)*2+1),2,MPI_INTEGER,i-1,disp,2,MPI_INTEGER,indWin, ierr)
247	end do
248	CALL MPI_Win_fence (0, indWin, ierr) ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
249
250	WinSize = 0
251	do i=1,me%inter_npes !Allocate memory for index array
252	aPE => me%PEs(i)
253	i2 = (i-1)*2+1
254	nr = NrEle(i2+1)
255	if(nr > 0) then
256	ALLOCATE(aPE%locInd(nr))
257	else
258	NULLIFY (aPE%locInd)
259	endif
260	WinSize = max(nr,WinSize) !Maximum window size
261	end do
262
263	ALLOCATE(myInd(2*WinSize))
264	WinSize = WinSize*c_sizeof(i)
265
266	! local Buffer used in MPI_Get can but must not be inside the MPI Window
267	! Here, we use a dummy for MPI Window because the server PEs do not access the RMA window via MPI_get or MPI_Put
268
269	CALL MPI_Win_create (dummy, 1, iwp, MPI_INFO_NULL, me%intra_comm, indWin2, ierr);
270
271	CALL MPI_Win_fence (0, indWin2, ierr) ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
272	CALL MPI_Win_fence (0, indWin2, ierr) ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
273
274	do i=1,me%inter_npes
275	aPE => me%PEs(i)
276	nr = NrEle(i*2)
277	if(nr > 0 ) then
278	disp = NrEle(2*(i-1)+1)
279	CALL MPI_Win_lock (MPI_LOCK_SHARED , i-1, 0, indWin2, ierr)
280	CALL MPI_Get (myInd,2nr,MPI_INTEGER,i-1,disp,2nr,MPI_INTEGER,indWin2, ierr)
281	CALL MPI_Win_unlock (i-1, indWin2, ierr)
282	do j=1,nr
283	aPE%locInd(j)%i = myInd(2*j-1)
284	aPE%locInd(j)%j = myInd(2*j)
285	end do
286	aPE%NrEle = nr
287	else
288	aPE%NrEle = -1
289	end if
290	end do
291
292	CALL MPI_Barrier(me%intra_comm, ierr) ! Dont know why, but this barrier is necessary before we can free the windows
293
294	CALL MPI_Win_free(indWin, ierr);
295	CALL MPI_Win_free(indWin2, ierr);
296	DEALLOCATE (myInd)
297
298	return
299	END SUBROUTINE PMC_C_Get_2D_index_list
300
301	LOGICAL function PMC_C_GetNextArray (myName)
302	character(len=*),INTENT(OUT) :: myName
303
304	!-- local variables
305	INTEGER :: MyCoupleIndex
306	LOGICAL :: MyLast !Last Array in List
307	character(len=DA_Namelen) :: loName
308
309	loName = 'NoName '
310	MyLast = .true.
311
312	CALL PMC_G_GetName (me, MyCoupleIndex, loName, MyLast)
313
314	myName = trim(loName)
315
316	PMC_C_GetNextArray = .NOT. MyLast ! Return true if valid array
317
318	return
319	END function PMC_C_GetNextArray
320
321	SUBROUTINE PMC_C_Set_DataArray_2d (array)
322	IMPLICIT none
323	!-- TO_DO: is double precision absolutely required here?
324	REAL(kind=dp),INTENT(IN),DIMENSION(:,:) :: array
325	!-- local variables
326	INTEGER :: NrDims
327	INTEGER,DIMENSION (4) :: dims
328	INTEGER :: dim_order
329	TYPE(c_ptr) :: array_adr
330	INTEGER :: i
331	TYPE(PeDef),POINTER :: aPE
332	TYPE(ArrayDef),POINTER :: ar
333
334
335	dims = 1
336
337	NrDims = 2
338	dims(1) = size(array,1)
339	dims(2) = size(array,2)
340	dim_order = 2
341
342	array_adr = c_loc(array)
343
344	do i=1,me%inter_npes
345	aPE => me%PEs(i)
346	ar => aPE%Arrays
347	ar%NrDims = NrDims
348	ar%A_dim = dims
349	ar%dim_order = dim_order
350	ar%data = array_adr
351	end do
352
353	return
354	END SUBROUTINE PMC_C_Set_DataArray_2d
355
356	SUBROUTINE PMC_C_Set_DataArray_3d (array)
357	IMPLICIT none
358	!-- TO_DO: is double precision absolutely required here?
359	REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:) :: array
360	!-- local variables
361	INTEGER :: NrDims
362	INTEGER,DIMENSION (4) :: dims
363	INTEGER :: dim_order
364	TYPE(c_ptr) :: array_adr
365	INTEGER :: i
366	TYPE(PeDef),POINTER :: aPE
367	TYPE(ArrayDef),POINTER :: ar
368
369	dims = 1
370
371	NrDims = 3
372	dims(1) = size(array,1)
373	dims(2) = size(array,2)
374	dims(3) = size(array,3)
375	dim_order =33
376
377	array_adr = c_loc(array)
378
379	do i=1,me%inter_npes
380	aPE => me%PEs(i)
381	ar => aPE%Arrays
382	ar%NrDims = NrDims
383	ar%A_dim = dims
384	ar%dim_order = dim_order
385	ar%data = array_adr
386	end do
387
388	return
389	END SUBROUTINE PMC_C_Set_DataArray_3d
390
391	SUBROUTINE PMC_C_setInd_and_AllocMem
392
393	IMPLICIT none
394
395	INTEGER :: i, ierr
396	INTEGER :: arlen, myIndex, tag
397	INTEGER(idp) :: bufsize ! Size of MPI data Window
398	TYPE(PeDef),POINTER :: aPE
399	TYPE(ArrayDef),POINTER :: ar
400	character(len=DA_Namelen) :: myName
401	Type(c_ptr) :: base_ptr
402	REAL(kind=wp),DIMENSION(:),POINTER :: base_array
403	INTEGER(KIND=MPI_ADDRESS_KIND) :: WinSize
404
405	myIndex = 0
406	bufsize = 8
407
408	! First stride, Compute size and set index
409
410	do i=1,me%inter_npes
411	aPE => me%PEs(i)
412	tag = 200
413
414	do while (PMC_C_GetNextArray (myName))
415	ar => aPE%Arrays
416
417	! Receive Index from client
418	tag = tag+1
419	CALL MPI_Recv (myIndex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, MPI_STATUS_IGNORE, ierr)
420
421	if(ar%dim_order == 33) then ! PALM has k in first dimension
422	bufsize = max(bufsize,ar%A_dim(1)ar%A_dim(2)ar%A_dim(3)) ! determine max, because client buffer is allocated only once
423	else
424	bufsize = max(bufsize,ar%A_dim(1)*ar%A_dim(2))
425	end if
426	ar%BufIndex = myIndex
427	end do
428	end do
429
430	! Create RMA (One Sided Communication) window for data buffer
431
432	CALL PMC_Alloc_mem (base_array, bufsize, base_ptr)
433	me%TotalBufferSize = bufsize*wp !Total buffer size in Byte
434
435	WinSize = me%TotalBufferSize
436	! write(9,'(a,8i7)') 'PMC_S_SetInd_and_Mem ',m_model_rank,me%inter_npes,WinSize,ar%A_dim
437	CALL MPI_Win_create (base_array, WinSize, wp, MPI_INFO_NULL, me%intra_comm, me%BufWin, ierr);
438	CALL MPI_Win_fence (0, me%BufWin, ierr); ! Open Window to set data
439	CALL MPI_Barrier(me%intra_comm, ierr)
440
441	do i=1,me%inter_npes
442	aPE => me%PEs(i)
443
444	do while (PMC_C_GetNextArray (myName))
445	ar => aPE%Arrays
446	ar%SendBuf = base_ptr
447	end do
448	end do
449
450	return
451	END SUBROUTINE PMC_C_setInd_and_AllocMem
452
453	SUBROUTINE PMC_C_GetBuffer (WaitTime)
454	IMPLICIT none
455	REAL(kind=dp),INTENT(OUT),optional :: WaitTime
456
457	!-- local variables
458	INTEGER :: ip, ij, ierr
459	INTEGER :: nr ! Number of Elements to getb from server
460	INTEGER :: myIndex
461	REAL(kind=dp) :: t1,t2
462	TYPE(PeDef),POINTER :: aPE
463	TYPE(ArrayDef),POINTER :: ar
464	INTEGER,DIMENSION(1) :: buf_shape
465	REAL(kind=wp),POINTER,DIMENSION(:) :: buf
466	REAL(kind=wp),POINTER,DIMENSION(:,:) :: data_2d
467	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: data_3d
468	character(len=DA_Namelen) :: myName
469	INTEGER(kind=MPI_ADDRESS_KIND) :: target_disp
470
471	t1 = PMC_Time()
472	CALL MPI_Barrier(me%intra_comm, ierr) ! Wait for server to fill buffer
473	t2 = PMC_Time()
474	if(present(WaitTime)) WaitTime = t2-t1
475
476	CALL MPI_Barrier(me%intra_comm, ierr) ! Wait for buffer is filled
477
478	do ip=1,me%inter_npes
479	aPE => me%PEs(ip)
480
481	do while (PMC_C_GetNextArray (myName))
482	ar => aPE%Arrays
483	if(ar%dim_order == 2) then
484	nr = aPE%NrEle
485	else if(ar%dim_order == 33) then
486	nr = aPE%NrEle*ar%A_dim(1)
487	end if
488
489	buf_shape(1) = nr
490	CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
491
492	if(nr > 0) then
493	target_disp = (ar%BufIndex-1)
494	CALL MPI_Win_lock (MPI_LOCK_SHARED , ip-1, 0, me%BufWin, ierr)
495	CALL MPI_Get (buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, me%BufWin, ierr)
496	CALL MPI_Win_unlock (ip-1, me%BufWin, ierr)
497	end if
498
499	myIndex = 1
500	if(ar%dim_order == 2) then
501
502	CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
503	do ij=1,aPE%NrEle
504	data_2d(aPE%locInd(ij)%j,aPE%locInd(ij)%i) = buf(myIndex)
505	myIndex = myIndex+1
506	end do
507	else if(ar%dim_order == 33) then
508	CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
509	do ij=1,aPE%NrEle
510	data_3d(:,aPE%locInd(ij)%j,aPE%locInd(ij)%i) = buf(myIndex:myIndex+ar%A_dim(1)-1)
511	myIndex = myIndex+ar%A_dim(1)
512	end do
513	end if
514
515	end do
516	end do
517	return
518	END SUBROUTINE PMC_C_GetBuffer
519
520	SUBROUTINE PMC_C_PutBuffer (WaitTime)
521	IMPLICIT none
522	REAL(kind=dp),INTENT(OUT),optional :: WaitTime
523
524	!-- local variables
525	INTEGER :: ip, ij, ierr
526	INTEGER :: nr ! Number of Elements to getb from server
527	INTEGER :: myIndex
528	REAL(kind=dp) :: t1,t2
529	TYPE(PeDef),POINTER :: aPE
530	TYPE(ArrayDef),POINTER :: ar
531	INTEGER,DIMENSION(1) :: buf_shape
532	REAL(kind=wp),POINTER,DIMENSION(:) :: buf
533	REAL(kind=wp),POINTER,DIMENSION(:,:) :: data_2d
534	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: data_3d
535	character(len=DA_Namelen) :: myName
536	INTEGER(kind=MPI_ADDRESS_KIND) :: target_disp
537
538
539	do ip=1,me%inter_npes
540	aPE => me%PEs(ip)
541
542	do while (PMC_C_GetNextArray (myName))
543	ar => aPE%Arrays
544	if(ar%dim_order == 2) then
545	nr = aPE%NrEle
546	else if(ar%dim_order == 33) then
547	nr = aPE%NrEle*ar%A_dim(1)
548	end if
549
550	buf_shape(1) = nr
551	CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
552
553	myIndex = 1
554	if(ar%dim_order == 2) then
555	CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
556	do ij=1,aPE%NrEle
557	buf(myIndex) = data_2d(aPE%locInd(ij)%j,aPE%locInd(ij)%i)
558	myIndex = myIndex+1
559	end do
560	else if(ar%dim_order == 33) then
561	CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
562	do ij=1,aPE%NrEle
563	buf(myIndex:myIndex+ar%A_dim(1)-1) = data_3d(:,aPE%locInd(ij)%j,aPE%locInd(ij)%i)
564	myIndex = myIndex+ar%A_dim(1)
565	end do
566	end if
567
568	if(nr > 0) then
569	target_disp = (ar%BufIndex-1)
570	CALL MPI_Win_lock (MPI_LOCK_SHARED , ip-1, 0, me%BufWin, ierr)
571	CALL MPI_Put (buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, me%BufWin, ierr)
572	CALL MPI_Win_unlock (ip-1, me%BufWin, ierr)
573	end if
574
575	end do
576	end do
577
578
579	t1 = PMC_Time()
580	CALL MPI_Barrier(me%intra_comm, ierr) ! Wait for server to fill buffer
581	t2 = PMC_Time()
582	if(present(WaitTime)) WaitTime = t2-t1
583
584	CALL MPI_Barrier(me%intra_comm, ierr) ! Wait for buffer is filled
585
586
587	return
588	END SUBROUTINE PMC_C_PutBuffer
589
590	#endif
591	END MODULE pmc_client

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |