EpetraExt  Development
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
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 
5 c ==================================================================
6 c ==================================================================
7 c ==== rectblk -- find rectangular portion of matrix by ====
8 c ==== depth-first search ====
9 c ==================================================================
10 c ==================================================================
11 
12 c original -- alex pothen and chin-ju fan, penn state, 1988
13 c bcs modifications, john lewis, sept. 1990
14 
15 c use a depth-first serch to find all the rows and columns, which
16 c can be reached via alternating paths beginning from all the
17 c unmatched columns. comments and names describe use of code
18 c for finding the 'horizontal' block. the same code is used
19 c to find the vertical block by performing exactly the same
20 c operations on the transpose of the matrix.
21 c
22 c input variables:
23 c
24 c nrows -- number of rows
25 c ncols -- number of columns
26 c marked -- value to store in marker vectors to indicate
27 c that row/column has been reached and is
28 c therefore in the horizontal block
29 c unmrkd -- initial value of marker vectors, indicating
30 c that row or column is free to be chosen
31 c colstr,
32 c rowidx -- adjacency structure of graph
33 c colset -- maximum matching for columns
34 c rowset -- maximum matching for rows
35 c
36 c output variables:
37 c
38 c nhrows -- number of rows in horizontal block
39 c nhcols -- number of columns in horizontal block
40 c rowmrk,
41 c colmrk -- row and column marker vectors.
42 c = unmrkd --> row/column is in neither the
43 c horizontal or vertical block yet
44 c = marked --> row/column has been reached via
45 c search in this routine and lies
46 c in the horizontal block
47 c = neither --> row/column is not free for use.
48 c it was found to lie in another
49 c block.
50 c
51 c working variables:
52 c
53 c tryrow -- tryrow (col) is a pointer into rowidx to the
54 c next row to be explored from col 'col' in
55 c the search.
56 c prevcl -- pointer toward the root of the search from
57 c column to column.
58 c
59 c ==================================================================
60 
61 c --------------
62 c ... parameters
63 c --------------
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 
73 c -------------------
74 c ... local variables
75 c -------------------
76 
77  integer col, fromc, nextcl, nextrw, p, row, xrow
78 
79 c ==================================================================
80 
81  nhcols = 0
82  nhrows = 0
83 
84  do 300 p = 1, ncols
85 
86 c -----------------------------------------------------------
87 c ... find an unmatched column to start the alternating path.
88 c -----------------------------------------------------------
89 
90  if ( colset(p) .eq. 0 ) then
91 
92  fromc = p
93 
94 c ---------------------------------------------
95 c ... path starts from unmatched column "fromc"
96 c put fromc into horizontal set "hc"
97 c indicate fromc is the root of the path.
98 c ---------------------------------------------
99 
100  nhcols = nhcols + 1
101  colmrk(fromc) = marked
102  tryrow(fromc) = colstr(fromc)
103  prevcl(fromc) = 0
104  col = fromc
105 
106 c ------------------------------------------------------
107 c ... main depth-first search loop begins here.
108 c Each time through take a step forward if possible
109 c or backtrack if not. quit when we backtrack to the
110 c beginning of the search.
111 c ------------------------------------------------------
112 c
113 c ------------------------------------------------
114 c ... look for a forward step from column 'col' to
115 c an unmarked row.
116 c ------------------------------------------------
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 
123 c ---------------------------------------------------
124 c ... take a double forward step from 'col' to 'row'
125 c and then via matching edge from 'row' to column
126 c 'nextcl'. ('row' must be matched since
127 c otherwise we have found an augmenting path
128 c and the maximum matching wasn't matching.)
129 c ---------------------------------------------------
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)
139 60000 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 
154 c ------------------------------------------------
155 c ... no forward step: backtrack. if we backtrack
156 c all the way, we have completed all searchs
157 c beginning at column 'p'.
158 c ------------------------------------------------
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 
rectblk
subroutine rectblk(nrows, ncols, marked, unmrkd, colstr, rowidx, colset, rowset, prevcl, tryrow, colmrk, rowmrk, nhrows, nhcols)
Definition: rectblk.f:1
Generated on Fri Dec 20 2024 09:27:22 for EpetraExt by   doxygen 1.8.5