perform_ftlm Subroutine

    subroutine perform_ftlm()

        integer :: i, j
        ! Data for the testsuite to use.
        real(dp) :: h_sum

        call init_ftlm()

        do i = 1, n_init_vecs_ftlm

            write(stdout, '(1x,a28,1x,i3)') "Starting from initial vector", i
            call neci_flush(stdout)

            ftlm_vecs = 0.0_dp
            ftlm_hamil = 0.0_dp

            call gen_init_vec_ftlm()

            do j = 1, n_lanc_vecs_ftlm - 1
                call subspace_expansion_lanczos(j, ftlm_vecs, full_vec_ftlm, &
                                                ftlm_hamil, ndets_ftlm, disps_ftlm)
                write(stdout, '(1x,a19,1x,i3)') "Iteration complete:", j
                call neci_flush(stdout)
            end do

            call calc_final_hamil_elem(ftlm_vecs, full_vec_ftlm, &
                                       ftlm_hamil, ndets_ftlm, disps_ftlm)

            h_sum = sum(ftlm_hamil)

            call subspace_extraction_ftlm()

            call add_in_contribs_to_energy()

            write(stdout, '(1x,a45,/)') "Calculation complete for this initial vector."
            call neci_flush(stdout)

        end do

        write(stdout, '(1x,a48,/)') "FTLM calculation complete. Outputting results..."
        call neci_flush(stdout)

        call output_ftlm()

        if (iProcIndex == root) call write_ftlm_testsuite_data(h_sum)

        call end_ftlm()

    end subroutine perform_ftlm