LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-11 22:23:31 +01:00
Code Releases Activity

add mo optimization

Browse Source
This commit is contained in:
Yann Damour 2023-04-18 13:56:30 +02:00
parent d6f7ec60f8
commit b71888f459
57 changed files with 18356 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
src/mo_optimization/83.mo_optimization.bats Normal file
View File

@ -0,0 +1,62 @@
#!/usr/bin/env bats
source $QP_ROOT/tests/bats/common.bats.sh
source $QP_ROOT/quantum_package.rc
function run() {
thresh=2e-3
test_exe scf || skip
qp set_file $1
qp edit --check
qp reset -a
qp run scf
qp set_frozen_core
qp set determinants n_states 2
qp set determinants read_wf true
qp set mo_two_e_ints io_mo_two_e_integrals None
file="$(echo $1 | sed 's/.ezfio//g')"
qp run cis
qp run debug_gradient_list_opt > $file.debug_g.out
err3="$(grep 'Max error:' $file.debug_g.out | awk '{print $3}')"
qp run debug_hessian_list_opt > $file.debug_h1.out
err1="$(grep 'Max error:' $file.debug_h1.out | awk '{print $3}')"
qp run orb_opt > $file.opt1.out
energy1="$(grep 'State average energy:' $file.opt1.out | tail -n 1 | awk '{print $4}')"
qp set orbital_optimization optimization_method diag
qp reset -d
qp run scf
qp run cis
qp run debug_hessian_list_opt > $file.debug_h2.out
err2="$(grep 'Max error_H:' $file.debug_h2.out | awk '{print $3}')"
qp run orb_opt > $file.opt2.out
energy2="$(grep 'State average energy:' $file.opt2.out | tail -n 1 | awk '{print $4}')"
qp set orbital_optimization optimization_method full
qp reset -d
qp run scf
eq $energy1 $2 $thresh
eq $energy2 $3 $thresh
eq $err1 0.0 1e-12
eq $err2 0.0 1e-12
eq $err3 0.0 1e-12
}
@test "b2_stretched" {
run b2_stretched.ezfio -48.9852901484277 -48.9852937541510
}
@test "h2o" {
run h2o.ezfio -75.9025622449206 -75.8691844585879
}
@test "h2s" {
run h2s.ezfio -398.576255809878 -398.574145943928
}
@test "hbo" {
run hbo.ezfio -99.9234823022109 -99.9234763597840
}
@test "hco" {
run hco.ezfio -113.204915552241 -113.204905207050
}

29
src/mo_optimization/EZFIO.cfg Normal file
View File

@ -0,0 +1,29 @@
[optimization_method]
type: character*(32)
doc: Define the kind of hessian for the orbital optimization full : full hessian, diag : diagonal hessian, none : no hessian
interface: ezfio,provider,ocaml
default: full
[n_det_start]
type: integer
doc: Number of determinants after which the orbital optimization will start, n_det_start must be greater than 1. The algorithm does a cipsi until n_det > n_det_start and the optimization starts after
interface: ezfio,provider,ocaml
default: 5
[n_det_max_opt]
type: integer
doc: Maximal number of the determinants in the wf for the orbital optimization (to stop the optimization if n_det > n_det_max_opt)
interface: ezfio,provider,ocaml
default: 200000
[optimization_max_nb_iter]
type: integer
doc: Maximal number of iterations for the orbital optimization
interface: ezfio,provider,ocaml
default: 20
[thresh_opt_max_elem_grad]
type: double precision
doc: Threshold for the convergence, the optimization exits when the biggest element in the gradient is smaller than thresh_optimization_max_elem_grad
interface: ezfio,provider,ocaml
default: 1.e-5

7
src/mo_optimization/NEED Normal file
View File

@ -0,0 +1,7 @@
two_body_rdm
hartree_fock
cipsi
davidson_undressed
selectors_full
generators_full
utils_trust_region

74
src/mo_optimization/README.md Normal file
View File

