source: XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_client.f90 @ 43

Last change on this file since 43 was 43, checked in by ymipsl, 12 years ago

Correction de bug lorsque le serveur accumule trop de requÚtes et ne passe pas en mode bloquant.
YM

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