EpetraExt Development
maxmatch.f
Go to the documentation of this file.
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 
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines