EpetraExt Development
Loading...
Searching...
No Matches
rectblk.f
Go to the documentation of this file.
1 subroutine rectblk ( nrows , ncols , marked, unmrkd, colstr,
2 $ rowidx, colset, rowset, prevcl, tryrow,
3 $ colmrk, rowmrk, nhrows, nhcols )
4
5c ==================================================================
6c ==================================================================
7c ==== rectblk -- find rectangular portion of matrix by ====
8c ==== depth-first search ====
9c ==================================================================
10c ==================================================================
11
12c original -- alex pothen and chin-ju fan, penn state, 1988
13c bcs modifications, john lewis, sept. 1990
14
15c use a depth-first serch to find all the rows and columns, which
16c can be reached via alternating paths beginning from all the
17c unmatched columns. comments and names describe use of code
18c for finding the 'horizontal' block. the same code is used
19c to find the vertical block by performing exactly the same
20c operations on the transpose of the matrix.
21c
22c input variables:
23c
24c nrows -- number of rows
25c ncols -- number of columns
26c marked -- value to store in marker vectors to indicate
27c that row/column has been reached and is
28c therefore in the horizontal block
29c unmrkd -- initial value of marker vectors, indicating
30c that row or column is free to be chosen
31c colstr,
32c rowidx -- adjacency structure of graph
33c colset -- maximum matching for columns
34c rowset -- maximum matching for rows
35c
36c output variables:
37c
38c nhrows -- number of rows in horizontal block
39c nhcols -- number of columns in horizontal block
40c rowmrk,
41c colmrk -- row and column marker vectors.
42c = unmrkd --> row/column is in neither the
43c horizontal or vertical block yet
44c = marked --> row/column has been reached via
45c search in this routine and lies
46c in the horizontal block
47c = neither --> row/column is not free for use.
48c it was found to lie in another
49c block.
50c
51c working variables:
52c
53c tryrow -- tryrow (col) is a pointer into rowidx to the
54c next row to be explored from col 'col' in
55c the search.
56c prevcl -- pointer toward the root of the search from
57c column to column.
58c
59c ==================================================================
60
61c --------------
62c ... parameters
63c --------------
64
65 integer nrows, ncols, marked, unmrkd, nhcols, nhrows
66
67 integer colstr (nrows+1), rowidx (*), rowset (nrows),
68 $ colset (ncols)
69
70 integer prevcl (ncols), tryrow (ncols), colmrk (ncols),
71 $ rowmrk (nrows)
72
73c -------------------
74c ... local variables
75c -------------------
76
77 integer col, fromc, nextcl, nextrw, p, row, xrow
78
79c ==================================================================
80
81 nhcols = 0
82 nhrows = 0
83
84 do 300 p = 1, ncols
85
86c -----------------------------------------------------------
87c ... find an unmatched column to start the alternating path.
88c -----------------------------------------------------------
89
90 if ( colset(p) .eq. 0 ) then
91
92 fromc = p
93
94c ---------------------------------------------
95c ... path starts from unmatched column "fromc"
96c put fromc into horizontal set "hc"
97c indicate fromc is the root of the path.
98c ---------------------------------------------
99
100 nhcols = nhcols + 1
101 colmrk(fromc) = marked
102 tryrow(fromc) = colstr(fromc)
103 prevcl(fromc) = 0
104 col = fromc
105
106c ------------------------------------------------------
107c ... main depth-first search loop begins here.
108c Each time through take a step forward if possible
109c or backtrack if not. quit when we backtrack to the
110c beginning of the search.
111c ------------------------------------------------------
112c
113c ------------------------------------------------
114c ... look for a forward step from column 'col' to
115c an unmarked row.
116c ------------------------------------------------
117
118 100 nextrw = tryrow(col)
119 do 200 xrow = nextrw, colstr(col + 1) - 1
120
121 if ( rowmrk(rowidx(xrow)) .eq. unmrkd ) then
122
123c ---------------------------------------------------
124c ... take a double forward step from 'col' to 'row'
125c and then via matching edge from 'row' to column
126c 'nextcl'. ('row' must be matched since
127c otherwise we have found an augmenting path
128c and the maximum matching wasn't matching.)
129c ---------------------------------------------------
130
131 tryrow(col) = xrow + 1
132 row = rowidx(xrow)
133 rowmrk(row) = marked
134 nhrows = nhrows + 1
135
136 nextcl = rowset(row)
137 if ( nextcl .eq. 0 ) then
138 write (6, 60000)
13960000 format (' max matching is wrong -- augmenting ',
140 $ 'path found')
141 stop
142 endif
143
144 nhcols = nhcols + 1
145 colmrk(nextcl) = marked
146 prevcl(nextcl) = col
147 tryrow(nextcl) = colstr(nextcl)
148 col = nextcl
149 go to 100
150 endif
151
152 200 continue
153
154c ------------------------------------------------
155c ... no forward step: backtrack. if we backtrack
156c all the way, we have completed all searchs
157c beginning at column 'p'.
158c ------------------------------------------------
159
160 col = prevcl(col)
161 if ( col .ne. 0 ) then
162 go to 100
163 endif
164
165 endif
166
167 300 continue
168
169 return
170
171 end
172
subroutine rectblk(nrows, ncols, marked, unmrkd, colstr, rowidx, colset, rowset, prevcl, tryrow, colmrk, rowmrk, nhrows, nhcols)
Definition: rectblk.f:4