1
0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-07-26 04:37:31 +02:00
qp_plugins_scemama/stable/champ/write_champ_csf.irp.f

83 lines
2.3 KiB
FortranFixed
Raw Normal View History

2021-12-03 14:48:52 +01:00
subroutine write_champ_csf
implicit none
2021-12-03 15:20:59 +01:00
integer, parameter :: istate=1
2021-12-03 14:48:52 +01:00
character*(2048) :: format
integer :: i, n_elements, j, k
integer, allocatable :: list(:,:)
2021-12-03 15:20:59 +01:00
integer :: startdet, enddet, iunit
2021-12-03 14:48:52 +01:00
integer :: ndetI, bfIcfg, s
double precision :: phasedet
integer :: idx
2021-12-03 15:20:59 +01:00
open(newunit=iunit, file='det.'//ezfio_filename)
2021-12-03 14:48:52 +01:00
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(format,*) '(', N_det, '(F12.8, X))'
write(iunit, format) psi_coef(1:N_det,istate)
write(format,*) '( ', 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,format) 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(format,*) '(', N_csf, '(F12.8, X))'
do i=1,N_states
write(iunit, format) 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)
ndetI += enddet-startdet+1
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)
ndetI = enddet-startdet+1
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
write(iunit, '(I4)') ndetI
do j = startdet, enddet
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