OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sana_aux.F File Reference

Go to the source code of this file.

Modules

module  smumps_ana_aux_m

Functions/Subroutines

subroutine smumps_ana_aux_m::smumps_ana_f (n, nz8, irn, icn, liwalloc, ikeep1, ikeep2, ikeep3, iord, nfsiz, fils, frere, listvar_schur, size_schur, icntl, info, keep, keep8, nslaves, piv, cntl4, colsca, rowsca, norig_arg, sizeofblocks, gcomp_provided_in, gcomp)
subroutine smumps_ana_aux_m::smumps_ana_n_dist (id, ptrar)
subroutine smumps_ana_aux_m::smumps_ana_o (n, nz, mtrans, perm, ikeepalloc, idirn, idjcn, ida, idrowsca, idcolsca, work2, keep, icntl, info, infog)
subroutine smumps_ana_k (n, ipe, iw, lw, iwfr, ips, ipv, nv, flag, ncmpa, size_schur, parent)
subroutine smumps_ana_j (n, nz, irn, icn, perm, iw, lw, ipe, iq, flag, iwfr, iflag, ierror, mp)
subroutine smumps_ana_d (n, ipe, iw, lw, iwfr, ncmpa)
subroutine smumps_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)
subroutine smumps_ana_m (ne, nd, nsteps, maxfr, maxelim, k50, sizefac_tot, maxnpiv, k5, k6, panel_size, k253)
subroutine smumps_ana_r (n, fils, frere, nstk, na)
subroutine smumps_diag_ana (myid, comm, keep, keep8, info, infog, rinfo, rinfog, icntl, size_schur)
subroutine smumps_cutnodes (n, frere, fils, nfsiz, sizeofblocks, lsizeofblocks, nsteps, nslaves, keep, keep8, splitroot, mp, ldiag, info1, info2)
recursive subroutine smumps_split_1node (inode, n, frere, fils, nfsiz, nsteps, nslaves, keep, keep8, tot_cut, strat, depth, k79, splitroot, mp, ldiag, blkon, sizeofblocks, lsizeofblocks)
subroutine smumps_ana_gnew (n, nz, irn, icn, iw, lw, ipe, len, iq, flag, iwfr, nrorm, niorm, iflag, ierror, icntl, symmetry, sym, nbqd, avgdens, keep264, keep265, printstat, inplace64_graph_copy)
subroutine smumps_set_k821_surface (keep821, keep2, keep48, keep50, nslaves)
subroutine smumps_mtrans_driver (job, m, n, ne, ip, irn, a, la, num, perm, liw, iw, ldw, dw, ipq8, icntl, cntl, info, infomumps)
subroutine smumps_suppress_duppli_val (n, nz, ip, irn, a, flag, posi)
subroutine smumps_suppress_duppli_str (n, nz, ip, irn, flag)
subroutine smumps_sort_perm (n, na, lna, ne_steps, perm, fils, dad_steps, step, nsteps, keep60, keep20, keep38, info)
subroutine smumps_expand_tree_steps (icntl, n, nblk, blkptr, blkvar, fils_old, fils_new, nsteps, step_old, step_new, par2_nodes, nb_niv2, dad_steps, frere_steps, na, lna, lrgroups_old, lrgroups_new, k20, k38)
subroutine smumps_dist_avoid_copies (n, nslaves, icntl, infog, ne, nfsiz, frere, fils, keep, keep8, procnode, ssarbr, nbsa, peak, ierr, sizeofblocks, lsizeofblocks)
subroutine smumps_set_procnode (inode, procnode, value, fils, n)

Function/Subroutine Documentation

◆ smumps_ana_d()

subroutine smumps_ana_d ( integer, intent(in) n,
integer(8), dimension(n), intent(inout) ipe,
integer, dimension(lw), intent(inout) iw,
integer(8), intent(in) lw,
integer(8), intent(out) iwfr,
integer, intent(inout) ncmpa )

Definition at line 2151 of file sana_aux.F.

2152 INTEGER, INTENT(IN) :: N
2153 INTEGER(8), INTENT(IN) :: LW
2154 INTEGER(8), INTENT(OUT) :: IWFR
2155 INTEGER(8), INTENT(INOUT):: IPE(N)
2156 INTEGER, INTENT(INOUT) :: NCMPA
2157 INTEGER, INTENT(INOUT) :: IW(LW)
2158 INTEGER :: I, IR
2159 INTEGER(8) :: K1, K, K2, LWFR
2160 ncmpa = ncmpa + 1
2161 DO 10 i=1,n
2162 k1 = ipe(i)
2163 IF (k1.LE.0_8) GO TO 10
2164 ipe(i) = int(iw(k1), 8)
2165 iw(k1) = -i
2166 10 CONTINUE
2167 iwfr = 1_8
2168 lwfr = iwfr
2169 DO 60 ir=1,n
2170 IF (lwfr.GT.lw) GO TO 70
2171 DO 20 k=lwfr,lw
2172 IF (iw(k).LT.0) GO TO 30
2173 20 CONTINUE
2174 GO TO 70
2175 30 i = -iw(k)
2176 iw(iwfr) = int(ipe(i))
2177 ipe(i) = int(iwfr,8)
2178 k1 = k + 1_8
2179 k2 = k + int(iw(iwfr),8)
2180 iwfr = iwfr + 1_8
2181 IF (k1.GT.k2) GO TO 50
2182 DO 40 k=k1,k2
2183 iw(iwfr) = iw(k)
2184 iwfr = iwfr + 1_8
2185 40 CONTINUE
2186 50 lwfr = k2 + 1_8
2187 60 CONTINUE
2188 70 RETURN

◆ smumps_ana_gnew()

subroutine smumps_ana_gnew ( integer, intent(in) n,
integer(8), intent(in) nz,
integer, dimension(nz), intent(in) irn,
integer, dimension(nz), intent(in) icn,
integer, dimension(lw), intent(out) iw,
integer(8), intent(in) lw,
integer(8), dimension(n+1), intent(out) ipe,
integer, dimension(n), intent(out) len,
integer(8), dimension(n), intent(out) iq,
integer, dimension(n), intent(out) flag,
integer(8), intent(out) iwfr,
integer(8), intent(out) nrorm,
integer(8), intent(out) niorm,
integer, intent(inout) iflag,
integer, intent(out) ierror,
integer, dimension(60), intent(in) icntl,
integer, intent(out) symmetry,
integer, intent(in) sym,
integer, intent(out) nbqd,
integer, intent(out) avgdens,
integer, intent(inout) keep264,
integer, intent(inout) keep265,
logical, intent(in) printstat,
logical, intent(inout) inplace64_graph_copy )

Definition at line 3223 of file sana_aux.F.

