fcblok Subroutine

subroutine fcblok ( bloks, integs, nbloks, ipivot, scrtch, iflag )

  !*****************************************************************************80
  !
  !! FCBLOK supervises the PLU factorization of an almost block diagonal matrix.
  !
  !  Discussion:
  !
  !    The routine supervises the PLU factorization with pivoting of
  !    the scaled rows of an almost block diagonal matrix.
  !
  !    The almost block diagonal matrix is stored in the arrays
  !    BLOKS and INTEGS.
  !
  !    The FACTRB routine carries out steps 1,..., LAST of Gauss
  !    elimination, with pivoting, for an individual block.
  !
  !    The SHIFTB routine shifts the remaining rows to the top of
  !    the next block.
  !
  !  Modified:
  !
  !    14 February 2007
  !
  !  Author:
  !
  !    Carl DeBoor
  !
  !  Reference:
  !
  !    Carl DeBoor,
  !    A Practical Guide to Splines,
  !    Springer, 2001,
  !    ISBN: 0387953663,
  !    LC: QA1.A647.v27.
  !
  !  Parameters:
  !
  !    Input/output, real ( kind = 8 ) BLOKS(*).  On input, the almost 
  !    block diagonal matrix A to be factored.  On output, the
  !    factorization of A.
  !
  !    Input, integer ( kind = 4 ) INTEGS(3,NBLOKS), describes the block 
  !    structure of A.
  !
  !    Input, integer ( kind = 4 ) NBLOKS, the number of blocks in A.
  !
  !    Output, integer ( kind = 4 ) IPIVOT(*), which will contain pivoting 
  !    information.  The dimension of IPIVOT is the sum ( INTEGS(1,1:NBLOKS) ).
  !
  !    Workspace, real SCRTCH(*), of length maxval ( integs(1,1:NBLOKS) ).
  !
  !    Output, integer ( kind = 4 ) IFLAG, error flag.
  !    = 0,  in case matrix was found to be singular;
  !    = (-1)**(number of row interchanges during factorization), otherwise.
  !
  implicit none

  integer ( kind = 4 ) nbloks

  real ( kind = 8 ) bloks(*)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) iflag
  integer ( kind = 4 ) index
  integer ( kind = 4 ) indexb
  integer ( kind = 4 ) indexn
  integer ( kind = 4 ) integs(3,nbloks)
  integer ( kind = 4 ) ipivot(*)
  integer ( kind = 4 ) last
  integer ( kind = 4 ) ncol
  integer ( kind = 4 ) nrow
  real ( kind = 8 ) scrtch(*)

  iflag = 1
  indexb = 1
  indexn = 1
  i = 1 
  !
  !  Loop over the blocks.  I is the loop index.
  !
  do

     index = indexn
     nrow = integs(1,i)
     ncol = integs(2,i)
     last = integs(3,i)
     !
     !  Carry out elimination on the I-th block until next block
     !  enters, for columns 1 through LAST of I-th block.
     !
     call factrb ( bloks(index), ipivot(indexb), scrtch, nrow, ncol, &
          last, iflag )
     !
     !  Check for having reached a singular block or the last block.
     !
     if ( iflag == 0 .or. i == nbloks ) then
        exit
     end if

     i = i + 1
     indexn = nrow * ncol + index
     !
     !  Put the rest of the I-th block onto the next block.
     !
     call shiftb ( bloks(index), ipivot(indexb), nrow, ncol, last, &
          bloks(indexn), integs(1,i), integs(2,i) )

     indexb = indexb + nrow

  end do

  return
end subroutine fcblok