|
EpetraExt
Development
|
|
EpetraExt
Development
|
00001 subroutine maxmatch ( nrows , ncols , colstr, rowind, prevcl, 00002 $ prevrw, marker, tryrow, nxtchp, rowset, 00003 $ colset ) 00004 c 00005 c ================================================================== 00006 c ================================================================== 00007 c ==== maxmatch -- find maximum matching ==== 00008 c ================================================================== 00009 c ================================================================== 00010 00011 c maxmatch uses depth-first search to find an augmenting path from 00012 c each column node to get the maximum matching. 00013 c 00014 c Alex Pothen and Chin-Ju Fan, Penn State University, 1988 00015 c last modifed: Alex Pothen July 1990 00016 c last bcs modifications: John Lewis, Sept. 1990 00017 c 00018 c input variables : 00019 c 00020 c nrows -- number of row nodes in the graph. 00021 c ncols -- number of column nodes in the graph. 00022 c colstr, rowind -- adjacency structure of graph, stored by 00023 c columns 00024 c 00025 c output variables : 00026 c 00027 c rowset -- describe the matching. 00028 c rowset (row) = col > 0 means column "col" is matched 00029 c to row "row" 00030 c = 0 means "row" is an unmatched 00031 c node. 00032 c colset -- describe the matching. 00033 c colset (col) = row > 0 means row "row" is matched to 00034 c column "col" 00035 c = 0 means "col" is an unmatched 00036 c node. 00037 c Working variables : 00038 c 00039 c prevrw (ncols) -- pointer toward the root of the depth-first 00040 c search from a column to a row. 00041 c prevcl (ncols) -- pointer toward the root of the depth-first 00042 c search from a column to a column. 00043 c the pair (prevrw,prevcl) represent a 00044 c matched pair. 00045 c marker (nrows) -- marker (row) <= the index of the root of the 00046 c current depth-first search. row has been 00047 c visited in current pass when equality holds. 00048 c tryrow (ncols) -- tryrow (col) is a pointer into rowind to 00049 c the next row to be explored from column col 00050 c in the depth-first search. 00051 c nxtchp (ncols) -- nxtchp (col) is a pointer into rowind to the 00052 c next row to be explored from column col for 00053 c the cheap assignment. set to -1 when 00054 c all rows have been considered for 00055 c cheap assignment 00056 c 00057 c ================================================================== 00058 00059 c -------------- 00060 c ... parameters 00061 c -------------- 00062 00063 integer nrows, ncols 00064 00065 integer colstr (ncols+1), rowind (*), rowset (nrows), 00066 $ colset (ncols) 00067 00068 integer prevrw (ncols), prevcl (ncols), tryrow (ncols), 00069 $ marker (nrows), nxtchp (ncols) 00070 00071 c ------------------- 00072 c ... local variables 00073 c ------------------- 00074 c 00075 integer nodec, col, nextrw, lastrw, xrow, row, nxtcol, 00076 $ prow, pcol 00077 c 00078 c ================================================================== 00079 00080 do 600 nodec = 1, ncols 00081 00082 c -------------------------------------------------- 00083 c ... initialize node 'col' as the root of the path. 00084 c -------------------------------------------------- 00085 00086 col = nodec 00087 prevrw (col) = 0 00088 prevcl (col) = 0 00089 nxtchp (col) = colstr (col) 00090 00091 c ----------------------------------------------------------- 00092 c ... main loop begins here. Each time through, try to find a 00093 c cheap assignment from node col. 00094 c ----------------------------------------------------------- 00095 00096 100 nextrw = nxtchp (col) 00097 lastrw = colstr (col+1) - 1 00098 00099 if (nextrw .gt. 0 ) then 00100 00101 do 200 xrow = nextrw, lastrw 00102 row = rowind (xrow) 00103 if ( rowset (row) .eq. 0 ) go to 400 00104 200 continue 00105 00106 c ------------------------------------------------ 00107 c ... mark column when all adjacent rows have been 00108 c considered for cheap assignment. 00109 c ------------------------------------------------ 00110 00111 nxtchp (col) = -1 00112 00113 endif 00114 00115 c ------------------------------------------------------------ 00116 c ... Each time through, take a step forward if possible, or 00117 c backtrack if not . Quit when backtracking takes us back 00118 c to the beginning of the search. 00119 c ------------------------------------------------------------ 00120 00121 tryrow (col) = colstr (col) 00122 nextrw = tryrow (col) 00123 c$$$ lastrw = colstr (col+1) - 1 00124 00125 if ( lastrw .ge. nextrw ) then 00126 do 300 xrow = nextrw, lastrw 00127 c next line inserted by Alex Pothen, July 1990 00128 c$$$ ii = xrow 00129 row = rowind (xrow) 00130 if ( marker (row) .lt. nodec ) then 00131 00132 c --------------------------------------- 00133 c ... row is unvisited yet for this pass. 00134 c take a forward step 00135 c --------------------------------------- 00136 00137 tryrow (col) = xrow + 1 00138 marker (row) = nodec 00139 nxtcol = rowset (row) 00140 00141 if ( nxtcol .lt. 0 ) then 00142 go to 801 00143 else 00144 $ if ( nxtcol .eq. col ) then 00145 go to 802 00146 else 00147 $ if ( nxtcol .gt. 0 ) then 00148 00149 c ----------------------------------------- 00150 c ... the forward step led to a matched row 00151 c try to extend augmenting path from 00152 c the column matched by this row. 00153 c ----------------------------------------- 00154 00155 prevcl (nxtcol) = col 00156 prevrw (nxtcol) = row 00157 tryrow (nxtcol) = colstr (nxtcol) 00158 col = nxtcol 00159 go to 100 00160 00161 else 00162 00163 c ----------------- 00164 c ... unmatched row 00165 c ----------------- 00166 00167 go to 400 00168 00169 endif 00170 00171 endif 00172 300 continue 00173 endif 00174 00175 c --------------------------------------------------- 00176 c ... no forward step -- backtrack. 00177 c if we backtrack all the way, the search is done 00178 c --------------------------------------------------- 00179 c 00180 col = prevcl (col) 00181 if ( col .gt. 0 ) then 00182 go to 100 00183 else 00184 go to 600 00185 endif 00186 00187 c --------------------------------------------------- 00188 c ... update the matching by alternating the matching 00189 c edge backward toward the root 00190 c --------------------------------------------------- 00191 00192 400 rowset (row) = col 00193 prow = prevrw (col) 00194 pcol = prevcl (col) 00195 00196 500 if ( pcol .gt. 0 ) then 00197 if ( rowset (prow) .ne. col ) go to 803 00198 rowset (prow) = pcol 00199 col = pcol 00200 prow = prevrw (pcol) 00201 pcol = prevcl (pcol) 00202 go to 500 00203 endif 00204 00205 600 continue 00206 00207 c ------------------------------------------------------ 00208 c ... compute the matching from the view of column nodes 00209 c ------------------------------------------------------ 00210 00211 do 700 row = 1, nrows 00212 col = rowset (row) 00213 if ( col .gt. 0 ) then 00214 colset (col) = row 00215 endif 00216 700 continue 00217 00218 return 00219 00220 c ------------- 00221 c ... bug traps 00222 c ------------- 00223 00224 801 write (6, 901) 00225 901 format (' bug in maxmatch : search reached a forbidden column') 00226 stop 00227 00228 802 write (6, 902) 00229 902 format (' bug in maxmatch : search followed a matching edge') 00230 stop 00231 00232 803 write (6, 903) col, row, row, rowset (row) 00233 903 format (' bug in maxmatch : pointer toward root disagrees with ', 00234 $ 'matching.' / 00235 $ 'prevcl (', i4, ') = ', i4, ' but colset (', i4, ') = ', 00236 $ i4) 00237 stop 00238 00239 end 00240
1.7.6.1