3231 IMPLICIT NONE
3232 INTEGER, intent(in) :: N, SYM
3233 INTEGER(8), intent(in) :: LW
3234 INTEGER(8), intent(in) :: NZ
3235 INTEGER, intent(in) :: ICNTL(60)
3236 INTEGER, intent(in) :: IRN(NZ), ICN(NZ)
3237 INTEGER, intent(out) :: IERROR, symmetry
3238 INTEGER, intent(out) :: NBQD, AvgDens
3239 INTEGER, intent(out) :: LEN(N), IW(LW)
3240 INTEGER(8), intent(out):: IWFR
3241 INTEGER(8), intent(out):: NRORM, NIORM
3242 INTEGER(8), intent(out):: IPE(N+1)
3243 INTEGER, intent(inout) :: IFLAG, KEEP264, KEEP265
3244 INTEGER(8), intent(out):: IQ(N)
3245 INTEGER, intent(out) :: FLAG(N)
3246 LOGICAL, intent(in) :: PRINTSTAT
3247 LOGICAL, intent(inout) :: INPLACE64_GRAPH_COPY
3248 INTEGER :: MP, MPG, I, J, N1
3249 INTEGER :: NBERR, THRESH
3250 INTEGER(8) :: K8, K1, K2, LAST, NDUP
3251 INTEGER(8) :: NZOFFA, NDIAGA, L, N8
3252 REAL :: RSYM
3253 INTRINSIC nint
3254 mp = icntl(2)
3255 mpg= icntl(3)
3256 nzoffa = 0_8
3257 ndiaga = 0
3258 ierror = 0
3259 n8 = int(n,8)
3260 DO i=1,n+1
3261 ipe(i) = 0_8
3262 ENDDO
3263 IF (keep264.EQ.0) THEN
3264 IF ((sym.EQ.0).AND.(keep265.EQ.-1)) THEN
3265 DO k8=1_8,nz
3266 i = irn(k8)
3267 j = icn(k8)
3268 IF ((i.GT.n).OR.(j.GT.n).OR.(i.LT.1)
3269 & .OR.(j.LT.1)) THEN
3270 ierror = ierror + 1
3271 ELSE
3272 IF (i.NE.j) THEN
3273 ipe(i) = ipe(i) + 1_8
3274 nzoffa = nzoffa + 1_8
3275 ELSE
3276 ndiaga = ndiaga + 1_8
3277 ENDIF
3278 ENDIF
3279 ENDDO
3280 ELSE
3281 DO k8=1_8,nz
3282 i = irn(k8)
3283 j = icn(k8)
3284 IF ((i.GT.n).OR.(j.GT.n).OR.(i.LT.1)
3285 & .OR.(j.LT.1)) THEN
3286 ierror = ierror + 1
3287 ELSE
3288 IF (i.NE.j) THEN
3289 ipe(i) = ipe(i) + 1_8
3290 ipe(j) = ipe(j) + 1_8
3291 nzoffa = nzoffa + 1_8
3292 ELSE
3293 ndiaga = ndiaga + 1_8
3294 ENDIF
3295 ENDIF
3296 ENDDO
3297 ENDIF
3298 ELSE
3299 IF ((sym.EQ.0).AND.(keep265.EQ.-1)) THEN
3300 DO k8=1_8,nz
3301 i = irn(k8)
3302 j = icn(k8)
3303 IF (i.EQ.j) THEN
3304 ndiaga = ndiaga + 1_8
3305 ELSE
3306 ipe(i) = ipe(i) + 1_8
3307 nzoffa = nzoffa + 1_8
3308 ENDIF
3309 ENDDO
3310 ELSE
3311 DO k8=1_8,nz
3312 i = irn(k8)
3313 j = icn(k8)
3314 IF (i.NE.j) THEN
3315 ipe(i) = ipe(i) + 1_8
3316 ipe(j) = ipe(j) + 1_8
3317 nzoffa = nzoffa + 1_8
3318 ELSE
3319 ndiaga = ndiaga + 1_8
3320 ENDIF
3321 ENDDO
3322 ENDIF
3323 ENDIF
3324 niorm = nzoffa + 3_8*n8
3325 IF (ierror.GE.1) THEN
3326 nberr = 0
3327 IF (mod(iflag,2) .EQ. 0) iflag = iflag+1
3328 IF ((mp.GT.0).AND.(icntl(4).GE.2)) THEN
3329 WRITE (mp,99999)
3330 DO 70 k8=1_8,nz
3331 i = irn(k8)
3332 j = icn(k8)
3333 IF ((i.GT.n).OR.(j.GT.n).OR.(i.LT.1)
3334 & .OR.(j.LT.1)) THEN
3335 nberr = nberr + 1
3336 IF (nberr.LE.10) THEN
3337 IF (mod(k8,10_8).GT.3_8 .OR. mod(k8,10_8).EQ.0_8 .OR.
3338 & (10_8.LE.k8 .AND. k8.LE.20_8)) THEN
3339 WRITE (mp,'(I16,A,I10,A,I10,A)')
3340 & k8,'th entry (in row',i,' and column',j,') ignored'
3341 ELSE
3342 IF (mod(k8,10_8).EQ.1_8)
3343 & WRITE(mp,'(I16,A,I10,A,I10,A)')
3344 & k8,'st entry (in row',i,' and column',j,') ignored'
3345 IF (mod(k8,10_8).EQ.2_8)
3346 & WRITE(mp,'(I16,A,I10,A,I10,A)')
3347 & k8,'nd entry (in row',i,' and column',j,') ignored'
3348 IF (mod(k8,10_8).EQ.3_8)
3349 & WRITE(mp,'(I16,A,I10,A,I10,A)')
3350 & k8,'rd entry (in row',i,' and column',j,') ignored'
3351 ENDIF
3352 ELSE
3353 GO TO 100
3354 ENDIF
3355 ENDIF
3356 70 CONTINUE
3357 ENDIF
3358 ENDIF
3359 100 nrorm = niorm - 2_8*n8
3360 iq(1) = 1_8
3361 n1 = n - 1
3362 IF (n1.GT.0) THEN
3363 DO i=1,n1
3364 iq(i+1) = ipe(i) + iq(i)
3365 ENDDO
3366 ENDIF
3367 last = max(ipe(n)+iq(n)-1,iq(n))
3368 flag(1:n) = 0
3369 ipe(1:n) = iq(1:n)
3370 iw(1:last) = 0
3371 iwfr = last + 1_8
3372 IF (keep264 .EQ. 0) THEN
3373 IF ((sym.EQ.0).AND.(keep265.EQ.-1)) THEN
3374 DO k8=1_8,nz
3375 i = irn(k8)
3376 j = icn(k8)
3377 IF (i.NE.j) THEN
3378 IF ((j.GE.1).AND.(i.LE.n)) THEN
3379 iw(iq(i)) = j
3380 iq(i) = iq(i) + 1
3381 ENDIF
3382 ENDIF
3383 ENDDO
3384 ELSE IF (keep265.EQ.1) THEN
3385 DO k8=1_8,nz
3386 i = irn(k8)
3387 j = icn(k8)
3388 IF (i.NE.j) THEN
3389 IF ((j.GE.1).AND.(i.LE.n)) THEN
3390 iw(iq(j)) = i
3391 iq(j) = iq(j) + 1
3392 iw(iq(i)) = j
3393 iq(i) = iq(i) + 1
3394 ENDIF
3395 ENDIF
3396 ENDDO
3397 ELSE
3398 DO k8=1_8,nz
3399 i = irn(k8)
3400 j = icn(k8)
3401 IF (i.NE.j) THEN
3402 IF (i.LT.j) THEN
3403 IF ((i.GE.1).AND.(j.LE.n)) THEN
3404 iw(iq(i)) = -j
3405 iq(i) = iq(i) + 1
3406 ENDIF
3407 ELSE
3408 IF ((j.GE.1).AND.(i.LE.n)) THEN
3409 iw(iq(j)) = -i
3410 iq(j) = iq(j) + 1
3411 ENDIF
3412 ENDIF
3413 ENDIF
3414 ENDDO
3415 ENDIF
3416 ELSE
3417 IF ((sym.EQ.0).AND.(keep265.EQ.-1)) THEN
3418 DO k8=1_8,nz
3419 i = irn(k8)
3420 j = icn(k8)
3421 IF (i.NE.j) THEN
3422 iw(iq(i)) = j
3423 iq(i) = iq(i) + 1
3424 ENDIF
3425 ENDDO
3426 ELSE IF (keep265.EQ.1) THEN
3427 DO k8=1_8,nz
3428 i = irn(k8)
3429 j = icn(k8)
3430 IF (i.NE.j) THEN
3431 iw(iq(j)) = i
3432 iq(j) = iq(j) + 1
3433 iw(iq(i)) = j
3434 iq(i) = iq(i) + 1
3435 ENDIF
3436 ENDDO
3437 ELSE
3438 DO k8=1_8,nz
3439 i = irn(k8)
3440 j = icn(k8)
3441 IF (i.NE.j) THEN
3442 IF (i.LT.j) THEN
3443 iw(iq(i)) = -j
3444 iq(i) = iq(i) + 1
3445 ELSE
3446 iw(iq(j)) = -i
3447 iq(j) = iq(j) + 1
3448 ENDIF
3449 ENDIF
3450 ENDDO
3451 ENDIF
3452 ENDIF
3453 IF (keep265.EQ.0) THEN
3454 ndup = 0_8
3455 DO i=1,n
3456 k1 = ipe(i)
3457 k2 = iq(i) - 1_8
3458 IF (k1.GT.k2) THEN
3459 len(i) = 0
3460 ELSE
3461 DO k8=k1,k2
3462 j = -iw(k8)
3463 IF (j.LE.0) EXIT
3464 IF (flag(j).EQ.i) THEN
3465 ndup = ndup + 1_8
3466 iw(k8) = 0
3467 ELSE
3468 l = iq(j)
3469 iw(l) = i
3470 iq(j) = l + 1
3471 iw(k8) = j
3472 flag(j) = i
3473 ENDIF
3474 END DO
3475 len(i) = int((iq(i) - ipe(i)))
3476 ENDIF
3477 ENDDO
3478 IF (ndup.NE.0_8) THEN
3479 iwfr = 1_8
3480 DO i=1,n
3481 IF (len(i).EQ.0) THEN
3482 ipe(i) = iwfr
3483 cycle
3484 ENDIF
3485 k1 = ipe(i)
3486 k2 = k1 + len(i) - 1
3487 l = iwfr
3488 ipe(i) = iwfr
3489 DO 270 k8=k1,k2
3490 IF (iw(k8).NE.0) THEN
3491 iw(iwfr) = iw(k8)
3492 iwfr = iwfr + 1_8
3493 ENDIF
3494 270 CONTINUE
3495 len(i) = int(iwfr - l)
3496 ENDDO
3497 ELSE
3498 keep265 = 1
3499 ENDIF
3500 ipe(n+1) = ipe(n) + int(len(n),8)
3501 iwfr = ipe(n+1)
3502 ELSE
3503 ipe(1) = 1_8
3504 DO i = 1, n
3505 len(i) = int(iq(i) - ipe(i))
3506 ENDDO
3507 DO i = 1, n
3508 ipe(i+1) = ipe(i) + int(len(i),8)
3509 ENDDO
3510 iwfr = ipe(n+1)
3511 ENDIF
3512 symmetry = 100
3513 IF (sym.EQ.0) THEN
3514 rsym = real(ndiaga+2_8*nzoffa - (iwfr-1_8))/
3515 & real(nzoffa+ndiaga)
3516 IF ((keep265.EQ.0) .AND. (nzoffa - (iwfr-1_8)).EQ.0_8)
3517 & THEN
3518 keep265 = -1
3519 ENDIF
3520 symmetry = min(nint(100.0e0*rsym), 100)
3521 IF (printstat) THEN
3522 IF ((mpg .GT. 0).AND.(icntl(4).GE.2) )
3523 & write(mpg,'(A,I5)')
3524 & ' ... Structural symmetry (in percent)=', symmetry
3525 IF (mp.GT.0 .AND. mpg.NE.mp.AND. (icntl(4).GE.2) )
3526 & write(mp,'(A,I5)')
3527 & ' ... Structural symmetry (in percent)=', symmetry
3528 ENDIF
3529 ELSE
3530 ENDIF
3531 avgdens = nint(real(iwfr-1_8)/real(n))
3532 thresh = avgdens*50 - avgdens/10 + 1
3533 nbqd = 0
3534 IF (n.GT.2) THEN
3535 DO i= 1, n
3536 j = max(len(i),1)
3537 IF (j.GT.thresh) nbqd = nbqd+1
3538 ENDDO
3539 ENDIF
3540 inplace64_graph_copy = (lw.GE.2*(iwfr-1_8))
3541 IF (printstat) THEN
3542 IF (mpg .GT. 0.AND.(icntl(4).GE.2))
3543 & write(mpg,'(A,1I5)')
3544 & ' Average density of rows/columns =', avgdens
3545 IF (mp.GT.0 .AND. mpg.NE.mp.AND.(icntl(4).GE.2))
3546 & write(mp,'(A,1I5)')
3547 & ' Average density of rows/columns =', avgdens
3548 ENDIF
3549 RETURN
355099999 FORMAT (/'*** Warning message from analysis routine ***')
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ smumps_ana_j()

subroutine smumps_ana_j ( integer, intent(in) n,
integer(8), intent(in) nz,
integer, dimension(nz), intent(in) irn,
integer, dimension(nz), intent(in) icn,
integer, dimension(n), intent(in) perm,
integer, dimension(lw), intent(out) iw,
integer(8), intent(in) lw,
integer(8), dimension(n), intent(out) ipe,
integer, dimension(n), intent(out) iq,
integer, dimension(n), intent(out) flag,
integer(8), intent(out) iwfr,
integer, intent(inout) iflag,
integer, intent(out) ierror,
integer, intent(in) mp )

Definition at line 2029 of file sana_aux.F.

2032 INTEGER, INTENT(IN) :: N
2033 INTEGER(8), INTENT(IN) :: NZ, LW
2034 INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ)
2035 INTEGER, INTENT(IN) :: PERM(N)
2036 INTEGER, INTENT(IN) :: MP
2037 INTEGER(8), INTENT(OUT):: IWFR
2038 INTEGER, INTENT(OUT) :: IERROR
2039 INTEGER, INTENT(OUT) :: IQ(N)
2040 INTEGER(8), INTENT(OUT) :: IPE(N)
2041 INTEGER, INTENT(OUT) :: IW(LW)
2042 INTEGER, INTENT(OUT) :: FLAG(N)
2043 INTEGER, INTENT(INOUT) :: IFLAG
2044 INTEGER :: I,J,LBIG,IN,LEN,JDUMMY,L1
2045 INTEGER(8) :: K, K1, K2, KL, KID
2046 ierror = 0
2047 DO 10 i=1,n
2048 iq(i) = 0
2049 10 CONTINUE
2050 DO 80 k=1_8,nz
2051 i = irn(k)
2052 j = icn(k)
2053 iw(k) = -i
2054 IF (i.EQ.j) GOTO 40
2055 IF (i.GT.j) GOTO 30
2056 IF (i.GE.1 .AND. j.LE.n) GO TO 60
2057 GO TO 50
2058 30 IF (j.GE.1 .AND. i.LE.n) GO TO 60
2059 GO TO 50
2060 40 iw(k) = 0
2061 IF (i.GE.1 .AND. i.LE.n) GO TO 80
2062 50 ierror = ierror + 1
2063 iw(k) = 0
2064 IF (ierror.LE.1 .AND. mp.GT.0) WRITE (mp,99999)
2065 IF (ierror.LE.10 .AND. mp.GT.0) WRITE (mp,99998) k, i, j
2066 GO TO 80
2067 60 IF (perm(j).GT.perm(i)) GO TO 70
2068 iq(j) = iq(j) + 1
2069 GO TO 80
2070 70 iq(i) = iq(i) + 1
2071 80 CONTINUE
2072 IF (ierror.GE.1) THEN
2073 IF (mod(iflag,2) .EQ. 0) iflag = iflag+1
2074 ENDIF
2075 iwfr = 1_8
2076 lbig = 0
2077 DO 100 i=1,n
2078 l1 = iq(i)
2079 lbig = max0(l1,lbig)
2080 iwfr = iwfr + int(l1,8)
2081 ipe(i) = iwfr - 1_8
2082 100 CONTINUE
2083 DO 140 k=1_8,nz
2084 i = -iw(k)
2085 IF (i.LE.0) GO TO 140
2086 kl = k
2087 iw(k) = 0
2088 DO 130 kid=1,nz
2089 j = icn(kl)
2090 IF (perm(i).LT.perm(j)) GO TO 110
2091 kl = ipe(j)
2092 ipe(j) = kl - 1_8
2093 in = iw(kl)
2094 iw(kl) = i
2095 GO TO 120
2096 110 kl = ipe(i)
2097 ipe(i) = kl - 1_8
2098 in = iw(kl)
2099 iw(kl) = j
2100 120 i = -in
2101 IF (i.LE.0) GO TO 140
2102 130 CONTINUE
2103 140 CONTINUE
2104 k = iwfr - 1_8
2105 kl = k + int(n,8)
2106 iwfr = kl + 1_8
2107 DO 170 i=1,n
2108 flag(i) = 0
2109 j = n + 1 - i
2110 len = iq(j)
2111 IF (len.LE.0) GO TO 160
2112 DO 150 jdummy=1,len
2113 iw(kl) = iw(k)
2114 k = k - 1_8
2115 kl = kl - 1_8
2116 150 CONTINUE
2117 160 ipe(j) = kl
2118 kl = kl - 1_8
2119 170 CONTINUE
2120 IF (lbig.GE.huge(n)) GO TO 190
2121 DO 180 i=1,n
2122 k = ipe(i)
2123 iw(k) = iq(i)
2124 IF (iq(i).EQ.0) ipe(i) = 0_8
2125 180 CONTINUE
2126 GO TO 230
2127 190 iwfr = 1_8
2128 DO 220 i=1,n
2129 k1 = ipe(i) + 1_8
2130 k2 = ipe(i) + int(iq(i),8)
2131 IF (k1.LE.k2) GO TO 200
2132 ipe(i) = 0_8
2133 GO TO 220
2134 200 ipe(i) = iwfr
2135 iwfr = iwfr + 1_8
2136 DO 210 k=k1,k2
2137 j = iw(k)
2138 IF (flag(j).EQ.i) GO TO 210
2139 iw(iwfr) = j
2140 iwfr = iwfr + 1_8
2141 flag(j) = i
2142 210 CONTINUE
2143 k = ipe(i)
2144 iw(k) = int(iwfr - k - 1_8)
2145 220 CONTINUE
2146 230 RETURN
214799999 FORMAT (' *** WARNING MESSAGE FROM SMUMPS_ANA_J ***' )
214899998 FORMAT (i6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', i6,
2149 & ') IGNORED')

◆ smumps_ana_k()

subroutine smumps_ana_k ( integer, intent(in) n,
integer(8), dimension(n), intent(inout) ipe,
integer, dimension(lw), intent(inout) iw,
integer(8), intent(in) lw,
integer(8), intent(inout) iwfr,
integer, dimension(n), intent(in) ips,
integer, dimension(n), intent(out) ipv,
integer, dimension(n), intent(out) nv,
integer, dimension(n), intent(out) flag,
integer, intent(out) ncmpa,
integer, intent(in) size_schur,
integer, dimension(n), intent(out) parent )

