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

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

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