37
37
<a name="line27"> 27: </a><font color="#B22222">/* PROGRAM SUBROUTINES -*/</font>
38
38
<a name="line28"> 28: </a><font color="#B22222">/* FN1WD, REVRSE, ../../..LS.*/</font>
39
39
<a name="line29"> 29: </a><font color="#B22222">/****************************************************************/</font>
40
<a name="line30"> 30: </a><strong><font color="#4169E1"><a name="SPARSEPACKgen1wd"></a>int SPARSEPACKgen1wd(int *neqns, int *xadj, int *adjncy, </font></strong>
41
<a name="line31"> 31: </a><strong><font color="#4169E1"> int *mask, int *nblks, int *xblk, int *perm, int *</font></strong>
42
<a name="line32"> 32: </a><strong><font color="#4169E1"> xls, int *ls)</font></strong>
43
<a name="line33"> 33: </a>{
44
<a name="line34"> 34: </a> <font color="#B22222">/* System generated locals */</font>
45
<a name="line35"> 35: </a> int i__1, i__2, i__3;
47
<a name="line37"> 37: </a> <font color="#B22222">/* Local variables */</font>
48
<a name="line38"> 38: </a> int node, nsep, lnum, nlvl, root;
49
<a name="line39"> 39: </a> EXTERN int SPARSEPACKfn1wd(int *, int *, int *,
50
<a name="line40"> 40: </a> int *, int *, int *, int *, int *, int *);
51
<a name="line41"> 41: </a> int i, j, k, ccsize;
52
<a name="line42"> 42: </a> EXTERN int SPARSEPACKrevrse(int *, int *), SPARSEPACKrootls(
53
<a name="line43"> 43: </a> int *, int *, int *, int *, int *, int *, int *);
54
<a name="line44"> 44: </a> int num;
56
<a name="line47"> 47: </a> <font color="#B22222">/* Parameter adjustments */</font>
57
<a name="line48"> 48: </a> --ls;
58
<a name="line49"> 49: </a> --xls;
59
<a name="line50"> 50: </a> --perm;
60
<a name="line51"> 51: </a> --xblk;
61
<a name="line52"> 52: </a> --mask;
62
<a name="line53"> 53: </a> --xadj;
63
<a name="line54"> 54: </a> --adjncy;
65
<a name="line56"> 56: </a> i__1 = *neqns;
66
<a name="line57"> 57: </a> <font color="#4169E1">for</font> (i = 1; i <= i__1; ++i) {
67
<a name="line58"> 58: </a> mask[i] = 1;
68
<a name="line59"> 59: </a> }
69
<a name="line60"> 60: </a> *nblks = 0;
70
<a name="line61"> 61: </a> num = 0;
71
<a name="line62"> 62: </a> i__1 = *neqns;
72
<a name="line63"> 63: </a> <font color="#4169E1">for</font> (i = 1; i <= i__1; ++i) {
73
<a name="line64"> 64: </a> <font color="#4169E1">if</font> (mask[i] == 0) {
74
<a name="line65"> 65: </a> <font color="#4169E1">goto</font> L400;
75
<a name="line66"> 66: </a> }
76
<a name="line67"> 67: </a><font color="#B22222">/* FIND A ONE-WAY DISSECTOR FOR EACH COMPONENT.*/</font>
77
<a name="line68"> 68: </a> root = i;
78
<a name="line69"> 69: </a> SPARSEPACKfn1wd(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &
79
<a name="line70"> 70: </a> nlvl, &xls[1], &ls[1]);
80
<a name="line71"> 71: </a> num += nsep;
81
<a name="line72"> 72: </a> ++(*nblks);
82
<a name="line73"> 73: </a> xblk[*nblks] = *neqns - num + 1;
83
<a name="line74"> 74: </a> ccsize = xls[nlvl + 1] - 1;
84
<a name="line75"> 75: </a><font color="#B22222">/* NUMBER THE REMAINING NODES IN THE COMPONENT.*/</font>
85
<a name="line76"> 76: </a><font color="#B22222">/* EACH COMPONENT IN THE REMAINING SUBGRAPH FORMS*/</font>
86
<a name="line77"> 77: </a><font color="#B22222">/* A NEW BLOCK IN THE PARTITIONING.*/</font>
87
<a name="line78"> 78: </a> i__2 = ccsize;
88
<a name="line79"> 79: </a> <font color="#4169E1">for</font> (j = 1; j <= i__2; ++j) {
89
<a name="line80"> 80: </a> node = ls[j];
90
<a name="line81"> 81: </a> <font color="#4169E1">if</font> (mask[node] == 0) {
91
<a name="line82"> 82: </a> <font color="#4169E1">goto</font> L300;
92
<a name="line83"> 83: </a> }
93
<a name="line84"> 84: </a> SPARSEPACKrootls(&node, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &
94
<a name="line85"> 85: </a> perm[num + 1]);
95
<a name="line86"> 86: </a> lnum = num + 1;
96
<a name="line87"> 87: </a> num = num + xls[nlvl + 1] - 1;
97
<a name="line88"> 88: </a> ++(*nblks);
98
<a name="line89"> 89: </a> xblk[*nblks] = *neqns - num + 1;
99
<a name="line90"> 90: </a> i__3 = num;
100
<a name="line91"> 91: </a> <font color="#4169E1">for</font> (k = lnum; k <= i__3; ++k) {
101
<a name="line92"> 92: </a> node = perm[k];
102
<a name="line93"> 93: </a> mask[node] = 0;
103
<a name="line94"> 94: </a> }
104
<a name="line95"> 95: </a> <font color="#4169E1">if</font> (num > *neqns) {
105
<a name="line96"> 96: </a> <font color="#4169E1">goto</font> L500;
106
<a name="line97"> 97: </a> }
107
<a name="line98"> 98: </a><strong><font color="#FF0000">L300:</font></strong>
108
<a name="line99"> 99: </a> ;
109
<a name="line100">100: </a> }
110
<a name="line101">101: </a><strong><font color="#FF0000">L400:</font></strong>
111
<a name="line102">102: </a> ;
112
<a name="line103">103: </a> }
113
<a name="line104">104: </a><font color="#B22222">/* SINCE DISSECTORS FOUND FIRST SHOULD BE ORDERED LAST,*/</font>
114
<a name="line105">105: </a><font color="#B22222">/* ROUTINE REVRSE <A href="../../../docs/manualpages/IS/IS.html#IS">IS</A> CALLED TO ADJUST THE ORDERING*/</font>
115
<a name="line106">106: </a><font color="#B22222">/* VECTOR, AND THE BLOCK INDEX VECTOR.*/</font>
116
<a name="line107">107: </a><strong><font color="#FF0000">L500:</font></strong>
117
<a name="line108">108: </a> SPARSEPACKrevrse(neqns, &perm[1]);
118
<a name="line109">109: </a> SPARSEPACKrevrse(nblks, &xblk[1]);
119
<a name="line110">110: </a> xblk[*nblks + 1] = *neqns + 1;
120
<a name="line111">111: </a> <font color="#4169E1">return</font>(0);
121
<a name="line112">112: </a>}
40
<a name="line32"> 32: </a><strong><font color="#4169E1"><a name="SPARSEPACKgen1wd"></a>int SPARSEPACKgen1wd(int *neqns, int *xadj, int *adjncy, </font></strong>
41
<a name="line33"> 33: </a><strong><font color="#4169E1"> int *mask, int *nblks, int *xblk, int *perm, int *</font></strong>
42
<a name="line34"> 34: </a><strong><font color="#4169E1"> xls, int *ls)</font></strong>
43
<a name="line35"> 35: </a>{
44
<a name="line36"> 36: </a> <font color="#B22222">/* System generated locals */</font>
45
<a name="line37"> 37: </a> int i__1, i__2, i__3;
47
<a name="line39"> 39: </a> <font color="#B22222">/* Local variables */</font>
48
<a name="line40"> 40: </a> int node, nsep, lnum, nlvl, root;
49
<a name="line41"> 41: </a> EXTERN int SPARSEPACKfn1wd(int *, int *, int *,
50
<a name="line42"> 42: </a> int *, int *, int *, int *, int *, int *);
51
<a name="line43"> 43: </a> int i, j, k, ccsize;
52
<a name="line44"> 44: </a> EXTERN int SPARSEPACKrevrse(int *, int *), SPARSEPACKrootls(
53
<a name="line45"> 45: </a> int *, int *, int *, int *, int *, int *, int *);
54
<a name="line46"> 46: </a> int num;
56
<a name="line49"> 49: </a> <font color="#B22222">/* Parameter adjustments */</font>
57
<a name="line50"> 50: </a> --ls;
58
<a name="line51"> 51: </a> --xls;
59
<a name="line52"> 52: </a> --perm;
60
<a name="line53"> 53: </a> --xblk;
61
<a name="line54"> 54: </a> --mask;
62
<a name="line55"> 55: </a> --xadj;
63
<a name="line56"> 56: </a> --adjncy;
65
<a name="line58"> 58: </a> i__1 = *neqns;
66
<a name="line59"> 59: </a> <font color="#4169E1">for</font> (i = 1; i <= i__1; ++i) {
67
<a name="line60"> 60: </a> mask[i] = 1;
68
<a name="line61"> 61: </a> }
69
<a name="line62"> 62: </a> *nblks = 0;
70
<a name="line63"> 63: </a> num = 0;
71
<a name="line64"> 64: </a> i__1 = *neqns;
72
<a name="line65"> 65: </a> <font color="#4169E1">for</font> (i = 1; i <= i__1; ++i) {
73
<a name="line66"> 66: </a> <font color="#4169E1">if</font> (mask[i] == 0) {
74
<a name="line67"> 67: </a> <font color="#4169E1">goto</font> L400;
75
<a name="line68"> 68: </a> }
76
<a name="line69"> 69: </a><font color="#B22222">/* FIND A ONE-WAY DISSECTOR FOR EACH COMPONENT.*/</font>
77
<a name="line70"> 70: </a> root = i;
78
<a name="line71"> 71: </a> SPARSEPACKfn1wd(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &
79
<a name="line72"> 72: </a> nlvl, &xls[1], &ls[1]);
80
<a name="line73"> 73: </a> num += nsep;
81
<a name="line74"> 74: </a> ++(*nblks);
82
<a name="line75"> 75: </a> xblk[*nblks] = *neqns - num + 1;
83
<a name="line76"> 76: </a> ccsize = xls[nlvl + 1] - 1;
84
<a name="line77"> 77: </a><font color="#B22222">/* NUMBER THE REMAINING NODES IN THE COMPONENT.*/</font>
85
<a name="line78"> 78: </a><font color="#B22222">/* EACH COMPONENT IN THE REMAINING SUBGRAPH FORMS*/</font>
86
<a name="line79"> 79: </a><font color="#B22222">/* A NEW BLOCK IN THE PARTITIONING.*/</font>
87
<a name="line80"> 80: </a> i__2 = ccsize;
88
<a name="line81"> 81: </a> <font color="#4169E1">for</font> (j = 1; j <= i__2; ++j) {
89
<a name="line82"> 82: </a> node = ls[j];
90
<a name="line83"> 83: </a> <font color="#4169E1">if</font> (mask[node] == 0) {
91
<a name="line84"> 84: </a> <font color="#4169E1">goto</font> L300;
92
<a name="line85"> 85: </a> }
93
<a name="line86"> 86: </a> SPARSEPACKrootls(&node, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &
94
<a name="line87"> 87: </a> perm[num + 1]);
95
<a name="line88"> 88: </a> lnum = num + 1;
96
<a name="line89"> 89: </a> num = num + xls[nlvl + 1] - 1;
97
<a name="line90"> 90: </a> ++(*nblks);
98
<a name="line91"> 91: </a> xblk[*nblks] = *neqns - num + 1;
99
<a name="line92"> 92: </a> i__3 = num;
100
<a name="line93"> 93: </a> <font color="#4169E1">for</font> (k = lnum; k <= i__3; ++k) {
101
<a name="line94"> 94: </a> node = perm[k];
102
<a name="line95"> 95: </a> mask[node] = 0;
103
<a name="line96"> 96: </a> }
104
<a name="line97"> 97: </a> <font color="#4169E1">if</font> (num > *neqns) {
105
<a name="line98"> 98: </a> <font color="#4169E1">goto</font> L500;
106
<a name="line99"> 99: </a> }
107
<a name="line100">100: </a><strong><font color="#FF0000">L300:</font></strong>
108
<a name="line101">101: </a> ;
109
<a name="line102">102: </a> }
110
<a name="line103">103: </a><strong><font color="#FF0000">L400:</font></strong>
111
<a name="line104">104: </a> ;
112
<a name="line105">105: </a> }
113
<a name="line106">106: </a><font color="#B22222">/* SINCE DISSECTORS FOUND FIRST SHOULD BE ORDERED LAST,*/</font>
114
<a name="line107">107: </a><font color="#B22222">/* ROUTINE REVRSE <A href="../../../docs/manualpages/IS/IS.html#IS">IS</A> CALLED TO ADJUST THE ORDERING*/</font>
115
<a name="line108">108: </a><font color="#B22222">/* VECTOR, AND THE BLOCK INDEX VECTOR.*/</font>
116
<a name="line109">109: </a><strong><font color="#FF0000">L500:</font></strong>
117
<a name="line110">110: </a> SPARSEPACKrevrse(neqns, &perm[1]);
118
<a name="line111">111: </a> SPARSEPACKrevrse(nblks, &xblk[1]);
119
<a name="line112">112: </a> xblk[*nblks + 1] = *neqns + 1;
120
<a name="line113">113: </a> <font color="#4169E1">return</font>(0);
121
<a name="line114">114: </a>}