Definition at line 1928 of file sana_aux.F.

1931 IMPLICIT NONE
1932 INTEGER, INTENT(IN) :: N, SIZE_SCHUR
1933 INTEGER, INTENT(IN) :: IPS(N)
1934 INTEGER(8), INTENT(IN) :: LW
1935 INTEGER, INTENT(OUT) :: NCMPA
1936 INTEGER, INTENT(OUT) :: IPV(N), NV(N), PARENT(N)
1937 INTEGER(8), INTENT(INOUT) :: IWFR
1938 INTEGER(8), INTENT(INOUT) :: IPE(N)
1939 INTEGER, INTENT(INOUT) :: IW(LW)
1940 INTEGER, INTENT(OUT) :: FLAG(N)
1941 INTEGER I,J,ML,MS,ME,MINJS,IE,KDUMMY
1942 INTEGER LN,JS,JE
1943 INTEGER(8) :: JP, JP1, JP2, LWFR, IP
1944 DO 10 i=1,n
1945 flag(i) = 0
1946 nv(i) = 0
1947 j = ips(i)
1948 ipv(j) = i
1949 10 CONTINUE
1950 ncmpa = 0
1951 DO 100 ml=1,n-size_schur
1952 ms = ipv(ml)
1953 me = ms
1954 flag(ms) = me
1955 ip = iwfr
1956 minjs = n
1957 ie = me
1958 DO 70 kdummy=1,n
1959 jp = ipe(ie)
1960 ln = 0
1961 IF (jp.LE.0_8) GO TO 60
1962 ln = iw(jp)
1963 DO 50 jp1=1_8,int(ln,8)
1964 jp = jp + 1_8
1965 js = iw(jp)
1966 IF (flag(js).EQ.me) GO TO 50
1967 flag(js) = me
1968 IF (iwfr.LT.lw) GO TO 40
1969 ipe(ie) = jp
1970 iw(jp) = ln - int(jp1)
1971 CALL smumps_ana_d(n, ipe, iw, ip-1_8, lwfr, ncmpa)
1972 jp2 = iwfr - 1
1973 iwfr = lwfr
1974 IF (ip.GT.jp2) GO TO 30
1975 DO 20 jp=ip,jp2
1976 iw(iwfr) = iw(jp)
1977 iwfr = iwfr + 1_8
1978 20 CONTINUE
1979 30 ip = lwfr
1980 jp = ipe(ie)
1981 40 iw(iwfr) = js
1982 minjs = min0(minjs,ips(js)+0)
1983 iwfr = iwfr + 1_8
1984 50 CONTINUE
1985 60 ipe(ie) = int(-me,8)
1986 je = nv(ie)
1987 nv(ie) = ln + 1
1988 ie = je
1989 IF (ie.EQ.0) GO TO 80
1990 70 CONTINUE
1991 80 IF (iwfr.GT.ip) GO TO 90
1992 ipe(me) = 0_8
1993 nv(me) = 1
1994 GO TO 100
1995 90 minjs = ipv(minjs)
1996 nv(me) = nv(minjs)
1997 nv(minjs) = me
1998 iw(iwfr) = iw(ip)
1999 iw(ip) = int(iwfr - ip)
2000 ipe(me) = ip
2001 iwfr = iwfr + 1_8
2002 100 CONTINUE
2003 IF (size_schur == 0) GOTO 500
2004 DO ml = n-size_schur+1,n
2005 me = ipv(ml)
2006 ie = me
2007 DO kdummy=1,n
2008 jp = ipe(ie)
2009 ln = 0
2010 IF (jp.LE.0_8) GO TO 160
2011 ln = iw(jp)
2012 160 ipe(ie) = int(-ipv(n-size_schur+1),8)
2013 je = nv(ie)
2014 nv(ie) = ln + 1
2015 ie = je
2016 IF (ie.EQ.0) GO TO 190
2017 ENDDO
2018 190 nv(me) = 0
2019 ipe(me) = int(-ipv(n-size_schur+1),8)
2020 ENDDO
2021 me = ipv(n-size_schur+1)
2022 ipe(me) = 0_8
2023 nv(me) = size_schur
2024 500 DO i=1,n
2025 parent(i) = int(ipe(i))
2026 ENDDO
2027 RETURN
smumps_ana_d
subroutine smumps_ana_d(n, ipe, iw, lw, iwfr, ncmpa)
Definition sana_aux.F:2152

◆ smumps_ana_lnew()

subroutine smumps_ana_lnew ( integer n,
integer, dimension(n) ipe,
integer, dimension(n) nv,
integer, dimension(n) ips,
integer, dimension(n) ne,
integer, dimension(n) na,
integer, dimension(n) nfsiz,
integer, dimension(n) node,
integer nsteps,
integer, dimension(n) fils,
integer, dimension(n) frere,
integer, dimension(n) nd,
integer nemin,
integer, dimension(n) subord,
integer keep60,
integer keep20,
integer keep38,
integer, dimension(n) namalg,
integer namalgmax,
integer, dimension(n) cumul,
integer keep50,
integer icntl13,
integer keep37,
integer keep197,
integer nslaves,
logical allow_amalg_tiny_nodes,
logical, intent(in) blkon,
integer, dimension(lsizeofblocks), intent(in) sizeofblocks,
integer, intent(in) lsizeofblocks )

Definition at line 2404 of file sana_aux.F.

2412 IMPLICIT NONE
2413 INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50
2414 INTEGER ND(N), NFSIZ(N)
2415 INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N)
2416 INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N)
2417 INTEGER NEMIN,AMALG_COUNT
2418 INTEGER NAMALG(N),NAMALGMAX, CUMUL(N)
2419 DOUBLE PRECISION SIZE_DADI_AMALGAMATED, PERCENT_FILL
2420 DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON,
2421 & FLOPS_AVANT, FLOPS_APRES
2422 INTEGER ICNTL13, KEEP37, NSLAVES
2423 LOGICAL ALLOW_AMALG_TINY_NODES
2424 INTEGER KEEP197
2425 LOGICAL, INTENT(IN) :: BLKON
2426 INTEGER, INTENT(IN) :: LSIZEOFBLOCKS
2427 INTEGER, INTENT(IN) :: SIZEOFBLOCKS(LSIZEOFBLOCKS)
2428#if defined(NOAMALGTOFATHER)
2429#else
2430#endif
2431 INTEGER I,IF,IS,NR,INS
2432 INTEGER K,L,ISON,IN,IFSON,INO
2433 INTEGER INOS,IB,IL
2434 INTEGER IPERM
2435 INTEGER MAXNODE
2436#if defined(NOAMALGTOFATHER)
2437 INTEGER INB,INF,INFS,INL,INSW,INT1,NR1
2438#else
2439 INTEGER DADI
2440#endif
2441 LOGICAL AMALG_TO_father_OK
2442 amalg_count = 0
2443 DO 10 i=1,n
2444 cumul(i)= 0
2445 ips(i) = 0
2446 ne(i) = 0
2447 subord(i) = 0
2448 namalg(i) = 0
2449 10 CONTINUE
2450 DO i=1,n
2451 IF (blkon) THEN
2452 node(i) = sizeofblocks(i)
2453 ELSE
2454 node(i) = 1
2455 ENDIF
2456 ENDDO
2457 frere(1:n) = ipe(1:n)
2458 nr = n + 1
2459 maxnode = 1
2460 DO 50 i=1,n
2461 IF = -frere(i)
2462 IF (nv(i).EQ.0) THEN
2463 IF (subord(if).NE.0) subord(i) = subord(if)
2464 subord(if) = i
2465 IF (blkon) THEN
2466 node(if) = node(if)+sizeofblocks(i)
2467 ELSE
2468 node(if) = node(if)+1
2469 ENDIF
2470 maxnode = max(node(if),maxnode)
2471 ELSE
2472 IF (if.NE.0) THEN
2473 is = -ips(if)
2474 IF (is.GT.0) frere(i) = is
2475 ips(if) = -i
2476 ELSE
2477 nr = nr - 1
2478 ne(nr) = i
2479 ENDIF
2480 ENDIF
2481 50 CONTINUE
2482 maxnode = int(dble(maxnode)*dble(nemin) / dble(100))
2483 maxnode = max(maxnode,2000)
2484#if defined(NOAMALGTOFATHER)
2485 DO 999 i=1,n
2486 fils(i) = ips(i)
2487 999 CONTINUE
2488 nr1 = nr
2489 ins = 0
2490 1000 IF (nr1.GT.n) GO TO 1151
2491 ins = ne(nr1)
2492 nr1 = nr1 + 1
2493 1070 inl = fils(ins)
2494 IF (inl.LT.0) THEN
2495 ins = -inl
2496 GO TO 1070
2497 ENDIF
2498 1080 IF (frere(ins).LT.0) THEN
2499 ins = -frere(ins)
2500 fils(ins) = 0
2501 GO TO 1080
2502 ENDIF
2503 IF (frere(ins).EQ.0) THEN
2504 ins = 0
2505 GO TO 1000
2506 ENDIF
2507 inb = frere(ins)
2508 IF (nv(inb).GE.nv(ins)) THEN
2509 ins = inb
2510 GO TO 1070
2511 ENDIF
2512 inf = inb
2513 1090 inf = frere(inf)
2514 IF (inf.GT.0) GO TO 1090
2515 inf = -inf
2516 infs = -fils(inf)
2517 IF (infs.EQ.ins) THEN
2518 fils(inf) = -inb
2519 ips(inf) = -inb
2520 frere(ins) = frere(inb)
2521 frere(inb) = ins
2522 ELSE
2523 insw = infs
2524 1100 infs = frere(insw)
2525 IF (infs.NE.ins) THEN
2526 insw = infs
2527 GO TO 1100
2528 ENDIF
2529 frere(ins) = frere(inb)
2530 frere(inb) = ins
2531 frere(insw)= inb
2532 ENDIF
2533 ins = inb
2534 GO TO 1070
2535 1151 CONTINUE
2536#endif
2537 DO 51 i=1,n
2538 fils(i) = ips(i)
2539 51 CONTINUE
2540 is = 1
2541 i = 0
2542 iperm = 1
2543 DO 160 k=1,n
2544 amalg_to_father_ok=.false.
2545 IF (i.LE.0) THEN
2546 IF (nr.GT.n) EXIT
2547 i = ne(nr)
2548 ne(nr) = 0
2549 nr = nr + 1
2550 il = n
2551 na(n) = 0
2552 ENDIF
2553 DO 70 l=1,n
2554 IF (ips(i).GE.0) EXIT
2555 ison = -ips(i)
2556 ips(i) = 0
2557 i = ison
2558 il = il - 1
2559 na(il) = 0
2560 70 CONTINUE
2561#if ! defined(NOAMALGTOFATHER)
2562 dadi = -ipe(i)
2563 IF ( (dadi.NE.0) .AND.
2564 & (
2565 & (keep60.EQ.0).OR.
2566 & ( (keep20.NE.dadi).AND.(keep38.NE.dadi) )
2567 & )
2568 & ) THEN
2569 accu = dble(2)*dble(node(i))*dble(nv(dadi)-nv(i)+node(i))
2570 size_dadi_amalgamated =
2571 & dble(nv(dadi)+node(i)) *
2572 & dble(nv(dadi)+node(i))
2573 percent_fill = dble(100) * accu / size_dadi_amalgamated
2574 accu = accu + dble(cumul(i))
2575 amalg_to_father_ok = (
2576 & ( (node(i).LE.maxnode).AND.(node(dadi).LE.maxnode) )
2577 & .OR.
2578 & ( (node(i).LE.nemin.and. node(dadi).GT. maxnode)
2579 & .OR.(node(dadi).LE.nemin .and. node(i).GT.maxnode)))
2580 amalg_to_father_ok = ( amalg_to_father_ok .AND.
2581 & ( percent_fill < dble(nemin) ) )
2582 IF (keep197 .EQ. 1 ) THEN
2583 amalg_to_father_ok = amalg_to_father_ok.OR.
2584 & ( node(i).LE.2*nemin .AND. node(dadi).LT.4*nemin)
2585 ENDIF
2586 amalg_to_father_ok = ( amalg_to_father_ok .AND.
2587 & ( accu / size_dadi_amalgamated .LE. dble(nemin)) )
2588 IF (amalg_to_father_ok) THEN
2589 CALL mumps_get_flops_cost(nv(i),node(i),node(i),
2590 & keep50,1,flops_son)
2591 CALL mumps_get_flops_cost(nv(dadi),node(dadi),
2592 & node(dadi),
2593 & keep50,1,flops_father)
2594 flops_avant = flops_father+flops_son
2595 & + max(dble(200.0) * dble(nv(i)-node(i))
2596 & * dble(nv(i)-node(i)),
2597 & dble(10000.0))
2598 CALL mumps_get_flops_cost(nv(dadi)+node(i),
2599 & node(dadi)+node(i),
2600 & node(dadi)+node(i),
2601 & keep50,1,flops_apres)
2602 IF (flops_apres.GT.flops_avant*
2603 & (dble(1)+dble(max(8,nemin)-8)/dble(100))) THEN
2604 amalg_to_father_ok = .false.
2605 ENDIF
2606 ENDIF
2607 IF ( (nv(i).GT. 50*nv(dadi)).AND. (nslaves.GT.1)
2608 & .AND. (icntl13.LE.0)
2609 & .AND. (nv(i).GT. keep37) ) THEN
2610 IF ( ( accu / size_dadi_amalgamated ) .LT. 0.2 ) THEN
2611 amalg_to_father_ok = .true.
2612 ENDIF
2613 ENDIF
2614 IF ( allow_amalg_tiny_nodes .AND.
2615 & node(i) * 900 .LE. nv(dadi) - namalg(dadi)) THEN
2616 IF ( namalg(dadi) < (nv(dadi)-namalg(dadi))/50 ) THEN
2617 amalg_to_father_ok = .true.
2618 namalg(dadi) = namalg(dadi) + node(i)
2619 ENDIF
2620 ENDIF
2621 IF ( dadi .EQ. -frere(i)
2622 & .AND. -fils(dadi).EQ.i
2623 & ) THEN
2624 amalg_to_father_ok = ( amalg_to_father_ok .OR.
2625 & ( nv(i)-node(i).EQ.nv(dadi)) )
2626 ENDIF
2627 IF (amalg_to_father_ok) THEN
2628 cumul(dadi)=cumul(dadi)+nint(accu)
2629 namalg(dadi) = namalg(dadi) + namalg(i)
2630 amalg_count = amalg_count+1
2631 in = dadi
2632 75 IF (subord(in).EQ.0) GOTO 76
2633 in = subord(in)
2634 GOTO 75
2635 76 CONTINUE
2636 subord(in) = i
2637 nv(i) = 0
2638 ifson = -fils(dadi)
2639 IF (ifson.EQ.i) THEN
2640 IF (fils(i).LT.0) THEN
2641 fils(dadi) = fils(i)
2642 GOTO 78
2643 ELSE
2644 IF (frere(i).GT.0) THEN
2645 fils(dadi) = -frere(i)
2646 ELSE
2647 fils(dadi) = 0
2648 ENDIF
2649 GOTO 90
2650 ENDIF
2651 ENDIF
2652 in = ifson
2653 77 ins = in
2654 in = frere(in)
2655 IF (in.NE.i) GOTO 77
2656 IF (fils(i) .LT.0) THEN
2657 frere(ins) = -fils(i)
2658 ELSE
2659 frere(ins) = frere(i)
2660 GOTO 90
2661 ENDIF
2662 78 CONTINUE
2663 in = -fils(i)
2664 79 ino = in
2665 in = frere(in)
2666 IF (in.GT.0) GOTO 79
2667 frere(ino) = frere(i)
2668 90 CONTINUE
2669 node(dadi) = node(dadi)+ node(i)
2670 nv(dadi) = nv(dadi) + node(i)
2671 na(il+1) = na(il+1) + na(il)
2672 GOTO 120
2673 ENDIF
2674 ENDIF
2675#endif
2676 ne(is) = ne(is) + node(i)
2677 IF (il.LT.n) na(il+1) = na(il+1) + 1
2678 na(is) = na(il)
2679 nd(is) = nv(i)
2680 node(i) = is
2681 ips(i) = iperm
2682 iperm = iperm + 1
2683 in = i
2684 777 IF (subord(in).EQ.0) GO TO 778
2685 in = subord(in)
2686 node(in) = is
2687 ips(in) = iperm
2688 iperm = iperm + 1
2689 GO TO 777
2690 778 IF (na(is).LE.0) GO TO 110
2691#if defined(NOAMALGTOFATHER)
2692 IF ( (keep60.NE.0).AND.
2693 & (ne(is).EQ.nd(is)) ) GOTO 110
2694 IF (nd(is-1)-ne(is-1).EQ.nd(is)) THEN
2695 GO TO 100
2696 ENDIF
2697 IF(namalg(is-1) .GE. namalgmax) THEN
2698 GOTO 110
2699 ENDIF
2700 IF ((ne(is-1).GE.nemin).AND.
2701 & (ne(is).GE.nemin) ) GO TO 110
2702 IF (2*ne(is-1)*(nd(is)-nd(is-1)+ne(is-1)).GE.
2703 & ((nd(is)+ne(is-1))*
2704 & (nd(is)+ne(is-1))*nemin/100)) GO TO 110
2705 namalg(is-1) = namalg(is-1)+1
2706 100 na(is-1) = na(is-1) + na(is) - 1
2707 nd(is-1) = nd(is) + ne(is-1)
2708 ne(is-1) = ne(is) + ne(is-1)
2709 ne(is) = 0
2710 node(i) = is-1
2711 ifson = -fils(i)
2712 in = ifson
2713 102 ino = in
2714 in = frere(in)
2715 IF (in.GT.0) GO TO 102
2716 nv(ino) = 0
2717 in = i
2718 888 IF (subord(in).EQ.0) GO TO 889
2719 in = subord(in)
2720 GO TO 888
2721 889 subord(in) = ino
2722 inos = -fils(ino)
2723 IF (ifson.EQ.ino) THEN
2724 fils(i) = -inos
2725 GO TO 107
2726 ENDIF
2727 in = ifson
2728 105 ins = in
2729 in = frere(in)
2730 IF (in.NE.ino) GO TO 105
2731 IF (inos.EQ.0) THEN
2732 frere(ins) = -i
2733 GO TO 120
2734 ELSE
2735 frere(ins) = inos
2736 ENDIF
2737 107 in = inos
2738 IF (in.EQ.0) GO TO 120
2739 108 int1 = in
2740 in = frere(in)
2741 IF (in.GT.0) GO TO 108
2742 frere(int1) = -i
2743 GO TO 120
2744#endif
2745 110 is = is + 1
2746 120 ib = frere(i)
2747 IF (ib.GE.0) THEN
2748 IF (ib.GT.0) na(il) = 0
2749 i = ib
2750 ELSE
2751 i = -ib
2752 il = il + 1
2753 ENDIF
2754 160 CONTINUE
2755 nsteps = is - 1
2756 DO i=1, n
2757 IF (nv(i).EQ.0) THEN
2758 frere(i) = n+1
2759 nfsiz(i) = 0
2760 ELSE
2761 nfsiz(i) = nd(node(i))
2762 IF (subord(i) .NE.0) THEN
2763 inos = -fils(i)
2764 ino = i
2765 DO WHILE (subord(ino).NE.0)
2766 is = subord(ino)
2767 fils(ino) = is
2768 ino = is
2769 END DO
2770 fils(ino) = -inos
2771 ENDIF
2772 ENDIF
2773 ENDDO
2774 RETURN
if
if(complex_arithmetic) id
mumps_get_flops_cost
subroutine mumps_get_flops_cost(nfront, npiv, nass, keep50, level, cost)
Definition estim_flops.F:74

