EpetraExt Development
concmp.f
Go to the documentation of this file.
00001       subroutine   concmp   ( cmbase, rnbase, cnbase, vindex, nrows ,
00002      $                        ncols , nvrows, nvcols, rowstr, colidx,
00003      $                        colstr, rowidx, predrw, nextrw, predcl,    ,
00004      $                        nextcl, ctab  , rtab  , colmrk, rowmrk,
00005      $                        cmclad, cmrwad, cnto  , rnto  , numcmp ) 
00006 
00007 c     ==================================================================
00008 c     ==================================================================
00009 c     ====  concmp -- find the connected components in the          ====
00010 c     ====            vertical (horizontal) block                   ====
00011 c     ==================================================================
00012 c     ==================================================================
00013 
00014 c     original -- alex pothen and chin-ju fan, penn state, 1988
00015 c     bcs modifications, john lewis, sept. 19, 1990
00016 
00017 c     concmp:  find the connected components in the subgraph spanned
00018 c              by the rows and columns in the vertical block.  the
00019 c              same subroutine is used to find the connected
00020 c              components in the horizontal block -- the transpose
00021 c              of the matrix is used for that case.
00022 c
00023 c     input variables:
00024 c
00025 c         cmbase -- the number of components found in previous fine
00026 c                   analysis of the coarse partition
00027 c         rnbase -- the number of rows in earlier numbered partitions
00028 c                   (0 for the horizontal block, nhrows+nsrows for
00029 c                    the vertical partition)
00030 c         cnbase -- the number of columns in earlier numbered partitions
00031 c         vindex -- used to check whether the nodes belong in the
00032 c                   vertical block
00033 c         nrows  -- number of rows in the matrix 
00034 c         ncols  -- number of columns in the matrix 
00035 c         nvrows -- number of rows in the vertical block
00036 c         nvcols -- number of columns in the vertical block
00037 c         rowstr, colidx
00038 c               -- the adjacency structure of the matrix using
00039 c                  row-wise storage
00040 c         colstr, rowidx
00041 c               -- the adjacency structure of the matrix using
00042 c                  column-wise storage
00043 c
00044 c     output variables:
00045 c
00046 c        numcmp  -- number of connected components
00047 c        colmrk  -- initially,                        
00048 c                    colmrk(i) = vindex if i belongs to vc.
00049 c                              < 0 otherwise.
00050 c                    during execution, 
00051 c                    colmrk(i) = j, if i belongs to the jth component.
00052 c                    after execution, original values restored
00053 c        rowmrk -- initially,                        
00054 c                    rowmrk(i) = vindex if i belongs to vr.
00055 c                              < 0  otherwise.
00056 c                    during execution, 
00057 c                    rowmrk(i) = j, if i belongs to the jth component.
00058 c                              < 0 otherwise.
00059 c                    after execution, original values restored
00060 c        cmclad, cmrwad 
00061 c               -- the address (in the new ordering) of the 
00062 c                  first column/row in each component,
00063 c        cnto   -- the new to old mapping for the columns
00064 c        rnto   -- the new to old mapping for the rows
00065 c
00066 c     working variables:
00067 c
00068 c        predrw, predcl
00069 c               -- the path stack --
00070 c                     predrw(i) = j means that we have in the path an
00071 c                                   edge leaving from row node j to
00072 c                                   column node i.
00073 c                     predcl(i) = j means that we have in the path an 
00074 c                                   edge leaving from column node j to
00075 c                                   row node i.
00076 c        nextcl -- nextcl(i) is index of first unsearched edge leaving
00077 c                      from column node i.
00078 c        nextrw -- nextrw(i) is index of first unsearched edge leaving
00079 c                      from row node i.
00080 c
00081 c        ctab, rtab
00082 c               -- temporary copy of the address (in the new ordering)
00083 c                  of the first column/row in each component
00084 c
00085 c     ==================================================================
00086 
00087 c     --------------
00088 c     ... parameters
00089 c     --------------
00090 
00091       integer         cmbase, rnbase, cnbase, vindex, nrows , ncols ,
00092      $                nvrows, nvcols, numcmp
00093 
00094       integer         colstr (nrows+1), rowstr (ncols+1), rowidx (*),
00095      $                colidx (*)
00096 
00097       integer         predrw (ncols), nextrw (nrows),
00098      $                predcl (nrows), nextcl (ncols),
00099      $                cmclad (ncols), cmrwad (nrows),
00100      $                colmrk (ncols), rowmrk (nrows),
00101      $                ctab   (*)    , rtab (*),
00102      $                cnto  (ncols) , rnto (nrows)
00103 
00104 c     -------------------
00105 c     ... local variables
00106 c     -------------------
00107 
00108       integer         col, compn, p, cn, rn, row, xcol, xrow
00109 
00110 c     ==================================================================
00111 
00112 c     initialization
00113 c     cn -- the number of the scanned column node
00114 c     rn -- the number of the scanned row node
00115 
00116       cn     = 0
00117       rn     = 0
00118       numcmp = 0
00119 
00120 c     ----------------------------------------------------------------
00121 c     ... number of vertical rows > number of vertical columns.
00122 c         start each search for a connected component with an unmarked
00123 c         row in the vertical block.
00124 c     ----------------------------------------------------------------
00125 
00126 
00127       do 500 p = 1, nrows
00128 
00129          if  ( rowmrk (p) .eq. vindex )  then
00130 
00131             row = p
00132 
00133 c           --------------------------------------------------------
00134 c           ... update the value of the current working component
00135 c               put 'row' into the new component as the root of path
00136 c           --------------------------------------------------------
00137 
00138             numcmp                   = numcmp + 1
00139             ctab (numcmp)            = cnbase + 1 + cn
00140             rtab (numcmp)            = rnbase + 1 + rn
00141             cmclad (cmbase + numcmp) = ctab (numcmp)
00142             cmrwad (cmbase + numcmp) = rtab (numcmp)
00143             rowmrk (row)             = numcmp
00144             rn                       = rn + 1
00145             nextrw (row)             = rowstr (row)
00146             predcl (row)             = 0
00147 
00148 c           ------------------------------------------
00149 c           ... from row node to col node --
00150 c               try to find a forward step if possible
00151 c               else backtrack
00152 c           ------------------------------------------
00153 
00154  100        do 200 xcol = nextrw (row), rowstr (row + 1) -1
00155                col  = colidx (xcol)
00156 
00157                if  ( colmrk (col) .eq. vindex )  then
00158 
00159 c                 ------------------------------------------------
00160 c                 ... forward one step :
00161 c                     find a forward step from row 'row' to column 
00162 c                     'col'.  put 'col' into the current component
00163 c                 ------------------------------------------------
00164 
00165                   nextrw (row) = xcol + 1
00166                   colmrk (col) = numcmp
00167                   cn           = cn + 1
00168                   nextcl (col) = colstr (col)
00169                   predrw (col) = row
00170                   go to 300
00171 
00172                endif
00173  200        continue
00174             
00175 c           -----------------------------------------
00176 c           ... backward one step  (back to col node)
00177 c           -----------------------------------------
00178 
00179             nextrw (row) = rowstr (row + 1)
00180             col          = predcl (row)
00181             if  ( col .eq. 0 )  go to 500
00182                         
00183 c           ------------------------------------------
00184 c           ... from col node to row node
00185 c               try to find a forward step if possible
00186 c               else backtrack
00187 c           ------------------------------------------
00188 
00189  300        do 400 xrow = nextcl (col), colstr (col + 1) - 1
00190                row = rowidx (xrow)
00191                if  ( rowmrk (row) .eq. vindex )  then
00192 
00193 c                 --------------------------------------------------
00194 c                 ... forward one step :
00195 c                     find a forward step from column 'col' to
00196 c                     row 'row'.  put row into the current component
00197 c                 --------------------------------------------------
00198 
00199                   nextcl (col) = xrow + 1
00200                   rowmrk (row) = numcmp
00201                   rn           = rn + 1
00202                   nextrw (row) = rowstr (row)
00203                   predcl (row) = col
00204                   go to 100
00205                endif
00206  400        continue
00207 
00208 c           -----------------------------------------
00209 c           ... backward one step  (back to row node)
00210 c           -----------------------------------------
00211 
00212             nextcl (col) = colstr (col + 1)
00213             row          = predrw (col)
00214             go to 100
00215             
00216          endif
00217 
00218   500 continue
00219 
00220 c     ------------------------------------------------------------
00221 c     ... generate the column and row permutations (cnto and rnto)
00222 c         so that each component is numbered consecutively
00223 c     ------------------------------------------------------------
00224 
00225       cmclad (cmbase + 1 + numcmp)  = cnbase + 1 + nvcols
00226       cmrwad (cmbase + 1 + numcmp)  = rnbase + 1 + nvrows
00227 
00228       do 600 col = 1, ncols
00229    compn = colmrk (col)
00230    if  ( compn .gt. 0 )  then
00231             cnto (ctab (compn)) = col
00232             ctab (compn)        = ctab (compn) + 1
00233             colmrk (col)        = vindex
00234          endif
00235   600 continue
00236 
00237       do 700 row = 1, nrows
00238    compn = rowmrk (row)
00239    if  ( compn .gt. 0 ) then
00240             rnto (rtab (compn)) = row
00241             rtab (compn)        = rtab (compn) + 1
00242             rowmrk (row)        = vindex
00243          endif
00244   700 continue
00245 
00246       return
00247       end
00248 
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines