EpetraExt  Development
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 
7 c ==================================================================
8 c ==================================================================
9 c ==== concmp -- find the connected components in the ====
10 c ==== vertical (horizontal) block ====
11 c ==================================================================
12 c ==================================================================
13 
14 c original -- alex pothen and chin-ju fan, penn state, 1988
15 c bcs modifications, john lewis, sept. 19, 1990
16 
17 c concmp: find the connected components in the subgraph spanned
18 c by the rows and columns in the vertical block. the
19 c same subroutine is used to find the connected
20 c components in the horizontal block -- the transpose
21 c of the matrix is used for that case.
22 c
23 c input variables:
24 c
25 c cmbase -- the number of components found in previous fine
26 c analysis of the coarse partition
27 c rnbase -- the number of rows in earlier numbered partitions
28 c (0 for the horizontal block, nhrows+nsrows for
29 c the vertical partition)
30 c cnbase -- the number of columns in earlier numbered partitions
31 c vindex -- used to check whether the nodes belong in the
32 c vertical block
33 c nrows -- number of rows in the matrix
34 c ncols -- number of columns in the matrix
35 c nvrows -- number of rows in the vertical block
36 c nvcols -- number of columns in the vertical block
37 c rowstr, colidx
38 c -- the adjacency structure of the matrix using
39 c row-wise storage
40 c colstr, rowidx
41 c -- the adjacency structure of the matrix using
42 c column-wise storage
43 c
44 c output variables:
45 c
46 c numcmp -- number of connected components
47 c colmrk -- initially,
48 c colmrk(i) = vindex if i belongs to vc.
49 c < 0 otherwise.
50 c during execution,
51 c colmrk(i) = j, if i belongs to the jth component.
52 c after execution, original values restored
53 c rowmrk -- initially,
54 c rowmrk(i) = vindex if i belongs to vr.
55 c < 0 otherwise.
56 c during execution,
57 c rowmrk(i) = j, if i belongs to the jth component.
58 c < 0 otherwise.
59 c after execution, original values restored
60 c cmclad, cmrwad
61 c -- the address (in the new ordering) of the
62 c first column/row in each component,
63 c cnto -- the new to old mapping for the columns
64 c rnto -- the new to old mapping for the rows
65 c
66 c working variables:
67 c
68 c predrw, predcl
69 c -- the path stack --
70 c predrw(i) = j means that we have in the path an
71 c edge leaving from row node j to
72 c column node i.
73 c predcl(i) = j means that we have in the path an
74 c edge leaving from column node j to
75 c row node i.
76 c nextcl -- nextcl(i) is index of first unsearched edge leaving
77 c from column node i.
78 c nextrw -- nextrw(i) is index of first unsearched edge leaving
79 c from row node i.
80 c
81 c ctab, rtab
82 c -- temporary copy of the address (in the new ordering)
83 c of the first column/row in each component
84 c
85 c ==================================================================
86 
87 c --------------
88 c ... parameters
89 c --------------
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 
104 c -------------------
105 c ... local variables
106 c -------------------
107 
108  integer col, compn, p, cn, rn, row, xcol, xrow
109 
110 c ==================================================================
111 
112 c initialization
113 c cn -- the number of the scanned column node
114 c rn -- the number of the scanned row node
115 
116  cn = 0
117  rn = 0
118  numcmp = 0
119 
120 c ----------------------------------------------------------------
121 c ... number of vertical rows > number of vertical columns.
122 c start each search for a connected component with an unmarked
123 c row in the vertical block.
124 c ----------------------------------------------------------------
125 
126 
127  do 500 p = 1, nrows
128 
129  if ( rowmrk(p) .eq. vindex ) then
130 
131  row = p
132 
133 c --------------------------------------------------------
134 c ... update the value of the current working component
135 c put 'row' into the new component as the root of path
136 c --------------------------------------------------------
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 
148 c ------------------------------------------
149 c ... from row node to col node --
150 c try to find a forward step if possible
151 c else backtrack
152 c ------------------------------------------
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 
159 c ------------------------------------------------
160 c ... forward one step :
161 c find a forward step from row 'row' to column
162 c 'col'. put 'col' into the current component
163 c ------------------------------------------------
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 
175 c -----------------------------------------
176 c ... backward one step (back to col node)
177 c -----------------------------------------
178 
179  nextrw(row) = rowstr(row + 1)
180  col = predcl(row)
181  if ( col .eq. 0 ) go to 500
182 
183 c ------------------------------------------
184 c ... from col node to row node
185 c try to find a forward step if possible
186 c else backtrack
187 c ------------------------------------------
188 
189  300 do 400 xrow = nextcl(col), colstr(col + 1) - 1
190  row = rowidx(xrow)
191  if ( rowmrk(row) .eq. vindex ) then
192 
193 c --------------------------------------------------
194 c ... forward one step :
195 c find a forward step from column 'col' to
196 c row 'row'. put row into the current component
197 c --------------------------------------------------
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 
208 c -----------------------------------------
209 c ... backward one step (back to row node)
210 c -----------------------------------------
211 
212  nextcl(col) = colstr(col + 1)
213  row = predrw(col)
214  go to 100
215 
216  endif
217 
218  500 continue
219 
220 c ------------------------------------------------------------
221 c ... generate the column and row permutations (cnto and rnto)
222 c so that each component is numbered consecutively
223 c ------------------------------------------------------------
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,
Definition: concmp.f:4