dtblok Subroutine

subroutine dtblok ( bloks, integs, nbloks, ipivot, iflag, detsgn, detlog )

  !*****************************************************************************80
  !
  !! DTBLOK gets the determinant of an almost block diagonal matrix.
  !
  !  Discussion:
  !
  !    The matrix's PLU factorization must have been obtained 
  !    previously by FCBLOK.
  !
  !    The logarithm of the determinant is computed instead of the
  !    determinant itself to avoid the danger of overflow or underflow
  !    inherent in this calculation.
  !
  !  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, real ( kind = 8 ) BLOKS(*), the factorization of A computed
  !    by FCBLOK.
  !
  !    Input, integer ( kind = 4 ) INTEGS(3,NBLOKS), describes the block 
  !    structure of A.
  !
  !    Input, integer ( kind = 4 ) NBLOKS, the number of blocks in A.
  !
  !    Input, integer ( kind = 4 ) IPIVOT(*), pivoting information.
  !    The dimension of IPIVOT is the sum ( INTEGS(1,1:NBLOKS) ).
  !
  !    Input, integer ( kind = 4 ) IFLAG, = (-1)**(number of interchanges during
  !    factorization) if successful, otherwise IFLAG = 0.
  !
  !    Output, real ( kind = 8 ) DETSGN, the sign of the determinant.
  !
  !    Output, real ( kind = 8 ) DETLOG, the natural logarithm of the 
  !    determinant, if the determinant is not zero.  If the determinant
  !    is 0, then DETLOG is returned as 0.
  !
  implicit none

  integer ( kind = 4 ) nbloks

  real ( kind = 8 ) bloks(*)
  real ( kind = 8 ) detlog
  real ( kind = 8 ) detsgn
  integer ( kind = 4 ) i
  integer ( kind = 4 ) iflag
  integer ( kind = 4 ) index
  integer ( kind = 4 ) indexp
  integer ( kind = 4 ) integs(3,nbloks)
  integer ( kind = 4 ) ip
  integer ( kind = 4 ) ipivot(1)
  integer ( kind = 4 ) k
  integer ( kind = 4 ) last
  integer ( kind = 4 ) nrow

  detsgn = iflag
  detlog = 0.0D+00

  if ( iflag == 0 ) then
     return
  end if

  index = 0
  indexp = 0

  do i = 1, nbloks

     nrow = integs(1,i)
     last = integs(3,i)

     do k = 1, last
        ip = index + nrow * ( k - 1 ) + ipivot(indexp+k)
        detlog = detlog + log ( abs ( bloks(ip) ) )
        detsgn = detsgn * sign ( 1.0D+00, bloks(ip) )
     end do

     index = nrow * integs(2,i) + index
     indexp = indexp + nrow

  end do

  return
end subroutine dtblok