EpetraExt  Development
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
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 )
4 c
5 c ==================================================================
6 c ==================================================================
7 c ==== maxmatch -- find maximum matching ====
8 c ==================================================================
9 c ==================================================================
10 
11 c maxmatch uses depth-first search to find an augmenting path from
12 c each column node to get the maximum matching.
13 c
14 c Alex Pothen and Chin-Ju Fan, Penn State University, 1988
15 c last modifed: Alex Pothen July 1990
16 c last bcs modifications: John Lewis, Sept. 1990
17 c
18 c input variables :
19 c
20 c nrows -- number of row nodes in the graph.
21 c ncols -- number of column nodes in the graph.
22 c colstr, rowind -- adjacency structure of graph, stored by
23 c columns
24 c
25 c output variables :
26 c
27 c rowset -- describe the matching.
28 c rowset (row) = col > 0 means column "col" is matched
29 c to row "row"
30 c = 0 means "row" is an unmatched
31 c node.
32 c colset -- describe the matching.
33 c colset (col) = row > 0 means row "row" is matched to
34 c column "col"
35 c = 0 means "col" is an unmatched
36 c node.
37 c Working variables :
38 c
39 c prevrw (ncols) -- pointer toward the root of the depth-first
40 c search from a column to a row.
41 c prevcl (ncols) -- pointer toward the root of the depth-first
42 c search from a column to a column.
43 c the pair (prevrw,prevcl) represent a
44 c matched pair.
45 c marker (nrows) -- marker (row) <= the index of the root of the
46 c current depth-first search. row has been
47 c visited in current pass when equality holds.
48 c tryrow (ncols) -- tryrow (col) is a pointer into rowind to
49 c the next row to be explored from column col
50 c in the depth-first search.
51 c nxtchp (ncols) -- nxtchp (col) is a pointer into rowind to the
52 c next row to be explored from column col for
53 c the cheap assignment. set to -1 when
54 c all rows have been considered for
55 c cheap assignment
56 c
57 c ==================================================================
58 
59 c --------------
60 c ... parameters
61 c --------------
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 
71 c -------------------
72 c ... local variables
73 c -------------------
74 c
75  integer nodec, col, nextrw, lastrw, xrow, row, nxtcol,
76  $ prow, pcol
77 c
78 c ==================================================================
79 
80  do 600 nodec = 1, ncols
81 
82 c --------------------------------------------------
83 c ... initialize node 'col' as the root of the path.
84 c --------------------------------------------------
85 
86  col = nodec
87  prevrw(col) = 0
88  prevcl(col) = 0
89  nxtchp(col) = colstr(col)
90 
91 c -----------------------------------------------------------
92 c ... main loop begins here. Each time through, try to find a
93 c cheap assignment from node col.
94 c -----------------------------------------------------------
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 
106 c ------------------------------------------------
107 c ... mark column when all adjacent rows have been
108 c considered for cheap assignment.
109 c ------------------------------------------------
110 
111  nxtchp(col) = -1
112 
113  endif
114 
115 c ------------------------------------------------------------
116 c ... Each time through, take a step forward if possible, or
117 c backtrack if not . Quit when backtracking takes us back
118 c to the beginning of the search.
119 c ------------------------------------------------------------
120 
121  tryrow(col) = colstr(col)
122  nextrw = tryrow(col)
123 c$$$ lastrw = colstr (col+1) - 1
124 
125  if ( lastrw .ge. nextrw ) then
126  do 300 xrow = nextrw, lastrw
127 c next line inserted by Alex Pothen, July 1990
128 c$$$ ii = xrow
129  row = rowind(xrow)
130  if ( marker(row) .lt. nodec ) then
131 
132 c ---------------------------------------
133 c ... row is unvisited yet for this pass.
134 c take a forward step
135 c ---------------------------------------
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 
149 c -----------------------------------------
150 c ... the forward step led to a matched row
151 c try to extend augmenting path from
152 c the column matched by this row.
153 c -----------------------------------------
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 
163 c -----------------
164 c ... unmatched row
165 c -----------------
166 
167  go to 400
168 
169  endif
170 
171  endif
172  300 continue
173  endif
174 
175 c ---------------------------------------------------
176 c ... no forward step -- backtrack.
177 c if we backtrack all the way, the search is done
178 c ---------------------------------------------------
179 c
180  col = prevcl(col)
181  if ( col .gt. 0 ) then
182  go to 100
183  else
184  go to 600
185  endif
186 
187 c ---------------------------------------------------
188 c ... update the matching by alternating the matching
189 c edge backward toward the root
190 c ---------------------------------------------------
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 
207 c ------------------------------------------------------
208 c ... compute the matching from the view of column nodes
209 c ------------------------------------------------------
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 
220 c -------------
221 c ... bug traps
222 c -------------
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 
maxmatch
subroutine maxmatch(nrows, ncols, colstr, rowind, prevcl, prevrw, marker, tryrow, nxtchp, rowset, colset)
Definition: maxmatch.f:1
Generated on Thu Apr 18 2024 09:27:22 for EpetraExt by   doxygen 1.8.5