1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5C
6C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C  University of Bordeaux.
8C
9C  This version of MUMPS is provided to you free of charge. It is
10C  released under the CeCILL-C license:
11C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
12C
13        MODULE SMUMPS_BUF
14        PRIVATE
15        PUBLIC :: SMUMPS_BUF_TRY_FREE_CB, SMUMPS_BUF_INIT,
16     &   SMUMPS_BUF_INI_MYID,
17     &   SMUMPS_BUF_ALLOC_CB ,       SMUMPS_BUF_DEALL_CB ,
18     &   SMUMPS_BUF_ALLOC_SMALL_BUF, SMUMPS_BUF_DEALL_SMALL_BUF,
19     &   SMUMPS_BUF_ALLOC_LOAD_BUFFER,SMUMPS_BUF_DEALL_LOAD_BUFFER,
20     &   SMUMPS_BUF_SEND_CB,     SMUMPS_BUF_SEND_VCB,
21     &   SMUMPS_BUF_SEND_1INT,       SMUMPS_BUF_SEND_DESC_BANDE,
22     &   SMUMPS_BUF_SEND_MAPLIG, SMUMPS_BUF_SEND_MAITRE2,
23     &   SMUMPS_BUF_SEND_CONTRIB_TYPE2,
24     &   SMUMPS_BUF_SEND_BLOCFACTO, SMUMPS_BUF_SEND_BLFAC_SLAVE,
25     &   SMUMPS_BUF_SEND_MASTER2SLAVE,
26     &   SMUMPS_BUF_SEND_CONTRIB_TYPE3, SMUMPS_BUF_SEND_RTNELIND,
27     &   SMUMPS_BUF_SEND_ROOT2SLAVE, SMUMPS_BUF_SEND_ROOT2SON,
28     &   SMUMPS_BUF_SEND_BACKVEC,SMUMPS_BUF_SEND_UPDATE_LOAD,
29     &   SMUMPS_BUF_DIST_IRECV_SIZE,
30     &   SMUMPS_BUF_BCAST_ARRAY, SMUMPS_BUF_ALL_EMPTY,
31     &   SMUMPS_BUF_BROADCAST, SMUMPS_BUF_SEND_NOT_MSTR,
32     &   SMUMPS_BUF_SEND_FILS ,SMUMPS_BUF_DEALL_MAX_ARRAY
33     &   ,SMUMPS_BUF_MAX_ARRAY_MINSIZE
34     &   ,SMUMPS_BUF_TEST
35        INTEGER NEXT, REQ, CONTENT, OVHSIZE
36        PARAMETER( NEXT = 0, REQ = 1, CONTENT = 2, OVHSIZE = 2 )
37        INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID
38        TYPE SMUMPS_COMM_BUFFER_TYPE
39          INTEGER LBUF, HEAD, TAIL,LBUF_INT, ILASTMSG
40          INTEGER, DIMENSION(:),POINTER :: CONTENT
41        END TYPE SMUMPS_COMM_BUFFER_TYPE
42        TYPE ( SMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB
43        TYPE ( SMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL
44        TYPE ( SMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD
45        INTEGER, SAVE :: SIZE_RBUF_BYTES
46        INTEGER, SAVE ::  BUF_LMAX_ARRAY
47        REAL, DIMENSION(:), ALLOCATABLE
48     &       , SAVE :: BUF_MAX_ARRAY
49        PUBLIC :: BUF_LMAX_ARRAY, BUF_MAX_ARRAY
50      CONTAINS
51        SUBROUTINE SMUMPS_BUF_TRY_FREE_CB()
52        CALL SMUMPS_BUF_TRY_FREE(BUF_CB)
53        RETURN
54        END SUBROUTINE SMUMPS_BUF_TRY_FREE_CB
55        SUBROUTINE SMUMPS_BUF_TRY_FREE(B)
56        IMPLICIT NONE
57        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B
58        INCLUDE 'mpif.h'
59        LOGICAL :: FLAG
60        INTEGER :: IERR
61        INTEGER :: STATUS(MPI_STATUS_SIZE)
62        IF ( B%HEAD .NE. B%TAIL ) THEN
63 10       CONTINUE
64          CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR )
65          IF ( FLAG ) THEN
66            B%HEAD = B%CONTENT( B%HEAD + NEXT )
67            IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL
68            IF ( B%HEAD .NE. B%TAIL ) GOTO 10
69          END IF
70        END IF
71        IF ( B%HEAD .EQ. B%TAIL ) THEN
72          B%HEAD = 1
73          B%TAIL = 1
74          B%ILASTMSG = 1
75        END iF
76        RETURN
77        END SUBROUTINE SMUMPS_BUF_TRY_FREE
78        SUBROUTINE SMUMPS_BUF_INI_MYID( MYID )
79        IMPLICIT NONE
80        INTEGER MYID
81        BUF_MYID  = MYID
82        RETURN
83        END SUBROUTINE SMUMPS_BUF_INI_MYID
84        SUBROUTINE SMUMPS_BUF_INIT( IntSize, RealSize )
85        IMPLICIT NONE
86        INTEGER IntSize, RealSize
87        SIZEofINT = IntSize
88        SIZEofREAL = RealSize
89        NULLIFY(BUF_CB  %CONTENT)
90        NULLIFY(BUF_SMALL%CONTENT)
91        NULLIFY(BUF_LOAD%CONTENT)
92        BUF_CB%LBUF     = 0
93        BUF_CB%LBUF_INT = 0
94        BUF_CB%HEAD     = 1
95        BUF_CB%TAIL     = 1
96        BUF_CB%ILASTMSG = 1
97        BUF_SMALL%LBUF     = 0
98        BUF_SMALL%LBUF_INT = 0
99        BUF_SMALL%HEAD     = 1
100        BUF_SMALL%TAIL     = 1
101        BUF_SMALL%ILASTMSG = 1
102        BUF_LOAD%LBUF     = 0
103        BUF_LOAD%LBUF_INT = 0
104        BUF_LOAD%HEAD     = 1
105        BUF_LOAD%TAIL     = 1
106        BUF_LOAD%ILASTMSG = 1
107        RETURN
108        END SUBROUTINE SMUMPS_BUF_INIT
109        SUBROUTINE SMUMPS_BUF_ALLOC_CB( SIZE, IERR )
110        IMPLICIT NONE
111        INTEGER SIZE, IERR
112        CALL BUF_ALLOC( BUF_CB, SIZE, IERR )
113        RETURN
114        END SUBROUTINE SMUMPS_BUF_ALLOC_CB
115        SUBROUTINE SMUMPS_BUF_ALLOC_SMALL_BUF( SIZE, IERR )
116        IMPLICIT NONE
117        INTEGER SIZE, IERR
118        CALL BUF_ALLOC( BUF_SMALL, SIZE, IERR )
119        RETURN
120        END SUBROUTINE SMUMPS_BUF_ALLOC_SMALL_BUF
121        SUBROUTINE SMUMPS_BUF_ALLOC_LOAD_BUFFER( SIZE, IERR )
122        IMPLICIT NONE
123        INTEGER SIZE, IERR
124        CALL BUF_ALLOC( BUF_LOAD, SIZE, IERR )
125        RETURN
126        END SUBROUTINE SMUMPS_BUF_ALLOC_LOAD_BUFFER
127        SUBROUTINE SMUMPS_BUF_DEALL_LOAD_BUFFER( IERR )
128        IMPLICIT NONE
129        INTEGER IERR
130        CALL BUF_DEALL( BUF_LOAD, IERR )
131        RETURN
132        END SUBROUTINE SMUMPS_BUF_DEALL_LOAD_BUFFER
133        SUBROUTINE SMUMPS_BUF_DEALL_MAX_ARRAY()
134        IMPLICIT NONE
135        IF (allocated( BUF_MAX_ARRAY)) DEALLOCATE( BUF_MAX_ARRAY )
136        RETURN
137        END SUBROUTINE SMUMPS_BUF_DEALL_MAX_ARRAY
138        SUBROUTINE SMUMPS_BUF_MAX_ARRAY_MINSIZE(NFS4FATHER,IERR)
139        IMPLICIT NONE
140        INTEGER IERR, NFS4FATHER
141        IERR = 0
142        IF (allocated( BUF_MAX_ARRAY)) THEN
143          IF (BUF_LMAX_ARRAY .GE. NFS4FATHER) RETURN
144          DEALLOCATE( BUF_MAX_ARRAY )
145        ENDIF
146        ALLOCATE(BUF_MAX_ARRAY(NFS4FATHER),stat=IERR)
147        BUF_LMAX_ARRAY=NFS4FATHER
148        RETURN
149        END SUBROUTINE SMUMPS_BUF_MAX_ARRAY_MINSIZE
150        SUBROUTINE SMUMPS_BUF_DEALL_CB( IERR )
151        IMPLICIT NONE
152        INTEGER IERR
153        CALL BUF_DEALL( BUF_CB, IERR )
154        RETURN
155        END SUBROUTINE SMUMPS_BUF_DEALL_CB
156        SUBROUTINE SMUMPS_BUF_DEALL_SMALL_BUF( IERR )
157        IMPLICIT NONE
158        INTEGER IERR
159        CALL BUF_DEALL( BUF_SMALL, IERR )
160        RETURN
161        END SUBROUTINE SMUMPS_BUF_DEALL_SMALL_BUF
162        SUBROUTINE BUF_ALLOC( BUF, SIZE, IERR )
163        IMPLICIT NONE
164        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: BUF
165        INTEGER SIZE, IERR
166        IERR         = 0
167        BUF%LBUF     = SIZE
168        BUF%LBUF_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT
169        IF ( associated ( BUF%CONTENT ) ) DEALLOCATE( BUF%CONTENT )
170        ALLOCATE( BUF%CONTENT( BUF%LBUF_INT ), stat = IERR )
171        IF (IERR .NE. 0) THEN
172          NULLIFY( BUF%CONTENT )
173          IERR         = -1
174          BUF%LBUF     =  0
175          BUF%LBUF_INT =  0
176        END IF
177        BUF%HEAD     = 1
178        BUF%TAIL     = 1
179        BUF%ILASTMSG = 1
180        RETURN
181        END SUBROUTINE BUF_ALLOC
182        SUBROUTINE BUF_DEALL( BUF, IERR )
183        IMPLICIT NONE
184        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: BUF
185        INCLUDE 'mpif.h'
186        INTEGER :: IERR
187        INTEGER :: STATUS(MPI_STATUS_SIZE)
188        LOGICAL :: FLAG
189        IF ( .NOT. associated ( BUF%CONTENT ) ) THEN
190          BUF%HEAD     = 1
191          BUF%LBUF     = 0
192          BUF%LBUF_INT = 0
193          BUF%TAIL     = 1
194          BUF%ILASTMSG = 1
195          RETURN
196        END IF
197        DO WHILE ( BUF%HEAD.NE.0 .AND. BUF%HEAD .NE. BUF%TAIL )
198          CALL MPI_TEST(BUF%CONTENT( BUF%HEAD + REQ ), FLAG,
199     &                  STATUS, IERR)
200          IF ( .not. FLAG ) THEN
201            WRITE(*,*) '** Warning: trying to cancel a request.'
202            WRITE(*,*) '** This might be problematic'
203            CALL MPI_CANCEL( BUF%CONTENT( BUF%HEAD + REQ ), IERR )
204            CALL MPI_REQUEST_FREE( BUF%CONTENT( BUF%HEAD + REQ ), IERR )
205          END IF
206          BUF%HEAD = BUF%CONTENT( BUF%HEAD + NEXT )
207        END DO
208        DEALLOCATE( BUF%CONTENT )
209        NULLIFY( BUF%CONTENT )
210        BUF%LBUF     = 0
211        BUF%LBUF_INT = 0
212        BUF%HEAD     = 1
213        BUF%TAIL     = 1
214        BUF%ILASTMSG = 1
215        RETURN
216        END SUBROUTINE BUF_DEALL
217        SUBROUTINE SMUMPS_BUF_SEND_CB( NBROWS_ALREADY_SENT,
218     &                                INODE, FPERE, NFRONT, LCONT,
219     &                                NASS, NPIV,
220     &                                IWROW, IWCOL, A, COMPRESSCB,
221     &                                DEST, TAG, COMM, KEEP, IERR )
222        IMPLICIT NONE
223        INTEGER DEST, TAG, COMM, IERR
224        INTEGER NBROWS_ALREADY_SENT
225        INTEGER, INTENT(INOUT) :: KEEP(500)
226        INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV
227        INTEGER IWROW( LCONT ), IWCOL( LCONT )
228        REAL A( * )
229        LOGICAL COMPRESSCB
230        INCLUDE 'mpif.h'
231        INTEGER NBROWS_PACKET
232        INTEGER POSITION, IREQ, IPOS, I, J1
233        INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS
234        INTEGER IZERO, IONE
235        INTEGER SIZECB
236        INTEGER LCONT_SENT
237        INTEGER DEST2(1)
238        PARAMETER( IZERO = 0, IONE = 1 )
239        LOGICAL RECV_BUF_SMALLER_THAN_SEND
240        DOUBLE PRECISION TMP
241        DEST2(1) = DEST
242        IERR = 0
243        IF (NBROWS_ALREADY_SENT .EQ. 0) THEN
244          CALL MPI_PACK_SIZE( 11 + LCONT + LCONT, MPI_INTEGER,
245     &                        COMM, SIZE1,  IERR)
246        ELSE
247          CALL MPI_PACK_SIZE( 5, MPI_INTEGER, COMM, SIZE1, IERR)
248        ENDIF
249        CALL SMUMPS_BUF_SIZE_AVAILABLE( BUF_CB, SIZE_AV )
250        IF ( SIZE_AV .LT. SIZE_RBUF_BYTES ) THEN
251          RECV_BUF_SMALLER_THAN_SEND = .FALSE.
252        ELSE
253          SIZE_AV = SIZE_RBUF_BYTES
254          RECV_BUF_SMALLER_THAN_SEND = .TRUE.
255        ENDIF
256        SIZE_AV_REALS = ( SIZE_AV - SIZE1 ) / SIZEofREAL
257        IF (SIZE_AV_REALS < 0 ) THEN
258          NBROWS_PACKET = 0
259        ELSE
260          IF (COMPRESSCB) THEN
261            TMP=2.0D0*dble(NBROWS_ALREADY_SENT)+1.0D0
262            NBROWS_PACKET = int(
263     &                      ( sqrt( TMP * TMP
264     &                        + 8.0D0 * dble(SIZE_AV_REALS)) - TMP )
265     &                        / 2.0D0 )
266          ELSE
267            IF (LCONT.EQ.0) THEN
268              NBROWS_PACKET = 0
269            ELSE
270              NBROWS_PACKET = SIZE_AV_REALS / LCONT
271            ENDIF
272          ENDIF
273        ENDIF
274 10     CONTINUE
275        NBROWS_PACKET = max(0,
276     &            min(NBROWS_PACKET, LCONT - NBROWS_ALREADY_SENT))
277        IF (NBROWS_PACKET .EQ. 0 .AND. LCONT .NE. 0) THEN
278          IF (RECV_BUF_SMALLER_THAN_SEND) THEN
279            IERR = -3
280            GOTO 100
281          ELSE
282            IERR = -1
283            GOTO 100
284          ENDIF
285        ENDIF
286        IF (COMPRESSCB) THEN
287          SIZECB = (NBROWS_ALREADY_SENT*NBROWS_PACKET)+(NBROWS_PACKET
288     &             *(NBROWS_PACKET+1))/2
289        ELSE
290          SIZECB = NBROWS_PACKET * LCONT
291        ENDIF
292        CALL MPI_PACK_SIZE( SIZECB, MPI_REAL,
293     &                    COMM, SIZE2,  IERR )
294        SIZE_PACK = SIZE1 + SIZE2
295        IF (SIZE_PACK .GT. SIZE_AV ) THEN
296          NBROWS_PACKET = NBROWS_PACKET - 1
297          IF (NBROWS_PACKET > 0) THEN
298             GOTO 10
299          ELSE
300             IF (RECV_BUF_SMALLER_THAN_SEND) THEN
301               IERR=-3
302               GOTO 100
303             ELSE
304               IERR = -1
305               GOTO 100
306             ENDIF
307          ENDIF
308        ENDIF
309        IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.LCONT .AND.
310     &     SIZE_PACK  .LT. SIZE_RBUF_BYTES / 4
311     &    .AND.
312     &    .NOT. RECV_BUF_SMALLER_THAN_SEND)
313     &    THEN
314            IERR = -1
315            GOTO 100
316        ENDIF
317        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR,
318     &                 IONE , DEST2
319     &               )
320        IF (IERR .EQ. -1 .OR. IERR .EQ. -2) THEN
321          NBROWS_PACKET = NBROWS_PACKET - 1
322          IF ( NBROWS_PACKET > 0 )  GOTO 10
323        ENDIF
324        IF ( IERR .LT. 0 ) GOTO 100
325        POSITION = 0
326        CALL MPI_PACK( INODE, 1, MPI_INTEGER,
327     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
328     &                        POSITION, COMM, IERR )
329        CALL MPI_PACK( FPERE, 1, MPI_INTEGER,
330     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
331     &                        POSITION, COMM, IERR )
332        IF (COMPRESSCB) THEN
333          LCONT_SENT=-LCONT
334        ELSE
335          LCONT_SENT=LCONT
336        ENDIF
337        CALL MPI_PACK( LCONT_SENT, 1, MPI_INTEGER,
338     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
339     &                        POSITION, COMM, IERR )
340        CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER,
341     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
342     &                        POSITION, COMM, IERR )
343        CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER,
344     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
345     &                        POSITION, COMM, IERR )
346        IF (NBROWS_ALREADY_SENT == 0) THEN
347          CALL MPI_PACK( LCONT, 1, MPI_INTEGER,
348     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
349     &                        POSITION, COMM, IERR )
350          CALL MPI_PACK( NASS-NPIV, 1, MPI_INTEGER,
351     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
352     &                        POSITION, COMM, IERR )
353          CALL MPI_PACK( LCONT , 1, MPI_INTEGER,
354     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
355     &                        POSITION, COMM, IERR )
356          CALL MPI_PACK( IZERO, 1, MPI_INTEGER,
357     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
358     &                        POSITION, COMM, IERR )
359          CALL MPI_PACK( IONE,  1, MPI_INTEGER,
360     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
361     &                        POSITION, COMM, IERR )
362          CALL MPI_PACK( IZERO, 1, MPI_INTEGER,
363     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
364     &                        POSITION, COMM, IERR )
365          CALL MPI_PACK( IWROW, LCONT, MPI_INTEGER,
366     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
367     &                        POSITION, COMM, IERR )
368          CALL MPI_PACK( IWCOL, LCONT, MPI_INTEGER,
369     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
370     &                        POSITION, COMM, IERR )
371        ENDIF
372        IF ( LCONT .NE. 0 ) THEN
373          J1 = 1 + NBROWS_ALREADY_SENT * NFRONT
374          IF (COMPRESSCB) THEN
375           DO I = NBROWS_ALREADY_SENT+1,
376     &            NBROWS_ALREADY_SENT+NBROWS_PACKET
377            CALL MPI_PACK( A( J1 ), I, MPI_REAL,
378     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
379     &                        POSITION, COMM, IERR )
380             J1 = J1 + NFRONT
381           END DO
382          ELSE
383           DO I = NBROWS_ALREADY_SENT+1,
384     &            NBROWS_ALREADY_SENT+NBROWS_PACKET
385            CALL MPI_PACK( A( J1 ), LCONT, MPI_REAL,
386     &                        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
387     &                        POSITION, COMM, IERR )
388             J1 = J1 + NFRONT
389           END DO
390          ENDIF
391        END IF
392        KEEP(266)=KEEP(266)+1
393        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
394     &                DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR )
395        IF ( SIZE_PACK .LT. POSITION ) THEN
396          WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',SIZE_PACK,
397     &               POSITION
398          CALL MUMPS_ABORT()
399        END IF
400        IF ( SIZE_PACK .NE. POSITION )
401     &    CALL BUF_ADJUST( BUF_CB, POSITION )
402        NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET
403        IF (NBROWS_ALREADY_SENT .NE. LCONT ) THEN
404          IERR = -1
405          RETURN
406        ENDIF
407 100    CONTINUE
408        RETURN
409        END SUBROUTINE SMUMPS_BUF_SEND_CB
410        SUBROUTINE SMUMPS_BUF_SEND_MASTER2SLAVE( NRHS, INODE, IFATH,
411     &             EFF_CB_SIZE, LD_CB, LD_PIV, NPIV,
412     &             JBDEB, JBFIN,
413     &             CB, SOL,
414     &             DEST, COMM, KEEP, IERR )
415        IMPLICIT NONE
416        INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV
417        INTEGER DEST, COMM, IERR, JBDEB, JBFIN
418        REAL CB( LD_CB*(NRHS-1)+EFF_CB_SIZE )
419        REAL SOL( max(1, LD_PIV*(NRHS-1)+NPIV) )
420        INTEGER, INTENT(INOUT) :: KEEP(500)
421        INCLUDE 'mpif.h'
422        INCLUDE 'mumps_tags.h'
423        INTEGER SIZE, SIZE1, SIZE2, K
424        INTEGER POSITION, IREQ, IPOS
425        INTEGER IONE
426        INTEGER DEST2(1)
427        PARAMETER ( IONE=1 )
428        DEST2(1) = DEST
429        IERR = 0
430        CALL MPI_PACK_SIZE( 6, MPI_INTEGER, COMM, SIZE1, IERR )
431        CALL MPI_PACK_SIZE( NRHS * (EFF_CB_SIZE + NPIV),
432     &                      MPI_REAL, COMM,
433     &                      SIZE2, IERR )
434        SIZE = SIZE1 + SIZE2
435        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE, IERR,
436     &                 IONE , DEST2
437     &               )
438        IF ( IERR .LT. 0 ) THEN
439           RETURN
440        ENDIF
441        POSITION = 0
442        CALL MPI_PACK( INODE, 1, MPI_INTEGER,
443     &                        BUF_CB%CONTENT( IPOS ), SIZE,
444     &                        POSITION, COMM, IERR )
445        CALL MPI_PACK( IFATH, 1, MPI_INTEGER,
446     &                        BUF_CB%CONTENT( IPOS ), SIZE,
447     &                        POSITION, COMM, IERR )
448        CALL MPI_PACK( EFF_CB_SIZE  , 1, MPI_INTEGER,
449     &                        BUF_CB%CONTENT( IPOS ), SIZE,
450     &                        POSITION, COMM, IERR )
451        CALL MPI_PACK( NPIV , 1, MPI_INTEGER,
452     &                        BUF_CB%CONTENT( IPOS ), SIZE,
453     &                        POSITION, COMM, IERR )
454        CALL MPI_PACK( JBDEB , 1, MPI_INTEGER,
455     &                        BUF_CB%CONTENT( IPOS ), SIZE,
456     &                        POSITION, COMM, IERR )
457        CALL MPI_PACK( JBFIN , 1, MPI_INTEGER,
458     &                        BUF_CB%CONTENT( IPOS ), SIZE,
459     &                        POSITION, COMM, IERR )
460        DO K = 1, NRHS
461               CALL MPI_PACK( CB ( 1 + LD_CB * (K-1) ),
462     &                        EFF_CB_SIZE, MPI_REAL,
463     &                        BUF_CB%CONTENT( IPOS ), SIZE,
464     &                        POSITION, COMM, IERR )
465        END DO
466        IF ( NPIV .GT. 0 ) THEN
467          DO K=1, NRHS
468          CALL MPI_PACK( SOL(1+LD_PIV*(K-1)),
469     &                         NPIV, MPI_REAL,
470     &                         BUF_CB%CONTENT( IPOS ), SIZE,
471     &                         POSITION, COMM, IERR )
472          ENDDO
473        END IF
474        KEEP(266)=KEEP(266)+1
475        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
476     &                  DEST, Master2Slave, COMM,
477     &                  BUF_CB%CONTENT( IREQ ), IERR )
478        IF ( SIZE .LT. POSITION ) THEN
479          WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ',
480     &               SIZE, POSITION
481          CALL MUMPS_ABORT()
482        END IF
483        IF ( SIZE .NE. POSITION ) CALL BUF_ADJUST( BUF_CB, POSITION )
484        RETURN
485        END SUBROUTINE SMUMPS_BUF_SEND_MASTER2SLAVE
486        SUBROUTINE SMUMPS_BUF_SEND_VCB( NRHS_B, NODE1, NODE2, NCB, LDW,
487     &             LONG,
488     &             IW, W, JBDEB, JBFIN,
489     &             RHSCOMP, NRHS, LRHSCOMP, IPOSINRHSCOMP, NPIV,
490     &             KEEP,
491     &             DEST, TAG, COMM, IERR )
492        IMPLICIT NONE
493        INTEGER LDW, DEST, TAG, COMM, IERR
494        INTEGER NRHS_B, NODE1, NODE2, NCB, LONG, JBDEB, JBFIN
495        INTEGER IW( max( 1, LONG ) )
496        INTEGER, INTENT(IN) :: LRHSCOMP, NRHS, IPOSINRHSCOMP, NPIV
497        REAL W( max( 1, LDW * NRHS_B ) )
498#       if defined(RHSCOMP_BYROWS)
499        REAL RHSCOMP(NRHS,LRHSCOMP)
500#       else
501        REAL RHSCOMP(LRHSCOMP,NRHS)
502#       endif
503        INTEGER, INTENT(INOUT) :: KEEP(500)
504        INCLUDE 'mpif.h'
505        INTEGER POSITION, IREQ, IPOS
506        INTEGER SIZE1, SIZE2, SIZE, K
507        INTEGER IONE
508        INTEGER DEST2(1)
509        PARAMETER ( IONE=1 )
510        DEST2(1)=DEST
511        IERR = 0
512        IF ( NODE2 .EQ. 0 ) THEN
513         CALL MPI_PACK_SIZE( 4+LONG, MPI_INTEGER, COMM, SIZE1, IERR )
514        ELSE
515         CALL MPI_PACK_SIZE( 6+LONG, MPI_INTEGER, COMM, SIZE1, IERR )
516        END IF
517        SIZE2 = 0
518        IF ( LONG .GT. 0 ) THEN
519          CALL MPI_PACK_SIZE( NRHS_B*LONG, MPI_REAL,
520     &                        COMM, SIZE2, IERR )
521        END IF
522        SIZE = SIZE1 + SIZE2
523        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE, IERR,
524     &                 IONE , DEST2
525     &               )
526        IF ( IERR .LT. 0 ) THEN
527           RETURN
528        ENDIF
529        POSITION = 0
530        CALL MPI_PACK( NODE1, 1, MPI_INTEGER,
531     &                        BUF_CB%CONTENT( IPOS ), SIZE,
532     &                        POSITION, COMM, IERR )
533        IF ( NODE2 .NE. 0 ) THEN
534          CALL MPI_PACK( NODE2, 1, MPI_INTEGER,
535     &                        BUF_CB%CONTENT( IPOS ), SIZE,
536     &                        POSITION, COMM, IERR )
537          CALL MPI_PACK( NCB, 1, MPI_INTEGER,
538     &                        BUF_CB%CONTENT( IPOS ), SIZE,
539     &                        POSITION, COMM, IERR )
540        ENDIF
541        CALL MPI_PACK( JBDEB, 1, MPI_INTEGER,
542     &                        BUF_CB%CONTENT( IPOS ), SIZE,
543     &                        POSITION, COMM, IERR )
544        CALL MPI_PACK( JBFIN, 1, MPI_INTEGER,
545     &                        BUF_CB%CONTENT( IPOS ), SIZE,
546     &                        POSITION, COMM, IERR )
547        CALL MPI_PACK( LONG,  1, MPI_INTEGER,
548     &                        BUF_CB%CONTENT( IPOS ), SIZE,
549     &                        POSITION, COMM, IERR )
550        IF ( LONG .GT. 0 ) THEN
551          CALL MPI_PACK( IW, LONG, MPI_INTEGER,
552     &                        BUF_CB%CONTENT( IPOS ), SIZE,
553     &                        POSITION, COMM, IERR )
554          IF (NODE2.EQ.0.AND.KEEP(350).NE.0) THEN
555            DO K=1, NRHS_B
556#if defined(RHSCOMP_BYROWS)
557              WRITE(*,*) "Internal error in SMUMPS_BUF_SEND_VCB"
558              CALL MUMPS_ABORT()
559#else
560              IF (NPIV.GT.0) THEN
561              CALL MPI_PACK( RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1), NPIV,
562     &                          MPI_REAL,
563     &                          BUF_CB%CONTENT( IPOS ), SIZE,
564     &                          POSITION, COMM, IERR )
565              ENDIF
566              IF (LONG-NPIV .NE.0) THEN
567                CALL MPI_PACK( W(NPIV+1+(K-1)*LDW), LONG-NPIV,
568     &                          MPI_REAL,
569     &                          BUF_CB%CONTENT( IPOS ), SIZE,
570     &                          POSITION, COMM, IERR )
571              ENDIF
572#endif
573            END DO
574          ELSE
575            DO K=1, NRHS_B
576              CALL MPI_PACK( W(1+(K-1)*LDW), LONG, MPI_REAL,
577     &                          BUF_CB%CONTENT( IPOS ), SIZE,
578     &                          POSITION, COMM, IERR )
579            END DO
580          ENDIF
581        END IF
582        KEEP(266)=KEEP(266)+1
583        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
584     &                  DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR )
585        IF ( SIZE .NE. POSITION ) CALL BUF_ADJUST( BUF_CB, POSITION )
586        RETURN
587        END SUBROUTINE SMUMPS_BUF_SEND_VCB
588        SUBROUTINE SMUMPS_BUF_SEND_1INT( I, DEST, TAG, COMM,
589     &                                   KEEP, IERR )
590        IMPLICIT NONE
591        INTEGER I
592        INTEGER DEST, TAG, COMM, IERR
593        INTEGER, INTENT(INOUT) :: KEEP(500)
594        INCLUDE 'mpif.h'
595        INTEGER IPOS, IREQ, MSG_SIZE, POSITION
596        INTEGER IONE
597        INTEGER DEST2(1)
598        PARAMETER ( IONE=1 )
599        DEST2(1)=DEST
600        IERR = 0
601        CALL MPI_PACK_SIZE( 1, MPI_INTEGER,
602     &                      COMM, MSG_SIZE, IERR )
603        CALL BUF_LOOK( BUF_SMALL, IPOS, IREQ, MSG_SIZE, IERR,
604     &                 IONE , DEST2
605     &               )
606        IF ( IERR .LT. 0 ) THEN
607         write(6,*) ' Internal error in SMUMPS_BUF_SEND_1INT',
608     &       ' Buf size (bytes)= ',BUF_SMALL%LBUF
609         RETURN
610        ENDIF
611        POSITION=0
612        CALL MPI_PACK( I, 1,
613     &                 MPI_INTEGER, BUF_SMALL%CONTENT( IPOS ),
614     &                 MSG_SIZE,
615     &                 POSITION, COMM, IERR )
616        KEEP(266)=KEEP(266)+1
617        CALL MPI_ISEND( BUF_SMALL%CONTENT(IPOS), MSG_SIZE,
618     &                  MPI_PACKED, DEST, TAG, COMM,
619     &                  BUF_SMALL%CONTENT( IREQ ), IERR )
620        RETURN
621        END SUBROUTINE SMUMPS_BUF_SEND_1INT
622        SUBROUTINE SMUMPS_BUF_ALL_EMPTY(CHECK_COMM_NODES,
623     &             CHECK_COMM_LOAD,FLAG)
624        LOGICAL, INTENT(IN)  :: CHECK_COMM_NODES, CHECK_COMM_LOAD
625        LOGICAL, INTENT(OUT) :: FLAG
626        LOGICAL FLAG1, FLAG2, FLAG3
627        FLAG = .TRUE.
628        IF (CHECK_COMM_NODES) THEN
629          CALL SMUMPS_BUF_EMPTY( BUF_SMALL, FLAG1 )
630          CALL SMUMPS_BUF_EMPTY( BUF_CB, FLAG2 )
631          FLAG = FLAG .AND. FLAG1 .AND. FLAG2
632        ENDIF
633        IF ( CHECK_COMM_LOAD ) THEN
634          CALL SMUMPS_BUF_EMPTY( BUF_LOAD, FLAG3 )
635          FLAG = FLAG .AND. FLAG3
636        ENDIF
637        RETURN
638        END SUBROUTINE SMUMPS_BUF_ALL_EMPTY
639        SUBROUTINE SMUMPS_BUF_EMPTY( B, FLAG )
640        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B
641        LOGICAL :: FLAG
642        INTEGER SIZE_AVAIL
643        CALL SMUMPS_BUF_SIZE_AVAILABLE(B, SIZE_AVAIL)
644        FLAG = ( B%HEAD == B%TAIL )
645        RETURN
646        END SUBROUTINE SMUMPS_BUF_EMPTY
647        SUBROUTINE SMUMPS_BUF_SIZE_AVAILABLE( B, SIZE_AV )
648        IMPLICIT NONE
649        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B
650        INTEGER SIZE_AV
651        INCLUDE 'mpif.h'
652        INTEGER :: IERR
653        INTEGER :: STATUS(MPI_STATUS_SIZE)
654        LOGICAL :: FLAG
655        IF ( B%HEAD .NE. B%TAIL ) THEN
656 10       CONTINUE
657          CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR )
658          IF ( FLAG ) THEN
659            B%HEAD = B%CONTENT( B%HEAD + NEXT )
660            IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL
661            IF ( B%HEAD .NE. B%TAIL ) GOTO 10
662          END IF
663        END IF
664        IF ( B%HEAD .EQ. B%TAIL ) THEN
665          B%HEAD = 1
666          B%TAIL = 1
667          B%ILASTMSG = 1
668        END IF
669        IF ( B%HEAD .LE. B%TAIL ) THEN
670           SIZE_AV = max( B%LBUF_INT - B%TAIL, B%HEAD - 2 )
671        ELSE
672           SIZE_AV = B%HEAD - B%TAIL - 1
673        END IF
674        SIZE_AV = min(SIZE_AV - OVHSIZE, SIZE_AV)
675        SIZE_AV = SIZE_AV * SIZEofINT
676        RETURN
677        END SUBROUTINE SMUMPS_BUF_SIZE_AVAILABLE
678        SUBROUTINE SMUMPS_BUF_TEST()
679        INTEGER :: IPOS, IREQ, IERR
680        INTEGER, PARAMETER :: IONE=1
681        INTEGER :: MSG_SIZE
682        INTEGER :: DEST2(1)
683        DEST2=-10
684        MSG_SIZE=1
685        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, MSG_SIZE, IERR,
686     &                 IONE , DEST2,.TRUE.)
687        RETURN
688        END SUBROUTINE SMUMPS_BUF_TEST
689        SUBROUTINE BUF_LOOK( B, IPOS, IREQ, MSG_SIZE, IERR,
690     &    NDEST , PDEST, TEST_ONLY
691     &         )
692        IMPLICIT NONE
693        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B
694        INTEGER, INTENT(IN)        :: MSG_SIZE
695        INTEGER, INTENT(OUT)       :: IPOS, IREQ, IERR
696        LOGICAL, INTENT(IN), OPTIONAL :: TEST_ONLY
697        INTEGER NDEST
698        INTEGER, INTENT(IN)        :: PDEST(max(1,NDEST))
699        INCLUDE 'mpif.h'
700        INTEGER :: MSG_SIZE_INT
701        INTEGER :: IBUF
702        LOGICAL :: FLAG
703        INTEGER :: STATUS(MPI_STATUS_SIZE)
704        IERR = 0
705        IF ( B%HEAD .NE. B%TAIL ) THEN
706 10       CONTINUE
707          CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR )
708          IF ( FLAG ) THEN
709            B%HEAD = B%CONTENT( B%HEAD + NEXT )
710            IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL
711            IF ( B%HEAD .NE. B%TAIL ) GOTO 10
712          END IF
713        END IF
714        IF ( B%HEAD .EQ. B%TAIL ) THEN
715          B%HEAD = 1
716          B%TAIL = 1
717          B%ILASTMSG = 1
718        END iF
719        MSG_SIZE_INT = ( MSG_SIZE + ( SIZEofINT - 1 ) ) / SIZEofINT
720        MSG_SIZE_INT = MSG_SIZE_INT + OVHSIZE
721        IF (present(TEST_ONLY)) RETURN
722        FLAG = (     ( B%HEAD .LE. B%TAIL )
723     &               .AND. (
724     &                 ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL )
725     &                 .OR. ( MSG_SIZE_INT .LE. B%HEAD - 2 ) ) )
726     &         .OR.
727     &               ( ( B%HEAD .GT. B%TAIL )
728     &               .AND. ( MSG_SIZE_INT .LE. B%HEAD - B%TAIL - 1 ) )
729        IF ( .NOT. FLAG
730     &    ) THEN
731          IERR = -1
732          IF ( MSG_SIZE_INT .GT. B%LBUF_INT - 1 ) THEN
733            IERR = -2
734          ENDIF
735          IPOS = -1
736          IREQ = -1
737          RETURN
738        END IF
739        IF ( B%HEAD .LE. B%TAIL ) THEN
740          IF ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL + 1 ) THEN
741            IBUF = B%TAIL
742          ELSE IF ( MSG_SIZE_INT .LE. B%HEAD - 1 ) THEN
743            IBUF = 1
744          END IF
745        ELSE
746          IBUF = B%TAIL
747        END IF
748        B%CONTENT( B%ILASTMSG + NEXT ) = IBUF
749        B%ILASTMSG = IBUF
750        B%TAIL = IBUF + MSG_SIZE_INT
751        B%CONTENT( IBUF + NEXT ) = 0
752        IPOS = IBUF + CONTENT
753        IREQ = IBUF + REQ
754        RETURN
755        END SUBROUTINE BUF_LOOK
756        SUBROUTINE BUF_ADJUST( BUF, SIZE )
757        IMPLICIT NONE
758        TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: BUF
759        INTEGER SIZE
760        INTEGER SIZE_INT
761        SIZE_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT
762        SIZE_INT = SIZE_INT + OVHSIZE
763        BUF%TAIL = BUF%ILASTMSG + SIZE_INT
764        RETURN
765        END SUBROUTINE BUF_ADJUST
766      SUBROUTINE SMUMPS_BUF_SEND_DESC_BANDE(
767     &             INODE, NBPROCFILS, NLIG, ILIG, NCOL, ICOL,
768     &             NASS, NSLAVES, LIST_SLAVES,
769     &             DEST, IBC_SOURCE, NFRONT, COMM, KEEP, IERR
770     &             , LRSTATUS
771     &)
772      IMPLICIT NONE
773        INTEGER COMM, IERR, NFRONT
774        INTEGER INODE
775        INTEGER NLIG, NCOL, NASS, NSLAVES
776        INTEGER NBPROCFILS, DEST
777        INTEGER ILIG( NLIG )
778        INTEGER ICOL( NCOL )
779        INTEGER, INTENT(IN) :: IBC_SOURCE
780        INTEGER LIST_SLAVES( NSLAVES )
781        INTEGER, INTENT(INOUT) :: KEEP(500)
782        INTEGER, INTENT(IN) :: LRSTATUS
783        INCLUDE 'mpif.h'
784        INCLUDE 'mumps_tags.h'
785        INTEGER SIZE_INT, SIZE_BYTES, POSITION, IPOS, IREQ
786        INTEGER IONE
787        INTEGER DEST2(1)
788        PARAMETER ( IONE=1 )
789        DEST2(1) = DEST
790        IERR = 0
791        SIZE_INT = ( 7 + NLIG + NCOL + NSLAVES + 1 )
792        SIZE_INT = SIZE_INT + 1
793        SIZE_BYTES = SIZE_INT * SIZEofINT
794        IF (SIZE_INT.GT.SIZE_RBUF_BYTES ) THEN
795         IERR = -3
796         RETURN
797        END IF
798        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE_BYTES, IERR,
799     &                 IONE , DEST2
800     &               )
801        IF ( IERR .LT. 0 ) THEN
802           RETURN
803        ENDIF
804        POSITION = IPOS
805        BUF_CB%CONTENT( POSITION ) = SIZE_INT
806        POSITION = POSITION + 1
807        BUF_CB%CONTENT( POSITION ) = INODE
808        POSITION = POSITION + 1
809        BUF_CB%CONTENT( POSITION ) = NBPROCFILS
810        POSITION = POSITION + 1
811        BUF_CB%CONTENT( POSITION ) = NLIG
812        POSITION = POSITION + 1
813        BUF_CB%CONTENT( POSITION ) = NCOL
814        POSITION = POSITION + 1
815        BUF_CB%CONTENT( POSITION ) = NASS
816        POSITION = POSITION + 1
817        BUF_CB%CONTENT( POSITION ) = NFRONT
818        POSITION = POSITION + 1
819        BUF_CB%CONTENT( POSITION ) = NSLAVES
820        POSITION = POSITION + 1
821        BUF_CB%CONTENT( POSITION ) = LRSTATUS
822        POSITION = POSITION + 1
823        IF (NSLAVES.GT.0) THEN
824         BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) =
825     &   LIST_SLAVES( 1: NSLAVES )
826         POSITION = POSITION + NSLAVES
827        ENDIF
828        BUF_CB%CONTENT( POSITION:POSITION + NLIG - 1 ) = ILIG
829        POSITION = POSITION + NLIG
830        BUF_CB%CONTENT( POSITION:POSITION + NCOL - 1 ) = ICOL
831        POSITION = POSITION + NCOL
832        POSITION = POSITION - IPOS
833        IF ( POSITION * SIZEofINT .NE. SIZE_BYTES ) THEN
834          WRITE(*,*) 'Error in SMUMPS_BUF_SEND_DESC_BANDE :',
835     &               ' wrong estimated size'
836          CALL MUMPS_ABORT()
837        END IF
838        KEEP(266)=KEEP(266)+1
839        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE_BYTES,
840     &                  MPI_PACKED,
841     &                  DEST, MAITRE_DESC_BANDE, COMM,
842     &                  BUF_CB%CONTENT( IREQ ), IERR )
843        RETURN
844        END SUBROUTINE SMUMPS_BUF_SEND_DESC_BANDE
845        SUBROUTINE SMUMPS_BUF_SEND_MAITRE2( NBROWS_ALREADY_SENT,
846     &  IPERE, ISON, NROW,
847     &  IROW, NCOL, ICOL, VAL, LDA, NELIM, TYPE_SON,
848     &  NSLAVES, SLAVES, DEST, COMM, IERR,
849     &
850     &  SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE )
851        IMPLICIT NONE
852        INTEGER NBROWS_ALREADY_SENT
853        INTEGER LDA, NELIM, TYPE_SON
854        INTEGER IPERE, ISON, NROW, NCOL, NSLAVES
855        INTEGER IROW( NROW )
856        INTEGER ICOL( NCOL )
857        INTEGER SLAVES( NSLAVES )
858        REAL VAL(LDA, *)
859        INTEGER IPOS, IREQ, DEST, COMM, IERR
860        INTEGER SLAVEF, KEEP(500), INIV2
861        INTEGER(8) KEEP8(150)
862        INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
863        INCLUDE 'mpif.h'
864        INCLUDE 'mumps_tags.h'
865        INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I
866        INTEGER NBROWS_PACKET, NCOL_SEND
867        INTEGER SIZE_AV
868        LOGICAL RECV_BUF_SMALLER_THAN_SEND
869        INTEGER IONE
870        INTEGER DEST2(1)
871        PARAMETER ( IONE=1 )
872        DEST2(1) = DEST
873        IERR = 0
874        IF ( NELIM .NE. NROW ) THEN
875          WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',NELIM, NROW
876          CALL MUMPS_ABORT()
877        END IF
878        IF (NBROWS_ALREADY_SENT .EQ. 0) THEN
879          CALL MPI_PACK_SIZE( NROW+NCOL+7+NSLAVES, MPI_INTEGER,
880     &                      COMM, SIZE1, IERR )
881          IF ( TYPE_SON .eq. 2 ) THEN
882          CALL MPI_PACK_SIZE( NSLAVES+1, MPI_INTEGER,
883     &                          COMM, SIZE3, IERR )
884          ELSE
885            SIZE3 = 0
886          ENDIF
887          SIZE1=SIZE1+SIZE3
888        ELSE
889          CALL MPI_PACK_SIZE(7, MPI_INTEGER,COMM,SIZE1,IERR)
890        ENDIF
891        IF ( KEEP(50).ne.0  .AND. TYPE_SON .eq. 2 ) THEN
892          NCOL_SEND = NROW
893        ELSE
894          NCOL_SEND = NCOL
895        ENDIF
896        CALL SMUMPS_BUF_SIZE_AVAILABLE( BUF_CB, SIZE_AV )
897        IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN
898          RECV_BUF_SMALLER_THAN_SEND = .FALSE.
899        ELSE
900          RECV_BUF_SMALLER_THAN_SEND = .TRUE.
901          SIZE_AV = SIZE_RBUF_BYTES
902        ENDIF
903        IF (NROW .GT. 0 ) THEN
904         NBROWS_PACKET = (SIZE_AV - SIZE1) / NCOL_SEND / SIZEofREAL
905         NBROWS_PACKET = min(NBROWS_PACKET, NROW - NBROWS_ALREADY_SENT)
906         NBROWS_PACKET = max(NBROWS_PACKET, 0)
907        ELSE
908          NBROWS_PACKET =0
909        ENDIF
910        IF (NBROWS_PACKET .EQ. 0 .AND. NROW .NE. 0) THEN
911          IF (RECV_BUF_SMALLER_THAN_SEND) THEN
912              IERR=-3
913              GOTO 100
914          ELSE
915              IERR=-1
916              GOTO 100
917          ENDIF
918        ENDIF
919 10     CONTINUE
920        CALL MPI_PACK_SIZE( NBROWS_PACKET * NCOL_SEND,
921     &           MPI_REAL,
922     &           COMM, SIZE2, IERR )
923        SIZE_PACK = SIZE1 + SIZE2
924        IF (SIZE_PACK .GT. SIZE_AV) THEN
925          NBROWS_PACKET = NBROWS_PACKET - 1
926          IF ( NBROWS_PACKET .GT. 0 ) THEN
927            GOTO 10
928          ELSE
929            IF (RECV_BUF_SMALLER_THAN_SEND) THEN
930                IERR = -3
931                GOTO 100
932            ELSE
933                IERR = -1
934                GOTO 100
935            ENDIF
936          ENDIF
937        ENDIF
938       IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NROW .AND.
939     &   SIZE_PACK - SIZE1  .LT. ( SIZE_RBUF_BYTES - SIZE1 ) / 2
940     &  .AND.
941     &   .NOT. RECV_BUF_SMALLER_THAN_SEND)
942     &   THEN
943           IERR = -1
944           GOTO 100
945       ENDIF
946        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR,
947     &                 IONE , DEST2
948     &               )
949        IF ( IERR .LT. 0 ) THEN
950          GOTO 100
951        ENDIF
952        POSITION = 0
953        CALL MPI_PACK( IPERE, 1, MPI_INTEGER,
954     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
955     &                 POSITION, COMM, IERR )
956        CALL MPI_PACK( ISON,  1, MPI_INTEGER,
957     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
958     &                 POSITION, COMM, IERR )
959        CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER,
960     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
961     &                 POSITION, COMM, IERR )
962        CALL MPI_PACK( NROW, 1, MPI_INTEGER,
963     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
964     &                 POSITION, COMM, IERR )
965        CALL MPI_PACK( NCOL, 1, MPI_INTEGER,
966     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
967     &                 POSITION, COMM, IERR )
968        CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER,
969     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
970     &                 POSITION, COMM, IERR )
971        CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER,
972     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
973     &                 POSITION, COMM, IERR )
974        IF (NBROWS_ALREADY_SENT .EQ. 0) THEN
975          IF (NSLAVES.GT.0) THEN
976            CALL MPI_PACK( SLAVES, NSLAVES, MPI_INTEGER,
977     &                BUF_CB%CONTENT( IPOS ), SIZE_PACK,
978     &                POSITION, COMM, IERR )
979          ENDIF
980          CALL MPI_PACK( IROW, NROW, MPI_INTEGER,
981     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
982     &                 POSITION, COMM, IERR )
983          CALL MPI_PACK( ICOL, NCOL, MPI_INTEGER,
984     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
985     &                 POSITION, COMM, IERR )
986          IF ( TYPE_SON .eq. 2 ) THEN
987            CALL MPI_PACK( TAB_POS_IN_PERE(1,INIV2), NSLAVES+1,
988     &                 MPI_INTEGER,
989     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
990     &                 POSITION, COMM, IERR )
991          ENDIF
992        ENDIF
993        IF (NBROWS_PACKET.GE.1) THEN
994          DO I=NBROWS_ALREADY_SENT+1,
995     &                   NBROWS_ALREADY_SENT+NBROWS_PACKET
996            CALL MPI_PACK( VAL(1,I), NCOL_SEND,
997     &               MPI_REAL,
998     &               BUF_CB%CONTENT( IPOS ), SIZE_PACK,
999     &               POSITION, COMM, IERR )
1000          ENDDO
1001        ENDIF
1002        KEEP(266)=KEEP(266)+1
1003        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
1004     &                  DEST, MAITRE2, COMM,
1005     &                  BUF_CB%CONTENT( IREQ ), IERR )
1006        IF ( SIZE_PACK .LT. POSITION ) THEN
1007          write(*,*) 'Try_send_maitre2, SIZE,POSITION=',
1008     &                SIZE_PACK,POSITION
1009          CALL MUMPS_ABORT()
1010        END IF
1011        IF ( SIZE_PACK .NE. POSITION )
1012     &    CALL BUF_ADJUST( BUF_CB, POSITION )
1013        NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET
1014        IF ( NBROWS_ALREADY_SENT .NE. NROW ) THEN
1015          IERR = -1
1016        ENDIF
1017 100    CONTINUE
1018        RETURN
1019        END SUBROUTINE SMUMPS_BUF_SEND_MAITRE2
1020        SUBROUTINE SMUMPS_BUF_SEND_CONTRIB_TYPE2(NBROWS_ALREADY_SENT,
1021     &  DESC_IN_LU,
1022     &  IPERE, NFRONT_PERE, NASS_PERE, NFS4FATHER,
1023     &  NSLAVES_PERE,
1024     &  ISON, NBROW, LMAP, MAPROW, PERM, IW_CBSON, A_CBSON,
1025     &  ISLAVE, PDEST, PDEST_MASTER, COMM, IERR,
1026     &
1027     & KEEP,KEEP8, STEP, N, SLAVEF,
1028     & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1029     & COMPRESSCB, KEEP253_LOC )
1030        IMPLICIT NONE
1031        INTEGER NBROWS_ALREADY_SENT
1032        INTEGER, INTENT (in) :: KEEP253_LOC
1033        INTEGER IPERE, ISON, NBROW
1034        INTEGER PDEST, ISLAVE, COMM, IERR
1035        INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE,
1036     &       NFRONT_PERE, LMAP
1037        INTEGER MAPROW( LMAP ), PERM( max(1, NBROW ))
1038        INTEGER IW_CBSON( * )
1039        REAL A_CBSON( * )
1040        LOGICAL DESC_IN_LU, COMPRESSCB
1041       INTEGER   KEEP(500), N , SLAVEF
1042       INTEGER(8) KEEP8(150)
1043       INTEGER   STEP(N),
1044     &          ISTEP_TO_INIV2(KEEP(71)),
1045     &          TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
1046      INCLUDE 'mpif.h'
1047      INCLUDE 'mumps_tags.h'
1048      INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1
1049      INTEGER(8) :: ASIZE
1050      LOGICAL COMPUTE_MAX
1051      INTEGER NBROWS_PACKET
1052      INTEGER MAX_ROW_LENGTH
1053      INTEGER LROW, NELIM
1054      INTEGER(8) :: SIZFR, ITMP8
1055      INTEGER NPIV, NFRONT, HS
1056      INTEGER SIZE_PACK, SIZE1, SIZE2, POSITION,I
1057      INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV
1058      INTEGER NBINT, L
1059      INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8
1060      INTEGER IPOS_IN_SLAVE
1061      INTEGER STATE_SON
1062      INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA
1063      INTEGER IONE, J, THIS_ROW_LENGTH
1064      INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES
1065      LOGICAL RECV_BUF_SMALLER_THAN_SEND
1066      LOGICAL NOT_ENOUGH_SPACE
1067      INTEGER PDEST2(1)
1068      PARAMETER ( IONE=1 )
1069      INCLUDE 'mumps_headers.h'
1070      REAL ZERO
1071      PARAMETER (ZERO = 0.0E0)
1072      COMPUTE_MAX = (KEEP(219) .NE. 0) .AND.
1073     &              (KEEP(50) .EQ. 2) .AND.
1074     &              (PDEST.EQ.PDEST_MASTER)
1075      IF (NBROWS_ALREADY_SENT == 0) THEN
1076        IF (COMPUTE_MAX) THEN
1077          CALL SMUMPS_BUF_MAX_ARRAY_MINSIZE(NFS4FATHER,IERR)
1078          IF (IERR .NE. 0) THEN
1079            IERR         = -4
1080            RETURN
1081          ENDIF
1082        ENDIF
1083      ENDIF
1084      PDEST2(1) = PDEST
1085      IERR   = 0
1086      LROW   = IW_CBSON( 1 + KEEP(IXSZ))
1087      NELIM  = IW_CBSON( 2 + KEEP(IXSZ))
1088      NPIV   = IW_CBSON( 4 + KEEP(IXSZ))
1089      IF ( NPIV .LT. 0 ) THEN
1090          NPIV = 0
1091      END IF
1092      NROW   = IW_CBSON( 3 + KEEP(IXSZ))
1093      NFRONT = LROW + NPIV
1094      HS     = 6 + IW_CBSON( 6 + KEEP(IXSZ)) + KEEP(IXSZ)
1095      CALL MUMPS_GETI8( SIZFR, IW_CBSON( 1 + XXR ) )
1096      STATE_SON = IW_CBSON(1+XXS)
1097      IF (STATE_SON .EQ. S_NOLCBCONTIG) THEN
1098               LDA_SON8    = int(LROW,8)
1099               SHIFTCB_SON = int(NPIV,8)*int(NROW,8)
1100      ELSE IF (STATE_SON .EQ. S_NOLCLEANED) THEN
1101               LDA_SON8    = int(LROW,8)
1102               SHIFTCB_SON = 0_8
1103      ELSE
1104               LDA_SON8     = int(NFRONT,8)
1105               SHIFTCB_SON = int(NPIV,8)
1106      ENDIF
1107      CALL SMUMPS_BUF_SIZE_AVAILABLE( BUF_CB, SIZE_AV )
1108      IF (PDEST .EQ. PDEST_MASTER) THEN
1109        SIZE_DESC_BANDE=0
1110      ELSE
1111        SIZE_DESC_BANDE=(7+SLAVEF+KEEP(127)*2)
1112        SIZE_DESC_BANDE=SIZE_DESC_BANDE+int(real(KEEP(12))*
1113     &                  real(SIZE_DESC_BANDE)/100.0E0)
1114        SIZE_DESC_BANDE=max(SIZE_DESC_BANDE,
1115     &     7+NSLAVES_PERE+NFRONT_PERE+NFRONT_PERE-NASS_PERE)
1116      ENDIF
1117      DESC_BANDE_BYTES=SIZE_DESC_BANDE*SIZEofINT
1118      IF ( SIZE_AV .LT. SIZE_RBUF_BYTES-DESC_BANDE_BYTES ) THEN
1119        RECV_BUF_SMALLER_THAN_SEND = .FALSE.
1120      ELSE
1121        RECV_BUF_SMALLER_THAN_SEND = .TRUE.
1122        SIZE_AV = SIZE_RBUF_BYTES-DESC_BANDE_BYTES
1123      ENDIF
1124      SIZE1=0
1125      IF (NBROWS_ALREADY_SENT==0) THEN
1126          IF(COMPUTE_MAX) THEN
1127               CALL MPI_PACK_SIZE(1, MPI_INTEGER,
1128     &            COMM, PS1, IERR )
1129               IF(NFS4FATHER .GT. 0) THEN
1130                CALL MPI_PACK_SIZE( NFS4FATHER, MPI_REAL,
1131     &             COMM, SIZE1, IERR )
1132               ENDIF
1133               SIZE1 = SIZE1+PS1
1134          ENDIF
1135      ENDIF
1136      IF (KEEP(50) .EQ. 0) THEN
1137        ONEorTWO = 1
1138      ELSE
1139        ONEorTWO = 2
1140      ENDIF
1141      IF (PDEST .EQ.PDEST_MASTER) THEN
1142        L = 0
1143      ELSE IF (KEEP(50) .EQ. 0) THEN
1144        L = LROW
1145      ELSE
1146        L = LROW + PERM(1) - LMAP + NBROWS_ALREADY_SENT - 1
1147        ONEorTWO=ONEorTWO+1
1148      ENDIF
1149      NBINT = 6 + L
1150      CALL MPI_PACK_SIZE( NBINT, MPI_INTEGER,
1151     &                    COMM, TMPSIZE, IERR )
1152      SIZE1 = SIZE1 + TMPSIZE
1153      SIZE_AV = SIZE_AV - SIZE1
1154      NOT_ENOUGH_SPACE=.FALSE.
1155      IF (SIZE_AV .LT.0 ) THEN
1156        NBROWS_PACKET = 0
1157        NOT_ENOUGH_SPACE=.TRUE.
1158      ELSE
1159        IF ( KEEP(50) .EQ. 0 ) THEN
1160          NBROWS_PACKET =
1161     &       SIZE_AV / ( ONEorTWO*SIZEofINT+LROW*SIZEofREAL)
1162        ELSE
1163          B = 2 * ONEorTWO +
1164     &      ( 1 + 2 *  LROW + 2 * PERM(1) + 2 * NBROWS_ALREADY_SENT )
1165     &      * SIZEofREAL / SIZEofINT
1166          NBROWS_PACKET=int((dble(-B)+sqrt((dble(B)*dble(B))+
1167     &        dble(4)*dble(2)*dble(SIZE_AV)/dble(SIZEofINT) *
1168     &        dble(SIZEofREAL/SIZEofINT)))*
1169     &        dble(SIZEofINT) / dble(2) / dble(SIZEofREAL))
1170        ENDIF
1171      ENDIF
1172 10   CONTINUE
1173      NBROWS_PACKET = max( 0,
1174     &           min( NBROWS_PACKET, NBROW - NBROWS_ALREADY_SENT))
1175      NOT_ENOUGH_SPACE = NOT_ENOUGH_SPACE .OR.
1176     &                   (NBROWS_PACKET .EQ.0.AND. NBROW.NE.0)
1177      IF (NOT_ENOUGH_SPACE) THEN
1178        IF (RECV_BUF_SMALLER_THAN_SEND) THEN
1179          IERR = -3
1180          GOTO 100
1181        ELSE
1182          IERR = -1
1183          GOTO 100
1184        ENDIF
1185      ENDIF
1186      IF (KEEP(50).EQ.0) THEN
1187        MAX_ROW_LENGTH = -99999
1188        SIZE_REALS = NBROWS_PACKET * LROW
1189      ELSE
1190        SIZE_REALS = (  LROW + PERM(1) + NBROWS_ALREADY_SENT ) *
1191     &  NBROWS_PACKET + ( NBROWS_PACKET * ( NBROWS_PACKET + 1) ) / 2
1192        MAX_ROW_LENGTH = LROW+PERM(1)-LMAP+NBROWS_ALREADY_SENT
1193     &                 + NBROWS_PACKET-1
1194      ENDIF
1195      SIZE_INTEGERS = ONEorTWO* NBROWS_PACKET
1196      CALL MPI_PACK_SIZE( SIZE_REALS, MPI_REAL,
1197     &                    COMM, SIZE2,  IERR)
1198      CALL MPI_PACK_SIZE( SIZE_INTEGERS, MPI_INTEGER,
1199     &                    COMM, SIZE3,  IERR)
1200      IF (SIZE2 + SIZE3 .GT. SIZE_AV ) THEN
1201         NBROWS_PACKET = NBROWS_PACKET -1
1202         IF (NBROWS_PACKET .GT. 0 ) THEN
1203           GOTO 10
1204         ELSE
1205           IF (RECV_BUF_SMALLER_THAN_SEND) THEN
1206             IERR = -3
1207             GOTO 100
1208           ELSE
1209             IERR = -1
1210             GOTO 100
1211           ENDIF
1212         ENDIF
1213      ENDIF
1214        SIZE_PACK = SIZE1 + SIZE2 + SIZE3
1215        IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NBROW .AND.
1216     &       SIZE_PACK  .LT. SIZE_RBUF_BYTES / 4 .AND.
1217     &    .NOT. RECV_BUF_SMALLER_THAN_SEND)
1218     &    THEN
1219            IERR = -1
1220            GOTO 100
1221        ENDIF
1222        IF (SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN
1223          IERR = -3
1224          GOTO 100
1225        ENDIF
1226        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR,
1227     &                 IONE , PDEST2
1228     &               )
1229        IF (IERR .EQ. -1 .OR. IERR.EQ. -2) THEN
1230          NBROWS_PACKET = NBROWS_PACKET - 1
1231          IF (NBROWS_PACKET > 0 ) GOTO 10
1232        ENDIF
1233        IF ( IERR .LT. 0 ) GOTO 100
1234        POSITION = 0
1235        CALL MPI_PACK( IPERE, 1, MPI_INTEGER,
1236     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1237     &                 POSITION, COMM, IERR )
1238        CALL MPI_PACK( ISON, 1, MPI_INTEGER,
1239     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1240     &                 POSITION, COMM, IERR )
1241        CALL MPI_PACK( NBROW, 1, MPI_INTEGER,
1242     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1243     &                 POSITION, COMM, IERR )
1244        IF (KEEP(50)==0) THEN
1245        CALL MPI_PACK( LROW, 1, MPI_INTEGER,
1246     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1247     &                 POSITION, COMM, IERR )
1248        ELSE
1249        CALL MPI_PACK( MAX_ROW_LENGTH, 1, MPI_INTEGER,
1250     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1251     &                 POSITION, COMM, IERR )
1252        ENDIF
1253        CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER,
1254     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1255     &                 POSITION, COMM, IERR )
1256        CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER,
1257     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1258     &                 POSITION, COMM, IERR )
1259        IF ( PDEST .NE. PDEST_MASTER ) THEN
1260          IF (KEEP(50)==0) THEN
1261          CALL MPI_PACK( IW_CBSON( HS + NROW +  NPIV + 1 ), LROW,
1262     &                 MPI_INTEGER,
1263     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1264     &                 POSITION, COMM, IERR )
1265          ELSE
1266           IF (MAX_ROW_LENGTH > 0) THEN
1267           CALL MPI_PACK( IW_CBSON( HS + NROW +  NPIV + 1 ),
1268     &                 MAX_ROW_LENGTH,
1269     &                 MPI_INTEGER,
1270     &                 BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1271     &                 POSITION, COMM, IERR )
1272           ENDIF
1273          ENDIF
1274        END IF
1275        DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET
1276           I = PERM(J)
1277           INDICE_PERE=MAPROW(I)
1278           CALL MUMPS_BLOC2_GET_ISLAVE(
1279     &          KEEP,KEEP8, IPERE, STEP, N, SLAVEF,
1280     &          ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1281     &
1282     &          NASS_PERE,
1283     &          NFRONT_PERE - NASS_PERE,
1284     &          NSLAVES_PERE,
1285     &          INDICE_PERE,
1286     &          NOSLA,
1287     &          IPOS_IN_SLAVE )
1288           INDICE_PERE = IPOS_IN_SLAVE
1289           CALL MPI_PACK( INDICE_PERE, 1, MPI_INTEGER,
1290     &          BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1291     &          POSITION, COMM, IERR )
1292        ENDDO
1293        DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET
1294           I = PERM(J)
1295           INDICE_PERE=MAPROW(I)
1296           CALL MUMPS_BLOC2_GET_ISLAVE(
1297     &          KEEP,KEEP8, IPERE, STEP, N, SLAVEF,
1298     &          ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1299     &
1300     &          NASS_PERE,
1301     &          NFRONT_PERE - NASS_PERE,
1302     &          NSLAVES_PERE,
1303     &          INDICE_PERE,
1304     &          NOSLA,
1305     &          IPOS_IN_SLAVE )
1306          IF (KEEP(50).ne.0) THEN
1307            THIS_ROW_LENGTH = LROW + I - LMAP
1308            CALL MPI_PACK( THIS_ROW_LENGTH, 1, MPI_INTEGER,
1309     &                      BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1310     &                      POSITION, COMM, IERR )
1311         ELSE
1312            THIS_ROW_LENGTH = LROW
1313         ENDIF
1314         IF (DESC_IN_LU) THEN
1315            IF ( COMPRESSCB ) THEN
1316             IF (NELIM.EQ.0) THEN
1317               ITMP8 = int(I,8)
1318             ELSE
1319               ITMP8 = int(NELIM+I,8)
1320             ENDIF
1321             APOS = ITMP8 * (ITMP8-1_8) / 2_8 + 1_8
1322            ELSE
1323             APOS = int(I+NELIM-1, 8) * int(LROW,8) + 1_8
1324            ENDIF
1325         ELSE
1326            IF ( COMPRESSCB ) THEN
1327             IF ( LROW .EQ. NROW )  THEN
1328               ITMP8 = int(I,8)
1329               APOS  = ITMP8 * (ITMP8-1_8)/2_8 + 1_8
1330             ELSE
1331               ITMP8 = int(I + LROW - NROW,8)
1332               APOS  = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 -
1333     &                 int(LROW - NROW, 8) * int(LROW-NROW+1,8) / 2_8
1334             ENDIF
1335            ELSE
1336             APOS = int( I - 1, 8 ) * LDA_SON8 + SHIFTCB_SON + 1_8
1337            ENDIF
1338         ENDIF
1339         CALL MPI_PACK( A_CBSON( APOS ), THIS_ROW_LENGTH,
1340     &        MPI_REAL,
1341     &        BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1342     &        POSITION, COMM, IERR )
1343        ENDDO
1344      IF (NBROWS_ALREADY_SENT == 0) THEN
1345        IF (COMPUTE_MAX) THEN
1346           CALL MPI_PACK(NFS4FATHER,1,
1347     &          MPI_INTEGER,
1348     &          BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1349     &          POSITION, COMM, IERR )
1350           IF(NFS4FATHER .GT. 0) THEN
1351              BUF_MAX_ARRAY(1:NFS4FATHER) = ZERO
1352              IF(MAPROW(NROW) .GT. NASS_PERE) THEN
1353                 DO PS1=1,NROW
1354                    IF(MAPROW(PS1).GT.NASS_PERE) EXIT
1355                 ENDDO
1356                 IF (DESC_IN_LU) THEN
1357                   IF (COMPRESSCB) THEN
1358                    APOS = int(NELIM+PS1,8) * int(NELIM+PS1-1,8) /
1359     &                     2_8 + 1_8
1360                    NCA  = -44444
1361                    ASIZE  = int(NROW,8) * int(NROW+1,8)/2_8 -
1362     &                       int(NELIM+PS1,8) * int(NELIM+PS1-1,8)/2_8
1363                    LROW1  = PS1 + NELIM
1364                   ELSE
1365                    APOS = int(PS1+NELIM-1,8) * int(LROW,8) + 1_8
1366                    NCA = LROW
1367                    ASIZE = int(NCA,8) * int(NROW-PS1+1,8)
1368                    LROW1 = LROW
1369                   ENDIF
1370                 ELSE
1371                    IF (COMPRESSCB) THEN
1372                      IF (NPIV.NE.0) THEN
1373         WRITE(*,*) "Error in PARPIV/SMUMPS_BUF_SEND_CONTRIB_TYPE2"
1374                        CALL MUMPS_ABORT()
1375                      ENDIF
1376                      LROW1=LROW-NROW+PS1
1377                      ITMP8 = int(PS1 + LROW - NROW,8)
1378                      APOS = ITMP8 * (ITMP8 - 1_8) / 2_8 + 1_8 -
1379     &                       int(LROW-NROW,8)*int(LROW-NROW+1,8)/2_8
1380                      ASIZE = int(LROW,8)*int(LROW+1,8)/2_8 -
1381     &                       ITMP8*(ITMP8-1_8)/2_8
1382                      NCA   = -555555
1383                    ELSE
1384                      APOS = int(PS1-1,8) * LDA_SON8 + 1_8 + SHIFTCB_SON
1385                      NCA = int(LDA_SON8)
1386                      ASIZE = SIZFR - (SHIFTCB_SON -
1387     &                                 int(PS1-1,8) * LDA_SON8)
1388                      LROW1=-666666
1389                    ENDIF
1390                 ENDIF
1391                 IF ( NROW-PS1+1-KEEP253_LOC .NE. 0 ) THEN
1392                   CALL SMUMPS_COMPUTE_MAXPERCOL(
1393     &                A_CBSON(APOS),ASIZE,NCA,
1394     &                NROW-PS1+1-KEEP253_LOC,
1395     &                BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,LROW1)
1396                 ENDIF
1397              ENDIF
1398              CALL MPI_PACK(BUF_MAX_ARRAY, NFS4FATHER,
1399     &             MPI_REAL,
1400     &             BUF_CB%CONTENT( IPOS ), SIZE_PACK,
1401     &             POSITION, COMM, IERR )
1402           ENDIF
1403        ENDIF
1404      ENDIF
1405        KEEP(266)=KEEP(266)+1
1406        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
1407     &                  PDEST, CONTRIB_TYPE2, COMM,
1408     &                  BUF_CB%CONTENT( IREQ ), IERR )
1409        IF ( SIZE_PACK.LT. POSITION ) THEN
1410          WRITE(*,*) ' contniv2: SIZE, POSITION =',SIZE_PACK, POSITION
1411          WRITE(*,*) ' NBROW, LROW = ', NBROW, LROW
1412          CALL MUMPS_ABORT()
1413        END IF
1414        IF ( SIZE_PACK .NE. POSITION )
1415     &  CALL BUF_ADJUST( BUF_CB, POSITION )
1416        NBROWS_ALREADY_SENT=NBROWS_ALREADY_SENT + NBROWS_PACKET
1417        IF (NBROWS_ALREADY_SENT .NE. NBROW ) THEN
1418           IERR = -1
1419        ENDIF
1420 100    CONTINUE
1421        RETURN
1422        END SUBROUTINE SMUMPS_BUF_SEND_CONTRIB_TYPE2
1423        SUBROUTINE SMUMPS_BUF_SEND_MAPLIG(
1424     &                INODE, NFRONT, NASS1, NFS4FATHER,
1425     &                ISON, MYID, NSLAVES, SLAVES_PERE,
1426     &                TROW, NCBSON,
1427     &                COMM, IERR,
1428     &                DEST, NDEST, SLAVEF,
1429     &
1430     &                KEEP,KEEP8, STEP, N,
1431     &                ISTEP_TO_INIV2, TAB_POS_IN_PERE
1432     &
1433     &                                  )
1434        IMPLICIT NONE
1435      INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES,
1436     &          NDEST
1437      INTEGER SLAVEF, MYID, ISON
1438      INTEGER TROW( NCBSON )
1439      INTEGER DEST( NDEST )
1440      INTEGER SLAVES_PERE( NSLAVES )
1441      INTEGER COMM, IERR
1442      INTEGER KEEP(500), N
1443      INTEGER(8) KEEP8(150)
1444      INTEGER STEP(N),
1445     &        ISTEP_TO_INIV2(KEEP(71)),
1446     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
1447      INCLUDE 'mpif.h'
1448      INCLUDE 'mumps_tags.h'
1449        INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER
1450        INTEGER TROW_SIZE, POSITION, INDX, INIV2
1451        INTEGER IPOS, IREQ
1452        INTEGER IONE
1453        PARAMETER ( IONE=1 )
1454        INTEGER NASS_SON
1455        NASS_SON = -99998
1456        IERR = 0
1457        IF ( NDEST .eq. 1 ) THEN
1458          IF ( DEST(1).EQ.MYID )  GOTO 500
1459          SIZE = SIZEofINT * ( 7 + NSLAVES + NCBSON )
1460          IF ( NSLAVES.GT.0 ) THEN
1461             SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 )
1462          ENDIF
1463          IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN
1464            IERR = -3
1465            RETURN
1466          END IF
1467          CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE, IERR,
1468     &                 IONE, DEST
1469     &                 )
1470          IF (IERR .LT. 0 ) THEN
1471            RETURN
1472          ENDIF
1473              POSITION = IPOS
1474              BUF_CB%CONTENT( POSITION ) = INODE
1475              POSITION = POSITION + 1
1476              BUF_CB%CONTENT( POSITION ) = ISON
1477              POSITION = POSITION + 1
1478              BUF_CB%CONTENT( POSITION ) = NSLAVES
1479              POSITION = POSITION + 1
1480              BUF_CB%CONTENT( POSITION ) = NFRONT
1481              POSITION = POSITION + 1
1482              BUF_CB%CONTENT( POSITION ) = NASS1
1483              POSITION = POSITION + 1
1484              BUF_CB%CONTENT( POSITION ) = NCBSON
1485              POSITION = POSITION + 1
1486              BUF_CB%CONTENT( POSITION ) = NFS4FATHER
1487              POSITION = POSITION + 1
1488              IF ( NSLAVES.GT.0 ) THEN
1489                INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) )
1490                BUF_CB%CONTENT( POSITION: POSITION + NSLAVES )
1491     &          =  TAB_POS_IN_PERE(1:NSLAVES+1,INIV2)
1492                POSITION = POSITION + NSLAVES + 1
1493              ENDIF
1494              IF ( NSLAVES .NE. 0 ) THEN
1495                BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 )
1496     &          = SLAVES_PERE( 1: NSLAVES )
1497                POSITION = POSITION + NSLAVES
1498              END IF
1499              BUF_CB%CONTENT( POSITION:POSITION+NCBSON-1 ) =
1500     &        TROW( 1: NCBSON )
1501              POSITION = POSITION + NCBSON
1502              POSITION = POSITION - IPOS
1503              IF ( POSITION * SIZEofINT .NE. SIZE ) THEN
1504                WRITE(*,*) 'Error in SMUMPS_BUF_SEND_MAPLIG :',
1505     &                     ' wrong estimated size'
1506                CALL MUMPS_ABORT()
1507              END IF
1508              KEEP(266)=KEEP(266)+1
1509              CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE,
1510     &                        MPI_PACKED,
1511     &                        DEST( NDEST ), MAPLIG, COMM,
1512     &                        BUF_CB%CONTENT( IREQ ),
1513     &                        IERR )
1514        ELSE
1515          NSEND = 0
1516          DO IDEST = 1, NDEST
1517            IF ( DEST( IDEST ) .ne. MYID ) NSEND = NSEND + 1
1518          END DO
1519          SIZE = SIZEofINT *
1520     &         ( ( OVHSIZE + 7 + NSLAVES )* NSEND + NCBSON )
1521          IF ( NSLAVES.GT.0 ) THEN
1522           SIZE = SIZE + SIZEofINT * NSEND*( NSLAVES + 1 )
1523          ENDIF
1524          CALL SMUMPS_BUF_SIZE_AVAILABLE( BUF_CB, SIZE_AV )
1525          IF ( SIZE_AV .LT. SIZE ) THEN
1526            IERR = -1
1527            RETURN
1528          END IF
1529          DO IDEST= 1, NDEST
1530            CALL MUMPS_BLOC2_GET_SLAVE_INFO(
1531     &                KEEP,KEEP8, ISON, STEP, N, SLAVEF,
1532     &                ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1533     &                IDEST, NCBSON,
1534     &                NDEST,
1535     &                TROW_SIZE, INDX  )
1536            SIZE = SIZEofINT * ( NSLAVES + TROW_SIZE + 7 )
1537            IF ( NSLAVES.GT.0 ) THEN
1538             SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 )
1539            ENDIF
1540            IF ( MYID .NE. DEST( IDEST ) ) THEN
1541              IF (SIZE.GT.SIZE_RBUF_BYTES) THEN
1542                IERR = -3
1543                RETURN
1544              ENDIF
1545              CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE, IERR,
1546     &                       IONE, DEST(IDEST) )
1547              IF ( IERR .LT. 0 )  THEN
1548                WRITE(*,*) 'Internal error SMUMPS_BUF_SEND_MAPLIG',
1549     &                     'IERR after BUF_LOOK=',IERR
1550                CALL MUMPS_ABORT()
1551              END IF
1552              POSITION = IPOS
1553              BUF_CB%CONTENT( POSITION ) = INODE
1554              POSITION = POSITION + 1
1555              BUF_CB%CONTENT( POSITION ) = ISON
1556              POSITION = POSITION + 1
1557              BUF_CB%CONTENT( POSITION ) = NSLAVES
1558              POSITION = POSITION + 1
1559              BUF_CB%CONTENT( POSITION ) = NFRONT
1560              POSITION = POSITION + 1
1561              BUF_CB%CONTENT( POSITION ) = NASS1
1562              POSITION = POSITION + 1
1563              BUF_CB%CONTENT( POSITION ) = TROW_SIZE
1564              POSITION = POSITION + 1
1565              BUF_CB%CONTENT( POSITION ) = NFS4FATHER
1566              POSITION = POSITION + 1
1567              IF ( NSLAVES.GT.0 ) THEN
1568                INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) )
1569                BUF_CB%CONTENT( POSITION: POSITION + NSLAVES )
1570     &          =  TAB_POS_IN_PERE(1:NSLAVES+1,INIV2)
1571                POSITION = POSITION + NSLAVES + 1
1572              ENDIF
1573              IF ( NSLAVES .NE. 0 ) THEN
1574                BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 )
1575     &          = SLAVES_PERE( 1: NSLAVES )
1576                POSITION = POSITION + NSLAVES
1577              END IF
1578              BUF_CB%CONTENT( POSITION:POSITION+TROW_SIZE-1 ) =
1579     &        TROW( INDX: INDX + TROW_SIZE - 1 )
1580              POSITION = POSITION + TROW_SIZE
1581              POSITION = POSITION - IPOS
1582              IF ( POSITION * SIZEofINT .NE. SIZE ) THEN
1583               WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:',
1584     &          'Wrong estimated size'
1585               CALL MUMPS_ABORT()
1586              END IF
1587              KEEP(266)=KEEP(266)+1
1588              CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE,
1589     &                        MPI_PACKED,
1590     &                        DEST( IDEST ), MAPLIG, COMM,
1591     &                        BUF_CB%CONTENT( IREQ ),
1592     &                        IERR )
1593            END IF
1594          END DO
1595        END IF
1596 500    CONTINUE
1597        RETURN
1598        END SUBROUTINE SMUMPS_BUF_SEND_MAPLIG
1599        SUBROUTINE SMUMPS_BUF_SEND_BLOCFACTO( INODE, NFRONT,
1600     &             NCOL, NPIV, FPERE, LASTBL, IPIV, VAL,
1601     &             PDEST, NDEST, KEEP, NB_BLOC_FAC,
1602     &             NSLAVES_TOT,
1603     &             WIDTH, COMM,
1604     &             NELIM, NPARTSASS, CURRENT_BLR_PANEL,
1605     &             SEND_LR, BLR_LorU,
1606     &
1607     &             IERR )
1608      USE SMUMPS_LR_TYPE
1609      IMPLICIT NONE
1610        INTEGER, intent(in) :: INODE, NCOL, NPIV,
1611     &                         FPERE, NFRONT, NDEST
1612        INTEGER, intent(in) :: IPIV( NPIV )
1613        REAL, intent(in) :: VAL( NFRONT, * )
1614        INTEGER, intent(in) :: PDEST( NDEST )
1615        INTEGER, intent(inout) :: KEEP(500)
1616        INTEGER, intent(in) :: NB_BLOC_FAC,
1617     &                         NSLAVES_TOT, COMM, WIDTH
1618        LOGICAL, intent(in) :: LASTBL
1619        LOGICAL, intent(in) :: SEND_LR
1620        INTEGER, intent(in) :: NELIM, NPARTSASS, CURRENT_BLR_PANEL
1621        TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR_LorU
1622        INTEGER :: SEND_LR_INT
1623        INTEGER, intent(inout) :: IERR
1624        INCLUDE 'mpif.h'
1625        INCLUDE 'mumps_tags.h'
1626        INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE3, SIZET,
1627     &          IDEST, IPOSMSG, I
1628        INTEGER NPIVSENT
1629        INTEGER SSS
1630        INTEGER  :: NBMSGS
1631        INTEGER, ALLOCATABLE, DIMENSION(:) ::  RELAY_INFO
1632        INTEGER :: LRELAY_INFO, DEST_BLOCFACTO, TAG_BLOCFACTO
1633        IERR = 0
1634        LRELAY_INFO = 0
1635        NBMSGS = NDEST
1636        IF ( LASTBL ) THEN
1637          IF ( KEEP(50) .eq. 0 ) THEN
1638            CALL MPI_PACK_SIZE( 4 + NPIV + ( NBMSGS - 1 ) * OVHSIZE +
1639     &                          1+LRELAY_INFO,
1640     &                          MPI_INTEGER, COMM, SIZE1, IERR )
1641          ELSE
1642            CALL MPI_PACK_SIZE( 6 + NPIV + ( NBMSGS - 1 ) * OVHSIZE +
1643     &                          1+LRELAY_INFO,
1644     &                          MPI_INTEGER, COMM, SIZE1, IERR )
1645          END IF
1646        ELSE
1647          IF ( KEEP(50) .eq. 0 ) THEN
1648          CALL MPI_PACK_SIZE( 3 + NPIV + ( NBMSGS - 1 ) * OVHSIZE +
1649     &                        1+LRELAY_INFO,
1650     &                        MPI_INTEGER, COMM, SIZE1, IERR )
1651          ELSE
1652            CALL MPI_PACK_SIZE( 4 + NPIV + ( NBMSGS - 1 ) * OVHSIZE +
1653     &                          1+LRELAY_INFO,
1654     &                          MPI_INTEGER, COMM, SIZE1, IERR )
1655          END IF
1656        END IF
1657        SIZE2 = 0
1658        CALL MPI_PACK_SIZE(4, MPI_INTEGER, COMM, SIZE3, IERR)
1659        SIZE2=SIZE2+SIZE3
1660        IF ( KEEP(50).NE.0 ) THEN
1661          CALL MPI_PACK_SIZE(1, MPI_INTEGER, COMM, SIZE3, IERR)
1662          SIZE2=SIZE2+SIZE3
1663        ENDIF
1664        IF ((NPIV.GT.0)
1665     &     ) THEN
1666          IF (.NOT. SEND_LR) THEN
1667            CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_REAL,
1668     &                      COMM, SIZE3, IERR )
1669            SIZE2 = SIZE2+SIZE3
1670          ELSE
1671            CALL MPI_PACK_SIZE( NPIV*(NPIV+NELIM), MPI_REAL,
1672     &                      COMM, SIZE3, IERR )
1673            SIZE2 = SIZE2+SIZE3
1674              CALL MUMPS_MPI_PACK_SIZE_LR( BLR_LorU, SIZE3, COMM, IERR )
1675            SIZE2 = SIZE2+SIZE3
1676          ENDIF
1677        ENDIF
1678        SIZET = SIZE1 + SIZE2
1679        IF (SIZET.GT.SIZE_RBUF_BYTES) THEN
1680          SSS = 0
1681          IF ( LASTBL ) THEN
1682           IF ( KEEP(50) .eq. 0 ) THEN
1683            CALL MPI_PACK_SIZE( 4 + NPIV + 1+LRELAY_INFO,
1684     &                        MPI_INTEGER, COMM, SSS, IERR )
1685           ELSE
1686            CALL MPI_PACK_SIZE( 6 + NPIV + 1+LRELAY_INFO,
1687     &                           MPI_INTEGER, COMM, SSS, IERR )
1688           END IF
1689          ELSE
1690           IF ( KEEP(50) .eq. 0 ) THEN
1691            CALL MPI_PACK_SIZE( 3 + NPIV + 1+LRELAY_INFO,
1692     &                        MPI_INTEGER, COMM, SSS, IERR )
1693           ELSE
1694            CALL MPI_PACK_SIZE( 4 + NPIV + 1+LRELAY_INFO,
1695     &                        MPI_INTEGER, COMM, SSS, IERR )
1696           END IF
1697          END IF
1698          SSS = SSS + SIZE2
1699          IF (SSS.GT.SIZE_RBUF_BYTES) THEN
1700           IERR = -3
1701           RETURN
1702          ENDIF
1703        ENDIF
1704        IF (LRELAY_INFO.GT.0) THEN
1705         CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZET, IERR,
1706     &                 NBMSGS , RELAY_INFO(2)
1707     &               )
1708        ELSE
1709         CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZET, IERR,
1710     &                 NBMSGS , PDEST
1711     &               )
1712        ENDIF
1713        IF ( IERR .LT. 0 ) THEN
1714          RETURN
1715        ENDIF
1716        BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NBMSGS - 1 ) * OVHSIZE
1717        IPOS = IPOS - OVHSIZE
1718        DO IDEST = 1, NBMSGS - 1
1719          BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
1720     &    IPOS + IDEST * OVHSIZE
1721        END DO
1722        BUF_CB%CONTENT( IPOS + ( NBMSGS - 1 ) * OVHSIZE ) = 0
1723        IPOSMSG = IPOS + OVHSIZE * NBMSGS
1724        POSITION = 0
1725        CALL MPI_PACK( INODE, 1, MPI_INTEGER,
1726     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1727     &                        POSITION, COMM, IERR )
1728        NPIVSENT = NPIV
1729        IF (LASTBL) NPIVSENT = -NPIV
1730        CALL MPI_PACK( NPIVSENT, 1, MPI_INTEGER,
1731     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1732     &                        POSITION, COMM, IERR )
1733        IF ( LASTBL .or. KEEP(50).ne.0 ) THEN
1734          CALL MPI_PACK( FPERE, 1, MPI_INTEGER,
1735     &                   BUF_CB%CONTENT( IPOSMSG ), SIZET,
1736     &                   POSITION, COMM, IERR )
1737        END IF
1738        IF ( LASTBL .AND. KEEP(50) .NE. 0 ) THEN
1739            CALL MPI_PACK( NSLAVES_TOT, 1, MPI_INTEGER,
1740     &                   BUF_CB%CONTENT( IPOSMSG ), SIZET,
1741     &                   POSITION, COMM, IERR )
1742            CALL MPI_PACK( NB_BLOC_FAC, 1, MPI_INTEGER,
1743     &                   BUF_CB%CONTENT( IPOSMSG ), SIZET,
1744     &                   POSITION, COMM, IERR )
1745        END IF
1746        CALL MPI_PACK( NCOL, 1, MPI_INTEGER,
1747     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1748     &                        POSITION, COMM, IERR )
1749        IF (SEND_LR) THEN
1750          SEND_LR_INT=1
1751        ELSE
1752          SEND_LR_INT=0
1753        ENDIF
1754        CALL MPI_PACK( NELIM, 1, MPI_INTEGER,
1755     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1756     &                        POSITION, COMM, IERR )
1757        CALL MPI_PACK( NPARTSASS, 1, MPI_INTEGER,
1758     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1759     &                        POSITION, COMM, IERR )
1760        CALL MPI_PACK( CURRENT_BLR_PANEL, 1, MPI_INTEGER,
1761     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1762     &                        POSITION, COMM, IERR )
1763        CALL MPI_PACK( SEND_LR_INT, 1, MPI_INTEGER,
1764     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1765     &                        POSITION, COMM, IERR )
1766        IF ( KEEP(50) .ne. 0 ) THEN
1767          CALL MPI_PACK( NSLAVES_TOT, 1, MPI_INTEGER,
1768     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1769     &                        POSITION, COMM, IERR )
1770        ENDIF
1771        IF ( (NPIV.GT.0)
1772     &     ) THEN
1773          IF (NPIV.GT.0) THEN
1774            CALL MPI_PACK( IPIV, NPIV, MPI_INTEGER,
1775     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1776     &                        POSITION, COMM, IERR )
1777          ENDIF
1778          IF (SEND_LR) THEN
1779              DO I = 1, NPIV
1780              CALL MPI_PACK( VAL(1,I), NPIV+NELIM,
1781     &                        MPI_REAL,
1782     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1783     &                        POSITION, COMM, IERR )
1784              END DO
1785              CALL MUMPS_MPI_PACK_LR( BLR_LorU,
1786     &         BUF_CB%CONTENT(IPOSMSG:
1787     &              IPOSMSG+(SIZET+KEEP(34)-1)/KEEP(34)-1),
1788     &         SIZET, POSITION, COMM, IERR)
1789          ELSE
1790            DO I = 1, NPIV
1791              CALL MPI_PACK( VAL(1,I), NCOL,
1792     &                        MPI_REAL,
1793     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1794     &                        POSITION, COMM, IERR )
1795            END DO
1796          ENDIF
1797        ENDIF
1798        CALL MPI_PACK( LRELAY_INFO, 1, MPI_INTEGER,
1799     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1800     &                        POSITION, COMM, IERR )
1801        IF ( LRELAY_INFO.GT.0)
1802     &    CALL MPI_PACK( RELAY_INFO, LRELAY_INFO, MPI_INTEGER,
1803     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1804     &                        POSITION, COMM, IERR )
1805        DO IDEST = 1, NBMSGS
1806          IF (LRELAY_INFO .GT. 0) THEN
1807            DEST_BLOCFACTO = RELAY_INFO(IDEST+1)
1808          ELSE
1809            DEST_BLOCFACTO = PDEST(IDEST)
1810          ENDIF
1811          IF ( KEEP(50) .EQ. 0) THEN
1812            TAG_BLOCFACTO = BLOC_FACTO
1813            KEEP(266)=KEEP(266)+1
1814            CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION,
1815     &                MPI_PACKED,
1816     &                DEST_BLOCFACTO, TAG_BLOCFACTO, COMM,
1817     &                BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ),
1818     &                IERR )
1819          ELSE
1820            KEEP(266)=KEEP(266)+1
1821            CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION,
1822     &                MPI_PACKED,
1823     &                DEST_BLOCFACTO, BLOC_FACTO_SYM, COMM,
1824     &                BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ),
1825     &                IERR )
1826          END IF
1827        END DO
1828        SIZET = SIZET - ( NBMSGS - 1 ) * OVHSIZE * SIZEofINT
1829        IF ( SIZET .LT. POSITION ) THEN
1830          WRITE(*,*) ' Error sending blocfacto : size < position'
1831          WRITE(*,*) ' Size,position=',SIZET,POSITION
1832          CALL MUMPS_ABORT()
1833        END IF
1834        IF ( SIZET .NE. POSITION ) CALL BUF_ADJUST( BUF_CB, POSITION )
1835        RETURN
1836        END SUBROUTINE SMUMPS_BUF_SEND_BLOCFACTO
1837        SUBROUTINE SMUMPS_BUF_SEND_BLFAC_SLAVE( INODE,
1838     &             NPIV, FPERE, IPOSK, JPOSK, UIP21K, NCOLU,
1839     &             NDEST, PDEST, COMM, KEEP,
1840     &             SEND_LR, BLR_LS, IPANEL,
1841     &             A , LA, POSBLOCFACTO, LD_BLOCFACTO,
1842     &             IPIV, MAXI_CLUSTER,
1843     &             IERR )
1844      USE SMUMPS_LR_TYPE
1845        IMPLICIT NONE
1846        INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE
1847        REAL UIP21K( NPIV, * )
1848        INTEGER PDEST( NDEST )
1849        INTEGER   COMM, IERR
1850        INTEGER, INTENT(INOUT) :: KEEP(500)
1851        LOGICAL, intent(in) :: SEND_LR
1852        TYPE (LRB_TYPE), DIMENSION(:), POINTER :: BLR_LS
1853        INTEGER(8), intent(in)  :: LA, POSBLOCFACTO
1854        INTEGER, intent(in)     :: LD_BLOCFACTO, IPIV(NPIV),
1855     &                             MAXI_CLUSTER, IPANEL
1856        REAL, intent(inout)  :: A(LA)
1857        INTEGER :: SEND_LR_INT
1858        INCLUDE 'mpif.h'
1859        INCLUDE 'mumps_tags.h'
1860        INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZET,
1861     &          IDEST, IPOSMSG, SSS, SSLR
1862        IERR = 0
1863        CALL MPI_PACK_SIZE( 6 + ( NDEST - 1 ) * OVHSIZE,
1864     &                      MPI_INTEGER, COMM, SIZE1, IERR )
1865        SIZE2  = 0
1866        CALL MPI_PACK_SIZE(2, MPI_INTEGER, COMM, SSLR, IERR)
1867        SIZE2=SIZE2+SSLR
1868        IF (.NOT. SEND_LR) THEN
1869        CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_REAL,
1870     &                      COMM, SSLR, IERR )
1871         SIZE2=SIZE2+SSLR
1872        ELSE
1873          CALL MUMPS_MPI_PACK_SIZE_LR( BLR_LS, SSLR, COMM, IERR )
1874          SIZE2=SIZE2+SSLR
1875        ENDIF
1876        SIZET = SIZE1 + SIZE2
1877        IF (SIZET.GT.SIZE_RBUF_BYTES) THEN
1878         CALL MPI_PACK_SIZE( 6 ,
1879     &                      MPI_INTEGER, COMM, SSS, IERR )
1880         SSS = SSS+SIZE2
1881         IF (SSS.GT.SIZE_RBUF_BYTES) THEN
1882           IERR = -2
1883           RETURN
1884         ENDIF
1885        END IF
1886        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZET, IERR,
1887     &                 NDEST, PDEST
1888     &               )
1889        IF ( IERR .LT. 0 ) THEN
1890           RETURN
1891        ENDIF
1892        BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE
1893        IPOS = IPOS - OVHSIZE
1894        DO IDEST = 1, NDEST - 1
1895          BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
1896     &    IPOS + IDEST * OVHSIZE
1897        END DO
1898        BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0
1899        IPOSMSG = IPOS + OVHSIZE * NDEST
1900        POSITION = 0
1901        CALL MPI_PACK( INODE, 1, MPI_INTEGER,
1902     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1903     &                        POSITION, COMM, IERR )
1904        CALL MPI_PACK( IPOSK, 1, MPI_INTEGER,
1905     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1906     &                        POSITION, COMM, IERR )
1907        CALL MPI_PACK( JPOSK, 1, MPI_INTEGER,
1908     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1909     &                        POSITION, COMM, IERR )
1910        CALL MPI_PACK( NPIV, 1, MPI_INTEGER,
1911     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1912     &                        POSITION, COMM, IERR )
1913        CALL MPI_PACK( FPERE, 1, MPI_INTEGER,
1914     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1915     &                        POSITION, COMM, IERR )
1916        CALL MPI_PACK( NCOLU, 1, MPI_INTEGER,
1917     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1918     &                        POSITION, COMM, IERR )
1919        IF (SEND_LR) THEN
1920          SEND_LR_INT=1
1921        ELSE
1922          SEND_LR_INT=0
1923        ENDIF
1924        CALL MPI_PACK( SEND_LR_INT, 1, MPI_INTEGER,
1925     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1926     &                        POSITION, COMM, IERR )
1927        CALL MPI_PACK( IPANEL, 1, MPI_INTEGER,
1928     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1929     &                        POSITION, COMM, IERR )
1930        IF (SEND_LR) THEN
1931                 CALL MUMPS_MPI_PACK_SCALE_LR( BLR_LS,
1932     &           BUF_CB%CONTENT( IPOSMSG:
1933     &                   IPOSMSG+(SIZET+KEEP(34)-1)/KEEP(34)-1 ),
1934     &           SIZET, POSITION, COMM,
1935     &           A, LA, POSBLOCFACTO, LD_BLOCFACTO,
1936     &           IPIV, NPIV, MAXI_CLUSTER,
1937     &           IERR)
1938        ELSE
1939        CALL MPI_PACK( UIP21K, abs(NPIV) * NCOLU,
1940     &                        MPI_REAL,
1941     &                        BUF_CB%CONTENT( IPOSMSG ), SIZET,
1942     &                        POSITION, COMM, IERR )
1943        ENDIF
1944        DO IDEST = 1, NDEST
1945        KEEP(266)=KEEP(266)+1
1946        CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED,
1947     &                  PDEST(IDEST), BLOC_FACTO_SYM_SLAVE, COMM,
1948     &                  BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ),
1949     &                  IERR )
1950        END DO
1951        SIZET = SIZET - ( NDEST - 1 ) * OVHSIZE * SIZEofINT
1952        IF ( SIZET .LT. POSITION ) THEN
1953          WRITE(*,*) ' Error sending blfac slave : size < position'
1954          WRITE(*,*) ' Size,position=',SIZET,POSITION
1955          CALL MUMPS_ABORT()
1956        END IF
1957        IF ( SIZET .NE. POSITION ) CALL BUF_ADJUST( BUF_CB, POSITION )
1958        RETURN
1959        END SUBROUTINE SMUMPS_BUF_SEND_BLFAC_SLAVE
1960        SUBROUTINE SMUMPS_BUF_SEND_CONTRIB_TYPE3( N, ISON,
1961     &             NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON,
1962     &             LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL,
1963     &             NSUBSET_ROW, NSUBSET_COL,
1964     &             NSUPROW, NSUPCOL,
1965     &             NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL,
1966     &             NBLOCK, PDEST, COMM, IERR ,
1967     &             TAB, TABSIZE, TRANSP, SIZE_PACK,
1968     &             N_ALREADY_SENT, KEEP, BBPCBP )
1969        IMPLICIT NONE
1970        INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL
1971        INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON
1972        INTEGER BBPCBP
1973        INTEGER PDEST, TAG, COMM, IERR
1974        INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON )
1975        INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL )
1976        INTEGER, DIMENSION(:) :: RG2L_ROW
1977        INTEGER, DIMENSION(:) :: RG2L_COL
1978        INTEGER NSUPROW, NSUPCOL
1979        INTEGER(8), INTENT(IN) :: TABSIZE
1980        INTEGER SIZE_PACK
1981        INTEGER KEEP(500)
1982        REAL VAL_SON( LD_SON, * ), TAB(*)
1983        LOGICAL TRANSP
1984        INTEGER N_ALREADY_SENT
1985        INCLUDE 'mpif.h'
1986        INTEGER SIZE1, SIZE2, SIZE_AV, POSITION
1987        INTEGER SIZE_CBP, SIZE_TMP
1988        INTEGER IREQ, IPOS, ITAB
1989        INTEGER ISUB, JSUB, I, J
1990        INTEGER ILOC_ROOT, JLOC_ROOT
1991        INTEGER IPOS_ROOT, JPOS_ROOT
1992        INTEGER IONE
1993        LOGICAL RECV_BUF_SMALLER_THAN_SEND
1994        INTEGER PDEST2(1)
1995        PARAMETER ( IONE=1 )
1996        INTEGER N_PACKET
1997        INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF
1998        PDEST2(1) = PDEST
1999        IERR = 0
2000        IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN
2001          CALL SMUMPS_BUF_SIZE_AVAILABLE( BUF_CB, SIZE_AV )
2002          IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN
2003            RECV_BUF_SMALLER_THAN_SEND = .FALSE.
2004          ELSE
2005            RECV_BUF_SMALLER_THAN_SEND = .TRUE.
2006            SIZE_AV = SIZE_RBUF_BYTES
2007          ENDIF
2008          SIZE_AV = min(SIZE_AV, SIZE_RBUF_BYTES)
2009          CALL MPI_PACK_SIZE(8 + NSUBSET_COL,
2010     &                      MPI_INTEGER, COMM, SIZE1, IERR )
2011          SIZE_CBP = 0
2012          IF (N_ALREADY_SENT .EQ. 0 .AND.
2013     &        min(NSUPROW,NSUPCOL) .GT.0) THEN
2014            CALL MPI_PACK_SIZE(NSUPROW, MPI_INTEGER, COMM,
2015     &           SIZE_CBP, IERR)
2016            CALL MPI_PACK_SIZE(NSUPCOL, MPI_INTEGER, COMM,
2017     &           SIZE_TMP, IERR)
2018            SIZE_CBP = SIZE_CBP + SIZE_TMP
2019            CALL MPI_PACK_SIZE(NSUPROW*NSUPCOL,
2020     &           MPI_REAL, COMM,
2021     &           SIZE_TMP, IERR)
2022            SIZE_CBP = SIZE_CBP + SIZE_TMP
2023            SIZE1 = SIZE1 + SIZE_CBP
2024          ENDIF
2025          IF (BBPCBP.EQ.1) THEN
2026            NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL
2027            NSUPCOL_EFF = 0
2028          ELSE
2029            NSUBSET_COL_EFF = NSUBSET_COL
2030            NSUPCOL_EFF = NSUPCOL
2031          ENDIF
2032          NSUBSET_ROW_EFF = NSUBSET_ROW - NSUPROW
2033          N_PACKET =
2034     &    (SIZE_AV - SIZE1) / (SIZEofINT + NSUBSET_COL_EFF * SIZEofREAL)
2035 10       CONTINUE
2036          N_PACKET = min( N_PACKET,
2037     &                    NSUBSET_ROW_EFF-N_ALREADY_SENT )
2038          IF (N_PACKET .LE. 0 .AND.
2039     &        NSUBSET_ROW_EFF-N_ALREADY_SENT.GT.0) THEN
2040            IF (RECV_BUF_SMALLER_THAN_SEND) THEN
2041              IERR=-3
2042              GOTO 100
2043            ELSE
2044              IERR = -1
2045              GOTO 100
2046            ENDIF
2047          ENDIF
2048          CALL MPI_PACK_SIZE( 8 + NSUBSET_COL_EFF + N_PACKET,
2049     &                      MPI_INTEGER, COMM, SIZE1, IERR )
2050          SIZE1 = SIZE1 + SIZE_CBP
2051          CALL MPI_PACK_SIZE( N_PACKET * NSUBSET_COL_EFF,
2052     &                      MPI_REAL,
2053     &                      COMM, SIZE2, IERR )
2054          SIZE_PACK = SIZE1 + SIZE2
2055          IF (SIZE_PACK .GT. SIZE_AV) THEN
2056            N_PACKET = N_PACKET - 1
2057            IF ( N_PACKET > 0 ) THEN
2058              GOTO 10
2059            ELSE
2060              IF (RECV_BUF_SMALLER_THAN_SEND) THEN
2061                IERR = -3
2062                GOTO 100
2063              ELSE
2064                IERR = -1
2065                GOTO 100
2066              ENDIF
2067            ENDIF
2068          ENDIF
2069#if ! defined(DBG_SMB3)
2070          IF (N_PACKET + N_ALREADY_SENT .NE. NSUBSET_ROW - NSUPROW
2071     &      .AND.
2072     &      SIZE_PACK .LT. SIZE_RBUF_BYTES / 4
2073     &      .AND. .NOT. RECV_BUF_SMALLER_THAN_SEND)
2074     &      THEN
2075            IERR = -1
2076            GOTO 100
2077          ENDIF
2078#endif
2079        ELSE
2080          N_PACKET = 0
2081          CALL MPI_PACK_SIZE(8,MPI_INTEGER, COMM, SIZE_PACK, IERR )
2082        END IF
2083        IF ( SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN
2084             IERR = -3
2085             GOTO 100
2086        ENDIF
2087        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR,
2088     &                 IONE, PDEST2
2089     &               )
2090        IF ( IERR .LT. 0 ) GOTO 100
2091        POSITION = 0
2092        CALL MPI_PACK( ISON, 1, MPI_INTEGER,
2093     &                 BUF_CB%CONTENT( IPOS ),
2094     &                 SIZE_PACK, POSITION, COMM, IERR )
2095        CALL MPI_PACK( NSUBSET_ROW, 1, MPI_INTEGER,
2096     &                 BUF_CB%CONTENT( IPOS ),
2097     &                 SIZE_PACK, POSITION, COMM, IERR )
2098        CALL MPI_PACK( NSUPROW, 1, MPI_INTEGER,
2099     &                 BUF_CB%CONTENT( IPOS ),
2100     &                 SIZE_PACK, POSITION, COMM, IERR )
2101        CALL MPI_PACK( NSUBSET_COL, 1, MPI_INTEGER,
2102     &                 BUF_CB%CONTENT( IPOS ),
2103     &                 SIZE_PACK, POSITION, COMM, IERR )
2104        CALL MPI_PACK( NSUPCOL, 1, MPI_INTEGER,
2105     &                 BUF_CB%CONTENT( IPOS ),
2106     &                 SIZE_PACK, POSITION, COMM, IERR )
2107        CALL MPI_PACK( N_ALREADY_SENT, 1, MPI_INTEGER,
2108     &                 BUF_CB%CONTENT( IPOS ),
2109     &                 SIZE_PACK, POSITION, COMM, IERR )
2110        CALL MPI_PACK( N_PACKET, 1, MPI_INTEGER,
2111     &                 BUF_CB%CONTENT( IPOS ),
2112     &                 SIZE_PACK, POSITION, COMM, IERR )
2113        CALL MPI_PACK( BBPCBP, 1, MPI_INTEGER,
2114     &                 BUF_CB%CONTENT( IPOS ),
2115     &                 SIZE_PACK, POSITION, COMM, IERR )
2116        IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN
2117          IF (N_ALREADY_SENT .EQ. 0 .AND.
2118     &          min(NSUPROW, NSUPCOL) .GT. 0) THEN
2119            DO ISUB = NSUBSET_ROW-NSUPROW+1, NSUBSET_ROW
2120              I =  SUBSET_ROW( ISUB )
2121              IPOS_ROOT = RG2L_ROW(INDCOL_SON( I ))
2122              ILOC_ROOT = MBLOCK
2123     &                 * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) )
2124     &                 + mod( IPOS_ROOT - 1, MBLOCK ) + 1
2125              CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER,
2126     &                      BUF_CB%CONTENT( IPOS ),
2127     &                      SIZE_PACK, POSITION, COMM, IERR )
2128            ENDDO
2129            DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL
2130               J = SUBSET_COL( ISUB )
2131               JPOS_ROOT = INDROW_SON( J ) - N
2132               JLOC_ROOT = NBLOCK
2133     &                  * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) )
2134     &                  + mod( JPOS_ROOT - 1, NBLOCK ) + 1
2135              CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER,
2136     &                       BUF_CB%CONTENT( IPOS ),
2137     &                       SIZE_PACK, POSITION, COMM, IERR )
2138            ENDDO
2139            IF ( TABSIZE.GE.int(NSUPROW,8)*int(NSUPCOL,8) ) THEN
2140              ITAB = 1
2141              DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW
2142                J = SUBSET_ROW(JSUB)
2143                DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL
2144                  I = SUBSET_COL(ISUB)
2145                  TAB(ITAB) = VAL_SON(J, I)
2146                  ITAB = ITAB + 1
2147                ENDDO
2148              ENDDO
2149              CALL MPI_PACK(TAB(1), NSUPROW*NSUPCOL,
2150     &         MPI_REAL,
2151     &         BUF_CB%CONTENT( IPOS ),
2152     &         SIZE_PACK, POSITION, COMM, IERR )
2153            ELSE
2154              DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW
2155                J = SUBSET_ROW(JSUB)
2156                DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL
2157                  I = SUBSET_COL(ISUB)
2158                  CALL MPI_PACK(VAL_SON(J,I), 1,
2159     &            MPI_REAL,
2160     &            BUF_CB%CONTENT( IPOS ),
2161     &            SIZE_PACK, POSITION, COMM, IERR )
2162                ENDDO
2163              ENDDO
2164            ENDIF
2165          ENDIF
2166          IF ( .NOT. TRANSP ) THEN
2167            DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET
2168              I         = SUBSET_ROW( ISUB )
2169              IPOS_ROOT = RG2L_ROW( INDROW_SON( I ) )
2170              ILOC_ROOT = MBLOCK
2171     &                 * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) )
2172     &                 + mod( IPOS_ROOT - 1, MBLOCK ) + 1
2173              CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER,
2174     &                      BUF_CB%CONTENT( IPOS ),
2175     &                      SIZE_PACK, POSITION, COMM, IERR )
2176            END DO
2177            DO JSUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF
2178              J         = SUBSET_COL( JSUB )
2179              JPOS_ROOT = RG2L_COL( INDCOL_SON( J ) )
2180              JLOC_ROOT = NBLOCK
2181     &                  * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) )
2182     &                  + mod( JPOS_ROOT - 1, NBLOCK ) + 1
2183              CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER,
2184     &                       BUF_CB%CONTENT( IPOS ),
2185     &                       SIZE_PACK, POSITION, COMM, IERR )
2186            END DO
2187            DO JSUB = NSUBSET_COL_EFF-NSUPCOL_EFF+1, NSUBSET_COL_EFF
2188               J = SUBSET_COL( JSUB )
2189               JPOS_ROOT = INDCOL_SON( J ) - N
2190               JLOC_ROOT = NBLOCK
2191     &                  * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) )
2192     &                  + mod( JPOS_ROOT - 1, NBLOCK ) + 1
2193              CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER,
2194     &                       BUF_CB%CONTENT( IPOS ),
2195     &                       SIZE_PACK, POSITION, COMM, IERR )
2196            ENDDO
2197          ELSE
2198            DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET
2199              J         = SUBSET_ROW( JSUB )
2200              IPOS_ROOT = RG2L_ROW( INDCOL_SON( J ) )
2201              ILOC_ROOT = MBLOCK
2202     &                 * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) )
2203     &                 + mod( IPOS_ROOT - 1, MBLOCK ) + 1
2204              CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER,
2205     &                       BUF_CB%CONTENT( IPOS ),
2206     &                       SIZE_PACK, POSITION, COMM, IERR )
2207            END DO
2208            DO ISUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF
2209              I         = SUBSET_COL( ISUB )
2210              JPOS_ROOT = RG2L_COL( INDROW_SON( I ) )
2211              JLOC_ROOT = NBLOCK
2212     &                  * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) )
2213     &                  + mod( JPOS_ROOT - 1, NBLOCK ) + 1
2214              CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER,
2215     &                      BUF_CB%CONTENT( IPOS ),
2216     &                      SIZE_PACK, POSITION, COMM, IERR )
2217            END DO
2218            DO ISUB = NSUBSET_COL_EFF - NSUPCOL_EFF + 1, NSUBSET_COL_EFF
2219              I         = SUBSET_COL( ISUB )
2220              JPOS_ROOT = INDROW_SON(I) - N
2221              JLOC_ROOT = NBLOCK
2222     &                  * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) )
2223     &                  + mod( JPOS_ROOT - 1, NBLOCK ) + 1
2224              CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER,
2225     &                      BUF_CB%CONTENT( IPOS ),
2226     &                      SIZE_PACK, POSITION, COMM, IERR )
2227            ENDDO
2228          END IF
2229          IF ( TABSIZE.GE.int(N_PACKET,8)*int(NSUBSET_COL_EFF,8) ) THEN
2230            IF ( .NOT. TRANSP ) THEN
2231              ITAB = 1
2232              DO ISUB = N_ALREADY_SENT+1,
2233     &                  N_ALREADY_SENT+N_PACKET
2234                I         = SUBSET_ROW( ISUB )
2235                DO JSUB = 1, NSUBSET_COL_EFF
2236                  J              = SUBSET_COL( JSUB )
2237                  TAB( ITAB )    = VAL_SON(J,I)
2238                  ITAB           = ITAB + 1
2239                END DO
2240              END DO
2241              CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET,
2242     &         MPI_REAL,
2243     &         BUF_CB%CONTENT( IPOS ),
2244     &         SIZE_PACK, POSITION, COMM, IERR )
2245            ELSE
2246              ITAB = 1
2247              DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET
2248                J = SUBSET_ROW( JSUB )
2249                DO ISUB = 1, NSUBSET_COL_EFF
2250                  I         = SUBSET_COL( ISUB )
2251                  TAB( ITAB ) = VAL_SON( J, I )
2252                  ITAB = ITAB + 1
2253                END DO
2254              END DO
2255              CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET,
2256     &         MPI_REAL,
2257     &         BUF_CB%CONTENT( IPOS ),
2258     &         SIZE_PACK, POSITION, COMM, IERR )
2259            END IF
2260          ELSE
2261            IF ( .NOT. TRANSP ) THEN
2262              DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET
2263                I         = SUBSET_ROW( ISUB )
2264                DO JSUB = 1, NSUBSET_COL_EFF
2265                  J         = SUBSET_COL( JSUB )
2266                  CALL MPI_PACK( VAL_SON( J, I ), 1,
2267     &            MPI_REAL,
2268     &            BUF_CB%CONTENT( IPOS ),
2269     &            SIZE_PACK, POSITION, COMM, IERR )
2270                END DO
2271              END DO
2272            ELSE
2273              DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET
2274                J = SUBSET_ROW( JSUB )
2275                DO ISUB = 1, NSUBSET_COL_EFF
2276                  I         = SUBSET_COL( ISUB )
2277                  CALL MPI_PACK( VAL_SON( J, I ), 1,
2278     &            MPI_REAL,
2279     &            BUF_CB%CONTENT( IPOS ),
2280     &            SIZE_PACK, POSITION, COMM, IERR )
2281                END DO
2282              END DO
2283            END IF
2284          ENDIF
2285        END IF
2286        KEEP(266)=KEEP(266)+1
2287        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
2288     &                PDEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR )
2289        IF ( SIZE_PACK .LT. POSITION ) THEN
2290          WRITE(*,*) ' Error sending contribution to root:Size<positn'
2291          WRITE(*,*) ' Size,position=',SIZE_PACK,POSITION
2292          CALL MUMPS_ABORT()
2293        END IF
2294        IF ( SIZE_PACK .NE. POSITION )
2295     &  CALL BUF_ADJUST( BUF_CB, POSITION )
2296        N_ALREADY_SENT = N_ALREADY_SENT + N_PACKET
2297        IF (NSUBSET_ROW * NSUBSET_COL .NE. 0) THEN
2298          IF ( N_ALREADY_SENT.NE.NSUBSET_ROW_EFF ) IERR = -1
2299        ENDIF
2300  100   CONTINUE
2301        RETURN
2302        END SUBROUTINE SMUMPS_BUF_SEND_CONTRIB_TYPE3
2303        SUBROUTINE SMUMPS_BUF_SEND_RTNELIND( ISON, NELIM,
2304     &             NELIM_ROW, NELIM_COL, NSLAVES, SLAVES,
2305     &             DEST, COMM, KEEP, IERR )
2306        INTEGER ISON, NELIM
2307        INTEGER NSLAVES, DEST, COMM, IERR
2308        INTEGER NELIM_ROW( NELIM ), NELIM_COL( NELIM )
2309        INTEGER SLAVES( NSLAVES )
2310        INTEGER, INTENT(INOUT) :: KEEP(500)
2311        INCLUDE 'mpif.h'
2312        INCLUDE 'mumps_tags.h'
2313        INTEGER SIZE, POSITION, IPOS, IREQ
2314        INTEGER IONE
2315        INTEGER DEST2(1)
2316        PARAMETER ( IONE=1 )
2317        DEST2(1) = DEST
2318        IERR = 0
2319        SIZE = ( 3 + NSLAVES + 2 * NELIM ) * SIZEofINT
2320        IF (SIZE.GT.SIZE_RBUF_BYTES) THEN
2321             IERR = -3
2322             RETURN
2323        ENDIF
2324        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE, IERR,
2325     &                 IONE, DEST2
2326     &               )
2327        IF ( IERR .LT. 0 ) THEN
2328           RETURN
2329        ENDIF
2330        POSITION = IPOS
2331        BUF_CB%CONTENT( POSITION ) = ISON
2332        POSITION = POSITION + 1
2333        BUF_CB%CONTENT( POSITION ) = NELIM
2334        POSITION = POSITION + 1
2335        BUF_CB%CONTENT( POSITION ) = NSLAVES
2336        POSITION = POSITION + 1
2337        BUF_CB%CONTENT( POSITION: POSITION + NELIM - 1 ) = NELIM_ROW
2338        POSITION = POSITION + NELIM
2339        BUF_CB%CONTENT( POSITION: POSITION + NELIM - 1 ) = NELIM_COL
2340        POSITION = POSITION + NELIM
2341        BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = SLAVES
2342        POSITION = POSITION + NSLAVES
2343        POSITION = POSITION - IPOS
2344        IF ( POSITION * SIZEofINT .NE. SIZE ) THEN
2345          WRITE(*,*) 'Error in SMUMPS_BUF_SEND_ROOT_NELIM_INDICES:',
2346     &               'wrong estimated size'
2347           CALL MUMPS_ABORT()
2348        END IF
2349        KEEP(266)=KEEP(266)+1
2350        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE,
2351     &                  MPI_PACKED,
2352     &                  DEST, ROOT_NELIM_INDICES, COMM,
2353     &                  BUF_CB%CONTENT( IREQ ), IERR )
2354        RETURN
2355        END SUBROUTINE SMUMPS_BUF_SEND_RTNELIND
2356        SUBROUTINE SMUMPS_BUF_SEND_ROOT2SON( ISON, NELIM_ROOT,
2357     &             DEST, COMM, KEEP, IERR )
2358        IMPLICIT NONE
2359        INTEGER ISON, NELIM_ROOT, DEST, COMM, IERR
2360        INTEGER, INTENT(INOUT) :: KEEP(500)
2361        INCLUDE 'mpif.h'
2362        INCLUDE 'mumps_tags.h'
2363        INTEGER IPOS, IREQ, SIZE
2364        INTEGER IONE
2365        INTEGER DEST2(1)
2366        PARAMETER ( IONE=1 )
2367        DEST2(1)=DEST
2368        IERR = 0
2369        SIZE = 2 * SIZEofINT
2370        CALL BUF_LOOK( BUF_SMALL, IPOS, IREQ, SIZE, IERR,
2371     &                 IONE, DEST2
2372     &               )
2373        IF ( IERR .LT. 0 ) THEN
2374          WRITE(*,*) 'Internal error 1 with small buffers '
2375          CALL MUMPS_ABORT()
2376        END IF
2377        IF ( IERR .LT. 0 ) THEN
2378          RETURN
2379        ENDIF
2380        BUF_SMALL%CONTENT( IPOS )     = ISON
2381        BUF_SMALL%CONTENT( IPOS + 1 ) = NELIM_ROOT
2382        KEEP(266)=KEEP(266)+1
2383        CALL MPI_ISEND( BUF_SMALL%CONTENT( IPOS ), SIZE,
2384     &                  MPI_PACKED,
2385     &                  DEST, ROOT_2SON, COMM,
2386     &                  BUF_SMALL%CONTENT( IREQ ), IERR )
2387        RETURN
2388        END SUBROUTINE SMUMPS_BUF_SEND_ROOT2SON
2389        SUBROUTINE SMUMPS_BUF_SEND_ROOT2SLAVE
2390     &  ( TOT_ROOT_SIZE, TOT_CONT2RECV, DEST, COMM, KEEP, IERR )
2391        IMPLICIT NONE
2392        INTEGER TOT_ROOT_SIZE, TOT_CONT2RECV, DEST, COMM, IERR
2393        INTEGER, INTENT(INOUT) :: KEEP(500)
2394        INCLUDE 'mpif.h'
2395        INCLUDE 'mumps_tags.h'
2396        INTEGER SIZE, IPOS, IREQ
2397        INTEGER IONE
2398        INTEGER DEST2(1)
2399        PARAMETER ( IONE=1 )
2400        IERR = 0
2401        DEST2(1) = DEST
2402        SIZE = 2 * SIZEofINT
2403        CALL BUF_LOOK( BUF_SMALL, IPOS, IREQ, SIZE, IERR,
2404     &                 IONE, DEST2
2405     &               )
2406        IF ( IERR .LT. 0 ) THEN
2407          WRITE(*,*) 'Internal error 2 with small buffers '
2408           CALL MUMPS_ABORT()
2409        END IF
2410        IF ( IERR .LT. 0 ) THEN
2411           RETURN
2412        ENDIF
2413        BUF_SMALL%CONTENT( IPOS     ) = TOT_ROOT_SIZE
2414        BUF_SMALL%CONTENT( IPOS + 1 ) = TOT_CONT2RECV
2415        KEEP(266)=KEEP(266)+1
2416        CALL MPI_ISEND( BUF_SMALL%CONTENT( IPOS ), SIZE,
2417     &                  MPI_PACKED,
2418     &                  DEST, ROOT_2SLAVE, COMM,
2419     &                  BUF_SMALL%CONTENT( IREQ ), IERR )
2420        RETURN
2421        END SUBROUTINE SMUMPS_BUF_SEND_ROOT2SLAVE
2422        SUBROUTINE SMUMPS_BUF_SEND_BACKVEC
2423     &             ( NRHS, INODE, W, LW, LD_W, DEST, MSGTAG,
2424     &               JBDEB, JBFIN, KEEP, COMM, IERR )
2425        IMPLICIT NONE
2426        INTEGER NRHS, INODE,LW,COMM,IERR,DEST,MSGTAG, LD_W
2427        INTEGER, intent(in) :: JBDEB, JBFIN
2428        REAL :: W(LD_W, *)
2429        INTEGER, INTENT(INOUT) :: KEEP(500)
2430        INCLUDE 'mpif.h'
2431        INTEGER SIZE, SIZE1, SIZE2
2432        INTEGER POSITION, IREQ, IPOS
2433        INTEGER IONE, K
2434        INTEGER DEST2(1)
2435        PARAMETER ( IONE=1 )
2436        IERR = 0
2437        DEST2(1) = DEST
2438        CALL MPI_PACK_SIZE( 4 , MPI_INTEGER, COMM, SIZE1, IERR )
2439        CALL MPI_PACK_SIZE( LW*NRHS, MPI_REAL, COMM,
2440     &                      SIZE2, IERR )
2441        SIZE = SIZE1 + SIZE2
2442        CALL BUF_LOOK( BUF_CB, IPOS, IREQ, SIZE, IERR,
2443     &                 IONE, DEST2
2444     &               )
2445        IF ( IERR .LT. 0 ) THEN
2446           RETURN
2447        ENDIF
2448        POSITION = 0
2449        CALL MPI_PACK( INODE, 1, MPI_INTEGER,
2450     &                        BUF_CB%CONTENT( IPOS ), SIZE,
2451     &                        POSITION, COMM, IERR )
2452        CALL MPI_PACK( LW   , 1, MPI_INTEGER,
2453     &                        BUF_CB%CONTENT( IPOS ), SIZE,
2454     &                        POSITION, COMM, IERR )
2455        CALL MPI_PACK( JBDEB   , 1, MPI_INTEGER,
2456     &                        BUF_CB%CONTENT( IPOS ), SIZE,
2457     &                        POSITION, COMM, IERR )
2458        CALL MPI_PACK( JBFIN   , 1, MPI_INTEGER,
2459     &                        BUF_CB%CONTENT( IPOS ), SIZE,
2460     &                        POSITION, COMM, IERR )
2461        DO K=1, NRHS
2462        CALL MPI_PACK( W(1,K), LW, MPI_REAL,
2463     &                        BUF_CB%CONTENT( IPOS ), SIZE,
2464     &                        POSITION, COMM, IERR )
2465        END DO
2466        KEEP(266)=KEEP(266)+1
2467        CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED,
2468     &                  DEST, MSGTAG, COMM,
2469     &                  BUF_CB%CONTENT( IREQ ), IERR )
2470        IF ( SIZE .LT. POSITION ) THEN
2471          WRITE(*,*) 'Try_update: SIZE, POSITION = ',
2472     &               SIZE, POSITION
2473          CALL MUMPS_ABORT()
2474        END IF
2475        IF ( SIZE .NE. POSITION ) CALL BUF_ADJUST( BUF_CB, POSITION )
2476        RETURN
2477        END SUBROUTINE SMUMPS_BUF_SEND_BACKVEC
2478        SUBROUTINE SMUMPS_BUF_SEND_UPDATE_LOAD
2479     &             ( BDC_SBTR,BDC_MEM,BDC_MD, COMM, NPROCS, LOAD,
2480     &               MEM,SBTR_CUR,
2481     &               LU_USAGE,
2482#if ! defined(OLD_LOAD_MECHANISM)
2483     &               FUTURE_NIV2,
2484#endif
2485     &               MYID, KEEP, IERR)
2486        IMPLICIT NONE
2487        INTEGER COMM, NPROCS, MYID, IERR
2488        INTEGER, INTENT(INOUT) :: KEEP(500)
2489#if ! defined(OLD_LOAD_MECHANISM)
2490        INTEGER FUTURE_NIV2(NPROCS)
2491#endif
2492        DOUBLE PRECISION LU_USAGE
2493        DOUBLE PRECISION LOAD
2494        DOUBLE PRECISION MEM,SBTR_CUR
2495        LOGICAL BDC_MEM,BDC_SBTR,BDC_MD
2496        INCLUDE 'mpif.h'
2497        INCLUDE 'mumps_tags.h'
2498        INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE
2499        INTEGER I, NDEST, IDEST, IPOSMSG, WHAT, NREALS
2500        INTEGER IZERO
2501        INTEGER MYID2(1)
2502        PARAMETER ( IZERO=0 )
2503        IERR = 0
2504        MYID2(1) = MYID
2505        NDEST = NPROCS - 1
2506#if ! defined(OLD_LOAD_MECHANISM)
2507        NDEST = 0
2508        DO I = 1, NPROCS
2509          IF ( I .NE. MYID + 1 .AND. FUTURE_NIV2(I).NE.0) THEN
2510            NDEST = NDEST + 1
2511          ENDIF
2512        ENDDO
2513#endif
2514        IF ( NDEST .eq. 0 ) THEN
2515           RETURN
2516        ENDIF
2517        CALL MPI_PACK_SIZE( 1 + (NDEST-1) * OVHSIZE,
2518     &                       MPI_INTEGER, COMM,
2519     &                       SIZE1, IERR )
2520        NREALS = 1
2521        IF (BDC_MEM) THEN
2522          NREALS = 2
2523        ENDIf
2524        IF (BDC_SBTR)THEN
2525          NREALS = 3
2526        ENDIF
2527        IF(BDC_MD)THEN
2528           NREALS=NREALS+1
2529        ENDIF
2530        CALL MPI_PACK_SIZE( NREALS, MPI_DOUBLE_PRECISION,
2531     &                      COMM, SIZE2, IERR )
2532        SIZE = SIZE1 + SIZE2
2533        CALL BUF_LOOK( BUF_LOAD, IPOS, IREQ, SIZE, IERR,
2534     &                  IZERO, MYID2
2535     &               )
2536        IF ( IERR .LT. 0 ) THEN
2537           RETURN
2538        ENDIF
2539        BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE
2540        IPOS = IPOS - OVHSIZE
2541        DO IDEST = 1, NDEST - 1
2542          BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
2543     &    IPOS + IDEST * OVHSIZE
2544        END DO
2545        BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0
2546        IPOSMSG = IPOS + OVHSIZE * NDEST
2547        WHAT = 0
2548        POSITION = 0
2549        CALL MPI_PACK( WHAT, 1, MPI_INTEGER,
2550     &                 BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2551     &                 POSITION, COMM, IERR )
2552        CALL MPI_PACK( LOAD, 1, MPI_DOUBLE_PRECISION,
2553     &                 BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2554     &                 POSITION, COMM, IERR )
2555        IF (BDC_MEM) THEN
2556          CALL MPI_PACK( MEM, 1, MPI_DOUBLE_PRECISION,
2557     &                   BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2558     &                   POSITION, COMM, IERR )
2559        END IF
2560        IF (BDC_SBTR) THEN
2561          CALL MPI_PACK( SBTR_CUR, 1, MPI_DOUBLE_PRECISION,
2562     &                   BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2563     &                   POSITION, COMM, IERR )
2564        END IF
2565        IF(BDC_MD)THEN
2566           CALL MPI_PACK( LU_USAGE, 1, MPI_DOUBLE_PRECISION,
2567     &          BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2568     &          POSITION, COMM, IERR )
2569        ENDIF
2570        IDEST = 0
2571        DO I = 0, NPROCS - 1
2572#if ! defined(OLD_LOAD_MECHANISM)
2573        IF ( I .NE. MYID .AND. FUTURE_NIV2(I+1) .NE. 0) THEN
2574#else
2575        IF ( I .ne. MYID ) THEN
2576#endif
2577            IDEST = IDEST + 1
2578            KEEP(267)=KEEP(267)+1
2579            CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ),
2580     &                      POSITION, MPI_PACKED, I,
2581     &                      UPDATE_LOAD, COMM,
2582     &                      BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ),
2583     &                      IERR )
2584          END IF
2585        END DO
2586        SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT
2587        IF ( SIZE .LT. POSITION ) THEN
2588          WRITE(*,*) ' Error in SMUMPS_BUF_SEND_UPDATE_LOAD'
2589          WRITE(*,*) ' Size,position=',SIZE,POSITION
2590          CALL MUMPS_ABORT()
2591        END IF
2592        IF ( SIZE .NE. POSITION )
2593     &  CALL BUF_ADJUST( BUF_LOAD, POSITION )
2594        RETURN
2595        END SUBROUTINE SMUMPS_BUF_SEND_UPDATE_LOAD
2596        SUBROUTINE SMUMPS_BUF_BROADCAST
2597     &             ( WHAT, COMM, NPROCS,
2598#if ! defined(OLD_LOAD_MECHANISM)
2599     &               FUTURE_NIV2,
2600#endif
2601     &               LOAD, UPD_LOAD,
2602     &               MYID, KEEP, IERR)
2603        IMPLICIT NONE
2604        INTEGER COMM, NPROCS, MYID, IERR, WHAT
2605        DOUBLE PRECISION LOAD,UPD_LOAD
2606        INTEGER, INTENT(INOUT) :: KEEP(500)
2607        INCLUDE 'mpif.h'
2608        INCLUDE 'mumps_tags.h'
2609        INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE
2610        INTEGER I, NDEST, IDEST, IPOSMSG, NREALS
2611        INTEGER IZERO
2612        INTEGER MYID2(1)
2613#if ! defined(OLD_LOAD_MECHANISM)
2614        INTEGER FUTURE_NIV2(NPROCS)
2615#endif
2616        PARAMETER ( IZERO=0 )
2617        IERR = 0
2618        IF (WHAT .NE. 2 .AND. WHAT .NE. 3 .AND.
2619     &       WHAT.NE.6.AND. WHAT.NE.8 .AND.WHAT.NE.9.AND.
2620     &       WHAT.NE.17) THEN
2621          WRITE(*,*)
2622     &  "Internal error 1 in SMUMPS_BUF_BROADCAST",WHAT
2623        END IF
2624        MYID2(1) = MYID
2625        NDEST = NPROCS - 1
2626#if ! defined(OLD_LOAD_MECHANISM)
2627        NDEST = 0
2628        DO I = 1, NPROCS
2629          IF ( I .NE. MYID + 1 .AND. FUTURE_NIV2(I).NE.0) THEN
2630            NDEST = NDEST + 1
2631          ENDIF
2632        ENDDO
2633#endif
2634        IF ( NDEST .eq. 0 ) THEN
2635           RETURN
2636        ENDIF
2637        CALL MPI_PACK_SIZE( 1 + (NDEST-1) * OVHSIZE,
2638     &                       MPI_INTEGER, COMM,
2639     &                       SIZE1, IERR )
2640        IF((WHAT.NE.17).AND.(WHAT.NE.10))THEN
2641           NREALS = 1
2642        ELSE
2643           NREALS = 2
2644        ENDIF
2645        CALL MPI_PACK_SIZE( NREALS, MPI_DOUBLE_PRECISION,
2646     &                      COMM, SIZE2, IERR )
2647        SIZE = SIZE1 + SIZE2
2648        CALL BUF_LOOK( BUF_LOAD, IPOS, IREQ, SIZE, IERR,
2649     &                  IZERO, MYID2
2650     &               )
2651        IF ( IERR .LT. 0 ) THEN
2652           RETURN
2653        ENDIF
2654        BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE
2655        IPOS = IPOS - OVHSIZE
2656        DO IDEST = 1, NDEST - 1
2657          BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
2658     &    IPOS + IDEST * OVHSIZE
2659        END DO
2660        BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0
2661        IPOSMSG = IPOS + OVHSIZE * NDEST
2662        POSITION = 0
2663        CALL MPI_PACK( WHAT, 1, MPI_INTEGER,
2664     &                 BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2665     &                 POSITION, COMM, IERR )
2666        CALL MPI_PACK( LOAD, 1, MPI_DOUBLE_PRECISION,
2667     &                 BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2668     &                 POSITION, COMM, IERR )
2669        IF((WHAT.EQ.17).OR.(WHAT.EQ.10))THEN
2670           CALL MPI_PACK( UPD_LOAD, 1, MPI_DOUBLE_PRECISION,
2671     &          BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2672     &          POSITION, COMM, IERR )
2673        ENDIF
2674        IDEST = 0
2675        DO I = 0, NPROCS - 1
2676#if ! defined(OLD_LOAD_MECHANISM)
2677          IF ( I .NE. MYID .AND. FUTURE_NIV2(I+1) .NE. 0) THEN
2678#else
2679          IF ( I .ne. MYID ) THEN
2680#endif
2681            IDEST = IDEST + 1
2682            KEEP(267)=KEEP(267)+1
2683            CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ),
2684     &                      POSITION, MPI_PACKED, I,
2685     &                      UPDATE_LOAD, COMM,
2686     &                      BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ),
2687     &                      IERR )
2688          END IF
2689        END DO
2690        SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT
2691        IF ( SIZE .LT. POSITION ) THEN
2692          WRITE(*,*) ' Error in SMUMPS_BUF_BROADCAST'
2693          WRITE(*,*) ' Size,position=',SIZE,POSITION
2694          CALL MUMPS_ABORT()
2695        END IF
2696        IF ( SIZE .NE. POSITION )
2697     &  CALL BUF_ADJUST( BUF_LOAD, POSITION )
2698        RETURN
2699        END SUBROUTINE SMUMPS_BUF_BROADCAST
2700        SUBROUTINE SMUMPS_BUF_SEND_FILS
2701     &             ( WHAT, COMM, NPROCS,
2702     &               FATHER_NODE,INODE,NCB,KEEP,
2703     &               MYID,REMOTE, IERR)
2704        IMPLICIT NONE
2705        INTEGER COMM, NPROCS, MYID, IERR, WHAT,REMOTE
2706        INTEGER FATHER_NODE,INODE
2707        INCLUDE 'mpif.h'
2708        INCLUDE 'mumps_tags.h'
2709        INTEGER POSITION, IREQ, IPOS, SIZE
2710        INTEGER NDEST, IDEST, IPOSMSG
2711        INTEGER IZERO,NCB,KEEP(500)
2712        INTEGER MYID2(1)
2713        PARAMETER ( IZERO=0 )
2714        MYID2(1) = MYID
2715        NDEST = 1
2716        IF ( NDEST .eq. 0 ) THEN
2717           RETURN
2718        ENDIF
2719        IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN
2720           CALL MPI_PACK_SIZE( 4 + OVHSIZE,
2721     &          MPI_INTEGER, COMM,
2722     &          SIZE, IERR )
2723        ELSE
2724           CALL MPI_PACK_SIZE( 2 + OVHSIZE,
2725     &          MPI_INTEGER, COMM,
2726     &          SIZE, IERR )
2727        ENDIF
2728        CALL BUF_LOOK( BUF_LOAD, IPOS, IREQ, SIZE, IERR,
2729     &                  IZERO, MYID2
2730     &               )
2731        IF ( IERR .LT. 0 ) THEN
2732           RETURN
2733        ENDIF
2734        BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE
2735        IPOS = IPOS - OVHSIZE
2736        DO IDEST = 1, NDEST - 1
2737          BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
2738     &    IPOS + IDEST * OVHSIZE
2739        END DO
2740        BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0
2741        IPOSMSG = IPOS + OVHSIZE * NDEST
2742        POSITION = 0
2743        CALL MPI_PACK( WHAT, 1, MPI_INTEGER,
2744     &                 BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2745     &                 POSITION, COMM, IERR )
2746        CALL MPI_PACK( FATHER_NODE, 1, MPI_INTEGER,
2747     &                 BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2748     &                 POSITION, COMM, IERR )
2749        IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN
2750           CALL MPI_PACK( INODE, 1, MPI_INTEGER,
2751     &          BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2752     &          POSITION, COMM, IERR )
2753           CALL MPI_PACK( NCB, 1, MPI_INTEGER,
2754     &          BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2755     &          POSITION, COMM, IERR )
2756        ENDIF
2757        IDEST = 1
2758        KEEP(267)=KEEP(267)+1
2759        CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ),
2760     &                 POSITION, MPI_PACKED, REMOTE,
2761     &                 UPDATE_LOAD, COMM,
2762     &                 BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ),
2763     &                 IERR )
2764        SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT
2765        IF ( SIZE .LT. POSITION ) THEN
2766          WRITE(*,*) ' Error in SMUMPS_BUF_SEND_FILS'
2767          WRITE(*,*) ' Size,position=',SIZE,POSITION
2768          CALL MUMPS_ABORT()
2769        END IF
2770        IF ( SIZE .NE. POSITION )
2771     &  CALL BUF_ADJUST( BUF_LOAD, POSITION )
2772        RETURN
2773        END SUBROUTINE SMUMPS_BUF_SEND_FILS
2774        SUBROUTINE SMUMPS_BUF_SEND_NOT_MSTR( COMM, MYID, NPROCS,
2775     &  MAX_SURF_MASTER,KEEP,IERR)
2776        IMPLICIT NONE
2777        INCLUDE 'mpif.h'
2778        INCLUDE 'mumps_tags.h'
2779        INTEGER IPOS, IREQ, IDEST, IPOSMSG, POSITION, I
2780        INTEGER COMM, MYID, IERR, NPROCS
2781        DOUBLE PRECISION MAX_SURF_MASTER
2782        INTEGER, INTENT(INOUT) :: KEEP(500)
2783        INTEGER IZERO
2784        INTEGER MYID2(1)
2785        PARAMETER ( IZERO=0 )
2786        INTEGER NDEST, NINTS, NREALS, SIZE, SIZE1, SIZE2
2787        INTEGER WHAT
2788        IERR = 0
2789        MYID2(1) = MYID
2790        NDEST = NPROCS - 1
2791        NINTS = 1 + ( NDEST-1 ) * OVHSIZE
2792        NREALS = 1
2793        CALL MPI_PACK_SIZE( NINTS,
2794     &                       MPI_INTEGER, COMM,
2795     &                       SIZE1, IERR )
2796        CALL MPI_PACK_SIZE( NREALS,
2797     &                       MPI_DOUBLE_PRECISION, COMM,
2798     &                       SIZE2, IERR )
2799        SIZE=SIZE1+SIZE2
2800        CALL BUF_LOOK( BUF_LOAD, IPOS, IREQ, SIZE, IERR,
2801     &       IZERO, MYID2 )
2802        IF ( IERR .LT. 0 ) THEN
2803           RETURN
2804        ENDIF
2805        BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE
2806        IPOS = IPOS - OVHSIZE
2807        DO IDEST = 1, NDEST - 1
2808          BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
2809     &    IPOS + IDEST * OVHSIZE
2810        END DO
2811        BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0
2812        IPOSMSG = IPOS + OVHSIZE * NDEST
2813        POSITION = 0
2814        WHAT = 4
2815        CALL MPI_PACK( WHAT, 1, MPI_INTEGER,
2816     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2817     &      POSITION, COMM, IERR )
2818        CALL MPI_PACK( MAX_SURF_MASTER, 1, MPI_DOUBLE_PRECISION,
2819     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2820     &      POSITION, COMM, IERR )
2821        IDEST = 0
2822        DO I = 0, NPROCS - 1
2823           IF ( I .ne. MYID ) THEN
2824              IDEST = IDEST + 1
2825              KEEP(267)=KEEP(267)+1
2826              CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ),
2827     &             POSITION, MPI_PACKED, I,
2828     &             UPDATE_LOAD, COMM,
2829     &             BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ),
2830     &             IERR )
2831           END IF
2832        END DO
2833        SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT
2834        IF ( SIZE .LT. POSITION ) THEN
2835          WRITE(*,*) ' Error in SMUMPS_BUF_BCAST_ARRAY'
2836          WRITE(*,*) ' Size,position=',SIZE,POSITION
2837          CALL MUMPS_ABORT()
2838        END IF
2839        IF ( SIZE .NE. POSITION )
2840     &  CALL BUF_ADJUST( BUF_LOAD, POSITION )
2841        RETURN
2842        END SUBROUTINE SMUMPS_BUF_SEND_NOT_MSTR
2843        SUBROUTINE SMUMPS_BUF_BCAST_ARRAY( BDC_MEM,
2844     &      COMM, MYID, NPROCS,
2845#if ! defined(OLD_LOAD_MECHANISM)
2846     &      FUTURE_NIV2,
2847#endif
2848     &      NSLAVES,
2849     &      LIST_SLAVES,INODE,
2850     &      MEM_INCREMENT, FLOPS_INCREMENT,CB_BAND, WHAT,
2851     &      KEEP,
2852     &      IERR )
2853        IMPLICIT NONE
2854        INCLUDE 'mpif.h'
2855        INCLUDE 'mumps_tags.h'
2856        LOGICAL BDC_MEM
2857        INTEGER COMM, MYID, NPROCS, NSLAVES, IERR
2858#if ! defined(OLD_LOAD_MECHANISM)
2859        INTEGER FUTURE_NIV2(NPROCS)
2860#endif
2861        INTEGER LIST_SLAVES(NSLAVES),INODE
2862        DOUBLE PRECISION MEM_INCREMENT(NSLAVES)
2863        DOUBLE PRECISION FLOPS_INCREMENT(NSLAVES)
2864        DOUBLE PRECISION CB_BAND(NSLAVES)
2865        INTEGER, INTENT(INOUT) :: KEEP(500)
2866        INTEGER NDEST, NINTS, NREALS, SIZE1, SIZE2, SIZE
2867        INTEGER IPOS, IPOSMSG, IREQ, POSITION
2868        INTEGER I, IDEST, WHAT
2869        INTEGER IZERO
2870        INTEGER MYID2(1)
2871        PARAMETER ( IZERO=0 )
2872        MYID2(1)=MYID
2873        IERR = 0
2874#if ! defined(OLD_LOAD_MECHANISM)
2875        NDEST = 0
2876        DO I = 1, NPROCS
2877          IF ( I .NE. MYID + 1 .AND. FUTURE_NIV2(I).NE.0) THEN
2878            NDEST = NDEST + 1
2879          ENDIF
2880        ENDDO
2881#else
2882        NDEST = NPROCS - 1
2883#endif
2884        IF ( NDEST == 0 ) THEN
2885           RETURN
2886        ENDIF
2887        NINTS = 2 +  NSLAVES + ( NDEST - 1 ) * OVHSIZE + 1
2888        NREALS = NSLAVES
2889        IF (BDC_MEM) NREALS = NREALS + NSLAVES
2890        IF(WHAT.EQ.19) THEN
2891           NREALS = NREALS + NSLAVES
2892        ENDIF
2893        CALL MPI_PACK_SIZE( NINTS,
2894     &                       MPI_INTEGER, COMM,
2895     &                       SIZE1, IERR )
2896        CALL MPI_PACK_SIZE( NREALS, MPI_DOUBLE_PRECISION,
2897     &       COMM, SIZE2, IERR )
2898        SIZE = SIZE1+SIZE2
2899        CALL BUF_LOOK( BUF_LOAD, IPOS, IREQ, SIZE, IERR,
2900     &       IZERO, MYID2 )
2901        IF ( IERR .LT. 0 ) THEN
2902           RETURN
2903        ENDIF
2904        BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE
2905        IPOS = IPOS - OVHSIZE
2906        DO IDEST = 1, NDEST - 1
2907          BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) =
2908     &    IPOS + IDEST * OVHSIZE
2909        END DO
2910        BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0
2911        IPOSMSG = IPOS + OVHSIZE * NDEST
2912        POSITION = 0
2913        CALL MPI_PACK( WHAT, 1, MPI_INTEGER,
2914     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2915     &      POSITION, COMM, IERR )
2916        CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER,
2917     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2918     &      POSITION, COMM, IERR )
2919        CALL MPI_PACK( INODE, 1, MPI_INTEGER,
2920     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2921     &      POSITION, COMM, IERR )
2922        CALL MPI_PACK( LIST_SLAVES, NSLAVES, MPI_INTEGER,
2923     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2924     &      POSITION, COMM, IERR )
2925        CALL MPI_PACK( FLOPS_INCREMENT, NSLAVES,
2926     &      MPI_DOUBLE_PRECISION,
2927     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2928     &      POSITION, COMM, IERR )
2929        IF (BDC_MEM) THEN
2930          CALL MPI_PACK( MEM_INCREMENT, NSLAVES,
2931     &      MPI_DOUBLE_PRECISION,
2932     &      BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2933     &      POSITION, COMM, IERR )
2934        END IF
2935        IF(WHAT.EQ.19)THEN
2936           CALL MPI_PACK( CB_BAND, NSLAVES,
2937     &          MPI_DOUBLE_PRECISION,
2938     &          BUF_LOAD%CONTENT( IPOSMSG ), SIZE,
2939     &          POSITION, COMM, IERR )
2940        ENDIF
2941        IDEST = 0
2942        DO I = 0, NPROCS - 1
2943#if ! defined(OLD_LOAD_MECHANISM)
2944        IF ( I .NE. MYID .AND. FUTURE_NIV2(I+1) .NE. 0) THEN
2945#else
2946        IF ( I .NE. MYID ) THEN
2947#endif
2948            IDEST = IDEST + 1
2949            KEEP(267)=KEEP(267)+1
2950            CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ),
2951     &                      POSITION, MPI_PACKED, I,
2952     &                      UPDATE_LOAD, COMM,
2953     &                      BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ),
2954     &                      IERR )
2955          END IF
2956        END DO
2957        SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT
2958        IF ( SIZE .LT. POSITION ) THEN
2959          WRITE(*,*) ' Error in SMUMPS_BUF_BCAST_ARRAY'
2960          WRITE(*,*) ' Size,position=',SIZE,POSITION
2961          CALL MUMPS_ABORT()
2962        END IF
2963        IF ( SIZE .NE. POSITION )
2964     &  CALL BUF_ADJUST( BUF_LOAD, POSITION )
2965        RETURN
2966        END SUBROUTINE SMUMPS_BUF_BCAST_ARRAY
2967        SUBROUTINE SMUMPS_BUF_DIST_IRECV_SIZE
2968     &             ( SMUMPS_LBUFR_BYTES)
2969        IMPLICIT NONE
2970        INTEGER SMUMPS_LBUFR_BYTES
2971        SIZE_RBUF_BYTES = SMUMPS_LBUFR_BYTES
2972        RETURN
2973      END SUBROUTINE SMUMPS_BUF_DIST_IRECV_SIZE
2974      SUBROUTINE MUMPS_MPI_PACK_SIZE_LR( BLR_LorU, SIZE_OUT, COMM, IERR)
2975      USE SMUMPS_LR_TYPE
2976      INTEGER, intent(out) :: SIZE_OUT, IERR
2977      INTEGER, intent(in)  :: COMM
2978      TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR_LorU
2979      INTEGER :: I, SIZE_LOC
2980      INCLUDE 'mpif.h'
2981      IERR = 0
2982      SIZE_OUT = 0
2983      CALL MPI_PACK_SIZE( 1,
2984     &              MPI_INTEGER, COMM, SIZE_LOC,  IERR )
2985      SIZE_OUT = SIZE_OUT + SIZE_LOC
2986      DO I = 1, size(BLR_LorU)
2987          CALL MPI_PACK_SIZE( 6,
2988     &              MPI_INTEGER, COMM, SIZE_LOC,  IERR )
2989          SIZE_OUT = SIZE_OUT + SIZE_LOC
2990          IF ( BLR_LorU(I)%ISLR ) THEN
2991            IF ( BLR_LorU(I)%LRFORM.NE.1) THEN
2992              CALL MUMPS_ABORT()
2993            ENDIF
2994            IF (BLR_LorU(I)%K .GT. 0) THEN
2995              CALL MPI_PACK_SIZE( BLR_LorU(I)%M * BLR_LorU(I)%K,
2996     &           MPI_REAL, COMM, SIZE_LOC,  IERR )
2997              SIZE_OUT = SIZE_OUT + SIZE_LOC
2998              CALL MPI_PACK_SIZE( BLR_LorU(I)%K * BLR_LorU(I)%N,
2999     &           MPI_REAL, COMM, SIZE_LOC,  IERR )
3000              SIZE_OUT = SIZE_OUT + SIZE_LOC
3001            ENDIF
3002          ELSE
3003            CALL MPI_PACK_SIZE( BLR_LorU(I)%M * BLR_LorU(I)%N,
3004     &           MPI_REAL, COMM, SIZE_LOC,  IERR )
3005            SIZE_OUT = SIZE_OUT + SIZE_LOC
3006         ENDIF
3007      ENDDO
3008      RETURN
3009      END SUBROUTINE MUMPS_MPI_PACK_SIZE_LR
3010      SUBROUTINE MUMPS_MPI_PACK_LR( BLR_LorU, BUF, LBUF, POSITION,
3011     &                              COMM, IERR)
3012      USE SMUMPS_LR_TYPE
3013      INTEGER, intent(out) :: IERR
3014      INTEGER, intent(in)  :: COMM, LBUF
3015      INTEGER, intent(inout) :: POSITION
3016      INTEGER, intent(inout) :: BUF(:)
3017      TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR_LorU
3018      INTEGER I, ISLR_INT
3019      INCLUDE 'mpif.h'
3020      IERR = 0
3021      CALL MPI_PACK( size(BLR_LorU), 1, MPI_INTEGER,
3022     &       BUF(1), LBUF, POSITION, COMM, IERR )
3023      DO I = 1, size(BLR_LorU)
3024        IF (BLR_LorU(I)%ISLR) THEN
3025          ISLR_INT = 1
3026        ELSE
3027          ISLR_INT = 0
3028        ENDIF
3029        CALL MPI_PACK( ISLR_INT, 1, MPI_INTEGER,
3030     &       BUF(1), LBUF, POSITION, COMM, IERR )
3031        CALL MPI_PACK( BLR_LorU(I)%LRFORM,
3032     &       1, MPI_INTEGER,
3033     &       BUF(1), LBUF, POSITION, COMM, IERR )
3034        CALL MPI_PACK( BLR_LorU(I)%K,
3035     &       1, MPI_INTEGER,
3036     &       BUF(1), LBUF, POSITION, COMM, IERR )
3037        CALL MPI_PACK( BLR_LorU(I)%M,
3038     &       1, MPI_INTEGER,
3039     &       BUF(1), LBUF, POSITION, COMM, IERR )
3040        CALL MPI_PACK( BLR_LorU(I)%N,
3041     &       1, MPI_INTEGER,
3042     &       BUF(1), LBUF, POSITION, COMM, IERR )
3043        CALL MPI_PACK( BLR_LorU(I)%KSVD,
3044     &       1, MPI_INTEGER,
3045     &       BUF(1), LBUF, POSITION, COMM, IERR )
3046        IF (BLR_LorU(I)%ISLR) THEN
3047          IF (BLR_LorU(I)%K .GT. 0) THEN
3048            CALL MPI_PACK( BLR_LorU(I)%Q(1,1),
3049     &        BLR_LorU(I)%M*BLR_LorU(I)%K,
3050     &        MPI_REAL, BUF(1), LBUF, POSITION, COMM, IERR )
3051            CALL MPI_PACK( BLR_LorU(I)%R(1,1),
3052     &        BLR_LorU(I)%N*BLR_LorU(I)%K, MPI_REAL,
3053     &        BUF(1), LBUF, POSITION, COMM, IERR )
3054          ENDIF
3055        ELSE
3056          CALL MPI_PACK( BLR_LorU(I)%Q(1,1), BLR_LorU(I)%M*BLR_LorU(I)%N
3057     &       ,MPI_REAL,
3058     &       BUF(1), LBUF, POSITION, COMM, IERR )
3059        ENDIF
3060      ENDDO
3061      RETURN
3062      END SUBROUTINE MUMPS_MPI_PACK_LR
3063      SUBROUTINE MUMPS_MPI_PACK_SCALE_LR
3064     &                  ( BLR, BUF, LBUF, POSITION,
3065     &                    COMM,
3066     &                    A , LA, POSELTD, LD_DIAG,
3067     &                    IPIV, NPIV, MAXI_CLUSTER,
3068     &                    IERR)
3069      USE SMUMPS_LR_TYPE
3070      INTEGER, intent(out) :: IERR
3071      INTEGER, intent(in)  :: COMM, LBUF
3072      INTEGER, intent(inout) :: POSITION
3073      INTEGER, intent(inout) :: BUF(:)
3074      TYPE  (LRB_TYPE), DIMENSION(:), intent(in) :: BLR
3075      INTEGER(8), intent(in)  :: LA, POSELTD
3076      INTEGER, intent(in)     :: LD_DIAG, NPIV
3077      INTEGER, intent(in)     :: IPIV(NPIV), MAXI_CLUSTER
3078      REAL, intent(inout)  :: A(LA)
3079      INTEGER I, ISLR_INT, J, ALLOCOK
3080      REAL, ALLOCATABLE,DIMENSION(:,:) ::  SCALED
3081      REAL, ALLOCATABLE,DIMENSION(:) ::  BLOCK
3082      REAL :: PIV1, PIV2, OFFDIAG
3083      INCLUDE 'mpif.h'
3084      IERR = 0
3085      CALL MPI_PACK( size(BLR), 1, MPI_INTEGER,
3086     &       BUF(1), LBUF, POSITION, COMM, IERR )
3087      allocate(BLOCK(MAXI_CLUSTER), STAT=ALLOCOK )
3088      IF ( ALLOCOK .GT. 0 ) THEN
3089             WRITE(*,*) 'pb allocation in mumps_mpi_pack_scale_lr'
3090             IERR = -1
3091             GOTO 500
3092      END IF
3093      allocate(SCALED(MAXI_CLUSTER,2), STAT=ALLOCOK )
3094      IF ( ALLOCOK .GT. 0 ) THEN
3095             WRITE(*,*) 'pb allocation in mumps_mpi_pack_scale_lr'
3096             IERR = -1
3097             GOTO 500
3098      END IF
3099      DO I = 1, size(BLR)
3100        IF (BLR(I)%ISLR) THEN
3101          ISLR_INT = 1
3102        ELSE
3103          ISLR_INT = 0
3104        ENDIF
3105        CALL MPI_PACK( ISLR_INT, 1, MPI_INTEGER,
3106     &       BUF(1), LBUF, POSITION, COMM, IERR )
3107        CALL MPI_PACK( BLR(I)%LRFORM,
3108     &       1, MPI_INTEGER,
3109     &       BUF(1), LBUF, POSITION, COMM, IERR )
3110        CALL MPI_PACK( BLR(I)%K,
3111     &       1, MPI_INTEGER,
3112     &       BUF(1), LBUF, POSITION, COMM, IERR )
3113        CALL MPI_PACK( BLR(I)%M,
3114     &       1, MPI_INTEGER,
3115     &       BUF(1), LBUF, POSITION, COMM, IERR )
3116        CALL MPI_PACK( BLR(I)%N,
3117     &       1, MPI_INTEGER,
3118     &       BUF(1), LBUF, POSITION, COMM, IERR )
3119        CALL MPI_PACK( BLR(I)%KSVD,
3120     &       1, MPI_INTEGER,
3121     &       BUF(1), LBUF, POSITION, COMM, IERR )
3122        IF (BLR(I)%ISLR) THEN
3123          IF (BLR(I)%K .GT. 0) THEN
3124            CALL MPI_PACK( BLR(I)%Q(1,1), BLR(I)%M*BLR(I)%K,
3125     &       MPI_REAL,
3126     &       BUF(1), LBUF, POSITION, COMM, IERR )
3127            J =1
3128          DO WHILE (J <= BLR(I)%N)
3129              IF (IPIV(J) > 0) THEN
3130                SCALED(1:BLR(I)%K,1) = A(POSELTD+LD_DIAG*(J-1)+J-1)
3131     &            * BLR(I)%R(1:BLR(I)%K,J)
3132                J = J+1
3133              CALL MPI_PACK( SCALED(1,1), BLR(I)%K,
3134     &           MPI_REAL,
3135     &           BUF(1), LBUF, POSITION, COMM, IERR )
3136              ELSE
3137                PIV1    = A(POSELTD+LD_DIAG*(J-1)+J-1)
3138                PIV2    = A(POSELTD+LD_DIAG*J+J)
3139                OFFDIAG = A(POSELTD+LD_DIAG*(J-1)+J)
3140                BLOCK(1:BLR(I)%K)    = BLR(I)%R(1:BLR(I)%K,J)
3141                SCALED(1:BLR(I)%K,1) = PIV1 * BLR(I)%R(1:BLR(I)%K,J)
3142     &            + OFFDIAG * BLR(I)%R(1:BLR(I)%K,J+1)
3143                CALL MPI_PACK( SCALED(1,1), BLR(I)%K,
3144     &           MPI_REAL,
3145     &           BUF(1), LBUF, POSITION, COMM, IERR )
3146                SCALED(1:BLR(I)%K,2) = OFFDIAG * BLOCK(1:BLR(I)%K)
3147     &            + PIV2 * BLR(I)%R(1:BLR(I)%K,J+1)
3148                 J =J+2
3149                CALL MPI_PACK( SCALED(1,2), BLR(I)%K,
3150     &           MPI_REAL,
3151     &           BUF(1), LBUF, POSITION, COMM, IERR )
3152              ENDIF
3153          END DO
3154        ENDIF
3155        ELSE
3156          J = 1
3157          DO WHILE (J <= BLR(I)%N)
3158              IF (IPIV(J) > 0) THEN
3159                SCALED(1:BLR(I)%M,1) = A(POSELTD+LD_DIAG*(J-1)+J-1)
3160     &           * BLR(I)%Q(1:BLR(I)%M,J)
3161                CALL MPI_PACK( SCALED(1,1), BLR(I)%M,
3162     &           MPI_REAL,
3163     &           BUF(1), LBUF, POSITION, COMM, IERR )
3164                J = J+1
3165              ELSE
3166                PIV1    = A(POSELTD+LD_DIAG*(J-1)+J-1)
3167                PIV2    = A(POSELTD+LD_DIAG*J+J)
3168                OFFDIAG = A(POSELTD+LD_DIAG*(J-1)+J)
3169                BLOCK(1:BLR(I)%M)    = BLR(I)%Q(1:BLR(I)%M,J)
3170                SCALED(1:BLR(I)%M,1) = PIV1 * BLR(I)%Q(1:BLR(I)%M,J)
3171     &            + OFFDIAG * BLR(I)%Q(1:BLR(I)%M,J+1)
3172                CALL MPI_PACK( SCALED(1,1), BLR(I)%M,
3173     &           MPI_REAL,
3174     &           BUF(1), LBUF, POSITION, COMM, IERR )
3175                SCALED(1:BLR(I)%M,2) = OFFDIAG * BLOCK(1:BLR(I)%M)
3176     &            + PIV2 * BLR(I)%Q(1:BLR(I)%M,J+1)
3177                CALL MPI_PACK( SCALED(1,2), BLR(I)%M,
3178     &           MPI_REAL,
3179     &           BUF(1), LBUF, POSITION, COMM, IERR )
3180                 J=J+2
3181              ENDIF
3182          END DO
3183        ENDIF
3184      ENDDO
3185 500  CONTINUE
3186      IF (allocated(BLOCK)) deallocate(BLOCK)
3187      IF (allocated(SCALED)) deallocate(SCALED)
3188      RETURN
3189      END SUBROUTINE MUMPS_MPI_PACK_SCALE_LR
3190      END MODULE SMUMPS_BUF
3191