@ -0,0 +1,74 @@
# Orbital optimization
## Methods
Different methods are available:
- full hessian
```
qp set orbital_optimization optimization_method full
```
- diagonal hessian
```
qp set orbital_optimization optimization_method diag
```
- identity matrix
```
qp set orbital_optimization optimization_method none
```
After the optimization the ezfio contains the optimized orbitals
## For a fixed number of determinants
To optimize the MOs for the actual determinants:
```
qp run orb_opt
```
## For a complete optimization, i.e, with a larger and larger wave function
To optimize the MOs with a larger and larger wave function:
```
qp run optimization
```
The results are stored in the EZFIO in "mo_optimization/result_opt",
with the following format:
(1) (2) (3) (4)
1: Number of determinants in the wf,
2: Cispi energy before the optimization,
3: Cipsi energy after the optimization,
4: Energy difference between (2) and (3).
The optimization process if the following:
- we do a first cipsi step to obtain a small number of determinants in the wf
- we run an orbital optimization for this wf
- we do a new cipsi step to double the number of determinants in the wf
- we run an orbital optimization for this wf
- ...
- we do that until the energy difference between (2) and (3) is
smaller than the targeted accuracy for the cispi (targeted_accuracy_cipsi in qp edit)
or the wf is larger than a given size (n_det_max_opt in qp_edit)
- after that you can reset your determinants (qp reset -d) and run a clean Cispi calculation
### End of the optimization
You can choos the number of determinants after what the
optimization will stop:
```
qp set orbital_optimization n_det_max_opt 1e5 # or any number
```
## Weight of the states
You can change the weights of the differents states directly in qp edit.
It will affect ths weights used in the orbital optimization.
# Tests
To run the tests:
```
qp test
```
# Org files
The org files are stored in the directory org in order to avoid overwriting on user changes.
The org files can be modified, to export the change to the source code, run
```
./TANGLE_org_mode.sh
mv *.irp.f ../.
```

12
src/mo_optimization/class.irp.f Normal file
View File

@ -0,0 +1,12 @@
BEGIN_PROVIDER [ logical, do_only_1h1p ]
&BEGIN_PROVIDER [ logical, do_only_cas ]
&BEGIN_PROVIDER [ logical, do_ddci ]
implicit none
BEGIN_DOC
! In the FCI case, all those are always false
END_DOC
do_only_1h1p = .False.
do_only_cas = .False.
do_ddci = .False.
END_PROVIDER

1
src/mo_optimization/constants.h Normal file
View File

@ -0,0 +1 @@
logical, parameter :: debug=.False.

78
src/mo_optimization/debug_gradient_list_opt.irp.f Normal file
View File

@ -0,0 +1,78 @@
! Debug the gradient
! *Program to check the gradient*
! The program compares the result of the first and last code for the
! gradient.
! Provided:
! | mo_num | integer | number of MOs |
! Internal:
! | n | integer | number of orbitals pairs (p,q) p<q |
! | v_grad(n) | double precision | Original gradient |
! | v_grad2(n) | double precision | Gradient |
! | i | integer | index |
! | threshold | double precision | threshold for the errors |
! | max_error | double precision | maximal error in the gradient |
! | nb_error | integer | number of error in the gradient |
program debug_gradient_list
implicit none
! Variables
double precision, allocatable :: v_grad(:), v_grad2(:)
integer :: n,m
integer :: i
double precision :: threshold
double precision :: max_error, max_elem, norm
integer :: nb_error
m = dim_list_act_orb
! Definition of n
n = m*(m-1)/2
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
! Allocation
allocate(v_grad(n), v_grad2(n))
! Calculation
call diagonalize_ci ! Vérifier pour suppression
! Gradient
call gradient_list_opt(n,m,list_act,v_grad,max_elem,norm)
call first_gradient_list_opt(n,m,list_act,v_grad2)
v_grad = v_grad - v_grad2
nb_error = 0
max_error = 0d0
threshold = 1d-12
do i = 1, n
if (ABS(v_grad(i)) > threshold) then
print*,i,v_grad(i)
nb_error = nb_error + 1
if (ABS(v_grad(i)) > max_error) then
max_error = v_grad(i)
endif
endif
enddo
print*,''
print*,'Check the gradient'
print*,'Threshold:', threshold
print*,'Nb error:', nb_error
print*,'Max error:', max_error
! Deallocation
deallocate(v_grad,v_grad2)
end program

