EpetraExt  Development
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
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,, nextcl, ctab, rtab, colmrk, rowmrk, cmclad, cmrwad, cnto, rnto, numcmp)
Definition: concmp.f:1