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

Last change on this file since 46 was 46, checked in by ymipsl, 13 years ago

Ligne trop longue sous SX (>132 caractÚres)

YM

File size: 5.3 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.  &
111                                         (aggregated_request>=max_request/2) )) THEN
112        ok_out=.FALSE.
113        CALL Wait_us(10)
114        IF (.NOT. is_buffer_full) THEN
115          CALL VTb(VTbuffer_full)
116        ENDIF     
117        is_Buffer_full=.TRUE.
118       
119      ELSE
120        ok_out=.TRUE.
121        IF (is_buffer_full) THEN
122          CALL VTe(VTbuffer_full)
123        ENDIF
124        is_buffer_full=.FALSE.
125     
126      ENDIF
127     
128   ENDDO
129   
130   IF (nb_request_pending==0 .OR. (buffer_free < MPI_buffer_size* 0.4 ) .OR. (aggregated_request> max_request/2) ) THEN
131     
132     CALL MPI_ISSEND(MPI_Buffer(Pending_request(Request_pos)%Pos),message_size,MPI_INTEGER8,     &
133                    server_rank,tag_iocomm,iocomm,Pending_request(Request_pos)%request,ierr )
134   
135!    PRINT *,"Requete envoyï¿œe !!!!"
136!    PRINT *,"Message : ",MPI_Buffer(Pending_request(Request_pos)%Pos:Pending_request(Request_pos)%Pos+message_size-1)             
137      IF ( Pack_Pos > MPI_buffer_size*0.6 ) THEN
138        Pack_Pos=1
139      ENDIF
140   
141      IF (Request_Pos==max_request) THEN
142        Request_Pos=1
143      ELSE
144        Request_Pos=Request_Pos+1
145      ENDIF
146      nb_request_pending=nb_request_pending+1
147   
148      ok_new_request=.TRUE.
149      aggregated_request=0
150    ENDIF
151    CALL VTe(VTprocess_event)   
152  END SUBROUTINE Finalize_request
153
154
155  SUBROUTINE Check_request
156  USE mpi_mod
157  IMPLICIT NONE
158  LOGICAL :: ok_out
159  LOGICAL :: OK_complete
160  INTEGER :: ierr
161 
162!    PRINT *, 'on entre dans Check_request'
163!    PRINT *, 'nb_request_pending',nb_request_pending
164   
165    IF (nb_request_pending>0) THEN
166      ok_out=.FALSE.
167    ELSE
168      ok_out=.TRUE.
169    ENDIF
170   
171    DO WHILE (.NOT. ok_out)
172   
173!      PRINT *,'Testing_request...'
174!      PRINT *,'request_begin',request_begin
175      CALL MPI_TEST(Pending_request(request_begin)%request,ok_complete,Pending_request(request_begin)%status,ierr)
176!      PRINT *,'Request has been tested...'
177      IF (ok_complete) THEN
178!        PRINT *,"Request_completed"
179        IF (Request_begin==max_request) THEN
180          Request_begin=1
181        ELSE
182          request_begin=request_begin+1
183        ENDIF
184       
185        buffer_begin=Pending_request(request_begin)%Pos
186       
187        nb_request_pending=nb_request_pending-1
188       
189        IF (nb_request_pending==0) THEN
190          ok_out=.TRUE.
191        ELSE
192          ok_out=.FALSE.
193        ENDIF
194      ELSE
195        ok_out=.TRUE.
196      ENDIF
197   
198    ENDDO
199!    PRINT *, 'on sort de Check_request' 
200  END SUBROUTINE Check_Request
201
202END MODULE mod_mpi_buffer_client
Note: See TracBrowser for help on using the repository browser.