76
src/mo_optimization/debug_gradient_opt.irp.f Normal file
View File

@ -0,0 +1,76 @@
! Debug the gradient
! *Program to check the gradient*
! The program compares the result of the first and last code for the
! gradient.
! Provided:
! | mo_num | integer | number of MOs |
! Internal:
! | n | integer | number of orbitals pairs (p,q) p<q |
! | v_grad(n) | double precision | Original gradient |
! | v_grad2(n) | double precision | Gradient |
! | i | integer | index |
! | threshold | double precision | threshold for the errors |
! | max_error | double precision | maximal error in the gradient |
! | nb_error | integer | number of error in the gradient |
program debug_gradient
implicit none
! Variables
double precision, allocatable :: v_grad(:), v_grad2(:)
integer :: n
integer :: i
double precision :: threshold
double precision :: max_error, max_elem
integer :: nb_error
! Definition of n
n = mo_num*(mo_num-1)/2
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
! Allocation
allocate(v_grad(n), v_grad2(n))
! Calculation
call diagonalize_ci ! Vérifier pour suppression
! Gradient
call first_gradient_opt(n,v_grad)
call gradient_opt(n,v_grad2,max_elem)
v_grad = v_grad - v_grad2
nb_error = 0
max_error = 0d0
threshold = 1d-12
do i = 1, n
if (ABS(v_grad(i)) > threshold) then
print*,v_grad(i)
nb_error = nb_error + 1
if (ABS(v_grad(i)) > max_error) then
max_error = v_grad(i)
endif
endif
enddo
print*,''
print*,'Check the gradient'
print*,'Threshold :', threshold
print*,'Nb error :', nb_error
print*,'Max error :', max_error
! Deallocation
deallocate(v_grad,v_grad2)
end program

147
src/mo_optimization/debug_hessian_list_opt.irp.f Normal file
View File

@ -0,0 +1,147 @@
! Debug the hessian
! *Program to check the hessian matrix*
! The program compares the result of the first and last code for the
! hessian. First of all the 4D hessian and after the 2D hessian.
! Provided:
! | mo_num | integer | number of MOs |
! | optimization_method | string | Method for the orbital optimization: |
! | | | - 'full' -> full hessian |
! | | | - 'diag' -> diagonal hessian |
! | dim_list_act_orb | integer | number of active MOs |
! | list_act(dim_list_act_orb) | integer | list of the actives MOs |
! | | | |
! Internal:
! | m | integer | number of MOs in the list |
! | | | (active MOs) |
! | n | integer | number of orbitals pairs (p,q) p<q |
! | | | n = m*(m-1)/2 |
! | H(n,n) | double precision | Original hessian matrix (2D) |
! | H2(n,n) | double precision | Hessian matrix (2D) |
! | h_f(mo_num,mo_num,mo_num,mo_num) | double precision | Original hessian matrix (4D) |
! | h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D) |
! | i,j,p,q,k | integer | indexes |
! | threshold | double precision | threshold for the errors |
! | max_error | double precision | maximal error in the 4D hessian |
! | max_error_H | double precision | maximal error in the 2D hessian |
! | nb_error | integer | number of errors in the 4D hessian |
! | nb_error_H | integer | number of errors in the 2D hessian |
program debug_hessian_list_opt
implicit none
! Variables
double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
integer :: n,m
integer :: i,j,k,l
double precision :: max_error, max_error_H
integer :: nb_error, nb_error_H
double precision :: threshold
m = dim_list_act_orb !mo_num
! Definition of n
n = m*(m-1)/2
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
! Hessian
if (optimization_method == 'full') then
print*,'Use the full hessian matrix'
allocate(H(n,n),H2(n,n))
allocate(h_f(m,m,m,m),h_f2(m,m,m,m))
call hessian_list_opt(n,m,list_act,H,h_f)
call first_hessian_list_opt(n,m,list_act,H2,h_f2)
!call hessian_opt(n,H2,h_f2)
! Difference
h_f = h_f - h_f2
H = H - H2
max_error = 0d0
nb_error = 0
threshold = 1d-12
do l = 1, m
do k= 1, m
do j = 1, m
do i = 1, m
if (ABS(h_f(i,j,k,l)) > threshold) then
print*,h_f(i,j,k,l)
nb_error = nb_error + 1
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
max_error = h_f(i,j,k,l)
endif
endif
enddo
enddo
enddo
enddo
max_error_H = 0d0
nb_error_H = 0
do j = 1, n
do i = 1, n
if (ABS(H(i,j)) > threshold) then
print*, H(i,j)
nb_error_H = nb_error_H + 1
if (ABS(H(i,j)) > ABS(max_error_H)) then
max_error_H = H(i,j)
endif
endif
enddo
enddo
! Deallocation
deallocate(H, H2, h_f, h_f2)
else
print*, 'Use the diagonal hessian matrix'
allocate(H(n,1),H2(n,1))
call diag_hessian_list_opt(n,m,list_act,H)
call first_diag_hessian_list_opt(n,m,list_act,H2)
H = H - H2
max_error_H = 0d0
nb_error_H = 0
do i = 1, n
if (ABS(H(i,1)) > threshold) then
print*, H(i,1)
nb_error_H = nb_error_H + 1
if (ABS(H(i,1)) > ABS(max_error_H)) then
max_error_H = H(i,1)
endif
endif
enddo
endif
print*,''
if (optimization_method == 'full') then
print*,'Check of the full hessian'
print*,'Threshold:', threshold
print*,'Nb error:', nb_error
print*,'Max error:', max_error
print*,''
else
print*,'Check of the diagonal hessian'
endif
print*,'Nb error_H:', nb_error_H
print*,'Max error_H:', max_error_H
end program

