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

Last change on this file since 32 was 32, checked in by ymipsl, 15 years ago

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