mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-12-22 20:34:05 +01:00
100 lines
2.8 KiB
Fortran
100 lines
2.8 KiB
Fortran
subroutine write_champ_csf
|
|
implicit none
|
|
|
|
integer, parameter :: istate=1
|
|
character*(2048) :: fmt
|
|
integer :: i, n_elements, j, k
|
|
integer, allocatable :: list(:,:)
|
|
|
|
integer :: startdet, enddet, iunit
|
|
integer :: ndetI, bfIcfg, s
|
|
double precision :: phasedet
|
|
integer :: idx
|
|
|
|
open(newunit=iunit, file='det.'//ezfio_filename)
|
|
|
|
write(iunit, '(A, X, I4, X, A, X, I4)') '&electrons nelec', elec_num, 'nup', elec_alpha_num
|
|
|
|
|
|
! Determinants
|
|
write(iunit, '(A, I10)') 'determinants', N_det
|
|
|
|
write(fmt,*) '(', N_det, '(F12.8, X))'
|
|
write(iunit, fmt) psi_coef(1:N_det,istate)
|
|
|
|
write(fmt,*) '( ', elec_alpha_num, '(I4,X), 2X, ', elec_beta_num, '(I4,X))'
|
|
allocate ( list(bit_kind_size,2) )
|
|
do i=1, N_det
|
|
call bitstring_to_list( psi_det(1,1,i), list(1,1), n_elements, N_int)
|
|
call bitstring_to_list( psi_det(1,2,i), list(1,2), n_elements, N_int)
|
|
write(iunit,fmt) list(1:elec_alpha_num,1), list(1:elec_beta_num,2)
|
|
end do
|
|
write(iunit, '(A)') 'end'
|
|
|
|
! CSF
|
|
write(iunit, '(A, I10, X, I3)') 'csf', N_csf, N_states
|
|
|
|
write(fmt,*) '(', N_csf, '(F12.8, X))'
|
|
do i=1,N_states
|
|
write(iunit, fmt) psi_csf_coef(1:N_csf,i)
|
|
end do
|
|
|
|
write(iunit, '(A)') 'end'
|
|
|
|
! CSF map
|
|
phasedet = 1.0d0
|
|
|
|
ndetI = 0
|
|
do i=1,N_configuration
|
|
startdet = psi_configuration_to_psi_det(1,i)
|
|
enddet = psi_configuration_to_psi_det(2,i)
|
|
s = 0
|
|
do k=1,N_int
|
|
if (psi_configuration(k,1,i) == 0_bit_kind) cycle
|
|
s = s + popcnt(psi_configuration(k,1,i))
|
|
enddo
|
|
bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
|
|
do k=1,bfIcfg
|
|
do j = startdet, enddet
|
|
if (DetToCSFTransformationMatrix(s,k,j-startdet+1) == 0.d0) cycle
|
|
ndetI += 1
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
write(iunit, '(A)') 'csfmap'
|
|
write(iunit, '(I10, I10, I10)') n_csf, n_det, ndetI
|
|
|
|
do i=1,N_configuration
|
|
startdet = psi_configuration_to_psi_det(1,i)
|
|
enddet = psi_configuration_to_psi_det(2,i)
|
|
|
|
s = 0
|
|
do k=1,N_int
|
|
if (psi_configuration(k,1,i) == 0_bit_kind) cycle
|
|
s = s + popcnt(psi_configuration(k,1,i))
|
|
enddo
|
|
bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
|
|
|
|
do k=1,bfIcfg
|
|
ndetI = 0
|
|
do j = startdet, enddet
|
|
if (DetToCSFTransformationMatrix(s,k,j-startdet+1) == 0.d0) cycle
|
|
ndetI += 1
|
|
end do
|
|
|
|
write(iunit, '(I4)') ndetI
|
|
do j = startdet, enddet
|
|
if (DetToCSFTransformationMatrix(s,k,j-startdet+1) == 0.d0) cycle
|
|
idx = psi_configuration_to_psi_det_data(j)
|
|
call get_phase_qp_to_cfg(psi_det(1,1,idx), psi_det(1,2,idx), phasedet)
|
|
write(iunit, '(I10, F18.12)') idx, DetToCSFTransformationMatrix(s,k,j-startdet+1)*phasedet
|
|
end do
|
|
end do
|
|
|
|
end do
|
|
|
|
write(iunit, '(A)') 'end'
|
|
|
|
end
|