171
src/mo_optimization/debug_hessian_opt.irp.f Normal file
View File

@ -0,0 +1,171 @@
! Debug the hessian
! *Program to check the hessian matrix*
! The program compares the result of the first and last code for the
! hessian. First of all the 4D hessian and after the 2D hessian.
! Provided:
! | mo_num | integer | number of MOs |
! Internal:
! | n | integer | number of orbitals pairs (p,q) p<q |
! | H(n,n) | double precision | Original hessian matrix (2D) |
! | H2(n,n) | double precision | Hessian matrix (2D) |
! | h_f(mo_num,mo_num,mo_num,mo_num) | double precision | Original hessian matrix (4D) |
! | h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D) |
! | method | integer | - 1: full hessian |
! | | | - 2: diagonal hessian |
! | i,j,p,q,k | integer | indexes |
! | threshold | double precision | threshold for the errors |
! | max_error | double precision | maximal error in the 4D hessian |
! | max_error_H | double precision | maximal error in the 2D hessian |
! | nb_error | integer | number of errors in the 4D hessian |
! | nb_error_H | integer | number of errors in the 2D hessian |
program debug_hessian
implicit none
! Variables
double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
integer :: n
integer :: i,j,k,l
double precision :: max_error, max_error_H
integer :: nb_error, nb_error_H
double precision :: threshold
! Definition of n
n = mo_num*(mo_num-1)/2
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
! Allocation
allocate(H(n,n),H2(n,n))
allocate(h_f(mo_num,mo_num,mo_num,mo_num),h_f2(mo_num,mo_num,mo_num,mo_num))
! Calculation
! Hessian
if (optimization_method == 'full') then
print*,'Use the full hessian matrix'
call hessian_opt(n,H,h_f)
call first_hessian_opt(n,H2,h_f2)
! Difference
h_f = h_f - h_f2
H = H - H2
max_error = 0d0
nb_error = 0
threshold = 1d-12
do l = 1, mo_num
do k= 1, mo_num
do j = 1, mo_num
do i = 1, mo_num
if (ABS(h_f(i,j,k,l)) > threshold) then
print*,h_f(i,j,k,l)
nb_error = nb_error + 1
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
max_error = h_f(i,j,k,l)
endif
endif
enddo
enddo
enddo
enddo
max_error_H = 0d0
nb_error_H = 0
do j = 1, n
do i = 1, n
if (ABS(H(i,j)) > threshold) then
print*, H(i,j)
nb_error_H = nb_error_H + 1
if (ABS(H(i,j)) > ABS(max_error_H)) then
max_error_H = H(i,j)
endif
endif
enddo
enddo
elseif (optimization_method == 'diag') then
print*, 'Use the diagonal hessian matrix'
call diag_hessian_opt(n,H,h_f)
call first_diag_hessian_opt(n,H2,h_f2)
h_f = h_f - h_f2
max_error = 0d0
nb_error = 0
threshold = 1d-12
do l = 1, mo_num
do k = 1, mo_num
do j = 1, mo_num
do i = 1, mo_num
if (ABS(h_f(i,j,k,l)) > threshold) then
print*,h_f(i,j,k,l)
nb_error = nb_error + 1
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
max_error = h_f(i,j,k,l)
endif
endif
enddo
enddo
enddo
enddo
h=H-H2
max_error_H = 0d0
nb_error_H = 0
do j = 1, n
do i = 1, n
if (ABS(H(i,j)) > threshold) then
print*, H(i,j)
nb_error_H = nb_error_H + 1
if (ABS(H(i,j)) > ABS(max_error_H)) then
max_error_H = H(i,j)
endif
endif
enddo
enddo
else
print*,'Unknown optimization_method, please select full, diag'
call abort
endif
print*,''
if (optimization_method == 'full') then
print*,'Check the full hessian'
else
print*,'Check the diagonal hessian'
endif
print*,'Threshold :', threshold
print*,'Nb error :', nb_error
print*,'Max error :', max_error
print*,''
print*,'Nb error_H :', nb_error_H
print*,'Max error_H :', max_error_H
! Deallocation
deallocate(H,H2,h_f,h_f2)
end program

