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

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

Feature : permet d'utiliser XMLIO-SERVER sans MPI, donc en mode édition de lien, sans server.

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