OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dana_aux_ELT.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_ana_f_elt(N, NELT, ELTPTR, ELTVAR, LIW,
15 & IKEEP,
16 & IORD, NFSIZ, FILS, FRERE,
17 & LISTVAR_SCHUR, SIZE_SCHUR,
18 & ICNTL, INFO, KEEP,KEEP8,
19 & NSLAVES,
20 & XNODEL, NODEL
21#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
22 & , metis_options
23#endif
24 & )
25 USE mumps_ana_ord_wrappers
26 IMPLICIT NONE
27 INTEGER, INTENT(IN) :: N, NELT, SIZE_SCHUR, NSLAVES, LIW
28 INTEGER, INTENT(IN) :: ELTPTR(NELT+1)
29 INTEGER, INTENT(IN) :: ELTVAR(ELTPTR(NELT+1)-1)
30 INTEGER, INTENT(IN) :: LISTVAR_SCHUR(SIZE_SCHUR)
31 INTEGER, INTENT(IN) :: ICNTL(60)
32 INTEGER, INTENT(INOUT) :: IORD
33 INTEGER, INTENT(INOUT) :: IKEEP(N,3)
34 INTEGER, INTENT(INOUT) :: INFO(80), KEEP(500)
35 INTEGER(8), INTENT(INOUT) :: KEEP8(150)
36 INTEGER, INTENT(OUT) :: NFSIZ(N), FILS(N), FRERE(N)
37 INTEGER, INTENT(OUT) :: XNODEL(N+1), NODEL(ELTPTR(NELT+1)-1)
38#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
39 INTEGER, INTENT(IN) :: METIS_OPTIONS(40)
40#endif
41 INTEGER K,I,L1,L2,NCMPA,IFSON,IN
42 INTEGER NEMIN, MPRINT, LP, MP, LDIAG
43 INTEGER(8) :: NZ8, LLIW8, IWFR8
44 INTEGER allocok, ITEMP
45 LOGICAL PROK, NOSUPERVAR, LPOK
46 INTEGER(8) :: K79REF
47 PARAMETER(K79REF=12000000_8)
48 LOGICAL SPLITROOT
49 INTEGER, PARAMETER :: LIDUMMY = 1
50 INTEGER :: IDUMMY(1)
51 INTEGER, DIMENSION(:), ALLOCATABLE :: IW
52 INTEGER, DIMENSION(:), ALLOCATABLE :: IW2
53 INTEGER, DIMENSION(:), ALLOCATABLE :: PARENT
54 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWtemp
55 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPE8
56#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
57#if defined(metis4) || defined(parmetis3)
58 INTEGER :: NUMFLAG
59#else
60 INTEGER, DIMENSION(:), ALLOCATABLE :: NUMFLAG
61#endif
62 INTEGER :: OPT_METIS_SIZE, METIS_IDX_SIZE
63 INTEGER :: IERR
64#endif
65 INTEGER IDUM
66 EXTERNAL DMUMPS_ANA_G11_ELT, DMUMPS_ANA_G12_ELT,
67 & dmumps_ana_g1_elt, dmumps_ana_g2_elt,
68 & dmumps_ana_g2_eltnew,
69 & dmumps_ana_j1_elt, dmumps_ana_j2_elt,
70 & dmumps_ana_k,
71 & dmumps_ana_lnew, dmumps_ana_m,
72 & mumps_amd_elt
73#if defined(OLDDFS)
74 EXTERNAL dmumps_ana_l
75#endif
76 ALLOCATE( iw( liw ), stat = allocok )
77 IF ( allocok .GT. 0 ) THEN
78 info( 1 ) = -7
79 info( 2 ) = liw
80 GOTO 90
81 ENDIF
82 ALLOCATE( ipe8( n + 1 ), stat = allocok )
83 IF ( allocok .GT. 0 ) THEN
84 info( 1 ) = -7
85 info( 2 ) = (n+1)*keep(10)
86 GOTO 90
87 ENDIF
88 ALLOCATE( parent(n), iwtemp( n, 3 ), stat = allocok )
89 IF ( allocok .GT. 0 ) THEN
90 info( 1 ) = -7
91 info( 2 ) = 4*n
92 GOTO 90
93 ENDIF
94 mprint= icntl(3)
95 lp = icntl(1)
96 lpok = ((lp.GT.0).AND.(icntl(4).GE.1))
97 mp = icntl(3)
98 prok = ((mp.GT.0).AND.(icntl(4).GE.2))
99 ldiag = icntl(4)
100 IF (keep(60).NE.0) THEN
101 nosupervar=.true.
102 IF (iord.GT.1) iord = 0
103 ELSE
104 nosupervar=.false.
105 ENDIF
106 IF (iord == 7) THEN
107 IF ( n < 10000 ) THEN
108 iord = 0
109 ELSE
110#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
111 iord = 5
112#else
113 iord = 0
114#endif
115 ENDIF
116 END IF
117#if ! defined(metis) && ! defined(parmetis) && ! defined(metis4) && ! defined(parmetis3)
118 IF (iord == 5) iord = 0
119#endif
120 IF (keep(1).LT.1) keep(1) = 1
121 nemin = keep(1)
122 IF (ldiag.LE.2 .OR. mp.LE.0) GO TO 10
123 WRITE (mp,99999) n, nelt, liw, info(1)
124 k = min0(10,nelt+1)
125 IF (ldiag.EQ.4) k = nelt+1
126 IF (k.GT.0) WRITE (mp,99998) (eltptr(i),i=1,k)
127 k = min0(10,eltptr(nelt+1)-1)
128 IF (ldiag.EQ.4) k = eltptr(nelt+1)-1
129 IF (k.GT.0) WRITE (mp,99995) (eltvar(i),i=1,k)
130 k = min0(10,n)
131 IF (ldiag.EQ.4) k = n
132 IF (iord.EQ.1 .AND. k.GT.0) THEN
133 WRITE (mp,99997) (ikeep(i,1),i=1,k)
134 ENDIF
135 10 l1 = 1
136 l2 = l1 + n
137 IF (liw .LT. 3*n) THEN
138 info(1) = -2002
139 info(2) = liw
140 ENDIF
141#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
142 IF ( iord == 5 ) THEN
143 IF (liw .LT. n+n+1) THEN
144 info(1)= -2002
145 info(2) = liw
146 GOTO 90
147 ENDIF
148 ELSE
149#endif
150 IF (nosupervar) THEN
151 IF ( liw .LT. 2*n ) THEN
152 info(1)= -2002
153 info(2) = liw
154 GOTO 90
155 END IF
156 ELSE
157 IF ( liw .LT. 4*n+4 ) THEN
158 info(1)= -2002
159 info(2) = liw
160 GOTO 90
161 END IF
162 ENDIF
163#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
164 ENDIF
165#endif
166 idum=0
167 CALL dmumps_nodel(nelt, n, eltptr(nelt+1)-1, eltptr, eltvar,
168 & xnodel, nodel, iw(l1), idum, icntl)
169 IF (iord.NE.1 .AND. iord .NE. 5) THEN
170 iord = 0
171 IF (nosupervar) THEN
172 CALL dmumps_ana_g1_elt(n, nz8, nelt, eltptr(nelt+1)-1,
173 & eltptr, eltvar, xnodel, nodel,
174 & iwtemp(1,2), iw(l1))
175 ELSE
176 CALL dmumps_ana_g11_elt(n, nz8, nelt, eltptr(nelt+1)-1,
177 & eltptr, eltvar, xnodel, nodel,
178 & iwtemp(1,2), 4*n+4, iw(l1))
179 ENDIF
180 lliw8 = max(nz8,int(n,8))
181 ALLOCATE( iw2(lliw8), stat = allocok )
182 IF (allocok.GT.0) THEN
183 info(1) = -7
184 CALL mumps_set_ierror(lliw8, info(2))
185 GOTO 90
186 ENDIF
187 IF (nosupervar) THEN
188 CALL dmumps_ana_g2_elt(n, nelt, eltptr(nelt+1)-1,
189 & eltptr, eltvar, xnodel, nodel,
190 & iw2, lliw8, ipe8, iwtemp(1,2),
191 & iw(l1), iwfr8)
192 ELSE
193 CALL dmumps_ana_g12_elt(n, nelt, eltptr(nelt+1)-1,
194 & eltptr, eltvar, xnodel, nodel,
195 & iw2, lliw8, ipe8, iwtemp(1,2),
196 & iw(l1), iwfr8)
197 ENDIF
198 IF (nosupervar) THEN
199 CALL mumps_hamd(n, lliw8, ipe8, iwfr8, iwtemp(1,2), iw2,
200 & iw(l1), ikeep,
201 & ikeep(1,2), ncmpa, fils, ikeep(1,3), iw(l2), iwtemp(1,3),
202 & iwtemp,
203 & listvar_schur, size_schur)
204 IF (keep(60) == 1) THEN
205 keep(20) = listvar_schur(1)
206 ELSEIF (keep(60) == 2 .OR. keep(60) == 3 ) THEN
207 keep(38) = listvar_schur(1)
208 ELSE
209 WRITE(*,*) "Internal error in DMUMPS_ANA_F_ELT",keep(60)
210 CALL mumps_abort()
211 ENDIF
212 ELSE
213 CALL mumps_amd_elt(n, lliw8, ipe8, iwfr8, iwtemp(1,2), iw2,
214 & iw(l1), ikeep,
215 & ikeep(1,2), ncmpa, fils, ikeep(1,3), iw(l2), iwtemp(1,3),
216 & iwtemp)
217 ENDIF
218 ELSE
219#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
220 IF (iord.EQ.5) THEN
221 IF (prok) THEN
222 WRITE(mprint,'(A)') ' Ordering based on METIS'
223 ENDIF
224 CALL dmumps_ana_g1_elt(n, nz8, nelt, eltptr(nelt+1)-1,
225 & eltptr, eltvar, xnodel, nodel,
226 & iwtemp(1,2), iw(l1))
227 lliw8 = max(nz8,int(n,8))
228 ALLOCATE( iw2(lliw8), stat = allocok )
229 IF (allocok.GT.0) THEN
230 info(1) = -7
231 CALL mumps_set_ierror(lliw8, info(2))
232 GOTO 90
233 ENDIF
234 CALL dmumps_ana_g2_eltnew(n, nelt, eltptr(nelt+1)-1,
235 & eltptr, eltvar, xnodel, nodel,
236 & iw2, lliw8, ipe8, iwtemp(1,2),
237 & iw(l1), iwfr8)
238#if defined(metis4) || defined(parmetis3)
239 numflag = 1
240 opt_metis_size = 8
241#else
242 ALLOCATE( numflag( n ), stat = ierr )
243 IF ( ierr .GT. 0 ) THEN
244 info( 1 ) = -7
245 info( 2 ) = n
246 GOTO 90
247 ENDIF
248 DO i=1,n
249 numflag(i) = 1
250 ENDDO
251 opt_metis_size = 40
252#endif
253 CALL mumps_metis_idxsize(metis_idx_size)
254 IF (keep(10).EQ.1.AND.metis_idx_size.NE.64) THEN
255 info(1) = -52
256 info(2) = 1
257 GOTO 90
258 ENDIF
259 IF (metis_idx_size .EQ. 32) THEN
260 CALL mumps_metis_nodend_mixedto32(n, ipe8, iw2,
261#if defined(metis4) || defined(parmetis3)
262 & numflag,
263#else
264 & numflag,
265#endif
266 & metis_options(1), opt_metis_size,
267 & ikeep(1:n,2), ikeep(1:n,1), info(1), lp, lpok)
268 ELSE IF (metis_idx_size .EQ. 64) THEN
269 CALL mumps_metis_nodend_mixedto64(n, ipe8, iw2,
270#if defined(metis4) || defined(parmetis3)
271 & numflag,
272#else
273 & numflag,
274#endif
275 & metis_options(1), opt_metis_size,
276 & ikeep(1:n,2), ikeep(1:n,1), info(1),
277 & lp, lpok, keep(10),
278 & lliw8, .false., .true. )
279 ELSE
280 WRITE(*,*)
281 & "Internal error in METIS wrappers, METIS_IDX_SIZE=",
282 & metis_idx_size
283 CALL mumps_abort()
284 ENDIF
285 IF (info(1) .LT. 0) GOTO 90
286 DEALLOCATE(iw2)
287 ELSE IF (iord.NE.1) THEN
288 WRITE(*,*) iord
289 WRITE(*,*) 'bad option for ordering'
290 CALL mumps_abort()
291 ENDIF
292#endif
293 DO k=1,n
294 iw(l1+k) = 0
295 ENDDO
296 DO k=1,n
297 IF ((ikeep(k,1).LE.0).OR.(ikeep(k,1).GT.n))
298 & GO TO 40
299 IF (iw(l1+ikeep(k,1)).EQ.1) THEN
300 GOTO 40
301 ELSE
302 iw(l1+ikeep(k,1)) = 1
303 ENDIF
304 ENDDO
305 CALL dmumps_ana_j1_elt(n, nz8, nelt, eltptr(nelt+1)-1,
306 & eltptr, eltvar, xnodel, nodel,
307 & ikeep, iwtemp(1,2), iw(l1))
308 lliw8 = nz8+int(n,8)
309 ALLOCATE( iw2(lliw8), stat = allocok )
310 IF (allocok.GT.0) THEN
311 info(1) = -7
312 CALL mumps_set_ierror(lliw8,info(2))
313 GOTO 90
314 ENDIF
315 CALL dmumps_ana_j2_elt(n, nelt, eltptr(nelt+1)-1,
316 & eltptr, eltvar, xnodel, nodel,
317 & ikeep, iw2, lliw8, ipe8, iwtemp(1,2),
318 & iw(l1), iwfr8)
319 IF (keep(60) == 0) THEN
320 itemp = 0
321 ELSE
322 itemp = size_schur
323 IF (keep(60) == 1) THEN
324 keep(20) = listvar_schur(1)
325 ELSEIF (keep(60) == 2 .OR. keep(60) == 3 ) THEN
326 keep(38) = listvar_schur(1)
327 ELSE
328 WRITE(*,*) "Internal error in DMUMPS_ANA_F_ELT",keep(60)
329 CALL mumps_abort()
330 ENDIF
331 ENDIF
332 CALL dmumps_ana_k(n, ipe8, iw2, lliw8, iwfr8, ikeep,
333 & ikeep(1,2), iw(l1),
334 & iw(l2), ncmpa, itemp, iwtemp)
335 ENDIF
336#if defined(OLDDFS)
337 CALL dmumps_ana_l(n, iwtemp, iw(l1), ikeep, ikeep(1,2),
338 & ikeep(1,3),
339 & nfsiz, info(6), fils, frere, iwtemp(1,3), nemin, keep(60))
340#else
341 CALL dmumps_ana_lnew(n, iwtemp, iw(l1), ikeep, ikeep(1,2),
342 & ikeep(1,3),
343 & nfsiz, iwtemp(1,2),
344 & info(6), fils, frere, iwtemp(1,3), nemin,
345 & iw(l2), keep(60), keep(20), keep(38),
346 & iw2,keep(104),iw(l2+n),keep(50),
347 & icntl(13), keep(37), keep(197), nslaves, keep(250).EQ.1,
348 & .false., idummy, lidummy)
349#endif
350 DEALLOCATE(iw2)
351 IF (keep(60).NE.0) THEN
352 IF (keep(60)==1) THEN
353 in = keep(20)
354 ELSE
355 in = keep(38)
356 ENDIF
357 DO WHILE (in.GT.0)
358 in = fils(in)
359 END DO
360 ifson = -in
361 IF (keep(60)==1) THEN
362 in = keep(20)
363 ELSE
364 in = keep(38)
365 ENDIF
366 DO i=2,size_schur
367 fils(in) = listvar_schur(i)
368 in = fils(in)
369 frere(in) = n+1
370 ENDDO
371 fils(in) = -ifson
372 ENDIF
373 CALL dmumps_ana_m(ikeep(1,2),
374 & iwtemp(1,3), info(6),
375 & info(5), keep(2),keep(50),
376 & keep8(101), keep(108),keep(5),
377 & keep(6), keep(226), keep(253))
378 IF ( keep(53) .NE. 0 ) THEN
379 CALL mumps_make1root( n, frere, fils, nfsiz, keep(20) )
380 END IF
381 IF ( keep(48) == 4 .OR.
382 & ( (keep(24).NE.0).AND.(keep8(21).GT.0_8) ) ) THEN
383 CALL dmumps_set_k821_surface(keep8(21), keep(2),
384 & keep(48), keep(50), nslaves)
385 END IF
386 IF (keep(210).LT.0.OR.keep(210).GT.2) keep(210)=0
387 IF (keep(210).EQ.0.AND.keep(201).GT.0) keep(210)=1
388 IF (keep(210).EQ.0.AND.keep(201).EQ.0) keep(210)=2
389 IF (keep(210).EQ.2) keep8(79)=huge(keep8(79))
390 IF (keep(210).EQ.1.AND.keep8(79).LE.0_8) THEN
391 keep8(79)=k79ref * int(nslaves,8)
392 ENDIF
393 IF (keep(79).EQ.0) THEN
394 IF (keep(210).EQ.1) THEN
395 splitroot = .false.
396 IF ( keep(62).GE.1) THEN
397 idummy(1)= -1
398 CALL dmumps_cutnodes(n, frere, fils, nfsiz,
399 & idummy, lidummy, info(6),
400 & nslaves, keep,keep8, splitroot,
401 & mp, ldiag, info(1), info(2))
402 IF (info(1).LT.0) GOTO 90
403 IF (prok) THEN
404 WRITE(mp,*) " Number of split nodes in pre-splitting=",
405 & keep(61)
406 ENDIF
407 ENDIF
408 ENDIF
409 ENDIF
410 splitroot = ((icntl(13).GT.0 .AND. nslaves.GT.icntl(13)) .OR.
411 & icntl(13).EQ.-1 )
412 IF (keep(53) .NE. 0) THEN
413 splitroot = .true.
414 ENDIF
415 splitroot = (splitroot.AND.( (keep(60).EQ.0) ))
416 IF (splitroot) THEN
417 idummy(1) = -1
418 CALL dmumps_cutnodes(n, frere, fils, nfsiz,
419 & idummy, lidummy, info(6),
420 & nslaves, keep,keep8, splitroot,
421 & mp, ldiag, info(1), info(2))
422 IF (info(1).LT.0) GOTO 90
423 IF ( keep(53) .NE. 0 ) THEN
424 CALL mumps_make1root( n, frere, fils, nfsiz, keep(20) )
425 ENDIF
426 ENDIF
427 IF (ldiag.GT.2 .AND. mp.GT.0) THEN
428 k = min0(10,n)
429 IF (ldiag.EQ.4) k = n
430 IF (k.GT.0) WRITE (mp,99997) (ikeep(i,1),i=1,k)
431 IF (k.GT.0) WRITE (mp,99991) (ikeep(i,2),i=1,k)
432 IF (k.GT.0) WRITE (mp,99990) (ikeep(i,3),i=1,k)
433 IF (k.GT.0) WRITE (mp,99987) (nfsiz(i),i=1,k)
434 IF (k.GT.0) WRITE (mp,99989) (fils(i),i=1,k)
435 IF (k.GT.0) WRITE (mp,99988) (frere(i),i=1,k)
436 ENDIF
437 GO TO 90
438 40 info(1) = -4
439 info(2) = k
440 90 CONTINUE
441 IF (info(1) .LT.0) THEN
442 IF ((lp.GT.0).AND.(icntl(4).GE.1)) WRITE (lp,99996) info(1)
443 IF ((lp.GT.0).AND.(icntl(4).GE.1)) WRITE (lp,99982) info(2)
444 ENDIF
445 IF (allocated(iw)) DEALLOCATE(iw)
446 IF (allocated(ipe8)) DEALLOCATE(ipe8)
447 IF (allocated(iw2)) DEALLOCATE(iw2)
448 IF (allocated(iwtemp)) DEALLOCATE(iwtemp)
449 RETURN
45099999 FORMAT (/'Entering analysis phase with ...'/
451 & ' N NELT LIW INFO(1)'/,
452 & 9x, i10, i11, i12, i14)
45399998 FORMAT ('Element pointers: ELTPTR() '/(9x, 7i10))
45499995 FORMAT ('Element variables: ELTVAR() '/(9x, 7i10))
45599997 FORMAT ('IKEEP(.,1)=', 10i6/(12x, 10i6))
45699996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', i3)
45799991 FORMAT ('IKEEP(.,2)=', 10i6/(12x, 10i6))
45899990 FORMAT ('IKEEP(.,3)=', 10i6/(12x, 10i6))
45999989 FORMAT ('FILS (.) =', 10i6/(12x, 10i6))
46099988 FORMAT ('FRERE(.) =', 10i6/(12x, 10i6))
46199987 FORMAT ('NFSIZ(.) =', 10i6/(12x, 10i6))
46299982 FORMAT ('Error in permutation array KEEP INFO(2)=', i3)
463 END SUBROUTINE dmumps_ana_f_elt
464 SUBROUTINE dmumps_nodel( NELT, N, NELNOD, XELNOD, ELNOD,
465 & XNODEL, NODEL, FLAG, IERROR, ICNTL )
466 IMPLICIT NONE
467 INTEGER NELT, N, NELNOD, IERROR, ICNTL(60)
468 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
469 INTEGER XNODEL(N+1), NODEL(NELNOD),
470 & flag(n)
471 INTEGER I, J, K, MP, NBERR
472 mp = icntl(2)
473 flag(1:n) = 0
474 xnodel(1:n) = 0
475 ierror = 0
476 DO i = 1, nelt
477 DO k = xelnod(i), xelnod(i+1)-1
478 j = elnod(k)
479 IF ( j.LT.1 .OR. j.GT.n ) THEN
480 ierror = ierror + 1
481 ELSE
482 IF ( flag(j).NE.i ) THEN
483 xnodel(j) = xnodel(j) + 1
484 flag(j) = i
485 ENDIF
486 ENDIF
487 ENDDO
488 ENDDO
489 IF ( ierror.GT.0 .AND. mp.GT.0 .AND. icntl(4).GE.2 ) THEN
490 nberr = 0
491 WRITE(mp,99999)
492 DO i = 1, nelt
493 DO k = xelnod(i), xelnod(i+1)-1
494 j = elnod(k)
495 IF ( j.LT.1 .OR. j.GT.n ) THEN
496 nberr = nberr + 1
497 IF (nberr.LE.10) THEN
498 WRITE(mp,'(A,I8,A,I8,A)')
499 & 'Element ',i,' variable ',j,' ignored.'
500 ELSE
501 GO TO 100
502 ENDIF
503 ENDIF
504 ENDDO
505 ENDDO
506 ENDIF
507 100 CONTINUE
508 k = 1
509 DO i = 1, n
510 k = k + xnodel(i)
511 xnodel(i) = k
512 ENDDO
513 xnodel(n+1) = xnodel(n)
514 flag(1:n) = 0
515 DO i = 1, nelt
516 DO k = xelnod(i), xelnod(i+1)-1
517 j = elnod(k)
518 IF (flag(j).NE.i) THEN
519 xnodel(j) = xnodel(j) - 1
520 nodel(xnodel(j)) = i
521 flag(j) = i
522 ENDIF
523 ENDDO
524 ENDDO
525 RETURN
52699999 FORMAT (/'*** Warning message from subroutine DMUMPS_NODEL ***')
527 END SUBROUTINE dmumps_nodel
528 SUBROUTINE dmumps_ana_g1_elt(N, NZ, NELT, NELNOD,
529 & XELNOD, ELNOD, XNODEL, NODEL,
530 & LEN, FLAG)
531 IMPLICIT NONE
532 INTEGER N, NELT, NELNOD
533 INTEGER(8), INTENT(OUT) :: NZ
534 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
535 INTEGER LEN(N)
536 INTEGER XNODEL(N+1), NODEL(NELNOD),
537 & flag(n)
538 INTEGER I,J,K1,K2,K3
539 FLAG(1:N) = 0
540 len(1:n) = 0
541 DO i = 1,n
542 DO k1 = xnodel(i), xnodel(i+1)-1
543 k2 = nodel(k1)
544 DO k3 = xelnod(k2), xelnod(k2+1)-1
545 j = elnod(k3)
546 IF ((j.GE.1) .AND. (j.LE.n)) THEN
547 IF ((i.LT.j) .AND. (flag(j).NE.i)) THEN
548 len(i) = len(i) + 1
549 len(j) = len(j) + 1
550 flag(j) = i
551 ENDIF
552 ENDIF
553 ENDDO
554 ENDDO
555 ENDDO
556 nz = 0_8
557 DO i = 1,n
558 nz = nz + int(len(i),8)
559 ENDDO
560 RETURN
561 END SUBROUTINE dmumps_ana_g1_elt
562 SUBROUTINE dmumps_ana_g2_eltnew(N, NELT, NELNOD,
563 & XELNOD, ELNOD, XNODEL, NODEL,
564 & IW, LW, IPE, LEN, FLAG, IWFR)
565 IMPLICIT NONE
566 INTEGER N,NELT,NELNOD
567 INTEGER(8), INTENT(IN) :: LW
568 INTEGER(8), INTENT(OUT) :: IWFR
569 INTEGER(8), INTENT(OUT) :: IPE(N+1)
570 INTEGER LEN(N)
571 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
572 INTEGER XNODEL(N+1), NODEL(NELNOD),
573 & iw(lw), flag(n)
574 INTEGER I,J,K1,K2,K3
575 IWFR = 1_8
576 DO i = 1,n
577 iwfr = iwfr + int(len(i),8)
578 ipe(i) = iwfr
579 ENDDO
580 ipe(n+1)=ipe(n)
581 flag(1:n) = 0
582 DO i = 1,n
583 DO k1 = xnodel(i), xnodel(i+1)-1
584 k2 = nodel(k1)
585 DO k3 = xelnod(k2), xelnod(k2+1)-1
586 j = elnod(k3)
587 IF ((j.GE.1) .AND. (j.LE.n)) THEN
588 IF ((i.LT.j) .AND. (flag(j).NE.i)) THEN
589 ipe(i) = ipe(i) - 1
590 iw(ipe(i)) = j
591 ipe(j) = ipe(j) - 1
592 iw(ipe(j)) = i
593 flag(j) = i
594 ENDIF
595 ENDIF
596 ENDDO
597 ENDDO
598 ENDDO
599 RETURN
600 END SUBROUTINE dmumps_ana_g2_eltnew
601 SUBROUTINE dmumps_ana_g2_elt(N, NELT, NELNOD,
602 & XELNOD, ELNOD, XNODEL, NODEL,
603 & IW, LW, IPE, LEN, FLAG, IWFR)
604 IMPLICIT NONE
605 INTEGER N,NELT,NELNOD
606 INTEGER(8), INTENT(IN) :: LW
607 INTEGER(8), INTENT(OUT) :: IWFR
608 INTEGER(8), INTENT(OUT) :: IPE(N)
609 INTEGER LEN(N)
610 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
611 INTEGER XNODEL(N+1), NODEL(NELNOD),
612 & iw(lw), flag(n)
613 INTEGER I,J,K1,K2,K3
614 iwfr = 1_8
615 DO i = 1,n
616 iwfr = iwfr + int(len(i),8)
617 IF (len(i).GT.0) THEN
618 ipe(i) = iwfr
619 ELSE
620 ipe(i) = 0_8
621 ENDIF
622 ENDDO
623 flag(1:n) = 0
624 DO i = 1,n
625 DO k1 = xnodel(i), xnodel(i+1)-1
626 k2 = nodel(k1)
627 DO k3 = xelnod(k2), xelnod(k2+1)-1
628 j = elnod(k3)
629 IF ((j.GE.1) .AND. (j.LE.n)) THEN
630 IF ((i.LT.j) .AND. (flag(j).NE.i)) THEN
631 ipe(i) = ipe(i) - 1_8
632 iw(ipe(i)) = j
633 ipe(j) = ipe(j) - 1_8
634 iw(ipe(j)) = i
635 flag(j) = i
636 ENDIF
637 ENDIF
638 ENDDO
639 ENDDO
640 ENDDO
641 RETURN
642 END SUBROUTINE dmumps_ana_g2_elt
643 SUBROUTINE dmumps_ana_j1_elt(N, NZ, NELT, NELNOD,
644 & XELNOD, ELNOD, XNODEL, NODEL,
645 & PERM, LEN, FLAG)
646 IMPLICIT NONE
647 INTEGER N,NELT,NELNOD
648 INTEGER(8), INTENT(OUT) :: NZ
649 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
650 INTEGER PERM(N)
651 INTEGER LEN(N)
652 INTEGER XNODEL(N+1), NODEL(NELNOD), FLAG(N)
653 INTEGER I,J,K1,K2,K3
654 flag(1:n) = 0
655 len(1:n) = 0
656 DO i = 1,n
657 DO k1 = xnodel(i),xnodel(i+1)-1
658 k2 = nodel(k1)
659 DO k3 = xelnod(k2),xelnod(k2+1)-1
660 j = elnod(k3)
661 IF ((j.GE.1) .AND. (j.LE.n)) THEN
662 IF ((i.NE.j) .AND. (flag(j).NE.i)) THEN
663 IF (perm(j).GT.perm(i)) THEN
664 len(i) = len(i) + 1
665 flag(j) = i
666 ENDIF
667 ENDIF
668 ENDIF
669 ENDDO
670 ENDDO
671 ENDDO
672 nz = 0_8
673 DO i = 1,n
674 nz = nz + int(len(i),8)
675 ENDDO
676 RETURN
677 END SUBROUTINE dmumps_ana_j1_elt
678 SUBROUTINE dmumps_ana_j2_elt(N, NELT, NELNOD,
679 & XELNOD, ELNOD, XNODEL, NODEL,
680 & PERM, IW, LW, IPE, LEN, FLAG, IWFR)
681 IMPLICIT NONE
682 INTEGER N,NELT,NELNOD
683 INTEGER(8), INTENT(IN) :: LW
684 INTEGER(8), INTENT(OUT) :: IWFR
685 INTEGER(8), INTENT(OUT) :: IPE(N)
686 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
687 INTEGER PERM(N)
688 INTEGER LEN(N)
689 INTEGER XNODEL(N+1), NODEL(NELNOD), IW(LW),
690 & flag(n)
691 INTEGER I,J,K1,K2,K3
692 iwfr = 0_8
693 DO i = 1,n
694 iwfr = iwfr + int(len(i) + 1,8)
695 ipe(i) = iwfr
696 ENDDO
697 iwfr = iwfr + 1_8
698 flag(1:n) = 0
699 DO i = 1,n
700 DO k1 = xnodel(i),xnodel(i+1)-1
701 k2 = nodel(k1)
702 DO k3 = xelnod(k2),xelnod(k2+1)-1
703 j = elnod(k3)
704 IF ((j.GE.1) .AND. (j.LE.n)) THEN
705 IF ((i.NE.j) .AND. (flag(j).NE.i)) THEN
706 IF (perm(j).GT.perm(i)) THEN
707 iw(ipe(i)) = j
708 ipe(i) = ipe(i) - 1_8
709 flag(j) = i
710 ENDIF
711 ENDIF
712 ENDIF
713 ENDDO
714 ENDDO
715 ENDDO
716 DO i = 1,n
717 j = int(ipe(i))
718 iw(j) = len(i)
719 IF (len(i).EQ.0) ipe(i) = 0_8
720 ENDDO
721 RETURN
722 END SUBROUTINE dmumps_ana_j2_elt
723 SUBROUTINE dmumps_ana_dist_elements( MYID, SLAVEF, N,
724 & PROCNODE, STEP, PTRAIW, PTRARW,
725 & NELT, FRTPTR, FRTELT,
726 & KEEP,KEEP8, ICNTL, SYM )
727 IMPLICIT NONE
728 INTEGER MYID, SLAVEF, N, NELT, SYM
729 INTEGER KEEP( 500 ), ICNTL( 60 )
730 INTEGER(8) KEEP8(150)
731 INTEGER(8) :: PTRAIW( NELT+1 ), PTRARW( NELT+1 )
732 INTEGER STEP( N )
733 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
734 INTEGER PROCNODE( KEEP(28) )
735 INTEGER MUMPS_TYPENODE, MUMPS_PROCNODE
736 EXTERNAL mumps_typenode, mumps_procnode
737 INTEGER(8) :: IPTRI8, IPTRR8, NVAR8
738 INTEGER ELT, I, K
739 INTEGER TYPE_PARALL, ITYPE, IRANK
740 LOGICAL :: EARLYT3ROOTINS
741 type_parall = keep(46)
742 ptraiw( 1:nelt ) = 0_8
743 earlyt3rootins = keep(200) .EQ.0
744 & .OR. ( keep(200) .LT. 0 .AND. keep(400) .EQ. 0 )
745 DO i = 1, n
746 IF (step(i).LT.0) cycle
747 itype = mumps_typenode( procnode(abs(step(i))), keep(199) )
748 irank = mumps_procnode( procnode(abs(step(i))), keep(199) )
749 IF ( type_parall .eq. 0 ) THEN
750 irank = irank + 1
751 END IF
752 IF ( (itype .EQ. 2) .OR.
753 & (itype .EQ. 3 .AND. .NOT. earlyt3rootins ) .OR.
754 & (itype .EQ. 1 .AND. irank .EQ. myid) ) THEN
755 DO k = frtptr(i),frtptr(i+1)-1
756 elt = frtelt(k)
757 ptraiw( elt ) = ptrarw(elt+1) - ptrarw(elt)
758 ENDDO
759 ELSE
760 END IF
761 END DO
762 iptri8 = 1_8
763 DO elt = 1,nelt
764 nvar8 = ptraiw( elt )
765 ptraiw( elt ) = iptri8
766 iptri8 = iptri8 + nvar8
767 ENDDO
768 ptraiw( nelt+1 ) = iptri8
769 keep8(27) = iptri8 - 1
770 IF ( .true. ) THEN
771 IF (sym .EQ. 0) THEN
772 iptrr8 = 1_8
773 DO elt = 1,nelt
774 nvar8 = ptraiw( elt+1 ) - ptraiw( elt )
775 ptrarw( elt ) = iptrr8
776 iptrr8 = iptrr8 + nvar8*nvar8
777 ENDDO
778 ptrarw( nelt+1 ) = iptrr8
779 ELSE
780 iptrr8 = 1_8
781 DO elt = 1,nelt
782 nvar8 = ptraiw( elt+1 ) - ptraiw( elt )
783 ptrarw( elt ) = iptrr8
784 iptrr8 = iptrr8 + (nvar8*(nvar8+1))/2
785 ENDDO
786 ptrarw( nelt+1 ) = iptrr8
787 ENDIF
788 ELSE
789 IF (sym .EQ. 0) THEN
790 iptrr8 = 1_8
791 DO elt = 1,nelt
792 nvar8 = ptrarw( elt+1 ) - ptrarw( elt )
793 ptrarw( elt ) = iptrr8
794 iptrr8 = iptrr8 + nvar8*nvar8
795 ENDDO
796 ptrarw( nelt+1 ) = iptrr8
797 ELSE
798 iptrr8 = 1_8
799 DO elt = 1,nelt
800 nvar8 = ptrarw( elt+1 ) - ptrarw( elt )
801 ptrarw( elt ) = iptrr8
802 iptrr8 = iptrr8 + (nvar8*(nvar8+1))/2
803 ENDDO
804 ptrarw( nelt+1 ) = iptrr8
805 ENDIF
806 ENDIF
807 keep8(26) = iptrr8 - 1_8
808 RETURN
809 END SUBROUTINE dmumps_ana_dist_elements
810 SUBROUTINE dmumps_eltproc( N, NELT, ELTPROC, SLAVEF, PROCNODE,
811 & KEEP)
812 IMPLICIT NONE
813 INTEGER, INTENT(IN) :: N, NELT, SLAVEF
814 INTEGER, INTENT(IN) :: PROCNODE( N )
815 INTEGER, INTENT(INOUT) :: ELTPROC( NELT )
816 INTEGER :: KEEP(500)
817 INTEGER ELT, I, ITYPE
818 LOGICAL :: EARLYT3ROOTINS
819 INTEGER, EXTERNAL :: MUMPS_TYPENODE, MUMPS_PROCNODE
820 earlyt3rootins = keep(200) .EQ.0
821 & .OR. ( keep(200) .LT. 0 .AND. keep(400) .EQ. 0 )
822 DO elt = 1, nelt
823 i = eltproc(elt)
824 IF ( i .NE. 0) THEN
825 itype = mumps_typenode(procnode(i),keep(199))
826 IF (itype.EQ.1) THEN
827 eltproc(elt) = mumps_procnode(procnode(i),keep(199))
828 ELSE IF ( itype.EQ.2 .OR. .NOT. earlyt3rootins ) THEN
829 eltproc(elt) = -1
830 ELSE
831 eltproc(elt) = -2
832 ENDIF
833 ELSE
834 eltproc(elt) = -3
835 ENDIF
836 ENDDO
837 RETURN
838 END SUBROUTINE dmumps_eltproc
839 SUBROUTINE dmumps_frtelt(N, NELT, NELNOD, FRERE, FILS, NA, NE,
840 & XNODEL, NODEL, FRTPTR, FRTELT, ELTNOD)
841 IMPLICIT NONE
842 INTEGER, INTENT(IN) :: N, NELT, NELNOD
843 INTEGER, INTENT(IN) :: FRERE(N), FILS(N), NA(N), NE(N)
844 INTEGER, INTENT(OUT):: FRTPTR(N+1), FRTELT(NELT), ELTNOD(NELT)
845 INTEGER, INTENT(IN) :: XNODEL(N+1), NODEL(NELNOD)
846 INTEGER, DIMENSION(:), ALLOCATABLE :: TNSTK, IPOOL
847 INTEGER I, K, IFATH, allocok
848 INTEGER INODE, LEAF, NBLEAF, NBROOT, III, IN
849 ALLOCATE(tnstk( n ), stat=allocok)
850 IF (allocok.ne.0) THEN
851 WRITE(6,*) ' Allocation error of TNSTK in '
852 & // 'routine DMUMPS_FRTELT '
853 CALL mumps_abort()
854 ENDIF
855 ALLOCATE(ipool( n ), stat=allocok)
856 IF (allocok.ne.0) THEN
857 WRITE(6,*) ' Allocation error of IPOOL in '
858 & // 'routine DMUMPS_FRTELT '
859 CALL mumps_abort()
860 ENDIF
861 tnstk = ne
862 leaf = 1
863 IF (n.EQ.1) THEN
864 nbroot = 1
865 nbleaf = 1
866 ipool(1) = 1
867 leaf = leaf + 1
868 ELSEIF (na(n).LT.0) THEN
869 nbleaf = n
870 nbroot = n
871 DO 20 i=1,nbleaf-1
872 inode = na(i)
873 ipool(leaf) = inode
874 leaf = leaf + 1
875 20 CONTINUE
876 inode = -na(n)-1
877 ipool(leaf) = inode
878 leaf = leaf + 1
879 ELSEIF (na(n-1).LT.0) THEN
880 nbleaf = n-1
881 nbroot = na(n)
882 IF (nbleaf-1.GT.0) THEN
883 DO 30 i=1,nbleaf-1
884 inode = na(i)
885 ipool(leaf) = inode
886 leaf = leaf + 1
887 30 CONTINUE
888 ENDIF
889 inode = -na(n-1)-1
890 ipool(leaf) = inode
891 leaf = leaf + 1
892 ELSE
893 nbleaf = na(n-1)
894 nbroot = na(n)
895 DO 40 i = 1,nbleaf
896 inode = na(i)
897 ipool(leaf) = inode
898 leaf = leaf + 1
899 40 CONTINUE
900 ENDIF
901 eltnod(1:nelt) = 0
902 iii = 1
903 90 CONTINUE
904 IF (iii.NE.leaf) THEN
905 inode=ipool(iii)
906 iii = iii + 1
907 ELSE
908 WRITE(6,*) ' ERROR 1 in subroutine DMUMPS_FRTELT '
909 CALL mumps_abort()
910 ENDIF
911 95 CONTINUE
912 in = inode
913 100 CONTINUE
914 DO k = xnodel(in),xnodel(in+1)-1
915 i = nodel(k)
916 IF (eltnod(i).EQ.0) eltnod(i) = inode
917 ENDDO
918 in = fils(in)
919 IF (in .GT. 0 ) GOTO 100
920 in = inode
921 110 in = frere(in)
922 IF (in.GT.0) GO TO 110
923 IF (in.EQ.0) THEN
924 nbroot = nbroot - 1
925 IF (nbroot.EQ.0) GOTO 115
926 GOTO 90
927 ELSE
928 ifath = -in
929 ENDIF
930 tnstk(ifath) = tnstk(ifath) - 1
931 IF ( tnstk(ifath) .EQ. 0 ) THEN
932 inode = ifath
933 GOTO 95
934 ELSE
935 GOTO 90
936 ENDIF
937 115 CONTINUE
938 frtptr(1:n) = 0
939 DO i = 1,nelt
940 IF (eltnod(i) .NE. 0) THEN
941 frtptr(eltnod(i)) = frtptr(eltnod(i)) + 1
942 ENDIF
943 ENDDO
944 k = 1
945 DO i = 1,n
946 k = k + frtptr(i)
947 frtptr(i) = k
948 ENDDO
949 frtptr(n+1) = frtptr(n)
950 DO k = 1,nelt
951 inode = eltnod(k)
952 IF (inode .NE. 0) THEN
953 frtptr(inode) = frtptr(inode) - 1
954 frtelt(frtptr(inode)) = k
955 ENDIF
956 ENDDO
957 DEALLOCATE(tnstk, ipool)
958 RETURN
959 END SUBROUTINE dmumps_frtelt
960 SUBROUTINE dmumps_ana_g11_elt(N, NZ, NELT, NELNOD,
961 & XELNOD, ELNOD, XNODEL, NODEL,
962 & LEN, LW, IW)
963 IMPLICIT NONE
964 INTEGER N,NELT,NELNOD,LW
965 INTEGER(8), INTENT(OUT) :: NZ
966 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
967 INTEGER LEN(N)
968 INTEGER XNODEL(N+1), NODEL(NELNOD),
969 & iw(lw)
970 INTEGER I,J,K1,K2,K3,LP,NSUP,SUPVAR
971 INTEGER INFO44(6)
972 EXTERNAL dmumps_supvar
973 lp = 6
974 CALL dmumps_supvar(n,nelt,xelnod(nelt+1)-1,elnod,xelnod,
975 & nsup,iw(3*n+3+1),3*n+3,iw,lp,info44)
976 IF (info44(1) .LT. 0) THEN
977 IF (lp.GE.0) WRITE(lp,*)
978 & 'Error return from DMUMPS_SUPVAR. INFO(1) = ',info44(1)
979 ENDIF
980 iw(1:nsup) = 0
981 len(1:n) = 0
982 DO i = 1,n
983 supvar = iw(3*n+3+1+i)
984 IF (supvar .EQ. 0) cycle
985 IF (iw(supvar).NE.0) THEN
986 len(i) = -iw(supvar)
987 ELSE
988 iw(supvar) = i
989 ENDIF
990 ENDDO
991 iw(n+1:2*n) = 0
992 nz = 0_8
993 DO supvar = 1,nsup
994 i = iw(supvar)
995 DO k1 = xnodel(i),xnodel(i+1)-1
996 k2 = nodel(k1)
997 DO k3 = xelnod(k2),xelnod(k2+1)-1
998 j = elnod(k3)
999 IF ((j.GE.1) .AND. (j.LE.n)) THEN
1000 IF (len(j).GE.0) THEN
1001 IF ((i.NE.j) .AND. (iw(n+j).NE.i)) THEN
1002 iw(n+j) = i
1003 len(i) = len(i) + 1
1004 ENDIF
1005 ENDIF
1006 ENDIF
1007 ENDDO
1008 ENDDO
1009 nz = nz + int(len(i),8)
1010 ENDDO
1011 RETURN
1012 END SUBROUTINE dmumps_ana_g11_elt
1013 SUBROUTINE dmumps_ana_g12_elt(N, NELT, NELNOD,
1014 & XELNOD, ELNOD, XNODEL, NODEL,
1015 & IW, LW, IPE, LEN, FLAG, IWFR)
1016 IMPLICIT NONE
1017 INTEGER N,NELT,NELNOD
1018 INTEGER(8), INTENT(IN) :: LW
1019 INTEGER(8), INTENT(OUT) :: IWFR
1020 INTEGER(8), INTENT(OUT) :: IPE(N)
1021 INTEGER XELNOD(NELT+1), ELNOD(NELNOD)
1022 INTEGER LEN(N)
1023 INTEGER XNODEL(N+1), NODEL(NELNOD),
1024 & iw(lw), flag(n)
1025 INTEGER I,J,K1,K2,K3
1026 iwfr = 1_8
1027 DO i = 1,n
1028 IF (len(i).GT.0) THEN
1029 iwfr = iwfr + int(len(i),8)
1030 ipe(i) = iwfr
1031 ELSE
1032 ipe(i) = 0_8
1033 ENDIF
1034 ENDDO
1035 flag(1:n) = 0
1036 DO i = 1,n
1037 IF (len(i).LE.0) cycle
1038 DO k1 = xnodel(i), xnodel(i+1)-1
1039 k2 = nodel(k1)
1040 DO k3 = xelnod(k2), xelnod(k2+1)-1
1041 j = elnod(k3)
1042 IF ((j.GE.1) .AND. (j.LE.n)) THEN
1043 IF (len(j) .GT. 0) THEN
1044 IF ((i.NE.j) .AND. (flag(j).NE.i)) THEN
1045 ipe(i) = ipe(i) - 1
1046 iw(ipe(i)) = j
1047 flag(j) = i
1048 ENDIF
1049 ENDIF
1050 ENDIF
1051 ENDDO
1052 ENDDO
1053 ENDDO
1054 RETURN
1055 END SUBROUTINE dmumps_ana_g12_elt
1056 SUBROUTINE dmumps_supvar(N,NELT,NZ,ELTVAR,ELTPTR,NSUP,SVAR,
1057 & LIW,IW,LP,INFO)
1058 INTEGER LIW,LP,N,NELT,NSUP,NZ
1059 INTEGER INFO(6)
1060 INTEGER ELTPTR(NELT+1),ELTVAR(NZ)
1061 INTEGER IW(LIW),SVAR(0:N)
1062 INTEGER FLAG,NEW,VARS
1063 EXTERNAL dmumps_supvarb
1064 info(1) = 0
1065 info(2) = 0
1066 info(3) = 0
1067 info(4) = 0
1068 IF (n.LT.1) GO TO 10
1069 IF (nelt.LT.1) GO TO 20
1070 IF (nz.LT.eltptr(nelt+1)-1) GO TO 30
1071 IF (liw.LT.6) THEN
1072 info(4) = 3*n + 3
1073 GO TO 40
1074 END IF
1075 new = 1
1076 vars = new + liw/3
1077 flag = vars + liw/3
1078 CALL dmumps_supvarb(n,nelt,eltptr,nz,eltvar,svar,nsup,liw/3-1,
1079 & iw(new),iw(vars),iw(flag),info)
1080 IF (info(1).EQ.-4) THEN
1081 info(4) = 3*n + 3
1082 GO TO 40
1083 ELSE
1084 info(4) = 3*nsup + 3
1085 END IF
1086 GO TO 50
1087 10 info(1) = -1
1088 IF (lp.GT.0) WRITE (lp,fmt=9000) info(1)
1089 GO TO 50
1090 20 info(1) = -2
1091 IF (lp.GT.0) WRITE (lp,fmt=9000) info(1)
1092 GO TO 50
1093 30 info(1) = -3
1094 IF (lp.GT.0) WRITE (lp,fmt=9000) info(1)
1095 GO TO 50
1096 40 info(1) = -4
1097 IF (lp.GT.0) THEN
1098 WRITE (lp,fmt=9000) info(1)
1099 WRITE (lp,fmt=9010) info(4)
1100 END IF
1101 50 RETURN
1102 9000 FORMAT (/3x,'Error message from DMUMPS_SUPVAR: INFO(1) = ',i2)
1103 9010 FORMAT (3x,'LIW is insufficient. Upper bound on required work',
1104 & 'space is ',i8)
1105 END SUBROUTINE dmumps_supvar
1106 SUBROUTINE dmumps_supvarb( N, NELT, ELTPTR, NZ, ELTVAR,
1107 & SVAR, NSUP, MAXSUP, NEW, VARS, FLAG, INFO )
1108 INTEGER MAXSUP,N,NELT,NSUP,NZ
1109 INTEGER ELTPTR(NELT+1),ELTVAR(NZ)
1110 INTEGER INFO(6)
1111 INTEGER FLAG(0:MAXSUP), NEW(0:MAXSUP),SVAR(0:N),
1112 & vars(0:maxsup)
1113 INTEGER I,IS,J,JS,K,K1,K2
1114 DO 10 i = 0,n
1115 svar(i) = 0
1116 10 CONTINUE
1117 vars(0) = n + 1
1118 new(0) = -1
1119 flag(0) = 0
1120 nsup = 0
1121 DO 40 j = 1,nelt
1122 k1 = eltptr(j)
1123 k2 = eltptr(j+1) - 1
1124 DO 20 k = k1,k2
1125 i = eltvar(k)
1126 IF (i.LT.1 .OR. i.GT.n) THEN
1127 info(2) = info(2) + 1
1128 GO TO 20
1129 END IF
1130 is = svar(i)
1131 IF (is.LT.0) THEN
1132 eltvar(k) = 0
1133 info(3) = info(3) + 1
1134 GO TO 20
1135 END IF
1136 svar(i) = svar(i) - n - 2
1137 vars(is) = vars(is) - 1
1138 20 CONTINUE
1139 DO 30 k = k1,k2
1140 i = eltvar(k)
1141 IF (i.LT.1 .OR. i.GT.n) GO TO 30
1142 is = svar(i) + n + 2
1143 IF (flag(is).LT.j) THEN
1144 flag(is) = j
1145 IF (vars(is).GT.0) THEN
1146 nsup = nsup + 1
1147 IF (nsup.GT.maxsup) THEN
1148 info(1) = -4
1149 RETURN
1150 END IF
1151 vars(nsup) = 1
1152 flag(nsup) = j
1153 new(is) = nsup
1154 svar(i) = nsup
1155 ELSE
1156 vars(is) = 1
1157 new(is) = is
1158 svar(i) = is
1159 END IF
1160 ELSE
1161 js = new(is)
1162 vars(js) = vars(js) + 1
1163 svar(i) = js
1164 END IF
1165 30 CONTINUE
1166 40 CONTINUE
1167 RETURN
1168 END SUBROUTINE dmumps_supvarb
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_hamd
subroutine mumps_hamd(n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent, listvar_schur, size_schur)
Definition ana_orderings.F:2372
mumps_amd_elt
subroutine mumps_amd_elt(n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
Definition ana_orderings.F:1287
dmumps_ana_m
subroutine dmumps_ana_m(ne, nd, nsteps, maxfr, maxelim, k50, sizefac_tot, maxnpiv, k5, k6, panel_size, k253)
Definition dana_aux.F:2780
dmumps_cutnodes
subroutine dmumps_cutnodes(n, frere, fils, nfsiz, sizeofblocks, lsizeofblocks, nsteps, nslaves, keep, keep8, splitroot, mp, ldiag, info1, info2)
Definition dana_aux.F:2919
dmumps_ana_k
subroutine dmumps_ana_k(n, ipe, iw, lw, iwfr, ips, ipv, nv, flag, ncmpa, size_schur, parent)
Definition dana_aux.F:1931
dmumps_set_k821_surface
subroutine dmumps_set_k821_surface(keep821, keep2, keep48, keep50, nslaves)
Definition dana_aux.F:3554
dmumps_ana_lnew
subroutine dmumps_ana_lnew(n, ipe, nv, ips, ne, na, nfsiz, node, nsteps, fils, frere, nd, nemin, subord, keep60, keep20, keep38, namalg, namalgmax, cumul, keep50, icntl13, keep37, keep197, nslaves, allow_amalg_tiny_nodes, blkon, sizeofblocks, lsizeofblocks)
Definition dana_aux.F:2412
dmumps_ana_j1_elt
subroutine dmumps_ana_j1_elt(n, nz, nelt, nelnod, xelnod, elnod, xnodel, nodel, perm, len, flag)
Definition dana_aux_ELT.F:646
dmumps_ana_g2_elt
subroutine dmumps_ana_g2_elt(n, nelt, nelnod, xelnod, elnod, xnodel, nodel, iw, lw, ipe, len, flag, iwfr)
Definition dana_aux_ELT.F:604
dmumps_nodel
subroutine dmumps_nodel(nelt, n, nelnod, xelnod, elnod, xnodel, nodel, flag, ierror, icntl)
Definition dana_aux_ELT.F:466
dmumps_ana_f_elt
subroutine dmumps_ana_f_elt(n, nelt, eltptr, eltvar, liw, ikeep, iord, nfsiz, fils, frere, listvar_schur, size_schur, icntl, info, keep, keep8, nslaves, xnodel, nodel)
Definition dana_aux_ELT.F:25
dmumps_eltproc
subroutine dmumps_eltproc(n, nelt, eltproc, slavef, procnode, keep)
Definition dana_aux_ELT.F:812
dmumps_ana_g1_elt
subroutine dmumps_ana_g1_elt(n, nz, nelt, nelnod, xelnod, elnod, xnodel, nodel, len, flag)
Definition dana_aux_ELT.F:531
dmumps_ana_j2_elt
subroutine dmumps_ana_j2_elt(n, nelt, nelnod, xelnod, elnod, xnodel, nodel, perm, iw, lw, ipe, len, flag, iwfr)
Definition dana_aux_ELT.F:681
dmumps_ana_g12_elt
subroutine dmumps_ana_g12_elt(n, nelt, nelnod, xelnod, elnod, xnodel, nodel, iw, lw, ipe, len, flag, iwfr)
Definition dana_aux_ELT.F:1016
dmumps_ana_g11_elt
subroutine dmumps_ana_g11_elt(n, nz, nelt, nelnod, xelnod, elnod, xnodel, nodel, len, lw, iw)
Definition dana_aux_ELT.F:963
dmumps_ana_dist_elements
subroutine dmumps_ana_dist_elements(myid, slavef, n, procnode, step, ptraiw, ptrarw, nelt, frtptr, frtelt, keep, keep8, icntl, sym)
Definition dana_aux_ELT.F:727
dmumps_supvar
subroutine dmumps_supvar(n, nelt, nz, eltvar, eltptr, nsup, svar, liw, iw, lp, info)
Definition dana_aux_ELT.F:1058
dmumps_frtelt
subroutine dmumps_frtelt(n, nelt, nelnod, frere, fils, na, ne, xnodel, nodel, frtptr, frtelt, eltnod)
Definition dana_aux_ELT.F:841
dmumps_supvarb
subroutine dmumps_supvarb(n, nelt, eltptr, nz, eltvar, svar, nsup, maxsup, new, vars, flag, info)
Definition dana_aux_ELT.F:1108
dmumps_ana_g2_eltnew
subroutine dmumps_ana_g2_eltnew(n, nelt, nelnod, xelnod, elnod, xnodel, nodel, iw, lw, ipe, len, flag, iwfr)
Definition dana_aux_ELT.F:565
max
#define max(a, b)
Definition macros.h:21
mumps_ana_ord_wrappers
Definition ana_orderings_wrappers_m.F:19
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_make1root
subroutine mumps_make1root(n, frere, fils, nfsiz, theroot)
Definition tools_common.F:32