init_ftlm Subroutine

    subroutine init_ftlm()

        use gndts_mod, only: gndts_all_sym_this_proc
        use SystemData, only: nbasis, nel
        use util_mod, only: choose_i64, get_free_unit

        integer :: ndets_this_proc, ndets_tot, expected_ndets_tot
        integer(MPIArg) :: mpi_temp
        integer(n_int), allocatable :: ilut_list(:, :)
        character(len=*), parameter :: t_r = 'init_ftlm'
        integer :: i, ierr

        write(stdout, '(/,1x,a49,/)') "Beginning finite-temperature Lanczos calculation."
        call neci_flush(stdout)

        expected_ndets_tot = int(choose_i64(nbasis, nel))
        write(stdout, *) "Expected number:", expected_ndets_tot
        call neci_flush(stdout)

        ftlm_unit = get_free_unit()
        open(ftlm_unit, file='FTLM_EIGV', status='replace')

        allocate(ndets_ftlm(0:nProcessors - 1))
        allocate(disps_ftlm(0:nProcessors - 1))

        write(stdout, '(1x,a56)', advance='no') "Enumerating and storing all determinants in the space..."
        call neci_flush(stdout)

        ! Generate and count all the determinants on this processor, but don't store them.
        call gndts_all_sym_this_proc(ilut_list, .true., ndets_this_proc)
        allocate(ilut_list(0:NIfTot, ndets_this_proc))
        ! Now generate them again and store them this time.
        call gndts_all_sym_this_proc(ilut_list, .false., ndets_this_proc)

        write(stdout, '(1x,a9)') "Complete."
        call neci_flush(stdout)

        mpi_temp = int(ndets_this_proc, MPIArg)
        call MPIAllGather(mpi_temp, ndets_ftlm, ierr)

        disps_ftlm(0) = 0
        do i = 1, nProcessors - 1
            disps_ftlm(i) = disps_ftlm(i - 1) + ndets_ftlm(i - 1)
        end do

        ndets_tot = int(sum(ndets_ftlm))
        expected_ndets_tot = int(choose_i64(nbasis, nel))
        if (ndets_tot /= expected_ndets_tot) then
            write(stdout, *) "ndets counted:", ndets_tot, "ndets expected:", expected_ndets_tot
            call stop_all('t_r', &
                'The number of determinants generated is not &
                &consistent with the expected number.')
        end if

        write(stdout, '(1x,a44)', advance='no') "Allocating arrays to hold Lanczos vectors..."
        call neci_flush(stdout)
        allocate(ftlm_vecs(ndets_this_proc, n_lanc_vecs_ftlm))
        allocate(full_vec_ftlm(ndets_tot))
        write(stdout, '(1x,a9)') "Complete."
        call neci_flush(stdout)

        allocate(ftlm_hamil(n_lanc_vecs_ftlm, n_lanc_vecs_ftlm))
        allocate(ftlm_trace(nbeta_ftlm + 1))
        allocate(ftlm_e_num(nbeta_ftlm + 1))
        allocate(ftlm_h_eigv(n_lanc_vecs_ftlm))
        ftlm_trace = 0.0_dp
        ftlm_e_num = 0.0_dp
        ftlm_h_eigv = 0.0_dp

        write(stdout, '(1x,a48)') "Allocating and calculating Hamiltonian matrix..."
        call neci_flush(stdout)
        call calculate_sparse_ham_par(ndets_ftlm, ilut_list, .true.)
        write(stdout, '(1x,a48,/)') "Hamiltonian allocation and calculation complete."
        call neci_flush(stdout)

        deallocate(ilut_list)

    end subroutine init_ftlm