1556
src/mo_optimization/diagonal_hessian_list_opt.irp.f Normal file
View File

File diff suppressed because it is too large Load Diff

1511
src/mo_optimization/diagonal_hessian_opt.irp.f Normal file
View File

File diff suppressed because it is too large Load Diff

136
src/mo_optimization/diagonalization_hessian.irp.f Normal file
View File

@ -0,0 +1,136 @@
! Diagonalization of the hessian
! Just a matrix diagonalization using Lapack
! Input:
! | n | integer | mo_num*(mo_num-1)/2 |
! | H(n,n) | double precision | hessian |
! Output:
! | e_val(n) | double precision | eigenvalues of the hessian |
! | w(n,n) | double precision | eigenvectors of the hessian |
! Internal:
! | nb_negative_nv | integer | number of negative eigenvalues |
! | lwork | integer | for Lapack |
! | work(lwork,n) | double precision | temporary array for Lapack |
! | info | integer | if 0 -> ok, else problem in the diagonalization |
! | i,j | integer | dummy indexes |
subroutine diagonalization_hessian(n,H,e_val,w)
include 'constants.h'
implicit none
! Variables
! in
integer, intent(in) :: n
double precision, intent(in) :: H(n,n)
! out
double precision, intent(out) :: e_val(n), w(n,n)
! internal
double precision, allocatable :: work(:,:)
integer, allocatable :: key(:)
integer :: info,lwork
integer :: i,j
integer :: nb_negative_vp
double precision :: t1,t2,t3,max_elem
print*,''
print*,'---Diagonalization_hessian---'
call wall_time(t1)
if (optimization_method == 'full') then
! Allocation
! For Lapack
lwork=3*n-1
allocate(work(lwork,n))
! Calculation
! Copy the hessian matrix, the eigenvectors will be store in W
W=H
! Diagonalization of the hessian
call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info)
if (info /= 0) then
print*, 'Error diagonalization : diagonalization_hessian'
print*, 'info = ', info
call ABORT
endif
if (debug) then
print *, 'vp Hess:'
write(*,'(100(F10.5))') real(e_val(:))
endif
! Number of negative eigenvalues
max_elem = 0d0
nb_negative_vp = 0
do i = 1, n
if (e_val(i) < 0d0) then
nb_negative_vp = nb_negative_vp + 1
if (e_val(i) < max_elem) then
max_elem = e_val(i)
endif
!print*,'e_val < 0 :', e_val(i)
endif
enddo
print*,'Number of negative eigenvalues:', nb_negative_vp
print*,'Lowest eigenvalue:',max_elem
!nb_negative_vp = 0
!do i = 1, n
! if (e_val(i) < -thresh_eig) then
! nb_negative_vp = nb_negative_vp + 1
! endif
!enddo
!print*,'Number of negative eigenvalues <', -thresh_eig,':', nb_negative_vp
! Deallocation
deallocate(work)
elseif (optimization_method == 'diag') then
! Diagonalization of the diagonal hessian by hands
allocate(key(n))
do i = 1, n
e_val(i) = H(i,i)
enddo
! Key list for dsort
do i = 1, n
key(i) = i
enddo
! Sort of the eigenvalues
call dsort(e_val, key, n)
! Eigenvectors
W = 0d0
do i = 1, n
j = key(i)
W(j,i) = 1d0
enddo
deallocate(key)
else
print*,'Diagonalization_hessian, abort'
call abort
endif
call wall_time(t2)
t3 = t2 - t1
print*,'Time in diagonalization_hessian:', t3
print*,'---End diagonalization_hessian---'
end subroutine

