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

Last change on this file since 1762 was 1762, checked in by hellstea, 6 years ago

Introduction of nested domain system

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