subroutine write_champ_csf implicit none integer, parameter :: istate=1 character*(2048) :: format 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(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