! Copyright (C) 2008, 2009  VZLU Prague, a.s., Czech Republic, Jaroslav Hajek <highegg@gmail.com>
! Copyright (C) 2026 Martin Köhler <koehlerm(AT)mpi-magdeburg.mpg.de>
!
! This file is part of qrupdate-ng.
!
! qrupdate is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3 of the License, or
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this software; see the file COPYING.  If not, see
! <http://www.gnu.org/licenses/>.
!
program tchinx
    integer n,j
    external stest, dtest, ctest, ztest, pstats


    write (*,*)
    write (*,*) 'testing Cholesky symmetric insert routines.'
    write (*,*) 'All residual errors are expected to be small.'
    write (*,*)

    n = 50
    j = 25
    write (*,*) 'schinx test:'
    call stest(n,j)
    write (*,*) 'dchinx test:'
    call dtest(n,j)
    write (*,*) 'cchinx test:'
    call ctest(n,j)
    write (*,*) 'zchinx test:'
    call ztest(n,j)

    call pstats
end program

subroutine stest(n,j)
    use iso_fortran_env
    integer n,j
    real(real32) A(n,n),R(n,n),u(n),wrk(n)
    external srandg,schgen,schinx,schchk,schdex
    integer info,i
    ! set up random matrix & vectors
    call srandg(n,n,A,n)
    ! generate A'*A and its Cholesky decomposition
    call schgen(n,A,n,R,n)
    ! save the row/column
    do i = 1,j
        u(i) = A(i,j)
    end do
    do i = j+1,n
        u(i) = A(j,i)
    end do
    ! update the Cholesky decomposition
    call schdex(n,R,n,j,wrk)
    ! put the row/column back
    call schinx(n-1,R,n,j,u,wrk,info)
    ! check result
    call schchk(n,A,n,R,n)

end subroutine

subroutine dtest(n,j)
    use iso_fortran_env
    integer n,j
    real(real64) A(n,n),R(n,n),u(n),wrk(n)
    external drandg,dchgen,dchinx,dchchk,dchdex
    integer info,i
    ! set up random matrix & vectors
    call drandg(n,n,A,n)
    ! generate A'*A and its Cholesky decomposition
    call dchgen(n,A,n,R,n)
    ! save the row/column
    do i = 1,j
        u(i) = A(i,j)
    end do
    do i = j+1,n
        u(i) = A(j,i)
    end do
    ! update the Cholesky decomposition
    call dchdex(n,R,n,j,wrk)
    ! put the row/column back
    call dchinx(n-1,R,n,j,u,wrk,info)
    ! check result
    call dchchk(n,A,n,R,n)

end subroutine

subroutine ctest(n,j)
    use iso_fortran_env
    integer n,j
    complex(real32) A(n,n),R(n,n),u(n)
    real(real32) rwrk(n)
    external crandg,cchgen,cchinx,cchchk,cchdex
    integer info,i
    ! set up random matrix & vectors
    call crandg(n,n,A,n)
    ! generate A'*A and its Cholesky decomposition
    call cchgen(n,A,n,R,n)
    ! save the row/column
    do i = 1,j
        u(i) = A(i,j)
    end do
    do i = j+1,n
        u(i) = conjg(A(j,i))
    end do
    ! update the Cholesky decomposition
    call cchdex(n,R,n,j,rwrk)
    ! put the row/column back
    call cchinx(n-1,R,n,j,u,rwrk,info)
    ! check result
    call cchchk(n,A,n,R,n)

end subroutine

subroutine ztest(n,j)
    use iso_fortran_env
    integer n,j
    complex(real64) A(n,n),R(n,n),u(n)
    real(real64) rwrk(n)
    external zrandg,zchgen,zchinx,zchchk,zchdex
    integer info,i
    ! set up random matrix & vectors
    call zrandg(n,n,A,n)
    ! generate A'*A and its Cholesky decomposition
    call zchgen(n,A,n,R,n)
    ! save the row/column
    do i = 1,j
        u(i) = A(i,j)
    end do
    do i = j+1,n
        u(i) = conjg(A(j,i))
    end do
    ! update the Cholesky decomposition
    call zchdex(n,R,n,j,rwrk)
    ! put the row/column back
    call zchinx(n-1,R,n,j,u,rwrk,info)
    ! check result
    call zchchk(n,A,n,R,n)

    END
