28 IMPLICIT NONE
29 INTEGER INODE, N, IOLDPS, HF, NFRONT, NASS1, LIW, NASS,
30 & NUMSTK, NUMORG, IFSON, MYID, LP
31 LOGICAL, intent(in) :: LPOK
32 INTEGER, intent(in) :: ISON_IN_PLACE
33 INTEGER KEEP(500)
34 INTEGER(8) KEEP8(150)
35 INTEGER(8), INTENT(IN) :: PTRAIW(N)
36 INTEGER STEP(N), PIMASTER(KEEP(28)), PTRIST(KEEP(28)),
37 & ITLOC(N+KEEP(253)), FILS(N), FRERE_STEPS(KEEP(28)),
38 & PERM(N)
39 INTEGER, TARGET :: IW(LIW)
40 INTEGER, INTENT(IN), TARGET :: IWPOSCB
41 INTEGER, INTENT(IN) :: IWPOS
42 INTEGER(8), INTENT(IN) :: LINTARR
43 INTEGER :: INTARR(LINTARR)
44 LOGICAL, intent(in) :: NIV1
45 INTEGER, intent(inout) :: IFLAG
46 LOGICAL, intent(out) :: SON_LEVEL2
47 INTEGER, intent(out) :: NFRONT_EFF
48 INTEGER, intent(in) :: DAD (KEEP(28))
49 INTEGER, intent(in) :: PROCNODE_STEPS(KEEP(28)), SLAVEF
50 TYPE (MUMPS_TPS_T), TARGET, OPTIONAL :: MUMPS_TPS_ARR(:)
51 INTEGER, intent(in), OPTIONAL :: L0_OMP_MAPPING(:)
52 INTEGER, intent(in) :: LSONROWS_PER_ROW
53 INTEGER, intent(out) :: SONROWS_PER_ROW(LSONROWS_PER_ROW)
54 INTEGER NELIM_SON_IN_PLACE
55 INTEGER NEWEL, IOLDP2, INEW, INEW1,
56 & IN, NTOTFS, ICT11, NELIM, NPIVS, NSLSON, NCOLS,
57 & ITRANS, J, JT1, ISON, IELL, LSTK,
58 & NROWS, HS, IP1, IP2, IBROT, IORG,
59 & I, K, ILOC, NEWEL_SAVE, NEWEL1_SAVE,
60 & LAST_J_ASS, JMIN, MIN_PERM
61 LOGICAL LEVEL1_SON
62 INTEGER :: K1, K2, K3, KK
63 INTEGER(8) :: J18, J28, JJ8, JDEBROW8
64 INTEGER INBPROCFILS_SON
65 INTEGER TYPESPLIT
66 include 'mumps_headers.h'
67 INTEGER :: ITHREAD
68 INTEGER, POINTER :: SON_IWPOSCB
69 INTEGER, POINTER, DIMENSION(:) :: SON_IW
70 INTEGER, POINTER, DIMENSION(:) :: PTTRI, PTLAST
71 INTEGER :: LREQ, allocok
72 INTEGER, ALLOCATABLE, TARGET :: TMP_ALLOC_ARRAY(:)
73 INTEGER MUMPS_TYPESPLIT, MUMPS_TYPENODE
75 iw(ioldps+xxnbpr) = 0
77 & keep(199))
78 son_level2 = .false.
79 ioldp2 = ioldps + hf - 1
80 ict11 = ioldp2 + nfront
81 ntotfs = 0
82 nelim_son_in_place = 0
83 IF ( (typesplit.EQ.5).OR.(typesplit.EQ.6) ) THEN
84 k2 = pimaster(step(ifson))
85 lstk = iw(k2 +keep(ixsz))
86 nelim = iw(k2 + 1+keep(ixsz))
87 IF ( ison_in_place > 0 ) THEN
88 IF (ison_in_place.NE.ifson) THEN
89 write(6,*) myid, ':',
90 & ' Internal error 1 in MUMPS_BUILD_SORT_INDEX ',
91 & ' in place node is not the first son a interior split node '
93 ENDIF
94 nelim_son_in_place = nelim
95 ENDIF
96 npivs = iw(k2 + 3+keep(ixsz))
97 IF (npivs.LT.0) npivs = 0
98 nslson = iw(k2 + 5+keep(ixsz))
99 IF( nslson.GT.0) son_level2 = .true.
100 level1_son = nslson.EQ.0
101 ncols = npivs + lstk
102 nrows = ncols
103 itrans = nrows
104 IF (niv1) THEN
105 write(6,*) myid, ':',
106 & ' Internal error 2 in MUMPS_BUILD_SORT_INDEX ',
107 & ' interior split node of type 1 '
109 ENDIF
112 & keep(199))
113 IF (level1_son.or.j.LT.4) THEN
114 write(6,*) myid, ':',
115 & ' Internal error 3 in MUMPS_BUILD_SORT_INDEX ',
116 & ' son', ifson,
117 & ' of interior split node', inode, ' of type 1 ',
118 & ' NSLSON =', nslson, ' TYPE_SON=', i, 'TYPESPLIT_SON=', j
120 ENDIF
121 son_iw => iw
122 son_iwposcb => iwposcb
123 IF (keep(400) .GT. 0 ) THEN
124 IF (present( l0_omp_mapping )) THEN
125 ithread=l0_omp_mapping(step(ifson))
126 IF (ithread .GT. 0) THEN
127 son_iw => mumps_tps_arr(ithread)%IW
128 son_iwposcb => mumps_tps_arr(ithread)%IWPOSCB
129 ENDIF
130 ENDIF
131 ENDIF
132 IF (k2 .GT. son_iwposcb) THEN
133 inbprocfils_son = k2 + xxnbpr
134 ELSE
135 inbprocfils_son = ptrist(step(ifson))+xxnbpr
136 ENDIF
137 iw(ioldps+xxnbpr)=nslson
138 son_iw(inbprocfils_son) = nslson
139 sonrows_per_row(1:nfront-nass1) = 1
140 IF ( k2.GT. iwposcb ) THEN
141 nrows = iw(k2 + 2+keep(ixsz))
142 itrans = npivs + nrows
143 ENDIF
144 hs = nslson + 6 + keep(ixsz)
145 k1 = k2 + hs + nrows + npivs
146 k2 = k1 + lstk - 1
147 k3 = k1 + nelim - 1
148 IF (nelim.GT.0) THEN
149 DO kk=k1,k3
150 ntotfs = ntotfs + 1
151 jt1 = iw(kk)
152 iw(ict11 + ntotfs) = jt1
153 iw(kk) = ntotfs
154 iw(ioldp2 + ntotfs) = iw(kk - itrans)
155 ENDDO
156 ENDIF
157 DO kk =k3+1, k3+numorg
158 ntotfs = ntotfs + 1
159 jt1 = iw(kk)
160 itloc(jt1) = ntotfs
161 iw(kk) = ntotfs
162 iw(ict11 + ntotfs) = jt1
163 iw(ioldp2 + ntotfs) = jt1
164 ENDDO
165 DO kk =k3+numorg+1, k2
166 ntotfs = ntotfs + 1
167 jt1 = iw(kk)
168 itloc(jt1) = ntotfs
169 iw(kk) = ntotfs
170 iw(ict11 + ntotfs) = jt1
171 iw(ioldp2 + ntotfs) = jt1
172 ENDDO
173 nfront_eff = ntotfs
174 ibrot = inode
175 DO iorg = 1, numorg
176 j18 = ptraiw(ibrot) + 2
177 jt1 = intarr(j18)
178 intarr(j18) = itloc(jt1)
179 ibrot = fils(ibrot)
180 j28 = j18 + intarr(j18 - 2) - intarr(j18 - 1)
181 j18 = j18 + 1
182 IF (j18 .LE. j28) THEN
183 DO jj8 = j18, j28
184 j = intarr(jj8)
185 intarr(jj8) = itloc(j)
186 ENDDO
187 ENDIF
188 ENDDO
189 k1 = ioldps+hf
190 DO kk=k1+nelim,k1+nfront_eff-1
191 itloc(iw(kk)) = 0
192 ENDDO
193 RETURN
194 ENDIF
195 lreq= 2*numstk+2
196 IF ((iwpos + lreq -1) .GT. iwposcb) THEN
197 ALLOCATE(tmp_alloc_array(lreq), stat=allocok)
198 IF (allocok .GT. 0) THEN
199 iflag = -13
200 GOTO 800
201 ENDIF
202 pttri => tmp_alloc_array(1:numstk+1)
203 ptlast => tmp_alloc_array(numstk+2:lreq)
204 ELSE
205 pttri => iw(iwpos:iwpos+numstk)
206 ptlast => iw(iwpos+numstk+1:iwpos+lreq-1)
207 ENDIF
208 nfront_eff = nass1
209 IF ( ison_in_place > 0 ) THEN
210 ison = ison_in_place
211 k2 = pimaster(step(ison))
212 lstk = iw(k2 +keep(ixsz))
213 nelim = iw(k2 + 1+keep(ixsz))
214 npivs = iw(k2 + 3+keep(ixsz))
215 IF (npivs.LT.0) npivs = 0
216 nslson = iw(k2 + 5+keep(ixsz))
217 ncols = npivs + lstk
218 nrows = ncols
219 itrans = nrows
220 IF ( k2 .GT. iwposcb ) THEN
221 nrows = iw(k2 + 2+keep(ixsz))
222 itrans = npivs + nrows
223 ENDIF
224 hs = nslson + 6 + keep(ixsz)
225 k1 = k2 + hs + nrows + npivs
226 k2 = k1 + lstk - 1
227 k3 = k1 + nelim - 1
228 DO kk = k1, k3
229 ntotfs = ntotfs + 1
230 jt1 = iw(kk)
231 iw(ict11 + ntotfs) = jt1
232 itloc(jt1) = ntotfs
233 iw(kk) = ntotfs
234 iw(ioldp2 + ntotfs) = iw(kk - itrans)
235 ENDDO
236 nelim_son_in_place = ntotfs
237 ENDIF
238 IF (.NOT. niv1) sonrows_per_row(1:nfront-nass1) = 0
239 in = inode
240 inew = ioldps + hf + ntotfs
241 inew1 = ntotfs + 1
242 jdebrow8 = ptraiw(inode)+3
243 pttri(numstk+1) = 0
244 ptlast(numstk+1) = 0 + intarr(jdebrow8-3) - 1
245 50 CONTINUE
246 j18 = ptraiw(in) + 2
247 jt1 = intarr(j18)
248 intarr(j18) = inew1
249 itloc(jt1) = inew1
250 iw(inew) = jt1
251 iw(inew+nfront) = jt1
252 inew = inew + 1
253 inew1 = inew1 + 1
254 in = fils(in)
255 IF (in .GT. 0) GOTO 50
256 ntotfs = ntotfs + numorg
257 IF (numstk .NE. 0) THEN
258 ison = ifson
259 DO iell = 1, numstk
260 k2 = pimaster(step(ison))
261 son_iw => iw
262 son_iwposcb => iwposcb
263 IF ( keep(400) .GT. 0 ) THEN
264 IF (present( l0_omp_mapping )) THEN
265 ithread=l0_omp_mapping(step(ison))
266 IF (ithread .GT. 0) THEN
267 son_iw => mumps_tps_arr(ithread)%IW
268 son_iwposcb => mumps_tps_arr(ithread)%IWPOSCB
269 ENDIF
270 ENDIF
271 ENDIF
272 lstk = son_iw(k2 +keep(ixsz))
273 nelim = son_iw(k2 + 1+keep(ixsz))
274 npivs = son_iw(k2 + 3+keep(ixsz))
275 IF (npivs.LT.0) npivs = 0
276 nslson = son_iw(k2 + 5+keep(ixsz))
277 IF( nslson.GT.0) son_level2 = .true.
278 level1_son = nslson.EQ.0
279 ncols = npivs + lstk
280 nrows = ncols
281 itrans = nrows
282 IF ( k2 .GT. son_iwposcb ) THEN
283 inbprocfils_son = k2+xxnbpr
284 ELSE
285 inbprocfils_son = ptrist(step(ison))+xxnbpr
286 ENDIF
287 IF (niv1) THEN
288 son_iw(inbprocfils_son) = nslson
289 iw(ioldps+xxnbpr) = iw(ioldps+xxnbpr) + nslson
290 ELSE
291 IF (level1_son) THEN
292 son_iw(inbprocfils_son) = 1
293 ELSE
294 son_iw(inbprocfils_son) = nslson
295 ENDIF
296 iw(ioldps+xxnbpr) = iw(ioldps+xxnbpr) +
297 & son_iw(inbprocfils_son)
298 ENDIF
299 IF (k2.GT.son_iwposcb) THEN
300 nrows = son_iw(k2 + 2+keep(ixsz))
301 itrans = npivs + nrows
302 ENDIF
303 hs = nslson + 6 + keep(ixsz)
304 k1 = k2 + hs + nrows + npivs
305 k2 = k1 + lstk - 1 - keep(253)
306 k3 = k1 + nelim - 1
307 IF (nelim .NE. 0 .AND. ison.NE.ison_in_place) THEN
308 DO kk = k1, k3
309 ntotfs = ntotfs + 1
310 jt1 = son_iw(kk)
311 iw(ict11 + ntotfs) = jt1
312 itloc(jt1) = ntotfs
313 son_iw(kk) = ntotfs
314 iw(ioldp2 + ntotfs) = son_iw(kk - itrans)
315 ENDDO
316 ENDIF
317 pttri(iell) = k2+1
318 ptlast(iell) = k2
319 k1 = k3 + 1
320 IF (nass1 .NE. nfront - keep(253)) THEN
321 DO kk = k1, k2
322 j = son_iw(kk)
323 IF (itloc(j) .EQ. 0) THEN
324 pttri(iell) = kk
325 EXIT
326 ENDIF
327 ENDDO
328 ELSE
329 DO kk = k1, k2
330 son_iw(kk) = itloc(son_iw(kk))
331 ENDDO
332 DO kk=k2+1, k2+keep(253)
333 son_iw(kk)=nfront-keep(253)+kk-k2
334 ENDDO
335 ENDIF
336 ison = frere_steps(step(ison))
337 ENDDO
338 ENDIF
339 IF (nfront-keep(253).EQ.nass1) GOTO 500
340 199 CONTINUE
341 IF ( pttri( numstk + 1 ) .LE. ptlast( numstk + 1 ) ) THEN
342 IF ( itloc( intarr( jdebrow8+pttri( numstk + 1 ) ) ) .NE. 0 ) THEN
343 pttri( numstk + 1 ) = pttri( numstk + 1 ) + 1
344 GOTO 199
345 END IF
346 END IF
347 min_perm = n + 1
348 IF (keep(400) .GT. 0) THEN
349 ison = ifson
350 ENDIF
351 DO iell = 1, numstk
352 son_iw => iw
353 IF ( keep(400) .GT. 0 ) THEN
354 IF (present( mumps_tps_arr )) THEN
355 ithread = l0_omp_mapping(step(ison))
356 IF (ithread .GT. 0) THEN
357 son_iw => mumps_tps_arr(ithread)%IW
358 ENDIF
359 ENDIF
360 ENDIF
361 iloc = pttri( iell )
362 IF ( iloc .LE. ptlast( iell ) ) THEN
363 IF ( perm( son_iw( iloc ) ) .LT. min_perm ) THEN
364 jmin = son_iw( iloc )
365 min_perm = perm( jmin )
366 END IF
367 END IF
368 IF (keep(400) .GT. 0) THEN
369 ison = frere_steps(step(ison))
370 ENDIF
371 END DO
372 iell = numstk + 1
373 iloc = pttri( iell )
374 IF ( iloc .LE. ptlast( iell ) ) THEN
375 IF ( perm( intarr( jdebrow8+iloc ) ) .LT. min_perm ) THEN
376 jmin = intarr( jdebrow8+iloc )
377 min_perm = perm( jmin )
378 END IF
379 END IF
380 newel = ioldp2 + nass1 + nfront
381 DO WHILE ( min_perm .NE. n + 1 )
382 newel = newel + 1
383 nfront_eff = nfront_eff + 1
384 iw( newel ) = jmin
385 itloc( jmin ) = nfront_eff
386 last_j_ass = jmin
387 min_perm = n + 1
388 IF (keep(400) .GT. 0) THEN
389 ison = ifson
390 ENDIF
391 DO iell = 1, numstk
392 son_iw => iw
393 IF (keep(400) .GT. 0) THEN
394 IF (present( mumps_tps_arr )) THEN
395 ithread=l0_omp_mapping(step(ison))
396 IF (ithread .GT. 0) THEN
397 son_iw => mumps_tps_arr(ithread)%IW
398 ENDIF
399 ENDIF
400 ENDIF
401 IF ( pttri( iell ) .LE. ptlast( iell ) ) THEN
402 IF ( son_iw( pttri( iell ) ) .eq. last_j_ass )
403 & pttri( iell ) = pttri( iell ) + 1
404 ENDIF
405 IF ( pttri( iell ) .LE. ptlast( iell ) ) THEN
406 IF ( perm(son_iw( pttri( iell )) ) .LT. min_perm ) THEN
407 jmin = son_iw( pttri( iell ) )
408 min_perm = perm( jmin )
409 END IF
410 END IF
411 IF (keep(400).GT.0) THEN
412 ison = frere_steps(step(ison))
413 ENDIF
414 END DO
415 iell = numstk + 1
416 145 CONTINUE
417 IF ( pttri( iell ) .LE. ptlast( iell ) ) THEN
418 IF ( intarr( jdebrow8+pttri( iell ) ) .eq. last_j_ass ) THEN
419 pttri( iell ) = pttri( iell ) + 1
420 GOTO 145
421 END IF
422 END IF
423 IF ( pttri( iell ) .LE. ptlast( iell ) ) THEN
424 IF (perm(intarr( jdebrow8+pttri(iell) )) .LT. min_perm) THEN
425 jmin = intarr( jdebrow8+pttri(iell) )
426 min_perm = perm( jmin )
427 END IF
428 END IF
429 END DO
430 newel_save = newel
431 newel1_save = nfront_eff
432 IF (newel1_save.LT.nfront - keep(253)) THEN
433 ibrot = inode
434 DO iorg = 1, numorg
435 j18 = ptraiw(ibrot) + 2
436 j28 = j18 + intarr(j18 - 2) - intarr(j18-1)
437 ibrot = fils( ibrot )
438 IF ( iorg.EQ. 1) THEN
439 IF ( keep(50).NE.0 ) cycle
440 j18 = j18 + 1 + intarr(j18-2)
441 ELSE
442 j18 = j18 + 1
443 ENDIF
444 DO jj8 = j18, j28
445 j = intarr( jj8 )
446 IF ( itloc( j ) .eq. 0 ) THEN
447 newel = newel + 1
448 nfront_eff = nfront_eff + 1
449 iw( newel ) = j
450 itloc( j ) = nfront_eff
451 END IF
452 ENDDO
453 ENDDO
454 IF ( (typesplit.EQ.4).AND.
455 & (nfront_eff.LT.nfront-keep(253)) ) THEN
456 ibrot = inode
457 DO WHILE
458 & (
460 & (procnode_steps(step(dad(step(ibrot)))),keep(199))
461 & .EQ.5
462 & )
463 & .OR.
465 & (procnode_steps(step(dad(step(ibrot)))),keep(199))
466 & .EQ.6
467 & )
468 & )
469 ibrot = dad(step(ibrot))
470 in = ibrot
471 DO WHILE (in.GT.0.AND.nfront_eff.LT.nfront-keep(253))
472 j18 = ptraiw(in) + 2
473 j28 = j18 + intarr(j18 - 2) - intarr(j18-1)
474 in = fils( in )
475 DO jj8 = j18, j28
476 j = intarr( jj8 )
477 IF ( itloc( j ) .eq. 0 ) THEN
478 newel = newel + 1
479 nfront_eff = nfront_eff + 1
480 iw( newel ) = j
481 itloc( j ) = nfront_eff
482 END IF
483 ENDDO
484 ENDDO
485 IF (nfront_eff.EQ.nfront-keep(253)) EXIT
486 ENDDO
487 IF (nfront_eff.NE.nfront-keep(253) .AND.
488 & .NOT. (keep(376).EQ.1 .AND. keep(79) .GE.1)) THEN
489 write(6,*) myid, ': INODE', inode, ' of type 4 ',
490 & ' not yet fully assembled ',
491 & ' NFRONT_EFF, NFRONT =', nfront_eff, nfront
493 ENDIF
494 ENDIF
495 ENDIF
496 IF ( newel1_save .eq. nfront_eff ) THEN
497 DO kk=nass1+1, nfront_eff
498 iw( ioldp2+kk ) = iw( ict11+kk )
499 ENDDO
500 ELSE
502 & iw( newel_save + 1 ), nfront_eff - newel1_save )
504 & iw( newel_save + 1), nfront_eff - newel1_save,
505 & iw( ict11 + nass1 + 1 ), newel1_save - nass1,
506 & iw( ioldp2 + nass1 + 1 ), nfront_eff - nass1 )
507 DO kk = nass1+1, nfront_eff
508 iw(ict11 + kk) = iw(ioldp2+kk)
509 ENDDO
510 END IF
511 500 CONTINUE
512 IF ( keep(253).GT.0) THEN
513 ip1 = ioldps + hf + nfront_eff
514 ip2 = ioldps + hf + nfront + nfront_eff
515 DO i= 1, keep(253)
516 iw(ip1+i-1) = n+i
517 iw(ip2+i-1) = n+i
518 itloc(n+i) = nfront_eff + i
519 ENDDO
520 nfront_eff = nfront_eff + keep(253)
521 ENDIF
522 IF (nfront.GT.nfront_eff) THEN
523 ip1 = ioldps + nfront + hf
524 ip2 = ioldps + nfront_eff + hf
525 DO i=1, nfront_eff
526 iw(ip2+i-1)=iw(ip1+i-1)
527 ENDDO
528 ELSE IF (nfront .LT. nfront_eff) THEN
529 IF (lpok) THEN
530 WRITE(lp,*) " Error in MUMPS_BUILD_SORT_INDEX:",
531 & " matrix structure might have changed,",
532 & " analysis (JOB=1) should be performed again ",
533 & " NFRONTexpected, NFRONTeffective=", nfront, nfront_eff
534 ENDIF
535 iflag = -53
536 GOTO 800
537 ENDIF
538 IF ( numstk .NE. 0
539 & .AND. (nfront-keep(253).GT.nass1)
540 & ) THEN
541 ison = ifson
542 DO iell = 1, numstk
543 k2 = pimaster(step(ison))
544 son_iw => iw
545 son_iwposcb => iwposcb
546 IF (keep(400).GT.0) THEN
547 IF (present( mumps_tps_arr )) THEN
548 ithread=l0_omp_mapping(step(ison))
549 IF (ithread .GT. 0) THEN
550 son_iw => mumps_tps_arr(ithread)%IW
551 son_iwposcb => mumps_tps_arr(ithread)%IWPOSCB
552 ENDIF
553 ENDIF
554 ENDIF
555 lstk = son_iw(k2+keep(ixsz))
556 nelim = son_iw(k2 + 1 +keep(ixsz))
557 npivs = son_iw(k2 + 3 +keep(ixsz))
558 IF (npivs.LT.0) npivs = 0
559 nslson = son_iw(k2 + 5 +keep(ixsz))
560 level1_son = (nslson .EQ. 0)
561 ncols = npivs + lstk
562 nrows = ncols
563 IF (k2.GT.son_iwposcb) THEN
564 nrows = son_iw(k2 + 2+keep(ixsz))
565 ENDIF
566 hs = nslson + 6 +keep(ixsz)
567 k1 = k2 + hs + nrows + npivs
568 k2 = k1 + lstk - 1
569 k3 = k1 + nelim - 1
570 k1 = k3 + 1
571 IF (nfront-keep(253).GT.nass1) THEN
572 DO kk = k1, k2
573 j = son_iw(kk)
574 son_iw(kk) = itloc(j)
575 IF (niv1 .AND. nslson.EQ.0) THEN
576 ELSE
577 IF (son_iw(kk) .LE. nass1 .OR. niv1) THEN
578 ELSE
579 sonrows_per_row(son_iw(kk)-nass1) =
580 & sonrows_per_row(son_iw(kk)-nass1) + 1
581 ENDIF
582 ENDIF
583 ENDDO
584 ELSE
585 IF (.not. niv1) THEN
586 WRITE(*,*) "Internal error 1 in MUMPS_BUILD_SORT_INDEX"
588 ENDIF
589 IF (.not.level1_son) THEN
590 ENDIF
591 ENDIF
592 ison = frere_steps(step(ison))
593 ENDDO
594 ENDIF
595 ibrot = inode
596 DO iorg = 1, numorg
597 j18 = ptraiw(ibrot) + 2
598 ibrot = fils(ibrot)
599 j28 = j18 + intarr(j18 - 2) - intarr(j18 - 1)
600 j18 = j18 + 1
601 DO jj8 = j18, j28
602 j = intarr(jj8)
603 intarr(jj8) = itloc(j)
604 ENDDO
605 ENDDO
606 k1 = ioldps + hf
607 k2 = k1 + nfront_eff -1
608 IF (keep(50).EQ.0) k2 = k2 + nelim_son_in_place
609 DO k = k1, k2
610 i = iw(k)
611 itloc(i) = 0
612 ENDDO
613 IF (keep(50).EQ.0) THEN
614 k1 = ioldps+hf+nfront_eff+nelim_son_in_place+numorg
615 k2 = k1 + nass -nelim_son_in_place - 1
616 DO k = k1, k2
617 i = iw(k)
618 itloc(i) = 0
619 ENDDO
620 ENDIF
621 800 CONTINUE
622 IF (allocated(tmp_alloc_array)) DEALLOCATE(tmp_alloc_array)
623 RETURN
subroutine mumps_sort(n, perm, iw, liw)
subroutine mumps_sorted_merge(n, nass1, perm, itloc, small, lsmall, large, llarge, merge, lmerge)
1.15.0