program linpackc_prb
!
!*******************************************************************************
!
!! LINPACKC_PRB calls each of the LINPACKC test routines.
!
  implicit none
!
  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'LINPACKC_PRB'
  write ( *, '(a)' ) '  Tests for LINPACKC.'
  write ( *, '(a)' ) ' '

  call test01
  call test02
  call test03

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'LINPACKC_PRB'
  write ( *, '(a)' ) '  Normal end of execution.'
 
  stop
end
subroutine test01
!
!*******************************************************************************
!
!! TEST01 tests CGEFA.
!! TEST01 tests CGESL.
!
  implicit none
!
  integer, parameter :: n = 3
!
  complex a(n,n)
  real a1
  real a2
  complex b(n)
  integer i
  integer info
  integer ipvt(n)
  integer j
  integer job
  integer lda
  complex x(n)
!
  lda = n

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  For a complex general storage matrix:'
  write ( *, '(a)' ) '  CGEFA factors the matrix.'
  write ( *, '(a)' ) '  CGESL solves a linear system.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The matrix order is N = ', n
!
!  Set the values of the matrix A.
!
  do i = 1, n
    do j = 1, n
      call random_number ( harvest = a1 )
      call random_number ( harvest = a2 )
      a(i,j) = cmplx ( a1, a2 )
    end do
  end do
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The matrix A is '
  write ( *, '(a)' ) ' '
 
  do i = 1, n
    write ( *, '(10f8.4)' ) a(i,1:n)
  end do
!
!  Set the values of the right hand side vector B.
!
  do i = 1, n
    call random_number ( harvest = a1 )
    call random_number ( harvest = a2 )
    x(i) = cmplx ( a1, a2 )
  end do

  b(1:n) = matmul ( a(1:n,1:n), x(1:n) )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The right hand side B is '
  write ( *, '(a)' ) ' '
  do i = 1, n
    write ( *, '(2f8.4)' ) b(i)
  end do
!
!  Factor the matrix A.
!
  call cgefa ( a, lda, n, ipvt, info )
 
  if ( info /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a,i6)' ) '  CGEFA returned an error flag INFO = ', info
    return
  end if
!
!  Solve the system.
!
  job = 0
  call cgesl ( a, lda, n, ipvt, b, job )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Computed                     Exact'
  write ( *, '(a)' ) '  Solution                     Solution'
  write ( *, '(a)' ) ' '
 
  do i = 1, n
    write ( *, '(4g14.6)' ) b(i), x(i)
  end do
 
  return
end
subroutine test02
!
!*******************************************************************************
!
!! TEST02 tests CGTSL.
!
  implicit none
!
  integer, parameter :: n = 10
!
  complex b(n)
  complex c(n)
  complex d(n)
  complex e(n)
  integer i
  integer info
  real r1(n)
  real r2(n)
  complex x(n)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST02'
  write ( *, '(a)' ) '  For a complex tridiagonal matrix, test:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  CGTSL'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  Matrix order N = ', n
!
!  Set the matrix.
!
  call random_number ( harvest = r1(2:n) )
  call random_number ( harvest = r2(2:n) )
  c(2:n) = cmplx ( r1(2:n), r2(2:n) )

  call random_number ( harvest = r1(1:n-1) )
  call random_number ( harvest = r2(1:n-1) )
  e(1:n-1) = cmplx ( r1(1:n-1), r2(1:n-1) )

  d(1:n) = cmplx ( 0.0E+00, 0.0E+00 )

  d(1:n-1) = d(1:n-1) - 2.0E+00 * e(1:n-1)
  d(2:n)   = d(2:n) - 2.0E+00 * c(2:n)
!
!  Set the desired solution
!
  do i = 1, n
    x(i) = cmplx ( i, 10 * i )
  end do
!
!  Compute the corresponding right hand side.
!
  b(1) = d(1) * x(1) + e(1) * x(2)
  do i = 2, n-1
    b(i) = c(i) * x(i-1) + d(i) * x(i) + e(i) * x(i+1)
  end do
  b(n) = c(n) * x(n-1) + d(n) * x(n)
!
!  Solve the tridiagonal system.
!
  call cgtsl ( n, c, d, e, b, info )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Computed                     Exact'
  write ( *, '(a)' ) '  Solution                     Solution'
  write ( *, '(a)' ) ' '
  do i = 1, n
    write ( *, '(4g14.6)' ) b(i), x(i)
  end do

  return
end
subroutine test03
!
!*******************************************************************************
!
!! TEST03 tests CHIFA.
!! TEST01 tests CHISL.
!
  implicit none
!
  integer, parameter :: n = 3
!
  complex a(n,n)
  real a1
  real a2
  complex b(n)
  integer i
  integer info
  integer ipvt(n)
  integer j
  integer lda
  complex x(n)
!
  lda = n

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST03'
  write ( *, '(a)' ) '  For a complex Hermitian matrix:'
  write ( *, '(a)' ) '  CHIFA factors the matrix.'
  write ( *, '(a)' ) '  CHISL solves a linear system.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The matrix order is N = ', n
!
!  Set the values of the matrix A.
!
  do i = 1, n
    call random_number ( harvest = a1 )
    a2 = 0.0E+00
    a(i,i) = cmplx ( a1, a2 )
    do j = i+1, n
      call random_number ( harvest = a1 )
      call random_number ( harvest = a2 )
      a(i,j) = cmplx ( a1, a2 )
      a(j,i) = conjg ( a(i,j) )
    end do
  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The matrix A is '
  write ( *, '(a)' ) ' '
 
  do i = 1, n
    write ( *, '(10f8.4)' ) a(i,1:n)
  end do
!
!  Set the values of the right hand side vector B.
!
  do i = 1, n
    call random_number ( harvest = a1 )
    call random_number ( harvest = a2 )
    x(i) = cmplx ( a1, a2 )
  end do

  b(1:n) = matmul ( a(1:n,1:n), x(1:n) )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The right hand side B is '
  write ( *, '(a)' ) ' '
  do i = 1, n
    write ( *, '(2f8.4)' ) b(i)
  end do
!
!  Factor the matrix A.
!
  call chifa ( a, lda, n, ipvt, info )
 
  if ( info /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a,i6)' ) '  CHIFA returned an error flag INFO = ', info
    return
  end if
!
!  Solve the system.
!
  call chisl ( a, lda, n, ipvt, b )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Computed                     Exact'
  write ( *, '(a)' ) '  Solution                     Solution'
  write ( *, '(a)' ) ' '
 
  do i = 1, n
    write ( *, '(4g14.6)' ) b(i), x(i)
  end do
 
  return
end