◆ smumps_ana_m()

subroutine smumps_ana_m ( integer, dimension(nsteps), intent(in) ne,
integer, dimension(nsteps), intent(in) nd,
integer, intent(in) nsteps,
integer, intent(out) maxfr,
integer, intent(out) maxelim,
integer, intent(in) k50,
integer(8), intent(out) sizefac_tot,
integer, intent(out) maxnpiv,
integer, intent(in) k5,
integer, intent(in) k6,
integer, intent(out) panel_size,
integer, intent(in) k253 )

Definition at line 2777 of file sana_aux.F.

2780 IMPLICIT NONE
2781 INTEGER, INTENT(in) :: NSTEPS, K50, K253, K5, K6
2782 INTEGER, INTENT(in) :: NE(NSTEPS), ND(NSTEPS)
2783 INTEGER, INTENT(out) :: MAXNPIV, PANEL_SIZE
2784 INTEGER, INTENT(out) :: MAXFR, MAXELIM
2785 INTEGER(8), INTENT(out):: SIZEFAC_TOT
2786 INTEGER ITREE, NFR, NELIM
2787 INTEGER LKJIB
2788 INTEGER(8) :: SIZEFAC
2789 lkjib = max(k5,k6)
2790 maxfr = 0
2791 maxelim = 0
2792 maxnpiv = 0
2793 panel_size = 0
2794 sizefac_tot = 0_8
2795 DO itree=1,nsteps
2796 nelim = ne(itree)
2797 nfr = nd(itree) + k253
2798 IF (nfr.GT.maxfr) maxfr = nfr
2799 IF (nfr-nelim.GT.maxelim) maxelim = nfr - nelim
2800 IF (nelim .GT. maxnpiv) THEN
2801 maxnpiv = nelim
2802 ENDIF
2803 IF (k50.EQ.0) THEN
2804 sizefac = (2_8*int(nfr,8) - int(nelim,8))*int(nelim,8)
2805 panel_size = max(panel_size, nfr*(lkjib+1))
2806 ELSE
2807 sizefac = int(nfr,8) * int(nelim,8)
2808 panel_size = max(panel_size, nelim*(lkjib+1))
2809 panel_size = max(panel_size, (nfr-nelim)*(lkjib+1))
2810 ENDIF
2811 sizefac_tot = sizefac_tot + sizefac
2812 END DO
2813 RETURN

◆ smumps_ana_r()

subroutine smumps_ana_r ( integer, intent(in) n,
integer, dimension(n), intent(in) fils,
integer, dimension(n), intent(in) frere,
integer, dimension(n), intent(out) nstk,
integer, dimension(n), intent(out) na )

Definition at line 2815 of file sana_aux.F.

2817 IMPLICIT NONE
2818 INTEGER, INTENT(IN) :: N
2819 INTEGER, INTENT(IN) :: FILS(N), FRERE(N)
2820 INTEGER, INTENT(OUT) :: NSTK(N), NA(N)
2821 INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON
2822 na = 0
2823 nstk = 0
2824 nbroot = 0
2825 ileaf = 1
2826 DO 11 i=1,n
2827 IF (frere(i).EQ. n+1) cycle
2828 IF (frere(i).EQ.0) nbroot = nbroot + 1
2829 in = i
2830 12 in = fils(in)
2831 IF (in.GT.0) GO TO 12
2832 IF (in.EQ.0) THEN
2833 na(ileaf) = i
2834 ileaf = ileaf + 1
2835 cycle
2836 ENDIF
2837 ison = -in
2838 13 nstk(i) = nstk(i) + 1
2839 ison = frere(ison)
2840 IF (ison.GT.0) GO TO 13
2841 11 CONTINUE
2842 nbleaf = ileaf-1
2843 IF (n.GT.1) THEN
2844 IF (nbleaf.GT.n-2) THEN
2845 IF (nbleaf.EQ.n-1) THEN
2846 na(n-1) = -na(n-1)-1
2847 na(n) = nbroot
2848 ELSE
2849 na(n) = -na(n)-1
2850 ENDIF
2851 ELSE
2852 na(n-1) = nbleaf
2853 na(n) = nbroot
2854 ENDIF
2855 ENDIF
2856 RETURN

◆ smumps_cutnodes()

subroutine smumps_cutnodes ( integer n,
integer, dimension( n ) frere,
integer, dimension( n ) fils,
integer, dimension( n ) nfsiz,
integer, dimension(lsizeofblocks) sizeofblocks,
integer lsizeofblocks,
integer nsteps,
integer nslaves,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
logical splitroot,
integer mp,
integer ldiag,
integer info1,
integer info2 )

Definition at line 2915 of file sana_aux.F.

