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

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

Les buffers MPI sont maintenant donnes en quantite de memoire totale par serveur et non par client.
La valeur par defaut peut etre redefinie dans la namelist.

YM

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  IMPLICIT NONE
58    INCLUDE 'mpif.h'
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  IMPLICIT NONE
79    INCLUDE 'mpif.h'
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  IMPLICIT NONE
153  INCLUDE 'mpif.h'
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.