EpetraExt Development
Loading...
Searching...
No Matches
maxmatch.f
Go to the documentation of this file.
1 subroutine maxmatch ( nrows , ncols , colstr, rowind, prevcl,
2 $ prevrw, marker, tryrow, nxtchp, rowset,
3 $ colset )
4c
5c ==================================================================
6c ==================================================================
7c ==== maxmatch -- find maximum matching ====
8c ==================================================================
9c ==================================================================
10
11c maxmatch uses depth-first search to find an augmenting path from
12c each column node to get the maximum matching.
13c
14c Alex Pothen and Chin-Ju Fan, Penn State University, 1988
15c last modifed: Alex Pothen July 1990
16c last bcs modifications: John Lewis, Sept. 1990
17c
18c input variables :
19c
20c nrows -- number of row nodes in the graph.
21c ncols -- number of column nodes in the graph.
22c colstr, rowind -- adjacency structure of graph, stored by
23c columns
24c
25c output variables :
26c
27c rowset -- describe the matching.
28c rowset (row) = col > 0 means column "col" is matched
29c to row "row"
30c = 0 means "row" is an unmatched
31c node.
32c colset -- describe the matching.
33c colset (col) = row > 0 means row "row" is matched to
34c column "col"
35c = 0 means "col" is an unmatched
36c node.
37c Working variables :
38c
39c prevrw (ncols) -- pointer toward the root of the depth-first
40c search from a column to a row.
41c prevcl (ncols) -- pointer toward the root of the depth-first
42c search from a column to a column.
43c the pair (prevrw,prevcl) represent a
44c matched pair.
45c marker (nrows) -- marker (row) <= the index of the root of the
46c current depth-first search. row has been
47c visited in current pass when equality holds.
48c tryrow (ncols) -- tryrow (col) is a pointer into rowind to
49c the next row to be explored from column col
50c in the depth-first search.
51c nxtchp (ncols) -- nxtchp (col) is a pointer into rowind to the
52c next row to be explored from column col for
53c the cheap assignment. set to -1 when
54c all rows have been considered for
55c cheap assignment
56c
57c ==================================================================
58
59c --------------
60c ... parameters
61c --------------
62
63 integer nrows, ncols
64
65 integer colstr (ncols+1), rowind (*), rowset (nrows),
66 $ colset (ncols)
67
68 integer prevrw (ncols), prevcl (ncols), tryrow (ncols),
69 $ marker (nrows), nxtchp (ncols)
70
71c -------------------
72c ... local variables
73c -------------------
74c
75 integer nodec, col, nextrw, lastrw, xrow, row, nxtcol,
76 $ prow, pcol
77c
78c ==================================================================
79
80 do 600 nodec = 1, ncols
81
82c --------------------------------------------------
83c ... initialize node 'col' as the root of the path.
84c --------------------------------------------------
85
86 col = nodec
87 prevrw(col) = 0
88 prevcl(col) = 0
89 nxtchp(col) = colstr(col)
90
91c -----------------------------------------------------------
92c ... main loop begins here. Each time through, try to find a
93c cheap assignment from node col.
94c -----------------------------------------------------------
95
96 100 nextrw = nxtchp(col)
97 lastrw = colstr(col+1) - 1
98
99 if (nextrw .gt. 0 ) then
100
101 do 200 xrow = nextrw, lastrw
102 row = rowind(xrow)
103 if ( rowset(row) .eq. 0 ) go to 400
104 200 continue
105
106c ------------------------------------------------
107c ... mark column when all adjacent rows have been
108c considered for cheap assignment.
109c ------------------------------------------------
110
111 nxtchp(col) = -1
112
113 endif
114
115c ------------------------------------------------------------
116c ... Each time through, take a step forward if possible, or
117c backtrack if not . Quit when backtracking takes us back
118c to the beginning of the search.
119c ------------------------------------------------------------
120
121 tryrow(col) = colstr(col)
122 nextrw = tryrow(col)
123c$$$ lastrw = colstr (col+1) - 1
124
125 if ( lastrw .ge. nextrw ) then
126 do 300 xrow = nextrw, lastrw
127c next line inserted by Alex Pothen, July 1990
128c$$$ ii = xrow
129 row = rowind(xrow)
130 if ( marker(row) .lt. nodec ) then
131
132c ---------------------------------------
133c ... row is unvisited yet for this pass.
134c take a forward step
135c ---------------------------------------
136
137 tryrow(col) = xrow + 1
138 marker(row) = nodec
139 nxtcol = rowset(row)
140
141 if ( nxtcol .lt. 0 ) then
142 go to 801
143 else
144 $ if ( nxtcol .eq. col ) then
145 go to 802
146 else
147 $ if ( nxtcol .gt. 0 ) then
148
149c -----------------------------------------
150c ... the forward step led to a matched row
151c try to extend augmenting path from
152c the column matched by this row.
153c -----------------------------------------
154
155 prevcl(nxtcol) = col
156 prevrw(nxtcol) = row
157 tryrow(nxtcol) = colstr(nxtcol)
158 col = nxtcol
159 go to 100
160
161 else
162
163c -----------------
164c ... unmatched row
165c -----------------
166
167 go to 400
168
169 endif
170
171 endif
172 300 continue
173 endif
174
175c ---------------------------------------------------
176c ... no forward step -- backtrack.
177c if we backtrack all the way, the search is done
178c ---------------------------------------------------
179c
180 col = prevcl(col)
181 if ( col .gt. 0 ) then
182 go to 100
183 else
184 go to 600
185 endif
186
187c ---------------------------------------------------
188c ... update the matching by alternating the matching
189c edge backward toward the root
190c ---------------------------------------------------
191
192 400 rowset(row) = col
193 prow = prevrw(col)
194 pcol = prevcl(col)
195
196 500 if ( pcol .gt. 0 ) then
197 if ( rowset(prow) .ne. col ) go to 803
198 rowset(prow) = pcol
199 col = pcol
200 prow = prevrw(pcol)
201 pcol = prevcl(pcol)
202 go to 500
203 endif
204
205 600 continue
206
207c ------------------------------------------------------
208c ... compute the matching from the view of column nodes
209c ------------------------------------------------------
210
211 do 700 row = 1, nrows
212 col = rowset(row)
213 if ( col .gt. 0 ) then
214 colset(col) = row
215 endif
216 700 continue
217
218 return
219
220c -------------
221c ... bug traps
222c -------------
223
224 801 write (6, 901)
225 901 format (' bug in maxmatch : search reached a forbidden column')
226 stop
227
228 802 write (6, 902)
229 902 format (' bug in maxmatch : search followed a matching edge')
230 stop
231
232 803 write (6, 903) col, row, row, rowset(row)
233 903 format (' bug in maxmatch : pointer toward root disagrees with ',
234 $ 'matching.' /
235 $ 'prevcl (', i4, ') = ', i4, ' but colset (', i4, ') = ',
236 $ i4)
237 stop
238
239 end
240
subroutine maxmatch(nrows, ncols, colstr, rowind, prevcl, prevrw, marker, tryrow, nxtchp, rowset, colset)
Definition maxmatch.f:4