2919 IMPLICIT NONE
2920 INTEGER N, NSTEPS, NSLAVES, KEEP(500)
2921 INTEGER(8) KEEP8(150)
2922 INTEGER FRERE( N ), FILS( N ), NFSIZ( N )
2923 INTEGER LSIZEOFBLOCKS
2924 INTEGER SIZEOFBLOCKS(LSIZEOFBLOCKS)
2925 LOGICAL SPLITROOT
2926 INTEGER MP, LDIAG
2927 INTEGER INFO1, INFO2
2928 INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL
2929 INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT
2930 INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT
2931 INTEGER(8) :: K79
2932 INTEGER NFRONT, K82, allocok
2933 LOGICAL BLKON
2934 blkon = .NOT.(sizeofblocks(1).EQ.-1)
2935 k79 = keep8(79)
2936 k82 = abs(keep(82))
2937 strat= keep(62)
2938 IF (keep(210).EQ.1) THEN
2939 max_depth = 2*nslaves*k82
2940 strat = strat/4
2941 ELSE
2942 IF (( nslaves .eq. 1 ).AND. (.NOT. splitroot) ) RETURN
2943 IF (nslaves.EQ.1) THEN
2944 max_depth=1
2945 ELSE
2946 max_depth = int( log( real( nslaves - 1 ) )
2947 & / log(2.0e0) )
2948 ENDIF
2949 ENDIF
2950 ALLOCATE(ipool(nsteps+1), stat=allocok)
2951 IF (allocok.GT.0) THEN
2952 info1= -7
2953 info2= nsteps+1
2954 RETURN
2955 ENDIF
2956 nroot = 0
2957 DO inode = 1, n
2958 IF ( frere(inode) .eq. 0 ) THEN
2959 nroot = nroot + 1
2960 ipool( nroot ) = inode
2961 END IF
2962 END DO
2963 ibeg = 1
2964 iend = nroot
2965 iipool = nroot + 1
2966 IF (splitroot) THEN
2967 max_depth=0
2968 ENDIF
2969 DO depth = 1, max_depth
2970 DO i = ibeg, iend
2971 inode = ipool( i )
2972 ison = inode
2973 DO WHILE ( ison .GT. 0 )
2974 ison = fils( ison )
2975 END DO
2976 ison = - ison
2977 DO WHILE ( ison .GT. 0 )
2978 ipool( iipool ) = ison
2979 iipool = iipool + 1
2980 ison = frere( ison )
2981 END DO
2982 END DO
2983 ipool( ibeg ) = -ipool( ibeg )
2984 ibeg = iend + 1
2985 iend = iipool - 1
2986 END DO
2987 ipool( ibeg ) = -ipool( ibeg )
2988 tot_cut = 0
2989 IF (splitroot) THEN
2990 max_cut = nroot*max(k82,2)
2991 inode = abs(ipool(1))
2992 nfront = nfsiz( inode )
2993 k79 = max(
2994 & int(nfront,8)*int(nfront,8)/(int(k82+1,8)*int(k82+1,8)),
2995 & 9_8)
2996 IF (keep(53).NE.0) THEN
2997 max_cut = nfront
2998 k79 = 121_8*121_8
2999 ELSE
3000 k79 = min(2000_8*2000_8,k79)
3001 IF (keep(376) .EQ. 1) THEN
3002 k79 = min(int(keep(9)+1,8)*int(keep(9)+1,8),k79)
3003 ENDIF
3004 ENDIF
3005 ELSE
3006 max_cut = 2 * nslaves
3007 IF (keep(210).EQ.1) THEN
3008 max_cut = 4 * (max_cut + 4)
3009 ENDIF
3010 ENDIF
3011 depth = -1
3012 DO i = 1, iipool - 1
3013 inode = ipool( i )
3014 IF ( inode .LT. 0 ) THEN
3015 inode = -inode
3016 depth = depth + 1
3017 END IF
3018 CALL smumps_split_1node
3019 & ( inode, n, frere, fils, nfsiz, nsteps, nslaves,
3020 & keep,keep8, tot_cut, strat, depth,
3021 & k79, splitroot, mp, ldiag,
3022 & blkon, sizeofblocks, lsizeofblocks )
3023 IF ( tot_cut > max_cut ) EXIT
3024 END DO
3025 keep(61) = tot_cut
3026 DEALLOCATE(ipool)
3027 RETURN
smumps_split_1node
recursive subroutine smumps_split_1node(inode, n, frere, fils, nfsiz, nsteps, nslaves, keep, keep8, tot_cut, strat, depth, k79, splitroot, mp, ldiag, blkon, sizeofblocks, lsizeofblocks)
Definition sana_aux.F:3033

◆ smumps_diag_ana()

subroutine smumps_diag_ana ( integer, intent(in) myid,
integer, intent(in) comm,
integer, dimension(500), intent(in) keep,
integer(8), dimension(150), intent(in) keep8,
integer, dimension(80), intent(in) info,
integer, dimension(80), intent(in) infog,
real, dimension(40), intent(in) rinfo,
real, dimension(40), intent(in) rinfog,
integer, dimension(60), intent(in) icntl,
integer, intent(in) size_schur )

Definition at line 2858 of file sana_aux.F.

2861 IMPLICIT NONE
2862 INTEGER, INTENT(IN) :: COMM, MYID, KEEP(500), INFO(80),
2863 & ICNTL(60), INFOG(80), SIZE_SCHUR
2864 INTEGER(8), INTENT(IN) :: KEEP8(150)
2865 REAL, INTENT(IN) :: RINFO(40), RINFOG(40)
2866 include 'mpif.h'
2867 INTEGER MASTER, MPG
2868 INTEGER ITMP
2869 parameter( master = 0 )
2870 mpg = icntl(3)
2871 IF ( myid.eq.master.and.mpg.GT.0.AND.icntl(4).GE.2) THEN
2872 itmp = keep(13)
2873 IF (icntl(15).EQ.0) itmp = 0
2874 WRITE(mpg, 99992) info(1), info(2),
2875 & keep8(109), keep8(111), infog(4),
2876 & infog(5), keep(28), infog(32), infog(7), keep(23),
2877 & icntl(7), keep(12),
2878 & itmp,
2879 & icntl(18),
2880 & keep(106),
2881 & keep(56), keep(61), rinfog(1)
2882 IF (keep(95).GT.1)
2883 & WRITE(mpg, 99993) keep(95)
2884 IF (keep(54).GT.0) WRITE(mpg, 99994) keep(54)
2885 IF (keep(60).GT.0) WRITE(mpg, 99995) keep(60), size_schur
2886 IF (keep(253).GT.0) WRITE(mpg, 99996) keep(253)
2887 ENDIF
2888 RETURN
288999992 FORMAT(/'Leaving analysis phase with ...'/
2890 & ' INFOG(1) =',i16/
2891 & ' INFOG(2) =',i16/
2892 & ' -- (20) Number of entries in factors (estim.) =',i16/
2893 & ' -- (3) Real space for factors (estimated) =',i16/
2894 & ' -- (4) Integer space for factors (estimated) =',i16/
2895 & ' -- (5) Maximum frontal size (estimated) =',i16/
2896 & ' -- (6) Number of nodes in the tree =',i16/
2897 & ' -- (32) Type of analysis effectively used =',i16/
2898 & ' -- (7) Ordering option effectively used =',i16/
2899 & ' ICNTL (6) Maximum transversal option =',i16/
2900 & ' ICNTL (7) Pivot order option =',i16/
2901 & ' ICNTL(14) Percentage of memory relaxation =',i16/
2902 & ' ICNTL(15) Analysis by block effectively used =',i16/
2903 & ' ICNTL(18) Distributed input matrix (on if >0) =',i16/
2904 & ' ICNTL(58) Symbolic factorization option =',i16/
2905 & ' Number of level 2 nodes =',i16/
2906 & ' Number of split nodes =',i16/
2907 & ' RINFOG(1) Operations during elimination (estim)=',
2908 & 1pd10.3)
290999993 FORMAT(' Ordering compressed/constrained (ICNTL(12)) =',i16)
291099994 FORMAT(' Distributed matrix entry format (ICNTL(18)) =',i16)
291199995 FORMAT(' Effective Schur option (ICNTL(19)) =',i16/
2912 & ' Size of Schur (SIZE_SCHUR) =',i16)
291399996 FORMAT(' Forward solution during factorization, NRHS =',i16)

◆ smumps_dist_avoid_copies()

subroutine smumps_dist_avoid_copies ( integer n,
integer nslaves,
integer, dimension(60) icntl,
integer, dimension(80) infog,
integer, dimension(n) ne,
integer, dimension(n) nfsiz,
integer, dimension(n) frere,
integer, dimension(n) fils,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(n) procnode,
integer, dimension(n) ssarbr,
integer nbsa,
real peak,
integer ierr,
integer, dimension(lsizeofblocks), intent(in) sizeofblocks,
integer, intent(in) lsizeofblocks )

Definition at line 4198 of file sana_aux.F.

4205 USE mumps_static_mapping
4206 IMPLICIT NONE
4207 INTEGER N, NSLAVES, NBSA, IERR
4208 INTEGER ICNTL(60),INFOG(80),KEEP(500)
4209 INTEGER(8) KEEP8(150)
4210 INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N)
4211 INTEGER SSARBR(N)
4212 REAL PEAK
4213 INTEGER, intent(IN) :: LSIZEOFBLOCKS
4214 INTEGER, intent(IN) :: SIZEOFBLOCKS(LSIZEOFBLOCKS)
4215 CALL mumps_distribute(n,nslaves,
4216 & icntl,infog, ne, nfsiz,
4217 & frere, fils,
4218 & keep,keep8,procnode,
4219 & ssarbr,nbsa,dble(peak),ierr
4220 & , sizeofblocks, lsizeofblocks
4221 & )
4222 RETURN
mumps_static_mapping
Definition mumps_static_mapping.F:14
mumps_static_mapping::mumps_distribute
subroutine, public mumps_distribute(n, slavef, icntl, info, ne, nfsiz, frere, fils, keep, keep8, procnode, ssarbr, nbsa, peak, istat, sizeofblocks, lsizeofblocks)
Definition mumps_static_mapping.F:94

◆ smumps_expand_tree_steps()

subroutine smumps_expand_tree_steps ( integer, dimension(60), intent(in) icntl,
integer, intent(in) n,
integer, intent(in) nblk,
integer, dimension(nblk+1), intent(in) blkptr,
integer, dimension(n), intent(in) blkvar,
integer, dimension(nblk), intent(in) fils_old,
integer, dimension(n), intent(out) fils_new,
integer, intent(in) nsteps,
integer, dimension(nblk), intent(in) step_old,
integer, dimension(n), intent(out) step_new,
integer, dimension(nb_niv2), intent(inout) par2_nodes,
integer, intent(in) nb_niv2,
integer, dimension(nsteps), intent(inout) dad_steps,
integer, dimension(nsteps), intent(inout) frere_steps,
integer, dimension(lna), intent(inout) na,
integer, intent(in) lna,
integer, dimension(nblk), intent(in) lrgroups_old,
integer, dimension(n), intent(out) lrgroups_new,
integer, intent(inout) k20,
integer, intent(inout) k38 )

Definition at line 4099 of file sana_aux.F.

4107 IMPLICIT NONE
4108 INTEGER, INTENT(IN) :: N, NBLK, ICNTL(60), NSTEPS, LNA,
4109 & NB_NIV2
4110 INTEGER, INTENT(IN) :: BLKPTR(NBLK+1), BLKVAR(N)
4111 INTEGER, INTENT(IN) :: FILS_OLD(NBLK), STEP_OLD(NBLK),
4112 & LRGROUPS_OLD(NBLK)
4113 INTEGER, INTENT(OUT) :: FILS_NEW(N), STEP_NEW(N),
4114 & LRGROUPS_NEW(N)
4115 INTEGER, INTENT(INOUT) :: DAD_STEPS(NSTEPS), FRERE_STEPS(NSTEPS)
4116 INTEGER, INTENT(INOUT) :: NA(LNA), PAR2_NODES(NB_NIV2), K20, K38
4117 INTEGER :: IB, I, IBFS, IBNB, IFS, INB
4118 INTEGER NBLEAF, NBROOT, ISTEP, IGROUP
4119 INTEGER :: II
4120 IF (k20.GT.0) k20 = blkvar(blkptr(k20))
4121 IF (k38.GT.0) k38 = blkvar(blkptr(k38))
4122 nbleaf = na(1)
4123 nbroot = na(2)
4124 IF (nblk.GT.1) THEN
4125 DO i= 3, 3+nbleaf+nbroot-1
4126 ibnb = na(i)
4127 inb = blkvar(blkptr(ibnb))
4128 na(i) = inb
4129 ENDDO
4130 ENDIF
4131 IF (par2_nodes(1).GT.0) THEN
4132 DO i=1, nb_niv2
4133 ibnb = par2_nodes(i)
4134 inb = blkvar(blkptr(ibnb))
4135 par2_nodes(i) = inb
4136 ENDDO
4137 ENDIF
4138 DO i= 1, nsteps
4139 ibnb = dad_steps(i)
4140 IF (ibnb.EQ.0) THEN
4141 inb = 0
4142 ELSE
4143 inb = blkvar(blkptr(ibnb))
4144 ENDIF
4145 dad_steps(i) = inb
4146 ENDDO
4147 DO i= 1, nsteps
4148 ibnb = frere_steps(i)
4149 IF (ibnb.EQ.0) THEN
4150 inb = 0
4151 ELSE
4152 inb = blkvar(blkptr(abs(ibnb)))
4153 IF (ibnb.LT.0) inb=-inb
4154 ENDIF
4155 frere_steps(i) = inb
4156 ENDDO
4157 DO ib=1, nblk
4158 ibfs = fils_old(ib)
4159 IF (ibfs.EQ.0) THEN
4160 ifs = 0
4161 ELSE
4162 ifs = blkvar(blkptr(abs(ibfs)))
4163 IF (ibfs.LT.0) ifs=-ifs
4164 ENDIF
4165 IF (blkptr(ib+1)-blkptr(ib).EQ.0) cycle
4166 DO ii=blkptr(ib), blkptr(ib+1)-1
4167 IF (ii.LT. blkptr(ib+1)-1) THEN
4168 fils_new(blkvar(ii))= blkvar(ii+1)
4169 ELSE
4170 fils_new(blkvar(ii))= ifs
4171 ENDIF
4172 ENDDO
4173 ENDDO
4174 DO ib=1, nblk
4175 istep = step_old(ib)
4176 IF (blkptr(ib+1)-blkptr(ib).EQ.0) cycle
4177 IF (istep.LT.0) THEN
4178 DO ii=blkptr(ib), blkptr(ib+1)-1
4179 step_new(blkvar(ii)) = istep
4180 ENDDO
4181 ELSE
4182 i = blkvar(blkptr(ib))
4183 step_new(i) = istep
4184 DO ii=blkptr(ib)+1, blkptr(ib+1)-1
4185 step_new(blkvar(ii)) = -istep
4186 ENDDO
4187 ENDIF
4188 ENDDO
4189 DO ib=1, nblk
4190 igroup = lrgroups_old(ib)
4191 IF (blkptr(ib+1)-blkptr(ib).EQ.0) cycle
4192 DO ii=blkptr(ib), blkptr(ib+1)-1
4193 lrgroups_new(blkvar(ii)) = igroup
4194 ENDDO
4195 ENDDO
4196 RETURN

