10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-27 06:43:48 +01:00
quantum_package/plugins/CIS/super_ci.irp.f

63 lines
1.6 KiB
Fortran
Raw Normal View History

2014-06-25 14:58:58 +02:00
program cis
implicit none
integer :: i
call super_CI
end
subroutine super_CI
implicit none
double precision :: E, delta_E, delta_D, E_min
integer :: k
character :: save_char
2018-01-05 15:12:27 +01:00
call write_time(6)
write(6,'(A4,X,A16, X, A16, X, A16 )') &
2014-06-25 14:58:58 +02:00
'====','================','================','================'
2018-01-05 15:12:27 +01:00
write(6,'(A4,X,A16, X, A16, X, A16 )') &
2014-06-25 14:58:58 +02:00
' N ', 'Energy ', 'Energy diff ', 'Save '
2018-01-05 15:12:27 +01:00
write(6,'(A4,X,A16, X, A16, X, A16 )') &
2014-06-25 14:58:58 +02:00
'====','================','================','================'
E = HF_energy + 1.d0
delta_D = 0.d0
E_min = HF_energy
FREE psi_det psi_coef
call clear_mo_map
N_det = 1
SOFT_TOUCH N_det
mo_coef = eigenvectors_fock_matrix_mo
TOUCH mo_coef
do k=1,n_it_scf_max
delta_E = HF_energy - E
E = HF_energy
if (E < E_min) then
call save_mos
save_char = 'X'
else
save_char = ' '
endif
2014-07-09 14:52:42 +02:00
E_min = min(E,E_min)
2018-01-05 15:12:27 +01:00
write(6,'(I4,X,F16.10, X, F16.10, X, A8 )') &
2014-06-25 14:58:58 +02:00
k, E, delta_E, save_char
if ( (delta_E < 0.d0).and.(dabs(delta_E) < thresh_scf) ) then
exit
endif
call H_apply_cis
call diagonalize_CI
call set_natural_mos
FREE psi_det psi_coef
call clear_mo_map
N_det = 1
SOFT_TOUCH N_det
mo_coef = eigenvectors_fock_matrix_mo
TOUCH mo_coef
enddo
2018-01-05 15:12:27 +01:00
write(6,'(A4,X,A16, X, A16, X, A16 )') &
2014-06-25 14:58:58 +02:00
'====','================','================','================'
2018-01-05 15:12:27 +01:00
call write_time(6)
2014-06-25 14:58:58 +02:00
end