EpetraExt Development
rectblk.f
Go to the documentation of this file.
00001       subroutine   rectblk   ( nrows , ncols , marked, unmrkd, colstr,
00002      $                         rowidx, colset, rowset, prevcl, tryrow, 
00003      $                         colmrk, rowmrk, nhrows, nhcols )
00004 
00005 c     ==================================================================
00006 c     ==================================================================
00007 c     ====  rectblk -- find rectangular portion of matrix by        ====
00008 c     ====             depth-first search                           ====
00009 c     ==================================================================
00010 c     ==================================================================
00011 
00012 c     original -- alex pothen and chin-ju fan, penn state, 1988
00013 c     bcs modifications, john lewis, sept. 1990
00014 
00015 c     use a depth-first serch to find all the rows and columns, which
00016 c     can be reached via alternating paths beginning from all the
00017 c     unmatched columns.  comments and names describe use of code
00018 c     for finding the 'horizontal' block.  the same code is used
00019 c     to find the vertical block by performing exactly the same
00020 c     operations on the transpose of the matrix.
00021 c
00022 c     input variables:
00023 c
00024 c         nrows    -- number of rows
00025 c         ncols    -- number of columns
00026 c         marked   -- value to store in marker vectors to indicate
00027 c                     that row/column has been reached and is
00028 c                     therefore in the horizontal block
00029 c         unmrkd   -- initial value of marker vectors, indicating
00030 c                     that row or column is free to be chosen
00031 c         colstr, 
00032 c         rowidx   -- adjacency structure of graph
00033 c         colset   -- maximum matching for columns
00034 c         rowset   -- maximum matching for rows
00035 c
00036 c    output variables:
00037 c
00038 c         nhrows  -- number of rows in horizontal block
00039 c         nhcols  -- number of columns in horizontal block 
00040 c         rowmrk, 
00041 c         colmrk  -- row and column marker vectors.  
00042 c                    = unmrkd --> row/column is in neither the
00043 c                                  horizontal or vertical block yet
00044 c                    = marked --> row/column has been reached via
00045 c                                 search in this routine and lies
00046 c                                 in the horizontal block
00047 c                    = neither --> row/column is not free for use.
00048 c                                  it was found to lie in another
00049 c                                  block.
00050 c                                  
00051 c    working variables:
00052 c
00053 c         tryrow -- tryrow (col) is a pointer into rowidx to the
00054 c                   next row to be explored from col 'col' in
00055 c                   the search.
00056 c         prevcl -- pointer toward the root of the search from 
00057 c                   column to column.
00058 c
00059 c     ==================================================================
00060 
00061 c     --------------
00062 c     ... parameters
00063 c     --------------
00064 
00065       integer        nrows, ncols, marked, unmrkd, nhcols, nhrows
00066 
00067       integer        colstr (nrows+1), rowidx (*), rowset (nrows),
00068      $               colset (ncols)
00069 
00070       integer        prevcl (ncols), tryrow (ncols), colmrk (ncols),
00071      $               rowmrk (nrows)
00072 
00073 c     -------------------
00074 c     ... local variables
00075 c     -------------------
00076 
00077       integer        col, fromc, nextcl, nextrw, p, row, xrow
00078 
00079 c     ==================================================================
00080 
00081       nhcols = 0
00082       nhrows = 0
00083 
00084       do 300 p = 1, ncols
00085 
00086 c        -----------------------------------------------------------
00087 c        ... find an unmatched column to start the alternating path.
00088 c        -----------------------------------------------------------
00089 
00090          if  ( colset (p) .eq. 0 )  then
00091 
00092             fromc = p
00093 
00094 c           ---------------------------------------------
00095 c           ... path starts from unmatched column "fromc"
00096 c               put fromc into horizontal set "hc"
00097 c               indicate fromc is the root of the path.
00098 c           ---------------------------------------------
00099 
00100             nhcols         = nhcols + 1
00101             colmrk (fromc) = marked
00102             tryrow (fromc) = colstr (fromc)
00103             prevcl (fromc) = 0
00104             col            =  fromc
00105 
00106 c           ------------------------------------------------------
00107 c           ... main depth-first search loop begins here.
00108 c               Each time through take a step forward if possible
00109 c               or backtrack if not. quit when we backtrack to the
00110 c               beginning of the search.
00111 c           ------------------------------------------------------
00112 c     
00113 c           ------------------------------------------------
00114 c           ... look for a forward step from column 'col' to
00115 c               an unmarked row.
00116 c           ------------------------------------------------
00117 
00118  100        nextrw = tryrow (col)
00119             do 200 xrow = nextrw, colstr (col + 1) - 1
00120 
00121                if  ( rowmrk (rowidx (xrow)) .eq. unmrkd )  then
00122 
00123 c                 ---------------------------------------------------
00124 c                 ... take a double forward step from 'col' to 'row'
00125 c                     and then via matching edge from 'row' to column
00126 c                     'nextcl'.  ('row' must be matched since 
00127 c                     otherwise we have found an augmenting path
00128 c                     and the maximum matching wasn't matching.)
00129 c                 ---------------------------------------------------
00130 
00131                   tryrow (col) = xrow + 1
00132                   row          = rowidx (xrow)
00133                   rowmrk (row) = marked
00134                   nhrows       = nhrows + 1
00135 
00136                   nextcl       = rowset (row)
00137                   if  ( nextcl .eq. 0 )  then
00138                      write (6, 60000)
00139 60000                format (' max matching is wrong -- augmenting ',
00140      $                         'path found')
00141                      stop
00142                   endif
00143       
00144                   nhcols          = nhcols + 1
00145                   colmrk (nextcl) = marked
00146                   prevcl (nextcl) = col
00147                   tryrow (nextcl) = colstr (nextcl)
00148                   col             = nextcl
00149                   go to 100
00150                endif
00151       
00152  200        continue
00153 
00154 c           ------------------------------------------------
00155 c           ... no forward step: backtrack.  if we backtrack
00156 c               all the way, we have completed all searchs
00157 c               beginning at column 'p'.
00158 c           ------------------------------------------------
00159 
00160             col = prevcl (col)
00161             if  ( col .ne. 0 )  then
00162                go to 100
00163             endif
00164 
00165          endif
00166 
00167   300 continue
00168 
00169       return
00170 
00171       end
00172 
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines