SUBROUTINE WRITEBASIS(NUNIT, G1, NHG, ARR, BRR)
! Write out the current basis to unit nUnit
integer, intent(in) :: nunit
type(basisfn), intent(in) :: g1(nhg)
integer, intent(in) :: nhg, brr(nhg)
integer :: pos, i
real(dp) ARR(NHG, 2), unscaled_energy, kvecX, kvecY, kvecZ
! nb. Cannot use EncodeBitDet as would be easy, as nifd, niftot etc are not
! filled in yet. --> track pos.
if (.not. associated(fdet)) &
write(nunit, '("HF determinant not yet defined.")')
pos = 1
!=============================================
if (tUEG2) then
DO I = 1, NHG
! kvectors in cartesian coordinates
kvecX = k_lattice_vectors(1, 1) * G1(BRR(I))%K(1) &
+ k_lattice_vectors(2, 1) * G1(BRR(I))%K(2) &
+ k_lattice_vectors(3, 1) * G1(BRR(I))%K(3)
kvecY = k_lattice_vectors(1, 2) * G1(BRR(I))%K(1) &
+ k_lattice_vectors(2, 2) * G1(BRR(I))%K(2) &
+ k_lattice_vectors(3, 2) * G1(BRR(I))%K(3)
kvecZ = k_lattice_vectors(1, 3) * G1(BRR(I))%K(1) &
+ k_lattice_vectors(2, 3) * G1(BRR(I))%K(2) &
+ k_lattice_vectors(3, 3) * G1(BRR(I))%K(3)
unscaled_energy = ((kvecX)**2 + (kvecY)**2 + (kvecZ)**2)
write(NUNIT, '(6I7)', advance='no') I, BRR(I), G1(BRR(I))%K(1), G1(BRR(I))%K(2), G1(BRR(I))%K(3), G1(BRR(I))%MS
CALL WRITESYM(NUNIT, G1(BRR(I))%SYM, .FALSE.)
write(NUNIT, '(I4)', advance='no') G1(BRR(I))%Ml
write(NUNIT, '(3F19.9)', advance='no') ARR(I, 1), ARR(BRR(I), 2), unscaled_energy
if (associated(fdet)) then
pos = 1
do while (pos < nel .and. fdet(pos) < brr(i))
pos = pos + 1
end do
if (brr(i) == fdet(pos)) write(nunit, '(" #")', advance='no')
end if
write(nunit, *)
end do
RETURN
end if !UEG2
!=============================================
DO I = 1, NHG
write(NUNIT, '(6I7)', advance='no') I, BRR(I), G1(BRR(I))%K(1), G1(BRR(I))%K(2), G1(BRR(I))%K(3), G1(BRR(I))%MS
CALL WRITESYM(NUNIT, G1(BRR(I))%SYM, .FALSE.)
write(NUNIT, '(I4)', advance='no') G1(BRR(I))%Ml
write(NUNIT, '(2F19.9)', advance='no') ARR(I, 1), ARR(BRR(I), 2)
if (associated(fdet)) then
pos = 1
do while (pos < nel .and. fdet(pos) < brr(i))
pos = pos + 1
end do
if (brr(i) == fdet(pos)) write(nunit, '(" #")', advance='no')
end if
write(nunit, *)
end do
RETURN
END SUBROUTINE WRITEBASIS