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