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      SUBROUTINE ZMUMPS_CREATEPARTVEC(MYID, NUMPROCS, COMM,
14     & IRN_loc, JCN_loc, NZ_loc,
15     & IPARTVEC, ISZ, OSZ,
16     & IWRK, IWSZ)
17C
18      IMPLICIT NONE
19      EXTERNAL ZMUMPS_BUREDUCE
20      INTEGER, INTENT(IN)    :: MYID, NUMPROCS, COMM
21      INTEGER(8), INTENT(IN) :: NZ_loc
22      INTEGER, INTENT(IN)    :: IWSZ
23      INTEGER, INTENT(IN)    :: ISZ, OSZ
24      INTEGER, INTENT(IN)    :: IRN_loc(NZ_loc), JCN_loc(NZ_loc)
25C  OUTPUT
26C     IPARTVEC(I) = proc number with largest number of entries
27C                in row/col I
28      INTEGER, INTENT(OUT) :: IPARTVEC(ISZ)
29C
30C  INTERNAL WORKING ARRAY
31C     IWRK (1:2*ISZ) is initialized to couples (MYID, Nb of entries
32C     on my proc and in row/col I) for I=1,ISZ
33C     (2*ISZ+1: 4*ISZ) is then set to
34C     the processor with largest number of entries in its row/col
35C     and its value (that is copied back into IPARTVEC(I)
36#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
37      INTEGER(4), INTENT(OUT) :: IWRK(IWSZ)
38#else
39      INTEGER, INTENT(OUT) :: IWRK(IWSZ)
40#endif
41      INCLUDE 'mpif.h'
42C
43C     LOCAL VARS
44      INTEGER I
45      INTEGER(8) :: I8
46      INTEGER OP, IERROR
47      INTEGER IR, IC
48C
49      IF(NUMPROCS.NE.1) THEN
50C     CHECK done outsize
51C     IF(IWSZ < 4*ISZ) THEN
52C     CHECK ENDS
53         CALL MPI_OP_CREATE(ZMUMPS_BUREDUCE, .TRUE., OP, IERROR)
54C     PERFORM THE REDUCTION
55#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
56        CALL ZMUMPS_IBUINIT(IWRK, 4*ISZ, int(ISZ,4))
57#else
58        CALL ZMUMPS_IBUINIT(IWRK, 4*ISZ, ISZ)
59#endif
60C     WE FIRST ZERO OUT
61         DO I=1,ISZ
62            IWRK(2*I-1) = 0
63            IWRK(2*I) = MYID
64         ENDDO
65         DO I8=1_8,NZ_loc
66            IR = IRN_loc(I8)
67            IC = JCN_loc(I8)
68            IF((IR.GE.1).AND.(IR.LE.ISZ).AND.
69     &           (IC.GE.1).AND.(IC.LE.OSZ)) THEN
70               IWRK(2*IR-1) = IWRK(2*IR-1) + 1
71            ENDIF
72         ENDDO
73         CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ,
74     &        MPI_2INTEGER, OP, COMM, IERROR)
75         DO I=1,ISZ
76            IPARTVEC(I) = IWRK(2*I+2*ISZ)
77         ENDDO
78C     FREE THE OPERATOR
79         CALL MPI_OP_FREE(OP, IERROR)
80      ELSE
81         DO I=1,ISZ
82            IPARTVEC(I) = 0
83         ENDDO
84      ENDIF
85      RETURN
86      END SUBROUTINE ZMUMPS_CREATEPARTVEC
87C
88C     SEPARATOR: Another function begins
89C
90C
91      SUBROUTINE ZMUMPS_FINDNUMMYROWCOL(MYID, NUMPROCS, COMM,
92     &     IRN_loc, JCN_loc, NZ_loc,
93     &     ROWPARTVEC, COLPARTVEC, M, N,
94     &     INUMMYR,
95     &     INUMMYC,
96     &     IWRK, IWSZ)
97      IMPLICIT NONE
98      INTEGER(8), INTENT(IN) :: NZ_loc
99      INTEGER, INTENT(IN) :: MYID, NUMPROCS, M, N, IWSZ
100      INTEGER, INTENT(IN) :: IRN_loc(NZ_loc), JCN_loc(NZ_loc)
101C     [ROW/COL]PARTVEC(I) holds proc number with largest number of entries
102C                in row/col I
103      INTEGER, INTENT(IN) :: ROWPARTVEC(M)
104      INTEGER, INTENT(IN) :: COLPARTVEC(N)
105      INTEGER, INTENT(IN) :: COMM
106C
107C  OUTPUT PARAMETERS
108C     INUMMYR < M and INUMMYC < N  (CPA or <= ??)
109C     INUMMYR holds the number of rows allocated to me
110C             or non empty on my proc
111C     INUMMYC idem with columns
112      INTEGER INUMMYR, INUMMYC
113C
114C  INTERNAL working array
115      INTEGER IWRK(IWSZ)
116C
117C   Local variables
118      INTEGER I, IR, IC
119      INTEGER(8) ::  I8
120C check done outsize
121C     IF(IWSZ < M) THEN ERROR
122C     IF(IWSZ < N) THEN ERROR
123      INUMMYR = 0
124      INUMMYC = 0
125C     MARK MY ROWS. FIRST COUNT,
126C          IF DYNAMIC MEMORY ALLOCATIOn WILL USED
127C     INUMMYR first counts number of rows affected to me
128C             (that will be centralized on MYID)
129      DO I=1,M
130         IWRK(I) = 0
131         IF(ROWPARTVEC(I).EQ.MYID) THEN
132            IWRK(I)=1
133            INUMMYR = INUMMYR + 1
134         ENDIF
135      ENDDO
136      DO I8=1_8,NZ_loc
137         IR = IRN_loc(I8)
138         IC = JCN_loc(I8)
139         IF((IR.GE.1).AND.(IR.LE.M).AND.
140     &        ((IC.GE.1).AND.(IC.LE.N)) ) THEN
141            IF(IWRK(IR) .EQ. 0) THEN
142               IWRK(IR)= 1
143               INUMMYR = INUMMYR + 1
144            ENDIF
145         ENDIF
146      ENDDO
147C     DO THE SMAME THING FOR COLS
148      DO I=1,N
149         IWRK(I) = 0
150         IF(COLPARTVEC(I).EQ.MYID) THEN
151            IWRK(I)= 1
152            INUMMYC = INUMMYC + 1
153         ENDIF
154      ENDDO
155      DO I8=1_8,NZ_loc
156         IC = JCN_loc(I8)
157         IR = IRN_loc(I8)
158         IF((IR.GE.1).AND.(IR.LE.M).AND.
159     &        ((IC.GE.1).AND.(IC.LE.N)) ) THEN
160            IF(IWRK(IC) .EQ. 0) THEN
161               IWRK(IC)= 1
162               INUMMYC = INUMMYC + 1
163            ENDIF
164         ENDIF
165      ENDDO
166C
167      RETURN
168      END SUBROUTINE ZMUMPS_FINDNUMMYROWCOL
169      SUBROUTINE ZMUMPS_FILLMYROWCOLINDICES(MYID, NUMPROCS,COMM,
170     &     IRN_loc, JCN_loc, NZ_loc,
171     &     ROWPARTVEC, COLPARTVEC, M, N,
172     &     MYROWINDICES, INUMMYR,
173     &     MYCOLINDICES, INUMMYC,
174     &     IWRK, IWSZ  )
175      IMPLICIT NONE
176      INTEGER(8) :: NZ_loc
177      INTEGER MYID, NUMPROCS, M, N
178      INTEGER INUMMYR, INUMMYC, IWSZ
179      INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc)
180      INTEGER ROWPARTVEC(M)
181      INTEGER COLPARTVEC(N)
182      INTEGER MYROWINDICES(INUMMYR)
183      INTEGER MYCOLINDICES(INUMMYC)
184      INTEGER IWRK(IWSZ)
185      INTEGER COMM
186C
187      INTEGER I, IR, IC, ITMP, MAXMN
188      INTEGER(8) :: I8
189C
190      MAXMN = M
191      IF(N > MAXMN) MAXMN = N
192C check done outsize
193C      IF(IWSZ < MAXMN) THEN ERROR
194C     MARK MY ROWS.
195      DO I=1,M
196         IWRK(I) = 0
197         IF(ROWPARTVEC(I).EQ.MYID) IWRK(I)=1
198      ENDDO
199      DO I8=1,NZ_loc
200         IR = IRN_loc(I8)
201         IC = JCN_loc(I8)
202         IF((IR.GE.1).AND.(IR.LE.M).AND.
203     &      ((IC.GE.1).AND.(IC.LE.N))  ) THEN
204            IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1
205         ENDIF
206      ENDDO
207C     PUT MY ROWS INTO MYROWINDICES
208      ITMP = 1
209      DO I=1,M
210         IF(IWRK(I).EQ.1) THEN
211            MYROWINDICES(ITMP) = I
212            ITMP  = ITMP + 1
213         ENDIF
214      ENDDO
215C
216C
217C     DO THE SMAME THING FOR COLS
218      DO I=1,N
219         IWRK(I) = 0
220         IF(COLPARTVEC(I).EQ.MYID) IWRK(I)= 1
221      ENDDO
222      DO I8=1,NZ_loc
223         IR = IRN_loc(I8)
224         IC = JCN_loc(I8)
225         IF((IR.GE.1).AND.(IR.LE.M).AND.
226     &      ((IC.GE.1).AND.(IC.LE.N))  ) THEN
227            IF(IWRK(IC) .EQ. 0) IWRK(IC)= 1
228         ENDIF
229      ENDDO
230C     PUT MY ROWS INTO MYROWINDICES
231      ITMP = 1
232      DO I=1,N
233         IF(IWRK(I).EQ.1) THEN
234            MYCOLINDICES(ITMP) = I
235            ITMP  = ITMP + 1
236         ENDIF
237      ENDDO
238C
239      RETURN
240      END SUBROUTINE ZMUMPS_FILLMYROWCOLINDICES
241C
242C     SEPARATOR: Another function begins
243C
244C
245      INTEGER FUNCTION ZMUMPS_CHK1LOC(D, DSZ, INDX, INDXSZ, EPS)
246      IMPLICIT NONE
247      INTEGER DSZ, INDXSZ
248      DOUBLE PRECISION D(DSZ)
249      INTEGER INDX(INDXSZ)
250      DOUBLE PRECISION EPS
251C     LOCAL VARS
252      INTEGER I, IID
253      DOUBLE PRECISION RONE
254      PARAMETER(RONE=1.0D0)
255      ZMUMPS_CHK1LOC = 1
256      DO I=1, INDXSZ
257         IID = INDX(I)
258         IF (.NOT.( (D(IID).LE.(RONE+EPS)).AND.
259     &        ((RONE-EPS).LE.D(IID)) )) THEN
260            ZMUMPS_CHK1LOC = 0
261         ENDIF
262      ENDDO
263      RETURN
264      END FUNCTION ZMUMPS_CHK1LOC
265      INTEGER FUNCTION ZMUMPS_CHK1CONV(D, DSZ, EPS)
266      IMPLICIT NONE
267      INTEGER DSZ
268      DOUBLE PRECISION D(DSZ)
269      DOUBLE PRECISION EPS
270C     LOCAL VARS
271      INTEGER I
272      DOUBLE PRECISION RONE
273      PARAMETER(RONE=1.0D0)
274      ZMUMPS_CHK1CONV = 1
275      DO I=1, DSZ
276         IF (.NOT.( (D(I).LE.(RONE+EPS)).AND.
277     &        ((RONE-EPS).LE.D(I)) )) THEN
278            ZMUMPS_CHK1CONV = 0
279         ENDIF
280      ENDDO
281      RETURN
282      END FUNCTION ZMUMPS_CHK1CONV
283C
284C     SEPARATOR: Another function begins
285C
286      INTEGER FUNCTION ZMUMPS_CHKCONVGLO(DR, M, INDXR, INDXRSZ,
287     &     DC, N, INDXC, INDXCSZ, EPS, COMM)
288      IMPLICIT NONE
289      INCLUDE 'mpif.h'
290      INTEGER M, N, INDXRSZ, INDXCSZ
291      DOUBLE PRECISION DR(M), DC(N)
292      INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ)
293      DOUBLE PRECISION EPS
294      INTEGER COMM
295      EXTERNAL ZMUMPS_CHK1LOC
296      INTEGER  ZMUMPS_CHK1LOC
297      INTEGER GLORES, MYRESR, MYRESC, MYRES
298      INTEGER IERR
299      MYRESR =  ZMUMPS_CHK1LOC(DR, M, INDXR, INDXRSZ, EPS)
300      MYRESC =  ZMUMPS_CHK1LOC(DC, N, INDXC, INDXCSZ, EPS)
301      MYRES = MYRESR + MYRESC
302      CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER,
303     &     MPI_SUM, COMM, IERR)
304      ZMUMPS_CHKCONVGLO = GLORES
305      RETURN
306      END FUNCTION ZMUMPS_CHKCONVGLO
307C
308C     SEPARATOR: Another function begins
309C
310      DOUBLE PRECISION FUNCTION ZMUMPS_ERRSCALOC(D, TMPD, DSZ,
311     &     INDX, INDXSZ)
312C     THE VAR D IS NOT USED IN COMPUTATIONS.
313C     IT IS THERE FOR READIBLITY OF THE *simScaleAbs.F
314      IMPLICIT NONE
315      INTEGER DSZ, INDXSZ
316      DOUBLE PRECISION D(DSZ)
317      DOUBLE PRECISION TMPD(DSZ)
318      INTEGER INDX(INDXSZ)
319C     LOCAL VARS
320      DOUBLE PRECISION RONE
321      PARAMETER(RONE=1.0D0)
322      INTEGER I, IIND
323      DOUBLE PRECISION ERRMAX
324      INTRINSIC abs
325      ERRMAX = -RONE
326      DO I=1,INDXSZ
327         IIND = INDX(I)
328         IF(abs(RONE-TMPD(IIND)).GT.ERRMAX) THEN
329            ERRMAX = abs(RONE-TMPD(IIND))
330         ENDIF
331      ENDDO
332      ZMUMPS_ERRSCALOC = ERRMAX
333      RETURN
334      END FUNCTION ZMUMPS_ERRSCALOC
335      DOUBLE PRECISION FUNCTION ZMUMPS_ERRSCA1(D, TMPD, DSZ)
336      IMPLICIT NONE
337      INTEGER DSZ
338      DOUBLE PRECISION D(DSZ)
339      DOUBLE PRECISION TMPD(DSZ)
340C     LOCAL VARS
341      DOUBLE PRECISION RONE
342      PARAMETER(RONE=1.0D0)
343      INTEGER I
344      DOUBLE PRECISION ERRMAX1
345      INTRINSIC abs
346      ERRMAX1 = -RONE
347      DO I=1,DSZ
348         IF(abs(RONE-TMPD(I)).GT.ERRMAX1) THEN
349            ERRMAX1 = abs(RONE-TMPD(I))
350         ENDIF
351      ENDDO
352      ZMUMPS_ERRSCA1 = ERRMAX1
353      RETURN
354      END FUNCTION ZMUMPS_ERRSCA1
355C
356C     SEPARATOR: Another function begins
357C
358      SUBROUTINE ZMUMPS_UPDATESCALE(D,  TMPD, DSZ,
359     &        INDX, INDXSZ)
360      IMPLICIT NONE
361      INTEGER DSZ, INDXSZ
362      DOUBLE PRECISION D(DSZ)
363      DOUBLE PRECISION TMPD(DSZ)
364      INTEGER INDX(INDXSZ)
365      INTRINSIC sqrt
366C     LOCAL VARS
367      INTEGER I, IIND
368      DOUBLE PRECISION RZERO
369      PARAMETER(RZERO=0.0D0)
370      DO I=1,INDXSZ
371         IIND = INDX(I)
372         IF (TMPD(IIND).NE.RZERO) D(IIND) = D(IIND)/sqrt(TMPD(IIND))
373      ENDDO
374      RETURN
375      END SUBROUTINE ZMUMPS_UPDATESCALE
376      SUBROUTINE ZMUMPS_UPSCALE1(D,  TMPD, DSZ)
377      IMPLICIT NONE
378      INTEGER DSZ
379      DOUBLE PRECISION D(DSZ)
380      DOUBLE PRECISION TMPD(DSZ)
381      INTRINSIC sqrt
382C     LOCAL VARS
383      INTEGER I
384      DOUBLE PRECISION RZERO
385      PARAMETER(RZERO=0.0D0)
386      DO I=1,DSZ
387         IF (TMPD(I) .NE. RZERO) D(I) = D(I)/sqrt(TMPD(I))
388      ENDDO
389      RETURN
390      END SUBROUTINE ZMUMPS_UPSCALE1
391C
392C     SEPARATOR: Another function begins
393C
394      SUBROUTINE ZMUMPS_INITREALLST(D, DSZ, INDX, INDXSZ, VAL)
395      IMPLICIT NONE
396      INTEGER DSZ, INDXSZ
397      DOUBLE PRECISION D(DSZ)
398      INTEGER INDX(INDXSZ)
399      DOUBLE PRECISION VAL
400C     LOCAL VARS
401      INTEGER I, IIND
402      DO I=1,INDXSZ
403         IIND = INDX(I)
404         D(IIND) = VAL
405      ENDDO
406      RETURN
407      END SUBROUTINE ZMUMPS_INITREALLST
408C
409C     SEPARATOR: Another function begins
410C
411      SUBROUTINE ZMUMPS_INVLIST(D, DSZ, INDX, INDXSZ)
412      IMPLICIT NONE
413      INTEGER DSZ, INDXSZ
414      DOUBLE PRECISION D(DSZ)
415      INTEGER INDX(INDXSZ)
416C     LOCALS
417      INTEGER I, IIND
418      DO I=1,INDXSZ
419         IIND  = INDX(I)
420         D(IIND) = 1.0D0/D(IIND)
421      ENDDO
422      RETURN
423      END SUBROUTINE ZMUMPS_INVLIST
424C
425C     SEPARATOR: Another function begins
426C
427      SUBROUTINE ZMUMPS_INITREAL(D, DSZ, VAL)
428      IMPLICIT NONE
429      INTEGER DSZ
430      DOUBLE PRECISION D(DSZ)
431      DOUBLE PRECISION VAL
432C     LOCAL VARS
433      INTEGER I
434      DO I=1,DSZ
435         D(I) = VAL
436      ENDDO
437      RETURN
438      END SUBROUTINE ZMUMPS_INITREAL
439C
440C     SEPARATOR: Another function begins
441C
442      SUBROUTINE ZMUMPS_ZEROOUT(TMPD, TMPSZ, INDX, INDXSZ)
443      IMPLICIT NONE
444      INTEGER TMPSZ,INDXSZ
445      DOUBLE PRECISION TMPD(TMPSZ)
446      INTEGER INDX(INDXSZ)
447C     LOCAL VAR
448      INTEGER I
449      DOUBLE PRECISION DZERO
450      PARAMETER(DZERO=0.0D0)
451      DO I=1,INDXSZ
452         TMPD(INDX(I)) = DZERO
453      ENDDO
454      RETURN
455      END SUBROUTINE ZMUMPS_ZEROOUT
456C
457C     SEPARATOR: Another function begins
458C
459      SUBROUTINE ZMUMPS_BUREDUCE(INV, INOUTV, LEN, DTYPE)
460C
461C    Like MPI_MINLOC operation (with ties broken sometimes with min
462C                               and sometimes with max)
463C     The objective is find for each entry row/col
464C     the processor with largest number of entries in its row/col
465C     When 2 procs have the same number of entries in the row/col
466C     then
467C         if this number of entries is odd we take the proc with largest id
468C         if this number of entries is even we take the proc with smallest id
469C
470      IMPLICIT NONE
471#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
472      INTEGER(4) :: LEN
473      INTEGER(4) :: INV(2*LEN)
474      INTEGER(4) :: INOUTV(2*LEN)
475      INTEGER(4) :: DTYPE
476#else
477      INTEGER :: LEN
478      INTEGER :: INV(2*LEN)
479      INTEGER :: INOUTV(2*LEN)
480      INTEGER :: DTYPE
481#endif
482      INTEGER I
483#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
484      INTEGER(4) DIN, DINOUT, PIN, PINOUT
485#else
486      INTEGER DIN, DINOUT, PIN, PINOUT
487#endif
488      DO I=1,2*LEN-1,2
489         DIN = INV(I)     ! nb of entries in row/col
490         PIN = INV(I+1)   ! proc number
491C  DINOUT
492         DINOUT = INOUTV(I)
493         PINOUT = INOUTV(I+1)
494         IF (DINOUT < DIN) THEN
495            INOUTV(I) = DIN
496            INOUTV(I+1) = PIN
497         ELSE IF (DINOUT == DIN) THEN
498C           --INOUTV(I) = DIN
499C           --even number I take smallest Process number (pin)
500            IF ((mod(DINOUT,2).EQ.0).AND.(PIN<PINOUT)) THEN
501              INOUTV(I+1) = PIN
502            ELSE IF ((mod(DINOUT,2).EQ.1).AND.(PIN>PINOUT)) THEN
503C           --odd number I take largest Process number (pin)
504              INOUTV(I+1) = PIN
505            ENDIF
506         ENDIF
507      ENDDO
508      RETURN
509      END SUBROUTINE ZMUMPS_BUREDUCE
510C
511C     SEPARATOR: Another function begins
512C
513      SUBROUTINE ZMUMPS_IBUINIT(IW, IWSZ, IVAL)
514      IMPLICIT NONE
515      INTEGER IWSZ
516#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
517      INTEGER(4) IW(IWSZ)
518      INTEGER(4) IVAL
519#else
520      INTEGER IW(IWSZ)
521      INTEGER IVAL
522#endif
523      INTEGER I
524      DO I=1,IWSZ
525         IW(I)=IVAL
526      ENDDO
527      RETURN
528      END SUBROUTINE ZMUMPS_IBUINIT
529C
530C     SEPARATOR: Another function begins
531C
532C
533C     SEPARATOR: Another function begins
534C
535      SUBROUTINE ZMUMPS_NUMVOLSNDRCV(MYID, NUMPROCS, ISZ, IPARTVEC,
536     &     NZ_loc, INDX, OSZ, OINDX,ISNDRCVNUM,ISNDRCVVOL,
537     &     OSNDRCVNUM,OSNDRCVVOL,
538     &     IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM)
539      IMPLICIT NONE
540      INTEGER(8), INTENT(IN) :: NZ_loc
541      INTEGER, INTENT(IN)    :: IWRKSZ
542      INTEGER, INTENT(IN) ::  MYID, NUMPROCS, ISZ, OSZ
543      INTEGER, INTENT(IN) ::  COMM
544C     When INDX holds row indices O(ther)INDX hold col indices
545      INTEGER, INTENT(IN) :: INDX(NZ_loc)
546      INTEGER, INTENT(IN) :: OINDX(NZ_loc)
547C     On entry IPARTVEC(I) holds proc number with largest number of entries
548C                in row/col I
549      INTEGER, INTENT(IN) :: IPARTVEC(ISZ)
550C
551C  OUTPUT PARAMETERS
552C     SNDSZ (IPROC+1) is set to the number of rows (or col) that
553C                     MYID will have to send to IPROC
554C     RCVSZ(IPROC+1) is set to the nb of row/cols that
555C                    MYID will receive from IPROC
556      INTEGER, INTENT(OUT) :: SNDSZ(NUMPROCS)
557      INTEGER, INTENT(OUT) :: RCVSZ(NUMPROCS)
558C     OSNDRCVNUM is set to the total number of procs
559C                destination of messages from MYID (< NUMPROCS)
560C     ISNDRCVNUM is set to the total number procs
561C                that will send messages to MYID  (< NUMPROCS)
562C     ISNDRCVVOL is set to the total number of row/col that
563C                MYID will have to send to other procs
564C                (bounded by N)
565C     OSNDRCVVOL  is set to the total number of row/col that
566C                MYID will have to send to other procs
567C                (bounded by N)
568C        Knowing that for each row the process with the largest
569C        number of entries  will centralize all indices then
570C        ISNDRCVVOL and OSNDRCVVOL are bounded by N
571      INTEGER, INTENT(OUT) :: ISNDRCVNUM, OSNDRCVNUM
572      INTEGER, INTENT(OUT) :: ISNDRCVVOL, OSNDRCVVOL
573C
574C  INTERNAL WORKING ARRAY
575      INTEGER IWRK(IWRKSZ)
576      INCLUDE 'mpif.h'
577C     LOCAL VARS
578      INTEGER I
579      INTEGER(8) :: I8
580      INTEGER IIND, IIND2, PIND
581      INTEGER IERROR
582C check done outsize
583C      IF(ISZ>IWRKSZ) THEN ERROR
584      DO I=1,NUMPROCS
585         SNDSZ(I) = 0
586         RCVSZ(I) = 0
587      ENDDO
588      DO I=1,IWRKSZ
589         IWRK(I) = 0
590      ENDDO
591C
592C     set SNDSZ
593      DO I8=1,NZ_loc
594         IIND = INDX(I8)
595         IIND2 = OINDX(I8)
596         IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.
597     &        (IIND2.GE.1).AND.(IIND2.LE.OSZ))THEN
598            PIND = IPARTVEC(IIND)
599            IF(PIND .NE. MYID) THEN
600C              MYID will send row/col IIND to proc PIND
601C              (PIND has the largest nb of entries in row/con IIND
602               IF(IWRK(IIND).EQ.0) THEN
603                  IWRK(IIND) = 1
604                  SNDSZ(PIND+1) = SNDSZ(PIND+1)+1
605               ENDIF
606            ENDIF
607         ENDIF
608      ENDDO
609C
610C     use SNDSZ to set RCVSZ
611      CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER,
612     & RCVSZ, 1, MPI_INTEGER, COMM, IERROR)
613C
614C     compute number of procs destinations of messages from MYID
615C     number of row/col sent by MYID.
616      ISNDRCVNUM = 0
617      ISNDRCVVOL = 0
618      OSNDRCVNUM = 0
619      OSNDRCVVOL = 0
620      DO I=1, NUMPROCS
621         IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1
622         OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I)
623         IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1
624         ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I)
625      ENDDO
626      RETURN
627      END SUBROUTINE ZMUMPS_NUMVOLSNDRCV
628C
629C     SEPARATOR: Another function begins
630C
631      SUBROUTINE ZMUMPS_SETUPCOMMS(MYID, NUMPROCS, ISZ, IPARTVEC,
632     &     NZ_loc, INDX, OSZ, OINDX,
633     &     ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA,
634     &     OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA,
635     &     SNDSZ, RCVSZ, IWRK,
636     &     ISTATUS, REQUESTS,
637     &     ITAGCOMM, COMM )
638      IMPLICIT NONE
639      INCLUDE 'mpif.h'
640      INTEGER(8) :: NZ_loc
641      INTEGER ISNDVOL, OSNDVOL
642      INTEGER MYID, NUMPROCS, ISZ, OSZ
643C     ISZ is either M or N
644      INTEGER INDX(NZ_loc)
645      INTEGER OINDX(NZ_loc)
646C     INDX is either IRN_loc or JCN_col
647      INTEGER IPARTVEC(ISZ)
648C     IPARTVEC is either rowpartvec or colpartvec
649      INTEGER :: ISNDRCVNUM
650      INTEGER INGHBPRCS(ISNDRCVNUM)
651      INTEGER ISNDRCVIA(NUMPROCS+1)
652      INTEGER ISNDRCVJA(ISNDVOL)
653      INTEGER OSNDRCVNUM
654      INTEGER ONGHBPRCS(OSNDRCVNUM)
655      INTEGER OSNDRCVIA(NUMPROCS+1)
656      INTEGER OSNDRCVJA(OSNDVOL)
657      INTEGER SNDSZ(NUMPROCS)
658      INTEGER RCVSZ(NUMPROCS)
659      INTEGER IWRK(ISZ)
660      INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM)
661      INTEGER REQUESTS(ISNDRCVNUM)
662      INTEGER ITAGCOMM, COMM
663C     LOCAL VARS
664      INTEGER I, IIND, IIND2, IPID, OFFS
665      INTEGER IWHERETO, POFFS, ITMP, IERROR
666      INTEGER(8) :: I8
667C     COMPUATIONs START
668      DO I=1,ISZ
669         IWRK(I) = 0
670      ENDDO
671C     INITIALIZE ONGHBPRCS using SNDSZ
672C     INITIALIZE THE OSNDRCVIA using SNDSZ
673      OFFS = 1
674      POFFS = 1
675      DO I=1,NUMPROCS
676         OSNDRCVIA(I) = OFFS + SNDSZ(I)
677         IF(SNDSZ(I) > 0) THEN
678            ONGHBPRCS(POFFS)=I
679            POFFS = POFFS + 1
680         ENDIF
681         OFFS  = OFFS +  SNDSZ(I)
682      ENDDO
683      OSNDRCVIA(NUMPROCS+1) = OFFS
684C     CHECK STARTS
685C check done outsize
686C      IF(POFFS .NE. OSNDRCVNUM + 1)THEN ERROR
687C     INIT DONE. FILL UP THE OSNDRCVJA(OSNDVOL)
688      DO I8=1,NZ_loc
689         IIND  = INDX(I8)
690         IIND2 = OINDX(I8)
691         IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.
692     &        (IIND2.GE.1).AND.(IIND2.LE.OSZ) ) THEN
693            IPID=IPARTVEC(IIND)
694            IF(IPID.NE.MYID) THEN
695               IF(IWRK(IIND).EQ.0) THEN
696                  IWHERETO = OSNDRCVIA(IPID+1)-1
697                  OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1
698                  OSNDRCVJA(IWHERETO) = IIND
699                  IWRK(IIND) = 1
700               ENDIF
701            ENDIF
702         ENDIF
703      ENDDO
704C     FILLED UP, WHAT I WILL RECEIVE (My requests from others)
705C     FILL UP ISNDRCVJA. It will be received to fill up
706      CALL MPI_BARRIER(COMM,IERROR)
707      OFFS = 1
708      POFFS = 1
709      ISNDRCVIA(1) = 1
710      DO I=2,NUMPROCS+1
711         ISNDRCVIA(I) = OFFS + RCVSZ(I-1)
712         IF(RCVSZ(I-1) > 0) THEN
713            INGHBPRCS(POFFS)=I-1
714            POFFS = POFFS + 1
715         ENDIF
716         OFFS  = OFFS +  RCVSZ(I-1)
717      ENDDO
718      CALL MPI_BARRIER(COMM,IERROR)
719      DO I=1, ISNDRCVNUM
720         IPID = INGHBPRCS(I)
721         OFFS = ISNDRCVIA(IPID)
722         ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID)
723         CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1,
724     &     ITAGCOMM, COMM, REQUESTS(I),IERROR)
725      ENDDO
726      DO I=1,OSNDRCVNUM
727         IPID = ONGHBPRCS(I)
728         OFFS = OSNDRCVIA(IPID)
729         ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID)
730         CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1,
731     &        ITAGCOMM, COMM,IERROR)
732      ENDDO
733      IF(ISNDRCVNUM > 0) THEN
734         CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR)
735      ENDIF
736      CALL MPI_BARRIER(COMM,IERROR)
737      RETURN
738      END SUBROUTINE ZMUMPS_SETUPCOMMS
739C
740C     SEPARATOR: Another function begins
741C
742      SUBROUTINE ZMUMPS_DOCOMMINF(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM,
743     &     ISNDRCVNUM, INGHBPRCS,
744     &     ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA,
745     &     OSNDRCVNUM, ONGHBPRCS,
746     &     OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA,
747     &     ISTATUS, REQUESTS,
748     &     COMM)
749      IMPLICIT NONE
750      INCLUDE 'mpif.h'
751      INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM
752      INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL
753      DOUBLE PRECISION TMPD(IDSZ)
754      INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM)
755      INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL)
756      DOUBLE PRECISION ISNDRCVA(ISNDRCVVOL)
757      INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL)
758      DOUBLE PRECISION OSNDRCVA(OSNDRCVVOL)
759      INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM))
760      INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM))
761      INTEGER COMM, IERROR
762C     LOCAL VARS
763      INTEGER I, PID, OFFS, SZ, J, JS, JE, IID
764      DO I=1,ISNDRCVNUM
765         PID = INGHBPRCS(I)
766         OFFS = ISNDRCVIA(PID)
767         SZ = ISNDRCVIA(PID+1) -  ISNDRCVIA(PID)
768         CALL MPI_IRECV(ISNDRCVA(OFFS), SZ,
769     &        MPI_DOUBLE_PRECISION, PID-1,
770     &        ITAGCOMM,COMM,REQUESTS(I), IERROR)
771      ENDDO
772      DO I=1,OSNDRCVNUM
773         PID = ONGHBPRCS(I)
774         OFFS = OSNDRCVIA(PID)
775         SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID)
776         JS = OSNDRCVIA(PID)
777         JE =  OSNDRCVIA(PID+1) - 1
778         DO J=JS, JE
779            IID = OSNDRCVJA(J)
780            OSNDRCVA(J) = TMPD(IID)
781         ENDDO
782         CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1,
783     &        ITAGCOMM, COMM, IERROR)
784      ENDDO
785      IF(ISNDRCVNUM > 0) THEN
786         CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR)
787      ENDIF
788C     FOLD INTO MY D
789      DO I=1,ISNDRCVNUM
790         PID = INGHBPRCS(I)
791         JS = ISNDRCVIA(PID)
792         JE = ISNDRCVIA(PID+1)-1
793         DO J=JS,JE
794            IID = ISNDRCVJA(J)
795            IF(TMPD(IID) < ISNDRCVA(J)) TMPD(IID)= ISNDRCVA(J)
796         ENDDO
797      ENDDO
798C     COMMUNICATE THE UPDATED ONES
799      DO I=1,OSNDRCVNUM
800         PID = ONGHBPRCS(I)
801         OFFS = OSNDRCVIA(PID)
802         SZ = OSNDRCVIA(PID+1) -  OSNDRCVIA(PID)
803         CALL MPI_IRECV(OSNDRCVA(OFFS), SZ,
804     &        MPI_DOUBLE_PRECISION, PID-1,
805     &        ITAGCOMM+1,COMM,REQUESTS(I), IERROR)
806      ENDDO
807      DO I=1,ISNDRCVNUM
808         PID = INGHBPRCS(I)
809         OFFS = ISNDRCVIA(PID)
810         SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID)
811         JS = ISNDRCVIA(PID)
812         JE = ISNDRCVIA(PID+1) -1
813         DO J=JS, JE
814            IID = ISNDRCVJA(J)
815            ISNDRCVA(J) = TMPD(IID)
816         ENDDO
817         CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1,
818     &        ITAGCOMM+1, COMM, IERROR)
819      ENDDO
820      IF(OSNDRCVNUM > 0) THEN
821         CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR)
822      ENDIF
823      DO I=1,OSNDRCVNUM
824         PID = ONGHBPRCS(I)
825         JS = OSNDRCVIA(PID)
826         JE = OSNDRCVIA(PID+1) - 1
827         DO J=JS,JE
828            IID = OSNDRCVJA(J)
829            TMPD(IID)=OSNDRCVA(J)
830         ENDDO
831      ENDDO
832      RETURN
833      END  SUBROUTINE ZMUMPS_DOCOMMINF
834C
835C     SEPARATOR: Another function begins
836C
837      SUBROUTINE ZMUMPS_DOCOMM1N(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM,
838     &     ISNDRCVNUM, INGHBPRCS,
839     &     ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA,
840     &     OSNDRCVNUM, ONGHBPRCS,
841     &     OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA,
842     &     ISTATUS, REQUESTS,
843     &     COMM)
844      IMPLICIT NONE
845      INCLUDE 'mpif.h'
846      INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM
847      INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL
848      DOUBLE PRECISION TMPD(IDSZ)
849      INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM)
850      INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL)
851      DOUBLE PRECISION ISNDRCVA(ISNDRCVVOL)
852      INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL)
853      DOUBLE PRECISION OSNDRCVA(OSNDRCVVOL)
854      INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM))
855      INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM))
856      INTEGER COMM, IERROR
857C     LOCAL VARS
858      INTEGER I, PID, OFFS, SZ, J, JS, JE, IID
859      DO I=1,ISNDRCVNUM
860         PID = INGHBPRCS(I)
861         OFFS = ISNDRCVIA(PID)
862         SZ = ISNDRCVIA(PID+1) -  ISNDRCVIA(PID)
863         CALL MPI_IRECV(ISNDRCVA(OFFS), SZ,
864     &        MPI_DOUBLE_PRECISION, PID-1,
865     &        ITAGCOMM,COMM,REQUESTS(I), IERROR)
866      ENDDO
867      DO I=1,OSNDRCVNUM
868         PID = ONGHBPRCS(I)
869         OFFS = OSNDRCVIA(PID)
870         SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID)
871         JS = OSNDRCVIA(PID)
872         JE =  OSNDRCVIA(PID+1) - 1
873         DO J=JS, JE
874            IID = OSNDRCVJA(J)
875            OSNDRCVA(J) = TMPD(IID)
876         ENDDO
877         CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1,
878     &        ITAGCOMM, COMM, IERROR)
879      ENDDO
880      IF(ISNDRCVNUM > 0) THEN
881         CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR)
882      ENDIF
883C     FOLD INTO MY D
884      DO I=1,ISNDRCVNUM
885         PID = INGHBPRCS(I)
886         JS = ISNDRCVIA(PID)
887         JE = ISNDRCVIA(PID+1)-1
888         DO J=JS,JE
889            IID = ISNDRCVJA(J)
890            TMPD(IID)  = TMPD(IID)+ ISNDRCVA(J)
891         ENDDO
892      ENDDO
893C     COMMUNICATE THE UPDATED ONES
894      DO I=1,OSNDRCVNUM
895         PID = ONGHBPRCS(I)
896         OFFS = OSNDRCVIA(PID)
897         SZ = OSNDRCVIA(PID+1) -  OSNDRCVIA(PID)
898         CALL MPI_IRECV(OSNDRCVA(OFFS), SZ,
899     &        MPI_DOUBLE_PRECISION, PID-1,
900     &        ITAGCOMM+1,COMM,REQUESTS(I), IERROR)
901      ENDDO
902      DO I=1,ISNDRCVNUM
903         PID = INGHBPRCS(I)
904         OFFS = ISNDRCVIA(PID)
905         SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID)
906         JS = ISNDRCVIA(PID)
907         JE = ISNDRCVIA(PID+1) -1
908         DO J=JS, JE
909            IID = ISNDRCVJA(J)
910            ISNDRCVA(J) = TMPD(IID)
911         ENDDO
912         CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1,
913     &        ITAGCOMM+1, COMM, IERROR)
914      ENDDO
915      IF(OSNDRCVNUM > 0) THEN
916         CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR)
917      ENDIF
918      DO I=1,OSNDRCVNUM
919         PID = ONGHBPRCS(I)
920         JS = OSNDRCVIA(PID)
921         JE = OSNDRCVIA(PID+1) - 1
922         DO J=JS,JE
923            IID = OSNDRCVJA(J)
924            TMPD(IID)=OSNDRCVA(J)
925         ENDDO
926      ENDDO
927      RETURN
928      END  SUBROUTINE ZMUMPS_DOCOMM1N
929      SUBROUTINE ZMUMPS_CREATEPARTVECSYM(MYID, NUMPROCS, COMM,
930     & IRN_loc, JCN_loc, NZ_loc,
931     & IPARTVEC, ISZ,
932     & IWRK, IWSZ)
933      IMPLICIT NONE
934      EXTERNAL ZMUMPS_BUREDUCE
935      INTEGER, INTENT(IN) :: MYID, NUMPROCS, COMM
936      INTEGER(8)          :: NZ_loc
937      INTEGER, INTENT(IN) :: ISZ, IWSZ
938      INTEGER, INTENT(IN) :: IRN_loc(NZ_loc), JCN_loc(NZ_loc)
939C
940C  OUTPUT
941C     IPARTVEC(I) = proc number with largest number of entries
942C                in row/col I
943      INTEGER, INTENT(OUT) :: IPARTVEC(ISZ)
944C
945C  INTERNAL WORKING ARRAY
946C     IWRK (1:2*ISZ) is initialized to couples (MYID, Nb of entries
947C     on my proc and in row/col I) for I=1,ISZ
948C     (2*ISZ+1: 4*ISZ) is then set to
949C     the processor with largest number of entries in its row/col
950C     and its value (that is copied back into IPARTVEC(I)
951#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
952      INTEGER(4), INTENT(OUT) :: IWRK(IWSZ)
953#else
954      INTEGER, INTENT(OUT) :: IWRK(IWSZ)
955#endif
956      INCLUDE 'mpif.h'
957C
958C     LOCAL VARS
959      INTEGER I
960      INTEGER(8) :: I8
961      INTEGER OP, IERROR
962      INTEGER IR, IC
963C
964      IF(NUMPROCS.NE.1) THEN
965C     CHECK done outsize
966C     IF(IWSZ < 2*ISZ) THEN
967C     CHECK ENDS
968         CALL MPI_OP_CREATE(ZMUMPS_BUREDUCE, .TRUE., OP, IERROR)
969C     PERFORM THE REDUCTION
970#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
971         CALL ZMUMPS_IBUINIT(IWRK, 4*ISZ, int(ISZ,4))
972#else
973         CALL ZMUMPS_IBUINIT(IWRK, 4*ISZ, ISZ)
974#endif
975         DO I=1,ISZ
976            IWRK(2*I-1) = 0
977            IWRK(2*I) = MYID
978         ENDDO
979         DO I8=1_8,NZ_loc
980            IR = IRN_loc(I8)
981            IC = JCN_loc(I8)
982            IF((IR.GE.1).AND.(IR.LE.ISZ).AND.
983     &           (IC.GE.1).AND.(IC.LE.ISZ)) THEN
984               IWRK(2*IR-1) = IWRK(2*IR-1) + 1
985               IWRK(2*IC-1) = IWRK(2*IC-1) + 1
986            ENDIF
987         ENDDO
988         CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ,
989     &        MPI_2INTEGER, OP, COMM, IERROR)
990         DO I=1,ISZ
991            IPARTVEC(I) = IWRK(2*I+2*ISZ)
992         ENDDO
993C     FREE THE OPERATOR
994         CALL MPI_OP_FREE(OP, IERROR)
995      ELSE
996         DO I=1,ISZ
997            IPARTVEC(I) = 0
998         ENDDO
999      ENDIF
1000      RETURN
1001      END SUBROUTINE ZMUMPS_CREATEPARTVECSYM
1002      SUBROUTINE ZMUMPS_NUMVOLSNDRCVSYM(MYID, NUMPROCS, ISZ, IPARTVEC,
1003     & NZ_loc, INDX,OINDX,ISNDRCVNUM,ISNDRCVVOL,OSNDRCVNUM,OSNDRCVVOL,
1004     & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM)
1005      IMPLICIT NONE
1006      INTEGER(8), INTENT(IN) :: NZ_loc
1007      INTEGER, INTENT(IN)    :: IWRKSZ
1008      INTEGER, INTENT(IN)    :: MYID, NUMPROCS, ISZ
1009      INTEGER, INTENT(IN)    :: INDX(NZ_loc), OINDX(NZ_loc)
1010      INTEGER, INTENT(IN)    :: IPARTVEC(ISZ)
1011      INTEGER, INTENT(IN)    :: COMM
1012C
1013C  OUTPUT PARAMETERS
1014C     SNDSZ (IPROC+1) is set to the number of rows (or col) that
1015C                     MYID will have to send to IPROC
1016C     RCVSZ(IPROC+1) is set to the nb of row/cols that
1017C                    MYID will receive from IPROC
1018      INTEGER :: SNDSZ(NUMPROCS)
1019      INTEGER :: RCVSZ(NUMPROCS)
1020C     OSNDRCVNUM is set to the total number of procs
1021C                destination of messages from MYID (< NUMPROCS)
1022C     ISNDRCVNUM is set to the total number procs
1023C                that will send messages to MYID  (< NUMPROCS)
1024C     ISNDRCVVOL is set to the total number of row/col that
1025C                MYID will have to send to other procs
1026C                (bounded by N)
1027C     OSNDRCVVOL  is set to the total number of row/col that
1028C                MYID will have to send to other procs
1029C                (bounded by N)
1030C        Knowing that for each row the process with the largest
1031C        number of entries  will centralize all indices then
1032C        ISNDRCVVOL and OSNDRCVVOL are bounded by N
1033      INTEGER, INTENT(OUT)   :: ISNDRCVNUM, ISNDRCVVOL
1034      INTEGER, INTENT(OUT)   :: OSNDRCVNUM, OSNDRCVVOL
1035C
1036C  INTERNAL WORKING ARRAY
1037      INTEGER, INTENT(OUT) :: IWRK(IWRKSZ)
1038      INCLUDE 'mpif.h'
1039C     LOCAL VARS
1040      INTEGER I
1041      INTEGER(8) :: I8
1042      INTEGER IIND, IIND2, PIND
1043      INTEGER IERROR
1044C check done outsize
1045C      IF(ISZ>IWRKSZ) THEN ERROR
1046      DO I=1,NUMPROCS
1047         SNDSZ(I) = 0
1048         RCVSZ(I) = 0
1049      ENDDO
1050      DO I=1,IWRKSZ
1051         IWRK(I) = 0
1052      ENDDO
1053C
1054C     set SNDSZ
1055      DO I8=1_8,NZ_loc
1056         IIND = INDX(I8)
1057         IIND2 = OINDX(I8)
1058         IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1)
1059     &        .AND.(IIND2.LE.ISZ)) THEN
1060            PIND = IPARTVEC(IIND)
1061            IF(PIND .NE. MYID) THEN
1062C              MYID will send row/col IIND to proc PIND
1063C              (PIND has the largest nb of entries in row/con IIND
1064               IF(IWRK(IIND).EQ.0) THEN
1065                  IWRK(IIND) = 1
1066                  SNDSZ(PIND+1) = SNDSZ(PIND+1)+1
1067               ENDIF
1068            ENDIF
1069            IIND = OINDX(I8)
1070            PIND = IPARTVEC(IIND)
1071            IF(PIND .NE. MYID) THEN
1072               IF(IWRK(IIND).EQ.0) THEN
1073                  IWRK(IIND) = 1
1074                  SNDSZ(PIND+1) = SNDSZ(PIND+1)+1
1075               ENDIF
1076            ENDIF
1077         ENDIF
1078      ENDDO
1079C
1080C     use SNDSZ to set RCVSZ
1081      CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER,
1082     &     RCVSZ, 1, MPI_INTEGER, COMM, IERROR)
1083C
1084C     compute number of procs destinations of messages from MYID
1085C     number of row/col sent by MYID.
1086      ISNDRCVNUM = 0
1087      ISNDRCVVOL = 0
1088      OSNDRCVNUM = 0
1089      OSNDRCVVOL = 0
1090      DO I=1, NUMPROCS
1091         IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1
1092         OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I)
1093         IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1
1094         ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I)
1095      ENDDO
1096      RETURN
1097      END SUBROUTINE ZMUMPS_NUMVOLSNDRCVSYM
1098      SUBROUTINE ZMUMPS_FINDNUMMYROWCOLSYM(MYID, NUMPROCS, COMM,
1099     &     IRN_loc, JCN_loc, NZ_loc,
1100     &     PARTVEC, N,
1101     &     INUMMYR,
1102     &     IWRK, IWSZ)
1103      IMPLICIT NONE
1104      INTEGER MYID, NUMPROCS, N
1105      INTEGER(8) :: NZ_loc
1106      INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc)
1107      INTEGER PARTVEC(N)
1108      INTEGER INUMMYR
1109      INTEGER IWSZ
1110      INTEGER IWRK(IWSZ)
1111      INTEGER COMM
1112C
1113      INTEGER I, IR, IC
1114      INTEGER(8) :: I8
1115C check done outsize
1116C     IF(IWSZ < M) THEN ERROR
1117C     IF(IWSZ < N) THEN ERROR
1118      INUMMYR = 0
1119C     MARK MY ROWS. FIRST COUNT,
1120C          IF DYNAMIC MEMORY ALLOCATIOn WILL USED
1121      DO I=1,N
1122         IWRK(I) = 0
1123         IF(PARTVEC(I).EQ.MYID) THEN
1124            IWRK(I)=1
1125            INUMMYR = INUMMYR + 1
1126         ENDIF
1127      ENDDO
1128      DO I8=1_8,NZ_loc
1129         IR = IRN_loc(I8)
1130         IC = JCN_loc(I8)
1131         IF((IR.GE.1).AND.(IR.LE.N).AND.
1132     &        ((IC.GE.1).AND.(IC.LE.N))) THEN
1133            IF(IWRK(IR) .EQ. 0) THEN
1134               IWRK(IR)= 1
1135               INUMMYR = INUMMYR + 1
1136            ENDIF
1137         ENDIF
1138         IF((IR.GE.1).AND.(IR.LE.N).AND.
1139     &        ((IC.GE.1).AND.(IC.LE.N))) THEN
1140            IF(IWRK(IC).EQ.0) THEN
1141               IWRK(IC)= 1
1142               INUMMYR = INUMMYR + 1
1143            ENDIF
1144         ENDIF
1145      ENDDO
1146C     THE SMAME THING APPLIES FOR COLS
1147C     No need to do anything
1148C
1149      RETURN
1150      END SUBROUTINE ZMUMPS_FINDNUMMYROWCOLSYM
1151      INTEGER FUNCTION ZMUMPS_CHKCONVGLOSYM(D, N, INDXR, INDXRSZ,
1152     &     EPS, COMM)
1153      IMPLICIT NONE
1154      INCLUDE 'mpif.h'
1155      INTEGER N, INDXRSZ
1156      DOUBLE PRECISION D(N)
1157      INTEGER INDXR(INDXRSZ)
1158      DOUBLE PRECISION EPS
1159      INTEGER COMM
1160      EXTERNAL ZMUMPS_CHK1LOC
1161      INTEGER  ZMUMPS_CHK1LOC
1162      INTEGER GLORES, MYRESR, MYRES
1163      INTEGER IERR
1164      MYRESR =  ZMUMPS_CHK1LOC(D, N, INDXR, INDXRSZ, EPS)
1165      MYRES = 2*MYRESR
1166      CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER,
1167     &     MPI_SUM, COMM, IERR)
1168      ZMUMPS_CHKCONVGLOSYM = GLORES
1169      RETURN
1170      END FUNCTION ZMUMPS_CHKCONVGLOSYM
1171      SUBROUTINE ZMUMPS_FILLMYROWCOLINDICESSYM(MYID, NUMPROCS,COMM,
1172     &     IRN_loc, JCN_loc, NZ_loc,
1173     &     PARTVEC, N,
1174     &     MYROWINDICES, INUMMYR,
1175     &     IWRK, IWSZ  )
1176      IMPLICIT NONE
1177      INTEGER MYID, NUMPROCS, N
1178      INTEGER(8) :: NZ_loc
1179      INTEGER INUMMYR, IWSZ
1180      INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc)
1181      INTEGER PARTVEC(N)
1182      INTEGER MYROWINDICES(INUMMYR)
1183      INTEGER IWRK(IWSZ)
1184      INTEGER COMM
1185C
1186      INTEGER I, IR, IC, ITMP, MAXMN
1187      INTEGER(8) :: I8
1188C
1189      MAXMN = N
1190C check done outsize
1191C      IF(IWSZ < MAXMN) THEN ERROR
1192C     MARK MY ROWS.
1193      DO I=1,N
1194         IWRK(I) = 0
1195         IF(PARTVEC(I).EQ.MYID) IWRK(I)=1
1196      ENDDO
1197      DO I8=1_8,NZ_loc
1198         IR = IRN_loc(I8)
1199         IC = JCN_loc(I8)
1200         IF((IR.GE.1).AND.(IR.LE.N).AND.
1201     &        ((IC.GE.1).AND.(IC.LE.N))) THEN
1202            IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1
1203         ENDIF
1204         IF((IR.GE.1).AND.(IR.LE.N).AND.
1205     &        ((IC.GE.1).AND.(IC.LE.N))) THEN
1206            IF(IWRK(IC) .EQ.0) IWRK(IC)=1
1207         ENDIF
1208      ENDDO
1209C     PUT MY ROWS INTO MYROWINDICES
1210      ITMP = 1
1211      DO I=1,N
1212         IF(IWRK(I).EQ.1) THEN
1213            MYROWINDICES(ITMP) = I
1214            ITMP  = ITMP + 1
1215         ENDIF
1216      ENDDO
1217C
1218C
1219C     THE SMAME THING APPLY TO COLS
1220C
1221      RETURN
1222      END SUBROUTINE ZMUMPS_FILLMYROWCOLINDICESSYM
1223      SUBROUTINE ZMUMPS_SETUPCOMMSSYM(MYID, NUMPROCS, ISZ, IPARTVEC,
1224     & NZ_loc, INDX, OINDX,
1225     & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA,
1226     & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA,
1227     & SNDSZ, RCVSZ, IWRK,
1228     & ISTATUS, REQUESTS,
1229     &  ITAGCOMM, COMM )
1230      IMPLICIT NONE
1231      INCLUDE 'mpif.h'
1232      INTEGER MYID, NUMPROCS, ISZ, ISNDVOL, OSNDVOL
1233      INTEGER(8) :: NZ_loc
1234C     ISZ is either M or N
1235      INTEGER INDX(NZ_loc), OINDX(NZ_loc)
1236C     INDX is either IRN_loc or JCN_col
1237      INTEGER IPARTVEC(ISZ)
1238C     IPARTVEC is either rowpartvec or colpartvec
1239      INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM)
1240      INTEGER ISNDRCVIA(NUMPROCS+1)
1241      INTEGER ISNDRCVJA(ISNDVOL)
1242      INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM)
1243      INTEGER OSNDRCVIA(NUMPROCS+1)
1244      INTEGER OSNDRCVJA(OSNDVOL)
1245      INTEGER SNDSZ(NUMPROCS)
1246      INTEGER RCVSZ(NUMPROCS)
1247      INTEGER IWRK(ISZ)
1248      INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM)
1249      INTEGER REQUESTS(ISNDRCVNUM)
1250      INTEGER ITAGCOMM, COMM
1251C     LOCAL VARS
1252      INTEGER I, IIND,IIND2,IPID,OFFS,IWHERETO,POFFS, ITMP, IERROR
1253      INTEGER(8) :: I8
1254C     COMPUATIONs START
1255      DO I=1,ISZ
1256         IWRK(I) = 0
1257      ENDDO
1258C     INITIALIZE ONGHBPRCS using SNDSZ
1259C     INITIALIZE THE OSNDRCVIA using SNDSZ
1260      OFFS = 1
1261      POFFS = 1
1262      DO I=1,NUMPROCS
1263         OSNDRCVIA(I) = OFFS + SNDSZ(I)
1264         IF(SNDSZ(I) > 0) THEN
1265            ONGHBPRCS(POFFS)=I
1266            POFFS = POFFS + 1
1267         ENDIF
1268         OFFS  = OFFS +  SNDSZ(I)
1269      ENDDO
1270      OSNDRCVIA(NUMPROCS+1) = OFFS
1271C CHECK STARTS
1272C check done outsize
1273C      IF(POFFS .NE. OSNDRCVNUM + 1)THEN ERROR
1274C     INIT DONE. FILL UP THE OSNDRCVJA(OSNDVOL)
1275      DO I8=1_8,NZ_loc
1276         IIND=INDX(I8)
1277         IIND2 = OINDX(I8)
1278         IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1)
1279     &        .AND.(IIND2.LE.ISZ)) THEN
1280            IPID=IPARTVEC(IIND)
1281            IF(IPID.NE.MYID) THEN
1282               IF(IWRK(IIND).EQ.0) THEN
1283                  IWHERETO = OSNDRCVIA(IPID+1)-1
1284                  OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1
1285                  OSNDRCVJA(IWHERETO) = IIND
1286                  IWRK(IIND) = 1
1287               ENDIF
1288            ENDIF
1289            IIND = OINDX(I8)
1290            IPID=IPARTVEC(IIND)
1291            IF(IPID.NE.MYID) THEN
1292               IF(IWRK(IIND).EQ.0) THEN
1293                  IWHERETO = OSNDRCVIA(IPID+1)-1
1294                  OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1
1295                  OSNDRCVJA(IWHERETO) = IIND
1296                  IWRK(IIND) = 1
1297               ENDIF
1298            ENDIF
1299         ENDIF
1300      ENDDO
1301C     FILLED UP, WHAT I WILL RECEIVE (My requests from others)
1302C     FILL UP ISNDRCVJA. It will be received to fill up
1303      CALL MPI_BARRIER(COMM,IERROR)
1304      OFFS = 1
1305      POFFS = 1
1306      ISNDRCVIA(1) = 1
1307      DO I=2,NUMPROCS+1
1308         ISNDRCVIA(I) = OFFS + RCVSZ(I-1)
1309         IF(RCVSZ(I-1) > 0) THEN
1310            INGHBPRCS(POFFS)=I-1
1311            POFFS = POFFS + 1
1312         ENDIF
1313         OFFS  = OFFS +  RCVSZ(I-1)
1314      ENDDO
1315      CALL MPI_BARRIER(COMM,IERROR)
1316      DO I=1, ISNDRCVNUM
1317         IPID = INGHBPRCS(I)
1318         OFFS = ISNDRCVIA(IPID)
1319         ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID)
1320         CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1,
1321     &     ITAGCOMM, COMM, REQUESTS(I),IERROR)
1322      ENDDO
1323      DO I=1,OSNDRCVNUM
1324         IPID = ONGHBPRCS(I)
1325         OFFS = OSNDRCVIA(IPID)
1326         ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID)
1327         CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1,
1328     &        ITAGCOMM, COMM,IERROR)
1329      ENDDO
1330      IF(ISNDRCVNUM > 0) THEN
1331         CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR)
1332      ENDIF
1333      CALL MPI_BARRIER(COMM,IERROR)
1334      RETURN
1335      END SUBROUTINE ZMUMPS_SETUPCOMMSSYM
1336