mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-11 22:23:31 +01:00
add mo optimization
This commit is contained in:
parent
d6f7ec60f8
commit
b71888f459
62
src/mo_optimization/83.mo_optimization.bats
Normal file
62
src/mo_optimization/83.mo_optimization.bats
Normal 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
29
src/mo_optimization/EZFIO.cfg
Normal 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
7
src/mo_optimization/NEED
Normal 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
74
src/mo_optimization/README.md
Normal 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
12
src/mo_optimization/class.irp.f
Normal 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
1
src/mo_optimization/constants.h
Normal file
@ -0,0 +1 @@
|
||||
logical, parameter :: debug=.False.
|
78
src/mo_optimization/debug_gradient_list_opt.irp.f
Normal file
78
src/mo_optimization/debug_gradient_list_opt.irp.f
Normal 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
76
src/mo_optimization/debug_gradient_opt.irp.f
Normal 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
147
src/mo_optimization/debug_hessian_list_opt.irp.f
Normal 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
171
src/mo_optimization/debug_hessian_opt.irp.f
Normal 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
1556
src/mo_optimization/diagonal_hessian_list_opt.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
1511
src/mo_optimization/diagonal_hessian_opt.irp.f
Normal file
1511
src/mo_optimization/diagonal_hessian_opt.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
136
src/mo_optimization/diagonalization_hessian.irp.f
Normal file
136
src/mo_optimization/diagonalization_hessian.irp.f
Normal 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
372
src/mo_optimization/first_diagonal_hessian_list_opt.irp.f
Normal 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
344
src/mo_optimization/first_diagonal_hessian_opt.irp.f
Normal 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
|
||||