372
src/mo_optimization/first_diagonal_hessian_list_opt.irp.f Normal file
View File

@ -0,0 +1,372 @@
subroutine first_diag_hessian_list_opt(tmp_n,m,list,H)!, h_tmpr)
include 'constants.h'
implicit none
!===========================================================================
! Compute the diagonal hessian of energy with respects to orbital rotations
!===========================================================================
!===========
! Variables
!===========
! in
integer, intent(in) :: tmp_n, m, list(m)
! tmp_n : integer, tmp_n = m*(m-1)/2
! out
double precision, intent(out) :: H(tmp_n)!, h_tmpr(m,m,m,m)
! H : n by n double precision matrix containing the 2D hessian
! internal
double precision, allocatable :: hessian(:,:,:,:), tmp(:,:),h_tmpr(:,:,:,:)
integer :: p,q, tmp_p,tmp_q
integer :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
integer :: pq,rs,tmp_pq,tmp_rs
double precision :: t1,t2,t3
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
! p,q,r,s : integer, indexes of the 4D hessian matrix
! t,u,v : integer, indexes to compute hessian elements
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
! Function
double precision :: get_two_e_integral
! get_two_e_integral : double precision function, two e integrals
! Provided :
! mo_one_e_integrals : mono e- integrals
! get_two_e_integral : two e- integrals
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
! two_e_dm_mo : two body density matrix
print*,'---first_diag_hess_list---'
!============
! Allocation
!============
allocate(hessian(m,m,m,m),tmp(tmp_n,tmp_n),h_tmpr(mo_num,mo_num,mo_num,mo_num))
!=============
! Calculation
!=============
! From Anderson et. al. (2014)
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
! LaTeX formula :
!\begin{align*}
!H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
!&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u)
!+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
!-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
!&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv})
!+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
!&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs} \Gamma_{ps}^{uv}) \\
!&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts})
!\end{align*}
!================
! Initialization
!================
hessian = 0d0
CALL wall_time(t1)
!========================
! First line, first term
!========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
if (q==r) then
do u = 1, mo_num
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
enddo
endif
endif
enddo
enddo
enddo
enddo
!=========================
! First line, second term
!=========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
if (p==s) then
do u = 1, mo_num
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
enddo
endif
endif
enddo
enddo
enddo
enddo
!========================
! First line, third term
!========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
endif
enddo
enddo
enddo
enddo
!=========================
! Second line, first term
!=========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
if (q==r) then
do t = 1, mo_num
do u = 1, mo_num
do v = 1, mo_num
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
enddo
enddo
enddo
endif
endif
enddo
enddo
enddo
enddo
!==========================
! Second line, second term
!==========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
if (p==s) then
do t = 1, mo_num
do u = 1, mo_num
do v = 1, mo_num
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
enddo
enddo
enddo
endif
endif
enddo
enddo
enddo
enddo
!========================
! Third line, first term
!========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
do u = 1, mo_num
do v = 1, mo_num
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
enddo
enddo
endif
enddo
enddo
enddo
enddo
!=========================
! Third line, second term
!=========================
do tmp_p = 1, m
p = list(tmp_p)
do tmp_q = 1, m
q = list(tmp_q)
do tmp_r = 1, m
r = list(tmp_r)
do tmp_s = 1, m
s = list(tmp_s)
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
do t = 1, mo_num
do u = 1, mo_num
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
enddo
enddo
endif
enddo
enddo
enddo
enddo
CALL wall_time(t2)
t2 = t2 - t1
print*, 'Time to compute the hessian :', t2
!==============
! Permutations
!==============
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
! H(pq,rs) : p<q and r<s
do tmp_r = 1, m
do tmp_s = 1, m
do tmp_q = 1, m
do tmp_p = 1, m
h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
- hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r)
enddo
enddo
enddo
enddo
!========================
! 4D matrix -> 2D matrix
!========================
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
! H(pq,rs) : p<q and r<s
! 4D mo_num matrix to 2D n matrix
do tmp_rs = 1, tmp_n
call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
do tmp_pq = 1, tmp_n
call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
tmp(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)
enddo
enddo
do p = 1, tmp_n
H(p) = tmp(p,p)
enddo
! Display
if (debug) then
print*,'2D diag Hessian matrix'
do tmp_pq = 1, tmp_n
write(*,'(100(F10.5))') tmp(tmp_pq,:)
enddo
endif
!==============
! Deallocation
!==============
deallocate(hessian,h_tmpr,tmp)
print*,'---End first_diag_hess_list---'
end subroutine

