Force_Cauchy_Schwarz Subroutine

public subroutine Force_Cauchy_Schwarz(matrix)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout) :: matrix(:,:)

Contents

Source Code


Source Code

    subroutine Force_Cauchy_Schwarz(matrix)

        use RotateOrbsData, only: SymLabelListInv_rot
        use SystemData, only: nbasis

        real(dp), intent(inout) :: matrix(:, :)

        integer :: i, j
        real(dp) :: UpperBound

        write(stdout, '("Ensuring that Cauchy--Schwarz inequality holds.")')

        associate(ind => SymLabelListInv_rot)
            do i = 1, nbasis
                do j = 1, nbasis
                    UpperBound = sqrt(matrix(ind(i), ind(i)) * matrix(ind(j), ind(j)))

                    if (abs(matrix(ind(i), ind(j))) > UpperBound) then

                        if (matrix(ind(i), ind(j)) < 0.0_dp) then
                            matrix(ind(i), ind(j)) = -UpperBound
                        else if (matrix(ind(i), ind(j)) > 0.0_dp) then
                            matrix(ind(i), ind(j)) = UpperBound
                        end if

                        write(stdout, '("Changing element:")') i, j
                    else
                        cycle
                    end if
                end do
            end do
        end associate

    end subroutine Force_Cauchy_Schwarz