source: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90 @ 2769

Last change on this file since 2769 was 2769, checked in by smasson, 10 years ago

end of bugfix started in changeset:2767

  • Property svn:keywords set to Id
File size: 5.4 KB
Line 
1MODULE mod_mpi_buffer_client
2  USE mod_mpi_buffer_parameters
3#if defined key_mpp_mpi
4  USE mpi, ONLY : status_size=>MPI_STATUS_SIZE
5#else
6  INTEGER, PARAMETER :: status_size = 1
7#endif
8
9 
10  INTEGER(KIND=8),POINTER :: MPI_Buffer(:)
11 
12  TYPE mpi_requests
13    INTEGER :: request
14    INTEGER :: status(status_size)
15    INTEGER :: Pos
16  END TYPE mpi_requests
17 
18  TYPE(mpi_requests),DIMENSION(max_request) :: pending_request
19 
20  INTEGER :: Buffer_pos
21  INTEGER :: request_pos
22  INTEGER :: buffer_begin
23  INTEGER :: request_begin
24  INTEGER :: nb_request_pending
25  INTEGER,SAVE :: start_pos
26  LOGICAL,SAVE :: ok_new_request
27  LOGICAL,SAVE :: is_last_request
28
29  INTEGER,SAVE      :: mpi_buffer_size
30  INTEGER,SAVE      :: aggregated_request
31
32CONTAINS
33
34  SUBROUTINE Init_mpi_buffer
35  USE mod_global_memory
36  USE mod_pack
37  USE mod_ioclient_para
38  IMPLICIT NONE
39
40  INTEGER  :: nb_client
41 
42    nb_client=iosize-1 
43    mpi_buffer_size=global_mpi_buffer_size/nb_client
44   
45    CALL allocate_global_memory(mpi_buffer_size,MPI_Buffer)
46    buffer_begin=1
47    request_begin=1
48    Buffer_pos=1
49    nb_request_pending=0
50    Request_pos=1
51    ok_new_request=.TRUE.
52    is_last_request=.FALSE.
53    aggregated_request=0
54   
55    CALL set_pack_buffer(MPI_Buffer,buffer_begin)
56   
57  END SUBROUTINE Init_mpi_buffer
58 
59
60  SUBROUTINE create_request(request_id)
61  USE mod_pack
62  USE mod_ioclient_para
63  USE mpitrace
64  USE mpi_mod
65  IMPLICIT NONE
66    INTEGER :: request_id
67   
68    CALL VTb(VTprocess_event)
69    IF (ok_new_request) THEN 
70      Pending_request(Request_pos)%Pos = pack_pos
71      ok_new_request=.FALSE.
72    ENDIF
73    start_pos=pack_pos
74    pack_pos=pack_pos+1
75!    PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
76    CALL pack_data(request_id)
77  END SUBROUTINE create_request
78 
79 
80  SUBROUTINE Finalize_request
81  USE mod_pack
82  USE mod_ioclient_para
83  USE mpitrace
84  use mod_wait
85  USE mpi_mod
86  IMPLICIT NONE
87    INTEGER :: ierr
88    INTEGER :: message_size
89    INTEGER(KIND=8) :: request_size
90    INTEGER :: buffer_free
91    LOGICAL :: ok_out
92    LOGICAL :: is_Buffer_full
93    request_size=pack_pos-start_pos   
94    pack_buffer(start_pos)=request_size
95    message_size=pack_pos-Pending_request(Request_pos)%Pos
96    aggregated_request=aggregated_request+1
97
98
99!! ICI verifier que le buffer ne se recouvre pas ainsi que les requetes
100   
101    ok_out=.FALSE.
102    is_buffer_full=.FALSE.
103    DO WHILE (.NOT. ok_out)
104      CALL check_request
105   
106      IF ( buffer_begin <= pack_pos) THEN
107        Buffer_free=mpi_buffer_size-pack_pos+1
108      ELSE
109        Buffer_free=buffer_begin-pack_pos
110      ENDIF
111     
112!      Print *,"message_size",message_size,"buffer_free",buffer_free
113!      PRINT *,"Request_pos",request_pos
114!      PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
115      IF ( nb_request_pending==1 .AND. ( (buffer_free < MPI_buffer_size * 0.4) .OR. is_last_request .OR.  &
116                                         (aggregated_request>=max_request/2) )) THEN
117        ok_out=.FALSE.
118        CALL Wait_us(10)
119        IF (.NOT. is_buffer_full) THEN
120          CALL VTb(VTbuffer_full)
121        ENDIF     
122        is_Buffer_full=.TRUE.
123       
124      ELSE
125        ok_out=.TRUE.
126        IF (is_buffer_full) THEN
127          CALL VTe(VTbuffer_full)
128        ENDIF
129        is_buffer_full=.FALSE.
130     
131      ENDIF
132     
133   ENDDO
134   
135   IF (nb_request_pending==0 .OR. (buffer_free < MPI_buffer_size* 0.4 ) .OR. (aggregated_request> max_request/2) ) THEN
136     
137     CALL MPI_ISSEND(MPI_Buffer(Pending_request(Request_pos)%Pos),message_size,MPI_INTEGER8,     &
138                    server_rank,tag_iocomm,iocomm,Pending_request(Request_pos)%request,ierr )
139   
140!    PRINT *,"Requete envoy�e !!!!"
141!    PRINT *,"Message : ",MPI_Buffer(Pending_request(Request_pos)%Pos:Pending_request(Request_pos)%Pos+message_size-1)             
142      IF ( Pack_Pos > MPI_buffer_size*0.6 ) THEN
143        Pack_Pos=1
144      ENDIF
145   
146      IF (Request_Pos==max_request) THEN
147        Request_Pos=1
148      ELSE
149        Request_Pos=Request_Pos+1
150      ENDIF
151      nb_request_pending=nb_request_pending+1
152   
153      ok_new_request=.TRUE.
154      aggregated_request=0
155    ENDIF
156    CALL VTe(VTprocess_event)   
157  END SUBROUTINE Finalize_request
158
159
160  SUBROUTINE Check_request
161  USE mpi_mod
162  IMPLICIT NONE
163  LOGICAL :: ok_out
164  LOGICAL :: OK_complete
165  INTEGER :: ierr
166 
167!    PRINT *, 'on entre dans Check_request'
168!    PRINT *, 'nb_request_pending',nb_request_pending
169   
170    IF (nb_request_pending>0) THEN
171      ok_out=.FALSE.
172    ELSE
173      ok_out=.TRUE.
174    ENDIF
175   
176    DO WHILE (.NOT. ok_out)
177   
178!      PRINT *,'Testing_request...'
179!      PRINT *,'request_begin',request_begin
180      CALL MPI_TEST(Pending_request(request_begin)%request,ok_complete,Pending_request(request_begin)%status,ierr)
181!      PRINT *,'Request has been tested...'
182      IF (ok_complete) THEN
183!        PRINT *,"Request_completed"
184        IF (Request_begin==max_request) THEN
185          Request_begin=1
186        ELSE
187          request_begin=request_begin+1
188        ENDIF
189       
190        buffer_begin=Pending_request(request_begin)%Pos
191       
192        nb_request_pending=nb_request_pending-1
193       
194        IF (nb_request_pending==0) THEN
195          ok_out=.TRUE.
196        ELSE
197          ok_out=.FALSE.
198        ENDIF
199      ELSE
200        ok_out=.TRUE.
201      ENDIF
202   
203    ENDDO
204!    PRINT *, 'on sort de Check_request' 
205  END SUBROUTINE Check_Request
206
207END MODULE mod_mpi_buffer_client
Note: See TracBrowser for help on using the repository browser.