344
src/mo_optimization/first_diagonal_hessian_opt.irp.f Normal file
View File

@ -0,0 +1,344 @@
subroutine first_diag_hessian_opt(n,H, h_tmpr)
include 'constants.h'
implicit none
!===========================================================================
! Compute the diagonal hessian of energy with respects to orbital rotations
!===========================================================================
!===========
! Variables
!===========
! in
integer, intent(in) :: n
! n : integer, n = mo_num*(mo_num-1)/2
! out
double precision, intent(out) :: H(n,n), h_tmpr(mo_num,mo_num,mo_num,mo_num)
! H : n by n double precision matrix containing the 2D hessian
! internal
double precision, allocatable :: hessian(:,:,:,:)
integer :: p,q
integer :: r,s,t,u,v
integer :: pq,rs
double precision :: t1,t2,t3
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
! p,q,r,s : integer, indexes of the 4D hessian matrix
! t,u,v : integer, indexes to compute hessian elements
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
! Function
double precision :: get_two_e_integral
! get_two_e_integral : double precision function, two e integrals
! Provided :
! mo_one_e_integrals : mono e- integrals
! get_two_e_integral : two e- integrals
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
! two_e_dm_mo : two body density matrix
!============
! Allocation
!============
allocate(hessian(mo_num,mo_num,mo_num,mo_num))!,h_tmpr(mo_num,mo_num,mo_num,mo_num))
!=============
! Calculation
!=============
if (debug) then
print*,'Enter in first_diag_hessien'
endif
! From Anderson et. al. (2014)
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
! LaTeX formula :
!\begin{align*}
!H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
!&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u)
!+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
!-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
!&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv})
!+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
!&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs} \Gamma_{ps}^{uv}) \\
!&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts})
!\end{align*}
!================
! Initialization
!================
hessian = 0d0
CALL wall_time(t1)
!========================
! First line, first term
!========================
do p = 1, mo_num
do q = 1, mo_num
do r = 1, mo_num
do s = 1, mo_num
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
if (q==r) then
do u = 1, mo_num
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
enddo
endif
endif
enddo
enddo
enddo
enddo
!=========================
! First line, second term
!=========================
do p = 1, mo_num
do q = 1, mo_num
do r = 1, mo_num
do s = 1, mo_num
! Permutations
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
.or. ((p==s) .and. (q==r))) then
if (p==s) then
do u = 1, mo_num
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
enddo
endif
endif
enddo
enddo
enddo
enddo
!========================
! First line, third term
!========================
do p = 1, mo_num
do q = 1, mo_num
do r = 1, mo_num
do s = 1, mo_num
! Permutations