Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |