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 SMUMPS_ASM_SLAVE_MASTER(N, INODE, IW, LIW, A, LA,
14     &    ISON, NBROWS, NBCOLS, ROWLIST,
15     &    VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,
16     &    OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6,
17     &    LDA_VALSON )
18      USE SMUMPS_LOAD
19      IMPLICIT NONE
20      INTEGER KEEP(500)
21      INTEGER(8) KEEP8(150)
22      INTEGER(8) :: LA
23      INTEGER N,LIW,MYID
24      INTEGER INODE,ISON, IWPOSCB
25      INTEGER NBROWS, NBCOLS, LDA_VALSON
26      INTEGER(8) :: PTRAST(KEEP(28))
27      INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)),
28     &        PTLUST_S(KEEP(28)), ROWLIST(NBROWS)
29      REAL A(LA), VALSON(LDA_VALSON,NBROWS)
30      DOUBLE PRECISION OPASSW
31      LOGICAL, INTENT(IN) :: IS_ofType5or6
32      INTEGER(8) :: POSELT, POSEL1, APOS, JJ2
33      INTEGER HF,HS, NSLAVES, NFRONT, NASS1,
34     &        IOLDPS, ISTCHK, LSTK, NSLSON,NELIM,
35     &        NPIVS,NCOLS,J1,JJ,JJ1,NROWS,
36     &        LDAFS_PERE, IBEG, DIAG
37      INCLUDE 'mumps_headers.h'
38      LOGICAL SAME_PROC
39      INTRINSIC real
40      IOLDPS = PTLUST_S(STEP(INODE))
41      POSELT = PTRAST(STEP(INODE))
42      NFRONT = IW(IOLDPS+KEEP(IXSZ))
43      NASS1  = iabs(IW(IOLDPS + 2+KEEP(IXSZ)))
44      NSLAVES= IW(IOLDPS+5+KEEP(IXSZ))
45      IF (KEEP(50).EQ.0) THEN
46        LDAFS_PERE = NFRONT
47      ELSE
48        IF ( NSLAVES .eq. 0 ) THEN
49          LDAFS_PERE = NFRONT
50        ELSE
51          LDAFS_PERE = NASS1
52        ENDIF
53      ENDIF
54      HF      = 6 + NSLAVES + KEEP(IXSZ)
55      POSEL1 = POSELT - int(LDAFS_PERE,8)
56      ISTCHK = PIMASTER(STEP(ISON))
57      LSTK = IW(ISTCHK+KEEP(IXSZ))
58      NSLSON  = IW(ISTCHK + 5+KEEP(IXSZ))
59      HS      = 6 + NSLSON + KEEP(IXSZ)
60      OPASSW = OPASSW + dble(NBROWS*NBCOLS)
61      NELIM = IW(ISTCHK + 1+KEEP(IXSZ))
62      NPIVS = IW(ISTCHK + 3+KEEP(IXSZ))
63      IF (NPIVS.LT.0) NPIVS = 0
64      NCOLS = NPIVS + LSTK
65      SAME_PROC = (ISTCHK.LT.IWPOSCB)
66      IF (SAME_PROC) THEN
67       NROWS = NCOLS
68      ELSE
69       NROWS = IW(ISTCHK+2+KEEP(IXSZ))
70      ENDIF
71      J1 = ISTCHK + NROWS + HS + NPIVS
72      IF (KEEP(50).EQ.0) THEN
73       IF (IS_ofType5or6) THEN
74         APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8)
75         DO JJ = 1, NBROWS
76           DO JJ1 = 1, NBCOLS
77             JJ2 = APOS + int(JJ1-1,8)
78             A(JJ2)=A(JJ2)+VALSON(JJ1,JJ)
79           ENDDO
80           APOS = APOS + int(LDAFS_PERE,8)
81         ENDDO
82       ELSE
83        DO 170 JJ = 1, NBROWS
84         APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8)
85         DO 160 JJ1 = 1, NBCOLS
86           JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8)
87           A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)
88  160    CONTINUE
89  170   CONTINUE
90       ENDIF
91      ELSE
92       IF (IS_ofType5or6) THEN
93        APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8)
94        DIAG = ROWLIST(1)
95        DO JJ = 1, NBROWS
96          DO JJ1 = 1, DIAG
97            JJ2 = APOS+int(JJ1-1,8)
98            A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)
99          ENDDO
100          DIAG = DIAG+1
101          APOS = APOS + int(LDAFS_PERE,8)
102        ENDDO
103       ELSE
104        DO JJ = 1, NBROWS
105         IF (ROWLIST(JJ).LE.NASS1.and..NOT.IS_ofType5or6) THEN
106          APOS = POSEL1 + int(ROWLIST(JJ) - 1,8)
107          DO JJ1 = 1, NELIM
108           JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8)
109            A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)
110          ENDDO
111          IBEG = NELIM+1
112         ELSE
113          IBEG = 1
114         ENDIF
115         APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8)
116         DO JJ1 = IBEG, NBCOLS
117          IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT
118          JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8)
119          A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)
120         ENDDO
121        ENDDO
122       ENDIF
123      ENDIF
124      RETURN
125      END SUBROUTINE SMUMPS_ASM_SLAVE_MASTER
126      SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_INIT
127     &    (N, INODE, IW, LIW, A, LA,
128     &    NBROWS, NBCOLS,
129     &    OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,
130     &    RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR,
131     &    ICNTL, KEEP,KEEP8, MYID)
132      IMPLICIT NONE
133      INTEGER N,LIW
134      INTEGER(8) :: LA
135      INTEGER KEEP(500), ICNTL(40)
136      INTEGER(8) KEEP8(150)
137      INTEGER INODE, MYID
138      INTEGER NBROWS, NBCOLS
139      INTEGER(8) :: PTRAST(KEEP(28))
140      INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
141     &        PTRIST(KEEP(28)), FILS(N)
142      INTEGER(8), INTENT(IN) :: PTRARW(N), PTRAIW(N)
143      REAL :: RHS_MUMPS(KEEP(255))
144      REAL :: A(LA)
145      INTEGER :: INTARR(KEEP8(27))
146      REAL :: DBLARR(KEEP8(26))
147      DOUBLE PRECISION OPASSW, OPELIW
148      INTEGER(8) :: POSELT
149      INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
150     &        K1,K2,K,J,JPOS,NASS
151      REAL ZERO
152      PARAMETER( ZERO = 0.0E0 )
153      INCLUDE 'mumps_headers.h'
154      IOLDPS  = PTRIST(STEP(INODE))
155      POSELT  = PTRAST(STEP(INODE))
156      NBCOLF  = IW(IOLDPS+KEEP(IXSZ))
157      NBROWF  = IW(IOLDPS+2+KEEP(IXSZ))
158      NASS    = IW(IOLDPS+1+KEEP(IXSZ))
159      NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))
160      HF      = 6 + NSLAVES + KEEP(IXSZ)
161      IF (NASS.LT.0) THEN
162          NASS         = -NASS
163          IW(IOLDPS+1+KEEP(IXSZ)) = NASS
164          CALL SMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW,
165     &           IOLDPS, A, LA, POSELT, KEEP, KEEP8,
166     &           ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR,
167     &           KEEP8(27), KEEP8(26),
168     &           RHS_MUMPS)
169      ENDIF
170      IF (NBROWS.GT.0) THEN
171          K1 = IOLDPS + HF + NBROWF
172          K2 = K1 + NBCOLF - 1
173          JPOS = 1
174          DO K = K1, K2
175           J        = IW(K)
176           ITLOC(J) = JPOS
177           JPOS     = JPOS + 1
178          ENDDO
179      ENDIF
180      RETURN
181      END SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_INIT
182      SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_END
183     & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST,
184     & ITLOC, RHS_MUMPS, KEEP,KEEP8)
185      IMPLICIT NONE
186      INTEGER N, LIW
187      INTEGER KEEP(500)
188      INTEGER(8) KEEP8(150)
189      INTEGER INODE
190      INTEGER NBROWS
191      INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
192     &        PTRIST(KEEP(28))
193      REAL :: RHS_MUMPS(KEEP(255))
194      INCLUDE 'mumps_headers.h'
195      INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
196     &        K1,K2,K,J
197      IOLDPS  = PTRIST(STEP(INODE))
198      NBCOLF  = IW(IOLDPS+KEEP(IXSZ))
199      NBROWF  = IW(IOLDPS+2+KEEP(IXSZ))
200      NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))
201      HF      = 6 + NSLAVES+KEEP(IXSZ)
202      IF (NBROWS.GT.0) THEN
203          K1 = IOLDPS + HF + NBROWF
204          K2 = K1 + NBCOLF - 1
205          DO K = K1, K2
206           J        = IW(K)
207           ITLOC(J) = 0
208          ENDDO
209      ENDIF
210      RETURN
211      END SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_END
212      SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE(N, INODE, IW, LIW, A, LA,
213     &    NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON,
214     &    OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,
215     &    RHS_MUMPS, FILS,
216     &    ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON)
217      IMPLICIT NONE
218      INTEGER N,LIW
219      INTEGER(8) :: LA
220      INTEGER KEEP(500), ICNTL(40)
221      INTEGER(8) KEEP8(150)
222      INTEGER INODE, MYID
223      LOGICAL, intent(in) :: IS_ofType5or6
224      INTEGER NBROWS, NBCOLS, LDA_VALSON
225      INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS)
226      INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
227     &        PTRIST(KEEP(28)), FILS(N)
228      REAL :: RHS_MUMPS(KEEP(255))
229      INTEGER(8) :: PTRAST(KEEP(28))
230      REAL A(LA), VALSON(LDA_VALSON,NBROWS)
231      DOUBLE PRECISION OPASSW, OPELIW
232      INTEGER(8) :: POSEL1, POSELT, APOS, K8
233      INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
234     &        I,J,NASS,IDIAG
235      INCLUDE 'mumps_headers.h'
236      INTRINSIC real
237      IOLDPS  = PTRIST(STEP(INODE))
238      POSELT  = PTRAST(STEP(INODE))
239      NBCOLF  = IW(IOLDPS+KEEP(IXSZ))
240      NBROWF  = IW(IOLDPS+2+KEEP(IXSZ))
241      NASS    = IW(IOLDPS+1+KEEP(IXSZ))
242       IF ( NBROWS .GT. NBROWF ) THEN
243          WRITE(*,*) ' ERR: ERROR : NBROWS > NBROWF'
244          WRITE(*,*) ' ERR: INODE =', INODE
245          WRITE(*,*) ' ERR: NBROW=',NBROWS,'NBROWF=',NBROWF
246          WRITE(*,*) ' ERR: ROW_LIST=', ROWLIST
247          WRITE(*,*) ' ERR: NBCOLF/NASS=', NBCOLF, NASS
248          CALL MUMPS_ABORT()
249       END IF
250      NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))
251      HF      = 6 + NSLAVES+KEEP(IXSZ)
252      IF (NBROWS.GT.0) THEN
253          POSEL1 = POSELT - int(NBCOLF,8)
254          IF (KEEP(50).EQ.0) THEN
255           IF (IS_ofType5or6) THEN
256            APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8)
257            DO I=1, NBROWS
258                DO J = 1, NBCOLS
259                  A(APOS+int(J-1,8)) = A( APOS+int(J-1,8)) + VALSON(J,I)
260                ENDDO
261                APOS = APOS + int(NBCOLF,8)
262            END DO
263           ELSE
264            DO I=1,NBROWS
265             APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8)
266             DO J=1,NBCOLS
267              K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8
268              A(K8) = A(K8) + VALSON(J,I)
269             ENDDO
270            ENDDO
271           ENDIF
272          ELSE
273           IF (IS_ofType5or6) THEN
274            APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8)
275     &              + int((NBROWS-1),8)*int(NBCOLF,8)
276            IDIAG = 0
277            DO I=NBROWS,1,-1
278             A(APOS:APOS+int(NBCOLS-IDIAG-1,8))=
279     &         A(APOS:APOS+int(NBCOLS-IDIAG-1,8)) +
280     &         VALSON(1:NBCOLS-IDIAG,I)
281             APOS = APOS - int(NBCOLF,8)
282             IDIAG = IDIAG + 1
283            ENDDO
284           ELSE
285            DO I=1,NBROWS
286             APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8)
287             DO J=1,NBCOLS
288              IF (ITLOC(COLLIST(J)) .EQ. 0) THEN
289                  EXIT
290              ENDIF
291              K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8
292              A(K8) = A(K8) + VALSON(J,I)
293             ENDDO
294            ENDDO
295           ENDIF
296          ENDIF
297          OPASSW = OPASSW + dble(NBROWS*NBCOLS)
298      ENDIF
299      RETURN
300      END SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE
301      SUBROUTINE SMUMPS_LDLT_ASM_NIV12_IP( A, LA,
302     &             IAFATH, NFRONT, NASS1,
303     &             IACB, NCOLS, LCB,
304     &             IW, NROWS, NELIM, ETATASS,
305     &             CB_IS_COMPRESSED )
306      IMPLICIT NONE
307      INTEGER NFRONT, NASS1
308      INTEGER(8) :: LA
309      INTEGER NCOLS, NROWS, NELIM
310      INTEGER(8) :: LCB
311      REAL A( LA )
312      INTEGER(8) :: IAFATH, IACB
313      INTEGER IW( NCOLS )
314      INTEGER ETATASS
315      LOGICAL CB_IS_COMPRESSED
316      REAL ZERO
317      PARAMETER( ZERO = 0.0E0 )
318      INTEGER I, J
319      INTEGER(8) :: APOS, POSELT
320      INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT
321      LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS,
322     &        RISK_OF_SAME_POS_THIS_LINE
323      IENDFRONT =  IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8
324      IPOSCB=1_8
325      RESET_TO_ZERO    = IACB .LT. IENDFRONT + 1_8
326      RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8
327      RISK_OF_SAME_POS_THIS_LINE = .FALSE.
328      DO I=1, NROWS
329          POSELT = int(IW(I)-1,8) * int(NFRONT,8)
330          IF (.NOT. CB_IS_COMPRESSED ) THEN
331            IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8)
332            IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN
333              RESET_TO_ZERO = .FALSE.
334            ENDIF
335          ENDIF
336          IF ( RISK_OF_SAME_POS ) THEN
337            IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN
338              IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ.
339     &             IACB+IPOSCB+int(I-1-1,8)) THEN
340                 RISK_OF_SAME_POS_THIS_LINE = .TRUE.
341              ENDIF
342            ENDIF
343          ENDIF
344          IF (RESET_TO_ZERO) THEN
345            IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN
346              DO J=1, I
347                APOS = POSELT + int(IW( J ),8)
348                IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN
349                  A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)
350                  A(IACB+IPOSCB-1_8) = ZERO
351                ENDIF
352                IPOSCB = IPOSCB + 1_8
353              ENDDO
354            ELSE
355              DO J=1, I
356                APOS = POSELT + int(IW( J ),8)
357                A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)
358                A(IACB+IPOSCB-1_8) = ZERO
359                IPOSCB = IPOSCB + 1_8
360              ENDDO
361            ENDIF
362          ELSE
363            DO J=1, I
364              APOS = POSELT + int(IW( J ),8)
365              A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)
366              IPOSCB = IPOSCB + 1_8
367            ENDDO
368          ENDIF
369          IF (.NOT. CB_IS_COMPRESSED ) THEN
370            IBEGCBROW = IACB+IPOSCB-1_8
371            IF ( IBEGCBROW .LE. IENDFRONT ) THEN
372              A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO
373            ENDIF
374          ENDIF
375          IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN
376            RESET_TO_ZERO = .FALSE.
377          ENDIF
378      ENDDO
379      RETURN
380      END SUBROUTINE SMUMPS_LDLT_ASM_NIV12_IP
381      SUBROUTINE SMUMPS_LDLT_ASM_NIV12( A, LA, SON_A,
382     &             IAFATH, NFRONT, NASS1,
383     &             NCOLS, LCB,
384     &             IW, NROWS, NELIM, ETATASS,
385     &             CB_IS_COMPRESSED
386     &             )
387      IMPLICIT NONE
388      INTEGER NFRONT, NASS1
389      INTEGER(8) :: LA
390      INTEGER NCOLS, NROWS, NELIM
391      INTEGER(8) :: LCB
392      REAL A( LA )
393      REAL SON_A( LCB )
394      INTEGER(8) :: IAFATH
395      INTEGER IW( NCOLS )
396      INTEGER ETATASS
397      LOGICAL CB_IS_COMPRESSED
398      REAL ZERO
399      PARAMETER( ZERO = 0.0E0 )
400      INTEGER I, J
401      INTEGER(8) :: APOS, POSELT
402      INTEGER(8) :: IPOSCB
403      LOGICAL    :: OMP_FLAG
404      IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN
405        IPOSCB = 1_8
406        DO I = 1, NELIM
407          POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
408          IF (.NOT. CB_IS_COMPRESSED) THEN
409            IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8)
410          ENDIF
411          DO J = 1, I
412            APOS = POSELT + int(IW( J ),8)
413            A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8)
414     &                           + SON_A(IPOSCB)
415            IPOSCB = IPOSCB + 1_8
416          END DO
417        END DO
418      ENDIF
419      IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN
420        OMP_FLAG = (NROWS-NELIM).GE.300
421!$OMP PARALLEL DO PRIVATE(IPOSCB, POSELT, J, APOS) IF (OMP_FLAG)
422       DO I = NELIM + 1, NROWS
423          IF (CB_IS_COMPRESSED) THEN
424            IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8
425          ELSE
426            IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8
427          ENDIF
428          POSELT = int(IW( I ),8)
429          IF (POSELT.LE. int(NASS1,8)) THEN
430            DO J = 1, NELIM
431              APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8)
432              A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) +
433     &                             SON_A(IPOSCB)
434              IPOSCB = IPOSCB + 1_8
435            END DO
436          ELSE
437            POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
438            DO J = 1, NELIM
439             APOS = POSELT + int(IW( J ), 8)
440             A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
441     &                          + SON_A(IPOSCB)
442             IPOSCB = IPOSCB + 1_8
443            END DO
444          ENDIF
445          IF (ETATASS.EQ.1) THEN
446            POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
447            DO J = NELIM + 1, I
448                 IF (IW(J).GT.NASS1) EXIT
449                 APOS = POSELT + int(IW( J ), 8)
450                 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
451     &                              + SON_A(IPOSCB)
452                 IPOSCB = IPOSCB +1_8
453            END DO
454          ELSE
455            POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
456            DO J = NELIM + 1, I
457             APOS = POSELT + int(IW( J ), 8)
458             A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
459     &                          + SON_A(IPOSCB)
460             IPOSCB = IPOSCB + 1_8
461            END DO
462          ENDIF
463        END DO
464!$OMP END PARALLEL DO
465      ELSE
466        DO I= NROWS, NELIM+1, -1
467          IF (CB_IS_COMPRESSED) THEN
468            IPOSCB = (int(I,8)*int(I+1,8))/2_8
469          ELSE
470            IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8)
471          ENDIF
472          POSELT = int(IW( I ),8)
473          IF (POSELT.LE.int(NASS1,8)) EXIT
474          POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
475          DO J=I,NELIM+1, -1
476            IF (IW(J).LE.NASS1) EXIT
477            APOS = POSELT + int(IW( J ), 8)
478            A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
479     &                         + SON_A(IPOSCB)
480            IPOSCB = IPOSCB - 1_8
481          ENDDO
482        ENDDO
483      ENDIF
484      RETURN
485      END SUBROUTINE SMUMPS_LDLT_ASM_NIV12
486      SUBROUTINE SMUMPS_RESTORE_INDICES(N, ISON, INODE, IWPOSCB,
487     &           PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)
488      IMPLICIT NONE
489      INTEGER N, ISON, INODE, IWPOSCB
490      INTEGER KEEP(500), STEP(N)
491      INTEGER(8) KEEP8(150)
492      INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28))
493      INTEGER LIW
494      INTEGER IW(LIW)
495      INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM
496      INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF
497      INTEGER J1, J2, J3, JJ, JPOS
498      LOGICAL SAME_PROC
499      INCLUDE 'mumps_headers.h'
500      ISTCHK = PIMASTER(STEP(ISON))
501      LSTK   = IW(ISTCHK+KEEP(IXSZ))
502      NSLSON = IW(ISTCHK+5+KEEP(IXSZ))
503      HS     = 6 + NSLSON + KEEP(IXSZ)
504      NELIM  = IW(ISTCHK + 1+KEEP(IXSZ))
505      NPIVS  = IW(ISTCHK + 3+KEEP(IXSZ))
506      NCOLS  = NPIVS + LSTK
507      IF ( NPIVS < 0 ) NPIVS = 0
508      SAME_PROC = ISTCHK < IWPOSCB
509      IF (SAME_PROC) THEN
510       NROWS = NCOLS
511      ELSE
512       NROWS = IW(ISTCHK+2+KEEP(IXSZ))
513      ENDIF
514      J1 = ISTCHK + NROWS + HS + NPIVS
515      IF (KEEP(50).NE.0) THEN
516          J2 = J1 +  LSTK - 1
517          DO JJ = J1, J2
518            IW(JJ) = IW(JJ - NROWS)
519          ENDDO
520      ELSE
521            J2 = J1 + LSTK - 1
522            J3 = J1 + NELIM
523            DO JJ = J3, J2
524             IW(JJ) = IW(JJ - NROWS)
525            ENDDO
526            IF (NELIM .NE. 0) THEN
527              IOLDPS = PTLUST_S(STEP(INODE))
528              NFRONT = IW(IOLDPS+KEEP(IXSZ))
529              NSLAVES= IW(IOLDPS+5+KEEP(IXSZ))
530              HF     = 6 + NSLAVES+KEEP(IXSZ)
531              ICT11 = IOLDPS + HF - 1 + NFRONT
532              J3 = J3 - 1
533              DO 190 JJ = J1, J3
534               JPOS = IW(JJ) + ICT11
535               IW(JJ) = IW(JPOS)
536  190         CONTINUE
537            ENDIF
538      ENDIF
539      RETURN
540      END SUBROUTINE SMUMPS_RESTORE_INDICES
541      SUBROUTINE SMUMPS_ASM_MAX(
542     &     N, INODE, IW, LIW, A, LA,
543     &     ISON, NBCOLS,
544     &     VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,
545     &     OPASSW, IWPOSCB,MYID, KEEP,KEEP8 )
546      USE SMUMPS_LOAD
547      IMPLICIT NONE
548      INTEGER KEEP(500)
549      INTEGER(8) KEEP8(150)
550      INTEGER(8) :: LA
551      INTEGER N,LIW,MYID
552      INTEGER INODE,ISON,IWPOSCB
553      INTEGER NBCOLS
554      INTEGER IW(LIW), STEP(N),
555     &     PIMASTER(KEEP(28)),
556     &     PTLUST_S(KEEP(28))
557      INTEGER(8) PTRAST(KEEP(28))
558      REAL A(LA)
559      REAL VALSON(NBCOLS)
560      DOUBLE PRECISION OPASSW
561      INTEGER HF,HS, NSLAVES, NASS1,
562     &     IOLDPS, ISTCHK,
563     &     LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1,
564     &     JJ1,NROWS
565      INTEGER(8) POSELT, APOS, JJ2
566      INCLUDE 'mumps_headers.h'
567      LOGICAL SAME_PROC
568      INTRINSIC real
569      IOLDPS = PTLUST_S(STEP(INODE))
570      POSELT = PTRAST(STEP(INODE))
571      NASS1  = iabs(IW(IOLDPS + 2 + KEEP(IXSZ)))
572      NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ))
573      HF      = 6 + NSLAVES + KEEP(IXSZ)
574      ISTCHK = PIMASTER(STEP(ISON))
575      LSTK = IW(ISTCHK + KEEP(IXSZ))
576      NSLSON  = IW(ISTCHK + 5 + KEEP(IXSZ))
577      HS      = 6 + NSLSON + KEEP(IXSZ)
578      NELIM = IW(ISTCHK + 1 + KEEP(IXSZ))
579      NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ))
580      IF (NPIVS.LT.0) NPIVS = 0
581      NCOLS = NPIVS + LSTK
582      SAME_PROC = (ISTCHK.LT.IWPOSCB)
583      IF (SAME_PROC) THEN
584       NROWS = NCOLS
585      ELSE
586       NROWS = IW(ISTCHK+2 + KEEP(IXSZ))
587      ENDIF
588      J1 = ISTCHK + NROWS + HS + NPIVS
589      APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8
590      DO JJ1 = 1, NBCOLS
591         JJ2 = APOS+int(IW(J1 + JJ1 - 1),8)
592         IF(real(A(JJ2)) .LT. VALSON(JJ1))
593     &         A(JJ2) = VALSON(JJ1)
594      ENDDO
595      RETURN
596      END SUBROUTINE SMUMPS_ASM_MAX
597      SUBROUTINE SMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW, IOLDPS,
598     &           A, LA, POSELT, KEEP, KEEP8,
599     &           ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR,
600     &           LINTARR, LDBLARR, RHS_MUMPS)
601      IMPLICIT NONE
602      INTEGER, intent(in)    :: N, LIW, IOLDPS, INODE
603      INTEGER(8), intent(in) :: LA, POSELT
604      INTEGER(8), intent(in) :: LINTARR, LDBLARR
605      INTEGER, intent(in)    :: IW(LIW)
606      INTEGER, intent(in)    :: KEEP(500)
607      INTEGER(8), intent(in) :: KEEP8(150)
608      INTEGER, intent(inout) :: ITLOC(N+KEEP(253))
609      REAL, intent(inout) :: A(LA)
610      REAL, intent(in)    :: RHS_MUMPS(KEEP(255))
611      REAL, intent(in)    :: DBLARR(LDBLARR)
612      INTEGER, intent(in)    :: INTARR(LINTARR)
613      INTEGER, intent(in)    :: FILS(N)
614      INTEGER(8), intent(in) :: PTRAIW(N), PTRARW(N)
615      INCLUDE 'mumps_headers.h'
616      INTEGER    :: HF, NBROWF, NBCOLF, NASS, NSLAVES
617      INTEGER    :: ILOC, J, K, K1, K2, JPOS, IJROW
618      INTEGER    :: IN
619      INTEGER(8) :: J18, J28, JJ8, JK8
620      INTEGER(8) :: APOS, ICT12
621      INTEGER(8) :: AINPUT8
622      INTEGER    :: K1RHS, K2RHS, JFirstRHS
623      REAL ZERO
624      PARAMETER( ZERO = 0.0E0 )
625      NBCOLF  = IW(IOLDPS+KEEP(IXSZ))
626      NBROWF  = IW(IOLDPS+2+KEEP(IXSZ))
627      NASS    = IW(IOLDPS+1+KEEP(IXSZ))
628      A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = ZERO
629      NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ))
630      HF      = 6 + NSLAVES + KEEP(IXSZ)
631      K1 = IOLDPS + HF + NBROWF
632      K2 = K1 + NASS - 1
633      JPOS = 1
634      DO K = K1, K2
635         J        = IW(K)
636         ITLOC(J) = -JPOS
637         JPOS     = JPOS + 1
638      ENDDO
639      K1 = IOLDPS + HF
640      K2 = K1 + NBROWF - 1
641      JPOS = 1
642      IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN
643           K1RHS = 0
644           K2RHS = -1
645           DO K = K1, K2
646            J        = IW(K)
647            ITLOC(J) = JPOS
648            IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN
649             K1RHS = K
650             JFirstRHS=J-N
651            ENDIF
652            JPOS     = JPOS + 1
653           ENDDO
654           IF (K1RHS.GT.0) K2RHS=K2
655           IF ( K2RHS.GE.K1RHS ) THEN
656             IN = INODE
657             DO WHILE (IN.GT.0)
658               IJROW = -ITLOC(IN)
659               DO K = K1RHS, K2RHS
660                J    = IW(K)
661                ILOC = ITLOC(J)
662                APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) +
663     &                 int(IJROW-1,8)
664                A(APOS) = A(APOS) + RHS_MUMPS(
665     &                    (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN)
666              ENDDO
667              IN = FILS(IN)
668             ENDDO
669            ENDIF
670          ELSE
671           DO K = K1, K2
672            J        = IW(K)
673            ITLOC(J) = JPOS
674            JPOS     = JPOS + 1
675           ENDDO
676      ENDIF
677      IN = INODE
678      DO WHILE (IN.GT.0)
679           AINPUT8 = PTRARW(IN)
680           JK8     = PTRAIW(IN)
681           JJ8     = JK8 + 1_8
682           J18     = JJ8 + 1_8
683           J28 = J18 + INTARR(JK8)
684           IJROW = -ITLOC(INTARR(J18))
685           ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8)
686           DO JJ8= J18,J28
687            ILOC = ITLOC(INTARR(JJ8))
688            IF (ILOC.GT.0) THEN
689              APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8)
690              A(APOS) = A(APOS) + DBLARR(AINPUT8)
691            ENDIF
692            AINPUT8 = AINPUT8 + 1_8
693           ENDDO
694           IN = FILS(IN)
695      ENDDO
696      K1 = IOLDPS + HF
697      K2 = K1 + NBROWF + NASS - 1
698      DO K = K1, K2
699           J = IW(K)
700           ITLOC(J) = 0
701      ENDDO
702      RETURN
703      END SUBROUTINE SMUMPS_ASM_SLAVE_ARROWHEADS
704