2019-01-25 11:39:31 +01:00
|
|
|
program cisd
|
|
|
|
implicit none
|
|
|
|
BEGIN_DOC
|
|
|
|
! Configuration Interaction with Single and Double excitations.
|
|
|
|
!
|
|
|
|
! This program takes a reference Slater determinant of ROHF-like occupancy,
|
|
|
|
!
|
|
|
|
! and performs all single and double excitations on top of it, disregarding
|
|
|
|
! spatial symmetry and compute the "n_states" lowest eigenstates of that CI
|
|
|
|
! matrix (see :option:`determinants n_states`).
|
|
|
|
!
|
|
|
|
! This program can be useful in many cases:
|
|
|
|
!
|
2019-01-29 23:10:00 +01:00
|
|
|
! * **Ground state calculation**: if even after a :c:func:`cis` calculation, natural
|
2019-01-25 11:39:31 +01:00
|
|
|
! orbitals (see :c:func:`save_natorb`) and then :c:func:`scf` optimization, you are not sure to have the lowest scf
|
|
|
|
! solution,
|
2020-03-31 18:40:20 +02:00
|
|
|
! do the same strategy with the :c:func:`cisd` executable instead of the :c:func:`cis` exectuable to generate the natural
|
2019-01-25 11:39:31 +01:00
|
|
|
! orbitals as a guess for the :c:func:`scf`.
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!
|
2019-01-29 23:10:00 +01:00
|
|
|
! * **Excited states calculations**: the lowest excited states are much likely to
|
2019-01-25 11:39:31 +01:00
|
|
|
! be dominanted by single- or double-excitations.
|
|
|
|
! Therefore, running a :c:func:`cisd` will save the "n_states" lowest states within
|
|
|
|
! the CISD space
|
2019-01-29 23:10:00 +01:00
|
|
|
! in the |EZFIO| directory, which can afterward be used as guess wave functions
|
2019-01-25 11:39:31 +01:00
|
|
|
! for a further multi-state fci calculation if you specify "read_wf" = True
|
|
|
|
! before running the fci executable (see :option:`determinants read_wf`).
|
|
|
|
! Also, if you specify "s2_eig" = True, the cisd will only retain states
|
|
|
|
! having the good value :math:`S^2` value
|
|
|
|
! (see :option:`determinants expected_s2` and :option:`determinants s2_eig`).
|
|
|
|
! If "s2_eig" = False, it will take the lowest n_states, whatever
|
|
|
|
! multiplicity they are.
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! Note: if you would like to discard some orbitals, use
|
|
|
|
! :ref:`qp_set_mo_class` to specify:
|
|
|
|
!
|
|
|
|
! * "core" orbitals which will be always doubly occupied
|
|
|
|
!
|
|
|
|
! * "act" orbitals where an electron can be either excited from or to
|
|
|
|
!
|
|
|
|
! * "del" orbitals which will be never occupied
|
2019-01-27 21:58:36 +01:00
|
|
|
!
|
2019-01-25 11:39:31 +01:00
|
|
|
END_DOC
|
2019-10-24 13:55:38 +02:00
|
|
|
PROVIDE N_states
|
2019-01-25 11:39:31 +01:00
|
|
|
read_wf = .False.
|
|
|
|
SOFT_TOUCH read_wf
|
2022-06-14 18:10:32 +02:00
|
|
|
|
|
|
|
integer :: i,k
|
|
|
|
|
|
|
|
if(pseudo_sym)then
|
|
|
|
call H_apply_cisd_sym
|
|
|
|
else
|
|
|
|
call H_apply_cisd
|
|
|
|
endif
|
|
|
|
double precision :: r1, r2
|
|
|
|
double precision, allocatable :: U_csf(:,:)
|
|
|
|
|
|
|
|
allocate(U_csf(N_csf,N_states))
|
|
|
|
U_csf = 0.d0
|
|
|
|
U_csf(1,1) = 1.d0
|
|
|
|
do k=2,N_states
|
|
|
|
do i=1,N_csf
|
|
|
|
call random_number(r1)
|
|
|
|
call random_number(r2)
|
|
|
|
r1 = dsqrt(-2.d0*dlog(r1))
|
|
|
|
r2 = dacos(-1.d0)*2.d0*r2
|
|
|
|
U_csf(i,k) = r1*dcos(r2)
|
|
|
|
enddo
|
|
|
|
U_csf(k,k) = U_csf(k,k) +100.d0
|
|
|
|
enddo
|
|
|
|
do k=1,N_states
|
|
|
|
call normalize(U_csf(1,k),N_csf)
|
|
|
|
enddo
|
|
|
|
call convertWFfromCSFtoDET(N_states,U_csf(1,1),psi_coef(1,1))
|
|
|
|
deallocate(U_csf)
|
|
|
|
SOFT_TOUCH psi_coef
|
|
|
|
|
2019-10-24 13:55:38 +02:00
|
|
|
call run
|
|
|
|
end
|
|
|
|
|
|
|
|
subroutine run
|
|
|
|
implicit none
|
|
|
|
integer :: i,k
|
|
|
|
double precision :: cisdq(N_states), delta_e
|
|
|
|
double precision,external :: diag_h_mat_elem
|
|
|
|
|
|
|
|
psi_coef = ci_eigenvectors
|
2021-11-26 12:50:26 +01:00
|
|
|
call save_wavefunction_truncated(save_threshold)
|
2019-10-24 13:55:38 +02:00
|
|
|
call ezfio_set_cisd_energy(CI_energy)
|
|
|
|
|
|
|
|
do i = 1,N_states
|
|
|
|
k = maxloc(dabs(psi_coef_sorted(1:N_det,i)),dim=1)
|
|
|
|
delta_E = CI_electronic_energy(i) - diag_h_mat_elem(psi_det_sorted(1,1,k),N_int)
|
2022-05-19 11:12:39 +02:00
|
|
|
if (elec_alpha_num + elec_beta_num >= 4) then
|
|
|
|
cisdq(i) = CI_energy(i) + delta_E * (1.d0 - psi_coef_sorted(k,i)**2)
|
|
|
|
endif
|
2019-10-24 13:55:38 +02:00
|
|
|
enddo
|
|
|
|
print *, 'N_det = ', N_det
|
|
|
|
print*,''
|
|
|
|
print*,'******************************'
|
|
|
|
print *, 'CISD Energies'
|
|
|
|
do i = 1,N_states
|
|
|
|
print *, i, CI_energy(i)
|
|
|
|
enddo
|
2022-05-19 11:12:39 +02:00
|
|
|
if (elec_alpha_num + elec_beta_num >= 4) then
|
2019-10-24 13:55:38 +02:00
|
|
|
print*,''
|
|
|
|
print*,'******************************'
|
2022-05-19 11:12:39 +02:00
|
|
|
print *, 'CISD+Q Energies'
|
|
|
|
do i = 1,N_states
|
|
|
|
print *, i, cisdq(i)
|
2019-10-24 13:55:38 +02:00
|
|
|
enddo
|
|
|
|
endif
|
2022-05-19 11:12:39 +02:00
|
|
|
if (N_states > 1) then
|
|
|
|
if (elec_alpha_num + elec_beta_num >= 4) then
|
|
|
|
print*,''
|
|
|
|
print*,'******************************'
|
|
|
|
print*,'Excitation energies (au) (CISD+Q)'
|
|
|
|
do i = 2, N_states
|
|
|
|
print*, i ,CI_energy(i) - CI_energy(1), cisdq(i) - cisdq(1)
|
|
|
|
enddo
|
|
|
|
print*,''
|
|
|
|
print*,'******************************'
|
|
|
|
print*,'Excitation energies (eV) (CISD+Q)'
|
|
|
|
do i = 2, N_states
|
|
|
|
print*, i ,(CI_energy(i) - CI_energy(1)) * ha_to_ev, &
|
|
|
|
(cisdq(i) - cisdq(1)) * ha_to_ev
|
|
|
|
enddo
|
|
|
|
else
|
|
|
|
print*,''
|
|
|
|
print*,'******************************'
|
|
|
|
print*,'Excitation energies (au) (CISD)'
|
|
|
|
do i = 2, N_states
|
|
|
|
print*, i ,CI_energy(i) - CI_energy(1)
|
|
|
|
enddo
|
|
|
|
print*,''
|
|
|
|
print*,'******************************'
|
|
|
|
print*,'Excitation energies (eV) (CISD)'
|
|
|
|
do i = 2, N_states
|
|
|
|
print*, i ,(CI_energy(i) - CI_energy(1)) * ha_to_ev
|
|
|
|
enddo
|
|
|
|
endif
|
|
|
|
endif
|
2019-10-24 13:55:38 +02:00
|
|
|
|
2019-01-25 11:39:31 +01:00
|
|
|
end
|