Line data Source code
1 : /*
2 : Copyright (c) 2003, The Regents of the University of California, through
3 : Lawrence Berkeley National Laboratory (subject to receipt of any required
4 : approvals from U.S. Dept. of Energy)
5 :
6 : All rights reserved.
7 :
8 : The source code is distributed under BSD license, see the file License.txt
9 : at the top-level directory.
10 : */
11 : /*! \file
12 : * \brief Minimum degree algorithm
13 : *
14 : * \ingroup Common
15 : */
16 : #include "superlu_config.h"
17 :
18 : typedef int_t shortint;
19 :
20 : /* *************************************************************** */
21 : /* *************************************************************** */
22 : /* **** GENMMD ..... MULTIPLE MINIMUM EXTERNAL DEGREE **** */
23 : /* *************************************************************** */
24 : /* *************************************************************** */
25 :
26 : /* AUTHOR - JOSEPH W.H. LIU */
27 : /* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
28 :
29 : /* PURPOSE - THIS ROUTINE IMPLEMENTS THE MINIMUM DEGREE */
30 : /* ALGORITHM. IT MAKES USE OF THE IMPLICIT REPRESENTATION */
31 : /* OF ELIMINATION GRAPHS BY QUOTIENT GRAPHS, AND THE */
32 : /* NOTION OF INDISTINGUISHABLE NODES. IT ALSO IMPLEMENTS */
33 : /* THE MODIFICATIONS BY MULTIPLE ELIMINATION AND MINIMUM */
34 : /* EXTERNAL DEGREE. */
35 : /* --------------------------------------------- */
36 : /* CAUTION - THE ADJACENCY VECTOR ADJNCY WILL BE */
37 : /* DESTROYED. */
38 : /* --------------------------------------------- */
39 :
40 : /* INPUT PARAMETERS - */
41 : /* NEQNS - NUMBER OF EQUATIONS. */
42 : /* (XADJ,ADJNCY) - THE ADJACENCY STRUCTURE. */
43 : /* DELTA - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
44 : /* MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) INTEGER */
45 : /* (ANY SMALLER ESTIMATE WILL DO) FOR MARKING */
46 : /* NODES. */
47 :
48 : /* OUTPUT PARAMETERS - */
49 : /* PERM - THE MINIMUM DEGREE ORDERING. */
50 : /* INVP - THE INVERSE OF PERM. */
51 : /* NOFSUB - AN UPPER BOUND ON THE NUMBER OF NONZERO */
52 : /* SUBSCRIPTS FOR THE COMPRESSED STORAGE SCHEME. */
53 :
54 : /* WORKING PARAMETERS - */
55 : /* DHEAD - VECTOR FOR HEAD OF DEGREE LISTS. */
56 : /* INVP - USED TEMPORARILY FOR DEGREE FORWARD LINK. */
57 : /* PERM - USED TEMPORARILY FOR DEGREE BACKWARD LINK. */
58 : /* QSIZE - VECTOR FOR SIZE OF SUPERNODES. */
59 : /* LLIST - VECTOR FOR TEMPORARY LINKED LISTS. */
60 : /* MARKER - A TEMPORARY MARKER VECTOR. */
61 :
62 : /* PROGRAM SUBROUTINES - */
63 : /* MMDELM, MMDINT, MMDNUM, MMDUPD. */
64 :
65 : /* *************************************************************** */
66 :
67 0 : /* Subroutine */ int genmmd_(int *neqns, int_t *xadj, shortint *adjncy,
68 : int *invp, int *perm, int_t *delta, shortint *dhead,
69 : shortint *qsize, shortint *llist, shortint *marker, int_t *maxint,
70 : int_t *nofsub)
71 : {
72 : /* System generated locals */
73 : int i__1;
74 :
75 : /* Local variables */
76 : int_t mdeg, ehead, i, mdlmt, mdnode;
77 : extern /* Subroutine */
78 : int slu_mmdelm_(const int_t *mdnode, int_t *xadj, shortint *adjncy,
79 : shortint *dhead, int *dforw, int *dbakw, shortint *qsize,
80 : shortint *llist, shortint *marker, const int_t *maxint, const int_t *tag),
81 : slu_mmdupd_(const int_t *ehead, const int *neqns, int_t *xadj,
82 : shortint *adjncy, const int_t *delta, int_t *mdeg, shortint *dhead,
83 : int *dforw, int *dbakw, shortint *qsize, shortint *llist,
84 : shortint *marker, const int_t *maxint, int_t *tag),
85 : slu_mmdint_(const int *neqns, int_t *xadj, shortint *adjncy,
86 : shortint *dhead, int *dforw, int *dbakw, shortint *qsize,
87 : shortint *llist, shortint *marker),
88 : slu_mmdnum_(const int *neqns, int *perm, int *invp, shortint *qsize);
89 :
90 : int_t nextmd, tag, num;
91 :
92 : /* *************************************************************** */
93 :
94 :
95 : /* *************************************************************** */
96 :
97 : /* Parameter adjustments */
98 0 : --marker;
99 : --llist;
100 0 : --qsize;
101 0 : --dhead;
102 : --perm;
103 0 : --invp;
104 : --adjncy;
105 : --xadj;
106 :
107 : /* Function Body */
108 0 : if (*neqns <= 0) {
109 : return 0;
110 : }
111 :
112 : /* ------------------------------------------------ */
113 : /* INITIALIZATION FOR THE MINIMUM DEGREE ALGORITHM. */
114 : /* ------------------------------------------------ */
115 0 : *nofsub = 0;
116 0 : slu_mmdint_(neqns, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1], &
117 : qsize[1], &llist[1], &marker[1]);
118 :
119 : /* ---------------------------------------------- */
120 : /* NUM COUNTS THE NUMBER OF ORDERED NODES PLUS 1. */
121 : /* ---------------------------------------------- */
122 : num = 1;
123 :
124 : /* ----------------------------- */
125 : /* ELIMINATE ALL ISOLATED NODES. */
126 : /* ----------------------------- */
127 0 : nextmd = dhead[1];
128 0 : L100:
129 0 : if (nextmd <= 0) {
130 0 : goto L200;
131 : }
132 0 : mdnode = nextmd;
133 0 : nextmd = invp[mdnode];
134 0 : marker[mdnode] = *maxint;
135 0 : invp[mdnode] = -num;
136 0 : ++num;
137 0 : goto L100;
138 :
139 : L200:
140 : /* ---------------------------------------- */
141 : /* SEARCH FOR NODE OF THE MINIMUM DEGREE. */
142 : /* MDEG IS THE CURRENT MINIMUM DEGREE; */
143 : /* TAG IS USED TO FACILITATE MARKING NODES. */
144 : /* ---------------------------------------- */
145 0 : if (num > *neqns) {
146 0 : goto L1000;
147 : }
148 0 : tag = 1;
149 0 : dhead[1] = 0;
150 0 : mdeg = 2;
151 : L300:
152 0 : if (dhead[mdeg] > 0) {
153 0 : goto L400;
154 : }
155 0 : ++mdeg;
156 0 : goto L300;
157 : L400:
158 : /* ------------------------------------------------- */
159 : /* USE VALUE OF DELTA TO SET UP MDLMT, WHICH GOVERNS */
160 : /* WHEN A DEGREE UPDATE IS TO BE PERFORMED. */
161 : /* ------------------------------------------------- */
162 0 : mdlmt = mdeg + *delta;
163 0 : ehead = 0;
164 :
165 : L500:
166 0 : mdnode = dhead[mdeg];
167 0 : if (mdnode > 0) {
168 0 : goto L600;
169 : }
170 0 : ++mdeg;
171 0 : if (mdeg > mdlmt) {
172 0 : goto L900;
173 : }
174 0 : goto L500;
175 : L600:
176 : /* ---------------------------------------- */
177 : /* REMOVE MDNODE FROM THE DEGREE STRUCTURE. */
178 : /* ---------------------------------------- */
179 0 : nextmd = invp[mdnode];
180 0 : dhead[mdeg] = nextmd;
181 0 : if (nextmd > 0) {
182 0 : perm[nextmd] = -mdeg;
183 : }
184 0 : invp[mdnode] = -num;
185 0 : *nofsub = *nofsub + mdeg + qsize[mdnode] - 2;
186 0 : if (num + qsize[mdnode] > *neqns) {
187 0 : goto L1000;
188 : }
189 : /* ---------------------------------------------- */
190 : /* ELIMINATE MDNODE AND PERFORM QUOTIENT GRAPH */
191 : /* TRANSFORMATION. RESET TAG VALUE IF NECESSARY. */
192 : /* ---------------------------------------------- */
193 0 : ++tag;
194 0 : if (tag < *maxint) {
195 0 : goto L800;
196 : }
197 0 : tag = 1;
198 : i__1 = *neqns;
199 0 : for (i = 1; i <= i__1; ++i) {
200 0 : if (marker[i] < *maxint) {
201 0 : marker[i] = 0;
202 : }
203 : /* L700: */
204 : }
205 0 : L800:
206 0 : slu_mmdelm_(&mdnode, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1], &
207 : qsize[1], &llist[1], &marker[1], maxint, &tag);
208 0 : num += qsize[mdnode];
209 0 : llist[mdnode] = ehead;
210 0 : ehead = mdnode;
211 0 : if (*delta >= 0) {
212 0 : goto L500;
213 : }
214 0 : L900:
215 : /* ------------------------------------------- */
216 : /* UPDATE DEGREES OF THE NODES INVOLVED IN THE */
217 : /* MINIMUM DEGREE NODES ELIMINATION. */
218 : /* ------------------------------------------- */
219 0 : if (num > *neqns) {
220 0 : goto L1000;
221 : }
222 0 : slu_mmdupd_(&ehead, neqns, &xadj[1], &adjncy[1], delta, &mdeg, &dhead[1], &
223 : invp[1], &perm[1], &qsize[1], &llist[1], &marker[1], maxint, &tag)
224 : ;
225 0 : goto L300;
226 :
227 0 : L1000:
228 0 : slu_mmdnum_(neqns, &perm[1], &invp[1], &qsize[1]);
229 0 : return 0;
230 :
231 : } /* genmmd_ */
232 :
233 : /* *************************************************************** */
234 : /* *************************************************************** */
235 : /* *** MMDINT ..... MULT MINIMUM DEGREE INITIALIZATION *** */
236 : /* *************************************************************** */
237 : /* *************************************************************** */
238 :
239 : /* AUTHOR - JOSEPH W.H. LIU */
240 : /* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
241 :
242 : /* PURPOSE - THIS ROUTINE PERFORMS INITIALIZATION FOR THE */
243 : /* MULTIPLE ELIMINATION VERSION OF THE MINIMUM DEGREE */
244 : /* ALGORITHM. */
245 :
246 : /* INPUT PARAMETERS - */
247 : /* NEQNS - NUMBER OF EQUATIONS. */
248 : /* (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
249 :
250 : /* OUTPUT PARAMETERS - */
251 : /* (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
252 : /* QSIZE - SIZE OF SUPERNODE (INITIALIZED TO ONE). */
253 : /* LLIST - LINKED LIST. */
254 : /* MARKER - MARKER VECTOR. */
255 :
256 : /* *************************************************************** */
257 :
258 : /* Subroutine */
259 0 : int slu_mmdint_(const int *neqns, int_t *xadj, shortint *adjncy,
260 : shortint *dhead, int *dforw, int *dbakw, shortint *qsize,
261 : shortint *llist, shortint *marker)
262 : {
263 : /* System generated locals */
264 : int i__1;
265 :
266 : /* Local variables */
267 : int ndeg, node, fnode;
268 :
269 : /* *************************************************************** */
270 :
271 : /* Parameter adjustments */
272 : --marker;
273 : --llist;
274 : --qsize;
275 0 : --dbakw;
276 : --dforw;
277 0 : --dhead;
278 : --adjncy;
279 0 : --xadj;
280 :
281 : /* Function Body */
282 0 : i__1 = *neqns;
283 0 : for (node = 1; node <= i__1; ++node) {
284 0 : dhead[node] = 0;
285 0 : qsize[node] = 1;
286 0 : marker[node] = 0;
287 0 : llist[node] = 0;
288 : /* L100: */
289 : }
290 : /* ------------------------------------------ */
291 : /* INITIALIZE THE DEGREE DOUBLY LINKED LISTS. */
292 : /* ------------------------------------------ */
293 0 : i__1 = *neqns;
294 0 : for (node = 1; node <= i__1; ++node) {
295 0 : ndeg = xadj[node + 1] - xadj[node] + 1;
296 0 : fnode = dhead[ndeg];
297 0 : dforw[node] = fnode;
298 0 : dhead[ndeg] = node;
299 0 : if (fnode > 0) {
300 0 : dbakw[fnode] = node;
301 : }
302 0 : dbakw[node] = -ndeg;
303 : /* L200: */
304 : }
305 0 : return 0;
306 :
307 : } /* slu_mmdint_ */
308 :
309 : /* *************************************************************** */
310 : /* *************************************************************** */
311 : /* ** MMDELM ..... MULTIPLE MINIMUM DEGREE ELIMINATION *** */
312 : /* *************************************************************** */
313 : /* *************************************************************** */
314 :
315 : /* AUTHOR - JOSEPH W.H. LIU */
316 : /* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
317 :
318 : /* PURPOSE - THIS ROUTINE ELIMINATES THE NODE MDNODE OF */
319 : /* MINIMUM DEGREE FROM THE ADJACENCY STRUCTURE, WHICH */
320 : /* IS STORED IN THE QUOTIENT GRAPH FORMAT. IT ALSO */
321 : /* TRANSFORMS THE QUOTIENT GRAPH REPRESENTATION OF THE */
322 : /* ELIMINATION GRAPH. */
323 :
324 : /* INPUT PARAMETERS - */
325 : /* MDNODE - NODE OF MINIMUM DEGREE. */
326 : /* MAXINT - ESTIMATE OF MAXIMUM REPRESENTABLE (SHORT) */
327 : /* INT. */
328 : /* TAG - TAG VALUE. */
329 :
330 : /* UPDATED PARAMETERS - */
331 : /* (XADJ,ADJNCY) - UPDATED ADJACENCY STRUCTURE. */
332 : /* (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
333 : /* QSIZE - SIZE OF SUPERNODE. */
334 : /* MARKER - MARKER VECTOR. */
335 : /* LLIST - TEMPORARY LINKED LIST OF ELIMINATED NABORS. */
336 :
337 : /* *************************************************************** */
338 :
339 : /* Subroutine */
340 0 : int slu_mmdelm_(const int_t *mdnode, int_t *xadj, shortint *adjncy,
341 : shortint *dhead, int *dforw, int *dbakw, shortint *qsize,
342 : shortint *llist, shortint *marker, const int_t *maxint, const int_t *tag)
343 : {
344 : /* System generated locals */
345 : int_t i__1, i__2;
346 :
347 : /* Local variables */
348 : int_t node, link, rloc, rlmt, i, j, nabor, rnode, elmnt, xqnbr,
349 : istop, jstop, istrt, jstrt, nxnode, pvnode, nqnbrs, npv;
350 :
351 :
352 : /* *************************************************************** */
353 :
354 :
355 : /* *************************************************************** */
356 :
357 : /* ----------------------------------------------- */
358 : /* FIND REACHABLE SET AND PLACE IN DATA STRUCTURE. */
359 : /* ----------------------------------------------- */
360 : /* Parameter adjustments */
361 0 : --marker;
362 0 : --llist;
363 0 : --qsize;
364 0 : --dbakw;
365 0 : --dforw;
366 : --dhead;
367 0 : --adjncy;
368 0 : --xadj;
369 :
370 : /* Function Body */
371 0 : marker[*mdnode] = *tag;
372 0 : istrt = xadj[*mdnode];
373 0 : istop = xadj[*mdnode + 1] - 1;
374 : /* ------------------------------------------------------- */
375 : /* ELMNT POINTS TO THE BEGINNING OF THE LIST OF ELIMINATED */
376 : /* NABORS OF MDNODE, AND RLOC GIVES THE STORAGE LOCATION */
377 : /* FOR THE NEXT REACHABLE NODE. */
378 : /* ------------------------------------------------------- */
379 : elmnt = 0;
380 : rloc = istrt;
381 : rlmt = istop;
382 : i__1 = istop;
383 0 : for (i = istrt; i <= i__1; ++i) {
384 0 : nabor = adjncy[i];
385 0 : if (nabor == 0) {
386 0 : goto L300;
387 : }
388 0 : if (marker[nabor] >= *tag) {
389 0 : goto L200;
390 : }
391 0 : marker[nabor] = *tag;
392 0 : if (dforw[nabor] < 0) {
393 0 : goto L100;
394 : }
395 0 : adjncy[rloc] = nabor;
396 0 : ++rloc;
397 0 : goto L200;
398 : L100:
399 0 : llist[nabor] = elmnt;
400 : elmnt = nabor;
401 0 : L200:
402 : ;
403 : }
404 0 : L300:
405 : /* ----------------------------------------------------- */
406 : /* MERGE WITH REACHABLE NODES FROM GENERALIZED ELEMENTS. */
407 : /* ----------------------------------------------------- */
408 0 : if (elmnt <= 0) {
409 0 : goto L1000;
410 : }
411 0 : adjncy[rlmt] = -elmnt;
412 : link = elmnt;
413 0 : L400:
414 0 : jstrt = xadj[link];
415 0 : jstop = xadj[link + 1] - 1;
416 : i__1 = jstop;
417 0 : for (j = jstrt; j <= i__1; ++j) {
418 0 : node = adjncy[j];
419 0 : link = -node;
420 0 : if (node < 0) {
421 0 : goto L400;
422 0 : } else if (node == 0) {
423 0 : goto L900;
424 : } else {
425 0 : goto L500;
426 : }
427 : L500:
428 0 : if (marker[node] >= *tag || dforw[node] < 0) {
429 0 : goto L800;
430 : }
431 0 : marker[node] = *tag;
432 : /* --------------------------------- */
433 : /* USE STORAGE FROM ELIMINATED NODES */
434 : /* IF NECESSARY. */
435 : /* --------------------------------- */
436 0 : L600:
437 0 : if (rloc < rlmt) {
438 0 : goto L700;
439 : }
440 0 : link = -adjncy[rlmt];
441 0 : rloc = xadj[link];
442 0 : rlmt = xadj[link + 1] - 1;
443 0 : goto L600;
444 : L700:
445 0 : adjncy[rloc] = node;
446 0 : ++rloc;
447 0 : L800:
448 : ;
449 : }
450 0 : L900:
451 0 : elmnt = llist[elmnt];
452 0 : goto L300;
453 : L1000:
454 0 : if (rloc <= rlmt) {
455 0 : adjncy[rloc] = 0;
456 : }
457 : /* -------------------------------------------------------- */
458 : /* FOR EACH NODE IN THE REACHABLE SET, DO THE FOLLOWING ... */
459 : /* -------------------------------------------------------- */
460 0 : link = *mdnode;
461 0 : L1100:
462 0 : istrt = xadj[link];
463 0 : istop = xadj[link + 1] - 1;
464 : i__1 = istop;
465 0 : for (i = istrt; i <= i__1; ++i) {
466 0 : rnode = adjncy[i];
467 0 : link = -rnode;
468 0 : if (rnode < 0) {
469 0 : goto L1100;
470 0 : } else if (rnode == 0) {
471 0 : goto L1800;
472 : } else {
473 0 : goto L1200;
474 : }
475 : L1200:
476 : /* -------------------------------------------- */
477 : /* IF RNODE IS IN THE DEGREE LIST STRUCTURE ... */
478 : /* -------------------------------------------- */
479 0 : pvnode = dbakw[rnode];
480 0 : if (pvnode == 0 || pvnode == -(*maxint)) {
481 0 : goto L1300;
482 : }
483 : /* ------------------------------------- */
484 : /* THEN REMOVE RNODE FROM THE STRUCTURE. */
485 : /* ------------------------------------- */
486 0 : nxnode = dforw[rnode];
487 0 : if (nxnode > 0) {
488 0 : dbakw[nxnode] = pvnode;
489 : }
490 0 : if (pvnode > 0) {
491 0 : dforw[pvnode] = nxnode;
492 : }
493 0 : npv = -pvnode;
494 0 : if (pvnode < 0) {
495 0 : dhead[npv] = nxnode;
496 : }
497 0 : L1300:
498 : /* ---------------------------------------- */
499 : /* PURGE INACTIVE QUOTIENT NABORS OF RNODE. */
500 : /* ---------------------------------------- */
501 0 : jstrt = xadj[rnode];
502 0 : jstop = xadj[rnode + 1] - 1;
503 : xqnbr = jstrt;
504 : i__2 = jstop;
505 0 : for (j = jstrt; j <= i__2; ++j) {
506 0 : nabor = adjncy[j];
507 0 : if (nabor == 0) {
508 0 : goto L1500;
509 : }
510 0 : if (marker[nabor] >= *tag) {
511 0 : goto L1400;
512 : }
513 0 : adjncy[xqnbr] = nabor;
514 0 : ++xqnbr;
515 0 : L1400:
516 : ;
517 : }
518 0 : L1500:
519 : /* ---------------------------------------- */
520 : /* IF NO ACTIVE NABOR AFTER THE PURGING ... */
521 : /* ---------------------------------------- */
522 0 : nqnbrs = xqnbr - jstrt;
523 0 : if (nqnbrs > 0) {
524 0 : goto L1600;
525 : }
526 : /* ----------------------------- */
527 : /* THEN MERGE RNODE WITH MDNODE. */
528 : /* ----------------------------- */
529 0 : qsize[*mdnode] += qsize[rnode];
530 0 : qsize[rnode] = 0;
531 0 : marker[rnode] = *maxint;
532 0 : dforw[rnode] = -(*mdnode);
533 0 : dbakw[rnode] = -(*maxint);
534 0 : goto L1700;
535 : L1600:
536 : /* -------------------------------------- */
537 : /* ELSE FLAG RNODE FOR DEGREE UPDATE, AND */
538 : /* ADD MDNODE AS A NABOR OF RNODE. */
539 : /* -------------------------------------- */
540 0 : dforw[rnode] = nqnbrs + 1;
541 0 : dbakw[rnode] = 0;
542 0 : adjncy[xqnbr] = *mdnode;
543 0 : ++xqnbr;
544 0 : if (xqnbr <= jstop) {
545 0 : adjncy[xqnbr] = 0;
546 : }
547 :
548 0 : L1700:
549 : ;
550 : }
551 0 : L1800:
552 0 : return 0;
553 :
554 : } /* slu_mmdelm_ */
555 :
556 : /* *************************************************************** */
557 : /* *************************************************************** */
558 : /* ***** MMDUPD ..... MULTIPLE MINIMUM DEGREE UPDATE ***** */
559 : /* *************************************************************** */
560 : /* *************************************************************** */
561 :
562 : /* AUTHOR - JOSEPH W.H. LIU */
563 : /* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
564 :
565 : /* PURPOSE - THIS ROUTINE UPDATES THE DEGREES OF NODES */
566 : /* AFTER A MULTIPLE ELIMINATION STEP. */
567 :
568 : /* INPUT PARAMETERS - */
569 : /* EHEAD - THE BEGINNING OF THE LIST OF ELIMINATED */
570 : /* NODES (I.E., NEWLY FORMED ELEMENTS). */
571 : /* NEQNS - NUMBER OF EQUATIONS. */
572 : /* (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
573 : /* DELTA - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
574 : /* MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) */
575 : /* INTEGER. */
576 :
577 : /* UPDATED PARAMETERS - */
578 : /* MDEG - NEW MINIMUM DEGREE AFTER DEGREE UPDATE. */
579 : /* (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
580 : /* QSIZE - SIZE OF SUPERNODE. */
581 : /* LLIST - WORKING LINKED LIST. */
582 : /* MARKER - MARKER VECTOR FOR DEGREE UPDATE. */
583 : /* TAG - TAG VALUE. */
584 :
585 : /* *************************************************************** */
586 :
587 :
588 : /* Subroutine */
589 0 : int slu_mmdupd_(const int_t *ehead, const int *neqns, int_t *xadj,
590 : shortint *adjncy, const int_t *delta, int_t *mdeg, shortint *dhead,
591 : int *dforw, int *dbakw, shortint *qsize, shortint *llist,
592 : shortint *marker, const int_t *maxint, int_t *tag)
593 : {
594 : /* System generated locals */
595 : int_t i__1, i__2;
596 :
597 : /* Local variables */
598 : int_t node, mtag, link, mdeg0, i, j, enode, fnode, nabor, elmnt,
599 : istop, jstop, q2head, istrt, jstrt, qxhead, iq2, deg, deg0;
600 :
601 :
602 : /* *************************************************************** */
603 :
604 :
605 : /* *************************************************************** */
606 :
607 : /* Parameter adjustments */
608 0 : --marker;
609 0 : --llist;
610 0 : --qsize;
611 0 : --dbakw;
612 0 : --dforw;
613 : --dhead;
614 0 : --adjncy;
615 0 : --xadj;
616 :
617 : /* Function Body */
618 0 : mdeg0 = *mdeg + *delta;
619 0 : elmnt = *ehead;
620 0 : L100:
621 : /* ------------------------------------------------------- */
622 : /* FOR EACH OF THE NEWLY FORMED ELEMENT, DO THE FOLLOWING. */
623 : /* (RESET TAG VALUE IF NECESSARY.) */
624 : /* ------------------------------------------------------- */
625 0 : if (elmnt <= 0) {
626 0 : return 0;
627 : }
628 0 : mtag = *tag + mdeg0;
629 0 : if (mtag < *maxint) {
630 0 : goto L300;
631 : }
632 0 : *tag = 1;
633 0 : i__1 = *neqns;
634 0 : for (i = 1; i <= i__1; ++i) {
635 0 : if (marker[i] < *maxint) {
636 0 : marker[i] = 0;
637 : }
638 : /* L200: */
639 : }
640 0 : mtag = *tag + mdeg0;
641 0 : L300:
642 : /* --------------------------------------------- */
643 : /* CREATE TWO LINKED LISTS FROM NODES ASSOCIATED */
644 : /* WITH ELMNT: ONE WITH TWO NABORS (Q2HEAD) IN */
645 : /* ADJACENCY STRUCTURE, AND THE OTHER WITH MORE */
646 : /* THAN TWO NABORS (QXHEAD). ALSO COMPUTE DEG0, */
647 : /* NUMBER OF NODES IN THIS ELEMENT. */
648 : /* --------------------------------------------- */
649 : q2head = 0;
650 : qxhead = 0;
651 : deg0 = 0;
652 : link = elmnt;
653 0 : L400:
654 0 : istrt = xadj[link];
655 0 : istop = xadj[link + 1] - 1;
656 : i__1 = istop;
657 0 : for (i = istrt; i <= i__1; ++i) {
658 0 : enode = adjncy[i];
659 0 : link = -enode;
660 0 : if (enode < 0) {
661 0 : goto L400;
662 0 : } else if (enode == 0) {
663 0 : goto L800;
664 : } else {
665 0 : goto L500;
666 : }
667 :
668 : L500:
669 0 : if (qsize[enode] == 0) {
670 0 : goto L700;
671 : }
672 0 : deg0 += qsize[enode];
673 0 : marker[enode] = mtag;
674 : /* ---------------------------------- */
675 : /* IF ENODE REQUIRES A DEGREE UPDATE, */
676 : /* THEN DO THE FOLLOWING. */
677 : /* ---------------------------------- */
678 0 : if (dbakw[enode] != 0) {
679 0 : goto L700;
680 : }
681 : /* ---------------------------------------
682 : */
683 : /* PLACE EITHER IN QXHEAD OR Q2HEAD LISTS.
684 : */
685 : /* ---------------------------------------
686 : */
687 0 : if (dforw[enode] == 2) {
688 0 : goto L600;
689 : }
690 0 : llist[enode] = qxhead;
691 : qxhead = enode;
692 0 : goto L700;
693 : L600:
694 0 : llist[enode] = q2head;
695 : q2head = enode;
696 0 : L700:
697 : ;
698 : }
699 0 : L800:
700 : /* -------------------------------------------- */
701 : /* FOR EACH ENODE IN Q2 LIST, DO THE FOLLOWING. */
702 : /* -------------------------------------------- */
703 : enode = q2head;
704 : iq2 = 1;
705 0 : L900:
706 0 : if (enode <= 0) {
707 0 : goto L1500;
708 : }
709 0 : if (dbakw[enode] != 0) {
710 0 : goto L2200;
711 : }
712 0 : ++(*tag);
713 : deg = deg0;
714 : /* ------------------------------------------ */
715 : /* IDENTIFY THE OTHER ADJACENT ELEMENT NABOR. */
716 : /* ------------------------------------------ */
717 0 : istrt = xadj[enode];
718 0 : nabor = adjncy[istrt];
719 0 : if (nabor == elmnt) {
720 0 : nabor = adjncy[istrt + 1];
721 : }
722 : /* ------------------------------------------------ */
723 : /* IF NABOR IS UNELIMINATED, INCREASE DEGREE COUNT. */
724 : /* ------------------------------------------------ */
725 : link = nabor;
726 0 : if (dforw[nabor] < 0) {
727 0 : goto L1000;
728 : }
729 0 : deg += qsize[nabor];
730 0 : goto L2100;
731 0 : L1000:
732 : /* -------------------------------------------- */
733 : /* OTHERWISE, FOR EACH NODE IN THE 2ND ELEMENT, */
734 : /* DO THE FOLLOWING. */
735 : /* -------------------------------------------- */
736 0 : istrt = xadj[link];
737 0 : istop = xadj[link + 1] - 1;
738 : i__1 = istop;
739 0 : for (i = istrt; i <= i__1; ++i) {
740 0 : node = adjncy[i];
741 0 : link = -node;
742 0 : if (node == enode) {
743 0 : goto L1400;
744 : }
745 0 : if (node < 0) {
746 0 : goto L1000;
747 0 : } else if (node == 0) {
748 0 : goto L2100;
749 : } else {
750 0 : goto L1100;
751 : }
752 :
753 : L1100:
754 0 : if (qsize[node] == 0) {
755 0 : goto L1400;
756 : }
757 0 : if (marker[node] >= *tag) {
758 0 : goto L1200;
759 : }
760 : /* -----------------------------------
761 : -- */
762 : /* CASE WHEN NODE IS NOT YET CONSIDERED
763 : . */
764 : /* -----------------------------------
765 : -- */
766 0 : marker[node] = *tag;
767 0 : deg += qsize[node];
768 0 : goto L1400;
769 : L1200:
770 : /* ----------------------------------------
771 : */
772 : /* CASE WHEN NODE IS INDISTINGUISHABLE FROM
773 : */
774 : /* ENODE. MERGE THEM INTO A NEW SUPERNODE.
775 : */
776 : /* ----------------------------------------
777 : */
778 0 : if (dbakw[node] != 0) {
779 0 : goto L1400;
780 : }
781 0 : if (dforw[node] != 2) {
782 0 : goto L1300;
783 : }
784 0 : qsize[enode] += qsize[node];
785 0 : qsize[node] = 0;
786 0 : marker[node] = *maxint;
787 0 : dforw[node] = -enode;
788 0 : dbakw[node] = -(*maxint);
789 0 : goto L1400;
790 : L1300:
791 : /* --------------------------------------
792 : */
793 : /* CASE WHEN NODE IS OUTMATCHED BY ENODE.
794 : */
795 : /* --------------------------------------
796 : */
797 : if (dbakw[node] == 0) {
798 0 : dbakw[node] = -(*maxint);
799 : }
800 0 : L1400:
801 : ;
802 : }
803 0 : goto L2100;
804 : L1500:
805 : /* ------------------------------------------------ */
806 : /* FOR EACH ENODE IN THE QX LIST, DO THE FOLLOWING. */
807 : /* ------------------------------------------------ */
808 : enode = qxhead;
809 : iq2 = 0;
810 0 : L1600:
811 0 : if (enode <= 0) {
812 0 : goto L2300;
813 : }
814 0 : if (dbakw[enode] != 0) {
815 0 : goto L2200;
816 : }
817 0 : ++(*tag);
818 : deg = deg0;
819 : /* --------------------------------- */
820 : /* FOR EACH UNMARKED NABOR OF ENODE, */
821 : /* DO THE FOLLOWING. */
822 : /* --------------------------------- */
823 0 : istrt = xadj[enode];
824 0 : istop = xadj[enode + 1] - 1;
825 : i__1 = istop;
826 0 : for (i = istrt; i <= i__1; ++i) {
827 0 : nabor = adjncy[i];
828 0 : if (nabor == 0) {
829 0 : goto L2100;
830 : }
831 0 : if (marker[nabor] >= *tag) {
832 0 : goto L2000;
833 : }
834 0 : marker[nabor] = *tag;
835 : link = nabor;
836 : /* ------------------------------ */
837 : /* IF UNELIMINATED, INCLUDE IT IN */
838 : /* DEG COUNT. */
839 : /* ------------------------------ */
840 0 : if (dforw[nabor] < 0) {
841 0 : goto L1700;
842 : }
843 0 : deg += qsize[nabor];
844 0 : goto L2000;
845 0 : L1700:
846 : /* -------------------------------
847 : */
848 : /* IF ELIMINATED, INCLUDE UNMARKED
849 : */
850 : /* NODES IN THIS ELEMENT INTO THE
851 : */
852 : /* DEGREE COUNT. */
853 : /* -------------------------------
854 : */
855 0 : jstrt = xadj[link];
856 0 : jstop = xadj[link + 1] - 1;
857 : i__2 = jstop;
858 0 : for (j = jstrt; j <= i__2; ++j) {
859 0 : node = adjncy[j];
860 0 : link = -node;
861 0 : if (node < 0) {
862 0 : goto L1700;
863 0 : } else if (node == 0) {
864 0 : goto L2000;
865 : } else {
866 0 : goto L1800;
867 : }
868 :
869 : L1800:
870 0 : if (marker[node] >= *tag) {
871 0 : goto L1900;
872 : }
873 0 : marker[node] = *tag;
874 0 : deg += qsize[node];
875 0 : L1900:
876 : ;
877 : }
878 0 : L2000:
879 : ;
880 : }
881 0 : L2100:
882 : /* ------------------------------------------- */
883 : /* UPDATE EXTERNAL DEGREE OF ENODE IN DEGREE */
884 : /* STRUCTURE, AND MDEG (MIN DEG) IF NECESSARY. */
885 : /* ------------------------------------------- */
886 0 : deg = deg - qsize[enode] + 1;
887 0 : fnode = dhead[deg];
888 0 : dforw[enode] = fnode;
889 0 : dbakw[enode] = -deg;
890 0 : if (fnode > 0) {
891 0 : dbakw[fnode] = enode;
892 : }
893 0 : dhead[deg] = enode;
894 0 : if (deg < *mdeg) {
895 0 : *mdeg = deg;
896 : }
897 0 : L2200:
898 : /* ---------------------------------- */
899 : /* GET NEXT ENODE IN CURRENT ELEMENT. */
900 : /* ---------------------------------- */
901 0 : enode = llist[enode];
902 0 : if (iq2 == 1) {
903 0 : goto L900;
904 : }
905 0 : goto L1600;
906 : L2300:
907 : /* ----------------------------- */
908 : /* GET NEXT ELEMENT IN THE LIST. */
909 : /* ----------------------------- */
910 0 : *tag = mtag;
911 0 : elmnt = llist[elmnt];
912 0 : goto L100;
913 :
914 : } /* slu_mmdupd_ */
915 :
916 : /* *************************************************************** */
917 : /* *************************************************************** */
918 : /* ***** MMDNUM ..... MULTI MINIMUM DEGREE NUMBERING ***** */
919 : /* *************************************************************** */
920 : /* *************************************************************** */
921 :
922 : /* AUTHOR - JOSEPH W.H. LIU */
923 : /* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
924 :
925 : /* PURPOSE - THIS ROUTINE PERFORMS THE FINAL STEP IN */
926 : /* PRODUCING THE PERMUTATION AND INVERSE PERMUTATION */
927 : /* VECTORS IN THE MULTIPLE ELIMINATION VERSION OF THE */
928 : /* MINIMUM DEGREE ORDERING ALGORITHM. */
929 :
930 : /* INPUT PARAMETERS - */
931 : /* NEQNS - NUMBER OF EQUATIONS. */
932 : /* QSIZE - SIZE OF SUPERNODES AT ELIMINATION. */
933 :
934 : /* UPDATED PARAMETERS - */
935 : /* INVP - INVERSE PERMUTATION VECTOR. ON INPUT, */
936 : /* IF QSIZE(NODE)=0, THEN NODE HAS BEEN MERGED */
937 : /* INTO THE NODE -INVP(NODE); OTHERWISE, */
938 : /* -INVP(NODE) IS ITS INVERSE LABELLING. */
939 :
940 : /* OUTPUT PARAMETERS - */
941 : /* PERM - THE PERMUTATION VECTOR. */
942 :
943 : /* *************************************************************** */
944 :
945 : /* Subroutine */
946 0 : int slu_mmdnum_(const int *neqns, int *perm, int *invp, shortint *qsize)
947 : {
948 : /* System generated locals */
949 :
950 : int i__1;
951 :
952 : /* Local variables */
953 : int_t node, root, nextf, father, nqsize, num;
954 :
955 :
956 : /* *************************************************************** */
957 :
958 :
959 : /* *************************************************************** */
960 :
961 : /* Parameter adjustments */
962 : --qsize;
963 0 : --invp;
964 0 : --perm;
965 :
966 : /* Function Body */
967 0 : i__1 = *neqns;
968 0 : for (node = 1; node <= i__1; ++node) {
969 0 : nqsize = qsize[node];
970 0 : if (nqsize <= 0) {
971 0 : perm[node] = invp[node];
972 : }
973 : if (nqsize > 0) {
974 0 : perm[node] = -invp[node];
975 : }
976 : /* L100: */
977 : }
978 : /* ------------------------------------------------------ */
979 : /* FOR EACH NODE WHICH HAS BEEN MERGED, DO THE FOLLOWING. */
980 : /* ------------------------------------------------------ */
981 0 : i__1 = *neqns;
982 0 : for (node = 1; node <= i__1; ++node) {
983 0 : if (perm[node] > 0) {
984 0 : goto L500;
985 : }
986 : /* ----------------------------------------- */
987 : /* TRACE THE MERGED TREE UNTIL ONE WHICH HAS */
988 : /* NOT BEEN MERGED, CALL IT ROOT. */
989 : /* ----------------------------------------- */
990 : father = node;
991 0 : L200:
992 0 : if (perm[father] > 0) {
993 0 : goto L300;
994 : }
995 0 : father = -perm[father];
996 0 : goto L200;
997 : L300:
998 : /* ----------------------- */
999 : /* NUMBER NODE AFTER ROOT. */
1000 : /* ----------------------- */
1001 : root = father;
1002 0 : num = perm[root] + 1;
1003 0 : invp[node] = -num;
1004 0 : perm[root] = num;
1005 : /* ------------------------ */
1006 : /* SHORTEN THE MERGED TREE. */
1007 : /* ------------------------ */
1008 : father = node;
1009 0 : L400:
1010 0 : nextf = -perm[father];
1011 0 : if (nextf <= 0) {
1012 0 : goto L500;
1013 : }
1014 0 : perm[father] = -root;
1015 : father = nextf;
1016 0 : goto L400;
1017 0 : L500:
1018 : ;
1019 : }
1020 : /* ---------------------- */
1021 : /* READY TO COMPUTE PERM. */
1022 : /* ---------------------- */
1023 0 : i__1 = *neqns;
1024 0 : for (node = 1; node <= i__1; ++node) {
1025 0 : num = -invp[node];
1026 0 : invp[node] = num;
1027 0 : perm[num] = node;
1028 : /* L600: */
1029 : }
1030 0 : return 0;
1031 :
1032 : } /* slu_mmdnum_ */
1033 :
|
