mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-03 20:53:54 +01:00
v0 of DIIS & level shift
This commit is contained in:
AbdAmmar
parent
f6f1ca5fa4
commit
f2c3c72978
@ -37,6 +37,52 @@ end subroutine ao_to_mo_bi_ortho
|
|||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
subroutine mo_to_ao_bi_ortho(A_mo, LDA_mo, A_ao, LDA_ao)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! mo_l_coef.T x A_ao x mo_r_coef = A_mo
|
||||||
|
! mo_l_coef.T x ao_overlap x mo_r_coef = I
|
||||||
|
!
|
||||||
|
! ==> A_ao = (ao_overlap x mo_r_coef) x A_mo x (ao_overlap x mo_l_coef).T
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: LDA_ao, LDA_mo
|
||||||
|
double precision, intent(in) :: A_mo(LDA_mo,mo_num)
|
||||||
|
double precision, intent(out) :: A_ao(LDA_ao,ao_num)
|
||||||
|
double precision, allocatable :: tmp_1(:,:), tmp_2(:,:)
|
||||||
|
|
||||||
|
! ao_overlap x mo_r_coef
|
||||||
|
allocate( tmp_1(ao_num,mo_num) )
|
||||||
|
call dgemm( 'N', 'N', ao_num, mo_num, ao_num, 1.d0 &
|
||||||
|
, ao_overlap, size(ao_overlap, 1), mo_r_coef, size(mo_r_coef, 1) &
|
||||||
|
, 0.d0, tmp_1, size(tmp_1, 1) )
|
||||||
|
|
||||||
|
! (ao_overlap x mo_r_coef) x A_mo
|
||||||
|
allocate( tmp_1(ao_num,mo_num) )
|
||||||
|
call dgemm( 'N', 'N', ao_num, mo_num, mo_num, 1.d0 &
|
||||||
|
, tmp_1, size(tmp_1, 1), A_mo, LDA_mo &
|
||||||
|
, 0.d0, tmp_2, size(tmp_2, 1) )
|
||||||
|
|
||||||
|
! ao_overlap x mo_l_coef
|
||||||
|
tmp_1 = 0.d0
|
||||||
|
call dgemm( 'N', 'N', ao_num, mo_num, ao_num, 1.d0 &
|
||||||
|
, ao_overlap, size(ao_overlap, 1), mo_l_coef, size(mo_l_coef, 1) &
|
||||||
|
, 0.d0, tmp_1, size(tmp_1, 1) )
|
||||||
|
|
||||||
|
! (ao_overlap x mo_r_coef) x A_mo x (ao_overlap x mo_l_coef).T
|
||||||
|
call dgemm( 'N', 'T', ao_num, mo_num, mo_num, 1.d0 &
|
||||||
|
, tmp_2, size(tmp_2, 1), tmp_1, size(tmp_1, 1) &
|
||||||
|
, 0.d0, A_ao, LDA_ao )
|
||||||
|
|
||||||
|
deallocate(tmp_1, tmp_2)
|
||||||
|
|
||||||
|
end subroutine mo_to_ao_bi_ortho
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, mo_r_coef, (ao_num, mo_num) ]
|
BEGIN_PROVIDER [ double precision, mo_r_coef, (ao_num, mo_num) ]
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -175,3 +221,4 @@ END_PROVIDER
|
|||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -136,3 +136,27 @@ doc: nb of Gaussians used to fit Jastrow fcts
|
|||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: 6
|
default: 6
|
||||||
|
|
||||||
|
[max_dim_diis_tcscf]
|
||||||
|
type: integer
|
||||||
|
doc: Maximum size of the DIIS extrapolation procedure
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 15
|
||||||
|
|
||||||
|
[threshold_diis_tcscf]
|
||||||
|
type: Threshold
|
||||||
|
doc: Threshold on the convergence of the DIIS error vector during a TCSCF calculation. If 0. is chosen, the square root of thresh_tcscf will be used.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.
|
||||||
|
|
||||||
|
[level_shift_tcscf]
|
||||||
|
type: Positive_float
|
||||||
|
doc: Energy shift on the virtual MOs to improve TCSCF convergence
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.
|
||||||
|
|
||||||
|
[tcscf_algorithm]
|
||||||
|
type: character*(32)
|
||||||
|
doc: Type of TCSCF algorithm used. Possible choices are [Simple | DIIS]
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: DIIS
|
||||||
|
|
||||||
|
|||||||
@ -1,3 +1,5 @@
|
|||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, fock_tc_reigvec_mo, (mo_num, mo_num)]
|
BEGIN_PROVIDER [ double precision, fock_tc_reigvec_mo, (mo_num, mo_num)]
|
||||||
&BEGIN_PROVIDER [ double precision, fock_tc_leigvec_mo, (mo_num, mo_num)]
|
&BEGIN_PROVIDER [ double precision, fock_tc_leigvec_mo, (mo_num, mo_num)]
|
||||||
&BEGIN_PROVIDER [ double precision, eigval_fock_tc_mo, (mo_num)]
|
&BEGIN_PROVIDER [ double precision, eigval_fock_tc_mo, (mo_num)]
|
||||||
@ -9,32 +11,50 @@
|
|||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: n_real_tc
|
integer :: n_real_tc
|
||||||
integer :: i, k, l
|
integer :: i, j, k, l
|
||||||
double precision :: accu_d, accu_nd, accu_tmp
|
double precision :: accu_d, accu_nd, accu_tmp
|
||||||
double precision :: thr_d, thr_nd
|
double precision :: thr_d, thr_nd
|
||||||
double precision :: norm
|
double precision :: norm
|
||||||
double precision, allocatable :: eigval_right_tmp(:)
|
double precision, allocatable :: eigval_right_tmp(:)
|
||||||
|
double precision, allocatable :: F_tmp(:,:)
|
||||||
|
|
||||||
thr_d = 1d-6
|
thr_d = 1d-6
|
||||||
thr_nd = 1d-6
|
thr_nd = 1d-6
|
||||||
|
|
||||||
allocate( eigval_right_tmp(mo_num) )
|
allocate( eigval_right_tmp(mo_num), F_tmp(mo_num,mo_num) )
|
||||||
|
|
||||||
PROVIDE Fock_matrix_tc_mo_tot
|
PROVIDE Fock_matrix_tc_mo_tot
|
||||||
|
|
||||||
call non_hrmt_bieig( mo_num, Fock_matrix_tc_mo_tot, thr_d, thr_nd &
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
F_tmp(j,i) = Fock_matrix_tc_mo_tot(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! insert level shift here
|
||||||
|
do i = elec_beta_num+1, elec_alpha_num
|
||||||
|
F_tmp(i,i) += 0.5d0 * level_shift_tcscf
|
||||||
|
enddo
|
||||||
|
do i = elec_alpha_num+1, mo_num
|
||||||
|
F_tmp(i,i) += level_shift_tcscf
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call non_hrmt_bieig( mo_num, F_tmp, thr_d, thr_nd &
|
||||||
, fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
, fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
||||||
, n_real_tc, eigval_right_tmp )
|
, n_real_tc, eigval_right_tmp )
|
||||||
|
|
||||||
!if(max_ov_tc_scf)then
|
!if(max_ov_tc_scf)then
|
||||||
! call non_hrmt_fock_mat( mo_num, Fock_matrix_tc_mo_tot, thr_d, thr_nd &
|
! call non_hrmt_fock_mat( mo_num, F_tmp, thr_d, thr_nd &
|
||||||
! , fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
! , fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
||||||
! , n_real_tc, eigval_right_tmp )
|
! , n_real_tc, eigval_right_tmp )
|
||||||
!else
|
!else
|
||||||
! call non_hrmt_diag_split_degen_bi_orthog( mo_num, Fock_matrix_tc_mo_tot &
|
! call non_hrmt_diag_split_degen_bi_orthog( mo_num, F_tmp &
|
||||||
! , fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
! , fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
||||||
! , n_real_tc, eigval_right_tmp )
|
! , n_real_tc, eigval_right_tmp )
|
||||||
!endif
|
!endif
|
||||||
|
|
||||||
|
deallocate(F_tmp)
|
||||||
|
|
||||||
|
|
||||||
! if(n_real_tc .ne. mo_num)then
|
! if(n_real_tc .ne. mo_num)then
|
||||||
! print*,'n_real_tc ne mo_num ! ',n_real_tc
|
! print*,'n_real_tc ne mo_num ! ',n_real_tc
|
||||||
! stop
|
! stop
|
||||||
@ -42,9 +62,12 @@
|
|||||||
|
|
||||||
eigval_fock_tc_mo = eigval_right_tmp
|
eigval_fock_tc_mo = eigval_right_tmp
|
||||||
! print*,'Eigenvalues of Fock_matrix_tc_mo_tot'
|
! print*,'Eigenvalues of Fock_matrix_tc_mo_tot'
|
||||||
! do i = 1, mo_num
|
! do i = 1, elec_alpha_num
|
||||||
! print*, i, eigval_fock_tc_mo(i)
|
! print*, i, eigval_fock_tc_mo(i)
|
||||||
! enddo
|
! enddo
|
||||||
|
! do i = elec_alpha_num+1, mo_num
|
||||||
|
! print*, i, eigval_fock_tc_mo(i) - level_shift_tcscf
|
||||||
|
! enddo
|
||||||
! deallocate( eigval_right_tmp )
|
! deallocate( eigval_right_tmp )
|
||||||
|
|
||||||
! L.T x R
|
! L.T x R
|
||||||
@ -102,6 +125,8 @@
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, fock_tc_reigvec_ao, (ao_num, mo_num)]
|
BEGIN_PROVIDER [ double precision, fock_tc_reigvec_ao, (ao_num, mo_num)]
|
||||||
&BEGIN_PROVIDER [ double precision, fock_tc_leigvec_ao, (ao_num, mo_num)]
|
&BEGIN_PROVIDER [ double precision, fock_tc_leigvec_ao, (ao_num, mo_num)]
|
||||||
&BEGIN_PROVIDER [ double precision, overlap_fock_tc_eigvec_ao, (mo_num, mo_num) ]
|
&BEGIN_PROVIDER [ double precision, overlap_fock_tc_eigvec_ao, (mo_num, mo_num) ]
|
||||||
|
|||||||
181
src/tc_scf/diis_tcscf.irp.f
Normal file
181
src/tc_scf/diis_tcscf.irp.f
Normal file
@ -0,0 +1,181 @@
|
|||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, threshold_DIIS_nonzero_TCSCF ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
if(threshold_DIIS_TCSCF == 0.d0) then
|
||||||
|
threshold_DIIS_nonzero_TCSCF = dsqrt(thresh_tcscf)
|
||||||
|
else
|
||||||
|
threshold_DIIS_nonzero_TCSCF = threshold_DIIS_TCSCF
|
||||||
|
endif
|
||||||
|
ASSERT(threshold_DIIS_nonzero_TCSCF >= 0.d0)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, Q_alpha, (ao_num, ao_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Q_alpha = mo_r_coef x eta_occ_alpha x mo_l_coef.T
|
||||||
|
!
|
||||||
|
! [Q_alpha]_ij = \sum_{k=1}^{elec_alpha_num} [mo_r_coef]_ik [mo_l_coef]_jk
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 &
|
||||||
|
, mo_r_coef, size(mo_r_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
|
||||||
|
, 0.d0, Q_alpha, size(Q_alpha, 1) )
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, Q_beta, (ao_num, ao_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Q_beta = mo_r_coef x eta_occ_beta x mo_l_coef.T
|
||||||
|
!
|
||||||
|
! [Q_beta]_ij = \sum_{k=1}^{elec_beta_num} [mo_r_coef]_ik [mo_l_coef]_jk
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 &
|
||||||
|
, mo_r_coef, size(mo_r_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
|
||||||
|
, 0.d0, Q_beta, size(Q_beta, 1) )
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, Q_matrix, (ao_num, ao_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Q_matrix = 2 mo_r_coef x eta_occ x mo_l_coef.T
|
||||||
|
!
|
||||||
|
! with:
|
||||||
|
! | 1 if i = j = 1, ..., nb of occ orbitals
|
||||||
|
! [eta_occ]_ij = |
|
||||||
|
! | 0 otherwise
|
||||||
|
!
|
||||||
|
! the diis error is defines as:
|
||||||
|
! e = F_ao x Q x ao_overlap - ao_overlap x Q x F_ao
|
||||||
|
! with:
|
||||||
|
! mo_l_coef.T x ao_overlap x mo_r_coef = I
|
||||||
|
! F_mo = mo_l_coef.T x F_ao x mo_r_coef
|
||||||
|
! F_ao = (ao_overlap x mo_r_coef) x F_mo x (ao_overlap x mo_l_coef).T
|
||||||
|
!
|
||||||
|
! ==> e = 2 ao_overlap x mo_r_coef x [ F_mo x eta_occ - eta_occ x F_mo ] x (ao_overlap x mo_l_coef).T
|
||||||
|
!
|
||||||
|
! at convergence:
|
||||||
|
! F_mo x eta_occ - eta_occ x F_mo = 0
|
||||||
|
! ==> [F_mo]_ij ([eta_occ]_ii - [eta_occ]_jj) = 0
|
||||||
|
! ==> [F_mo]_ia = [F_mo]_ai = 0 where: i = occ and a = vir
|
||||||
|
! ==> Brillouin conditions
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
if(elec_alpha_num == elec_beta_num) then
|
||||||
|
Q_matrix = Q_alpha + Q_alpha
|
||||||
|
else
|
||||||
|
Q_matrix = Q_alpha + Q_beta
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, FQS_SQF_ao, (ao_num, ao_num)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
double precision, allocatable :: tmp(:,:)
|
||||||
|
|
||||||
|
allocate(tmp(ao_num,ao_num))
|
||||||
|
|
||||||
|
! F x Q
|
||||||
|
call dgemm( 'N', 'N', ao_num, ao_num, ao_num, 1.d0 &
|
||||||
|
, Fock_matrix_tc_ao_tot, size(Fock_matrix_tc_ao_tot, 1), Q_matrix, size(Q_matrix, 1) &
|
||||||
|
, 0.d0, tmp, size(tmp, 1) )
|
||||||
|
|
||||||
|
! F x Q x S
|
||||||
|
call dgemm( 'N', 'N', ao_num, ao_num, ao_num, 1.d0 &
|
||||||
|
, tmp, size(tmp, 1), ao_overlap, size(ao_overlap, 1) &
|
||||||
|
, 0.d0, FQS_SQF_ao, size(FQS_SQF_ao, 1) )
|
||||||
|
|
||||||
|
! S x Q
|
||||||
|
call dgemm( 'N', 'N', ao_num, ao_num, ao_num, 1.d0 &
|
||||||
|
, ao_overlap, size(ao_overlap, 1), Q_matrix, size(Q_matrix, 1) &
|
||||||
|
, 0.d0, tmp, size(tmp, 1) )
|
||||||
|
|
||||||
|
! F x P x S - S x P x F
|
||||||
|
call dgemm( 'N', 'N', ao_num, ao_num, ao_num, -1.d0 &
|
||||||
|
, tmp, size(tmp, 1), Fock_matrix_tc_ao_tot, size(Fock_matrix_tc_ao_tot, 1) &
|
||||||
|
, 1.d0, FQS_SQF_ao, size(FQS_SQF_ao, 1) )
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, FQS_SQF_mo, (mo_num, mo_num)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call ao_to_mo_bi_ortho( FQS_SQF_ao, size(FQS_SQF_ao, 1) &
|
||||||
|
, FQS_SQF_mo, size(FQS_SQF_mo, 1) )
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
! BEGIN_PROVIDER [ double precision, eigenval_Fock_tc_ao, (ao_num) ]
|
||||||
|
!&BEGIN_PROVIDER [ double precision, eigenvec_Fock_tc_ao, (ao_num,ao_num) ]
|
||||||
|
!
|
||||||
|
! BEGIN_DOC
|
||||||
|
! !
|
||||||
|
! ! Eigenvalues and eigenvectors of the Fock matrix over the ao basis
|
||||||
|
! !
|
||||||
|
! ! F' = X.T x F x X where X = ao_overlap^(-1/2)
|
||||||
|
! !
|
||||||
|
! ! F' x Cr' = Cr' x E ==> F Cr = Cr x E with Cr = X x Cr'
|
||||||
|
! ! F'.T x Cl' = Cl' x E ==> F.T Cl = Cl x E with Cl = X x Cl'
|
||||||
|
! !
|
||||||
|
! END_DOC
|
||||||
|
!
|
||||||
|
! implicit none
|
||||||
|
! double precision, allocatable :: tmp1(:,:), tmp2(:,:)
|
||||||
|
!
|
||||||
|
! ! ---
|
||||||
|
! ! Fock matrix in orthogonal basis: F' = X.T x F x X
|
||||||
|
!
|
||||||
|
! allocate(tmp1(ao_num,ao_num))
|
||||||
|
! call dgemm( 'N', 'N', ao_num, ao_num, ao_num, 1.d0 &
|
||||||
|
! , Fock_matrix_tc_ao_tot, size(Fock_matrix_tc_ao_tot, 1), S_half_inv, size(S_half_inv, 1) &
|
||||||
|
! , 0.d0, tmp1, size(tmp1, 1) )
|
||||||
|
!
|
||||||
|
! allocate(tmp2(ao_num,ao_num))
|
||||||
|
! call dgemm( 'T', 'N', ao_num, ao_num, ao_num, 1.d0 &
|
||||||
|
! , S_half_inv, size(S_half_inv, 1), tmp1, size(tmp1, 1) &
|
||||||
|
! , 0.d0, tmp2, size(tmp2, 1) )
|
||||||
|
!
|
||||||
|
! ! ---
|
||||||
|
!
|
||||||
|
! ! Diagonalize F' to obtain eigenvectors in orthogonal basis C' and eigenvalues
|
||||||
|
! ! TODO
|
||||||
|
!
|
||||||
|
! ! Back-transform eigenvectors: C =X.C'
|
||||||
|
!
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
~
|
||||||
@ -141,27 +141,49 @@ END_PROVIDER
|
|||||||
BEGIN_PROVIDER [ double precision, grad_non_hermit_left]
|
BEGIN_PROVIDER [ double precision, grad_non_hermit_left]
|
||||||
&BEGIN_PROVIDER [ double precision, grad_non_hermit_right]
|
&BEGIN_PROVIDER [ double precision, grad_non_hermit_right]
|
||||||
&BEGIN_PROVIDER [ double precision, grad_non_hermit]
|
&BEGIN_PROVIDER [ double precision, grad_non_hermit]
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i, k
|
integer :: i, k
|
||||||
|
|
||||||
grad_non_hermit_left = 0.d0
|
grad_non_hermit_left = 0.d0
|
||||||
grad_non_hermit_right = 0.d0
|
grad_non_hermit_right = 0.d0
|
||||||
|
|
||||||
do i = 1, elec_beta_num ! doc --> SOMO
|
do i = 1, elec_beta_num ! doc --> SOMO
|
||||||
do k = elec_beta_num+1, elec_alpha_num
|
do k = elec_beta_num+1, elec_alpha_num
|
||||||
grad_non_hermit_left+= dabs(Fock_matrix_tc_mo_tot(k,i))
|
grad_non_hermit_left += dabs(Fock_matrix_tc_mo_tot(k,i))
|
||||||
grad_non_hermit_right+= dabs(Fock_matrix_tc_mo_tot(i,k))
|
grad_non_hermit_right += dabs(Fock_matrix_tc_mo_tot(i,k))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i = 1, elec_beta_num ! doc --> virt
|
do i = 1, elec_beta_num ! doc --> virt
|
||||||
do k = elec_alpha_num+1, mo_num
|
do k = elec_alpha_num+1, mo_num
|
||||||
grad_non_hermit_left+= dabs(Fock_matrix_tc_mo_tot(k,i))
|
grad_non_hermit_left += dabs(Fock_matrix_tc_mo_tot(k,i))
|
||||||
grad_non_hermit_right+= dabs(Fock_matrix_tc_mo_tot(i,k))
|
grad_non_hermit_right += dabs(Fock_matrix_tc_mo_tot(i,k))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i = elec_beta_num+1, elec_alpha_num ! SOMO --> virt
|
do i = elec_beta_num+1, elec_alpha_num ! SOMO --> virt
|
||||||
do k = elec_alpha_num+1, mo_num
|
do k = elec_alpha_num+1, mo_num
|
||||||
grad_non_hermit_left+= dabs(Fock_matrix_tc_mo_tot(k,i))
|
grad_non_hermit_left += dabs(Fock_matrix_tc_mo_tot(k,i))
|
||||||
grad_non_hermit_right+= dabs(Fock_matrix_tc_mo_tot(i,k))
|
grad_non_hermit_right += dabs(Fock_matrix_tc_mo_tot(i,k))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
grad_non_hermit = grad_non_hermit_left + grad_non_hermit_right
|
grad_non_hermit = grad_non_hermit_left + grad_non_hermit_right
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, Fock_matrix_tc_ao_tot, (ao_num, ao_num) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call mo_to_ao_bi_ortho( Fock_matrix_tc_mo_tot, size(Fock_matrix_tc_mo_tot, 1) &
|
||||||
|
, Fock_matrix_tc_ao_tot, size(Fock_matrix_tc_ao_tot, 1) )
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
367
src/tc_scf/rh_tcscf.irp.f
Normal file
367
src/tc_scf/rh_tcscf.irp.f
Normal file
@ -0,0 +1,367 @@
|
|||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine rh_tcscf()
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Roothaan-Hall algorithm for TC-SCF calculation
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
integer :: iteration_TCSCF, dim_DIIS, index_dim_DIIS
|
||||||
|
double precision :: energy_TCSCF, energy_TCSCF_1e, energy_TCSCF_2e, energy_TCSCF_3e, gradie_TCSCF
|
||||||
|
double precision :: energy_TCSCF_previous, delta_energy_TCSCF
|
||||||
|
double precision :: gradie_TCSCF_previous, delta_gradie_TCSCF
|
||||||
|
double precision :: max_error_DIIS_TCSCF
|
||||||
|
double precision :: level_shift_TCSCF_save
|
||||||
|
double precision, allocatable :: F_DIIS(:,:,:), e_DIIS(:,:,:)
|
||||||
|
double precision, allocatable :: mo_r_coef_save(:,:), mo_l_coef_save(:,:)
|
||||||
|
|
||||||
|
logical, external :: qp_stop
|
||||||
|
|
||||||
|
|
||||||
|
!PROVIDE ao_md5 mo_occ
|
||||||
|
PROVIDE level_shift_TCSCF
|
||||||
|
|
||||||
|
allocate( mo_r_coef_save(ao_num,mo_num), mo_l_coef_save(ao_num,mo_num) &
|
||||||
|
, F_DIIS(ao_num,ao_num,max_dim_DIIS_TCSCF), e_DIIS(ao_num,ao_num,max_dim_DIIS_TCSCF) )
|
||||||
|
|
||||||
|
F_DIIS = 0.d0
|
||||||
|
e_DIIS = 0.d0
|
||||||
|
mo_l_coef_save = 0.d0
|
||||||
|
mo_r_coef_save = 0.d0
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
! ---
|
||||||
|
! Initialize energies and density matrices
|
||||||
|
|
||||||
|
energy_TCSCF_previous = TC_HF_energy
|
||||||
|
energy_TCSCF_1e = TC_HF_one_e_energy
|
||||||
|
energy_TCSCF_2e = TC_HF_two_e_energy
|
||||||
|
energy_TCSCF_3e = 0.d0
|
||||||
|
if(three_body_h_tc) then
|
||||||
|
energy_TCSCF_3e = diag_three_elem_hf
|
||||||
|
endif
|
||||||
|
gradie_TCSCF_previous = grad_non_hermit
|
||||||
|
delta_energy_TCSCF = 1.d0
|
||||||
|
delta_gradie_TCSCF = 1.d0
|
||||||
|
iteration_TCSCF = 0
|
||||||
|
dim_DIIS = 0
|
||||||
|
max_error_DIIS_TCSCF = 1.d0
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
! Start of main SCF loop
|
||||||
|
|
||||||
|
PROVIDE FQS_SQF_ao Fock_matrix_tc_ao_tot
|
||||||
|
|
||||||
|
do while( (max_error_DIIS_TCSCF > threshold_DIIS_nonzero_TCSCF) .or. &
|
||||||
|
(dabs(delta_energy_TCSCF) > thresh_TCSCF) .or. &
|
||||||
|
(dabs(delta_gradie_TCSCF) > dsqrt(thresh_TCSCF)) )
|
||||||
|
|
||||||
|
iteration_TCSCF += 1
|
||||||
|
if(iteration_TCSCF > n_it_TCSCF_max) then
|
||||||
|
print *, ' max of TCSCF iterations is reached ', n_it_TCSCF_max
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! TODO
|
||||||
|
!if(frozen_orb_scf) then
|
||||||
|
! call initialize_mo_coef_begin_iteration
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! current size of the DIIS space
|
||||||
|
dim_DIIS = min(dim_DIIS+1, max_dim_DIIS_TCSCF)
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
if((tcscf_algorithm == 'DIIS') .and. (dabs(delta_energy_TCSCF) > 1.d-6)) then
|
||||||
|
|
||||||
|
! store Fock and error matrices at each iteration
|
||||||
|
index_dim_DIIS = mod(dim_DIIS-1, max_dim_DIIS_TCSCF) + 1
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
F_DIIS(i,j,index_dim_DIIS) = Fock_matrix_tc_ao_tot(i,j)
|
||||||
|
e_DIIS(i,j,index_dim_DIIS) = FQS_SQF_ao(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Compute the extrapolated Fock matrix
|
||||||
|
call extrapolate_TC_Fock_matrix( e_DIIS, F_DIIS &
|
||||||
|
, Fock_matrix_tc_ao_tot, size(Fock_matrix_tc_ao_tot, 1) &
|
||||||
|
, iteration_TCSCF, dim_DIIS )
|
||||||
|
|
||||||
|
Fock_matrix_tc_ao_alpha = 0.5d0 * Fock_matrix_tc_ao_tot
|
||||||
|
Fock_matrix_tc_ao_beta = 0.5d0 * Fock_matrix_tc_ao_tot
|
||||||
|
TOUCH Fock_matrix_tc_ao_alpha Fock_matrix_tc_ao_beta
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
mo_l_coef(1:ao_num,1:mo_num) = fock_tc_leigvec_ao(1:ao_num,1:mo_num)
|
||||||
|
mo_r_coef(1:ao_num,1:mo_num) = fock_tc_reigvec_ao(1:ao_num,1:mo_num)
|
||||||
|
TOUCH mo_l_coef mo_r_coef
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
! TODO
|
||||||
|
!if(frozen_orb_scf) then
|
||||||
|
! call reorder_core_orb
|
||||||
|
! call initialize_mo_coef_begin_iteration
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! calculate error vectors
|
||||||
|
max_error_DIIS_TCSCF = maxval(abs(FQS_SQF_mo))
|
||||||
|
|
||||||
|
energy_TCSCF = TC_HF_energy
|
||||||
|
energy_TCSCF_1e = TC_HF_one_e_energy
|
||||||
|
energy_TCSCF_2e = TC_HF_two_e_energy
|
||||||
|
energy_TCSCF_3e = 0.d0
|
||||||
|
if(three_body_h_tc) then
|
||||||
|
energy_TCSCF_3e = diag_three_elem_hf
|
||||||
|
endif
|
||||||
|
gradie_TCSCF = grad_non_hermit
|
||||||
|
delta_energy_TCSCF = energy_TCSCF - energy_TCSCF_previous
|
||||||
|
delta_gradie_TCSCF = gradie_TCSCF - gradie_TCSCF_previous
|
||||||
|
|
||||||
|
if((TCSCF_algorithm == 'DIIS') .and. (delta_gradie_TCSCF > 0.d0)) then
|
||||||
|
Fock_matrix_tc_ao_tot(1:ao_num,1:ao_num) = F_DIIS(1:ao_num,1:ao_num,index_dim_DIIS)
|
||||||
|
Fock_matrix_tc_ao_alpha = 0.5d0 * Fock_matrix_tc_ao_tot
|
||||||
|
Fock_matrix_tc_ao_beta = 0.5d0 * Fock_matrix_tc_ao_tot
|
||||||
|
TOUCH Fock_matrix_tc_ao_alpha Fock_matrix_tc_ao_beta
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
level_shift_TCSCF_save = level_shift_TCSCF
|
||||||
|
|
||||||
|
mo_r_coef_save(1:ao_num,1:mo_num) = mo_r_coef(1:ao_num,1:mo_num)
|
||||||
|
mo_l_coef_save(1:ao_num,1:mo_num) = mo_l_coef(1:ao_num,1:mo_num)
|
||||||
|
|
||||||
|
do while(delta_gradie_TCSCF > 0.d0)
|
||||||
|
|
||||||
|
mo_r_coef(1:ao_num,1:mo_num) = mo_r_coef_save(1:ao_num,1:mo_num)
|
||||||
|
mo_l_coef(1:ao_num,1:mo_num) = mo_l_coef_save(1:ao_num,1:mo_num)
|
||||||
|
|
||||||
|
if(level_shift_TCSCF <= .1d0) then
|
||||||
|
level_shift_TCSCF = 1.d0
|
||||||
|
else
|
||||||
|
level_shift_TCSCF = level_shift_TCSCF * 3.0d0
|
||||||
|
endif
|
||||||
|
TOUCH mo_r_coef mo_l_coef level_shift_TCSCF
|
||||||
|
|
||||||
|
mo_l_coef(1:ao_num,1:mo_num) = fock_tc_leigvec_ao(1:ao_num,1:mo_num)
|
||||||
|
mo_r_coef(1:ao_num,1:mo_num) = fock_tc_reigvec_ao(1:ao_num,1:mo_num)
|
||||||
|
|
||||||
|
!if(frozen_orb_scf) then
|
||||||
|
! call reorder_core_orb
|
||||||
|
! call initialize_mo_coef_begin_iteration
|
||||||
|
!endif
|
||||||
|
TOUCH mo_l_coef mo_r_coef
|
||||||
|
|
||||||
|
energy_TCSCF = TC_HF_energy
|
||||||
|
energy_TCSCF_1e = TC_HF_one_e_energy
|
||||||
|
energy_TCSCF_2e = TC_HF_two_e_energy
|
||||||
|
energy_TCSCF_3e = 0.d0
|
||||||
|
if(three_body_h_tc) then
|
||||||
|
energy_TCSCF_3e = diag_three_elem_hf
|
||||||
|
endif
|
||||||
|
gradie_TCSCF = grad_non_hermit
|
||||||
|
delta_energy_TCSCF = energy_TCSCF - energy_TCSCF_previous
|
||||||
|
delta_gradie_TCSCF = gradie_TCSCF - gradie_TCSCF_previous
|
||||||
|
|
||||||
|
if(level_shift_TCSCF - level_shift_TCSCF_save > 40.d0) then
|
||||||
|
level_shift_TCSCF = level_shift_TCSCF_save * 4.d0
|
||||||
|
SOFT_TOUCH level_shift_TCSCF
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
dim_DIIS = 0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
level_shift_TCSCF = level_shift_TCSCF * 0.5d0
|
||||||
|
SOFT_TOUCH level_shift_TCSCF
|
||||||
|
|
||||||
|
energy_TCSCF_previous = energy_TCSCF
|
||||||
|
energy_TCSCF_1e = TC_HF_one_e_energy
|
||||||
|
energy_TCSCF_2e = TC_HF_two_e_energy
|
||||||
|
energy_TCSCF_3e = 0.d0
|
||||||
|
if(three_body_h_tc) then
|
||||||
|
energy_TCSCF_3e = diag_three_elem_hf
|
||||||
|
endif
|
||||||
|
gradie_TCSCF_previous = grad_non_hermit
|
||||||
|
|
||||||
|
print *, ' iteration = ', iteration_TCSCF
|
||||||
|
print *, ' total TC energy = ', energy_TCSCF
|
||||||
|
print *, ' 1-e TC energy = ', energy_TCSCF_1e
|
||||||
|
print *, ' 2-e TC energy = ', energy_TCSCF_2e
|
||||||
|
print *, ' 3-e TC energy = ', energy_TCSCF_3e
|
||||||
|
print *, ' |delta TC energy| = ', delta_energy_TCSCF
|
||||||
|
print *, ' delta TC gradient = ', delta_gradie_TCSCF
|
||||||
|
print *, ' max TC DIIS error = ', max_error_DIIS_TCSCF
|
||||||
|
print *, ' TC DIIS dim = ', dim_DIIS
|
||||||
|
print *, ' TC level shift = ', level_shift_TCSCF
|
||||||
|
|
||||||
|
if(delta_gradie_TCSCF < 0.d0) then
|
||||||
|
call ezfio_set_bi_ortho_mos_mo_l_coef(mo_l_coef)
|
||||||
|
call ezfio_set_bi_ortho_mos_mo_r_coef(mo_r_coef)
|
||||||
|
call ezfio_set_tc_scf_bitc_energy(energy_TCSCF)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(qp_stop()) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
!if(iteration_TCSCF < n_it_TCSCF_max) then
|
||||||
|
! mo_label = 'Canonical'
|
||||||
|
!endif
|
||||||
|
|
||||||
|
!if(.not.frozen_orb_scf) then
|
||||||
|
! call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo, size(Fock_matrix_mo,1), size(Fock_matrix_mo, 2), mo_label, 1, .true.)
|
||||||
|
! call restore_symmetry(ao_num, mo_num, mo_coef, size(mo_coef, 1), 1.d-10)
|
||||||
|
! call orthonormalize_mos
|
||||||
|
! call save_mos
|
||||||
|
!endif
|
||||||
|
!call write_double(6, energy_TCSCF, 'TCSCF energy')
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine extrapolate_TC_Fock_matrix(e_DIIS, F_DIIS, F_ao, size_F_ao, iteration_TCSCF, dim_DIIS)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Compute the extrapolated Fock matrix using the DIIS procedure
|
||||||
|
!
|
||||||
|
! e = \sum_i c_i e_i and \sum_i c_i = 1
|
||||||
|
! ==> lagrange multiplier with L = |e|^2 - \lambda (\sum_i c_i = 1)
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: iteration_TCSCF, size_F_ao
|
||||||
|
integer, intent(inout) :: dim_DIIS
|
||||||
|
double precision, intent(in) :: F_DIIS(ao_num,ao_num,dim_DIIS)
|
||||||
|
double precision, intent(in) :: e_DIIS(ao_num,ao_num,dim_DIIS)
|
||||||
|
double precision, intent(inout) :: F_ao(size_F_ao,ao_num)
|
||||||
|
|
||||||
|
double precision, allocatable :: B_matrix_DIIS(:,:), X_vector_DIIS(:), C_vector_DIIS(:)
|
||||||
|
|
||||||
|
integer :: i, j, k, l, i_DIIS, j_DIIS
|
||||||
|
integer :: lwork
|
||||||
|
double precision :: rcond, ferr, berr
|
||||||
|
integer, allocatable :: iwork(:)
|
||||||
|
double precision, allocatable :: scratch(:,:)
|
||||||
|
|
||||||
|
if(dim_DIIS < 1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate( B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), X_vector_DIIS(dim_DIIS+1) &
|
||||||
|
, C_vector_DIIS(dim_DIIS+1), scratch(ao_num,ao_num) )
|
||||||
|
|
||||||
|
! Compute the matrices B and X
|
||||||
|
B_matrix_DIIS(:,:) = 0.d0
|
||||||
|
do j = 1, dim_DIIS
|
||||||
|
j_DIIS = min(dim_DIIS, mod(iteration_TCSCF-j, max_dim_DIIS_TCSCF)+1)
|
||||||
|
|
||||||
|
do i = 1, dim_DIIS
|
||||||
|
i_DIIS = min(dim_DIIS, mod(iteration_TCSCF-i, max_dim_DIIS_TCSCF)+1)
|
||||||
|
|
||||||
|
! Compute product of two errors vectors
|
||||||
|
do l = 1, ao_num
|
||||||
|
do k = 1, ao_num
|
||||||
|
B_matrix_DIIS(i,j) = B_matrix_DIIS(i,j) + e_DIIS(k,l,i_DIIS) * e_DIIS(k,l,j_DIIS)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Pad B matrix and build the X matrix
|
||||||
|
|
||||||
|
C_vector_DIIS(:) = 0.d0
|
||||||
|
do i = 1, dim_DIIS
|
||||||
|
B_matrix_DIIS(i,dim_DIIS+1) = -1.d0
|
||||||
|
B_matrix_DIIS(dim_DIIS+1,i) = -1.d0
|
||||||
|
enddo
|
||||||
|
C_vector_DIIS(dim_DIIS+1) = -1.d0
|
||||||
|
|
||||||
|
deallocate(scratch)
|
||||||
|
|
||||||
|
! Estimate condition number of B
|
||||||
|
integer :: info
|
||||||
|
double precision :: anorm
|
||||||
|
integer, allocatable :: ipiv(:)
|
||||||
|
double precision, allocatable :: AF(:,:)
|
||||||
|
double precision, external :: dlange
|
||||||
|
|
||||||
|
lwork = max((dim_DIIS+1)**2, (dim_DIIS+1)*5)
|
||||||
|
allocate(AF(dim_DIIS+1,dim_DIIS+1))
|
||||||
|
allocate(ipiv(2*(dim_DIIS+1)), iwork(2*(dim_DIIS+1)) )
|
||||||
|
allocate(scratch(lwork,1))
|
||||||
|
scratch(:,1) = 0.d0
|
||||||
|
|
||||||
|
anorm = dlange('1', dim_DIIS+1, dim_DIIS+1, B_matrix_DIIS, size(B_matrix_DIIS, 1), scratch(1,1))
|
||||||
|
|
||||||
|
AF(:,:) = B_matrix_DIIS(:,:)
|
||||||
|
call dgetrf(dim_DIIS+1, dim_DIIS+1, AF, size(AF, 1), ipiv, info)
|
||||||
|
if(info /= 0) then
|
||||||
|
dim_DIIS = 0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
call dgecon('1', dim_DIIS+1, AF, size(AF, 1), anorm, rcond, scratch, iwork, info)
|
||||||
|
if(info /= 0) then
|
||||||
|
dim_DIIS = 0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(rcond < 1.d-14) then
|
||||||
|
dim_DIIS = 0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! solve the linear system C = B x X
|
||||||
|
|
||||||
|
X_vector_DIIS = C_vector_DIIS
|
||||||
|
call dgesv(dim_DIIS+1, 1, B_matrix_DIIS, size(B_matrix_DIIS, 1), ipiv , X_vector_DIIS, size(X_vector_DIIS, 1), info)
|
||||||
|
|
||||||
|
deallocate(scratch, AF, iwork)
|
||||||
|
if(info < 0) then
|
||||||
|
stop ' bug in TC-DIIS'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Compute extrapolated Fock matrix
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num > 200)
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
F_ao(i,j) = 0.d0
|
||||||
|
enddo
|
||||||
|
do k = 1, dim_DIIS
|
||||||
|
if(dabs(X_vector_DIIS(k)) < 1.d-10) cycle
|
||||||
|
do i = 1,ao_num
|
||||||
|
! FPE here
|
||||||
|
F_ao(i,j) = F_ao(i,j) + X_vector_DIIS(k) * F_DIIS(i,j,dim_DIIS-k+1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
@ -18,11 +18,16 @@ program tc_scf
|
|||||||
!call create_guess
|
!call create_guess
|
||||||
!call orthonormalize_mos
|
!call orthonormalize_mos
|
||||||
|
|
||||||
call routine_scf()
|
PROVIDE tcscf_algorithm
|
||||||
|
if(tcscf_algorithm == 'DIIS') then
|
||||||
|
call rh_tcscf()
|
||||||
|
else
|
||||||
|
call simple_tcscf()
|
||||||
|
endif
|
||||||
|
|
||||||
call minimize_tc_orb_angles()
|
call minimize_tc_orb_angles()
|
||||||
call print_energy_and_mos()
|
call print_energy_and_mos()
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
@ -64,7 +69,7 @@ end subroutine create_guess
|
|||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
subroutine routine_scf()
|
subroutine simple_tcscf()
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i, j, it
|
integer :: i, j, it
|
||||||
@ -79,9 +84,9 @@ subroutine routine_scf()
|
|||||||
!print*,'grad_hermit = ', grad_hermit
|
!print*,'grad_hermit = ', grad_hermit
|
||||||
print*,'***'
|
print*,'***'
|
||||||
print*,'TC HF total energy = ', TC_HF_energy
|
print*,'TC HF total energy = ', TC_HF_energy
|
||||||
print*,'TC HF 1 e energy = ', TC_HF_one_electron_energy
|
print*,'TC HF 1 e energy = ', TC_HF_one_e_energy
|
||||||
print*,'TC HF 2 e energy = ', TC_HF_two_e_energy
|
print*,'TC HF 2 e energy = ', TC_HF_two_e_energy
|
||||||
if(three_body_h_tc)then
|
if(three_body_h_tc) then
|
||||||
print*,'TC HF 3 body = ', diag_three_elem_hf
|
print*,'TC HF 3 body = ', diag_three_elem_hf
|
||||||
endif
|
endif
|
||||||
print*,'***'
|
print*,'***'
|
||||||
@ -99,7 +104,6 @@ subroutine routine_scf()
|
|||||||
call ezfio_set_bi_ortho_mos_mo_r_coef(mo_r_coef)
|
call ezfio_set_bi_ortho_mos_mo_r_coef(mo_r_coef)
|
||||||
TOUCH mo_l_coef mo_r_coef
|
TOUCH mo_l_coef mo_r_coef
|
||||||
|
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
print*,'grad_hermit = ',grad_hermit
|
print*,'grad_hermit = ',grad_hermit
|
||||||
@ -122,7 +126,7 @@ subroutine routine_scf()
|
|||||||
print*,'iteration = ', it
|
print*,'iteration = ', it
|
||||||
print*,'***'
|
print*,'***'
|
||||||
print*,'TC HF total energy = ', TC_HF_energy
|
print*,'TC HF total energy = ', TC_HF_energy
|
||||||
print*,'TC HF 1 e energy = ', TC_HF_one_electron_energy
|
print*,'TC HF 1 e energy = ', TC_HF_one_e_energy
|
||||||
print*,'TC HF 2 non hermit = ', TC_HF_two_e_energy
|
print*,'TC HF 2 non hermit = ', TC_HF_two_e_energy
|
||||||
if(three_body_h_tc)then
|
if(three_body_h_tc)then
|
||||||
print*,'TC HF 3 body = ', diag_three_elem_hf
|
print*,'TC HF 3 body = ', diag_three_elem_hf
|
||||||
@ -161,7 +165,7 @@ subroutine routine_scf()
|
|||||||
print*,'iteration = ', it
|
print*,'iteration = ', it
|
||||||
print*,'***'
|
print*,'***'
|
||||||
print*,'TC HF total energy = ', TC_HF_energy
|
print*,'TC HF total energy = ', TC_HF_energy
|
||||||
print*,'TC HF 1 e energy = ', TC_HF_one_electron_energy
|
print*,'TC HF 1 e energy = ', TC_HF_one_e_energy
|
||||||
print*,'TC HF 2 e energy = ', TC_HF_two_e_energy
|
print*,'TC HF 2 e energy = ', TC_HF_two_e_energy
|
||||||
print*,'TC HF 3 body = ', diag_three_elem_hf
|
print*,'TC HF 3 body = ', diag_three_elem_hf
|
||||||
print*,'***'
|
print*,'***'
|
||||||
@ -174,11 +178,11 @@ subroutine routine_scf()
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
print*,'Energy converged !'
|
print*,'Energy converged !'
|
||||||
call print_energy_and_mos
|
call print_energy_and_mos()
|
||||||
|
|
||||||
deallocate(rho_old, rho_new)
|
deallocate(rho_old, rho_new)
|
||||||
|
|
||||||
end subroutine routine_scf
|
end subroutine simple_tcscf
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
|||||||
@ -1,12 +1,16 @@
|
|||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_beta, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_beta, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
if(bi_ortho)then
|
if(bi_ortho) then
|
||||||
TCSCF_density_matrix_ao_beta = TCSCF_bi_ort_dm_ao_beta
|
TCSCF_density_matrix_ao_beta = TCSCF_bi_ort_dm_ao_beta
|
||||||
else
|
else
|
||||||
TCSCF_density_matrix_ao_beta = SCF_density_matrix_ao_beta
|
TCSCF_density_matrix_ao_beta = SCF_density_matrix_ao_beta
|
||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_alpha, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_alpha, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
if(bi_ortho)then
|
if(bi_ortho)then
|
||||||
@ -17,6 +21,8 @@ BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_alpha, (ao_num, ao_nu
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_tot, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_tot, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
TCSCF_density_matrix_ao_tot = TCSCF_density_matrix_ao_beta + TCSCF_density_matrix_ao_alpha
|
TCSCF_density_matrix_ao_tot = TCSCF_density_matrix_ao_beta + TCSCF_density_matrix_ao_alpha
|
||||||
|
|||||||
@ -1,6 +1,6 @@
|
|||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, TC_HF_energy]
|
BEGIN_PROVIDER [ double precision, TC_HF_energy]
|
||||||
&BEGIN_PROVIDER [ double precision, TC_HF_one_electron_energy]
|
&BEGIN_PROVIDER [ double precision, TC_HF_one_e_energy]
|
||||||
&BEGIN_PROVIDER [ double precision, TC_HF_two_e_energy]
|
&BEGIN_PROVIDER [ double precision, TC_HF_two_e_energy]
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -11,19 +11,19 @@
|
|||||||
integer :: i, j
|
integer :: i, j
|
||||||
|
|
||||||
TC_HF_energy = nuclear_repulsion
|
TC_HF_energy = nuclear_repulsion
|
||||||
TC_HF_one_electron_energy = 0.d0
|
TC_HF_one_e_energy = 0.d0
|
||||||
TC_HF_two_e_energy = 0.d0
|
TC_HF_two_e_energy = 0.d0
|
||||||
|
|
||||||
do j = 1, ao_num
|
do j = 1, ao_num
|
||||||
do i = 1, ao_num
|
do i = 1, ao_num
|
||||||
TC_HF_two_e_energy += 0.5d0 * ( two_e_tc_non_hermit_integral_alpha(i,j) * TCSCF_density_matrix_ao_alpha(i,j) &
|
TC_HF_two_e_energy += 0.5d0 * ( two_e_tc_non_hermit_integral_alpha(i,j) * TCSCF_density_matrix_ao_alpha(i,j) &
|
||||||
+ two_e_tc_non_hermit_integral_beta(i,j) * TCSCF_density_matrix_ao_beta(i,j) )
|
+ two_e_tc_non_hermit_integral_beta (i,j) * TCSCF_density_matrix_ao_beta (i,j) )
|
||||||
TC_HF_one_electron_energy += ao_one_e_integrals_tc_tot(i,j) &
|
TC_HF_one_e_energy += ao_one_e_integrals_tc_tot(i,j) &
|
||||||
* (TCSCF_density_matrix_ao_alpha(i,j) + TCSCF_density_matrix_ao_beta (i,j) )
|
* (TCSCF_density_matrix_ao_alpha(i,j) + TCSCF_density_matrix_ao_beta (i,j) )
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
TC_HF_energy += TC_HF_one_electron_energy + TC_HF_two_e_energy
|
TC_HF_energy += TC_HF_one_e_energy + TC_HF_two_e_energy
|
||||||
TC_HF_energy += diag_three_elem_hf
|
TC_HF_energy += diag_three_elem_hf
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|||||||
@ -40,3 +40,4 @@ subroutine LTxSxR(n, m, L, S, R, C)
|
|||||||
end subroutine LTxR
|
end subroutine LTxR
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user