◆ smumps_mtrans_driver()

subroutine smumps_mtrans_driver ( integer job,
integer m,
integer n,
integer(8), intent(in) ne,
integer(8), dimension(n+1) ip,
integer, dimension(ne) irn,
real, dimension(la) a,
integer(8), intent(in) la,
integer num,
integer, dimension(m) perm,
integer(8), intent(in) liw,
integer, dimension(liw) iw,
integer(8), intent(in) ldw,
real, dimension(ldw) dw,
integer(8), dimension(n) ipq8,
integer, dimension(nicntl) icntl,
real, dimension(ncntl) cntl,
integer, dimension(ninfo) info,
integer, dimension(80) infomumps )

Definition at line 3608 of file sana_aux.F.

3612 IMPLICIT NONE
3613 INTEGER :: NICNTL, NCNTL, NINFO, INFOMUMPS(80)
3614 parameter(nicntl=10, ncntl=10, ninfo=10)
3615 INTEGER :: JOB,M,N,NUM
3616 INTEGER(8), INTENT(IN) :: NE, LIW,LDW, LA
3617 INTEGER(8) :: IP(N+1), IPQ8(N)
3618 INTEGER :: IRN(NE),PERM(M),IW(LIW)
3619 INTEGER :: ICNTL(NICNTL),INFO(NINFO)
3620 REAL :: A(LA)
3621 REAL :: DW(LDW),CNTL(NCNTL)
3622 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWtemp8
3623 INTEGER :: allocok
3624 INTEGER :: I,J,WARN1,WARN2,WARN4
3625 INTEGER(8) :: K
3626 REAL :: FACT,ZERO,ONE,RINF,RINF2,RINF3
3627 PARAMETER (zero=0.0e+00,one=1.0e+0)
3628 EXTERNAL smumps_mtransz,smumps_mtransb,smumps_mtransr,
3629 & smumps_mtranss,smumps_mtransw
3630 INTRINSIC abs,log
3631 rinf = cntl(2)
3632 rinf2 = huge(rinf2)/real(2*n)
3633 rinf3 = 0.0e0
3634 warn1 = 0
3635 warn2 = 0
3636 warn4 = 0
3637 IF (job.LT.1 .OR. job.GT.6) THEN
3638 info(1) = -1
3639 info(2) = job
3640 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'JOB',job
3641 GO TO 99
3642 ENDIF
3643 IF (m.LT.1 .OR. m.LT.n) THEN
3644 info(1) = -2
3645 info(2) = m
3646 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'M',m
3647 GO TO 99
3648 ENDIF
3649 IF (n.LT.1) THEN
3650 info(1) = -2
3651 info(2) = n
3652 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'N',n
3653 GO TO 99
3654 ENDIF
3655 IF (ne.LT.1) THEN
3656 info(1) = -3
3657 CALL mumps_set_ierror(ne,info(2))
3658 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'NE',ne
3659 GO TO 99
3660 ENDIF
3661 IF (job.EQ.1) k = int(4*n + m,8)
3662 IF (job.EQ.2) k = int(n + 2*m,8)
3663 IF (job.EQ.3) k = int(8*n + 2*m + ne,8)
3664 IF (job.EQ.4) k = int(n + m,8)
3665 IF (job.EQ.5) k = int(3*n + 2*m,8)
3666 IF (job.EQ.6) k = int(3*n + 2*m + ne,8)
3667 IF (liw.LT.k) THEN
3668 info(1) = -4
3669 CALL mumps_set_ierror(k,info(2))
3670 IF (icntl(1).GE.0) WRITE(icntl(1),9004) info(1),k
3671 GO TO 99
3672 ENDIF
3673 IF (job.GT.1) THEN
3674 IF (job.EQ.2) k = int( m,8)
3675 IF (job.EQ.3) k = int(1,8)
3676 IF (job.EQ.4) k = int( 2*m,8)
3677 IF (job.EQ.5) k = int(n + 2*m,8)
3678 IF (job.EQ.6) k = int(n + 3*m,8)
3679 IF (ldw .LT. k) THEN
3680 info(1) = -5
3681 CALL mumps_set_ierror(k,info(2))
3682 IF (icntl(1).GE.0) WRITE(icntl(1),9005) info(1),k
3683 GO TO 99
3684 ENDIF
3685 ENDIF
3686 IF (icntl(5).EQ.0) THEN
3687 DO 3 i = 1,m
3688 iw(i) = 0
3689 3 CONTINUE
3690 DO 6 j = 1,n
3691 DO 4 k = ip(j),ip(j+1)-1_8
3692 i = irn(k)
3693 IF (i.LT.1 .OR. i.GT.m) THEN
3694 info(1) = -6
3695 info(2) = j
3696 IF (icntl(1).GE.0) WRITE(icntl(1),9006) info(1),j,i
3697 GO TO 99
3698 ENDIF
3699 IF (iw(i).EQ.j) THEN
3700 info(1) = -7
3701 info(2) = j
3702 IF (icntl(1).GE.0) WRITE(icntl(1),9007) info(1),j,i
3703 GO TO 99
3704 ELSE
3705 iw(i) = j
3706 ENDIF
3707 4 CONTINUE
3708 6 CONTINUE
3709 ENDIF
3710 IF (icntl(3).GT.0) THEN
3711 IF (icntl(4).EQ.0 .OR. icntl(4).EQ.1) THEN
3712 WRITE(icntl(3),9020) job,m,n,ne
3713 IF (icntl(4).EQ.0) THEN
3714 WRITE(icntl(3),9021) (ip(j),j=1,min(10,n+1))
3715 WRITE(icntl(3),9022) (irn(k),k=1_8,min(10_8,ne))
3716 IF (job.GT.1) WRITE(icntl(3),9023)
3717 & (a(k),k=1_8,min(10_8,ne))
3718 ELSEIF (icntl(4).EQ.1) THEN
3719 WRITE(icntl(3),9021) (ip(j),j=1,n+1)
3720 WRITE(icntl(3),9022) (irn(k),k=1_8,ne)
3721 IF (job.GT.1) WRITE(icntl(3),9023) (a(k),k=1_8,ne)
3722 ENDIF
3723 WRITE(icntl(3),9024) (icntl(j),j=1,nicntl)
3724 WRITE(icntl(3),9025) (cntl(j),j=1,ncntl)
3725 ENDIF
3726 ENDIF
3727 DO 8 i=1,ninfo
3728 info(i) = 0
3729 8 CONTINUE
3730 IF (job.EQ.1) THEN
3731 DO 10 j = 1,n
3732 iw(j) = int(ip(j+1) - ip(j))
3733 10 CONTINUE
3734 CALL smumps_mtransz(m,n,irn,ne,ip,iw(1),perm,num,
3735 & iw(n+1),iw(2*n+1),iw(3*n+1),iw(3*n+m+1))
3736 GO TO 90
3737 ENDIF
3738 IF (job.EQ.2) THEN
3739 dw(1) = max(zero,cntl(1))
3740 CALL smumps_mtransb(m,n,ne,ip,irn,a,perm,num,
3741 & iw(1),ipq8,iw(n+1),iw(n+m+1),dw,rinf2)
3742 GO TO 90
3743 ENDIF
3744 IF (job.EQ.3) THEN
3745 DO 20 k = 1,ne
3746 iw(k) = irn(k)
3747 20 CONTINUE
3748 CALL smumps_mtransr(n,ne,ip,iw,a)
3749 fact = max(zero,cntl(1))
3750 CALL smumps_mtranss(m,n,ne,ip,iw(1),a,perm,num,iw(ne+1),
3751 & iw(ne+n+1),iw(ne+2*n+1),iw(ne+3*n+1),iw(ne+4*n+1),
3752 & iw(ne+5*n+1),iw(ne+5*n+m+1),fact,rinf2)
3753 GO TO 90
3754 ENDIF
3755 IF ((job.EQ.4).OR.(job.EQ.5).or.(job.EQ.6)) THEN
3756 ALLOCATE(iwtemp8(m+n+n), stat=allocok)
3757 IF (allocok.GT.0) THEN
3758 infomumps(1) = -7
3759 infomumps(2) = m+n+n
3760 GOTO 90
3761 ENDIF
3762 ENDIF
3763 IF (job.EQ.4) THEN
3764 DO 50 j = 1,n
3765 fact = zero
3766 DO 30 k = ip(j),ip(j+1)-1_8
3767 IF (abs(a(k)).GT.fact) fact = abs(a(k))
3768 30 CONTINUE
3769 IF(fact .GT. rinf3) rinf3 = fact
3770 DO 40 k = ip(j),ip(j+1)-1_8
3771 a(k) = fact - abs(a(k))
3772 40 CONTINUE
3773 50 CONTINUE
3774 dw(1) = max(zero,cntl(1))
3775 dw(2) = rinf3
3776 iwtemp8(1) = int(job,8)
3777 CALL smumps_mtransw(m,n,ne,ip,irn,a,perm,num,
3778 & iwtemp8(1),iw(1),iwtemp8(n+1),ipq8,iw(n+1),
3779 & iwtemp8(2*n+1),
3780 & dw(1),dw(m+1),rinf2)
3781 DEALLOCATE(iwtemp8)
3782 GO TO 90
3783 ENDIF
3784 IF (job.EQ.5 .or. job.EQ.6) THEN
3785 rinf3=one
3786 IF (job.EQ.5) THEN
3787 DO 75 j = 1,n
3788 fact = zero
3789 DO 60 k = ip(j),ip(j+1)-1_8
3790 IF (a(k).GT.fact) fact = a(k)
3791 60 CONTINUE
3792 dw(2*m+j) = fact
3793 IF (fact.NE.zero) THEN
3794 fact = log(fact)
3795 IF(fact .GT. rinf3) rinf3=fact
3796 DO 70 k = ip(j),ip(j+1)-1_8
3797 IF (a(k).NE.zero) THEN
3798 a(k) = fact - log(a(k))
3799 IF(a(k) .GT. rinf3) rinf3=a(k)
3800 ELSE
3801 a(k) = fact + rinf
3802 ENDIF
3803 70 CONTINUE
3804 ELSE
3805 DO 71 k = ip(j),ip(j+1)-1_8
3806 a(k) = one
3807 71 CONTINUE
3808 ENDIF
3809 75 CONTINUE
3810 ENDIF
3811 IF (job.EQ.6) THEN
3812 DO 175 k = 1,ne
3813 iw(3*n+2*m+k) = irn(k)
3814 175 CONTINUE
3815 DO 61 i = 1,m
3816 dw(2*m+n+i) = zero
3817 61 CONTINUE
3818 DO 63 j = 1,n
3819 DO 62 k = ip(j),ip(j+1)-1_8
3820 i = irn(k)
3821 IF (a(k).GT.dw(2*m+n+i)) THEN
3822 dw(2*m+n+i) = a(k)
3823 ENDIF
3824 62 CONTINUE
3825 63 CONTINUE
3826 DO 64 i = 1,m
3827 IF (dw(2*m+n+i).NE.zero) THEN
3828 dw(2*m+n+i) = 1.0e0/dw(2*m+n+i)
3829 ENDIF
3830 64 CONTINUE
3831 DO 66 j = 1,n
3832 DO 65 k = ip(j),ip(j+1)-1
3833 i = irn(k)
3834 a(k) = dw(2*m+n+i) * a(k)
3835 65 CONTINUE
3836 66 CONTINUE
3837 CALL smumps_mtransr(n,ne,ip,iw(3*n+2*m+1),a)
3838 DO 176 j = 1,n
3839 IF (ip(j).NE.ip(j+1)) THEN
3840 fact = a(ip(j))
3841 ELSE
3842 fact = zero
3843 ENDIF
3844 dw(2*m+j) = fact
3845 IF (fact.NE.zero) THEN
3846 fact = log(fact)
3847 DO 170 k = ip(j),ip(j+1)-1_8
3848 IF (a(k).NE.zero) THEN
3849 a(k) = fact - log(a(k))
3850 IF(a(k) .GT. rinf3) rinf3=a(k)
3851 ELSE
3852 a(k) = fact + rinf
3853 ENDIF
3854 170 CONTINUE
3855 ELSE
3856 DO 171 k = ip(j),ip(j+1)-1_8
3857 a(k) = one
3858 171 CONTINUE
3859 ENDIF
3860 176 CONTINUE
3861 ENDIF
3862 dw(1) = max(zero,cntl(1))
3863 rinf3 = rinf3+one
3864 dw(2) = rinf3
3865 iwtemp8(1) = int(job,8)
3866 IF (job.EQ.5) THEN
3867 CALL smumps_mtransw(m,n,ne,ip,irn,a,perm,num,
3868 & iwtemp8(1),iw(1),iwtemp8(n+1),ipq8,iw(n+1),
3869 & iwtemp8(2*n+1),
3870 & dw(1),dw(m+1),rinf2)
3871 ENDIF
3872 IF (job.EQ.6) THEN
3873 CALL smumps_mtransw(m,n,ne,ip,iw(3*n+2*m+1),a,perm,num,
3874 & iwtemp8(1),iw(1),iwtemp8(n+1),ipq8,iw(n+1),
3875 & iwtemp8(2*n+1),
3876 & dw(1),dw(m+1),rinf2)
3877 ENDIF
3878 IF ((job.EQ.5).or.(job.EQ.6)) THEN
3879 DEALLOCATE(iwtemp8)
3880 ENDIF
3881 IF (job.EQ.6) THEN
3882 DO 79 i = 1,m
3883 IF (dw(2*m+n+i).NE.0.0e0) THEN
3884 dw(i) = dw(i) + log(dw(2*m+n+i))
3885 ENDIF
3886 79 CONTINUE
3887 ENDIF
3888 IF (num.EQ.n) THEN
3889 DO 80 j = 1,n
3890 IF (dw(2*m+j).NE.zero) THEN
3891 dw(m+j) = dw(m+j) - log(dw(2*m+j))
3892 ELSE
3893 dw(m+j) = zero
3894 ENDIF
3895 80 CONTINUE
3896 ENDIF
3897 fact = 0.5e0*log(rinf2)
3898 DO 86 i = 1,m
3899 IF (dw(i).LT.fact) GO TO 86
3900 warn2 = 2
3901 GO TO 90
3902 86 CONTINUE
3903 DO 87 j = 1,n
3904 IF (dw(m+j).LT.fact) GO TO 87
3905 warn2 = 2
3906 GO TO 90
3907 87 CONTINUE
3908 ENDIF
3909 90 IF (infomumps(1).LT.0) RETURN
3910 IF (num.LT.n) warn1 = 1
3911 IF (job.EQ.4 .OR. job.EQ.5 .OR. job.EQ.6) THEN
3912 IF (cntl(1).LT.zero) warn4 = 4
3913 ENDIF
3914 IF (info(1).EQ.0) THEN
3915 info(1) = warn1 + warn2 + warn4
3916 IF (info(1).GT.0 .AND. icntl(2).GT.0) THEN
3917 WRITE(icntl(2),9010) info(1)
3918 IF (warn1.EQ.1) WRITE(icntl(2),9011)
3919 IF (warn2.EQ.2) WRITE(icntl(2),9012)
3920 IF (warn4.EQ.4) WRITE(icntl(2),9014)
3921 ENDIF
3922 ENDIF
3923 IF (icntl(3).GE.0) THEN
3924 IF (icntl(4).EQ.0 .OR. icntl(4).EQ.1) THEN
3925 WRITE(icntl(3),9030) (info(j),j=1,2)
3926 WRITE(icntl(3),9031) num
3927 IF (icntl(4).EQ.0) THEN
3928 WRITE(icntl(3),9032) (perm(j),j=1,min(10,m))
3929 IF (job.EQ.5 .OR. job.EQ.6) THEN
3930 WRITE(icntl(3),9033) (dw(j),j=1,min(10,m))
3931 WRITE(icntl(3),9034) (dw(m+j),j=1,min(10,n))
3932 ENDIF
3933 ELSEIF (icntl(4).EQ.1) THEN
3934 WRITE(icntl(3),9032) (perm(j),j=1,m)
3935 IF (job.EQ.5 .OR. job.EQ.6) THEN
3936 WRITE(icntl(3),9033) (dw(j),j=1,m)
3937 WRITE(icntl(3),9034) (dw(m+j),j=1,n)
3938 ENDIF
3939 ENDIF
3940 ENDIF
3941 ENDIF
3942 99 RETURN
3943 9001 FORMAT (' ****** Error in SMUMPS_MTRANSA. INFO(1) = ',i2,
3944 & ' because ',(a),' = ',i14)
3945 9004 FORMAT (' ****** Error in SMUMPS_MTRANSA. INFO(1) = ',i2/
3946 & ' LIW too small, must be at least ',i14)
3947 9005 FORMAT (' ****** Error in SMUMPS_MTRANSA. INFO(1) = ',i2/
3948 & ' LDW too small, must be at least ',i14)
3949 9006 FORMAT (' ****** Error in SMUMPS_MTRANSA. INFO(1) = ',i2/
3950 & ' Column ',i8,
3951 & ' contains an entry with invalid row index ',i8)
3952 9007 FORMAT (' ****** Error in SMUMPS_MTRANSA. INFO(1) = ',i2/
3953 & ' Column ',i8,
3954 & ' contains two or more entries with row index ',i8)
3955 9010 FORMAT (' ****** Warning from SMUMPS_MTRANSA. INFO(1) = ',i2)
3956 9011 FORMAT (' - The matrix is structurally singular.')
3957 9012 FORMAT (' - Some scaling factors may be too large.')
3958 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.')
3959 9020 FORMAT (' ****** Input parameters for SMUMPS_MTRANSA:'/
3960 & ' JOB =',i10/' M =',i10/' N =',i10/' NE =',i14)
3961 9021 FORMAT (' IP(1:N+1) = ',8i8/(15x,8i8))
3962 9022 FORMAT (' IRN(1:NE) = ',8i8/(15x,8i8))
3963 9023 FORMAT (' A(1:NE) = ',4(1pd14.4)/(15x,4(1pd14.4)))
3964 9024 FORMAT (' ICNTL(1:10) = ',8i8/(15x,2i8))
3965 9025 FORMAT (' CNTL(1:10) = ',4(1pd14.4)/(15x,4(1pd14.4)))
3966 9030 FORMAT (' ****** Output parameters for SMUMPS_MTRANSA:'/
3967 & ' INFO(1:2) = ',2i8)
3968 9031 FORMAT (' NUM = ',i8)
3969 9032 FORMAT (' PERM(1:M) = ',8i8/(15x,8i8))
3970 9033 FORMAT (' DW(1:M) = ',5(f11.3)/(15x,5(f11.3)))
3971 9034 FORMAT (' DW(M+1:M+N) = ',5(f11.3)/(15x,5(f11.3)))
smumps_mtranss
subroutine smumps_mtranss(m, n, ne, ip, irn, a, iperm, numx, w, len, lenl, lenh, fc, iw, iw4, rlx, rinf)
Definition sana_mtrans.F:570
smumps_mtransb
subroutine smumps_mtransb(m, n, ne, ip, irn, a, iperm, num, jperm, pr, q, l, d, rinf)
Definition sana_mtrans.F:62
smumps_mtransw
subroutine smumps_mtransw(m, n, ne, ip, irn, a, iperm, num, jperm, l32, out, pr, q, l, u, d, rinf)
Definition sana_mtrans.F:793
smumps_mtransr
subroutine smumps_mtransr(n, ne, ip, irn, a)
Definition sana_mtrans.F:485
smumps_mtransz
subroutine smumps_mtransz(m, n, irn, lirn, ip, lenc, iperm, num, pr, arp, cv, out)
Definition sana_mtrans.F:1084
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865

