EpetraExt Development
Loading...
Searching...
No Matches
concmp.f
Go to the documentation of this file.
1 subroutine concmp ( cmbase, rnbase, cnbase, vindex, nrows ,
2 $ ncols , nvrows, nvcols, rowstr, colidx,
3 $ colstr, rowidx, predrw, nextrw, predcl, ,
4 $ nextcl, ctab , rtab , colmrk, rowmrk,
5 $ cmclad, cmrwad, cnto , rnto , numcmp )
6
7c ==================================================================
8c ==================================================================
9c ==== concmp -- find the connected components in the ====
10c ==== vertical (horizontal) block ====
11c ==================================================================
12c ==================================================================
13
14c original -- alex pothen and chin-ju fan, penn state, 1988
15c bcs modifications, john lewis, sept. 19, 1990
16
17c concmp: find the connected components in the subgraph spanned
18c by the rows and columns in the vertical block. the
19c same subroutine is used to find the connected
20c components in the horizontal block -- the transpose
21c of the matrix is used for that case.
22c
23c input variables:
24c
25c cmbase -- the number of components found in previous fine
26c analysis of the coarse partition
27c rnbase -- the number of rows in earlier numbered partitions
28c (0 for the horizontal block, nhrows+nsrows for
29c the vertical partition)
30c cnbase -- the number of columns in earlier numbered partitions
31c vindex -- used to check whether the nodes belong in the
32c vertical block
33c nrows -- number of rows in the matrix
34c ncols -- number of columns in the matrix
35c nvrows -- number of rows in the vertical block
36c nvcols -- number of columns in the vertical block
37c rowstr, colidx
38c -- the adjacency structure of the matrix using
39c row-wise storage
40c colstr, rowidx
41c -- the adjacency structure of the matrix using
42c column-wise storage
43c
44c output variables:
45c
46c numcmp -- number of connected components
47c colmrk -- initially,
48c colmrk(i) = vindex if i belongs to vc.
49c < 0 otherwise.
50c during execution,
51c colmrk(i) = j, if i belongs to the jth component.
52c after execution, original values restored
53c rowmrk -- initially,
54c rowmrk(i) = vindex if i belongs to vr.
55c < 0 otherwise.
56c during execution,
57c rowmrk(i) = j, if i belongs to the jth component.
58c < 0 otherwise.
59c after execution, original values restored
60c cmclad, cmrwad
61c -- the address (in the new ordering) of the
62c first column/row in each component,
63c cnto -- the new to old mapping for the columns
64c rnto -- the new to old mapping for the rows
65c
66c working variables:
67c
68c predrw, predcl
69c -- the path stack --
70c predrw(i) = j means that we have in the path an
71c edge leaving from row node j to
72c column node i.
73c predcl(i) = j means that we have in the path an
74c edge leaving from column node j to
75c row node i.
76c nextcl -- nextcl(i) is index of first unsearched edge leaving
77c from column node i.
78c nextrw -- nextrw(i) is index of first unsearched edge leaving
79c from row node i.
80c
81c ctab, rtab
82c -- temporary copy of the address (in the new ordering)
83c of the first column/row in each component
84c
85c ==================================================================
86
87c --------------
88c ... parameters
89c --------------
90
91 integer cmbase, rnbase, cnbase, vindex, nrows , ncols ,
92 $ nvrows, nvcols, numcmp
93
94 integer colstr (nrows+1), rowstr (ncols+1), rowidx (*),
95 $ colidx(*)
96
97 integer predrw (ncols), nextrw (nrows),
98 $ predcl(nrows), nextcl(ncols),
99 $ cmclad(ncols), cmrwad(nrows),
100 $ colmrk(ncols), rowmrk(nrows),
101 $ ctab(*) , rtab(*),
102 $ cnto(ncols) , rnto(nrows)
103
104c -------------------
105c ... local variables
106c -------------------
107
108 integer col, compn, p, cn, rn, row, xcol, xrow
109
110c ==================================================================
111
112c initialization
113c cn -- the number of the scanned column node
114c rn -- the number of the scanned row node
115
116 cn = 0
117 rn = 0
118 numcmp = 0
119
120c ----------------------------------------------------------------
121c ... number of vertical rows > number of vertical columns.
122c start each search for a connected component with an unmarked
123c row in the vertical block.
124c ----------------------------------------------------------------
125
126
127 do 500 p = 1, nrows
128
129 if ( rowmrk(p) .eq. vindex ) then
130
131 row = p
132
133c --------------------------------------------------------
134c ... update the value of the current working component
135c put 'row' into the new component as the root of path
136c --------------------------------------------------------
137
138 numcmp = numcmp + 1
139 ctab(numcmp) = cnbase + 1 + cn
140 rtab(numcmp) = rnbase + 1 + rn
141 cmclad(cmbase + numcmp) = ctab(numcmp)
142 cmrwad(cmbase + numcmp) = rtab(numcmp)
143 rowmrk(row) = numcmp
144 rn = rn + 1
145 nextrw(row) = rowstr(row)
146 predcl(row) = 0
147
148c ------------------------------------------
149c ... from row node to col node --
150c try to find a forward step if possible
151c else backtrack
152c ------------------------------------------
153
154 100 do 200 xcol = nextrw(row), rowstr(row + 1) -1
155 col = colidx(xcol)
156
157 if ( colmrk(col) .eq. vindex ) then
158
159c ------------------------------------------------
160c ... forward one step :
161c find a forward step from row 'row' to column
162c 'col'. put 'col' into the current component
163c ------------------------------------------------
164
165 nextrw(row) = xcol + 1
166 colmrk(col) = numcmp
167 cn = cn + 1
168 nextcl(col) = colstr(col)
169 predrw(col) = row
170 go to 300
171
172 endif
173 200 continue
174
175c -----------------------------------------
176c ... backward one step (back to col node)
177c -----------------------------------------
178
179 nextrw(row) = rowstr(row + 1)
180 col = predcl(row)
181 if ( col .eq. 0 ) go to 500
182
183c ------------------------------------------
184c ... from col node to row node
185c try to find a forward step if possible
186c else backtrack
187c ------------------------------------------
188
189 300 do 400 xrow = nextcl(col), colstr(col + 1) - 1
190 row = rowidx(xrow)
191 if ( rowmrk(row) .eq. vindex ) then
192
193c --------------------------------------------------
194c ... forward one step :
195c find a forward step from column 'col' to
196c row 'row'. put row into the current component
197c --------------------------------------------------
198
199 nextcl(col) = xrow + 1
200 rowmrk(row) = numcmp
201 rn = rn + 1
202 nextrw(row) = rowstr(row)
203 predcl(row) = col
204 go to 100
205 endif
206 400 continue
207
208c -----------------------------------------
209c ... backward one step (back to row node)
210c -----------------------------------------
211
212 nextcl(col) = colstr(col + 1)
213 row = predrw(col)
214 go to 100
215
216 endif
217
218 500 continue
219
220c ------------------------------------------------------------
221c ... generate the column and row permutations (cnto and rnto)
222c so that each component is numbered consecutively
223c ------------------------------------------------------------
224
225 cmclad(cmbase + 1 + numcmp) = cnbase + 1 + nvcols
226 cmrwad(cmbase + 1 + numcmp) = rnbase + 1 + nvrows
227
228 do 600 col = 1, ncols
229 compn = colmrk(col)
230 if ( compn .gt. 0 ) then
231 cnto(ctab(compn)) = col
232 ctab(compn) = ctab(compn) + 1
233 colmrk(col) = vindex
234 endif
235 600 continue
236
237 do 700 row = 1, nrows
238 compn = rowmrk(row)
239 if ( compn .gt. 0 ) then
240 rnto(rtab(compn)) = row
241 rtab(compn) = rtab(compn) + 1
242 rowmrk(row) = vindex
243 endif
244 700 continue
245
246 return
247 end
248
subroutine concmp(cmbase, rnbase, cnbase, vindex, nrows, ncols, nvrows, nvcols, rowstr, colidx, colstr, rowidx, predrw, nextrw, predcl, nextcl, ctab, rtab, colmrk, rowmrk, cmclad, cmrwad, cnto, rnto, numcmp)
Definition: concmp.f:6