subroutine DiagWalkerSubspace()
integer :: i, iSubspaceSize, ierr, iSubspaceSizeFull
real(dp) :: CurrentSign(lenof_sign)
integer, allocatable :: ExpandedWalkerDets(:, :)
integer(TagIntType) :: ExpandedWalkTag = 0
real(dp) :: GroundEFull, GroundEInit, CreateNan, ProjGroundEFull, ProjGroundEInit
character(*), parameter :: t_r = 'DiagWalkerSubspace'
if (nProcessors > 1) call stop_all(t_r, "Walker subspace diagonalisation only works in serial")
if (lenof_sign /= 1) call stop_all(t_r, 'Cannot do Lanczos on complex orbitals.')
if (tTruncInitiator) then
!First, diagonalise initiator subspace
write(stdout, '(A)') 'Diagonalising initiator subspace...'
iSubspaceSize = 0
do i = 1, int(TotWalkers)
call extract_sign(CurrentDets(:, i), CurrentSign)
if ((abs(CurrentSign(1)) > InitiatorWalkNo) .or. &
(DetBitEQ(CurrentDets(:, i), iLutHF, nifd))) then
!Is allowed initiator. Add to subspace.
iSubspaceSize = iSubspaceSize + 1
end if
end do
write(stdout, '(A,I12)') "Number of initiators found to diagonalise: ", iSubspaceSize
allocate(ExpandedWalkerDets(NEl, iSubspaceSize), stat=ierr)
call LogMemAlloc('ExpandedWalkerDets', NEl * iSubspaceSize, 4, t_r, ExpandedWalkTag, ierr)
iSubspaceSize = 0
do i = 1, int(TotWalkers)
call extract_sign(CurrentDets(:, i), CurrentSign)
if ((abs(CurrentSign(1)) > InitiatorWalkNo) .or. &
(DetBitEQ(CurrentDets(:, i), iLutHF, nifd))) then
!Is allowed initiator. Add to subspace.
iSubspaceSize = iSubspaceSize + 1
call decode_bit_det(ExpandedWalkerDets(:, iSubspaceSize), CurrentDets(:, i))
end if
end do
if (iSubspaceSize > 0) then
!Routine to diagonalise a set of determinants, and return the ground state energy
call LanczosFindGroundE(ExpandedWalkerDets, iSubspaceSize, GroundEInit, ProjGroundEInit, .true.)
write(stdout, '(A,G25.10)') 'Ground state energy of initiator walker subspace = ', GroundEInit
else
CreateNan = -1.0_dp
write(stdout, '(A,G25.10)') 'Ground state energy of initiator walker subspace = ', sqrt(CreateNan)
end if
deallocate(ExpandedWalkerDets)
call LogMemDealloc(t_r, ExpandedWalkTag)
end if
iSubspaceSizeFull = int(TotWalkers)
!Allocate memory for walker list.
write(stdout, '(A)') "Allocating memory for diagonalisation of full walker subspace"
write(stdout, '(A,I12,A)') "Size = ", iSubspaceSizeFull, " walkers."
allocate(ExpandedWalkerDets(NEl, iSubspaceSizeFull), stat=ierr)
call LogMemAlloc('ExpandedWalkerDets', NEl * iSubspaceSizeFull, 4, t_r, ExpandedWalkTag, ierr)
do i = 1, iSubspaceSizeFull
call decode_bit_det(ExpandedWalkerDets(:, i), CurrentDets(:, i))
end do
!Routine to diagonalise a set of determinants, and return the ground state energy
call LanczosFindGroundE(ExpandedWalkerDets, iSubspaceSizeFull, GroundEFull, ProjGroundEFull, .false.)
write(stdout, '(A,G25.10)') 'Ground state energy of full walker subspace = ', GroundEFull
if (tTruncInitiator) then
write(unitWalkerDiag, '(3I14,4G25.15)') Iter, iSubspaceSize, iSubspaceSizeFull, GroundEInit - Hii, &
GroundEFull - Hii, ProjGroundEInit - Hii, ProjGroundEFull - Hii
else
write(unitWalkerDiag, '(2I14,2G25.15)') Iter, iSubspaceSizeFull, GroundEFull - Hii, ProjGroundEFull - Hii
end if
deallocate(ExpandedWalkerDets)
call LogMemDealloc(t_r, ExpandedWalkTag)
end subroutine DiagWalkerSubspace