◆ smumps_set_k821_surface()

subroutine smumps_set_k821_surface ( integer (8) keep821,
integer keep2,
integer keep48,
integer keep50,
integer nslaves )

Definition at line 3552 of file sana_aux.F.

3554 IMPLICIT NONE
3555 INTEGER NSLAVES, KEEP2, KEEP48, KEEP50
3556 INTEGER (8) :: KEEP821
3557 INTEGER(8) KEEP2_SQUARE, NSLAVES8
3558 nslaves8= int(nslaves,8)
3559 keep2_square = int(keep2,8) * int(keep2,8)
3560 keep821 = max(keep821*int(keep2,8),1_8)
3561#if defined(t3e)
3562 keep821 = min(1500000_8, keep821)
3563#elif defined(SP_)
3564 keep821 = min(3000000_8, keep821)
3565#else
3566 keep821 = min(2000000_8, keep821)
3567#endif
3568#if defined(t3e)
3569 IF (nslaves .GT. 64) THEN
3570 keep821 =
3571 & min(8_8*keep2_square/nslaves8+1_8, keep821)
3572 ELSE
3573 keep821 =
3574 & min(4_8*keep2_square/nslaves8+1_8, keep821)
3575 ENDIF
3576#else
3577 IF (nslaves.GT.64) THEN
3578 keep821 =
3579 & min(6_8*keep2_square/nslaves8+1_8, keep821)
3580 ELSE
3581 keep821 =
3582 & min(4_8*keep2_square/nslaves8+1_8, keep821)
3583 ENDIF
3584#endif
3585 IF (keep50 .EQ. 0 ) THEN
3586 keep821 = max(keep821,(7_8*keep2_square /
3587 & 4_8 / int(max(nslaves-1,1),8)) + int(keep2,8))
3588 ELSE
3589 keep821 = max(keep821,(7_8*keep2_square /
3590 & 4_8 / int(max(nslaves-1,1),8)) + int(keep2,8))
3591 ENDIF
3592 IF (keep50 .EQ. 0 ) THEN
3593#if defined(t3e)
3594 keep821 = max(keep821,200000_8)
3595#else
3596 keep821 = max(keep821,300000_8)
3597#endif
3598 ELSE
3599#if defined(t3e)
3600 keep821 = max(keep821,40000_8)
3601#else
3602 keep821 = max(keep821,80000_8)
3603#endif
3604 ENDIF
3605 keep821 = -keep821
3606 RETURN

◆ smumps_set_procnode()

subroutine smumps_set_procnode ( integer, intent(in) inode,
integer, dimension(n), intent(inout) procnode,
integer, intent(in) value,
integer, dimension(n), intent(in) fils,
integer, intent(in) n )

Definition at line 4224 of file sana_aux.F.

4225 INTEGER, intent(in) :: INODE, N, VALUE
4226 INTEGER, intent(in) :: FILS(N)
4227 INTEGER, intent(inout) :: PROCNODE(N)
4228 INTEGER IN
4229 in=inode
4230 DO WHILE ( in > 0 )
4231 procnode( in ) = VALUE
4232 in=fils( in )
4233 ENDDO
4234 RETURN

◆ smumps_sort_perm()

subroutine smumps_sort_perm ( integer, intent(in) n,
integer, dimension(lna), intent(in) na,
integer, intent(in) lna,
integer, dimension (nsteps), intent(in) ne_steps,
integer, dimension( n ), intent(out) perm,
integer, dimension( n ), intent(in) fils,
integer, dimension ( nsteps ), intent(in) dad_steps,
integer, dimension(n), intent(in) step,
integer, intent(in) nsteps,
integer, intent(in) keep60,
integer, intent(in) keep20,
integer, intent(in) keep38,
integer, dimension(80), intent(inout) info )

Definition at line 4034 of file sana_aux.F.

4039 IMPLICIT NONE
4040 INTEGER, INTENT(IN) :: N, NSTEPS, LNA
4041 INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA)
4042 INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS)
4043 INTEGER, INTENT(IN) :: KEEP60, KEEP20, KEEP38
4044 INTEGER, INTENT(INOUT) :: INFO(80)
4045 INTEGER, INTENT(OUT) :: PERM( N )
4046 INTEGER :: IPERM, INODE, IN, ISCHUR
4047 INTEGER :: INBLEAF, INBROOT, allocok
4048 INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK
4049 inbleaf = na(1)
4050 inbroot = na(2)
4051 ALLOCATE(pool(inbleaf), nstk(nsteps), stat=allocok)
4052 IF (allocok > 0 ) THEN
4053 info(1) = -7
4054 info(2) = inbleaf + nsteps
4055 RETURN
4056 ENDIF
4057 pool(1:inbleaf) = na(3:2+inbleaf)
4058 nstk(1:nsteps) = ne_steps(1:nsteps)
4059 ischur = 0
4060 IF ( keep60.GT.0 ) THEN
4061 ischur = max(keep20, keep38)
4062 ENDIF
4063 iperm = 1
4064 DO WHILE ( inbleaf .NE. 0 )
4065 inode = pool( inbleaf )
4066 inbleaf = inbleaf - 1
4067 in = inode
4068 IF (inode.NE.ischur) THEN
4069 DO WHILE ( in .GT. 0 )
4070 perm( in ) = iperm
4071 iperm = iperm + 1
4072 in = fils( in )
4073 END DO
4074 ENDIF
4075 in = dad_steps(step( inode ))
4076 IF ( in .eq. 0 ) THEN
4077 inbroot = inbroot - 1
4078 ELSE
4079 nstk( step(in) ) = nstk( step(in) ) - 1
4080 IF ( nstk( step(in) ) .eq. 0 ) THEN
4081 inbleaf = inbleaf + 1
4082 pool( inbleaf ) = in
4083 END IF
4084 END IF
4085 END DO
4086 IF (iperm.LE.n) THEN
4087 IF (ischur.GT.0) THEN
4088 in = ischur
4089 DO WHILE ( in .GT. 0 )
4090 perm( in ) = iperm
4091 iperm = iperm + 1
4092 in = fils( in )
4093 END DO
4094 ENDIF
4095 ENDIF
4096 DEALLOCATE(pool, nstk)
4097 RETURN

