strchk.f

Go to the documentation of this file.

      subroutine   strchk   ( nrows , ncols , colstr, rowidx, nhrows, 
     $                        nhcols, nsrows, rnto  , cnto  , colset,
     $                        rowset, output )
 
c     ==================================================================
c     ==================================================================
c     ====  strchk -- check that square block has nonzero diagonal  ====
c     ==================================================================
c     ==================================================================
 
c     ... for debugging purposes only 
c         created by john lewis, bcs, sept. 18, 1990
 
c     --------------
c     ... parameters
c     --------------
 
      integer       nrows , ncols , nhrows, nhcols, nsrows, output
 
      integer       colstr (ncols+1), rowidx (*),
     $              rnto (nrows), cnto (ncols), colset (ncols),
     $              rowset(nrows)
 
c     -------------------
c     ... local variables
c     -------------------
 
      integer       i, row, col, xi
 
      logical       match
 
c     ==================================================================
 
      do 300 i = 1, nsrows
 
         row = rnto(nhrows + i)
         col = cnto(nhcols + i)
 
         match = .false.
 
         do 200 xi = colstr(col), colstr(col+1) - 1
            match = match .or. (rowidx(xi) .eq. row)
 200     continue
 
         if  (.not. match  .or. (rowset(row) .ne. col)  .or.
     $                          (colset(col) .ne. row) )  then
            write (output, *) ' failure in matching, row, col, ',
     $                         'rowset(row), colset (col)',
     $                        row, col, rowset(row), colset(col)
         endif
 
 300  continue
 
      return
 
      end