OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfac_asm.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, 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 (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 SUBROUTINE dmumps_asm_slave_master(N, INODE, IW, LIW, A, LA,
15 & ISON, NBROWS, NBCOLS, ROWLIST,
16 & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,
17 & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6,
18 & LDA_VALSON )
19 USE dmumps_load
20 IMPLICIT NONE
21 INTEGER KEEP(500)
22 INTEGER(8) KEEP8(150)
23 INTEGER(8) :: LA
24 INTEGER N,LIW,MYID
25 INTEGER INODE,ISON, IWPOSCB
26 INTEGER NBROWS, NBCOLS, LDA_VALSON
27 INTEGER(8) :: PTRAST(KEEP(28))
28 INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)),
29 & ptlust_s(keep(28)), rowlist(nbrows)
30 DOUBLE PRECISION A(LA), VALSON(LDA_VALSON,NBROWS)
31 DOUBLE PRECISION OPASSW
32 LOGICAL, INTENT(IN) :: IS_ofType5or6
33 INTEGER(8) :: POSELT, POSEL1, APOS, JJ2
34 INTEGER HF,HS, NSLAVES, NFRONT, NASS1,
35 & ioldps, istchk, lstk, nslson,nelim,
36 & npivs,ncols,j1,jj,jj1,nrows,
37 & ldafs_pere, ibeg, diag
38 include 'mumps_headers.h'
39 LOGICAL SAME_PROC
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.EQ. IF (KEEP(50)0) THEN
46 LDAFS_PERE = NFRONT
47 ELSE
48.eq. IF ( NSLAVES 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.LT. IF (NPIVS0) NPIVS = 0
64 NCOLS = NPIVS + LSTK
65.LT. SAME_PROC = (ISTCHKIWPOSCB)
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.EQ. IF (KEEP(50)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.LE..and..NOT. IF (ROWLIST(JJ)NASS1IS_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.LT. IF (ROWLIST(JJ)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 DMUMPS_ASM_SLAVE_MASTER
126 SUBROUTINE DMUMPS_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, LRGROUPS)
132 USE DMUMPS_DYNAMIC_MEMORY_M, ONLY : DMUMPS_DM_SET_DYNPTR
133 IMPLICIT NONE
134 INTEGER N,LIW
135 INTEGER(8) :: LA
136 INTEGER KEEP(500), ICNTL(60)
137 INTEGER(8) KEEP8(150)
138 INTEGER INODE, MYID
139 INTEGER NBROWS, NBCOLS
140 INTEGER(8) :: PTRAST(KEEP(28))
141 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
142 & PTRIST(KEEP(28)), FILS(N)
143 INTEGER(8), INTENT(IN) :: PTRARW(N), PTRAIW(N)
144 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
145 DOUBLE PRECISION :: A(LA)
146 INTEGER :: INTARR(KEEP8(27))
147 DOUBLE PRECISION :: DBLARR(KEEP8(26))
148 DOUBLE PRECISION OPASSW, OPELIW
149 INTEGER, INTENT(IN) :: LRGROUPS(N)
150 INTEGER(8) :: POSELT
151 DOUBLE PRECISION, DIMENSION(:), POINTER :: A_PTR
152 INTEGER(8) :: LA_PTR
153 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
154 & K1,K2,K,J,JPOS,NASS
155 DOUBLE PRECISION ZERO
156 PARAMETER( ZERO = 0.0D0 )
157 INCLUDE 'mumps_headers.h'
158 IOLDPS = PTRIST(STEP(INODE))
159 CALL DMUMPS_DM_SET_DYNPTR( IW(IOLDPS+XXS), A, LA,
160 & PTRAST(STEP(INODE)), IW(IOLDPS+XXD), IW(IOLDPS+XXR),
161 & A_PTR, POSELT, LA_PTR )
162 NBCOLF = IW(IOLDPS+KEEP(IXSZ))
163 NBROWF = IW(IOLDPS+2+KEEP(IXSZ))
164 NASS = IW(IOLDPS+1+KEEP(IXSZ))
165 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))
166 HF = 6 + NSLAVES + KEEP(IXSZ)
167.LT. IF (NASS0) THEN
168 NASS = -NASS
169 IW(IOLDPS+1+KEEP(IXSZ)) = NASS
170 CALL DMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW,
171 & IOLDPS, A_PTR(POSELT), LA_PTR, 1_8, KEEP, KEEP8,
172 & ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR,
173 & KEEP8(27), KEEP8(26),
174 & RHS_MUMPS, LRGROUPS)
175 ENDIF
176.GT. IF (NBROWS0) THEN
177 K1 = IOLDPS + HF + NBROWF
178 K2 = K1 + NBCOLF - 1
179 JPOS = 1
180 DO K = K1, K2
181 J = IW(K)
182 ITLOC(J) = JPOS
183 JPOS = JPOS + 1
184 ENDDO
185 ENDIF
186 RETURN
187 END SUBROUTINE DMUMPS_ASM_SLAVE_TO_SLAVE_INIT
188 SUBROUTINE DMUMPS_ASM_SLAVE_TO_SLAVE_END
189 & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST,
190 & ITLOC, RHS_MUMPS, KEEP,KEEP8)
191 IMPLICIT NONE
192 INTEGER N, LIW
193 INTEGER KEEP(500)
194 INTEGER(8) KEEP8(150)
195 INTEGER INODE
196 INTEGER NBROWS
197 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
198 & PTRIST(KEEP(28))
199 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
200 INCLUDE 'mumps_headers.h'
201 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
202 & K1,K2,K,J
203 IOLDPS = PTRIST(STEP(INODE))
204 NBCOLF = IW(IOLDPS+KEEP(IXSZ))
205 NBROWF = IW(IOLDPS+2+KEEP(IXSZ))
206 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))
207 HF = 6 + NSLAVES+KEEP(IXSZ)
208.GT. IF (NBROWS0) THEN
209 K1 = IOLDPS + HF + NBROWF
210 K2 = K1 + NBCOLF - 1
211 DO K = K1, K2
212 J = IW(K)
213 ITLOC(J) = 0
214 ENDDO
215 ENDIF
216 RETURN
217 END SUBROUTINE DMUMPS_ASM_SLAVE_TO_SLAVE_END
218 SUBROUTINE DMUMPS_ASM_SLAVE_TO_SLAVE(N, INODE, IW, LIW, A, LA,
219 & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON,
220 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,
221 & RHS_MUMPS, FILS,
222 & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON)
223 USE DMUMPS_DYNAMIC_MEMORY_M, ONLY: DMUMPS_DM_SET_DYNPTR
224 IMPLICIT NONE
225 INTEGER N,LIW
226 INTEGER(8) :: LA
227 INTEGER KEEP(500), ICNTL(60)
228 INTEGER(8) KEEP8(150)
229 INTEGER INODE, MYID
230 LOGICAL, intent(in) :: IS_ofType5or6
231 INTEGER NBROWS, NBCOLS, LDA_VALSON
232 INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS)
233 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
234 & PTRIST(KEEP(28)), FILS(N)
235 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
236 INTEGER(8) :: PTRAST(KEEP(28))
237 DOUBLE PRECISION A(LA), VALSON(LDA_VALSON,NBROWS)
238 DOUBLE PRECISION OPASSW, OPELIW
239 INTEGER(8) :: POSEL1, POSELT, APOS, K8
240 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
241 & I,J,NASS,IDIAG
242 DOUBLE PRECISION, POINTER, DIMENSION(:) :: A_PTR
243 INTEGER(8) :: LA_PTR
244 INCLUDE 'mumps_headers.h'
245 IOLDPS = PTRIST(STEP(INODE))
246 CALL DMUMPS_DM_SET_DYNPTR( IW(IOLDPS+XXS), A, LA,
247 & PTRAST(STEP(INODE)), IW(IOLDPS+XXD), IW(IOLDPS+XXR),
248 & A_PTR, POSELT, LA_PTR )
249 NBCOLF = IW(IOLDPS+KEEP(IXSZ))
250 NBROWF = IW(IOLDPS+2+KEEP(IXSZ))
251 NASS = IW(IOLDPS+1+KEEP(IXSZ))
252.GT. IF ( NBROWS NBROWF ) THEN
253 WRITE(*,*) ' err: error : nbrows > nbrowf'
254 WRITE(*,*) ' err: inode =', INODE
255 WRITE(*,*) ' err: nbrow=',NBROWS,'nbrowf=',NBROWF
256 WRITE(*,*) ' err: row_list=', ROWLIST
257 WRITE(*,*) ' err: nbcolf/nass=', NBCOLF, NASS
258 CALL MUMPS_ABORT()
259 END IF
260 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))
261 HF = 6 + NSLAVES+KEEP(IXSZ)
262.GT. IF (NBROWS0) THEN
263 POSEL1 = POSELT - int(NBCOLF,8)
264.EQ. IF (KEEP(50)0) THEN
265 IF (IS_ofType5or6) THEN
266 APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8)
267 DO I=1, NBROWS
268 DO J = 1, NBCOLS
269 A_PTR(APOS+int(J-1,8)) = A_PTR( APOS+int(J-1,8)) +
270 & VALSON(J,I)
271 ENDDO
272 APOS = APOS + int(NBCOLF,8)
273 END DO
274 ELSE
275 DO I=1,NBROWS
276 APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8)
277 DO J=1,NBCOLS
278 K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8
279 A_PTR(K8) = A_PTR(K8) + VALSON(J,I)
280 ENDDO
281 ENDDO
282 ENDIF
283 ELSE
284 IF (IS_ofType5or6) THEN
285 APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8)
286 & + int((NBROWS-1),8)*int(NBCOLF,8)
287 IDIAG = 0
288 DO I=NBROWS,1,-1
289 DO J=1,NBCOLS-IDIAG
290 K8 = APOS+int(J-1,8)
291 A_PTR(K8) = A_PTR(K8) + VALSON(J,I)
292 ENDDO
293 APOS = APOS - int(NBCOLF,8)
294 IDIAG = IDIAG + 1
295 ENDDO
296 ELSE
297 DO I=1,NBROWS
298 APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8)
299 DO J=1,NBCOLS
300.EQ. IF (ITLOC(COLLIST(J)) 0) THEN
301 EXIT
302 ENDIF
303 K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8
304 A_PTR(K8) = A_PTR(K8) + VALSON(J,I)
305 ENDDO
306 ENDDO
307 ENDIF
308 ENDIF
309 OPASSW = OPASSW + dble(NBROWS*NBCOLS)
310 ENDIF
311 RETURN
312 END SUBROUTINE DMUMPS_ASM_SLAVE_TO_SLAVE
313 SUBROUTINE DMUMPS_LDLT_ASM_NIV12_IP( A, LA,
314 & IAFATH, NFRONT, NASS1,
315 & IACB, NCOLS, LCB,
316 & IW, NROWS, NELIM, ETATASS,
317 & CB_IS_COMPRESSED )
318 IMPLICIT NONE
319 INTEGER NFRONT, NASS1
320 INTEGER(8) :: LA
321 INTEGER NCOLS, NROWS, NELIM
322 INTEGER(8) :: LCB
323 DOUBLE PRECISION A( LA )
324 INTEGER(8) :: IAFATH, IACB
325 INTEGER IW( NCOLS )
326 INTEGER ETATASS
327 LOGICAL CB_IS_COMPRESSED
328 DOUBLE PRECISION ZERO
329 PARAMETER( ZERO = 0.0D0 )
330 INTEGER I, J
331 INTEGER(8) :: APOS, POSELT
332 INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT
333 LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS,
334 & RISK_OF_SAME_POS_THIS_LINE
335 IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8
336 IPOSCB=1_8
337.LT. RESET_TO_ZERO = IACB IENDFRONT + 1_8
338.EQ. RISK_OF_SAME_POS = IACB + LCB IENDFRONT + 1_8
339 RISK_OF_SAME_POS_THIS_LINE = .FALSE.
340 DO I=1, NROWS
341 POSELT = int(IW(I)-1,8) * int(NFRONT,8)
342.NOT. IF ( CB_IS_COMPRESSED ) THEN
343 IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8)
344.GE. IF (IACB+IPOSCB-1_8 IENDFRONT + 1_8) THEN
345 RESET_TO_ZERO = .FALSE.
346 ENDIF
347 ENDIF
348 IF ( RISK_OF_SAME_POS ) THEN
349.EQ..OR..NOT. IF (INROWS CB_IS_COMPRESSED) THEN
350.EQ. IF ( IAFATH + POSELT + int(IW(I)-1,8)
351 & IACB+IPOSCB+int(I-1-1,8)) THEN
352 RISK_OF_SAME_POS_THIS_LINE = .TRUE.
353 ENDIF
354 ENDIF
355 ENDIF
356 IF (RESET_TO_ZERO) THEN
357 IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN
358 DO J=1, I
359 APOS = POSELT + int(IW( J ),8)
360.NE. IF (IAFATH + APOS - 1_8 IACB+IPOSCB-1_8) THEN
361 A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)
362 A(IACB+IPOSCB-1_8) = ZERO
363 ENDIF
364 IPOSCB = IPOSCB + 1_8
365 ENDDO
366 ELSE
367#if defined(__ve__)
368!NEC$ IVDEP
369#endif
370 DO J=1, I
371 APOS = POSELT + int(IW( J ),8)
372 A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)
373 A(IACB+IPOSCB-1_8) = ZERO
374 IPOSCB = IPOSCB + 1_8
375 ENDDO
376 ENDIF
377 ELSE
378#if defined(__ve__)
379!NEC$ IVDEP
380#endif
381 DO J=1, I
382 APOS = POSELT + int(IW( J ),8)
383 A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)
384 IPOSCB = IPOSCB + 1_8
385 ENDDO
386 ENDIF
387.NOT. IF ( CB_IS_COMPRESSED ) THEN
388 IBEGCBROW = IACB+IPOSCB-1_8
389.LE. IF ( IBEGCBROW IENDFRONT ) THEN
390 A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO
391 ENDIF
392 ENDIF
393.GE. IF (IACB+IPOSCB-1_8 IENDFRONT + 1_8) THEN
394 RESET_TO_ZERO = .FALSE.
395 ENDIF
396 ENDDO
397 RETURN
398 END SUBROUTINE DMUMPS_LDLT_ASM_NIV12_IP
399 SUBROUTINE DMUMPS_LDLT_ASM_NIV12( A, LA, SON_A,
400 & IAFATH, NFRONT, NASS1,
401 & NCOLS, LCB,
402 & IW, NROWS, NELIM, ETATASS,
403 & CB_IS_COMPRESSED
404!$ & , K360
405 & )
406 IMPLICIT NONE
407 INTEGER NFRONT, NASS1
408 INTEGER(8) :: LA
409 INTEGER NCOLS, NROWS, NELIM
410 INTEGER(8) :: LCB
411 DOUBLE PRECISION A( LA )
412 DOUBLE PRECISION SON_A( LCB )
413 INTEGER(8) :: IAFATH
414 INTEGER IW( NCOLS )
415 INTEGER ETATASS
416 LOGICAL CB_IS_COMPRESSED
417!$ INTEGER, INTENT(in):: K360
418 DOUBLE PRECISION ZERO
419 PARAMETER( ZERO = 0.0D0 )
420 INTEGER I, J
421 INTEGER(8) :: APOS, POSELT
422 INTEGER(8) :: IPOSCB
423!$ LOGICAL :: OMP_FLAG
424.EQ..OR..EQ. IF ((ETATASS0) (ETATASS1)) THEN
425 IPOSCB = 1_8
426#if defined(__ve__)
427!NEC$ IVDEP
428#endif
429 DO I = 1, NELIM
430 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
431.NOT. IF ( CB_IS_COMPRESSED) THEN
432 IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8)
433 ENDIF
434#if defined(__ve__)
435!NEC$ IVDEP
436#endif
437 DO J = 1, I
438 APOS = POSELT + int(IW( J ),8)
439 A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8)
440 & + SON_A(IPOSCB)
441 IPOSCB = IPOSCB + 1_8
442 END DO
443 END DO
444 ENDIF
445.EQ..OR..EQ. IF ((ETATASS0)(ETATASS1)) THEN
446.GE.!$ OMP_FLAG = (NROWS-NELIM)K360
447!$OMP PARALLEL DO PRIVATE(IPOSCB, POSELT, J, APOS) IF (OMP_FLAG)
448 DO I = NELIM + 1, NROWS
449 IF (CB_IS_COMPRESSED) THEN
450 IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8
451 ELSE
452 IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8
453 ENDIF
454 POSELT = int(IW( I ),8)
455.LE. IF (POSELT int(NASS1,8)) THEN
456#if defined(__ve__)
457!NEC$ IVDEP
458#endif
459 DO J = 1, NELIM
460 APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8)
461 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) +
462 & SON_A(IPOSCB)
463 IPOSCB = IPOSCB + 1_8
464 END DO
465 ELSE
466 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
467#if defined(__ve__)
468!NEC$ IVDEP
469#endif
470 DO J = 1, NELIM
471 APOS = POSELT + int(IW( J ), 8)
472 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
473 & + SON_A(IPOSCB)
474 IPOSCB = IPOSCB + 1_8
475 END DO
476 ENDIF
477.EQ. IF (ETATASS1) THEN
478 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
479 DO J = NELIM + 1, I
480.GT. IF (IW(J)NASS1) EXIT
481 APOS = POSELT + int(IW( J ), 8)
482 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
483 & + SON_A(IPOSCB)
484 IPOSCB = IPOSCB +1_8
485 END DO
486 ELSE
487 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
488#if defined(__ve__)
489!NEC$ IVDEP
490#endif
491 DO J = NELIM + 1, I
492 APOS = POSELT + int(IW( J ), 8)
493 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
494 & + SON_A(IPOSCB)
495 IPOSCB = IPOSCB + 1_8
496 END DO
497 ENDIF
498 END DO
499!$OMP END PARALLEL DO
500 ELSE
501 DO I= NROWS, NELIM+1, -1
502 IF (CB_IS_COMPRESSED) THEN
503 IPOSCB = (int(I,8)*int(I+1,8))/2_8
504 ELSE
505 IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8)
506 ENDIF
507 POSELT = int(IW( I ),8)
508.LE. IF (POSELTint(NASS1,8)) EXIT
509 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)
510 DO J=I,NELIM+1, -1
511.LE. IF (IW(J)NASS1) EXIT
512 APOS = POSELT + int(IW( J ), 8)
513 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)
514 & + SON_A(IPOSCB)
515 IPOSCB = IPOSCB - 1_8
516 ENDDO
517 ENDDO
518 ENDIF
519 RETURN
520 END SUBROUTINE DMUMPS_LDLT_ASM_NIV12
521 SUBROUTINE DMUMPS_RESTORE_INDICES(N, ISON, INODE, IWPOSCB,
522 & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)
523 IMPLICIT NONE
524 INTEGER N, ISON, INODE, IWPOSCB
525 INTEGER KEEP(500), STEP(N)
526 INTEGER(8) KEEP8(150)
527 INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28))
528 INTEGER LIW
529 INTEGER IW(LIW)
530 INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM
531 INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF
532 INTEGER J1, J2, J3, JJ, JPOS
533 LOGICAL SAME_PROC
534 INCLUDE 'mumps_headers.h'
535 ISTCHK = PIMASTER(STEP(ISON))
536 LSTK = IW(ISTCHK+KEEP(IXSZ))
537 NSLSON = IW(ISTCHK+5+KEEP(IXSZ))
538 HS = 6 + NSLSON + KEEP(IXSZ)
539 NELIM = IW(ISTCHK + 1+KEEP(IXSZ))
540 NPIVS = IW(ISTCHK + 3+KEEP(IXSZ))
541 NCOLS = NPIVS + LSTK
542 IF ( NPIVS < 0 ) NPIVS = 0
543 SAME_PROC = ISTCHK < IWPOSCB
544 IF (SAME_PROC) THEN
545 NROWS = NCOLS
546 ELSE
547 NROWS = IW(ISTCHK+2+KEEP(IXSZ))
548 ENDIF
549 J1 = ISTCHK + NROWS + HS + NPIVS
550.NE. IF (KEEP(50)0) THEN
551 J2 = J1 + LSTK - 1
552 DO JJ = J1, J2
553 IW(JJ) = IW(JJ - NROWS)
554 ENDDO
555 ELSE
556 J2 = J1 + LSTK - 1
557 J3 = J1 + NELIM
558 DO JJ = J3, J2
559 IW(JJ) = IW(JJ - NROWS)
560 ENDDO
561.NE. IF (NELIM 0) THEN
562 IOLDPS = PTLUST_S(STEP(INODE))
563 NFRONT = IW(IOLDPS+KEEP(IXSZ))
564 NSLAVES= IW(IOLDPS+5+KEEP(IXSZ))
565 HF = 6 + NSLAVES+KEEP(IXSZ)
566 ICT11 = IOLDPS + HF - 1 + NFRONT
567 J3 = J3 - 1
568 DO 190 JJ = J1, J3
569 JPOS = IW(JJ) + ICT11
570 IW(JJ) = IW(JPOS)
571 190 CONTINUE
572 ENDIF
573 ENDIF
574 RETURN
575 END SUBROUTINE DMUMPS_RESTORE_INDICES
576 SUBROUTINE DMUMPS_ASM_MAX(
577 & N, INODE, IW, LIW, A, LA,
578 & ISON, NBCOLS,
579 & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,
580 & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 )
581 USE DMUMPS_LOAD
582 IMPLICIT NONE
583 INTEGER KEEP(500)
584 INTEGER(8) KEEP8(150)
585 INTEGER(8) :: LA
586 INTEGER N,LIW,MYID
587 INTEGER INODE,ISON,IWPOSCB
588 INTEGER NBCOLS
589 INTEGER IW(LIW), STEP(N),
590 & PIMASTER(KEEP(28)),
591 & PTLUST_S(KEEP(28))
592 INTEGER(8) PTRAST(KEEP(28))
593 DOUBLE PRECISION A(LA)
594 DOUBLE PRECISION VALSON(NBCOLS)
595 DOUBLE PRECISION OPASSW
596 INTEGER HF,HS, NSLAVES, NASS1,
597 & IOLDPS, ISTCHK,
598 & LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1,
599 & JJ1,NROWS
600 INTEGER(8) POSELT, APOS, JJ2
601 INCLUDE 'mumps_headers.h'
602 LOGICAL SAME_PROC
603 INTRINSIC real
604 IOLDPS = PTLUST_S(STEP(INODE))
605 POSELT = PTRAST(STEP(INODE))
606 NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ)))
607 NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ))
608 HF = 6 + NSLAVES + KEEP(IXSZ)
609 ISTCHK = PIMASTER(STEP(ISON))
610 LSTK = IW(ISTCHK + KEEP(IXSZ))
611 NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ))
612 HS = 6 + NSLSON + KEEP(IXSZ)
613 NELIM = IW(ISTCHK + 1 + KEEP(IXSZ))
614 NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ))
615.LT. IF (NPIVS0) NPIVS = 0
616 NCOLS = NPIVS + LSTK
617.LT. SAME_PROC = (ISTCHKIWPOSCB)
618 IF (SAME_PROC) THEN
619 NROWS = NCOLS
620 ELSE
621 NROWS = IW(ISTCHK+2 + KEEP(IXSZ))
622 ENDIF
623 J1 = ISTCHK + NROWS + HS + NPIVS
624 APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8
625 DO JJ1 = 1, NBCOLS
626 JJ2 = APOS+int(IW(J1 + JJ1 - 1),8)
627.LT. IF(dble(A(JJ2)) VALSON(JJ1)) THEN
628 A(JJ2) = VALSON(JJ1)
629 ENDIF
630 ENDDO
631 RETURN
632 END SUBROUTINE DMUMPS_ASM_MAX
633 SUBROUTINE DMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW, IOLDPS,
634 & A, LA, POSELT, KEEP, KEEP8,
635 & ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR,
636 & LINTARR, LDBLARR, RHS_MUMPS, LRGROUPS)
637!$ USE OMP_LIB
638 USE DMUMPS_ANA_LR, ONLY : GET_CUT
639 USE DMUMPS_LR_CORE, ONLY : MAX_CLUSTER
640 USE MUMPS_LR_COMMON, ONLY : COMPUTE_BLR_VCS
641 IMPLICIT NONE
642 INTEGER, intent(in) :: N, LIW, IOLDPS, INODE
643 INTEGER(8), intent(in) :: LA, POSELT
644 INTEGER(8), intent(in) :: LINTARR, LDBLARR
645 INTEGER, intent(in) :: IW(LIW)
646 INTEGER, intent(in) :: KEEP(500)
647 INTEGER(8), intent(in) :: KEEP8(150)
648 INTEGER, intent(inout) :: ITLOC(N+KEEP(253))
649 DOUBLE PRECISION, intent(inout) :: A(LA)
650 DOUBLE PRECISION, intent(in) :: RHS_MUMPS(KEEP(255))
651 DOUBLE PRECISION, intent(in) :: DBLARR(LDBLARR)
652 INTEGER, intent(in) :: INTARR(LINTARR)
653 INTEGER, intent(in) :: FILS(N)
654 INTEGER(8), intent(in) :: PTRAIW(N), PTRARW(N)
655 INTEGER, INTENT(IN) :: LRGROUPS(N)
656!$ INTEGER :: NOMP
657!$ INTEGER(8) :: CHUNK8
658!$ INTEGER :: CHUNK
659 INCLUDE 'mumps_headers.h'
660 INTEGER :: HF, NBROWF, NBCOLF, NASS, NSLAVES
661 INTEGER :: ILOC, J, K, K1, K2, JPOS, IJROW
662 INTEGER :: IN
663 INTEGER(8) :: J18, J28, JJ8, JK8
664 INTEGER(8) :: APOS, ICT12
665 INTEGER(8) :: AINPUT8
666 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_LS
667 INTEGER :: NB_BLR_LS, NPARTSCB, NPARTSASS, MAXI_CLUSTER,
668 & IBCKSZ2, MINSIZE, TOPDIAG
669 INTEGER(8) :: JJ3
670 INTEGER :: K1RHS, K2RHS, JFirstRHS
671 DOUBLE PRECISION ZERO
672 PARAMETER( ZERO = 0.0D0 )
673 NBCOLF = IW(IOLDPS+KEEP(IXSZ))
674 NBROWF = IW(IOLDPS+2+KEEP(IXSZ))
675 NASS = IW(IOLDPS+1+KEEP(IXSZ))
676 NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ))
677 HF = 6 + NSLAVES + KEEP(IXSZ)
678!$ NOMP = OMP_GET_MAX_THREADS()
679.EQ..OR..LT. IF (KEEP(50) 0 NBROWF KEEP(63)) THEN
680!$ CHUNK8 = int(KEEP(361),8)
681!$OMP PARALLEL DO PRIVATE(JJ8) SCHEDULE(STATIC, CHUNK8)
682!$OMP& IF (int(NBROWF,8)*int(NBCOLF,8) > int(KEEP(361),8)
683.AND..GT.!$OMP& NOMP 1)
684 DO JJ8=POSELT, POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8
685 A(JJ8) = ZERO
686 ENDDO
687!$OMP END PARALLEL DO
688 ELSE
689 TOPDIAG = 0
690.GE. IF (IW(IOLDPS+XXLR)1) THEN
691 CALL GET_CUT(IW(IOLDPS+HF:IOLDPS+HF+NBROWF-1), 0,
692 & NBROWF, LRGROUPS, NPARTSCB,
693 & NPARTSASS, BEGS_BLR_LS)
694 NB_BLR_LS = NPARTSCB
695 call MAX_CLUSTER(BEGS_BLR_LS,NB_BLR_LS+1,MAXI_CLUSTER)
696 DEALLOCATE(BEGS_BLR_LS)
697 CALL COMPUTE_BLR_VCS(KEEP(472), IBCKSZ2, KEEP(488), NASS)
698 MINSIZE = int(IBCKSZ2 / 2)
699 TOPDIAG = max(2*MINSIZE + MAXI_CLUSTER-1, TOPDIAG)
700 ENDIF
701!$ CHUNK = max( KEEP(360)/2,
702!$ & ((NBROWF+NOMP-1)/NOMP +2) / 3 )
703!$OMP PARALLEL DO PRIVATE(APOS,JJ3,JJ8) SCHEDULE(STATIC,CHUNK)
704.GT..AND..GT.!$OMP& IF (NBROWF KEEP(360) NOMP 1)
705 DO JJ8 = 0_8, int(NBROWF-1,8)
706 APOS = POSELT+ JJ8*int(NBCOLF,8)
707 JJ3 = min( int(NBCOLF,8) - 1_8,
708 & JJ8 + int(NBCOLF-NBROWF,8) + TOPDIAG )
709 A(APOS: APOS+JJ3) = ZERO
710 ENDDO
711!$OMP END PARALLEL DO
712 ENDIF
713 K1 = IOLDPS + HF + NBROWF
714 K2 = K1 + NASS - 1
715 JPOS = 1
716 DO K = K1, K2
717 J = IW(K)
718 ITLOC(J) = -JPOS
719 JPOS = JPOS + 1
720 ENDDO
721 K1 = IOLDPS + HF
722 K2 = K1 + NBROWF - 1
723 JPOS = 1
724.GT..AND..NE. IF ((KEEP(253)0)(KEEP(50)0)) THEN
725 K1RHS = 0
726 K2RHS = -1
727 DO K = K1, K2
728 J = IW(K)
729 ITLOC(J) = JPOS
730.EQ..AND..GT. IF ((K1RHS0)(JN)) THEN
731 K1RHS = K
732 JFirstRHS=J-N
733 ENDIF
734 JPOS = JPOS + 1
735 ENDDO
736.GT. IF (K1RHS0) K2RHS=K2
737.GE. IF ( K2RHSK1RHS ) THEN
738 IN = INODE
739.GT. DO WHILE (IN0)
740 IJROW = -ITLOC(IN)
741 DO K = K1RHS, K2RHS
742 J = IW(K)
743 ILOC = ITLOC(J)
744 APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) +
745 & int(IJROW-1,8)
746 A(APOS) = A(APOS) + RHS_MUMPS(
747 & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN)
748 ENDDO
749 IN = FILS(IN)
750 ENDDO
751 ENDIF
752 ELSE
753 DO K = K1, K2
754 J = IW(K)
755 ITLOC(J) = JPOS
756 JPOS = JPOS + 1
757 ENDDO
758 ENDIF
759 IN = INODE
760.GT. DO WHILE (IN0)
761 AINPUT8 = PTRARW(IN)
762 JK8 = PTRAIW(IN)
763 JJ8 = JK8 + 1_8
764 J18 = JJ8 + 1_8
765 J28 = J18 + INTARR(JK8)
766 IJROW = -ITLOC(INTARR(J18))
767 ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8)
768 DO JJ8= J18,J28
769 ILOC = ITLOC(INTARR(JJ8))
770.GT. IF (ILOC0) THEN
771 APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8)
772 A(APOS) = A(APOS) + DBLARR(AINPUT8)
773 ENDIF
774 AINPUT8 = AINPUT8 + 1_8
775 ENDDO
776 IN = FILS(IN)
777 ENDDO
778 K1 = IOLDPS + HF
779 K2 = K1 + NBROWF + NASS - 1
780 DO K = K1, K2
781 J = IW(K)
782 ITLOC(J) = 0
783 ENDDO
784 RETURN
785 END SUBROUTINE DMUMPS_ASM_SLAVE_ARROWHEADS
786 SUBROUTINE DMUMPS_SET_PARPIVT1 ( INODE, NFRONT, NASS1, KEEP,
787 & LR_ACTIVATED, PARPIV_T1)
788 IMPLICIT NONE
789 INTEGER, intent(in) :: INODE, NFRONT, NASS1, KEEP(500)
790 LOGICAL, intent(in) :: LR_ACTIVATED
791 INTEGER, intent(out) :: PARPIV_T1
792 INTEGER :: NCB
793 LOGICAL, EXTERNAL :: DMUMPS_IS_TRSM_LARGE_ENOUGH,
794 & DMUMPS_IS_GEMM_LARGE_ENOUGH
795 PARPIV_T1 = KEEP(269)
796.EQ. IF (PARPIV_T1-3) THEN
797 PARPIV_T1 = 0
798 ENDIF
799.EQ. IF (PARPIV_T177) THEN
800 PARPIV_T1 = 0
801 ENDIF
802.EQ. IF (PARPIV_T10) RETURN
803.EQ..AND. IF ( (PARPIV_T1-2)LR_ACTIVATED ) THEN
804 PARPIV_T1 = 1
805 ENDIF
806 NCB = NFRONT-NASS1
807.EQ. IF (PARPIV_T1-2) THEN
808 IF (
809 & ( DMUMPS_IS_TRSM_LARGE_ENOUGH ( NASS1, NCB
810 & )
811 & )
812.OR. &
813 & ( DMUMPS_IS_GEMM_LARGE_ENOUGH ( NCB, NCB, NASS1
814 & )
815 & )
816 & ) THEN
817 PARPIV_T1 = 1
818 ELSE
819 PARPIV_T1 = 0
820 ENDIF
821 ENDIF
822.EQ. IF (NCBKEEP(253)) THEN
823 PARPIV_T1 = 0
824 ENDIF
825 RETURN
826 END SUBROUTINE DMUMPS_SET_PARPIVT1
827 LOGICAL FUNCTION DMUMPS_IS_TRSM_LARGE_ENOUGH
828 & ( M, N
829 & )
830 IMPLICIT NONE
831 INTEGER, INTENT(in) :: M, N
832 DOUBLE PRECISION :: AI
833 INTEGER, PARAMETER :: THRES_AI = 400
834 AI = ( dble(M)*dble(N) ) /
835 & ( dble(M)/dble(2) + dble(2)*dble(N) )
836.GE. DMUMPS_IS_TRSM_LARGE_ENOUGH = (AIdble(THRES_AI))
837 RETURN
838 END FUNCTION DMUMPS_IS_TRSM_LARGE_ENOUGH
839 LOGICAL FUNCTION DMUMPS_IS_GEMM_LARGE_ENOUGH
840 & ( M, N, K
841 & )
842 IMPLICIT NONE
843 INTEGER, INTENT(in) :: M, N, K
844 DOUBLE PRECISION :: AI
845 INTEGER, PARAMETER :: THRES_AI = 400
846 AI = ( dble(2)*dble(M)*dble(N)*dble(K) ) /
847 & ( dble(M)*dble(N) + dble(M)*dble(K) + dble(K)*dble(N) )
848.GE. DMUMPS_IS_GEMM_LARGE_ENOUGH = (AIdble(THRES_AI))
849 RETURN
850 END FUNCTION DMUMPS_IS_GEMM_LARGE_ENOUGH
851 SUBROUTINE DMUMPS_PARPIVT1_SET_MAX ( INODE,
852 & A, LAELL8, KEEP, NFRONT,
853 & NASS1, NVSCHUR_K253, NB_POSTPONED)
854 IMPLICIT NONE
855 INTEGER(8), intent(in) :: LAELL8
856 INTEGER, intent(in) :: INODE
857 INTEGER, intent(in) :: KEEP(500), NFRONT, NASS1,
858 & NVSCHUR_K253
859 INTEGER, intent(in) :: NB_POSTPONED
860 DOUBLE PRECISION, intent(inout) :: A(LAELL8)
861 INTEGER(8) :: APOSMAX, APOS, NASS1_8, NFRONT_8
862 INTEGER :: I, J, NCB
863 DOUBLE PRECISION :: ZERO
864 DOUBLE PRECISION :: RMAX
865 PARAMETER( ZERO = 0.0D0 )
866 NASS1_8 = int(NASS1, 8)
867 NFRONT_8 = int(NFRONT, 8)
868 NCB = NFRONT-NASS1-NVSCHUR_K253
869.EQ..AND..EQ. IF ((NCB0)(NVSCHUR_K2530)) CALL MUMPS_ABORT()
870 APOSMAX = LAELL8 - NASS1_8 + 1_8
871 A(APOSMAX:APOSMAX+NASS1_8-1_8)= ZERO
872.EQ. IF (NCB0) RETURN
873.EQ. IF (KEEP(50)2) THEN
874 APOS = 1_8 + (NASS1_8*NFRONT_8)
875 DO I = 1, NCB
876 DO J = 1, NASS1
877 RMAX = dble(A(APOSMAX+int(J,8)-1_8))
878 RMAX = max(RMAX, abs(A(APOS+int(J,8)-1_8)))
879 A(APOSMAX+int(J,8)-1_8) = RMAX
880 ENDDO
881 APOS = APOS+NFRONT_8
882 ENDDO
883 ELSE
884 APOS = 1_8 + NASS1_8
885 DO I = 1, NASS1
886 RMAX = dble(A(APOSMAX+int(I,8)-1_8))
887 DO J = 1, NCB
888 RMAX = max(RMAX, abs(A(APOS+int(J,8)-1)))
889 ENDDO
890 A(APOSMAX+int(I,8)-1_8) = RMAX
891 APOS = APOS+NFRONT_8
892 ENDDO
893 ENDIF
894 CALL DMUMPS_UPDATE_PARPIV_ENTRIES ( INODE,
895 & KEEP, A(APOSMAX), NASS1, NB_POSTPONED)
896 RETURN
897 END SUBROUTINE DMUMPS_PARPIVT1_SET_MAX
898 SUBROUTINE DMUMPS_UPDATE_PARPIV_ENTRIES ( INODE,
899 & KEEP, PARPIV, LPARPIV,
900 & NB_POSTPONED)
901 IMPLICIT NONE
902 INTEGER, intent(in) :: INODE, LPARPIV, KEEP(500)
903 DOUBLE PRECISION, intent(inout):: PARPIV(LPARPIV)
904 INTEGER, intent(in) :: NB_POSTPONED
905 INTEGER :: I
906 DOUBLE PRECISION :: EPS, RMIN, RZERO, RTMP
907 DOUBLE PRECISION :: RMAX
908 LOGICAL :: UPDATE_PARPIV
909 PARAMETER( RZERO = 0.0D0 )
910 UPDATE_PARPIV=.FALSE.
911 RMIN = huge(RZERO)
912 RMAX = RZERO
913 EPS = sqrt(epsilon(RZERO))*0.01D0
914 DO I = 1, LPARPIV
915 RTMP = dble(PARPIV(I))
916.GT. IF (RTMPRZERO) THEN
917 RMIN = min(RMIN, RTMP)
918 ELSE
919 UPDATE_PARPIV=.TRUE.
920 ENDIF
921.LE. IF (RTMPEPS) UPDATE_PARPIV=.TRUE.
922 RMAX= max(RMAX,dble(PARPIV(I)))
923 ENDDO
924 IF (UPDATE_PARPIV) THEN
925.LT. IF (RMINhuge(RMIN)) THEN
926 RMAX= min (RMAX, EPS)
927 DO I = 1, LPARPIV-NB_POSTPONED
928 RTMP = dble(PARPIV(I))
929.LE. IF (RTMPEPS) THEN
930 PARPIV(I) = -RMAX
931 ENDIF
932 ENDDO
933.GT. IF (NB_POSTPONED0) THEN
934 DO I=LPARPIV-NB_POSTPONED+1, LPARPIV
935 RTMP = dble(PARPIV(I))
936.LE. IF (RTMPEPS) THEN
937 PARPIV(I) = -RMAX
938 ENDIF
939 ENDDO
940 ENDIF
941 ENDIF
942 ENDIF
943 RETURN
944 END SUBROUTINE DMUMPS_UPDATE_PARPIV_ENTRIES
945 SUBROUTINE DMUMPS_PARPIVT1_SET_NVSCHUR_MAX
946 & (N, INODE, IW, LIW, A, LA, KEEP, PERM,
947 & IOLDPS, POSELT,
948 & NFRONT, NASS1, LR_ACTIVATED, PARPIV_T1,
949 & NB_POSTPONED)
950 USE DMUMPS_FAC_FRONT_AUX_M, ONLY: DMUMPS_GET_SIZE_SCHUR_IN_FRONT
951 IMPLICIT NONE
952 INTEGER, intent(in) :: N, INODE, LIW, IOLDPS,
953 & NFRONT, NASS1, NB_POSTPONED
954 INTEGER(8), intent(in) :: LA, POSELT
955 INTEGER, intent(in) :: IW (LIW), PERM(N), KEEP(500)
956 LOGICAL, intent(in) :: LR_ACTIVATED
957 DOUBLE PRECISION, intent(inout) :: A(LA)
958 INTEGER, intent(inout) :: PARPIV_T1
959 INTEGER :: NVSCHUR_K253, IROW_L
960 INTEGER(8) :: LAELL8, NFRONT8
961 INCLUDE 'mumps_headers.h'
962.EQ. IF (PARPIV_T1-999) THEN
963 CALL DMUMPS_SET_PARPIVT1 ( INODE, NFRONT, NASS1, KEEP,
964 & LR_ACTIVATED, PARPIV_T1)
965.NE..AND..NE. ELSE IF ((PARPIV_T10PARPIV_T11)) THEN
966 PARPIV_T1 = 0
967 ENDIF
968.NE. IF (PARPIV_T10) THEN
969.EQ..AND..GT. IF ((KEEP(114)1) (KEEP(116)0) ) THEN
970 IROW_L = IOLDPS+6+KEEP(IXSZ)+NASS1
971 CALL DMUMPS_GET_SIZE_SCHUR_IN_FRONT (
972 & N,
973 & NFRONT-NASS1,
974 & KEEP(116),
975 & IW(IROW_L), PERM,
976 & NVSCHUR_K253 )
977 ELSE
978 NVSCHUR_K253 = KEEP(253)
979 ENDIF
980 NFRONT8 = int(NFRONT,8)
981 LAELL8 = NFRONT8 * NFRONT8 + int(NASS1,8)
982 CALL DMUMPS_PARPIVT1_SET_MAX ( INODE,
983 & A(POSELT), LAELL8, KEEP,
984 & NFRONT, NASS1, NVSCHUR_K253,
985 & NB_POSTPONED )
986 ENDIF
987 RETURN
988 END SUBROUTINE DMUMPS_PARPIVT1_SET_NVSCHUR_MAX
dmumps_asm_slave_master
subroutine dmumps_asm_slave_master(n, inode, iw, liw, a, la, ison, nbrows, nbcols, rowlist, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8, is_oftype5or6, lda_valson)
Definition dfac_asm.F:19
dmumps_load
Definition dmumps_load.F:14