◆ smumps_split_1node()

recursive subroutine smumps_split_1node ( integer inode,
integer n,
integer, dimension( n ) frere,
integer, dimension( n ) fils,
integer, dimension( n ) nfsiz,
integer nsteps,
integer nslaves,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer tot_cut,
integer strat,
integer depth,
integer(8) k79,
logical splitroot,
integer mp,
integer ldiag,
logical blkon,
integer, dimension(lsizeofblocks) sizeofblocks,
integer lsizeofblocks )

Definition at line 3029 of file sana_aux.F.

3033 IMPLICIT NONE
3034 INTEGER(8) :: K79
3035 INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT,
3036 & DEPTH, TOT_CUT, MP, LDIAG
3037 INTEGER(8) KEEP8(150)
3038 INTEGER FRERE( N ), FILS( N ), NFSIZ( N )
3039 LOGICAL SPLITROOT
3040 LOGICAL BLKON
3041 INTEGER LSIZEOFBLOCKS
3042 INTEGER SIZEOFBLOCKS(LSIZEOFBLOCKS)
3043 INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM
3044 REAL WK_SLAVE, WK_MASTER
3045 INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH
3046 INTEGER NPIV_COMPG, NPIV_SON_COMPG, NPIV_FATH_COMPG
3047 INTEGER NPIV_SON, NPIV_FATH, NPIV_TEMP
3048 INTEGER NCB, NSLAVESMIN, NSLAVESMAX
3049 INTEGER MUMPS_BLOC2_GET_NSLAVESMIN,
3050 & MUMPS_BLOC2_GET_NSLAVESMAX
3051 EXTERNAL mumps_bloc2_get_nslavesmin,
3052 & mumps_bloc2_get_nslavesmax
3053 IF ( (keep(210).EQ.1.AND.keep(60).EQ.0) .OR.
3054 & (splitroot) ) THEN
3055 IF ( frere( inode ) .eq. 0 ) THEN
3056 nfront = nfsiz( inode )
3057 npiv = nfront
3058 IF (blkon) THEN
3059 in = inode
3060 npiv_compg = 0
3061 DO WHILE( in > 0 )
3062 npiv_compg = npiv_compg + 1
3063 in = fils( in )
3064 ENDDO
3065 ELSE
3066 npiv_compg = npiv
3067 ENDIF
3068 ncb = 0
3069 IF ( int(nfront,8)*int(nfront,8).GT.k79
3070 & ) THEN
3071 GOTO 333
3072 ENDIF
3073 ENDIF
3074 ENDIF
3075 IF ( frere( inode ) .eq. 0 ) RETURN
3076 nfront = nfsiz( inode )
3077 in = inode
3078 npiv = 0
3079 npiv_compg = 0
3080 DO WHILE( in > 0 )
3081 IF (blkon) THEN
3082 npiv = npiv + sizeofblocks(in)
3083 ENDIF
3084 npiv_compg = npiv_compg + 1
3085 in = fils( in )
3086 END DO
3087 IF (.NOT.blkon) npiv = npiv_compg
3088 ncb = nfront - npiv
3089 IF ( (nfront - (npiv/2)) .LE. keep(9)) RETURN
3090 IF ((keep(50) == 0.and.int(nfront,8) * int(npiv,8) > k79 ) .OR.
3091 &(keep(50) .NE.0.and.int(npiv,8) * int(npiv,8) > k79 )) GOTO 333
3092 IF (keep(210).EQ.1) THEN
3093 nslavesmin = 1
3094 nslavesmax = 64
3095 nslaves_estim = 32+nslaves
3096 ELSE
3097 nslavesmin = mumps_bloc2_get_nslavesmin
3098 & ( nslaves, keep(48), keep8(21), keep(50),
3099 & nfront, ncb, keep(375), keep(119))
3100 nslavesmax = mumps_bloc2_get_nslavesmax
3101 & ( nslaves, keep(48), keep8(21), keep(50),
3102 & nfront, ncb, keep(375), keep(119))
3103 nslaves_estim = max(1,
3104 & nint( real(nslavesmax-nslavesmin)/real(3) )
3105 & )
3106 nslaves_estim = min(nslaves_estim, nslaves-1)
3107 ENDIF
3108 IF ( keep(50) .eq. 0 ) THEN
3109 wk_master = 0.6667e0 *
3110 & real(npiv)*real(npiv)*real(npiv) +
3111 & real(npiv)*real(npiv)*real(ncb)
3112 wk_slave = real( npiv ) * real( ncb ) *
3113 & ( 2.0e0 * real(nfront) - real(npiv) )
3114 & / real(nslaves_estim)
3115 ELSE
3116 wk_master = real(npiv)*real(npiv)*real(npiv) / real(3)
3117 wk_slave =
3118 & (real(npiv)*real(ncb)*real(nfront))
3119 & / real(nslaves_estim)
3120 ENDIF
3121 IF (keep(210).EQ.1) THEN
3122 IF ( real( 100 + strat )
3123 & * wk_slave / real(100) .GE. wk_master ) RETURN
3124 ELSE
3125 IF ( real( 100 + strat * max( depth-1, 1 ) )
3126 & * wk_slave / real(100) .GE. wk_master ) RETURN
3127 ENDIF
3128 333 CONTINUE
3129 IF (npiv .LE. 1 ) RETURN
3130 npiv_son = max(npiv/2,1)
3131 npiv_fath = npiv - npiv_son
3132 IF (splitroot) THEN
3133 IF (ncb .ne .0) THEN
3134 WRITE(*,*) "Error splitting"
3135 CALL mumps_abort()
3136 ENDIF
3137 npiv_fath = min(int(sqrt(real(k79))), int(npiv/2))
3138 npiv_son = npiv - npiv_fath
3139 ENDIF
3140 inode_son = inode
3141 IF (blkon) THEN
3142 npiv_temp = 0
3143 npiv_son_compg = 0
3144 in_son = inode
3145 DO WHILE (in_son > 0)
3146 npiv_temp = npiv_temp + sizeofblocks(in_son)
3147 npiv_son_compg = npiv_son_compg +1
3148 IF (npiv_temp.GE.npiv_son) EXIT
3149 in_son = fils( in_son )
3150 END DO
3151 npiv_fath_compg = npiv_compg - npiv_son_compg
3152 npiv_son = npiv_temp
3153 npiv_fath = npiv - npiv_son
3154 ELSE
3155 npiv_son_compg = npiv_son
3156 npiv_fath_compg = npiv_fath
3157 in_son = inode
3158 DO i = 1, npiv_son_compg - 1
3159 in_son = fils( in_son )
3160 END DO
3161 ENDIF
3162 IF (npiv_fath_compg.EQ.0) RETURN
3163 nsteps = nsteps + 1
3164 tot_cut = tot_cut + 1
3165 inode_fath = fils( in_son )
3166 IF ( inode_fath .LT. 0 ) THEN
3167 write(*,*) 'Error: INODE_FATH < 0 ', inode_fath
3168 END IF
3169 in_fath = inode_fath
3170 DO WHILE ( fils( in_fath ) > 0 )
3171 in_fath = fils( in_fath )
3172 END DO
3173 frere( inode_fath ) = frere( inode_son )
3174 frere( inode_son ) = - inode_fath
3175 fils( in_son ) = fils( in_fath )
3176 fils( in_fath ) = - inode_son
3177 in = frere( inode_fath )
3178 DO WHILE ( in > 0 )
3179 in = frere( in )
3180 END DO
3181 IF ( in .eq. 0 ) GO TO 10
3182 in = -in
3183 DO WHILE ( fils( in ) > 0 )
3184 in = fils( in )
3185 END DO
3186 in_grandfath = in
3187 IF ( fils( in_grandfath ) .eq. - inode_son ) THEN
3188 fils( in_grandfath ) = -inode_fath
3189 ELSE
3190 in = in_grandfath
3191 in = - fils( in )
3192 DO WHILE ( frere( in ) > 0 )
3193 IF ( frere( in ) .eq. inode_son ) THEN
3194 frere( in ) = inode_fath
3195 GOTO 10
3196 END IF
3197 in = frere( in )
3198 END DO
3199 WRITE(*,*) 'ERROR 2 in SPLIT NODE',
3200 & in_grandfath, in, frere(in)
3201 END IF
3202 10 CONTINUE
3203 nfsiz(inode_son) = nfront
3204 nfsiz(inode_fath) = nfront - npiv_son
3205 keep(2) = max( keep(2), nfront - npiv_son )
3206 IF (splitroot) THEN
3207 RETURN
3208 ENDIF
3209 CALL smumps_split_1node
3210 & ( inode_fath, n, frere, fils, nfsiz, nsteps,
3211 & nslaves, keep,keep8, tot_cut, strat, depth,
3212 & k79, splitroot, mp, ldiag,
3213 & blkon, sizeofblocks, lsizeofblocks )
3214 IF (.NOT. splitroot) THEN
3215 CALL smumps_split_1node
3216 & ( inode_son, n, frere, fils, nfsiz, nsteps,
3217 & nslaves, keep,keep8, tot_cut, strat, depth,
3218 & k79, splitroot, mp, ldiag,
3219 & blkon, sizeofblocks, lsizeofblocks )
3220 ENDIF
3221 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_bloc2_get_nslavesmin
integer function mumps_bloc2_get_nslavesmin(slavef, k48, k821, k50, nfront, ncb, k375, k119)
Definition mumps_type2_blocking.F:17
mumps_bloc2_get_nslavesmax
integer function mumps_bloc2_get_nslavesmax(slavef, k48, k821, k50, nfront, ncb, k375, k119)
Definition mumps_type2_blocking.F:89

◆ smumps_suppress_duppli_str()

subroutine smumps_suppress_duppli_str ( integer, intent(in) n,
integer(8), intent(inout) nz,
integer(8), dimension(n+1), intent(inout) ip,
integer, dimension(nz), intent(inout) irn,
integer, dimension(n), intent(out) flag )

Definition at line 4007 of file sana_aux.F.

4008 IMPLICIT NONE
4009 INTEGER, INTENT(IN) :: N
4010 INTEGER(8), INTENT(INOUT) :: NZ
4011 INTEGER(8), INTENT(INOUT) :: IP(N+1)
4012 INTEGER, INTENT(INOUT) :: IRN(NZ)
4013 INTEGER, INTENT(OUT) :: FLAG(N)
4014 INTEGER :: ROW, COL
4015 INTEGER(8) :: K, WR_POS, BEG_COL
4016 flag = 0
4017 wr_pos = 1_8
4018 DO col=1,n
4019 beg_col = wr_pos
4020 DO k=ip(col),ip(col+1)-1_8
4021 row = irn(k)
4022 IF(flag(row) .NE. col) THEN
4023 irn(wr_pos) = row
4024 flag(row) = col
4025 wr_pos = wr_pos+1_8
4026 ENDIF
4027 ENDDO
4028 ip(col) = beg_col
4029 ENDDO
4030 ip(n+1) = wr_pos
4031 nz = wr_pos-1_8
4032 RETURN

◆ smumps_suppress_duppli_val()

subroutine smumps_suppress_duppli_val ( integer, intent(in) n,
integer(8), intent(inout) nz,
integer(8), dimension(n+1), intent(inout) ip,
integer, dimension(nz), intent(inout) irn,
real, dimension(nz), intent(inout) a,
integer, dimension(n), intent(out) flag,
integer(8), dimension(n), intent(out) posi )

Definition at line 3973 of file sana_aux.F.

3974 IMPLICIT NONE
3975 INTEGER, INTENT(IN) :: N
3976 INTEGER(8), INTENT(INOUT) :: NZ
3977 INTEGER(8), INTENT(INOUT) :: IP(N+1)
3978 INTEGER, INTENT(INOUT) :: IRN(NZ)
3979 REAL, INTENT(INOUT) :: A(NZ)
3980 INTEGER, INTENT(OUT) :: FLAG(N)
3981 INTEGER(8), INTENT(OUT) :: POSI(N)
3982 INTEGER :: ROW, COL
3983 INTEGER(8) :: K, WR_POS, BEG_COL, SV_POS
3984 flag = 0
3985 wr_pos = 1_8
3986 DO col=1,n
3987 beg_col = wr_pos
3988 DO k=ip(col),ip(col+1)-1_8
3989 row = irn(k)
3990 IF(flag(row) .NE. col) THEN
3991 irn(wr_pos) = row
3992 a(wr_pos) = a(k)
3993 flag(row) = col
3994 posi(row) = wr_pos
3995 wr_pos = wr_pos+1
3996 ELSE
3997 sv_pos = posi(row)
3998 a(sv_pos) = a(sv_pos) + a(k)
3999 ENDIF
4000 ENDDO
4001 ip(col) = beg_col
4002 ENDDO
4003 ip(n+1) = wr_pos
4004 nz = wr_pos-1_8
4005 RETURN