mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-01 21:53:40 +02:00
Merge branch 'dev' of github.com:QuantumPackage/qp2 into dev
This commit is contained in:
commit
099c4385d1
@ -174,9 +174,6 @@ BEGIN_PROVIDER [integer, n_core_inact_act_orb ]
|
|||||||
n_core_inact_act_orb = (n_core_orb + n_inact_orb + n_act_orb)
|
n_core_inact_act_orb = (n_core_orb + n_inact_orb + n_act_orb)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ]
|
BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -444,4 +441,3 @@ BEGIN_PROVIDER [integer, list_all_but_del_orb, (n_all_but_del_orb)]
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -255,23 +255,24 @@ void generateAllBFs(int64_t Isomo, int64_t MS, Tree *bftree, int *NBF, int *NSOM
|
|||||||
|
|
||||||
void ortho_qr_csf(double *overlapMatrix, int lda, double *orthoMatrix, int rows, int cols);
|
void ortho_qr_csf(double *overlapMatrix, int lda, double *orthoMatrix, int rows, int cols);
|
||||||
|
|
||||||
void gramSchmidt_qp(double *overlapMatrix, int rows, int cols, double *orthoMatrix){
|
// QR to orthogonalize CSFs does not work
|
||||||
int i,j;
|
//void gramSchmidt_qp(double *overlapMatrix, int rows, int cols, double *orthoMatrix){
|
||||||
//for(j=0;j<cols;++j){
|
// int i,j;
|
||||||
// for(i=0;i<rows;++i){
|
// //for(j=0;j<cols;++j){
|
||||||
// printf(" %3.2f ",overlapMatrix[j*rows + i]);
|
// // for(i=0;i<rows;++i){
|
||||||
// }
|
// // printf(" %3.2f ",overlapMatrix[j*rows + i]);
|
||||||
// printf("\n");
|
// // }
|
||||||
//}
|
// // printf("\n");
|
||||||
// Call the function ortho_qr from qp
|
// //}
|
||||||
ortho_qr_csf(overlapMatrix, rows, orthoMatrix, rows, cols);
|
// // Call the function ortho_qr from qp
|
||||||
//for(j=0;j<cols;++j){
|
// ortho_qr_csf(overlapMatrix, rows, orthoMatrix, rows, cols);
|
||||||
// for(i=0;i<rows;++i){
|
// //for(j=0;j<cols;++j){
|
||||||
// printf(" %3.2f ",orthoMatrix[j*rows + i]);
|
// // for(i=0;i<rows;++i){
|
||||||
// }
|
// // printf(" %3.2f ",orthoMatrix[j*rows + i]);
|
||||||
// printf("\n");
|
// // }
|
||||||
//}
|
// // printf("\n");
|
||||||
}
|
// //}
|
||||||
|
//}
|
||||||
|
|
||||||
void gramSchmidt(double *overlapMatrix, int rows, int cols, double *orthoMatrix){
|
void gramSchmidt(double *overlapMatrix, int rows, int cols, double *orthoMatrix){
|
||||||
|
|
||||||
|
@ -112,7 +112,7 @@
|
|||||||
! endif
|
! endif
|
||||||
!enddo
|
!enddo
|
||||||
n_CSF = 0
|
n_CSF = 0
|
||||||
print *," -9(((((((((((((( NSOMOMin=",NSOMOMin
|
!print *," -9(((((((((((((( NSOMOMin=",NSOMOMin
|
||||||
ncfgprev = cfg_seniority_index(NSOMOMin) ! can be -1
|
ncfgprev = cfg_seniority_index(NSOMOMin) ! can be -1
|
||||||
if(ncfgprev.eq.-1)then
|
if(ncfgprev.eq.-1)then
|
||||||
ncfgprev=1
|
ncfgprev=1
|
||||||
@ -145,10 +145,10 @@
|
|||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
n_CSF += ncfg*dimcsfpercfg
|
n_CSF += ncfg*dimcsfpercfg
|
||||||
print *," i=",i," dimcsf=",dimcsfpercfg," ncfg=",ncfg, " ncfgprev=",ncfgprev, " senor=",cfg_seniority_index(i)
|
!print *," i=",i," dimcsf=",dimcsfpercfg," ncfg=",ncfg, " ncfgprev=",ncfgprev, " senor=",cfg_seniority_index(i)
|
||||||
ncfgprev = cfg_seniority_index(i+2)
|
ncfgprev = cfg_seniority_index(i+2)
|
||||||
end do
|
end do
|
||||||
print *," ^^^^^ N_CSF = ",n_CSF," N_CFG=",N_configuration
|
!print *," ^^^^^ N_CSF = ",n_CSF," N_CFG=",N_configuration
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -240,7 +240,7 @@ end subroutine get_phase_qp_to_cfg
|
|||||||
! initialization
|
! initialization
|
||||||
psi_coef_config = 0.d0
|
psi_coef_config = 0.d0
|
||||||
DetToCSFTransformationMatrix(0,:,:) = 1.d0
|
DetToCSFTransformationMatrix(0,:,:) = 1.d0
|
||||||
do i = 2-iand(MS,1), NSOMOMax,2
|
do i = 2-iand(MS,1_8), NSOMOMax,2
|
||||||
Isomo = IBSET(0_8, i) - 1_8
|
Isomo = IBSET(0_8, i) - 1_8
|
||||||
! rows = Ncsfs
|
! rows = Ncsfs
|
||||||
! cols = Ndets
|
! cols = Ndets
|
||||||
@ -342,8 +342,8 @@ end subroutine get_phase_qp_to_cfg
|
|||||||
nsomomin = elec_alpha_num-elec_beta_num
|
nsomomin = elec_alpha_num-elec_beta_num
|
||||||
rowsmax = 0
|
rowsmax = 0
|
||||||
colsmax = 0
|
colsmax = 0
|
||||||
print *,"NSOMOMax = ",NSOMOMax
|
!print *,"NSOMOMax = ",NSOMOMax
|
||||||
print *,"NSOMOMin = ",NSOMOMin
|
!print *,"NSOMOMin = ",NSOMOMin
|
||||||
!allocate(AIJpqMatrixDimsList(NSOMOMax,NSOMOMax,4,NSOMOMax,NSOMOMax,2))
|
!allocate(AIJpqMatrixDimsList(NSOMOMax,NSOMOMax,4,NSOMOMax,NSOMOMax,2))
|
||||||
! Type
|
! Type
|
||||||
! 1. SOMO -> SOMO
|
! 1. SOMO -> SOMO
|
||||||
@ -525,7 +525,7 @@ end subroutine get_phase_qp_to_cfg
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
print *,"Rowsmax=",rowsmax," Colsmax=",colsmax
|
!print *,"Rowsmax=",rowsmax," Colsmax=",colsmax
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ real*8, AIJpqContainer, (NBFMax,NBFmax,NSOMOMax+1,NSOMOMax+1,4,NSOMOMin:NSOMOMax)]
|
BEGIN_PROVIDER [ real*8, AIJpqContainer, (NBFMax,NBFmax,NSOMOMax+1,NSOMOMax+1,4,NSOMOMin:NSOMOMax)]
|
||||||
|
54
src/mo_localization/EZFIO.cfg
Normal file
54
src/mo_localization/EZFIO.cfg
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
[localization_method]
|
||||||
|
type: character*(32)
|
||||||
|
doc: Method for the orbital localization. boys : Foster-Boys, pipek : Pipek-Mezey.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: boys
|
||||||
|
|
||||||
|
[localization_max_nb_iter]
|
||||||
|
type: integer
|
||||||
|
doc: Maximal number of iterations for the orbital localization.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1000
|
||||||
|
|
||||||
|
[localization_use_hessian]
|
||||||
|
type: logical
|
||||||
|
doc: If true, it uses the trust region algorithm with the gradient and the diagonal of the hessian. Else it computes the rotation between each pair of MOs that should be applied to maximize/minimize the localization criterion. The last option requieres a way smaller amount of memory but is not easy to converge.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: true
|
||||||
|
|
||||||
|
[security_mo_class]
|
||||||
|
type: logical
|
||||||
|
doc: If true, call abort if the number of active orbital or the number of core + active orbitals is equal to the number of molecular orbitals, else uses the actual mo_class. It is a security if you forget to set the mo_class before the localization.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: true
|
||||||
|
|
||||||
|
[thresh_loc_max_elem_grad]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold for the convergence, the localization exits when the largest element in the gradient is smaller than thresh_localization_max_elem_grad.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-6
|
||||||
|
|
||||||
|
[kick_in_mos]
|
||||||
|
type: logical
|
||||||
|
doc: If True, it applies a rotation of an angle angle_pre_rot between the MOs of a same mo_class before the localization.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: true
|
||||||
|
|
||||||
|
[angle_pre_rot]
|
||||||
|
type: double precision
|
||||||
|
doc: To define the angle for the rotation of the MOs before the localization (in rad).
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.1
|
||||||
|
|
||||||
|
[sort_mos_by_e]
|
||||||
|
type: logical
|
||||||
|
doc: If True, the MOs are sorted using the diagonal elements of the Fock matrix.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: false
|
||||||
|
|
||||||
|
[debug_hf]
|
||||||
|
type: logical
|
||||||
|
doc: If True, prints the HF energy before/after the different steps of the localization. Only for debugging.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: false
|
||||||
|
|
2
src/mo_localization/NEED
Normal file
2
src/mo_localization/NEED
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
hartree_fock
|
||||||
|
utils_trust_region
|
108
src/mo_localization/README.md
Normal file
108
src/mo_localization/README.md
Normal file
@ -0,0 +1,108 @@
|
|||||||
|
# mo_localization
|
||||||
|
|
||||||
|
Some parameters can be changed with qp edit in the mo_localization section
|
||||||
|
(cf below). Similarly for the trust region parameters in the
|
||||||
|
utils_trust_region section. The localization without the trust region
|
||||||
|
is not available for the moment.
|
||||||
|
|
||||||
|
The irf.f files can be generated from the org ones using emacs.
|
||||||
|
If you modify the .org files, don't forget to do (you need emacs):
|
||||||
|
```
|
||||||
|
./TANGLE_org_mode.sh
|
||||||
|
ninja
|
||||||
|
```
|
||||||
|
|
||||||
|
# Orbital localisation
|
||||||
|
To localize the MOs:
|
||||||
|
```
|
||||||
|
qp run localization
|
||||||
|
```
|
||||||
|
After that the ezfio directory contains the localized MOs
|
||||||
|
|
||||||
|
But to do so the mo_class must be defined before, run
|
||||||
|
```
|
||||||
|
qp set_mo_class -q
|
||||||
|
```
|
||||||
|
for more information or
|
||||||
|
```
|
||||||
|
qp set_mo_class -c [] -a [] -v [] -i [] -d []
|
||||||
|
```
|
||||||
|
to set the mo classes. We don't care about the name of the
|
||||||
|
mo classes. The algorithm just localizes all the MOs of
|
||||||
|
a given class between them, for all the classes, except the deleted MOs.
|
||||||
|
|
||||||
|
If you just on kind of mo class to localize all the MOs between them
|
||||||
|
you have to put:
|
||||||
|
```
|
||||||
|
qp set mo_localization security_mo_class false
|
||||||
|
```
|
||||||
|
|
||||||
|
Before the localization, a kick is done for each mo class
|
||||||
|
(except the deleted ones) to break the MOs. This is done by
|
||||||
|
doing a rotation between the MOs.
|
||||||
|
This feature can be removed by setting:
|
||||||
|
```
|
||||||
|
qp set mo_localization kick_in_mos false
|
||||||
|
```
|
||||||
|
and the default angle for the rotation can be changed with:
|
||||||
|
```
|
||||||
|
qp set mo_localization angle_pre_rot 1e-3 # or something else
|
||||||
|
```
|
||||||
|
|
||||||
|
After the localization, the MOs of each class (except the deleted ones)
|
||||||
|
can be sorted between them using the diagonal elements of
|
||||||
|
the fock matrix with:
|
||||||
|
```
|
||||||
|
qp set mo_localization sort_mos_by_e true
|
||||||
|
```
|
||||||
|
|
||||||
|
You can check the Hartree-Fock energy before/during/after the localization
|
||||||
|
by putting (only for debugging):
|
||||||
|
```
|
||||||
|
qp set mo_localization debug_hf true
|
||||||
|
```
|
||||||
|
|
||||||
|
## Foster-Boys & Pipek-Mezey
|
||||||
|
Foster-Boys:
|
||||||
|
```
|
||||||
|
qp set mo_localization localization_method boys
|
||||||
|
```
|
||||||
|
|
||||||
|
Pipek-Mezey:
|
||||||
|
```
|
||||||
|
qp set mo_localization localization_method pipek
|
||||||
|
```
|
||||||
|
|
||||||
|
# Break the spatial symmetry of the MOs
|
||||||
|
To break the spatial symmetry of the MOs:
|
||||||
|
```
|
||||||
|
qp run break_spatial_sym
|
||||||
|
```
|
||||||
|
The default angle for the rotations is too big for this kind of
|
||||||
|
application, a value between 1e-3 and 1e-6 should break the spatial
|
||||||
|
symmetry with just a small change in the energy:
|
||||||
|
```
|
||||||
|
qp set mo_localization angle_pre_rot 1e-3
|
||||||
|
```
|
||||||
|
|
||||||
|
# With or without hessian + trust region
|
||||||
|
With hessian + trust region
|
||||||
|
```
|
||||||
|
qp set mo_localization localisation_use_hessian true
|
||||||
|
```
|
||||||
|
It uses the trust region algorithm with the diagonal of the hessian of the
|
||||||
|
localization criterion with respect to the MO rotations.
|
||||||
|
|
||||||
|
Without the hessian and the trust region
|
||||||
|
```
|
||||||
|
qp set mo_localization localisation_use_hessian false
|
||||||
|
```
|
||||||
|
By doing so it does not require to store the hessian but the
|
||||||
|
convergence is not easy, in particular for virtual MOs.
|
||||||
|
It seems that it not possible to converge with Pipek-Mezey
|
||||||
|
localization with this approach.
|
||||||
|
|
||||||
|
# Further improvements:
|
||||||
|
- Cleaner repo
|
||||||
|
- Correction of the errors in the documentations
|
||||||
|
- option with/without trust region
|
7
src/mo_localization/TANGLE_org_mode.sh
Executable file
7
src/mo_localization/TANGLE_org_mode.sh
Executable file
@ -0,0 +1,7 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
list='ls *.org'
|
||||||
|
for element in $list
|
||||||
|
do
|
||||||
|
emacs --batch $element -f org-babel-tangle
|
||||||
|
done
|
42
src/mo_localization/break_spatial_sym.irp.f
Normal file
42
src/mo_localization/break_spatial_sym.irp.f
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
! ! A small program to break the spatial symmetry of the MOs.
|
||||||
|
|
||||||
|
! ! You have to defined your MO classes or set security_mo_class to false
|
||||||
|
! ! with:
|
||||||
|
! ! qp set orbital_optimization security_mo_class false
|
||||||
|
|
||||||
|
! ! The default angle for the rotations is too big for this kind of
|
||||||
|
! ! application, a value between 1e-3 and 1e-6 should break the spatial
|
||||||
|
! ! symmetry with just a small change in the energy.
|
||||||
|
|
||||||
|
|
||||||
|
program break_spatial_sym
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Break the symmetry of the MOs with a rotation
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
print*, 'Security mo_class:', security_mo_class
|
||||||
|
|
||||||
|
! The default mo_classes are setted only if the MOs to localize are not specified
|
||||||
|
if (security_mo_class .and. (dim_list_act_orb == mo_num .or. &
|
||||||
|
dim_list_core_orb + dim_list_act_orb == mo_num)) then
|
||||||
|
|
||||||
|
print*, 'WARNING'
|
||||||
|
print*, 'You must set different mo_class with qp set_mo_class'
|
||||||
|
print*, 'If you want to kick all the orbitals:'
|
||||||
|
print*, 'qp set orbital_optimization security_mo_class false'
|
||||||
|
print*, ''
|
||||||
|
print*, 'abort'
|
||||||
|
|
||||||
|
call abort
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
call apply_pre_rotation
|
||||||
|
|
||||||
|
end
|
43
src/mo_localization/break_spatial_sym.org
Normal file
43
src/mo_localization/break_spatial_sym.org
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
! A small program to break the spatial symmetry of the MOs.
|
||||||
|
|
||||||
|
! You have to defined your MO classes or set security_mo_class to false
|
||||||
|
! with:
|
||||||
|
! qp set orbital_optimization security_mo_class false
|
||||||
|
|
||||||
|
! The default angle for the rotations is too big for this kind of
|
||||||
|
! application, a value between 1e-3 and 1e-6 should break the spatial
|
||||||
|
! symmetry with just a small change in the energy.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle break_spatial_sym.irp.f
|
||||||
|
program break_spatial_sym
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Break the symmetry of the MOs with a rotation
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
print*, 'Security mo_class:', security_mo_class
|
||||||
|
|
||||||
|
! The default mo_classes are setted only if the MOs to localize are not specified
|
||||||
|
if (security_mo_class .and. (dim_list_act_orb == mo_num .or. &
|
||||||
|
dim_list_core_orb + dim_list_act_orb == mo_num)) then
|
||||||
|
|
||||||
|
print*, 'WARNING'
|
||||||
|
print*, 'You must set different mo_class with qp set_mo_class'
|
||||||
|
print*, 'If you want to kick all the orbitals:'
|
||||||
|
print*, 'qp set orbital_optimization security_mo_class false'
|
||||||
|
print*, ''
|
||||||
|
print*, 'abort'
|
||||||
|
|
||||||
|
call abort
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
call apply_pre_rotation
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
62
src/mo_localization/debug_gradient_loc.irp.f
Normal file
62
src/mo_localization/debug_gradient_loc.irp.f
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
program debug_gradient_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the gradient is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
double precision :: norm, max_elem, threshold, max_error
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(v_grad(n),v_grad2(n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call gradient_FB(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_FB_omp(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
elseif (localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call gradient_PM(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_PM(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,v_grad(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(v_grad(i)) > threshold) then
|
||||||
|
print*,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(v_grad(i)) > max_elem) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end
|
64
src/mo_localization/debug_gradient_loc.org
Normal file
64
src/mo_localization/debug_gradient_loc.org
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_gradient_loc.irp.f
|
||||||
|
program debug_gradient_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the gradient is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
double precision :: norm, max_elem, threshold, max_error
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(v_grad(n),v_grad2(n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call gradient_FB(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_FB_omp(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
elseif (localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call gradient_PM(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_PM(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,v_grad(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(v_grad(i)) > threshold) then
|
||||||
|
print*,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(v_grad(i)) > max_elem) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
62
src/mo_localization/debug_hessian_loc.irp.f
Normal file
62
src/mo_localization/debug_hessian_loc.irp.f
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
program debug_hessian_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the hessian is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: H(:,:), H2(:,:)
|
||||||
|
double precision :: threshold, max_error, max_elem
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(H(n,n),H2(n,n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call hessian_FB(n,list_size,list,H)
|
||||||
|
call hessian_FB_omp(n,list_size,list,H2)
|
||||||
|
elseif(localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call hessian_PM(n,list_size,list,H)
|
||||||
|
call hessian_PM(n,list_size,list,H2)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,H(i,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
H = H - H2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(H(i,i)) > threshold) then
|
||||||
|
print*,H(i,i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(H(i,i)) > max_elem) then
|
||||||
|
max_elem = H(i,i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(H,H2)
|
||||||
|
|
||||||
|
end
|
64
src/mo_localization/debug_hessian_loc.org
Normal file
64
src/mo_localization/debug_hessian_loc.org
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_hessian_loc.irp.f
|
||||||
|
program debug_hessian_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the hessian is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: H(:,:), H2(:,:)
|
||||||
|
double precision :: threshold, max_error, max_elem
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(H(n,n),H2(n,n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call hessian_FB(n,list_size,list,H)
|
||||||
|
call hessian_FB_omp(n,list_size,list,H2)
|
||||||
|
elseif(localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call hessian_PM(n,list_size,list,H)
|
||||||
|
call hessian_PM(n,list_size,list,H2)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,H(i,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
H = H - H2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(H(i,i)) > threshold) then
|
||||||
|
print*,H(i,i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(H(i,i)) > max_elem) then
|
||||||
|
max_elem = H(i,i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(H,H2)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
31
src/mo_localization/kick_the_mos.irp.f
Normal file
31
src/mo_localization/kick_the_mos.irp.f
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
program kick_the_mos
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! To do a small rotation of the MOs
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
print*, 'Security mo_class:', security_mo_class
|
||||||
|
|
||||||
|
! The default mo_classes are setted only if the MOs to localize are not specified
|
||||||
|
if (security_mo_class .and. (dim_list_act_orb == mo_num .or. &
|
||||||
|
dim_list_core_orb + dim_list_act_orb == mo_num)) then
|
||||||
|
|
||||||
|
print*, 'WARNING'
|
||||||
|
print*, 'You must set different mo_class with qp set_mo_class'
|
||||||
|
print*, 'If you want to kick all the orbital:'
|
||||||
|
print*, 'qp set Orbital_optimization security_mo_class false'
|
||||||
|
print*, ''
|
||||||
|
print*, 'abort'
|
||||||
|
|
||||||
|
call abort
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
call apply_pre_rotation
|
||||||
|
|
||||||
|
end
|
33
src/mo_localization/kick_the_mos.org
Normal file
33
src/mo_localization/kick_the_mos.org
Normal file
@ -0,0 +1,33 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle kick_the_mos.irp.f
|
||||||
|
program kick_the_mos
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! To do a small rotation of the MOs
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
print*, 'Security mo_class:', security_mo_class
|
||||||
|
|
||||||
|
! The default mo_classes are setted only if the MOs to localize are not specified
|
||||||
|
if (security_mo_class .and. (dim_list_act_orb == mo_num .or. &
|
||||||
|
dim_list_core_orb + dim_list_act_orb == mo_num)) then
|
||||||
|
|
||||||
|
print*, 'WARNING'
|
||||||
|
print*, 'You must set different mo_class with qp set_mo_class'
|
||||||
|
print*, 'If you want to kick all the orbital:'
|
||||||
|
print*, 'qp set Orbital_optimization security_mo_class false'
|
||||||
|
print*, ''
|
||||||
|
print*, 'abort'
|
||||||
|
|
||||||
|
call abort
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
call apply_pre_rotation
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
531
src/mo_localization/localization.irp.f
Normal file
531
src/mo_localization/localization.irp.f
Normal file
@ -0,0 +1,531 @@
|
|||||||
|
program localization
|
||||||
|
call run_localization
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Variables:
|
||||||
|
! | pre_rot(mo_num, mo_num) | double precision | Matrix for the pre rotation |
|
||||||
|
! | R(mo_num,mo_num) | double precision | Rotation matrix |
|
||||||
|
! | tmp_R(:,:) | double precision | Rottation matrix in a subsapce |
|
||||||
|
! | prev_mos(ao_num, mo_num) | double precision | Previous mo_coef |
|
||||||
|
! | spatial_extent(mo_num) | double precision | Spatial extent of the orbitals |
|
||||||
|
! | criterion | double precision | Localization criterion |
|
||||||
|
! | prev_criterion | double precision | Previous criterion |
|
||||||
|
! | criterion_model | double precision | Estimated next criterion |
|
||||||
|
! | rho | double precision | Ratio to measure the agreement between the model |
|
||||||
|
! | | | and the reality |
|
||||||
|
! | delta | double precision | Radisu of the trust region |
|
||||||
|
! | norm_grad | double precision | Norm of the gradient |
|
||||||
|
! | info | integer | for dsyev from Lapack |
|
||||||
|
! | max_elem | double precision | maximal element in the gradient |
|
||||||
|
! | v_grad(:) | double precision | Gradient |
|
||||||
|
! | H(:,:) | double precision | Hessian (diagonal) |
|
||||||
|
! | e_val(:) | double precision | Eigenvalues of the hessian |
|
||||||
|
! | W(:,:) | double precision | Eigenvectors of the hessian |
|
||||||
|
! | tmp_x(:) | double precision | Step in 1D (in a subaspace) |
|
||||||
|
! | tmp_m_x(:,:) | double precision | Step in 2D (in a subaspace) |
|
||||||
|
! | tmp_list(:) | double precision | List of MOs in a mo_class |
|
||||||
|
! | i,j,k | integer | Indexes in the full MO space |
|
||||||
|
! | tmp_i, tmp_j, tmp_k | integer | Indexes in a subspace |
|
||||||
|
! | l | integer | Index for the mo_class |
|
||||||
|
! | key(:) | integer | Key to sort the eigenvalues of the hessian |
|
||||||
|
! | nb_iter | integer | Number of iterations |
|
||||||
|
! | must_exit | logical | To exit the trust region loop |
|
||||||
|
! | cancel_step | logical | To cancel a step |
|
||||||
|
! | not_*converged | logical | To localize the different mo classes |
|
||||||
|
! | t* | double precision | To measure the time |
|
||||||
|
! | n | integer | mo_num*(mo_num-1)/2, number of orbital parameters |
|
||||||
|
! | tmp_n | integer | dim_subspace*(dim_subspace-1)/2 |
|
||||||
|
! | | | Number of dimension in the subspace |
|
||||||
|
|
||||||
|
! Variables in qp_edit for the localization:
|
||||||
|
! | localization_method |
|
||||||
|
! | localization_max_nb_iter |
|
||||||
|
! | default_mo_class |
|
||||||
|
! | thresh_loc_max_elem_grad |
|
||||||
|
! | kick_in_mos |
|
||||||
|
! | angle_pre_rot |
|
||||||
|
|
||||||
|
! + all the variables for the trust region
|
||||||
|
|
||||||
|
! Cf. qp_edit orbital optimization
|
||||||
|
|
||||||
|
|
||||||
|
subroutine run_localization
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Orbital localization
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
double precision, allocatable :: pre_rot(:,:), R(:,:)
|
||||||
|
double precision, allocatable :: prev_mos(:,:), spatial_extent(:), tmp_R(:,:)
|
||||||
|
double precision :: criterion, norm_grad
|
||||||
|
integer :: i,j,k,l,p, tmp_i, tmp_j, tmp_k
|
||||||
|
integer :: info
|
||||||
|
integer :: n, tmp_n, tmp_list_size
|
||||||
|
double precision, allocatable :: v_grad(:), H(:,:), tmp_m_x(:,:), tmp_x(:),W(:,:),e_val(:)
|
||||||
|
double precision :: max_elem, t1, t2, t3, t4, t5, t6
|
||||||
|
integer, allocatable :: tmp_list(:), key(:)
|
||||||
|
double precision :: prev_criterion, rho, delta, criterion_model
|
||||||
|
integer :: nb_iter, nb_sub_iter
|
||||||
|
logical :: not_converged, not_core_converged
|
||||||
|
logical :: not_act_converged, not_inact_converged, not_virt_converged
|
||||||
|
logical :: use_trust_region, must_exit, cancel_step,enforce_step_cancellation
|
||||||
|
|
||||||
|
n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(spatial_extent(mo_num))
|
||||||
|
allocate(pre_rot(mo_num, mo_num), R(mo_num, mo_num))
|
||||||
|
allocate(prev_mos(ao_num, mo_num))
|
||||||
|
|
||||||
|
! Locality before the localization
|
||||||
|
call compute_spatial_extent(spatial_extent)
|
||||||
|
|
||||||
|
! Choice of the method (with qp_edit)
|
||||||
|
print*,''
|
||||||
|
print*,'Localization method:',localization_method
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys localization'
|
||||||
|
elseif (localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey localization'
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Localization criterion (FB, PM, ...) for each mo_class
|
||||||
|
print*,'### Before the pre rotation'
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
do l = 1, 4
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list_size = dim_list_core_orb
|
||||||
|
elseif (l==2) then ! act
|
||||||
|
tmp_list_size = dim_list_act_orb
|
||||||
|
elseif (l==3) then ! inact
|
||||||
|
tmp_list_size = dim_list_inact_orb
|
||||||
|
else ! virt
|
||||||
|
tmp_list_size = dim_list_virt_orb
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Allocation tmp array
|
||||||
|
allocate(tmp_list(tmp_list_size))
|
||||||
|
|
||||||
|
! To give the list of MOs in a mo_class
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list = list_core
|
||||||
|
elseif (l==2) then
|
||||||
|
tmp_list = list_act
|
||||||
|
elseif (l==3) then
|
||||||
|
tmp_list = list_inact
|
||||||
|
else
|
||||||
|
tmp_list = list_virt
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (tmp_list_size >= 2) then
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list,criterion)
|
||||||
|
print*,'Criterion:', criterion, mo_class(tmp_list(1))
|
||||||
|
endif
|
||||||
|
|
||||||
|
deallocate(tmp_list)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!print*,'HF', HF_energy
|
||||||
|
|
||||||
|
print*, 'Security mo_class:', security_mo_class
|
||||||
|
|
||||||
|
! The default mo_classes are setted only if the MOs to localize are not specified
|
||||||
|
if (security_mo_class .and. (n_act_orb == mo_num .or. &
|
||||||
|
n_core_orb + n_act_orb == mo_num)) then
|
||||||
|
|
||||||
|
print*, 'WARNING'
|
||||||
|
print*, 'You must set different mo_class with qp set_mo_class'
|
||||||
|
print*, 'If you want to localize all the orbitals:'
|
||||||
|
print*, 'qp set Orbital_optimization security_mo_class false'
|
||||||
|
print*, ''
|
||||||
|
print*, 'abort'
|
||||||
|
|
||||||
|
call abort
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Loc
|
||||||
|
|
||||||
|
! Pre rotation, to give a little kick in the MOs
|
||||||
|
call apply_pre_rotation()
|
||||||
|
|
||||||
|
! Criterion after the pre rotation
|
||||||
|
! Localization criterion (FB, PM, ...) for each mo_class
|
||||||
|
print*,'### After the pre rotation'
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
touch mo_coef
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
do l = 1, 4
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list_size = dim_list_core_orb
|
||||||
|
elseif (l==2) then ! act
|
||||||
|
tmp_list_size = dim_list_act_orb
|
||||||
|
elseif (l==3) then ! inact
|
||||||
|
tmp_list_size = dim_list_inact_orb
|
||||||
|
else ! virt
|
||||||
|
tmp_list_size = dim_list_virt_orb
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (tmp_list_size >= 2) then
|
||||||
|
! Allocation tmp array
|
||||||
|
allocate(tmp_list(tmp_list_size))
|
||||||
|
|
||||||
|
! To give the list of MOs in a mo_class
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list = list_core
|
||||||
|
elseif (l==2) then
|
||||||
|
tmp_list = list_act
|
||||||
|
elseif (l==3) then
|
||||||
|
tmp_list = list_inact
|
||||||
|
else
|
||||||
|
tmp_list = list_virt
|
||||||
|
endif
|
||||||
|
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list,criterion)
|
||||||
|
print*,'Criterion:', criterion, trim(mo_class(tmp_list(1)))
|
||||||
|
|
||||||
|
deallocate(tmp_list)
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!print*,'HF', HF_energy
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'========================'
|
||||||
|
print*,' Orbital localization'
|
||||||
|
print*,'========================'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
!Initialization
|
||||||
|
not_converged = .TRUE.
|
||||||
|
|
||||||
|
! To do the localization only if there is at least 2 MOs
|
||||||
|
if (dim_list_core_orb >= 2) then
|
||||||
|
not_core_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_core_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dim_list_act_orb >= 2) then
|
||||||
|
not_act_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_act_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dim_list_inact_orb >= 2) then
|
||||||
|
not_inact_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_inact_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dim_list_virt_orb >= 2) then
|
||||||
|
not_virt_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_virt_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Loop over the mo_classes
|
||||||
|
do l = 1, 4
|
||||||
|
|
||||||
|
if (l==1) then ! core
|
||||||
|
not_converged = not_core_converged
|
||||||
|
tmp_list_size = dim_list_core_orb
|
||||||
|
elseif (l==2) then ! act
|
||||||
|
not_converged = not_act_converged
|
||||||
|
tmp_list_size = dim_list_act_orb
|
||||||
|
elseif (l==3) then ! inact
|
||||||
|
not_converged = not_inact_converged
|
||||||
|
tmp_list_size = dim_list_inact_orb
|
||||||
|
else ! virt
|
||||||
|
not_converged = not_virt_converged
|
||||||
|
tmp_list_size = dim_list_virt_orb
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Next iteration if converged = true
|
||||||
|
if (.not. not_converged) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Allocation tmp array
|
||||||
|
allocate(tmp_list(tmp_list_size))
|
||||||
|
|
||||||
|
! To give the list of MOs in a mo_class
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list = list_core
|
||||||
|
elseif (l==2) then
|
||||||
|
tmp_list = list_act
|
||||||
|
elseif (l==3) then
|
||||||
|
tmp_list = list_inact
|
||||||
|
else
|
||||||
|
tmp_list = list_virt
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (not_converged) then
|
||||||
|
print*,''
|
||||||
|
print*,'###', trim(mo_class(tmp_list(1))), 'MOs ###'
|
||||||
|
print*,''
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Size for the 2D -> 1D transformation
|
||||||
|
tmp_n = tmp_list_size * (tmp_list_size - 1)/2
|
||||||
|
|
||||||
|
! Without hessian + trust region
|
||||||
|
if (.not. localization_use_hessian) then
|
||||||
|
|
||||||
|
! Allocation of temporary arrays
|
||||||
|
allocate(v_grad(tmp_n), tmp_m_x(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_R(tmp_list_size, tmp_list_size), tmp_x(tmp_n))
|
||||||
|
|
||||||
|
! Criterion
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, prev_criterion)
|
||||||
|
|
||||||
|
! Init
|
||||||
|
nb_iter = 0
|
||||||
|
delta = 1d0
|
||||||
|
|
||||||
|
!Loop
|
||||||
|
do while (not_converged)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'***********************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'***********************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Angles of rotation
|
||||||
|
call theta_localization(tmp_list, tmp_list_size, tmp_m_x, max_elem)
|
||||||
|
tmp_m_x = - tmp_m_x * delta
|
||||||
|
|
||||||
|
! Rotation submatrix
|
||||||
|
call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, &
|
||||||
|
info, enforce_step_cancellation)
|
||||||
|
|
||||||
|
! To ensure that the rotation matrix is unitary
|
||||||
|
if (enforce_step_cancellation) then
|
||||||
|
print*, 'Step cancellation, too large error in the rotation matrix'
|
||||||
|
delta = delta * 0.5d0
|
||||||
|
cycle
|
||||||
|
else
|
||||||
|
delta = min(delta * 2d0, 1d0)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Full rotation matrix and application of the rotation
|
||||||
|
call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
|
||||||
|
call apply_mo_rotation(R, prev_mos)
|
||||||
|
|
||||||
|
! Update the needed data
|
||||||
|
call update_data_localization()
|
||||||
|
|
||||||
|
! New criterion
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, criterion)
|
||||||
|
print*,'Criterion:', trim(mo_class(tmp_list(1))), nb_iter, criterion
|
||||||
|
print*,'Max elem :', max_elem
|
||||||
|
print*,'Delta :', delta
|
||||||
|
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
! Exit
|
||||||
|
if (nb_iter >= localization_max_nb_iter .or. dabs(max_elem) < thresh_loc_max_elem_grad) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Save the changes
|
||||||
|
call update_data_localization()
|
||||||
|
call save_mos()
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
! Deallocate
|
||||||
|
deallocate(v_grad, tmp_m_x, tmp_list)
|
||||||
|
deallocate(tmp_R, tmp_x)
|
||||||
|
|
||||||
|
! Trust region
|
||||||
|
else
|
||||||
|
|
||||||
|
! Allocation of temporary arrays
|
||||||
|
allocate(v_grad(tmp_n), H(tmp_n, tmp_n), tmp_m_x(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_R(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_x(tmp_n), W(tmp_n,tmp_n), e_val(tmp_n), key(tmp_n))
|
||||||
|
|
||||||
|
! ### Initialization ###
|
||||||
|
delta = 0d0 ! can be deleted (normally)
|
||||||
|
nb_iter = 0 ! Must start at 0 !!!
|
||||||
|
rho = 0.5d0 ! Must be 0.5
|
||||||
|
|
||||||
|
! Compute the criterion before the loop
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, prev_criterion)
|
||||||
|
|
||||||
|
! Loop until the convergence
|
||||||
|
do while (not_converged)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'***********************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'***********************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call gradient_localization(tmp_n, tmp_list_size, tmp_list, v_grad, max_elem, norm_grad)
|
||||||
|
! Diagonal hessian
|
||||||
|
call hessian_localization(tmp_n, tmp_list_size, tmp_list, H)
|
||||||
|
|
||||||
|
! Diagonalization of the diagonal hessian by hands
|
||||||
|
!call diagonalization_hessian(tmp_n,H,e_val,w)
|
||||||
|
do i = 1, tmp_n
|
||||||
|
e_val(i) = H(i,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Key list for dsort
|
||||||
|
do i = 1, tmp_n
|
||||||
|
key(i) = i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Sort of the eigenvalues
|
||||||
|
call dsort(e_val, key, tmp_n)
|
||||||
|
|
||||||
|
! Eigenvectors
|
||||||
|
W = 0d0
|
||||||
|
do i = 1, tmp_n
|
||||||
|
j = key(i)
|
||||||
|
W(j,i) = 1d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! To enter in the loop just after
|
||||||
|
cancel_step = .True.
|
||||||
|
nb_sub_iter = 0
|
||||||
|
|
||||||
|
! Loop to reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
do while (cancel_step)
|
||||||
|
print*,'-----------------------------'
|
||||||
|
print*, mo_class(tmp_list(1))
|
||||||
|
print*,'Iteration:', nb_iter
|
||||||
|
print*,'Sub iteration:', nb_sub_iter
|
||||||
|
print*,'-----------------------------'
|
||||||
|
|
||||||
|
! Hessian,gradient,Criterion -> x
|
||||||
|
call trust_region_step_w_expected_e(tmp_n, H, W, e_val, v_grad, prev_criterion, &
|
||||||
|
rho, nb_iter, delta, criterion_model, tmp_x, must_exit)
|
||||||
|
|
||||||
|
! Internal loop exit condition
|
||||||
|
if (must_exit) then
|
||||||
|
print*,'trust_region_step_w_expected_e sent: Exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! 1D tmp -> 2D tmp
|
||||||
|
call vec_to_mat_v2(tmp_n, tmp_list_size, tmp_x, tmp_m_x)
|
||||||
|
|
||||||
|
! Rotation submatrix (square matrix tmp_list_size by tmp_list_size)
|
||||||
|
call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, &
|
||||||
|
info, enforce_step_cancellation)
|
||||||
|
|
||||||
|
if (enforce_step_cancellation) then
|
||||||
|
print*, 'Step cancellation, too large error in the rotation matrix'
|
||||||
|
rho = 0d0
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! tmp_R to R, subspace to full space
|
||||||
|
call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
|
||||||
|
|
||||||
|
! Rotation of the MOs
|
||||||
|
call apply_mo_rotation(R, prev_mos)
|
||||||
|
|
||||||
|
! Update the things related to mo_coef
|
||||||
|
call update_data_localization()
|
||||||
|
|
||||||
|
! Update the criterion
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, criterion)
|
||||||
|
print*,'Criterion:', trim(mo_class(tmp_list(1))), nb_iter, criterion
|
||||||
|
|
||||||
|
! Criterion -> step accepted or rejected
|
||||||
|
call trust_region_is_step_cancelled(nb_iter, prev_criterion, criterion, &
|
||||||
|
criterion_model, rho, cancel_step)
|
||||||
|
|
||||||
|
! Cancellation of the step, previous MOs
|
||||||
|
if (cancel_step) then
|
||||||
|
mo_coef = prev_mos
|
||||||
|
endif
|
||||||
|
|
||||||
|
nb_sub_iter = nb_sub_iter + 1
|
||||||
|
enddo
|
||||||
|
!call save_mos() !### depend of the time for 1 iteration
|
||||||
|
|
||||||
|
! To exit the external loop if must_exti = .True.
|
||||||
|
if (must_exit) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Step accepted, nb iteration + 1
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
! External loop exit conditions
|
||||||
|
if (DABS(max_elem) < thresh_loc_max_elem_grad) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
if (nb_iter > localization_max_nb_iter) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Deallocation of temporary arrays
|
||||||
|
deallocate(v_grad, H, tmp_m_x, tmp_R, tmp_list, tmp_x, W, e_val, key)
|
||||||
|
|
||||||
|
! Save the MOs
|
||||||
|
call save_mos()
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
touch mo_coef
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
! To sort the MOs using the diagonal elements of the Fock matrix
|
||||||
|
if (sort_mos_by_e) then
|
||||||
|
call run_sort_by_fock_energies()
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
touch mo_coef
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Locality after the localization
|
||||||
|
call compute_spatial_extent(spatial_extent)
|
||||||
|
|
||||||
|
end
|
2859
src/mo_localization/localization.org
Normal file
2859
src/mo_localization/localization.org
Normal file
File diff suppressed because it is too large
Load Diff
2054
src/mo_localization/localization_sub.irp.f
Normal file
2054
src/mo_localization/localization_sub.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
@ -1133,102 +1133,103 @@ subroutine ortho_svd(A,LDA,m,n)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine ortho_qr_withB(A,LDA,B,m,n)
|
! QR to orthonormalize CSFs does not work :-(
|
||||||
implicit none
|
!subroutine ortho_qr_withB(A,LDA,B,m,n)
|
||||||
BEGIN_DOC
|
! implicit none
|
||||||
! Orthogonalization using Q.R factorization
|
! BEGIN_DOC
|
||||||
!
|
! ! Orthogonalization using Q.R factorization
|
||||||
! A : Overlap Matrix
|
! !
|
||||||
!
|
! ! A : Overlap Matrix
|
||||||
! LDA : leftmost dimension of A
|
! !
|
||||||
!
|
! ! LDA : leftmost dimension of A
|
||||||
! m : Number of rows of A
|
! !
|
||||||
!
|
! ! m : Number of rows of A
|
||||||
! n : Number of columns of A
|
! !
|
||||||
!
|
! ! n : Number of columns of A
|
||||||
! B : Output orthogonal basis
|
! !
|
||||||
!
|
! ! B : Output orthogonal basis
|
||||||
END_DOC
|
! !
|
||||||
integer, intent(in) :: m,n, LDA
|
! END_DOC
|
||||||
double precision, intent(inout) :: A(LDA,n)
|
! integer, intent(in) :: m,n, LDA
|
||||||
double precision, intent(inout) :: B(LDA,n)
|
! double precision, intent(inout) :: A(LDA,n)
|
||||||
|
! double precision, intent(inout) :: B(LDA,n)
|
||||||
|
!
|
||||||
|
! integer :: LWORK, INFO
|
||||||
|
! integer, allocatable :: jpvt(:)
|
||||||
|
! double precision, allocatable :: TAU(:), WORK(:)
|
||||||
|
! double precision, allocatable :: C(:,:)
|
||||||
|
! double precision :: norm
|
||||||
|
! integer :: i,j
|
||||||
|
!
|
||||||
|
! allocate (TAU(min(m,n)), WORK(1))
|
||||||
|
! allocate (jpvt(n))
|
||||||
|
! !print *," In function ortho"
|
||||||
|
! B = A
|
||||||
|
!
|
||||||
|
! jpvt(1:n)=1
|
||||||
|
!
|
||||||
|
! LWORK=-1
|
||||||
|
! call dgeqp3( m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
|
||||||
|
!
|
||||||
|
! ! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
|
||||||
|
! LWORK=max(n,int(WORK(1)))
|
||||||
|
!
|
||||||
|
! deallocate(WORK)
|
||||||
|
! allocate(WORK(LWORK))
|
||||||
|
! call dgeqp3(m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
|
||||||
|
! print *,A
|
||||||
|
! print *,jpvt
|
||||||
|
! deallocate(WORK,TAU)
|
||||||
|
! !stop
|
||||||
|
!
|
||||||
|
! !LWORK=-1
|
||||||
|
! !call dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO )
|
||||||
|
! !! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
|
||||||
|
! !LWORK=max(n,int(WORK(1)))
|
||||||
|
!
|
||||||
|
! !deallocate(WORK)
|
||||||
|
! !allocate(WORK(LWORK))
|
||||||
|
! !call dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO )
|
||||||
|
!
|
||||||
|
! !LWORK=-1
|
||||||
|
! !call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
|
||||||
|
! !! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
|
||||||
|
! !LWORK=max(n,int(WORK(1)))
|
||||||
|
!
|
||||||
|
! !deallocate(WORK)
|
||||||
|
! !allocate(WORK(LWORK))
|
||||||
|
! !call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
|
||||||
|
! !
|
||||||
|
! !allocate(C(LDA,n))
|
||||||
|
! !call dgemm('N','N',m,n,n,1.0d0,B,LDA,A,LDA,0.0d0,C,LDA)
|
||||||
|
! !norm = 0.0d0
|
||||||
|
! !B = 0.0d0
|
||||||
|
! !!print *,C
|
||||||
|
! !do i=1,m
|
||||||
|
! ! norm = 0.0d0
|
||||||
|
! ! do j=1,n
|
||||||
|
! ! norm = norm + C(j,i)*C(j,i)
|
||||||
|
! ! end do
|
||||||
|
! ! norm = 1.0d0/dsqrt(norm)
|
||||||
|
! ! do j=1,n
|
||||||
|
! ! B(j,i) = C(j,i)
|
||||||
|
! ! end do
|
||||||
|
! !end do
|
||||||
|
! !print *,B
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! !deallocate(WORK,TAU)
|
||||||
|
!end
|
||||||
|
|
||||||
integer :: LWORK, INFO
|
!subroutine ortho_qr_csf(A, LDA, B, m, n) bind(C, name="ortho_qr_csf")
|
||||||
integer, allocatable :: jpvt(:)
|
! use iso_c_binding
|
||||||
double precision, allocatable :: TAU(:), WORK(:)
|
! integer(c_int32_t), value :: LDA
|
||||||
double precision, allocatable :: C(:,:)
|
! integer(c_int32_t), value :: m
|
||||||
double precision :: norm
|
! integer(c_int32_t), value :: n
|
||||||
integer :: i,j
|
! integer(c_int16_t) :: A(LDA,n)
|
||||||
|
! integer(c_int16_t) :: B(LDA,n)
|
||||||
allocate (TAU(min(m,n)), WORK(1))
|
! call ortho_qr_withB(A,LDA,B,m,n)
|
||||||
allocate (jpvt(n))
|
!end subroutine ortho_qr_csf
|
||||||
!print *," In function ortho"
|
|
||||||
B = A
|
|
||||||
|
|
||||||
jpvt(1:n)=1
|
|
||||||
|
|
||||||
LWORK=-1
|
|
||||||
call dgeqp3( m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
|
|
||||||
|
|
||||||
! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
|
|
||||||
LWORK=max(n,int(WORK(1)))
|
|
||||||
|
|
||||||
deallocate(WORK)
|
|
||||||
allocate(WORK(LWORK))
|
|
||||||
call dgeqp3(m, n, A, LDA, jpvt, TAU, WORK, LWORK, INFO )
|
|
||||||
print *,A
|
|
||||||
print *,jpvt
|
|
||||||
deallocate(WORK,TAU)
|
|
||||||
!stop
|
|
||||||
|
|
||||||
!LWORK=-1
|
|
||||||
!call dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO )
|
|
||||||
!! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
|
|
||||||
!LWORK=max(n,int(WORK(1)))
|
|
||||||
|
|
||||||
!deallocate(WORK)
|
|
||||||
!allocate(WORK(LWORK))
|
|
||||||
!call dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO )
|
|
||||||
|
|
||||||
!LWORK=-1
|
|
||||||
!call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
|
|
||||||
!! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
|
|
||||||
!LWORK=max(n,int(WORK(1)))
|
|
||||||
|
|
||||||
!deallocate(WORK)
|
|
||||||
!allocate(WORK(LWORK))
|
|
||||||
!call dorgqr(m, n, n, A, LDA, TAU, WORK, LWORK, INFO)
|
|
||||||
!
|
|
||||||
!allocate(C(LDA,n))
|
|
||||||
!call dgemm('N','N',m,n,n,1.0d0,B,LDA,A,LDA,0.0d0,C,LDA)
|
|
||||||
!norm = 0.0d0
|
|
||||||
!B = 0.0d0
|
|
||||||
!!print *,C
|
|
||||||
!do i=1,m
|
|
||||||
! norm = 0.0d0
|
|
||||||
! do j=1,n
|
|
||||||
! norm = norm + C(j,i)*C(j,i)
|
|
||||||
! end do
|
|
||||||
! norm = 1.0d0/dsqrt(norm)
|
|
||||||
! do j=1,n
|
|
||||||
! B(j,i) = C(j,i)
|
|
||||||
! end do
|
|
||||||
!end do
|
|
||||||
!print *,B
|
|
||||||
|
|
||||||
|
|
||||||
!deallocate(WORK,TAU)
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine ortho_qr_csf(A, LDA, B, m, n) bind(C, name="ortho_qr_csf")
|
|
||||||
use iso_c_binding
|
|
||||||
integer(c_int32_t), value :: LDA
|
|
||||||
integer(c_int32_t), value :: m
|
|
||||||
integer(c_int32_t), value :: n
|
|
||||||
integer(c_int16_t) :: A(LDA,n)
|
|
||||||
integer(c_int16_t) :: B(LDA,n)
|
|
||||||
call ortho_qr_withB(A,LDA,B,m,n)
|
|
||||||
end subroutine ortho_qr_csf
|
|
||||||
|
|
||||||
subroutine ortho_qr(A,LDA,m,n)
|
subroutine ortho_qr(A,LDA,m,n)
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -411,3 +411,28 @@ subroutine lowercase(txt,n)
|
|||||||
enddo
|
enddo
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine v2_over_x(v,x,res)
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Two by two diagonalization to avoid the divergence in v^2/x when x goes to 0
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision, intent(in) :: v, x
|
||||||
|
double precision, intent(out) :: res
|
||||||
|
|
||||||
|
double precision :: delta_E, tmp, val
|
||||||
|
|
||||||
|
res = 0d0
|
||||||
|
delta_E = x
|
||||||
|
if (v == 0.d0) return
|
||||||
|
|
||||||
|
val = 2d0 * v
|
||||||
|
tmp = dsqrt(delta_E * delta_E + val * val)
|
||||||
|
if (delta_E < 0.d0) then
|
||||||
|
tmp = -tmp
|
||||||
|
endif
|
||||||
|
res = 0.5d0 * (tmp - delta_E)
|
||||||
|
|
||||||
|
end
|
||||||
|
89
src/utils_trust_region/EZFIO.cfg
Normal file
89
src/utils_trust_region/EZFIO.cfg
Normal file
@ -0,0 +1,89 @@
|
|||||||
|
[thresh_delta]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold to stop the optimization if the radius of the trust region delta < thresh_delta
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-10
|
||||||
|
|
||||||
|
[thresh_rho]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold for the step acceptance in the trust region algorithm, if (rho .geq. thresh_rho) the step is accepted, else the step is cancelled and a smaller step is tried until (rho .geq. thresh_rho)
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.1
|
||||||
|
|
||||||
|
[thresh_eig]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold to consider when an eigenvalue is 0 in the trust region algorithm
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-12
|
||||||
|
|
||||||
|
[thresh_model]
|
||||||
|
type: double precision
|
||||||
|
doc: If if ABS(criterion - criterion_model) < thresh_model, the program exit the trust region algorithm
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-12
|
||||||
|
|
||||||
|
[absolute_eig]
|
||||||
|
type: logical
|
||||||
|
doc: If True, the algorithm replace the eigenvalues of the hessian by their absolute value to compute the step (in the trust region)
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: false
|
||||||
|
|
||||||
|
[thresh_wtg]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold in the trust region algorithm to considere when the dot product of the eigenvector W by the gradient v_grad is equal to 0. Must be smaller than thresh_eig by several order of magnitude to avoid numerical problem. If the research of the optimal lambda cannot reach the condition (||x|| .eq. delta) because (||x|| .lt. delta), the reason might be that thresh_wtg is too big or/and thresh_eig is too small
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-6
|
||||||
|
|
||||||
|
[thresh_wtg2]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold in the trust region algorithm to considere when the dot product of the eigenvector W by the gradient v_grad is 0 in the case of avoid_saddle .eq. true. There is no particular reason to put a different value that thresh_wtg, but it can be useful one day
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-6
|
||||||
|
|
||||||
|
[avoid_saddle]
|
||||||
|
type: logical
|
||||||
|
doc: Test to avoid saddle point, active if true
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: false
|
||||||
|
|
||||||
|
[version_avoid_saddle]
|
||||||
|
type: integer
|
||||||
|
doc: cf. trust region, not stable
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 3
|
||||||
|
|
||||||
|
[thresh_rho_2]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold for the step acceptance for the research of lambda in the trust region algorithm, if (rho_2 .geq. thresh_rho_2) the step is accepted, else the step is rejected
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.1
|
||||||
|
|
||||||
|
[thresh_cc]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold to stop the research of the optimal lambda in the trust region algorithm when (dabs(1d0-||x||^2/delta^2) < thresh_cc)
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-6
|
||||||
|
|
||||||
|
[thresh_model_2]
|
||||||
|
type: double precision
|
||||||
|
doc: if (ABS(criterion - criterion_model) < thresh_model_2), i.e., the difference between the actual criterion and the predicted next criterion, during the research of the optimal lambda in the trust region algorithm it prints a warning
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-12
|
||||||
|
|
||||||
|
[version_lambda_search]
|
||||||
|
type: integer
|
||||||
|
doc: Research of the optimal lambda in the trust region algorithm to constrain the norm of the step by solving: 1 -> ||x||^2 - delta^2 .eq. 0, 2 -> 1/||x||^2 - 1/delta^2 .eq. 0
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 2
|
||||||
|
|
||||||
|
[nb_it_max_lambda]
|
||||||
|
type: integer
|
||||||
|
doc: Maximal number of iterations for the research of the optimal lambda in the trust region algorithm
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 100
|
||||||
|
|
||||||
|
[nb_it_max_pre_search]
|
||||||
|
type: integer
|
||||||
|
doc: Maximal number of iterations for the pre-research of the optimal lambda in the trust region algorithm
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 40
|
1
src/utils_trust_region/NEED
Normal file
1
src/utils_trust_region/NEED
Normal file
@ -0,0 +1 @@
|
|||||||
|
hartree_fock
|
5
src/utils_trust_region/README.rst
Normal file
5
src/utils_trust_region/README.rst
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
============
|
||||||
|
trust_region
|
||||||
|
============
|
||||||
|
|
||||||
|
The documentation can be found in the org files.
|
7
src/utils_trust_region/TANGLE_org_mode.sh
Executable file
7
src/utils_trust_region/TANGLE_org_mode.sh
Executable file
@ -0,0 +1,7 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
list='ls *.org'
|
||||||
|
for element in $list
|
||||||
|
do
|
||||||
|
emacs --batch $element -f org-babel-tangle
|
||||||
|
done
|
248
src/utils_trust_region/algo_trust.irp.f
Normal file
248
src/utils_trust_region/algo_trust.irp.f
Normal file
@ -0,0 +1,248 @@
|
|||||||
|
! Algorithm for the trust region
|
||||||
|
|
||||||
|
! step_in_trust_region:
|
||||||
|
! Computes the step in the trust region (delta)
|
||||||
|
! (automatically sets at the iteration 0 and which evolves during the
|
||||||
|
! process in function of the evolution of rho). The step is computing by
|
||||||
|
! constraining its norm with a lagrange multiplier.
|
||||||
|
! Since the calculation of the step is based on the Newton method, an
|
||||||
|
! estimation of the gain in energy is given using the Taylors series
|
||||||
|
! truncated at the second order (criterion_model).
|
||||||
|
! If (DABS(criterion-criterion_model) < 1d-12) then
|
||||||
|
! must_exit = .True.
|
||||||
|
! else
|
||||||
|
! must_exit = .False.
|
||||||
|
|
||||||
|
! This estimation of the gain in energy is used by
|
||||||
|
! is_step_cancel_trust_region to say if the step is accepted or cancelled.
|
||||||
|
|
||||||
|
! If the step must be cancelled, the calculation restart from the same
|
||||||
|
! hessian and gradient and recomputes the step but in a smaller trust
|
||||||
|
! region and so on until the step is accepted. If the step is accepted
|
||||||
|
! the hessian and the gradient are recomputed to produce a new step.
|
||||||
|
|
||||||
|
! Example:
|
||||||
|
|
||||||
|
|
||||||
|
! !### Initialization ###
|
||||||
|
! delta = 0d0
|
||||||
|
! nb_iter = 0 ! Must start at 0 !!!
|
||||||
|
! rho = 0.5d0
|
||||||
|
! not_converged = .True.
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! ! Compute the criterion before the loop
|
||||||
|
! call #your_criterion(prev_criterion)
|
||||||
|
!
|
||||||
|
! do while (not_converged)
|
||||||
|
! ! ### TODO ##
|
||||||
|
! ! Call your gradient
|
||||||
|
! ! Call you hessian
|
||||||
|
! call #your_gradient(v_grad) (1D array)
|
||||||
|
! call #your_hessian(H) (2D array)
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! ! Diagonalization of the hessian
|
||||||
|
! call diagonalization_hessian(n,H,e_val,w)
|
||||||
|
!
|
||||||
|
! cancel_step = .True. ! To enter in the loop just after
|
||||||
|
! ! Loop to Reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
! do while (cancel_step)
|
||||||
|
!
|
||||||
|
! ! Hessian,gradient,Criterion -> x
|
||||||
|
! call trust_region_step_w_expected_e(tmp_n,W,e_val,v_grad,prev_criterion,rho,nb_iter,delta,criterion_model,tmp_x,must_exit)
|
||||||
|
!
|
||||||
|
! if (must_exit) then
|
||||||
|
! ! ### Message ###
|
||||||
|
! ! if step_in_trust_region sets must_exit on true for numerical reasons
|
||||||
|
! print*,'algo_trust1 sends the message : Exit'
|
||||||
|
! !### exit ###
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! !### TODO ###
|
||||||
|
! ! Compute x -> m_x
|
||||||
|
! ! Compute m_x -> R
|
||||||
|
! ! Apply R and keep the previous MOs...
|
||||||
|
! ! Update/touch
|
||||||
|
! ! Compute the new criterion/energy -> criterion
|
||||||
|
!
|
||||||
|
! call #your_routine_1D_to_2D_antisymmetric_array(x,m_x)
|
||||||
|
! call #your_routine_2D_antisymmetric_array_to_rotation_matrix(m_x,R)
|
||||||
|
! call #your_routine_to_apply_the_rotation_matrix(R,prev_mos)
|
||||||
|
!
|
||||||
|
! TOUCH #your_variables
|
||||||
|
!
|
||||||
|
! call #your_criterion(criterion)
|
||||||
|
!
|
||||||
|
! ! Criterion -> step accepted or rejected
|
||||||
|
! call trust_region_is_step_cancelled(nb_iter,prev_criterion, criterion, criterion_model,rho,cancel_step)
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! !if (cancel_step) then
|
||||||
|
! ! Cancel the previous step (mo_coef = prev_mos if you keep them...)
|
||||||
|
! !endif
|
||||||
|
! #if (cancel_step) then
|
||||||
|
! #mo_coef = prev_mos
|
||||||
|
! #endif
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! !call save_mos() !### depend of the time for 1 iteration
|
||||||
|
!
|
||||||
|
! ! To exit the external loop if must_exit = .True.
|
||||||
|
! if (must_exit) then
|
||||||
|
! !### exit ###
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! ! Step accepted, nb iteration + 1
|
||||||
|
! nb_iter = nb_iter + 1
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! !if (###Conditions###) then
|
||||||
|
! ! no_converged = .False.
|
||||||
|
! !endif
|
||||||
|
! #if (#your_conditions) then
|
||||||
|
! # not_converged = .False.
|
||||||
|
! #endif
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Variables:
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | n | integer | m*(m-1)/2 |
|
||||||
|
! | m | integer | number of mo in the mo_class |
|
||||||
|
! | H(n,n) | double precision | Hessian |
|
||||||
|
! | v_grad(n) | double precision | Gradient |
|
||||||
|
! | W(n,n) | double precision | Eigenvectors of the hessian |
|
||||||
|
! | e_val(n) | double precision | Eigenvalues of the hessian |
|
||||||
|
! | criterion | double precision | Actual criterion |
|
||||||
|
! | prev_criterion | double precision | Value of the criterion before the first iteration/after the previous iteration |
|
||||||
|
! | rho | double precision | Given by is_step_cancel_trus_region |
|
||||||
|
! | | | Agreement between the real function and the Taylor series (2nd order) |
|
||||||
|
! | nb_iter | integer | Actual number of iterations |
|
||||||
|
|
||||||
|
! Input/output:
|
||||||
|
! | delta | double precision | Radius of the trust region |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | criterion_model | double precision | Predicted criterion after the rotation |
|
||||||
|
! | x(n) | double precision | Step |
|
||||||
|
! | must_exit | logical | If the program must exit the loop |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine trust_region_step_w_expected_e(n,H,W,e_val,v_grad,prev_criterion,rho,nb_iter,delta,criterion_model,x,must_exit)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the step and the expected criterion/energy after the step
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n, nb_iter
|
||||||
|
double precision, intent(in) :: H(n,n), W(n,n), v_grad(n)
|
||||||
|
double precision, intent(in) :: rho, prev_criterion
|
||||||
|
|
||||||
|
! inout
|
||||||
|
double precision, intent(inout) :: delta, e_val(n)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: criterion_model, x(n)
|
||||||
|
logical, intent(out) :: must_exit
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: info
|
||||||
|
|
||||||
|
must_exit = .False.
|
||||||
|
|
||||||
|
call trust_region_step(n,nb_iter,v_grad,rho,e_val,W,x,delta)
|
||||||
|
|
||||||
|
call trust_region_expected_e(n,v_grad,H,x,prev_criterion,criterion_model)
|
||||||
|
|
||||||
|
! exit if DABS(prev_criterion - criterion_model) < 1d-12
|
||||||
|
if (DABS(prev_criterion - criterion_model) < thresh_model) then
|
||||||
|
print*,''
|
||||||
|
print*,'###############################################################################'
|
||||||
|
print*,'DABS(prev_criterion - criterion_model) <', thresh_model, 'stop the trust region'
|
||||||
|
print*,'###############################################################################'
|
||||||
|
print*,''
|
||||||
|
must_exit = .True.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (delta < thresh_delta) then
|
||||||
|
print*,''
|
||||||
|
print*,'##############################################'
|
||||||
|
print*,'Delta <', thresh_delta, 'stop the trust region'
|
||||||
|
print*,'##############################################'
|
||||||
|
print*,''
|
||||||
|
must_exit = .True.
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Add after the call to this subroutine, a statement:
|
||||||
|
! "if (must_exit) then
|
||||||
|
! exit
|
||||||
|
! endif"
|
||||||
|
! in order to exit the optimization loop
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Variables:
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | nb_iter | integer | actual number of iterations |
|
||||||
|
! | prev_criterion | double precision | criterion before the application of the step x |
|
||||||
|
! | criterion | double precision | criterion after the application of the step x |
|
||||||
|
! | criterion_model | double precision | predicted criterion after the application of x |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | rho | double precision | Agreement between the predicted criterion and the real new criterion |
|
||||||
|
! | cancel_step | logical | If the step must be cancelled |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine trust_region_is_step_cancelled(nb_iter,prev_criterion, criterion, criterion_model,rho,cancel_step)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute if the step should be cancelled
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! in
|
||||||
|
double precision, intent(in) :: prev_criterion, criterion, criterion_model
|
||||||
|
|
||||||
|
! inout
|
||||||
|
integer, intent(inout) :: nb_iter
|
||||||
|
|
||||||
|
! out
|
||||||
|
logical, intent(out) :: cancel_step
|
||||||
|
double precision, intent(out) :: rho
|
||||||
|
|
||||||
|
! Computes rho
|
||||||
|
call trust_region_rho(prev_criterion,criterion,criterion_model,rho)
|
||||||
|
|
||||||
|
if (nb_iter == 0) then
|
||||||
|
nb_iter = 1 ! in order to enable the change of delta if the first iteration is cancelled
|
||||||
|
endif
|
||||||
|
|
||||||
|
! If rho < thresh_rho -> give something in output to cancel the step
|
||||||
|
if (rho >= thresh_rho) then !0.1d0) then
|
||||||
|
! The step is accepted
|
||||||
|
cancel_step = .False.
|
||||||
|
else
|
||||||
|
! The step is rejected
|
||||||
|
cancel_step = .True.
|
||||||
|
print*, '***********************'
|
||||||
|
print*, 'Step cancel : rho <', thresh_rho
|
||||||
|
print*, '***********************'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
593
src/utils_trust_region/algo_trust.org
Normal file
593
src/utils_trust_region/algo_trust.org
Normal file
@ -0,0 +1,593 @@
|
|||||||
|
* Algorithm for the trust region
|
||||||
|
|
||||||
|
step_in_trust_region:
|
||||||
|
Computes the step in the trust region (delta)
|
||||||
|
(automatically sets at the iteration 0 and which evolves during the
|
||||||
|
process in function of the evolution of rho). The step is computing by
|
||||||
|
constraining its norm with a lagrange multiplier.
|
||||||
|
Since the calculation of the step is based on the Newton method, an
|
||||||
|
estimation of the gain in energy is given using the Taylors series
|
||||||
|
truncated at the second order (criterion_model).
|
||||||
|
If (DABS(criterion-criterion_model) < 1d-12) then
|
||||||
|
must_exit = .True.
|
||||||
|
else
|
||||||
|
must_exit = .False.
|
||||||
|
|
||||||
|
This estimation of the gain in energy is used by
|
||||||
|
is_step_cancel_trust_region to say if the step is accepted or cancelled.
|
||||||
|
|
||||||
|
If the step must be cancelled, the calculation restart from the same
|
||||||
|
hessian and gradient and recomputes the step but in a smaller trust
|
||||||
|
region and so on until the step is accepted. If the step is accepted
|
||||||
|
the hessian and the gradient are recomputed to produce a new step.
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle algo_trust.irp.f
|
||||||
|
! !### Initialization ###
|
||||||
|
! delta = 0d0
|
||||||
|
! nb_iter = 0 ! Must start at 0 !!!
|
||||||
|
! rho = 0.5d0
|
||||||
|
! not_converged = .True.
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! ! Compute the criterion before the loop
|
||||||
|
! call #your_criterion(prev_criterion)
|
||||||
|
!
|
||||||
|
! do while (not_converged)
|
||||||
|
! ! ### TODO ##
|
||||||
|
! ! Call your gradient
|
||||||
|
! ! Call you hessian
|
||||||
|
! call #your_gradient(v_grad) (1D array)
|
||||||
|
! call #your_hessian(H) (2D array)
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! ! Diagonalization of the hessian
|
||||||
|
! call diagonalization_hessian(n,H,e_val,w)
|
||||||
|
!
|
||||||
|
! cancel_step = .True. ! To enter in the loop just after
|
||||||
|
! ! Loop to Reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
! do while (cancel_step)
|
||||||
|
!
|
||||||
|
! ! Hessian,gradient,Criterion -> x
|
||||||
|
! call trust_region_step_w_expected_e(tmp_n,W,e_val,v_grad,prev_criterion,rho,nb_iter,delta,criterion_model,tmp_x,must_exit)
|
||||||
|
!
|
||||||
|
! if (must_exit) then
|
||||||
|
! ! ### Message ###
|
||||||
|
! ! if step_in_trust_region sets must_exit on true for numerical reasons
|
||||||
|
! print*,'algo_trust1 sends the message : Exit'
|
||||||
|
! !### exit ###
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! !### TODO ###
|
||||||
|
! ! Compute x -> m_x
|
||||||
|
! ! Compute m_x -> R
|
||||||
|
! ! Apply R and keep the previous MOs...
|
||||||
|
! ! Update/touch
|
||||||
|
! ! Compute the new criterion/energy -> criterion
|
||||||
|
!
|
||||||
|
! call #your_routine_1D_to_2D_antisymmetric_array(x,m_x)
|
||||||
|
! call #your_routine_2D_antisymmetric_array_to_rotation_matrix(m_x,R)
|
||||||
|
! call #your_routine_to_apply_the_rotation_matrix(R,prev_mos)
|
||||||
|
!
|
||||||
|
! TOUCH #your_variables
|
||||||
|
!
|
||||||
|
! call #your_criterion(criterion)
|
||||||
|
!
|
||||||
|
! ! Criterion -> step accepted or rejected
|
||||||
|
! call trust_region_is_step_cancelled(nb_iter,prev_criterion, criterion, criterion_model,rho,cancel_step)
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! !if (cancel_step) then
|
||||||
|
! ! Cancel the previous step (mo_coef = prev_mos if you keep them...)
|
||||||
|
! !endif
|
||||||
|
! #if (cancel_step) then
|
||||||
|
! #mo_coef = prev_mos
|
||||||
|
! #endif
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! !call save_mos() !### depend of the time for 1 iteration
|
||||||
|
!
|
||||||
|
! ! To exit the external loop if must_exit = .True.
|
||||||
|
! if (must_exit) then
|
||||||
|
! !### exit ###
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! ! Step accepted, nb iteration + 1
|
||||||
|
! nb_iter = nb_iter + 1
|
||||||
|
!
|
||||||
|
! ! ### TODO ###
|
||||||
|
! !if (###Conditions###) then
|
||||||
|
! ! no_converged = .False.
|
||||||
|
! !endif
|
||||||
|
! #if (#your_conditions) then
|
||||||
|
! # not_converged = .False.
|
||||||
|
! #endif
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
Variables:
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| n | integer | m*(m-1)/2 |
|
||||||
|
| m | integer | number of mo in the mo_class |
|
||||||
|
| H(n,n) | double precision | Hessian |
|
||||||
|
| v_grad(n) | double precision | Gradient |
|
||||||
|
| W(n,n) | double precision | Eigenvectors of the hessian |
|
||||||
|
| e_val(n) | double precision | Eigenvalues of the hessian |
|
||||||
|
| criterion | double precision | Actual criterion |
|
||||||
|
| prev_criterion | double precision | Value of the criterion before the first iteration/after the previous iteration |
|
||||||
|
| rho | double precision | Given by is_step_cancel_trus_region |
|
||||||
|
| | | Agreement between the real function and the Taylor series (2nd order) |
|
||||||
|
| nb_iter | integer | Actual number of iterations |
|
||||||
|
|
||||||
|
Input/output:
|
||||||
|
| delta | double precision | Radius of the trust region |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| criterion_model | double precision | Predicted criterion after the rotation |
|
||||||
|
| x(n) | double precision | Step |
|
||||||
|
| must_exit | logical | If the program must exit the loop |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle algo_trust.irp.f
|
||||||
|
subroutine trust_region_step_w_expected_e(n,H,W,e_val,v_grad,prev_criterion,rho,nb_iter,delta,criterion_model,x,must_exit)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the step and the expected criterion/energy after the step
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n, nb_iter
|
||||||
|
double precision, intent(in) :: H(n,n), W(n,n), v_grad(n)
|
||||||
|
double precision, intent(in) :: rho, prev_criterion
|
||||||
|
|
||||||
|
! inout
|
||||||
|
double precision, intent(inout) :: delta, e_val(n)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: criterion_model, x(n)
|
||||||
|
logical, intent(out) :: must_exit
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: info
|
||||||
|
|
||||||
|
must_exit = .False.
|
||||||
|
|
||||||
|
call trust_region_step(n,nb_iter,v_grad,rho,e_val,W,x,delta)
|
||||||
|
|
||||||
|
call trust_region_expected_e(n,v_grad,H,x,prev_criterion,criterion_model)
|
||||||
|
|
||||||
|
! exit if DABS(prev_criterion - criterion_model) < 1d-12
|
||||||
|
if (DABS(prev_criterion - criterion_model) < thresh_model) then
|
||||||
|
print*,''
|
||||||
|
print*,'###############################################################################'
|
||||||
|
print*,'DABS(prev_criterion - criterion_model) <', thresh_model, 'stop the trust region'
|
||||||
|
print*,'###############################################################################'
|
||||||
|
print*,''
|
||||||
|
must_exit = .True.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (delta < thresh_delta) then
|
||||||
|
print*,''
|
||||||
|
print*,'##############################################'
|
||||||
|
print*,'Delta <', thresh_delta, 'stop the trust region'
|
||||||
|
print*,'##############################################'
|
||||||
|
print*,''
|
||||||
|
must_exit = .True.
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Add after the call to this subroutine, a statement:
|
||||||
|
! "if (must_exit) then
|
||||||
|
! exit
|
||||||
|
! endif"
|
||||||
|
! in order to exit the optimization loop
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
Variables:
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| nb_iter | integer | actual number of iterations |
|
||||||
|
| prev_criterion | double precision | criterion before the application of the step x |
|
||||||
|
| criterion | double precision | criterion after the application of the step x |
|
||||||
|
| criterion_model | double precision | predicted criterion after the application of x |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| rho | double precision | Agreement between the predicted criterion and the real new criterion |
|
||||||
|
| cancel_step | logical | If the step must be cancelled |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle algo_trust.irp.f
|
||||||
|
subroutine trust_region_is_step_cancelled(nb_iter,prev_criterion, criterion, criterion_model,rho,cancel_step)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute if the step should be cancelled
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! in
|
||||||
|
double precision, intent(in) :: prev_criterion, criterion, criterion_model
|
||||||
|
|
||||||
|
! inout
|
||||||
|
integer, intent(inout) :: nb_iter
|
||||||
|
|
||||||
|
! out
|
||||||
|
logical, intent(out) :: cancel_step
|
||||||
|
double precision, intent(out) :: rho
|
||||||
|
|
||||||
|
! Computes rho
|
||||||
|
call trust_region_rho(prev_criterion,criterion,criterion_model,rho)
|
||||||
|
|
||||||
|
if (nb_iter == 0) then
|
||||||
|
nb_iter = 1 ! in order to enable the change of delta if the first iteration is cancelled
|
||||||
|
endif
|
||||||
|
|
||||||
|
! If rho < thresh_rho -> give something in output to cancel the step
|
||||||
|
if (rho >= thresh_rho) then !0.1d0) then
|
||||||
|
! The step is accepted
|
||||||
|
cancel_step = .False.
|
||||||
|
else
|
||||||
|
! The step is rejected
|
||||||
|
cancel_step = .True.
|
||||||
|
print*, '***********************'
|
||||||
|
print*, 'Step cancel : rho <', thresh_rho
|
||||||
|
print*, '***********************'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Template for MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_template_mos.txt
|
||||||
|
subroutine algo_trust_template(tmp_n, tmp_list_size, tmp_list)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! In
|
||||||
|
integer, intent(in) :: tmp_n, tmp_list_size, tmp_list(tmp_list_size)
|
||||||
|
|
||||||
|
! Out
|
||||||
|
! Rien ou un truc pour savoir si ça c'est bien passé
|
||||||
|
|
||||||
|
! Internal
|
||||||
|
double precision, allocatable :: e_val(:), W(:,:), tmp_R(:,:), R(:,:), tmp_x(:), tmp_m_x(:,:)
|
||||||
|
double precision, allocatable :: prev_mos(:,:)
|
||||||
|
double precision :: criterion, prev_criterion, criterion_model
|
||||||
|
double precision :: delta, rho
|
||||||
|
logical :: not_converged, cancel_step, must_exit, enforce_step_cancellation
|
||||||
|
integer :: nb_iter, info, nb_sub_iter
|
||||||
|
integer :: i,j,tmp_i,tmp_j
|
||||||
|
|
||||||
|
allocate(W(tmp_n, tmp_n),e_val(tmp_n),tmp_x(tmp_n),tmp_m_x(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_R(tmp_list_size, tmp_list_size), R(mo_num, mo_num))
|
||||||
|
allocate(prev_mos(ao_num, mo_num))
|
||||||
|
|
||||||
|
! Provide the criterion, but unnecessary because it's done
|
||||||
|
! automatically
|
||||||
|
PROVIDE C_PROVIDER H_PROVIDER g_PROVIDER cc_PROVIDER
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
delta = 0d0
|
||||||
|
nb_iter = 0 ! Must start at 0 !!!
|
||||||
|
rho = 0.5d0 ! Must start at 0.5
|
||||||
|
not_converged = .True. ! Must be true
|
||||||
|
|
||||||
|
! Compute the criterion before the loop
|
||||||
|
prev_criterion = C_PROVIDER
|
||||||
|
|
||||||
|
do while (not_converged)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'******************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'******************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! The new hessian and gradient are computed at the end of the previous iteration
|
||||||
|
! Diagonalization of the hessian
|
||||||
|
call diagonalization_hessian(tmp_n, H_PROVIDER, e_val, W)
|
||||||
|
|
||||||
|
cancel_step = .True. ! To enter in the loop just after
|
||||||
|
nb_sub_iter = 0
|
||||||
|
|
||||||
|
! Loop to Reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
do while (cancel_step)
|
||||||
|
|
||||||
|
print*,'-----------------------------'
|
||||||
|
print*,'Iteration:', nb_iter
|
||||||
|
print*,'Sub iteration:', nb_sub_iter
|
||||||
|
print*,'-----------------------------'
|
||||||
|
|
||||||
|
! Hessian,gradient,Criterion -> x
|
||||||
|
call trust_region_step_w_expected_e(tmp_n, H_PROVIDER, W, e_val, g_PROVIDER, &
|
||||||
|
prev_criterion, rho, nb_iter, delta, criterion_model, tmp_x, must_exit)
|
||||||
|
|
||||||
|
if (must_exit) then
|
||||||
|
! if step_in_trust_region sets must_exit on true for numerical reasons
|
||||||
|
print*,'trust_region_step_w_expected_e sent the message : Exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! 1D tmp -> 2D tmp
|
||||||
|
call vec_to_mat_v2(tmp_n, tmp_list_size, tmp_x, tmp_m_x)
|
||||||
|
|
||||||
|
! Rotation submatrix (square matrix tmp_list_size by tmp_list_size)
|
||||||
|
call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, info, enforce_step_cancellation)
|
||||||
|
|
||||||
|
if (enforce_step_cancellation) then
|
||||||
|
print*, 'Forces the step cancellation, too large error in the rotation matrix'
|
||||||
|
rho = 0d0
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! tmp_R to R, subspace to full space
|
||||||
|
call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
|
||||||
|
|
||||||
|
! Rotation of the MOs
|
||||||
|
call apply_mo_rotation(R, prev_mos)
|
||||||
|
|
||||||
|
! touch mo_coef
|
||||||
|
call clear_mo_map ! Only if you are using the bi-electronic integrals
|
||||||
|
! mo_coef becomes valid
|
||||||
|
! And avoid the recomputation of the providers which depend of mo_coef
|
||||||
|
TOUCH mo_coef C_PROVIDER H_PROVIDER g_PROVIDER cc_PROVIDER
|
||||||
|
|
||||||
|
! To update the other parameters if needed
|
||||||
|
call #update_parameters()
|
||||||
|
|
||||||
|
! To enforce the program to provide new criterion after the update
|
||||||
|
! of the parameters
|
||||||
|
FREE C_PROVIDER
|
||||||
|
PROVIDE C_PROVIDER
|
||||||
|
criterion = C_PROVIDER
|
||||||
|
|
||||||
|
! Criterion -> step accepted or rejected
|
||||||
|
call trust_region_is_step_cancelled(nb_iter, prev_criterion, criterion, criterion_model, rho, cancel_step)
|
||||||
|
|
||||||
|
! Cancellation of the step ?
|
||||||
|
if (cancel_step) then
|
||||||
|
! Replacement by the previous MOs
|
||||||
|
mo_coef = prev_mos
|
||||||
|
! call save_mos() ! depends of the time for 1 iteration
|
||||||
|
|
||||||
|
! No need to clear_mo_map since we don't recompute the gradient and the hessian
|
||||||
|
! mo_coef becomes valid
|
||||||
|
! Avoid the recomputation of the providers which depend of mo_coef
|
||||||
|
TOUCH mo_coef H_PROVIDER g_PROVIDER C_PROVIDER cc_PROVIDER
|
||||||
|
else
|
||||||
|
! The step is accepted:
|
||||||
|
! criterion -> prev criterion
|
||||||
|
|
||||||
|
! The replacement "criterion -> prev criterion" is already done
|
||||||
|
! in trust_region_rho, so if the criterion does not have a reason
|
||||||
|
! to change, it will change nothing for the criterion and will
|
||||||
|
! force the program to provide the new hessian, gradient and
|
||||||
|
! convergence criterion for the next iteration.
|
||||||
|
! But in the case of orbital optimization we diagonalize the CI
|
||||||
|
! matrix after the "FREE" statement, so the criterion will change
|
||||||
|
|
||||||
|
FREE C_PROVIDER H_PROVIDER g_PROVIDER cc_PROVIDER
|
||||||
|
PROVIDE C_PROVIDER H_PROVIDER g_PROVIDER cc_PROVIDER
|
||||||
|
prev_criterion = C_PROVIDER
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
nb_sub_iter = nb_sub_iter + 1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! call save_mos() ! depends of the time for 1 iteration
|
||||||
|
|
||||||
|
! To exit the external loop if must_exit = .True.
|
||||||
|
if (must_exit) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Step accepted, nb iteration + 1
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
! Provide the convergence criterion
|
||||||
|
! Provide the gradient and the hessian for the next iteration
|
||||||
|
PROVIDE cc_PROVIDER
|
||||||
|
|
||||||
|
! To exit
|
||||||
|
if (dabs(cc_PROVIDER) < thresh_opt_max_elem_grad) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (nb_iter > optimization_max_nb_iter) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (delta < thresh_delta) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Save the final MOs
|
||||||
|
call save_mos()
|
||||||
|
|
||||||
|
! Diagonalization of the hessian
|
||||||
|
! (To see the eigenvalues at the end of the optimization)
|
||||||
|
call diagonalization_hessian(tmp_n, H_PROVIDER, e_val, W)
|
||||||
|
|
||||||
|
deallocate(e_val, W, tmp_R, R, tmp_x, prev_mos)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Cartesian version
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_template_xyz.txt
|
||||||
|
subroutine algo_trust_cartesian_template(tmp_n)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! In
|
||||||
|
integer, intent(in) :: tmp_n
|
||||||
|
|
||||||
|
! Out
|
||||||
|
! Rien ou un truc pour savoir si ça c'est bien passé
|
||||||
|
|
||||||
|
! Internal
|
||||||
|
double precision, allocatable :: e_val(:), W(:,:), tmp_x(:)
|
||||||
|
double precision :: criterion, prev_criterion, criterion_model
|
||||||
|
double precision :: delta, rho
|
||||||
|
logical :: not_converged, cancel_step, must_exit
|
||||||
|
integer :: nb_iter, nb_sub_iter
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
allocate(W(tmp_n, tmp_n),e_val(tmp_n),tmp_x(tmp_n))
|
||||||
|
|
||||||
|
PROVIDE C_PROVIDER X_PROVIDER H_PROVIDER g_PROVIDER
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
delta = 0d0
|
||||||
|
nb_iter = 0 ! Must start at 0 !!!
|
||||||
|
rho = 0.5d0 ! Must start at 0.5
|
||||||
|
not_converged = .True. ! Must be true
|
||||||
|
|
||||||
|
! Compute the criterion before the loop
|
||||||
|
prev_criterion = C_PROVIDER
|
||||||
|
|
||||||
|
do while (not_converged)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'******************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'******************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
if (nb_iter > 0) then
|
||||||
|
PROVIDE H_PROVIDER g_PROVIDER
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Diagonalization of the hessian
|
||||||
|
call diagonalization_hessian(tmp_n, H_PROVIDER, e_val, W)
|
||||||
|
|
||||||
|
cancel_step = .True. ! To enter in the loop just after
|
||||||
|
nb_sub_iter = 0
|
||||||
|
|
||||||
|
! Loop to Reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
do while (cancel_step)
|
||||||
|
|
||||||
|
print*,'-----------------------------'
|
||||||
|
print*,'Iteration:', nb_iter
|
||||||
|
print*,'Sub iteration:', nb_sub_iter
|
||||||
|
print*,'-----------------------------'
|
||||||
|
|
||||||
|
! Hessian,gradient,Criterion -> x
|
||||||
|
call trust_region_step_w_expected_e(tmp_n, H_PROVIDER, W, e_val, g_PROVIDER, &
|
||||||
|
prev_criterion, rho, nb_iter, delta, criterion_model, tmp_x, must_exit)
|
||||||
|
|
||||||
|
if (must_exit) then
|
||||||
|
! if step_in_trust_region sets must_exit on true for numerical reasons
|
||||||
|
print*,'trust_region_step_w_expected_e sent the message : Exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! New coordinates, check the sign
|
||||||
|
X_PROVIDER = X_PROVIDER - tmp_x
|
||||||
|
|
||||||
|
! touch X_PROVIDER
|
||||||
|
TOUCH X_PROVIDER H_PROVIDER g_PROVIDER cc_PROVIDER
|
||||||
|
|
||||||
|
! To update the other parameters if needed
|
||||||
|
call #update_parameters()
|
||||||
|
|
||||||
|
! New criterion
|
||||||
|
PROVIDE C_PROVIDER ! Unnecessary
|
||||||
|
criterion = C_PROVIDER
|
||||||
|
|
||||||
|
! Criterion -> step accepted or rejected
|
||||||
|
call trust_region_is_step_cancelled(nb_iter, prev_criterion, criterion, criterion_model, rho, cancel_step)
|
||||||
|
|
||||||
|
! Cancel the previous step
|
||||||
|
if (cancel_step) then
|
||||||
|
! Replacement by the previous coordinates, check the sign
|
||||||
|
X_PROVIDER = X_PROVIDER + tmp_x
|
||||||
|
|
||||||
|
! Avoid the recomputation of the hessian and the gradient
|
||||||
|
TOUCH X_PROVIDER H_PROVIDER g_PROVIDER C_PROVIDER cc_PROVIDER
|
||||||
|
endif
|
||||||
|
|
||||||
|
nb_sub_iter = nb_sub_iter + 1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! To exit the external loop if must_exit = .True.
|
||||||
|
if (must_exit) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Step accepted, nb iteration + 1
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
PROVIDE cc_PROVIDER
|
||||||
|
|
||||||
|
! To exit
|
||||||
|
if (dabs(cc_PROVIDER) < thresh_opt_max_elem_grad) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (nb_iter > optimization_max_nb_iter) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (delta < thresh_delta) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(e_val, W, tmp_x)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Script template
|
||||||
|
#+BEGIN_SRC bash :tangle script_template_mos.sh
|
||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
your_file=
|
||||||
|
|
||||||
|
your_C_PROVIDER=
|
||||||
|
your_H_PROVIDER=
|
||||||
|
your_g_PROVIDER=
|
||||||
|
your_cc_PROVIDER=
|
||||||
|
|
||||||
|
sed "s/C_PROVIDER/$your_C_PROVIDER/g" trust_region_template_mos.txt > $your_file
|
||||||
|
sed -i "s/H_PROVIDER/$your_H_PROVIDER/g" $your_file
|
||||||
|
sed -i "s/g_PROVIDER/$your_g_PROVIDER/g" $your_file
|
||||||
|
sed -i "s/cc_PROVIDER/$your_cc_PROVIDER/g" $your_file
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC bash :tangle script_template_xyz.sh
|
||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
your_file=
|
||||||
|
|
||||||
|
your_C_PROVIDER=
|
||||||
|
your_X_PROVIDER=
|
||||||
|
your_H_PROVIDER=
|
||||||
|
your_g_PROVIDER=
|
||||||
|
your_cc_PROVIDER=
|
||||||
|
|
||||||
|
sed "s/C_PROVIDER/$your_C_PROVIDER/g" trust_region_template_xyz.txt > $your_file
|
||||||
|
sed -i "s/X_PROVIDER/$your_X_PROVIDER/g" $your_file
|
||||||
|
sed -i "s/H_PROVIDER/$your_H_PROVIDER/g" $your_file
|
||||||
|
sed -i "s/g_PROVIDER/$your_g_PROVIDER/g" $your_file
|
||||||
|
sed -i "s/cc_PROVIDER/$your_cc_PROVIDER/g" $your_file
|
||||||
|
#+END_SRC
|
||||||
|
|
85
src/utils_trust_region/apply_mo_rotation.irp.f
Normal file
85
src/utils_trust_region/apply_mo_rotation.irp.f
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
! Apply MO rotation
|
||||||
|
! Subroutine to apply the rotation matrix to the coefficients of the
|
||||||
|
! MOs.
|
||||||
|
|
||||||
|
! New MOs = Old MOs . Rotation matrix
|
||||||
|
|
||||||
|
! *Compute the new MOs with the previous MOs and a rotation matrix*
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
! | ao_num | integer | number of AOs |
|
||||||
|
! | mo_coef(ao_num,mo_num) | double precision | coefficients of the MOs |
|
||||||
|
|
||||||
|
! Intent in:
|
||||||
|
! | R(mo_num,mo_num) | double precision | rotation matrix |
|
||||||
|
|
||||||
|
! Intent out:
|
||||||
|
! | prev_mos(ao_num,mo_num) | double precision | MOs before the rotation |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | new_mos(ao_num,mo_num) | double precision | MOs after the rotation |
|
||||||
|
! | i,j | integer | indexes |
|
||||||
|
|
||||||
|
subroutine apply_mo_rotation(R,prev_mos)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the new MOs knowing the rotation matrix
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
double precision, intent(in) :: R(mo_num,mo_num)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: prev_mos(ao_num,mo_num)
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: new_mos(:,:)
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---apply_mo_rotation---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(new_mos(ao_num,mo_num))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
! Product of old MOs (mo_coef) by Rotation matrix (R)
|
||||||
|
call dgemm('N','N',ao_num,mo_num,mo_num,1d0,mo_coef,size(mo_coef,1),R,size(R,1),0d0,new_mos,size(new_mos,1))
|
||||||
|
|
||||||
|
prev_mos = mo_coef
|
||||||
|
mo_coef = new_mos
|
||||||
|
|
||||||
|
!if (debug) then
|
||||||
|
! print*,'New mo_coef : '
|
||||||
|
! do i = 1, mo_num
|
||||||
|
! write(*,'(100(F10.5))') mo_coef(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Save the new MOs and change the label
|
||||||
|
mo_label = 'MCSCF'
|
||||||
|
!call save_mos
|
||||||
|
call ezfio_set_determinants_mo_label(mo_label)
|
||||||
|
|
||||||
|
!print*,'Done, MOs saved'
|
||||||
|
|
||||||
|
! Deallocation, end
|
||||||
|
deallocate(new_mos)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in apply mo rotation:', t3
|
||||||
|
print*,'---End apply_mo_rotation---'
|
||||||
|
|
||||||
|
end subroutine
|
86
src/utils_trust_region/apply_mo_rotation.org
Normal file
86
src/utils_trust_region/apply_mo_rotation.org
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
* Apply MO rotation
|
||||||
|
Subroutine to apply the rotation matrix to the coefficients of the
|
||||||
|
MOs.
|
||||||
|
|
||||||
|
New MOs = Old MOs . Rotation matrix
|
||||||
|
|
||||||
|
*Compute the new MOs with the previous MOs and a rotation matrix*
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
| ao_num | integer | number of AOs |
|
||||||
|
| mo_coef(ao_num,mo_num) | double precision | coefficients of the MOs |
|
||||||
|
|
||||||
|
Intent in:
|
||||||
|
| R(mo_num,mo_num) | double precision | rotation matrix |
|
||||||
|
|
||||||
|
Intent out:
|
||||||
|
| prev_mos(ao_num,mo_num) | double precision | MOs before the rotation |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| new_mos(ao_num,mo_num) | double precision | MOs after the rotation |
|
||||||
|
| i,j | integer | indexes |
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle apply_mo_rotation.irp.f
|
||||||
|
subroutine apply_mo_rotation(R,prev_mos)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the new MOs knowing the rotation matrix
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
double precision, intent(in) :: R(mo_num,mo_num)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: prev_mos(ao_num,mo_num)
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: new_mos(:,:)
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---apply_mo_rotation---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(new_mos(ao_num,mo_num))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
! Product of old MOs (mo_coef) by Rotation matrix (R)
|
||||||
|
call dgemm('N','N',ao_num,mo_num,mo_num,1d0,mo_coef,size(mo_coef,1),R,size(R,1),0d0,new_mos,size(new_mos,1))
|
||||||
|
|
||||||
|
prev_mos = mo_coef
|
||||||
|
mo_coef = new_mos
|
||||||
|
|
||||||
|
!if (debug) then
|
||||||
|
! print*,'New mo_coef : '
|
||||||
|
! do i = 1, mo_num
|
||||||
|
! write(*,'(100(F10.5))') mo_coef(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Save the new MOs and change the label
|
||||||
|
mo_label = 'MCSCF'
|
||||||
|
!call save_mos
|
||||||
|
call ezfio_set_determinants_mo_label(mo_label)
|
||||||
|
|
||||||
|
!print*,'Done, MOs saved'
|
||||||
|
|
||||||
|
! Deallocation, end
|
||||||
|
deallocate(new_mos)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in apply mo rotation:', t3
|
||||||
|
print*,'---End apply_mo_rotation---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
61
src/utils_trust_region/mat_to_vec_index.irp.f
Normal file
61
src/utils_trust_region/mat_to_vec_index.irp.f
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
! Matrix to vector index
|
||||||
|
|
||||||
|
! *Compute the index i of a vector element from the indexes p,q of a
|
||||||
|
! matrix element*
|
||||||
|
|
||||||
|
! Lower diagonal matrix (p,q), p > q -> vector (i)
|
||||||
|
|
||||||
|
! If a matrix is antisymmetric it can be reshaped as a vector. And the
|
||||||
|
! vector can be reshaped as an antisymmetric matrix
|
||||||
|
|
||||||
|
! \begin{align*}
|
||||||
|
! \begin{pmatrix}
|
||||||
|
! 0 & -1 & -2 & -4 \\
|
||||||
|
! 1 & 0 & -3 & -5 \\
|
||||||
|
! 2 & 3 & 0 & -6 \\
|
||||||
|
! 4 & 5 & 6 & 0
|
||||||
|
! \end{pmatrix}
|
||||||
|
! \Leftrightarrow
|
||||||
|
! \begin{pmatrix}
|
||||||
|
! 1 & 2 & 3 & 4 & 5 & 6
|
||||||
|
! \end{pmatrix}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! !!! Here the algorithm only work for the lower diagonal !!!
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | p,q | integer | indexes of a matrix element in the lower diagonal |
|
||||||
|
! | | | p > q, q -> column |
|
||||||
|
! | | | p -> row, |
|
||||||
|
! | | | q -> column |
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | i | integer | corresponding index in the vector |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine mat_to_vec_index(p,q,i)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: p,q
|
||||||
|
|
||||||
|
! out
|
||||||
|
integer, intent(out) :: i
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: a,b
|
||||||
|
double precision :: da
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
a = p-1
|
||||||
|
b = a*(a-1)/2
|
||||||
|
|
||||||
|
i = q+b
|
||||||
|
|
||||||
|
end subroutine
|
63
src/utils_trust_region/mat_to_vec_index.org
Normal file
63
src/utils_trust_region/mat_to_vec_index.org
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
* Matrix to vector index
|
||||||
|
|
||||||
|
*Compute the index i of a vector element from the indexes p,q of a
|
||||||
|
matrix element*
|
||||||
|
|
||||||
|
Lower diagonal matrix (p,q), p > q -> vector (i)
|
||||||
|
|
||||||
|
If a matrix is antisymmetric it can be reshaped as a vector. And the
|
||||||
|
vector can be reshaped as an antisymmetric matrix
|
||||||
|
|
||||||
|
\begin{align*}
|
||||||
|
\begin{pmatrix}
|
||||||
|
0 & -1 & -2 & -4 \\
|
||||||
|
1 & 0 & -3 & -5 \\
|
||||||
|
2 & 3 & 0 & -6 \\
|
||||||
|
4 & 5 & 6 & 0
|
||||||
|
\end{pmatrix}
|
||||||
|
\Leftrightarrow
|
||||||
|
\begin{pmatrix}
|
||||||
|
1 & 2 & 3 & 4 & 5 & 6
|
||||||
|
\end{pmatrix}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
!!! Here the algorithm only work for the lower diagonal !!!
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| p,q | integer | indexes of a matrix element in the lower diagonal |
|
||||||
|
| | | p > q, q -> column |
|
||||||
|
| | | p -> row, |
|
||||||
|
| | | q -> column |
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| i | integer | corresponding index in the vector |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle mat_to_vec_index.irp.f
|
||||||
|
subroutine mat_to_vec_index(p,q,i)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: p,q
|
||||||
|
|
||||||
|
! out
|
||||||
|
integer, intent(out) :: i
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: a,b
|
||||||
|
double precision :: da
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
a = p-1
|
||||||
|
b = a*(a-1)/2
|
||||||
|
|
||||||
|
i = q+b
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
||||||
|
|
2
src/utils_trust_region/pi.h
Normal file
2
src/utils_trust_region/pi.h
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
!logical, parameter :: debug=.False.
|
||||||
|
double precision, parameter :: pi = 3.1415926535897932d0
|
443
src/utils_trust_region/rotation_matrix.irp.f
Normal file
443
src/utils_trust_region/rotation_matrix.irp.f
Normal file
@ -0,0 +1,443 @@
|
|||||||
|
! Rotation matrix
|
||||||
|
|
||||||
|
! *Build a rotation matrix from an antisymmetric matrix*
|
||||||
|
|
||||||
|
! Compute a rotation matrix $\textbf{R}$ from an antisymmetric matrix $$\textbf{A}$$ such as :
|
||||||
|
! $$
|
||||||
|
! \textbf{R}=\exp(\textbf{A})
|
||||||
|
! $$
|
||||||
|
|
||||||
|
! So :
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{R}=& \exp(\textbf{A}) \\
|
||||||
|
! =& \sum_k^{\infty} \frac{1}{k!}\textbf{A}^k \\
|
||||||
|
! =& \textbf{W} \cdot \cos(\tau) \cdot \textbf{W}^{\dagger} + \textbf{W} \cdot \tau^{-1} \cdot \sin(\tau) \cdot \textbf{W}^{\dagger} \cdot \textbf{A}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! With :
|
||||||
|
! $\textbf{W}$ : eigenvectors of $\textbf{A}^2$
|
||||||
|
! $\tau$ : $\sqrt{-x}$
|
||||||
|
! $x$ : eigenvalues of $\textbf{A}^2$
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | A(n,n) | double precision | antisymmetric matrix |
|
||||||
|
! | n | integer | number of columns of the A matrix |
|
||||||
|
! | LDA | integer | specifies the leading dimension of A, must be at least max(1,n) |
|
||||||
|
! | LDR | integer | specifies the leading dimension of R, must be at least max(1,n) |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | R(n,n) | double precision | Rotation matrix |
|
||||||
|
! | info | integer | if info = 0, the execution is successful |
|
||||||
|
! | | | if info = k, the k-th parameter has an illegal value |
|
||||||
|
! | | | if info = -k, the algorithm failed |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | B(n,n) | double precision | B = A.A |
|
||||||
|
! | work(lwork,n) | double precision | work matrix for dysev, dimension max(1,lwork) |
|
||||||
|
! | lwork | integer | dimension of the syev work array >= max(1, 3n-1) |
|
||||||
|
! | W(n,n) | double precision | eigenvectors of B |
|
||||||
|
! | e_val(n) | double precision | eigenvalues of B |
|
||||||
|
! | m_diag(n,n) | double precision | diagonal matrix with the eigenvalues of B |
|
||||||
|
! | cos_tau(n,n) | double precision | diagonal matrix with cos(tau) values |
|
||||||
|
! | sin_tau(n,n) | double precision | diagonal matrix with sin cos(tau) values |
|
||||||
|
! | tau_m1(n,n) | double precision | diagonal matrix with (tau)^-1 values |
|
||||||
|
! | part_1(n,n) | double precision | matrix W.cos_tau.W^t |
|
||||||
|
! | part_1a(n,n) | double precision | matrix cos_tau.W^t |
|
||||||
|
! | part_2(n,n) | double precision | matrix W.tau_m1.sin_tau.W^t.A |
|
||||||
|
! | part_2a(n,n) | double precision | matrix W^t.A |
|
||||||
|
! | part_2b(n,n) | double precision | matrix sin_tau.W^t.A |
|
||||||
|
! | part_2c(n,n) | double precision | matrix tau_m1.sin_tau.W^t.A |
|
||||||
|
! | RR_t(n,n) | double precision | R.R^t must be equal to the identity<=> R.R^t-1=0 <=> norm = 0 |
|
||||||
|
! | norm | integer | norm of R.R^t-1, must be equal to 0 |
|
||||||
|
! | i,j | integer | indexes |
|
||||||
|
|
||||||
|
! Functions:
|
||||||
|
! | dnrm2 | double precision | Lapack function, compute the norm of a matrix |
|
||||||
|
! | disnan | logical | Lapack function, check if an element is NaN |
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine rotation_matrix(A,LDA,R,LDR,n,info,enforce_step_cancellation)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Rotation matrix to rotate the molecular orbitals.
|
||||||
|
! If the rotation is too large the transformation is not unitary and must be cancelled.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n,LDA,LDR
|
||||||
|
double precision, intent(inout) :: A(LDA,n)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: R(LDR,n)
|
||||||
|
integer, intent(out) :: info
|
||||||
|
logical, intent(out) :: enforce_step_cancellation
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: B(:,:)
|
||||||
|
double precision, allocatable :: work(:,:)
|
||||||
|
double precision, allocatable :: W(:,:), e_val(:)
|
||||||
|
double precision, allocatable :: m_diag(:,:),cos_tau(:,:),sin_tau(:,:),tau_m1(:,:)
|
||||||
|
double precision, allocatable :: part_1(:,:),part_1a(:,:)
|
||||||
|
double precision, allocatable :: part_2(:,:),part_2a(:,:),part_2b(:,:),part_2c(:,:)
|
||||||
|
double precision, allocatable :: RR_t(:,:)
|
||||||
|
integer :: i,j
|
||||||
|
integer :: info2, lwork ! for dsyev
|
||||||
|
double precision :: norm, max_elem, max_elem_A, t1,t2,t3
|
||||||
|
|
||||||
|
! function
|
||||||
|
double precision :: dnrm2
|
||||||
|
logical :: disnan
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---rotation_matrix---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(B(n,n))
|
||||||
|
allocate(m_diag(n,n),cos_tau(n,n),sin_tau(n,n),tau_m1(n,n))
|
||||||
|
allocate(W(n,n),e_val(n))
|
||||||
|
allocate(part_1(n,n),part_1a(n,n))
|
||||||
|
allocate(part_2(n,n),part_2a(n,n),part_2b(n,n),part_2c(n,n))
|
||||||
|
allocate(RR_t(n,n))
|
||||||
|
|
||||||
|
! Pre-conditions
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
info=0
|
||||||
|
enforce_step_cancellation = .False.
|
||||||
|
|
||||||
|
! Size of matrix A must be at least 1 by 1
|
||||||
|
if (n<1) then
|
||||||
|
info = 3
|
||||||
|
print*, 'WARNING: invalid parameter 5'
|
||||||
|
print*, 'n<1'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Leading dimension of A must be >= n
|
||||||
|
if (LDA < n) then
|
||||||
|
info = 25
|
||||||
|
print*, 'WARNING: invalid parameter 2 or 5'
|
||||||
|
print*, 'LDA < n'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Leading dimension of A must be >= n
|
||||||
|
if (LDR < n) then
|
||||||
|
info = 4
|
||||||
|
print*, 'WARNING: invalid parameter 4'
|
||||||
|
print*, 'LDR < n'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Matrix elements of A must by non-NaN
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (disnan(A(i,j))) then
|
||||||
|
info=1
|
||||||
|
print*, 'WARNING: invalid parameter 1'
|
||||||
|
print*, 'NaN element in A matrix'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (A(i,i) /= 0d0) then
|
||||||
|
print*, 'WARNING: matrix A is not antisymmetric'
|
||||||
|
print*, 'Non 0 element on the diagonal', i, A(i,i)
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (A(i,j)+A(j,i)>1d-16) then
|
||||||
|
print*, 'WANRING: matrix A is not antisymmetric'
|
||||||
|
print*, 'A(i,j) /= - A(j,i):', i,j,A(i,j), A(j,i)
|
||||||
|
print*, 'diff:', A(i,j)+A(j,i)
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Fix for too big elements ! bad idea better to cancel if the error is too big
|
||||||
|
!do j = 1, n
|
||||||
|
! do i = 1, n
|
||||||
|
! A(i,j) = mod(A(i,j),2d0*pi)
|
||||||
|
! if (dabs(A(i,j)) > pi) then
|
||||||
|
! A(i,j) = 0d0
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
|
||||||
|
max_elem_A = 0d0
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(A(i,j)) > ABS(max_elem_A)) then
|
||||||
|
max_elem_A = A(i,j)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'max element in A', max_elem_A
|
||||||
|
|
||||||
|
if (ABS(max_elem_A) > 2 * pi) then
|
||||||
|
print*,''
|
||||||
|
print*,'WARNING: ABS(max_elem_A) > 2 pi '
|
||||||
|
print*,''
|
||||||
|
endif
|
||||||
|
|
||||||
|
! B=A.A
|
||||||
|
! - Calculation of the matrix $\textbf{B} = \textbf{A}^2$
|
||||||
|
! - Diagonalization of $\textbf{B}$
|
||||||
|
! W, the eigenvectors
|
||||||
|
! e_val, the eigenvalues
|
||||||
|
|
||||||
|
|
||||||
|
! Compute B=A.A
|
||||||
|
|
||||||
|
call dgemm('N','N',n,n,n,1d0,A,size(A,1),A,size(A,1),0d0,B,size(B,1))
|
||||||
|
|
||||||
|
! Copy B in W, diagonalization will put the eigenvectors in W
|
||||||
|
W=B
|
||||||
|
|
||||||
|
! Diagonalization of B
|
||||||
|
! Eigenvalues -> e_val
|
||||||
|
! Eigenvectors -> W
|
||||||
|
lwork = 3*n-1
|
||||||
|
allocate(work(lwork,n))
|
||||||
|
|
||||||
|
print*,'Starting diagonalization ...'
|
||||||
|
|
||||||
|
call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info2)
|
||||||
|
|
||||||
|
deallocate(work)
|
||||||
|
|
||||||
|
if (info2 == 0) then
|
||||||
|
print*, 'Diagonalization : Done'
|
||||||
|
elseif (info2 < 0) then
|
||||||
|
print*, 'WARNING: error in the diagonalization'
|
||||||
|
print*, 'Illegal value of the ', info2,'-th parameter'
|
||||||
|
else
|
||||||
|
print*, "WARNING: Diagonalization failed to converge"
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Tau^-1, cos(tau), sin(tau)
|
||||||
|
! $$\tau = \sqrt{-x}$$
|
||||||
|
! - Calculation of $\cos(\tau)$ $\Leftrightarrow$ $\cos(\sqrt{-x})$
|
||||||
|
! - Calculation of $\sin(\tau)$ $\Leftrightarrow$ $\sin(\sqrt{-x})$
|
||||||
|
! - Calculation of $\tau^{-1}$ $\Leftrightarrow$ $(\sqrt{-x})^{-1}$
|
||||||
|
! These matrices are diagonals
|
||||||
|
|
||||||
|
! Diagonal matrix m_diag
|
||||||
|
do j = 1, n
|
||||||
|
if (e_val(j) >= -1d-12) then !0.d0) then !!! e_avl(i) must be < -1d-12 to avoid numerical problems
|
||||||
|
e_val(j) = 0.d0
|
||||||
|
else
|
||||||
|
e_val(j) = - e_val(j)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
m_diag = 0.d0
|
||||||
|
do i = 1, n
|
||||||
|
m_diag(i,i) = e_val(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! cos_tau
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (i==j) then
|
||||||
|
cos_tau(i,j) = dcos(dsqrt(e_val(i)))
|
||||||
|
else
|
||||||
|
cos_tau(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! sin_tau
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (i==j) then
|
||||||
|
sin_tau(i,j) = dsin(dsqrt(e_val(i)))
|
||||||
|
else
|
||||||
|
sin_tau(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug, display the cos_tau and sin_tau matrix
|
||||||
|
!if (debug) then
|
||||||
|
! print*, 'cos_tau'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*, cos_tau(i,:)
|
||||||
|
! enddo
|
||||||
|
! print*, 'sin_tau'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*, sin_tau(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! tau^-1
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if ((i==j) .and. (e_val(i) > 1d-16)) then!0d0)) then !!! Convergence problem can come from here if the threshold is too big/small
|
||||||
|
tau_m1(i,j) = 1d0/(dsqrt(e_val(i)))
|
||||||
|
else
|
||||||
|
tau_m1(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
max_elem = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(tau_m1(i,i)) > ABS(max_elem)) then
|
||||||
|
max_elem = tau_m1(i,i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'max elem tau^-1:', max_elem
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!print*,'eigenvalues:'
|
||||||
|
!do i = 1, n
|
||||||
|
! print*, e_val(i)
|
||||||
|
!enddo
|
||||||
|
|
||||||
|
!Debug, display tau^-1
|
||||||
|
!if (debug) then
|
||||||
|
! print*, 'tau^-1'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*,tau_m1(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Rotation matrix
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{R} = \textbf{W} \cos(\tau) \textbf{W}^{\dagger} + \textbf{W} \tau^{-1} \sin(\tau) \textbf{W}^{\dagger} \textbf{A}
|
||||||
|
! \end{align*}
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{Part1} = \textbf{W} \cos(\tau) \textbf{W}^{\dagger}
|
||||||
|
! \end{align*}
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{Part2} = \textbf{W} \tau^{-1} \sin(\tau) \textbf{W}^{\dagger} \textbf{A}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! First:
|
||||||
|
! part_1 = dgemm(W, dgemm(cos_tau, W^t))
|
||||||
|
! part_1a = dgemm(cos_tau, W^t)
|
||||||
|
! part_1 = dgemm(W, part_1a)
|
||||||
|
! And:
|
||||||
|
! part_2= dgemm(W, dgemm(tau_m1, dgemm(sin_tau, dgemm(W^t, A))))
|
||||||
|
! part_2a = dgemm(W^t, A)
|
||||||
|
! part_2b = dgemm(sin_tau, part_2a)
|
||||||
|
! part_2c = dgemm(tau_m1, part_2b)
|
||||||
|
! part_2 = dgemm(W, part_2c)
|
||||||
|
! Finally:
|
||||||
|
! Rotation matrix, R = part_1+part_2
|
||||||
|
|
||||||
|
! If $R$ is a rotation matrix:
|
||||||
|
! $R.R^T=R^T.R=\textbf{1}$
|
||||||
|
|
||||||
|
! part_1
|
||||||
|
call dgemm('N','T',n,n,n,1d0,cos_tau,size(cos_tau,1),W,size(W,1),0d0,part_1a,size(part_1a,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,W,size(W,1),part_1a,size(part_1a,1),0d0,part_1,size(part_1,1))
|
||||||
|
|
||||||
|
! part_2
|
||||||
|
call dgemm('T','N',n,n,n,1d0,W,size(W,1),A,size(A,1),0d0,part_2a,size(part_2a,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,sin_tau,size(sin_tau,1),part_2a,size(part_2a,1),0d0,part_2b,size(part_2b,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,tau_m1,size(tau_m1,1),part_2b,size(part_2b,1),0d0,part_2c,size(part_2c,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,W,size(W,1),part_2c,size(part_2c,1),0d0,part_2,size(part_2,1))
|
||||||
|
|
||||||
|
! Rotation matrix R
|
||||||
|
R = part_1 + part_2
|
||||||
|
|
||||||
|
! Matrix check
|
||||||
|
! R.R^t and R^t.R must be equal to identity matrix
|
||||||
|
do j = 1, n
|
||||||
|
do i=1,n
|
||||||
|
if (i==j) then
|
||||||
|
RR_t(i,j) = 1d0
|
||||||
|
else
|
||||||
|
RR_t(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dgemm('N','T',n,n,n,1d0,R,size(R,1),R,size(R,1),-1d0,RR_t,size(RR_t,1))
|
||||||
|
|
||||||
|
norm = dnrm2(n*n,RR_t,1)
|
||||||
|
print*, 'Rotation matrix check, norm R.R^T = ', norm
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!if (debug) then
|
||||||
|
! print*, 'RR_t'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*, RR_t(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Post conditions
|
||||||
|
|
||||||
|
! Check if R.R^T=1
|
||||||
|
max_elem = 0d0
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(RR_t(i,j)) > ABS(max_elem)) then
|
||||||
|
max_elem = RR_t(i,j)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*, 'Max error in R.R^T:', max_elem
|
||||||
|
print*, 'e_val(1):', e_val(1)
|
||||||
|
print*, 'e_val(n):', e_val(n)
|
||||||
|
print*, 'max elem in A:', max_elem_A
|
||||||
|
|
||||||
|
if (ABS(max_elem) > 1d-12) then
|
||||||
|
print*, 'WARNING: max error in R.R^T > 1d-12'
|
||||||
|
print*, 'Enforce the step cancellation'
|
||||||
|
enforce_step_cancellation = .True.
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Matrix elements of R must by non-NaN
|
||||||
|
do j = 1,n
|
||||||
|
do i = 1,LDR
|
||||||
|
if (disnan(R(i,j))) then
|
||||||
|
info = 666
|
||||||
|
print*, 'NaN in rotation matrix'
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
!if (debug) then
|
||||||
|
! print*,'Rotation matrix :'
|
||||||
|
! do i = 1, n
|
||||||
|
! write(*,'(100(F10.5))') R(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Deallocation, end
|
||||||
|
|
||||||
|
deallocate(B)
|
||||||
|
deallocate(m_diag,cos_tau,sin_tau,tau_m1)
|
||||||
|
deallocate(W,e_val)
|
||||||
|
deallocate(part_1,part_1a)
|
||||||
|
deallocate(part_2,part_2a,part_2b,part_2c)
|
||||||
|
deallocate(RR_t)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2-t1
|
||||||
|
print*,'Time in rotation matrix:', t3
|
||||||
|
|
||||||
|
print*,'---End rotation_matrix---'
|
||||||
|
|
||||||
|
end subroutine
|
454
src/utils_trust_region/rotation_matrix.org
Normal file
454
src/utils_trust_region/rotation_matrix.org
Normal file
@ -0,0 +1,454 @@
|
|||||||
|
* Rotation matrix
|
||||||
|
|
||||||
|
*Build a rotation matrix from an antisymmetric matrix*
|
||||||
|
|
||||||
|
Compute a rotation matrix $\textbf{R}$ from an antisymmetric matrix $$\textbf{A}$$ such as :
|
||||||
|
$$
|
||||||
|
\textbf{R}=\exp(\textbf{A})
|
||||||
|
$$
|
||||||
|
|
||||||
|
So :
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{R}=& \exp(\textbf{A}) \\
|
||||||
|
=& \sum_k^{\infty} \frac{1}{k!}\textbf{A}^k \\
|
||||||
|
=& \textbf{W} \cdot \cos(\tau) \cdot \textbf{W}^{\dagger} + \textbf{W} \cdot \tau^{-1} \cdot \sin(\tau) \cdot \textbf{W}^{\dagger} \cdot \textbf{A}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
With :
|
||||||
|
$\textbf{W}$ : eigenvectors of $\textbf{A}^2$
|
||||||
|
$\tau$ : $\sqrt{-x}$
|
||||||
|
$x$ : eigenvalues of $\textbf{A}^2$
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| A(n,n) | double precision | antisymmetric matrix |
|
||||||
|
| n | integer | number of columns of the A matrix |
|
||||||
|
| LDA | integer | specifies the leading dimension of A, must be at least max(1,n) |
|
||||||
|
| LDR | integer | specifies the leading dimension of R, must be at least max(1,n) |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| R(n,n) | double precision | Rotation matrix |
|
||||||
|
| info | integer | if info = 0, the execution is successful |
|
||||||
|
| | | if info = k, the k-th parameter has an illegal value |
|
||||||
|
| | | if info = -k, the algorithm failed |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| B(n,n) | double precision | B = A.A |
|
||||||
|
| work(lwork,n) | double precision | work matrix for dysev, dimension max(1,lwork) |
|
||||||
|
| lwork | integer | dimension of the syev work array >= max(1, 3n-1) |
|
||||||
|
| W(n,n) | double precision | eigenvectors of B |
|
||||||
|
| e_val(n) | double precision | eigenvalues of B |
|
||||||
|
| m_diag(n,n) | double precision | diagonal matrix with the eigenvalues of B |
|
||||||
|
| cos_tau(n,n) | double precision | diagonal matrix with cos(tau) values |
|
||||||
|
| sin_tau(n,n) | double precision | diagonal matrix with sin cos(tau) values |
|
||||||
|
| tau_m1(n,n) | double precision | diagonal matrix with (tau)^-1 values |
|
||||||
|
| part_1(n,n) | double precision | matrix W.cos_tau.W^t |
|
||||||
|
| part_1a(n,n) | double precision | matrix cos_tau.W^t |
|
||||||
|
| part_2(n,n) | double precision | matrix W.tau_m1.sin_tau.W^t.A |
|
||||||
|
| part_2a(n,n) | double precision | matrix W^t.A |
|
||||||
|
| part_2b(n,n) | double precision | matrix sin_tau.W^t.A |
|
||||||
|
| part_2c(n,n) | double precision | matrix tau_m1.sin_tau.W^t.A |
|
||||||
|
| RR_t(n,n) | double precision | R.R^t must be equal to the identity<=> R.R^t-1=0 <=> norm = 0 |
|
||||||
|
| norm | integer | norm of R.R^t-1, must be equal to 0 |
|
||||||
|
| i,j | integer | indexes |
|
||||||
|
|
||||||
|
Functions:
|
||||||
|
| dnrm2 | double precision | Lapack function, compute the norm of a matrix |
|
||||||
|
| disnan | logical | Lapack function, check if an element is NaN |
|
||||||
|
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
subroutine rotation_matrix(A,LDA,R,LDR,n,info,enforce_step_cancellation)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Rotation matrix to rotate the molecular orbitals.
|
||||||
|
! If the rotation is too large the transformation is not unitary and must be cancelled.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n,LDA,LDR
|
||||||
|
double precision, intent(inout) :: A(LDA,n)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: R(LDR,n)
|
||||||
|
integer, intent(out) :: info
|
||||||
|
logical, intent(out) :: enforce_step_cancellation
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: B(:,:)
|
||||||
|
double precision, allocatable :: work(:,:)
|
||||||
|
double precision, allocatable :: W(:,:), e_val(:)
|
||||||
|
double precision, allocatable :: m_diag(:,:),cos_tau(:,:),sin_tau(:,:),tau_m1(:,:)
|
||||||
|
double precision, allocatable :: part_1(:,:),part_1a(:,:)
|
||||||
|
double precision, allocatable :: part_2(:,:),part_2a(:,:),part_2b(:,:),part_2c(:,:)
|
||||||
|
double precision, allocatable :: RR_t(:,:)
|
||||||
|
integer :: i,j
|
||||||
|
integer :: info2, lwork ! for dsyev
|
||||||
|
double precision :: norm, max_elem, max_elem_A, t1,t2,t3
|
||||||
|
|
||||||
|
! function
|
||||||
|
double precision :: dnrm2
|
||||||
|
logical :: disnan
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---rotation_matrix---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(B(n,n))
|
||||||
|
allocate(m_diag(n,n),cos_tau(n,n),sin_tau(n,n),tau_m1(n,n))
|
||||||
|
allocate(W(n,n),e_val(n))
|
||||||
|
allocate(part_1(n,n),part_1a(n,n))
|
||||||
|
allocate(part_2(n,n),part_2a(n,n),part_2b(n,n),part_2c(n,n))
|
||||||
|
allocate(RR_t(n,n))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Pre-conditions
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
! Initialization
|
||||||
|
info=0
|
||||||
|
enforce_step_cancellation = .False.
|
||||||
|
|
||||||
|
! Size of matrix A must be at least 1 by 1
|
||||||
|
if (n<1) then
|
||||||
|
info = 3
|
||||||
|
print*, 'WARNING: invalid parameter 5'
|
||||||
|
print*, 'n<1'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Leading dimension of A must be >= n
|
||||||
|
if (LDA < n) then
|
||||||
|
info = 25
|
||||||
|
print*, 'WARNING: invalid parameter 2 or 5'
|
||||||
|
print*, 'LDA < n'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Leading dimension of A must be >= n
|
||||||
|
if (LDR < n) then
|
||||||
|
info = 4
|
||||||
|
print*, 'WARNING: invalid parameter 4'
|
||||||
|
print*, 'LDR < n'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Matrix elements of A must by non-NaN
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (disnan(A(i,j))) then
|
||||||
|
info=1
|
||||||
|
print*, 'WARNING: invalid parameter 1'
|
||||||
|
print*, 'NaN element in A matrix'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (A(i,i) /= 0d0) then
|
||||||
|
print*, 'WARNING: matrix A is not antisymmetric'
|
||||||
|
print*, 'Non 0 element on the diagonal', i, A(i,i)
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (A(i,j)+A(j,i)>1d-16) then
|
||||||
|
print*, 'WANRING: matrix A is not antisymmetric'
|
||||||
|
print*, 'A(i,j) /= - A(j,i):', i,j,A(i,j), A(j,i)
|
||||||
|
print*, 'diff:', A(i,j)+A(j,i)
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Fix for too big elements ! bad idea better to cancel if the error is too big
|
||||||
|
!do j = 1, n
|
||||||
|
! do i = 1, n
|
||||||
|
! A(i,j) = mod(A(i,j),2d0*pi)
|
||||||
|
! if (dabs(A(i,j)) > pi) then
|
||||||
|
! A(i,j) = 0d0
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
|
||||||
|
max_elem_A = 0d0
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(A(i,j)) > ABS(max_elem_A)) then
|
||||||
|
max_elem_A = A(i,j)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'max element in A', max_elem_A
|
||||||
|
|
||||||
|
if (ABS(max_elem_A) > 2 * pi) then
|
||||||
|
print*,''
|
||||||
|
print*,'WARNING: ABS(max_elem_A) > 2 pi '
|
||||||
|
print*,''
|
||||||
|
endif
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Calculations
|
||||||
|
|
||||||
|
*** B=A.A
|
||||||
|
- Calculation of the matrix $\textbf{B} = \textbf{A}^2$
|
||||||
|
- Diagonalization of $\textbf{B}$
|
||||||
|
W, the eigenvectors
|
||||||
|
e_val, the eigenvalues
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
! Compute B=A.A
|
||||||
|
|
||||||
|
call dgemm('N','N',n,n,n,1d0,A,size(A,1),A,size(A,1),0d0,B,size(B,1))
|
||||||
|
|
||||||
|
! Copy B in W, diagonalization will put the eigenvectors in W
|
||||||
|
W=B
|
||||||
|
|
||||||
|
! Diagonalization of B
|
||||||
|
! Eigenvalues -> e_val
|
||||||
|
! Eigenvectors -> W
|
||||||
|
lwork = 3*n-1
|
||||||
|
allocate(work(lwork,n))
|
||||||
|
|
||||||
|
print*,'Starting diagonalization ...'
|
||||||
|
|
||||||
|
call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info2)
|
||||||
|
|
||||||
|
deallocate(work)
|
||||||
|
|
||||||
|
if (info2 == 0) then
|
||||||
|
print*, 'Diagonalization : Done'
|
||||||
|
elseif (info2 < 0) then
|
||||||
|
print*, 'WARNING: error in the diagonalization'
|
||||||
|
print*, 'Illegal value of the ', info2,'-th parameter'
|
||||||
|
else
|
||||||
|
print*, "WARNING: Diagonalization failed to converge"
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Tau^-1, cos(tau), sin(tau)
|
||||||
|
$$\tau = \sqrt{-x}$$
|
||||||
|
- Calculation of $\cos(\tau)$ $\Leftrightarrow$ $\cos(\sqrt{-x})$
|
||||||
|
- Calculation of $\sin(\tau)$ $\Leftrightarrow$ $\sin(\sqrt{-x})$
|
||||||
|
- Calculation of $\tau^{-1}$ $\Leftrightarrow$ $(\sqrt{-x})^{-1}$
|
||||||
|
These matrices are diagonals
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
! Diagonal matrix m_diag
|
||||||
|
do j = 1, n
|
||||||
|
if (e_val(j) >= -1d-12) then !0.d0) then !!! e_avl(i) must be < -1d-12 to avoid numerical problems
|
||||||
|
e_val(j) = 0.d0
|
||||||
|
else
|
||||||
|
e_val(j) = - e_val(j)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
m_diag = 0.d0
|
||||||
|
do i = 1, n
|
||||||
|
m_diag(i,i) = e_val(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! cos_tau
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (i==j) then
|
||||||
|
cos_tau(i,j) = dcos(dsqrt(e_val(i)))
|
||||||
|
else
|
||||||
|
cos_tau(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! sin_tau
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (i==j) then
|
||||||
|
sin_tau(i,j) = dsin(dsqrt(e_val(i)))
|
||||||
|
else
|
||||||
|
sin_tau(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug, display the cos_tau and sin_tau matrix
|
||||||
|
!if (debug) then
|
||||||
|
! print*, 'cos_tau'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*, cos_tau(i,:)
|
||||||
|
! enddo
|
||||||
|
! print*, 'sin_tau'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*, sin_tau(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! tau^-1
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if ((i==j) .and. (e_val(i) > 1d-16)) then!0d0)) then !!! Convergence problem can come from here if the threshold is too big/small
|
||||||
|
tau_m1(i,j) = 1d0/(dsqrt(e_val(i)))
|
||||||
|
else
|
||||||
|
tau_m1(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
max_elem = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(tau_m1(i,i)) > ABS(max_elem)) then
|
||||||
|
max_elem = tau_m1(i,i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'max elem tau^-1:', max_elem
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!print*,'eigenvalues:'
|
||||||
|
!do i = 1, n
|
||||||
|
! print*, e_val(i)
|
||||||
|
!enddo
|
||||||
|
|
||||||
|
!Debug, display tau^-1
|
||||||
|
!if (debug) then
|
||||||
|
! print*, 'tau^-1'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*,tau_m1(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Rotation matrix
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{R} = \textbf{W} \cos(\tau) \textbf{W}^{\dagger} + \textbf{W} \tau^{-1} \sin(\tau) \textbf{W}^{\dagger} \textbf{A}
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{Part1} = \textbf{W} \cos(\tau) \textbf{W}^{\dagger}
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{Part2} = \textbf{W} \tau^{-1} \sin(\tau) \textbf{W}^{\dagger} \textbf{A}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
First:
|
||||||
|
part_1 = dgemm(W, dgemm(cos_tau, W^t))
|
||||||
|
part_1a = dgemm(cos_tau, W^t)
|
||||||
|
part_1 = dgemm(W, part_1a)
|
||||||
|
And:
|
||||||
|
part_2= dgemm(W, dgemm(tau_m1, dgemm(sin_tau, dgemm(W^t, A))))
|
||||||
|
part_2a = dgemm(W^t, A)
|
||||||
|
part_2b = dgemm(sin_tau, part_2a)
|
||||||
|
part_2c = dgemm(tau_m1, part_2b)
|
||||||
|
part_2 = dgemm(W, part_2c)
|
||||||
|
Finally:
|
||||||
|
Rotation matrix, R = part_1+part_2
|
||||||
|
|
||||||
|
If $R$ is a rotation matrix:
|
||||||
|
$R.R^T=R^T.R=\textbf{1}$
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
! part_1
|
||||||
|
call dgemm('N','T',n,n,n,1d0,cos_tau,size(cos_tau,1),W,size(W,1),0d0,part_1a,size(part_1a,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,W,size(W,1),part_1a,size(part_1a,1),0d0,part_1,size(part_1,1))
|
||||||
|
|
||||||
|
! part_2
|
||||||
|
call dgemm('T','N',n,n,n,1d0,W,size(W,1),A,size(A,1),0d0,part_2a,size(part_2a,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,sin_tau,size(sin_tau,1),part_2a,size(part_2a,1),0d0,part_2b,size(part_2b,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,tau_m1,size(tau_m1,1),part_2b,size(part_2b,1),0d0,part_2c,size(part_2c,1))
|
||||||
|
call dgemm('N','N',n,n,n,1d0,W,size(W,1),part_2c,size(part_2c,1),0d0,part_2,size(part_2,1))
|
||||||
|
|
||||||
|
! Rotation matrix R
|
||||||
|
R = part_1 + part_2
|
||||||
|
|
||||||
|
! Matrix check
|
||||||
|
! R.R^t and R^t.R must be equal to identity matrix
|
||||||
|
do j = 1, n
|
||||||
|
do i=1,n
|
||||||
|
if (i==j) then
|
||||||
|
RR_t(i,j) = 1d0
|
||||||
|
else
|
||||||
|
RR_t(i,j) = 0d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dgemm('N','T',n,n,n,1d0,R,size(R,1),R,size(R,1),-1d0,RR_t,size(RR_t,1))
|
||||||
|
|
||||||
|
norm = dnrm2(n*n,RR_t,1)
|
||||||
|
print*, 'Rotation matrix check, norm R.R^T = ', norm
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!if (debug) then
|
||||||
|
! print*, 'RR_t'
|
||||||
|
! do i = 1, n
|
||||||
|
! print*, RR_t(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Post conditions
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
! Check if R.R^T=1
|
||||||
|
max_elem = 0d0
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(RR_t(i,j)) > ABS(max_elem)) then
|
||||||
|
max_elem = RR_t(i,j)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*, 'Max error in R.R^T:', max_elem
|
||||||
|
print*, 'e_val(1):', e_val(1)
|
||||||
|
print*, 'e_val(n):', e_val(n)
|
||||||
|
print*, 'max elem in A:', max_elem_A
|
||||||
|
|
||||||
|
if (ABS(max_elem) > 1d-12) then
|
||||||
|
print*, 'WARNING: max error in R.R^T > 1d-12'
|
||||||
|
print*, 'Enforce the step cancellation'
|
||||||
|
enforce_step_cancellation = .True.
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Matrix elements of R must by non-NaN
|
||||||
|
do j = 1,n
|
||||||
|
do i = 1,LDR
|
||||||
|
if (disnan(R(i,j))) then
|
||||||
|
info = 666
|
||||||
|
print*, 'NaN in rotation matrix'
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
!if (debug) then
|
||||||
|
! print*,'Rotation matrix :'
|
||||||
|
! do i = 1, n
|
||||||
|
! write(*,'(100(F10.5))') R(i,:)
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Deallocation, end
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle rotation_matrix.irp.f
|
||||||
|
deallocate(B)
|
||||||
|
deallocate(m_diag,cos_tau,sin_tau,tau_m1)
|
||||||
|
deallocate(W,e_val)
|
||||||
|
deallocate(part_1,part_1a)
|
||||||
|
deallocate(part_2,part_2a,part_2b,part_2c)
|
||||||
|
deallocate(RR_t)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2-t1
|
||||||
|
print*,'Time in rotation matrix:', t3
|
||||||
|
|
||||||
|
print*,'---End rotation_matrix---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
||||||
|
|
64
src/utils_trust_region/sub_to_full_rotation_matrix.irp.f
Normal file
64
src/utils_trust_region/sub_to_full_rotation_matrix.irp.f
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
! Rotation matrix in a subspace to rotation matrix in the full space
|
||||||
|
|
||||||
|
! Usually, we are using a list of MOs, for exemple the active ones. When
|
||||||
|
! we compute a rotation matrix to rotate the MOs, we just compute a
|
||||||
|
! rotation matrix for these MOs in order to reduce the size of the
|
||||||
|
! matrix which has to be computed. Since the computation of a rotation
|
||||||
|
! matrix scale in $O(N^3)$ with $N$ the number of MOs, it's better to
|
||||||
|
! reuce the number of MOs involved.
|
||||||
|
! After that we replace the rotation matrix in the full space by
|
||||||
|
! building the elements of the rotation matrix in the full space from
|
||||||
|
! the elements of the rotation matrix in the subspace and adding some 0
|
||||||
|
! on the extradiagonal elements and some 1 on the diagonal elements,
|
||||||
|
! for the MOs that are not involved in the rotation.
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | Number of MOs |
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | m | integer | Size of tmp_list, m <= mo_num |
|
||||||
|
! | tmp_list(m) | integer | List of MOs |
|
||||||
|
! | tmp_R(m,m) | double precision | Rotation matrix in the space of |
|
||||||
|
! | | | the MOs containing by tmp_list |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | R(mo_num,mo_num | double precision | Rotation matrix in the space |
|
||||||
|
! | | | of all the MOs |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | i,j | integer | indexes in the full space |
|
||||||
|
! | tmp_i,tmp_j | integer | indexes in the subspace |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine sub_to_full_rotation_matrix(m,tmp_list,tmp_R,R)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the full rotation matrix from a smaller one
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: m, tmp_list(m)
|
||||||
|
double precision, intent(in) :: tmp_R(m,m)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: R(mo_num,mo_num)
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: i,j,tmp_i,tmp_j
|
||||||
|
|
||||||
|
! tmp_R to R, subspace to full space
|
||||||
|
R = 0d0
|
||||||
|
do i = 1, mo_num
|
||||||
|
R(i,i) = 1d0 ! 1 on the diagonal because it is a rotation matrix, 1 = nothing change for the corresponding orbital
|
||||||
|
enddo
|
||||||
|
do tmp_j = 1, m
|
||||||
|
j = tmp_list(tmp_j)
|
||||||
|
do tmp_i = 1, m
|
||||||
|
i = tmp_list(tmp_i)
|
||||||
|
R(i,j) = tmp_R(tmp_i,tmp_j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
65
src/utils_trust_region/sub_to_full_rotation_matrix.org
Normal file
65
src/utils_trust_region/sub_to_full_rotation_matrix.org
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
* Rotation matrix in a subspace to rotation matrix in the full space
|
||||||
|
|
||||||
|
Usually, we are using a list of MOs, for exemple the active ones. When
|
||||||
|
we compute a rotation matrix to rotate the MOs, we just compute a
|
||||||
|
rotation matrix for these MOs in order to reduce the size of the
|
||||||
|
matrix which has to be computed. Since the computation of a rotation
|
||||||
|
matrix scale in $O(N^3)$ with $N$ the number of MOs, it's better to
|
||||||
|
reuce the number of MOs involved.
|
||||||
|
After that we replace the rotation matrix in the full space by
|
||||||
|
building the elements of the rotation matrix in the full space from
|
||||||
|
the elements of the rotation matrix in the subspace and adding some 0
|
||||||
|
on the extradiagonal elements and some 1 on the diagonal elements,
|
||||||
|
for the MOs that are not involved in the rotation.
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | Number of MOs |
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| m | integer | Size of tmp_list, m <= mo_num |
|
||||||
|
| tmp_list(m) | integer | List of MOs |
|
||||||
|
| tmp_R(m,m) | double precision | Rotation matrix in the space of |
|
||||||
|
| | | the MOs containing by tmp_list |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| R(mo_num,mo_num | double precision | Rotation matrix in the space |
|
||||||
|
| | | of all the MOs |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| i,j | integer | indexes in the full space |
|
||||||
|
| tmp_i,tmp_j | integer | indexes in the subspace |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle sub_to_full_rotation_matrix.irp.f
|
||||||
|
subroutine sub_to_full_rotation_matrix(m,tmp_list,tmp_R,R)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the full rotation matrix from a smaller one
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: m, tmp_list(m)
|
||||||
|
double precision, intent(in) :: tmp_R(m,m)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: R(mo_num,mo_num)
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: i,j,tmp_i,tmp_j
|
||||||
|
|
||||||
|
! tmp_R to R, subspace to full space
|
||||||
|
R = 0d0
|
||||||
|
do i = 1, mo_num
|
||||||
|
R(i,i) = 1d0 ! 1 on the diagonal because it is a rotation matrix, 1 = nothing change for the corresponding orbital
|
||||||
|
enddo
|
||||||
|
do tmp_j = 1, m
|
||||||
|
j = tmp_list(tmp_j)
|
||||||
|
do tmp_i = 1, m
|
||||||
|
i = tmp_list(tmp_i)
|
||||||
|
R(i,j) = tmp_R(tmp_i,tmp_j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
119
src/utils_trust_region/trust_region_expected_e.irp.f
Normal file
119
src/utils_trust_region/trust_region_expected_e.irp.f
Normal file
@ -0,0 +1,119 @@
|
|||||||
|
! Predicted energy : e_model
|
||||||
|
|
||||||
|
! *Compute the energy predicted by the Taylor series*
|
||||||
|
|
||||||
|
! The energy is predicted using a Taylor expansion truncated at te 2nd
|
||||||
|
! order :
|
||||||
|
|
||||||
|
! \begin{align*}
|
||||||
|
! E_{k+1} = E_{k} + \textbf{g}_k^{T} \cdot \textbf{x}_{k+1} + \frac{1}{2} \cdot \textbf{x}_{k+1}^T \cdot \textbf{H}_{k} \cdot \textbf{x}_{k+1} + \mathcal{O}(\textbf{x}_{k+1}^2)
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | n | integer | m*(m-1)/2 |
|
||||||
|
! | v_grad(n) | double precision | gradient |
|
||||||
|
! | H(n,n) | double precision | hessian |
|
||||||
|
! | x(n) | double precision | Step in the trust region |
|
||||||
|
! | prev_energy | double precision | previous energy |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | e_model | double precision | predicted energy after the rotation of the MOs |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | part_1 | double precision | v_grad^T.x |
|
||||||
|
! | part_2 | double precision | 1/2 . x^T.H.x |
|
||||||
|
! | part_2a | double precision | H.x |
|
||||||
|
! | i,j | integer | indexes |
|
||||||
|
|
||||||
|
! Function:
|
||||||
|
! | ddot | double precision | dot product (Lapack) |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine trust_region_expected_e(n,v_grad,H,x,prev_energy,e_model)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the expected criterion/energy after the application of the step x
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
double precision, intent(in) :: v_grad(n),H(n,n),x(n)
|
||||||
|
double precision, intent(in) :: prev_energy
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: e_model
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision :: part_1, part_2, t1,t2,t3
|
||||||
|
double precision, allocatable :: part_2a(:)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
!Function
|
||||||
|
double precision :: ddot
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---Trust_e_model---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(part_2a(n))
|
||||||
|
|
||||||
|
! Calculations
|
||||||
|
|
||||||
|
! part_1 corresponds to the product g.x
|
||||||
|
! part_2a corresponds to the product H.x
|
||||||
|
! part_2 corresponds to the product 0.5*(x^T.H.x)
|
||||||
|
|
||||||
|
! TODO: remove the dot products
|
||||||
|
|
||||||
|
|
||||||
|
! Product v_grad.x
|
||||||
|
part_1 = ddot(n,v_grad,1,x,1)
|
||||||
|
|
||||||
|
!if (debug) then
|
||||||
|
print*,'g.x : ', part_1
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Product H.x
|
||||||
|
call dgemv('N',n,n,1d0,H,size(H,1),x,1,0d0,part_2a,1)
|
||||||
|
|
||||||
|
! Product 1/2 . x^T.H.x
|
||||||
|
part_2 = 0.5d0 * ddot(n,x,1,part_2a,1)
|
||||||
|
|
||||||
|
!if (debug) then
|
||||||
|
print*,'1/2*x^T.H.x : ', part_2
|
||||||
|
!endif
|
||||||
|
|
||||||
|
print*,'prev_energy', prev_energy
|
||||||
|
|
||||||
|
! Sum
|
||||||
|
e_model = prev_energy + part_1 + part_2
|
||||||
|
|
||||||
|
! Writing the predicted energy
|
||||||
|
print*, 'Predicted energy after the rotation : ', e_model
|
||||||
|
print*, 'Previous energy - predicted energy:', prev_energy - e_model
|
||||||
|
|
||||||
|
! Can be deleted, already in another subroutine
|
||||||
|
if (DABS(prev_energy - e_model) < 1d-12 ) then
|
||||||
|
print*,'WARNING: ABS(prev_energy - e_model) < 1d-12'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(part_2a)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in trust e model:', t3
|
||||||
|
|
||||||
|
print*,'---End trust_e_model---'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
end subroutine
|
121
src/utils_trust_region/trust_region_expected_e.org
Normal file
121
src/utils_trust_region/trust_region_expected_e.org
Normal file
@ -0,0 +1,121 @@
|
|||||||
|
* Predicted energy : e_model
|
||||||
|
|
||||||
|
*Compute the energy predicted by the Taylor series*
|
||||||
|
|
||||||
|
The energy is predicted using a Taylor expansion truncated at te 2nd
|
||||||
|
order :
|
||||||
|
|
||||||
|
\begin{align*}
|
||||||
|
E_{k+1} = E_{k} + \textbf{g}_k^{T} \cdot \textbf{x}_{k+1} + \frac{1}{2} \cdot \textbf{x}_{k+1}^T \cdot \textbf{H}_{k} \cdot \textbf{x}_{k+1} + \mathcal{O}(\textbf{x}_{k+1}^2)
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| n | integer | m*(m-1)/2 |
|
||||||
|
| v_grad(n) | double precision | gradient |
|
||||||
|
| H(n,n) | double precision | hessian |
|
||||||
|
| x(n) | double precision | Step in the trust region |
|
||||||
|
| prev_energy | double precision | previous energy |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| e_model | double precision | predicted energy after the rotation of the MOs |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| part_1 | double precision | v_grad^T.x |
|
||||||
|
| part_2 | double precision | 1/2 . x^T.H.x |
|
||||||
|
| part_2a | double precision | H.x |
|
||||||
|
| i,j | integer | indexes |
|
||||||
|
|
||||||
|
Function:
|
||||||
|
| ddot | double precision | dot product (Lapack) |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_expected_e.irp.f
|
||||||
|
subroutine trust_region_expected_e(n,v_grad,H,x,prev_energy,e_model)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the expected criterion/energy after the application of the step x
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
double precision, intent(in) :: v_grad(n),H(n,n),x(n)
|
||||||
|
double precision, intent(in) :: prev_energy
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: e_model
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision :: part_1, part_2, t1,t2,t3
|
||||||
|
double precision, allocatable :: part_2a(:)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
!Function
|
||||||
|
double precision :: ddot
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---Trust_e_model---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(part_2a(n))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Calculations
|
||||||
|
|
||||||
|
part_1 corresponds to the product g.x
|
||||||
|
part_2a corresponds to the product H.x
|
||||||
|
part_2 corresponds to the product 0.5*(x^T.H.x)
|
||||||
|
|
||||||
|
TODO: remove the dot products
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_expected_e.irp.f
|
||||||
|
! Product v_grad.x
|
||||||
|
part_1 = ddot(n,v_grad,1,x,1)
|
||||||
|
|
||||||
|
!if (debug) then
|
||||||
|
print*,'g.x : ', part_1
|
||||||
|
!endif
|
||||||
|
|
||||||
|
! Product H.x
|
||||||
|
call dgemv('N',n,n,1d0,H,size(H,1),x,1,0d0,part_2a,1)
|
||||||
|
|
||||||
|
! Product 1/2 . x^T.H.x
|
||||||
|
part_2 = 0.5d0 * ddot(n,x,1,part_2a,1)
|
||||||
|
|
||||||
|
!if (debug) then
|
||||||
|
print*,'1/2*x^T.H.x : ', part_2
|
||||||
|
!endif
|
||||||
|
|
||||||
|
print*,'prev_energy', prev_energy
|
||||||
|
|
||||||
|
! Sum
|
||||||
|
e_model = prev_energy + part_1 + part_2
|
||||||
|
|
||||||
|
! Writing the predicted energy
|
||||||
|
print*, 'Predicted energy after the rotation : ', e_model
|
||||||
|
print*, 'Previous energy - predicted energy:', prev_energy - e_model
|
||||||
|
|
||||||
|
! Can be deleted, already in another subroutine
|
||||||
|
if (DABS(prev_energy - e_model) < 1d-12 ) then
|
||||||
|
print*,'WARNING: ABS(prev_energy - e_model) < 1d-12'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(part_2a)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in trust e model:', t3
|
||||||
|
|
||||||
|
print*,'---End trust_e_model---'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
1655
src/utils_trust_region/trust_region_optimal_lambda.irp.f
Normal file
1655
src/utils_trust_region/trust_region_optimal_lambda.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
1665
src/utils_trust_region/trust_region_optimal_lambda.org
Normal file
1665
src/utils_trust_region/trust_region_optimal_lambda.org
Normal file
File diff suppressed because it is too large
Load Diff
121
src/utils_trust_region/trust_region_rho.irp.f
Normal file
121
src/utils_trust_region/trust_region_rho.irp.f
Normal file
@ -0,0 +1,121 @@
|
|||||||
|
! Agreement with the model: Rho
|
||||||
|
|
||||||
|
! *Compute the ratio : rho = (prev_energy - energy) / (prev_energy - e_model)*
|
||||||
|
|
||||||
|
! Rho represents the agreement between the model (the predicted energy
|
||||||
|
! by the Taylor expansion truncated at the 2nd order) and the real
|
||||||
|
! energy :
|
||||||
|
|
||||||
|
! \begin{equation}
|
||||||
|
! \rho^{k+1} = \frac{E^{k} - E^{k+1}}{E^{k} - m^{k+1}}
|
||||||
|
! \end{equation}
|
||||||
|
! With :
|
||||||
|
! $E^{k}$ the energy at the previous iteration
|
||||||
|
! $E^{k+1}$ the energy at the actual iteration
|
||||||
|
! $m^{k+1}$ the predicted energy for the actual iteration
|
||||||
|
! (cf. trust_e_model)
|
||||||
|
|
||||||
|
! If $\rho \approx 1$, the agreement is good, contrary to $\rho \approx 0$.
|
||||||
|
! If $\rho \leq 0$ the previous energy is lower than the actual
|
||||||
|
! energy. We have to cancel the last step and use a smaller trust
|
||||||
|
! region.
|
||||||
|
! Here we cancel the last step if $\rho < 0.1$, because even if
|
||||||
|
! the energy decreases, the agreement is bad, i.e., the Taylor expansion
|
||||||
|
! truncated at the second order doesn't represent correctly the energy
|
||||||
|
! landscape. So it's better to cancel the step and restart with a
|
||||||
|
! smaller trust region.
|
||||||
|
|
||||||
|
! Provided in qp_edit:
|
||||||
|
! | thresh_rho |
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | prev_energy | double precision | previous energy (energy before the rotation) |
|
||||||
|
! | e_model | double precision | predicted energy after the rotation |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | rho | double precision | the agreement between the model (predicted) and the real energy |
|
||||||
|
! | prev_energy | double precision | if rho >= 0.1 the actual energy becomes the previous energy |
|
||||||
|
! | | | else the previous energy doesn't change |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | energy | double precision | energy (real) after the rotation |
|
||||||
|
! | i | integer | index |
|
||||||
|
! | t* | double precision | time |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine trust_region_rho(prev_energy, energy,e_model,rho)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute rho, the agreement between the predicted criterion/energy and the real one
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! In
|
||||||
|
double precision, intent(inout) :: prev_energy
|
||||||
|
double precision, intent(in) :: e_model, energy
|
||||||
|
|
||||||
|
! Out
|
||||||
|
double precision, intent(out) :: rho
|
||||||
|
|
||||||
|
! Internal
|
||||||
|
double precision :: t1, t2, t3
|
||||||
|
integer :: i
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---Rho_model---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Rho
|
||||||
|
! \begin{equation}
|
||||||
|
! \rho^{k+1} = \frac{E^{k} - E^{k+1}}{E^{k} - m^{k+1}}
|
||||||
|
! \end{equation}
|
||||||
|
|
||||||
|
! In function of $\rho$ th step can be accepted or cancelled.
|
||||||
|
|
||||||
|
! If we cancel the last step (k+1), the previous energy (k) doesn't
|
||||||
|
! change!
|
||||||
|
! If the step (k+1) is accepted, then the "previous energy" becomes E(k+1)
|
||||||
|
|
||||||
|
|
||||||
|
! Already done in an other subroutine
|
||||||
|
!if (ABS(prev_energy - e_model) < 1d-12) then
|
||||||
|
! print*,'WARNING: prev_energy - e_model < 1d-12'
|
||||||
|
! print*,'=> rho will tend toward infinity'
|
||||||
|
! print*,'Check you convergence criterion !'
|
||||||
|
!endif
|
||||||
|
|
||||||
|
rho = (prev_energy - energy) / (prev_energy - e_model)
|
||||||
|
|
||||||
|
print*, 'previous energy, prev_energy :', prev_energy
|
||||||
|
print*, 'predicted energy, e_model :', e_model
|
||||||
|
print*, 'real energy, energy :', energy
|
||||||
|
print*, 'prev_energy - energy :', prev_energy - energy
|
||||||
|
print*, 'prev_energy - e_model :', prev_energy - e_model
|
||||||
|
print*, 'Rho :', rho
|
||||||
|
print*, 'Threshold for rho:', thresh_rho
|
||||||
|
|
||||||
|
! Modification of prev_energy in function of rho
|
||||||
|
if (rho < thresh_rho) then !0.1) then
|
||||||
|
! the step is cancelled
|
||||||
|
print*, 'Rho <', thresh_rho,', the previous energy does not changed'
|
||||||
|
print*, 'prev_energy :', prev_energy
|
||||||
|
else
|
||||||
|
! the step is accepted
|
||||||
|
prev_energy = energy
|
||||||
|
print*, 'Rho >=', thresh_rho,', energy -> prev_energy :', energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in rho model:', t3
|
||||||
|
|
||||||
|
print*,'---End rho_model---'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
end subroutine
|
123
src/utils_trust_region/trust_region_rho.org
Normal file
123
src/utils_trust_region/trust_region_rho.org
Normal file
@ -0,0 +1,123 @@
|
|||||||
|
* Agreement with the model: Rho
|
||||||
|
|
||||||
|
*Compute the ratio : rho = (prev_energy - energy) / (prev_energy - e_model)*
|
||||||
|
|
||||||
|
Rho represents the agreement between the model (the predicted energy
|
||||||
|
by the Taylor expansion truncated at the 2nd order) and the real
|
||||||
|
energy :
|
||||||
|
|
||||||
|
\begin{equation}
|
||||||
|
\rho^{k+1} = \frac{E^{k} - E^{k+1}}{E^{k} - m^{k+1}}
|
||||||
|
\end{equation}
|
||||||
|
With :
|
||||||
|
$E^{k}$ the energy at the previous iteration
|
||||||
|
$E^{k+1}$ the energy at the actual iteration
|
||||||
|
$m^{k+1}$ the predicted energy for the actual iteration
|
||||||
|
(cf. trust_e_model)
|
||||||
|
|
||||||
|
If $\rho \approx 1$, the agreement is good, contrary to $\rho \approx 0$.
|
||||||
|
If $\rho \leq 0$ the previous energy is lower than the actual
|
||||||
|
energy. We have to cancel the last step and use a smaller trust
|
||||||
|
region.
|
||||||
|
Here we cancel the last step if $\rho < 0.1$, because even if
|
||||||
|
the energy decreases, the agreement is bad, i.e., the Taylor expansion
|
||||||
|
truncated at the second order doesn't represent correctly the energy
|
||||||
|
landscape. So it's better to cancel the step and restart with a
|
||||||
|
smaller trust region.
|
||||||
|
|
||||||
|
Provided in qp_edit:
|
||||||
|
| thresh_rho |
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| prev_energy | double precision | previous energy (energy before the rotation) |
|
||||||
|
| e_model | double precision | predicted energy after the rotation |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| rho | double precision | the agreement between the model (predicted) and the real energy |
|
||||||
|
| prev_energy | double precision | if rho >= 0.1 the actual energy becomes the previous energy |
|
||||||
|
| | | else the previous energy doesn't change |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| energy | double precision | energy (real) after the rotation |
|
||||||
|
| i | integer | index |
|
||||||
|
| t* | double precision | time |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_rho.irp.f
|
||||||
|
subroutine trust_region_rho(prev_energy, energy,e_model,rho)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute rho, the agreement between the predicted criterion/energy and the real one
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! In
|
||||||
|
double precision, intent(inout) :: prev_energy
|
||||||
|
double precision, intent(in) :: e_model, energy
|
||||||
|
|
||||||
|
! Out
|
||||||
|
double precision, intent(out) :: rho
|
||||||
|
|
||||||
|
! Internal
|
||||||
|
double precision :: t1, t2, t3
|
||||||
|
integer :: i
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---Rho_model---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Rho
|
||||||
|
\begin{equation}
|
||||||
|
\rho^{k+1} = \frac{E^{k} - E^{k+1}}{E^{k} - m^{k+1}}
|
||||||
|
\end{equation}
|
||||||
|
|
||||||
|
In function of $\rho$ th step can be accepted or cancelled.
|
||||||
|
|
||||||
|
If we cancel the last step (k+1), the previous energy (k) doesn't
|
||||||
|
change!
|
||||||
|
If the step (k+1) is accepted, then the "previous energy" becomes E(k+1)
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_rho.irp.f
|
||||||
|
! Already done in an other subroutine
|
||||||
|
!if (ABS(prev_energy - e_model) < 1d-12) then
|
||||||
|
! print*,'WARNING: prev_energy - e_model < 1d-12'
|
||||||
|
! print*,'=> rho will tend toward infinity'
|
||||||
|
! print*,'Check you convergence criterion !'
|
||||||
|
!endif
|
||||||
|
|
||||||
|
rho = (prev_energy - energy) / (prev_energy - e_model)
|
||||||
|
|
||||||
|
print*, 'previous energy, prev_energy :', prev_energy
|
||||||
|
print*, 'predicted energy, e_model :', e_model
|
||||||
|
print*, 'real energy, energy :', energy
|
||||||
|
print*, 'prev_energy - energy :', prev_energy - energy
|
||||||
|
print*, 'prev_energy - e_model :', prev_energy - e_model
|
||||||
|
print*, 'Rho :', rho
|
||||||
|
print*, 'Threshold for rho:', thresh_rho
|
||||||
|
|
||||||
|
! Modification of prev_energy in function of rho
|
||||||
|
if (rho < thresh_rho) then !0.1) then
|
||||||
|
! the step is cancelled
|
||||||
|
print*, 'Rho <', thresh_rho,', the previous energy does not changed'
|
||||||
|
print*, 'prev_energy :', prev_energy
|
||||||
|
else
|
||||||
|
! the step is accepted
|
||||||
|
prev_energy = energy
|
||||||
|
print*, 'Rho >=', thresh_rho,', energy -> prev_energy :', energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in rho model:', t3
|
||||||
|
|
||||||
|
print*,'---End rho_model---'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
716
src/utils_trust_region/trust_region_step.irp.f
Normal file
716
src/utils_trust_region/trust_region_step.irp.f
Normal file
@ -0,0 +1,716 @@
|
|||||||
|
! Trust region
|
||||||
|
|
||||||
|
! *Compute the next step with the trust region algorithm*
|
||||||
|
|
||||||
|
! The Newton method is an iterative method to find a minimum of a given
|
||||||
|
! function. It uses a Taylor series truncated at the second order of the
|
||||||
|
! targeted function and gives its minimizer. The minimizer is taken as
|
||||||
|
! the new position and the same thing is done. And by doing so
|
||||||
|
! iteratively the method find a minimum, a local or global one depending
|
||||||
|
! of the starting point and the convexity/nonconvexity of the targeted
|
||||||
|
! function.
|
||||||
|
|
||||||
|
! The goal of the trust region is to constrain the step size of the
|
||||||
|
! Newton method in a certain area around the actual position, where the
|
||||||
|
! Taylor series is a good approximation of the targeted function. This
|
||||||
|
! area is called the "trust region".
|
||||||
|
|
||||||
|
! In addition, in function of the agreement between the Taylor
|
||||||
|
! development of the energy and the real energy, the size of the trust
|
||||||
|
! region will be updated at each iteration. By doing so, the step sizes
|
||||||
|
! are not too larges. In addition, since we add a criterion to cancel the
|
||||||
|
! step if the energy increases (more precisely if rho < 0.1), so it's
|
||||||
|
! impossible to diverge. \newline
|
||||||
|
|
||||||
|
! References: \newline
|
||||||
|
! Nocedal & Wright, Numerical Optimization, chapter 4 (1999), \newline
|
||||||
|
! https://link.springer.com/book/10.1007/978-0-387-40065-5, \newline
|
||||||
|
! ISBN: 978-0-387-40065-5 \newline
|
||||||
|
|
||||||
|
! By using the first and the second derivatives, the Newton method gives
|
||||||
|
! a step:
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}_{(k+1)}^{\text{Newton}} = - \textbf{H}_{(k)}^{-1} \cdot
|
||||||
|
! \textbf{g}_{(k)}
|
||||||
|
! \end{align*}
|
||||||
|
! which leads to the minimizer of the Taylor series.
|
||||||
|
! !!! Warning: the Newton method gives the minimizer if and only if
|
||||||
|
! $\textbf{H}$ is positive definite, else it leads to a saddle point !!!
|
||||||
|
! But we want a step $\textbf{x}_{(k+1)}$ with a constraint on its (euclidian) norm:
|
||||||
|
! \begin{align*}
|
||||||
|
! ||\textbf{x}_{(k+1)}|| \leq \Delta_{(k+1)}
|
||||||
|
! \end{align*}
|
||||||
|
! which is equivalent to
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}_{(k+1)}^T \cdot \textbf{x}_{(k+1)} \leq \Delta_{(k+1)}^2
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! with: \newline
|
||||||
|
! $\textbf{x}_{(k+1)}$ is the step for the k+1-th iteration (vector of
|
||||||
|
! size n) \newline
|
||||||
|
! $\textbf{H}_{(k)}$ is the hessian at the k-th iteration (n by n
|
||||||
|
! matrix) \newline
|
||||||
|
! $\textbf{g}_{(k)}$ is the gradient at the k-th iteration (vector of
|
||||||
|
! size n) \newline
|
||||||
|
! $\Delta_{(k+1)}$ is the trust radius for the (k+1)-th iteration
|
||||||
|
! \newline
|
||||||
|
|
||||||
|
! Thus we want to constrain the step size $\textbf{x}_{(k+1)}$ into a
|
||||||
|
! hypersphere of radius $\Delta_{(k+1)}$.\newline
|
||||||
|
|
||||||
|
! So, if $||\textbf{x}_{(k+1)}^{\text{Newton}}|| \leq \Delta_{(k)}$ and
|
||||||
|
! $\textbf{H}$ is positive definite, the
|
||||||
|
! solution is the step given by the Newton method
|
||||||
|
! $\textbf{x}_{(k+1)} = \textbf{x}_{(k+1)}^{\text{Newton}}$.
|
||||||
|
! Else we have to constrain the step size. For simplicity we will remove
|
||||||
|
! the index $_{(k)}$ and $_{(k+1)}$. To restict the step size, we have
|
||||||
|
! to put a constraint on $\textbf{x}$ with a Lagrange multiplier.
|
||||||
|
! Starting from the Taylor series of a function E (here, the energy)
|
||||||
|
! truncated at the 2nd order, we have:
|
||||||
|
! \begin{align*}
|
||||||
|
! E(\textbf{x}) = E +\textbf{g}^T \cdot \textbf{x} + \frac{1}{2}
|
||||||
|
! \cdot \textbf{x}^T \cdot \textbf{H} \cdot \textbf{x} +
|
||||||
|
! \mathcal{O}(\textbf{x}^2)
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! With the constraint on the norm of $\textbf{x}$ we can write the
|
||||||
|
! Lagrangian
|
||||||
|
! \begin{align*}
|
||||||
|
! \mathcal{L}(\textbf{x},\lambda) = E + \textbf{g}^T \cdot \textbf{x}
|
||||||
|
! + \frac{1}{2} \cdot \textbf{x}^T \cdot \textbf{H} \cdot \textbf{x}
|
||||||
|
! + \frac{1}{2} \lambda (\textbf{x}^T \cdot \textbf{x} - \Delta^2)
|
||||||
|
! \end{align*}
|
||||||
|
! Where: \newline
|
||||||
|
! $\lambda$ is the Lagrange multiplier \newline
|
||||||
|
! $E$ is the energy at the k-th iteration $\Leftrightarrow
|
||||||
|
! E(\textbf{x} = \textbf{0})$ \newline
|
||||||
|
|
||||||
|
! To solve this equation, we search a stationary point where the first
|
||||||
|
! derivative of $\mathcal{L}$ with respect to $\textbf{x}$ becomes 0, i.e.
|
||||||
|
! \begin{align*}
|
||||||
|
! \frac{\partial \mathcal{L}(\textbf{x},\lambda)}{\partial \textbf{x}}=0
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! The derivative is:
|
||||||
|
! \begin{align*}
|
||||||
|
! \frac{\partial \mathcal{L}(\textbf{x},\lambda)}{\partial \textbf{x}}
|
||||||
|
! = \textbf{g} + \textbf{H} \cdot \textbf{x} + \lambda \cdot \textbf{x}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! So, we search $\textbf{x}$ such as:
|
||||||
|
! \begin{align*}
|
||||||
|
! \frac{\partial \mathcal{L}(\textbf{x},\lambda)}{\partial \textbf{x}}
|
||||||
|
! = \textbf{g} + \textbf{H} \cdot \textbf{x} + \lambda \cdot \textbf{x} = 0
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! We can rewrite that as:
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{g} + \textbf{H} \cdot \textbf{x} + \lambda \cdot \textbf{x}
|
||||||
|
! = \textbf{g} + (\textbf{H} +\textbf{I} \lambda) \cdot \textbf{x} = 0
|
||||||
|
! \end{align*}
|
||||||
|
! with $\textbf{I}$ is the identity matrix.
|
||||||
|
|
||||||
|
! By doing so, the solution is:
|
||||||
|
! \begin{align*}
|
||||||
|
! (\textbf{H} +\textbf{I} \lambda) \cdot \textbf{x}= -\textbf{g}
|
||||||
|
! \end{align*}
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}= - (\textbf{H} + \textbf{I} \lambda)^{-1} \cdot \textbf{g}
|
||||||
|
! \end{align*}
|
||||||
|
! with $\textbf{x}^T \textbf{x} = \Delta^2$.
|
||||||
|
|
||||||
|
! We have to solve this previous equation to find this $\textbf{x}$ in the
|
||||||
|
! trust region, i.e. $||\textbf{x}|| = \Delta$. Now, this problem is
|
||||||
|
! just a one dimension problem because we can express $\textbf{x}$ as a
|
||||||
|
! function of $\lambda$:
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}(\lambda) = - (\textbf{H} + \textbf{I} \lambda)^{-1} \cdot \textbf{g}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! We start from the fact that the hessian is diagonalizable. So we have:
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{H} = \textbf{W} \cdot \textbf{h} \cdot \textbf{W}^T
|
||||||
|
! \end{align*}
|
||||||
|
! with: \newline
|
||||||
|
! $\textbf{H}$, the hessian matrix \newline
|
||||||
|
! $\textbf{W}$, the matrix containing the eigenvectors \newline
|
||||||
|
! $\textbf{w}_i$, the i-th eigenvector, i.e. i-th column of $\textbf{W}$ \newline
|
||||||
|
! $\textbf{h}$, the matrix containing the eigenvalues in ascending order \newline
|
||||||
|
! $h_i$, the i-th eigenvalue in ascending order \newline
|
||||||
|
|
||||||
|
! Now we use the fact that adding a constant on the diagonal just shifts
|
||||||
|
! the eigenvalues:
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{H} + \textbf{I} \lambda = \textbf{W} \cdot (\textbf{h}
|
||||||
|
! +\textbf{I} \lambda) \cdot \textbf{W}^T
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! By doing so we can express $\textbf{x}$ as a function of $\lambda$
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot
|
||||||
|
! \textbf{g}}{h_i + \lambda} \cdot \textbf{w}_i
|
||||||
|
! \end{align*}
|
||||||
|
! with $\lambda \neq - h_i$.
|
||||||
|
|
||||||
|
! An interesting thing in our case is the norm of $\textbf{x}$,
|
||||||
|
! because we want $||\textbf{x}|| = \Delta$. Due to the orthogonality of
|
||||||
|
! the eigenvectors $\left\{\textbf{w} \right\} _{i=1}^n$ we have:
|
||||||
|
! \begin{align*}
|
||||||
|
! ||\textbf{x}(\lambda)||^2 = \sum_{i=1}^n \frac{(\textbf{w}_i^T \cdot
|
||||||
|
! \textbf{g})^2}{(h_i + \lambda)^2}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! So the $||\textbf{x}(\lambda)||^2$ is just a function of $\lambda$.
|
||||||
|
! And if we study the properties of this function we see that:
|
||||||
|
! \begin{align*}
|
||||||
|
! \lim_{\lambda\to\infty} ||\textbf{x}(\lambda)|| = 0
|
||||||
|
! \end{align*}
|
||||||
|
! and if $\textbf{w}_i^T \cdot \textbf{g} \neq 0$:
|
||||||
|
! \begin{align*}
|
||||||
|
! \lim_{\lambda\to -h_i} ||\textbf{x}(\lambda)|| = + \infty
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! From these limits and knowing that $h_1$ is the lowest eigenvalue, we
|
||||||
|
! can conclude that $||\textbf{x}(\lambda)||$ is a continuous and
|
||||||
|
! strictly decreasing function on the interval $\lambda \in
|
||||||
|
! (-h_1;\infty)$. Thus, there is one $\lambda$ in this interval which
|
||||||
|
! gives $||\textbf{x}(\lambda)|| = \Delta$, consequently there is one
|
||||||
|
! solution.
|
||||||
|
|
||||||
|
! Since $\textbf{x} = - (\textbf{H} + \lambda \textbf{I})^{-1} \cdot
|
||||||
|
! \textbf{g}$ and we want to reduce the norm of $\textbf{x}$, clearly,
|
||||||
|
! $\lambda > 0$ ($\lambda = 0$ is the unconstraint solution). But the
|
||||||
|
! Newton method is only defined for a positive definite hessian matrix,
|
||||||
|
! so $(\textbf{H} + \textbf{I} \lambda)$ must be positive
|
||||||
|
! definite. Consequently, in the case where $\textbf{H}$ is not positive
|
||||||
|
! definite, to ensure the positive definiteness, $\lambda$ must be
|
||||||
|
! greater than $- h_1$.
|
||||||
|
! \begin{align*}
|
||||||
|
! \lambda > 0 \quad \text{and} \quad \lambda \geq - h_1
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! From that there are five cases:
|
||||||
|
! - if $\textbf{H}$ is positive definite, $-h_1 < 0$, $\lambda \in (0,\infty)$
|
||||||
|
! - if $\textbf{H}$ is not positive definite and $\textbf{w}_1^T \cdot
|
||||||
|
! \textbf{g} \neq 0$, $(\textbf{H} + \textbf{I}
|
||||||
|
! \lambda)$
|
||||||
|
! must be positve definite, $-h_1 > 0$, $\lambda \in (-h_1, \infty)$
|
||||||
|
! - if $\textbf{H}$ is not positive definite , $\textbf{w}_1^T \cdot
|
||||||
|
! \textbf{g} = 0$ and $||\textbf{x}(-h_1)|| > \Delta$ by removing
|
||||||
|
! $j=1$ in the sum, $(\textbf{H} + \textbf{I} \lambda)$ must be
|
||||||
|
! positive definite, $-h_1 > 0$, $\lambda \in (-h_1, \infty$)
|
||||||
|
! - if $\textbf{H}$ is not positive definite , $\textbf{w}_1^T \cdot
|
||||||
|
! \textbf{g} = 0$ and $||\textbf{x}(-h_1)|| \leq \Delta$ by removing
|
||||||
|
! $j=1$ in the sum, $(\textbf{H} + \textbf{I} \lambda)$ must be
|
||||||
|
! positive definite, $-h_1 > 0$, $\lambda = -h_1$). This case is
|
||||||
|
! similar to the case where $\textbf{H}$ and $||\textbf{x}(\lambda =
|
||||||
|
! 0)|| \leq \Delta$
|
||||||
|
! but we can also add to $\textbf{x}$, the first eigenvector $\textbf{W}_1$
|
||||||
|
! time a constant to ensure the condition $||\textbf{x}(\lambda =
|
||||||
|
! -h_1)|| = \Delta$ and escape from the saddle point
|
||||||
|
|
||||||
|
! Thus to find the solution, we can write:
|
||||||
|
! \begin{align*}
|
||||||
|
! ||\textbf{x}(\lambda)|| = \Delta
|
||||||
|
! \end{align*}
|
||||||
|
! \begin{align*}
|
||||||
|
! ||\textbf{x}(\lambda)|| - \Delta = 0
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! Taking the square of this equation
|
||||||
|
! \begin{align*}
|
||||||
|
! (||\textbf{x}(\lambda)|| - \Delta)^2 = 0
|
||||||
|
! \end{align*}
|
||||||
|
! we have a function with one minimum for the optimal $\lambda$.
|
||||||
|
! Since we have the formula of $||\textbf{x}(\lambda)||^2$, we solve
|
||||||
|
! \begin{align*}
|
||||||
|
! (||\textbf{x}(\lambda)||^2 - \Delta^2)^2 = 0
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! But in practice, it is more effective to solve:
|
||||||
|
! \begin{align*}
|
||||||
|
! (\frac{1}{||\textbf{x}(\lambda)||^2} - \frac{1}{\Delta^2})^2 = 0
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! To do that, we just use the Newton method with "trust_newton" using
|
||||||
|
! first and second derivative of $(||\textbf{x}(\lambda)||^2 -
|
||||||
|
! \Delta^2)^2$ with respect to $\textbf{x}$.
|
||||||
|
! This will give the optimal $\lambda$ to compute the
|
||||||
|
! solution $\textbf{x}$ with the formula seen previously:
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot
|
||||||
|
! \textbf{g}}{h_i + \lambda} \cdot \textbf{w}_i
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! The solution $\textbf{x}(\lambda)$ with the optimal $\lambda$ is our
|
||||||
|
! step to go from the (k)-th to the (k+1)-th iteration, is noted $\textbf{x}^*$.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Evolution of the trust region
|
||||||
|
|
||||||
|
! We initialize the trust region at the first iteration using a radius
|
||||||
|
! \begin{align*}
|
||||||
|
! \Delta = ||\textbf{x}(\lambda=0)||
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! And for the next iteration the trust region will evolves depending of
|
||||||
|
! the agreement of the energy prediction based on the Taylor series
|
||||||
|
! truncated at the 2nd order and the real energy. If the Taylor series
|
||||||
|
! truncated at the 2nd order represents correctly the energy landscape
|
||||||
|
! the trust region will be extent else it will be reduced. In order to
|
||||||
|
! mesure this agreement we use the ratio rho cf. "rho_model" and
|
||||||
|
! "trust_e_model". From that we use the following values:
|
||||||
|
! - if $\rho \geq 0.75$, then $\Delta = 2 \Delta$,
|
||||||
|
! - if $0.5 \geq \rho < 0.75$, then $\Delta = \Delta$,
|
||||||
|
! - if $0.25 \geq \rho < 0.5$, then $\Delta = 0.5 \Delta$,
|
||||||
|
! - if $\rho < 0.25$, then $\Delta = 0.25 \Delta$.
|
||||||
|
|
||||||
|
! In addition, if $\rho < 0.1$ the iteration is cancelled, so it
|
||||||
|
! restarts with a smaller trust region until the energy decreases.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Summary
|
||||||
|
|
||||||
|
! To summarize, knowing the hessian (eigenvectors and eigenvalues), the
|
||||||
|
! gradient and the radius of the trust region we can compute the norm of
|
||||||
|
! the Newton step
|
||||||
|
! \begin{align*}
|
||||||
|
! ||\textbf{x}(\lambda = 0)||^2 = ||- \textbf{H}^{-1} \cdot \textbf{g}||^2 = \sum_{i=1}^n
|
||||||
|
! \frac{(\textbf{w}_i^T \cdot \textbf{g})^2}{(h_i + \lambda)^2}, \quad h_i \neq 0
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! - if $h_1 \geq 0$, $||\textbf{x}(\lambda = 0)|| \leq \Delta$ and
|
||||||
|
! $\textbf{x}(\lambda=0)$ is in the trust region and it is not
|
||||||
|
! necessary to put a constraint on $\textbf{x}$, the solution is the
|
||||||
|
! unconstrained one, $\textbf{x}^* = \textbf{x}(\lambda = 0)$.
|
||||||
|
! - else if $h_1 < 0$, $\textbf{w}_1^T \cdot \textbf{g} = 0$ and
|
||||||
|
! $||\textbf{x}(\lambda = -h_1)|| \leq \Delta$ (by removing $j=1$ in
|
||||||
|
! the sum), the solution is $\textbf{x}^* = \textbf{x}(\lambda =
|
||||||
|
! -h_1)$, similarly to the previous case.
|
||||||
|
! But we can add to $\textbf{x}$, the first eigenvector $\textbf{W}_1$
|
||||||
|
! time a constant to ensure the condition $||\textbf{x}(\lambda =
|
||||||
|
! -h_1)|| = \Delta$ and escape from the saddle point
|
||||||
|
! - else if $h_1 < 0$ and $\textbf{w}_1^T \cdot \textbf{g} \neq 0$ we
|
||||||
|
! have to search $\lambda \in (-h_1, \infty)$ such as
|
||||||
|
! $\textbf{x}(\lambda) = \Delta$ by solving with the Newton method
|
||||||
|
! \begin{align*}
|
||||||
|
! (||\textbf{x}(\lambda)||^2 - \Delta^2)^2 = 0
|
||||||
|
! \end{align*}
|
||||||
|
! or
|
||||||
|
! \begin{align*}
|
||||||
|
! (\frac{1}{||\textbf{x}(\lambda)||^2} - \frac{1}{\Delta^2})^2 = 0
|
||||||
|
! \end{align*}
|
||||||
|
! which is numerically more stable. And finally compute
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}^* = \textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot
|
||||||
|
! \textbf{g}}{h_i + \lambda} \cdot \textbf{w}_i
|
||||||
|
! \end{align*}
|
||||||
|
! - else if $h_1 \geq 0$ and $||\textbf{x}(\lambda = 0)|| > \Delta$ we
|
||||||
|
! do exactly the same thing that the previous case but we search
|
||||||
|
! $\lambda \in (0, \infty)$
|
||||||
|
! - else if $h_1 < 0$ and $\textbf{w}_1^T \cdot \textbf{g} = 0$ and
|
||||||
|
! $||\textbf{x}(\lambda = -h_1)|| > \Delta$ (by removing $j=1$ in the
|
||||||
|
! sum), again we do exactly the same thing that the previous case
|
||||||
|
! searching $\lambda \in (-h_1, \infty)$.
|
||||||
|
|
||||||
|
|
||||||
|
! For the cases where $\textbf{w}_1^T \cdot \textbf{g} = 0$ it is not
|
||||||
|
! necessary in fact to remove the $j = 1$ in the sum since the term
|
||||||
|
! where $h_i - \lambda < 10^{-6}$ are not computed.
|
||||||
|
|
||||||
|
! After that, we take this vector $\textbf{x}^*$, called "x", and we do
|
||||||
|
! the transformation to an antisymmetric matrix $\textbf{X}$, called
|
||||||
|
! m_x. This matrix $\textbf{X}$ will be used to compute a rotation
|
||||||
|
! matrix $\textbf{R}= \exp(\textbf{X})$ in "rotation_matrix".
|
||||||
|
|
||||||
|
! NB:
|
||||||
|
! An improvement can be done using a elleptical trust region.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Code
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
! Cf. qp_edit in orbital optimization section, for some constants/thresholds
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | m | integer | number of MOs |
|
||||||
|
! | n | integer | m*(m-1)/2 |
|
||||||
|
! | H(n, n) | double precision | hessian |
|
||||||
|
! | v_grad(n) | double precision | gradient |
|
||||||
|
! | e_val(n) | double precision | eigenvalues of the hessian |
|
||||||
|
! | W(n, n) | double precision | eigenvectors of the hessian |
|
||||||
|
! | rho | double precision | agreement between the model and the reality, |
|
||||||
|
! | | | represents the quality of the energy prediction |
|
||||||
|
! | nb_iter | integer | number of iteration |
|
||||||
|
|
||||||
|
! Input/Ouput:
|
||||||
|
! | delta | double precision | radius of the trust region |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | x(n) | double precision | vector containing the step |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | accu | double precision | temporary variable to compute the step |
|
||||||
|
! | lambda | double precision | lagrange multiplier |
|
||||||
|
! | trust_radius2 | double precision | square of the radius of the trust region |
|
||||||
|
! | norm2_x | double precision | norm^2 of the vector x |
|
||||||
|
! | norm2_g | double precision | norm^2 of the vector containing the gradient |
|
||||||
|
! | tmp_wtg(n) | double precision | tmp_wtg(i) = w_i^T . g |
|
||||||
|
! | i, j, k | integer | indexes |
|
||||||
|
|
||||||
|
! Function:
|
||||||
|
! | dnrm2 | double precision | Blas function computing the norm |
|
||||||
|
! | f_norm_trust_region_omp | double precision | compute the value of norm(x(lambda)^2) |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine trust_region_step(n,nb_iter,v_grad,rho,e_val,w,x,delta)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compuet the step in the trust region
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
double precision, intent(in) :: v_grad(n), rho
|
||||||
|
integer, intent(inout) :: nb_iter
|
||||||
|
double precision, intent(in) :: e_val(n), w(n,n)
|
||||||
|
|
||||||
|
! inout
|
||||||
|
double precision, intent(inout) :: delta
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: x(n)
|
||||||
|
|
||||||
|
! Internal
|
||||||
|
double precision :: accu, lambda, trust_radius2
|
||||||
|
double precision :: norm2_x, norm2_g
|
||||||
|
double precision, allocatable :: tmp_wtg(:)
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
integer :: n_neg_eval
|
||||||
|
|
||||||
|
|
||||||
|
! Functions
|
||||||
|
double precision :: ddot, dnrm2
|
||||||
|
double precision :: f_norm_trust_region_omp
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'=================='
|
||||||
|
print*,'---Trust_region---'
|
||||||
|
print*,'=================='
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(tmp_wtg(n))
|
||||||
|
|
||||||
|
! Initialization and norm
|
||||||
|
|
||||||
|
! The norm of the step size will be useful for the trust region
|
||||||
|
! algorithm. We start from a first guess and the radius of the trust
|
||||||
|
! region will evolve during the optimization.
|
||||||
|
|
||||||
|
! avoid_saddle is actually a test to avoid saddle points
|
||||||
|
|
||||||
|
|
||||||
|
! Initialization of the Lagrange multiplier
|
||||||
|
lambda = 0d0
|
||||||
|
|
||||||
|
! List of w^T.g, to avoid the recomputation
|
||||||
|
tmp_wtg = 0d0
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
tmp_wtg(j) = tmp_wtg(j) + w(i,j) * v_grad(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Replacement of the small tmp_wtg corresponding to a negative eigenvalue
|
||||||
|
! in the case of avoid_saddle
|
||||||
|
if (avoid_saddle .and. e_val(1) < - thresh_eig) then
|
||||||
|
i = 2
|
||||||
|
! Number of negative eigenvalues
|
||||||
|
do while (e_val(i) < - thresh_eig)
|
||||||
|
if (tmp_wtg(i) < thresh_wtg2) then
|
||||||
|
if (version_avoid_saddle == 1) then
|
||||||
|
tmp_wtg(i) = 1d0
|
||||||
|
elseif (version_avoid_saddle == 2) then
|
||||||
|
tmp_wtg(i) = DABS(e_val(i))
|
||||||
|
elseif (version_avoid_saddle == 3) then
|
||||||
|
tmp_wtg(i) = dsqrt(DABS(e_val(i)))
|
||||||
|
else
|
||||||
|
tmp_wtg(i) = thresh_wtg2
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
i = i + 1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! For the fist one it's a little bit different
|
||||||
|
if (tmp_wtg(1) < thresh_wtg2) then
|
||||||
|
tmp_wtg(1) = 0d0
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm^2 of x, ||x||^2
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg,0d0)
|
||||||
|
! We just use this norm for the nb_iter = 0 in order to initialize the trust radius delta
|
||||||
|
! We don't care about the sign of the eigenvalue we just want the size of the step in a normal Newton-Raphson algorithm
|
||||||
|
! Anyway if the step is too big it will be reduced
|
||||||
|
print*,'||x||^2 :', norm2_x
|
||||||
|
|
||||||
|
! Norm^2 of the gradient, ||v_grad||^2
|
||||||
|
norm2_g = (dnrm2(n,v_grad,1))**2
|
||||||
|
print*,'||grad||^2 :', norm2_g
|
||||||
|
|
||||||
|
! Trust radius initialization
|
||||||
|
|
||||||
|
! At the first iteration (nb_iter = 0) we initialize the trust region
|
||||||
|
! with the norm of the step generate by the Newton's method ($\textbf{x}_1 =
|
||||||
|
! (\textbf{H}_0)^{-1} \cdot \textbf{g}_0$,
|
||||||
|
! we compute this norm using f_norm_trust_region_omp as explain just
|
||||||
|
! below)
|
||||||
|
|
||||||
|
|
||||||
|
! trust radius
|
||||||
|
if (nb_iter == 0) then
|
||||||
|
trust_radius2 = norm2_x
|
||||||
|
! To avoid infinite loop of cancellation of this first step
|
||||||
|
! without changing delta
|
||||||
|
nb_iter = 1
|
||||||
|
|
||||||
|
! Compute delta, delta = sqrt(trust_radius)
|
||||||
|
delta = dsqrt(trust_radius2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Modification of the trust radius
|
||||||
|
|
||||||
|
! In function of rho (which represents the agreement between the model
|
||||||
|
! and the reality, cf. rho_model) the trust region evolves. We update
|
||||||
|
! delta (the radius of the trust region).
|
||||||
|
|
||||||
|
! To avoid too big trust region we put a maximum size.
|
||||||
|
|
||||||
|
|
||||||
|
! Modification of the trust radius in function of rho
|
||||||
|
if (rho >= 0.75d0) then
|
||||||
|
delta = 2d0 * delta
|
||||||
|
elseif (rho >= 0.5d0) then
|
||||||
|
delta = delta
|
||||||
|
elseif (rho >= 0.25d0) then
|
||||||
|
delta = 0.5d0 * delta
|
||||||
|
else
|
||||||
|
delta = 0.25d0 * delta
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Maximum size of the trust region
|
||||||
|
!if (delta > 0.5d0 * n * pi) then
|
||||||
|
! delta = 0.5d0 * n * pi
|
||||||
|
! print*,'Delta > delta_max, delta = 0.5d0 * n * pi'
|
||||||
|
!endif
|
||||||
|
|
||||||
|
if (delta > 1d10) then
|
||||||
|
delta = 1d10
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*, 'Delta :', delta
|
||||||
|
|
||||||
|
! Calculation of the optimal lambda
|
||||||
|
|
||||||
|
! We search the solution of $(||x||^2 - \Delta^2)^2 = 0$
|
||||||
|
! - If $||\textbf{x}|| > \Delta$ or $h_1 < 0$ we have to add a constant
|
||||||
|
! $\lambda > 0 \quad \text{and} \quad \lambda > -h_1$
|
||||||
|
! - If $||\textbf{x}|| \leq \Delta$ and $h_1 \geq 0$ the solution is the
|
||||||
|
! unconstrained one, $\lambda = 0$
|
||||||
|
|
||||||
|
! You will find more details at the beginning
|
||||||
|
|
||||||
|
|
||||||
|
! By giving delta, we search (||x||^2 - delta^2)^2 = 0
|
||||||
|
! and not (||x||^2 - delta)^2 = 0
|
||||||
|
|
||||||
|
! Research of lambda to solve ||x(lambda)|| = Delta
|
||||||
|
|
||||||
|
! Display
|
||||||
|
print*, 'e_val(1) = ', e_val(1)
|
||||||
|
print*, 'w_1^T.g =', tmp_wtg(1)
|
||||||
|
|
||||||
|
! H positive definite
|
||||||
|
if (e_val(1) > - thresh_eig) then
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg,0d0)
|
||||||
|
print*, '||x(0)||=', dsqrt(norm2_x)
|
||||||
|
print*, 'Delta=', delta
|
||||||
|
|
||||||
|
! H positive definite, ||x(lambda = 0)|| <= Delta
|
||||||
|
if (dsqrt(norm2_x) <= delta) then
|
||||||
|
print*, 'H positive definite, ||x(lambda = 0)|| <= Delta'
|
||||||
|
print*, 'lambda = 0, no lambda optimization'
|
||||||
|
lambda = 0d0
|
||||||
|
|
||||||
|
! H positive definite, ||x(lambda = 0)|| > Delta
|
||||||
|
else
|
||||||
|
! Constraint solution
|
||||||
|
print*, 'H positive definite, ||x(lambda = 0)|| > Delta'
|
||||||
|
print*,'Computation of the optimal lambda...'
|
||||||
|
call trust_region_optimal_lambda(n,e_val,tmp_wtg,delta,lambda)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! H indefinite
|
||||||
|
else
|
||||||
|
if (DABS(tmp_wtg(1)) < thresh_wtg) then
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg, - e_val(1))
|
||||||
|
print*, 'w_1^T.g <', thresh_wtg,', ||x(lambda = -e_val(1))|| =', dsqrt(norm2_x)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| <= Delta
|
||||||
|
if (dsqrt(norm2_x) <= delta .and. DABS(tmp_wtg(1)) < thresh_wtg) then
|
||||||
|
! Add e_val(1) in order to have (H - e_val(1) I) positive definite
|
||||||
|
print*, 'H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| <= Delta'
|
||||||
|
print*, 'lambda = -e_val(1), no lambda optimization'
|
||||||
|
lambda = - e_val(1)
|
||||||
|
|
||||||
|
! H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| > Delta
|
||||||
|
! and
|
||||||
|
! H indefinite, w_1^T.g =/= 0
|
||||||
|
else
|
||||||
|
! Constraint solution/ add lambda
|
||||||
|
if (DABS(tmp_wtg(1)) < thresh_wtg) then
|
||||||
|
print*, 'H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| > Delta'
|
||||||
|
else
|
||||||
|
print*, 'H indefinite, w_1^T.g =/= 0'
|
||||||
|
endif
|
||||||
|
print*, 'Computation of the optimal lambda...'
|
||||||
|
call trust_region_optimal_lambda(n,e_val,tmp_wtg,delta,lambda)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Recomputation of the norm^2 of the step x
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg,lambda)
|
||||||
|
print*,''
|
||||||
|
print*,'Summary after the trust region:'
|
||||||
|
print*,'lambda:', lambda
|
||||||
|
print*,'||x||:', dsqrt(norm2_x)
|
||||||
|
print*,'delta:', delta
|
||||||
|
|
||||||
|
! Calculation of the step x
|
||||||
|
|
||||||
|
! x refers to $\textbf{x}^*$
|
||||||
|
! We compute x in function of lambda using its formula :
|
||||||
|
! \begin{align*}
|
||||||
|
! \textbf{x}^* = \textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot \textbf{g}}{h_i
|
||||||
|
! + \lambda} \cdot \textbf{w}_i
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
|
||||||
|
! Initialisation
|
||||||
|
x = 0d0
|
||||||
|
|
||||||
|
! Calculation of the step x
|
||||||
|
|
||||||
|
! Normal version
|
||||||
|
if (.not. absolute_eig) then
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (DABS(e_val(i)) > thresh_eig .and. DABS(e_val(i)+lambda) > thresh_eig) then
|
||||||
|
do j = 1, n
|
||||||
|
x(j) = x(j) - tmp_wtg(i) * W(j,i) / (e_val(i) + lambda)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Version to use the absolute value of the eigenvalues
|
||||||
|
else
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (DABS(e_val(i)) > thresh_eig) then
|
||||||
|
do j = 1, n
|
||||||
|
x(j) = x(j) - tmp_wtg(i) * W(j,i) / (DABS(e_val(i)) + lambda)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
double precision :: beta, norm_x
|
||||||
|
|
||||||
|
! Test
|
||||||
|
! If w_1^T.g = 0, the lim of ||x(lambda)|| when lambda tend to -e_val(1)
|
||||||
|
! is not + infinity. So ||x(lambda=-e_val(1))|| < delta, we add the first
|
||||||
|
! eigenvectors multiply by a constant to ensure the condition
|
||||||
|
! ||x(lambda=-e_val(1))|| = delta and escape the saddle point
|
||||||
|
if (avoid_saddle .and. e_val(1) < - thresh_eig) then
|
||||||
|
if (tmp_wtg(1) < 1d-15 .and. (1d0 - dsqrt(norm2_x)/delta) > 1d-3 ) then
|
||||||
|
|
||||||
|
! norm of x
|
||||||
|
norm_x = dnrm2(n,x,1)
|
||||||
|
|
||||||
|
! Computes the coefficient for the w_1
|
||||||
|
beta = delta**2 - norm_x**2
|
||||||
|
|
||||||
|
! Updates the step x
|
||||||
|
x = x + W(:,1) * dsqrt(beta)
|
||||||
|
|
||||||
|
! Recomputes the norm to check
|
||||||
|
norm_x = dnrm2(n,x,1)
|
||||||
|
|
||||||
|
print*, 'Add w_1 * dsqrt(delta^2 - ||x||^2):'
|
||||||
|
print*, '||x||', norm_x
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Transformation of x
|
||||||
|
|
||||||
|
! x is a vector of size n, so it can be write as a m by m
|
||||||
|
! antisymmetric matrix m_x cf. "mat_to_vec_index" and "vec_to_mat_index".
|
||||||
|
|
||||||
|
|
||||||
|
! ! Step transformation vector -> matrix
|
||||||
|
! ! Vector with n element -> mo_num by mo_num matrix
|
||||||
|
! do j = 1, m
|
||||||
|
! do i = 1, m
|
||||||
|
! if (i>j) then
|
||||||
|
! call mat_to_vec_index(i,j,k)
|
||||||
|
! m_x(i,j) = x(k)
|
||||||
|
! else
|
||||||
|
! m_x(i,j) = 0d0
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! ! Antisymmetrization of the previous matrix
|
||||||
|
! do j = 1, m
|
||||||
|
! do i = 1, m
|
||||||
|
! if (i<j) then
|
||||||
|
! m_x(i,j) = - m_x(j,i)
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! Deallocation, end
|
||||||
|
|
||||||
|
|
||||||
|
deallocate(tmp_wtg)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in trust_region:', t3
|
||||||
|
print*,'======================'
|
||||||
|
print*,'---End trust_region---'
|
||||||
|
print*,'======================'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
end
|
726
src/utils_trust_region/trust_region_step.org
Normal file
726
src/utils_trust_region/trust_region_step.org
Normal file
@ -0,0 +1,726 @@
|
|||||||
|
* Trust region
|
||||||
|
|
||||||
|
*Compute the next step with the trust region algorithm*
|
||||||
|
|
||||||
|
The Newton method is an iterative method to find a minimum of a given
|
||||||
|
function. It uses a Taylor series truncated at the second order of the
|
||||||
|
targeted function and gives its minimizer. The minimizer is taken as
|
||||||
|
the new position and the same thing is done. And by doing so
|
||||||
|
iteratively the method find a minimum, a local or global one depending
|
||||||
|
of the starting point and the convexity/nonconvexity of the targeted
|
||||||
|
function.
|
||||||
|
|
||||||
|
The goal of the trust region is to constrain the step size of the
|
||||||
|
Newton method in a certain area around the actual position, where the
|
||||||
|
Taylor series is a good approximation of the targeted function. This
|
||||||
|
area is called the "trust region".
|
||||||
|
|
||||||
|
In addition, in function of the agreement between the Taylor
|
||||||
|
development of the energy and the real energy, the size of the trust
|
||||||
|
region will be updated at each iteration. By doing so, the step sizes
|
||||||
|
are not too larges. In addition, since we add a criterion to cancel the
|
||||||
|
step if the energy increases (more precisely if rho < 0.1), so it's
|
||||||
|
impossible to diverge. \newline
|
||||||
|
|
||||||
|
References: \newline
|
||||||
|
Nocedal & Wright, Numerical Optimization, chapter 4 (1999), \newline
|
||||||
|
https://link.springer.com/book/10.1007/978-0-387-40065-5, \newline
|
||||||
|
ISBN: 978-0-387-40065-5 \newline
|
||||||
|
|
||||||
|
By using the first and the second derivatives, the Newton method gives
|
||||||
|
a step:
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}_{(k+1)}^{\text{Newton}} = - \textbf{H}_{(k)}^{-1} \cdot
|
||||||
|
\textbf{g}_{(k)}
|
||||||
|
\end{align*}
|
||||||
|
which leads to the minimizer of the Taylor series.
|
||||||
|
!!! Warning: the Newton method gives the minimizer if and only if
|
||||||
|
$\textbf{H}$ is positive definite, else it leads to a saddle point !!!
|
||||||
|
But we want a step $\textbf{x}_{(k+1)}$ with a constraint on its (euclidian) norm:
|
||||||
|
\begin{align*}
|
||||||
|
||\textbf{x}_{(k+1)}|| \leq \Delta_{(k+1)}
|
||||||
|
\end{align*}
|
||||||
|
which is equivalent to
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}_{(k+1)}^T \cdot \textbf{x}_{(k+1)} \leq \Delta_{(k+1)}^2
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
with: \newline
|
||||||
|
$\textbf{x}_{(k+1)}$ is the step for the k+1-th iteration (vector of
|
||||||
|
size n) \newline
|
||||||
|
$\textbf{H}_{(k)}$ is the hessian at the k-th iteration (n by n
|
||||||
|
matrix) \newline
|
||||||
|
$\textbf{g}_{(k)}$ is the gradient at the k-th iteration (vector of
|
||||||
|
size n) \newline
|
||||||
|
$\Delta_{(k+1)}$ is the trust radius for the (k+1)-th iteration
|
||||||
|
\newline
|
||||||
|
|
||||||
|
Thus we want to constrain the step size $\textbf{x}_{(k+1)}$ into a
|
||||||
|
hypersphere of radius $\Delta_{(k+1)}$.\newline
|
||||||
|
|
||||||
|
So, if $||\textbf{x}_{(k+1)}^{\text{Newton}}|| \leq \Delta_{(k)}$ and
|
||||||
|
$\textbf{H}$ is positive definite, the
|
||||||
|
solution is the step given by the Newton method
|
||||||
|
$\textbf{x}_{(k+1)} = \textbf{x}_{(k+1)}^{\text{Newton}}$.
|
||||||
|
Else we have to constrain the step size. For simplicity we will remove
|
||||||
|
the index $_{(k)}$ and $_{(k+1)}$. To restict the step size, we have
|
||||||
|
to put a constraint on $\textbf{x}$ with a Lagrange multiplier.
|
||||||
|
Starting from the Taylor series of a function E (here, the energy)
|
||||||
|
truncated at the 2nd order, we have:
|
||||||
|
\begin{align*}
|
||||||
|
E(\textbf{x}) = E +\textbf{g}^T \cdot \textbf{x} + \frac{1}{2}
|
||||||
|
\cdot \textbf{x}^T \cdot \textbf{H} \cdot \textbf{x} +
|
||||||
|
\mathcal{O}(\textbf{x}^2)
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
With the constraint on the norm of $\textbf{x}$ we can write the
|
||||||
|
Lagrangian
|
||||||
|
\begin{align*}
|
||||||
|
\mathcal{L}(\textbf{x},\lambda) = E + \textbf{g}^T \cdot \textbf{x}
|
||||||
|
+ \frac{1}{2} \cdot \textbf{x}^T \cdot \textbf{H} \cdot \textbf{x}
|
||||||
|
+ \frac{1}{2} \lambda (\textbf{x}^T \cdot \textbf{x} - \Delta^2)
|
||||||
|
\end{align*}
|
||||||
|
Where: \newline
|
||||||
|
$\lambda$ is the Lagrange multiplier \newline
|
||||||
|
$E$ is the energy at the k-th iteration $\Leftrightarrow
|
||||||
|
E(\textbf{x} = \textbf{0})$ \newline
|
||||||
|
|
||||||
|
To solve this equation, we search a stationary point where the first
|
||||||
|
derivative of $\mathcal{L}$ with respect to $\textbf{x}$ becomes 0, i.e.
|
||||||
|
\begin{align*}
|
||||||
|
\frac{\partial \mathcal{L}(\textbf{x},\lambda)}{\partial \textbf{x}}=0
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
The derivative is:
|
||||||
|
\begin{align*}
|
||||||
|
\frac{\partial \mathcal{L}(\textbf{x},\lambda)}{\partial \textbf{x}}
|
||||||
|
= \textbf{g} + \textbf{H} \cdot \textbf{x} + \lambda \cdot \textbf{x}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
So, we search $\textbf{x}$ such as:
|
||||||
|
\begin{align*}
|
||||||
|
\frac{\partial \mathcal{L}(\textbf{x},\lambda)}{\partial \textbf{x}}
|
||||||
|
= \textbf{g} + \textbf{H} \cdot \textbf{x} + \lambda \cdot \textbf{x} = 0
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
We can rewrite that as:
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{g} + \textbf{H} \cdot \textbf{x} + \lambda \cdot \textbf{x}
|
||||||
|
= \textbf{g} + (\textbf{H} +\textbf{I} \lambda) \cdot \textbf{x} = 0
|
||||||
|
\end{align*}
|
||||||
|
with $\textbf{I}$ is the identity matrix.
|
||||||
|
|
||||||
|
By doing so, the solution is:
|
||||||
|
\begin{align*}
|
||||||
|
(\textbf{H} +\textbf{I} \lambda) \cdot \textbf{x}= -\textbf{g}
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}= - (\textbf{H} + \textbf{I} \lambda)^{-1} \cdot \textbf{g}
|
||||||
|
\end{align*}
|
||||||
|
with $\textbf{x}^T \textbf{x} = \Delta^2$.
|
||||||
|
|
||||||
|
We have to solve this previous equation to find this $\textbf{x}$ in the
|
||||||
|
trust region, i.e. $||\textbf{x}|| = \Delta$. Now, this problem is
|
||||||
|
just a one dimension problem because we can express $\textbf{x}$ as a
|
||||||
|
function of $\lambda$:
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}(\lambda) = - (\textbf{H} + \textbf{I} \lambda)^{-1} \cdot \textbf{g}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
We start from the fact that the hessian is diagonalizable. So we have:
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{H} = \textbf{W} \cdot \textbf{h} \cdot \textbf{W}^T
|
||||||
|
\end{align*}
|
||||||
|
with: \newline
|
||||||
|
$\textbf{H}$, the hessian matrix \newline
|
||||||
|
$\textbf{W}$, the matrix containing the eigenvectors \newline
|
||||||
|
$\textbf{w}_i$, the i-th eigenvector, i.e. i-th column of $\textbf{W}$ \newline
|
||||||
|
$\textbf{h}$, the matrix containing the eigenvalues in ascending order \newline
|
||||||
|
$h_i$, the i-th eigenvalue in ascending order \newline
|
||||||
|
|
||||||
|
Now we use the fact that adding a constant on the diagonal just shifts
|
||||||
|
the eigenvalues:
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{H} + \textbf{I} \lambda = \textbf{W} \cdot (\textbf{h}
|
||||||
|
+\textbf{I} \lambda) \cdot \textbf{W}^T
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
By doing so we can express $\textbf{x}$ as a function of $\lambda$
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot
|
||||||
|
\textbf{g}}{h_i + \lambda} \cdot \textbf{w}_i
|
||||||
|
\end{align*}
|
||||||
|
with $\lambda \neq - h_i$.
|
||||||
|
|
||||||
|
An interesting thing in our case is the norm of $\textbf{x}$,
|
||||||
|
because we want $||\textbf{x}|| = \Delta$. Due to the orthogonality of
|
||||||
|
the eigenvectors $\left\{\textbf{w} \right\} _{i=1}^n$ we have:
|
||||||
|
\begin{align*}
|
||||||
|
||\textbf{x}(\lambda)||^2 = \sum_{i=1}^n \frac{(\textbf{w}_i^T \cdot
|
||||||
|
\textbf{g})^2}{(h_i + \lambda)^2}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
So the $||\textbf{x}(\lambda)||^2$ is just a function of $\lambda$.
|
||||||
|
And if we study the properties of this function we see that:
|
||||||
|
\begin{align*}
|
||||||
|
\lim_{\lambda\to\infty} ||\textbf{x}(\lambda)|| = 0
|
||||||
|
\end{align*}
|
||||||
|
and if $\textbf{w}_i^T \cdot \textbf{g} \neq 0$:
|
||||||
|
\begin{align*}
|
||||||
|
\lim_{\lambda\to -h_i} ||\textbf{x}(\lambda)|| = + \infty
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
From these limits and knowing that $h_1$ is the lowest eigenvalue, we
|
||||||
|
can conclude that $||\textbf{x}(\lambda)||$ is a continuous and
|
||||||
|
strictly decreasing function on the interval $\lambda \in
|
||||||
|
(-h_1;\infty)$. Thus, there is one $\lambda$ in this interval which
|
||||||
|
gives $||\textbf{x}(\lambda)|| = \Delta$, consequently there is one
|
||||||
|
solution.
|
||||||
|
|
||||||
|
Since $\textbf{x} = - (\textbf{H} + \lambda \textbf{I})^{-1} \cdot
|
||||||
|
\textbf{g}$ and we want to reduce the norm of $\textbf{x}$, clearly,
|
||||||
|
$\lambda > 0$ ($\lambda = 0$ is the unconstraint solution). But the
|
||||||
|
Newton method is only defined for a positive definite hessian matrix,
|
||||||
|
so $(\textbf{H} + \textbf{I} \lambda)$ must be positive
|
||||||
|
definite. Consequently, in the case where $\textbf{H}$ is not positive
|
||||||
|
definite, to ensure the positive definiteness, $\lambda$ must be
|
||||||
|
greater than $- h_1$.
|
||||||
|
\begin{align*}
|
||||||
|
\lambda > 0 \quad \text{and} \quad \lambda \geq - h_1
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
From that there are five cases:
|
||||||
|
- if $\textbf{H}$ is positive definite, $-h_1 < 0$, $\lambda \in (0,\infty)$
|
||||||
|
- if $\textbf{H}$ is not positive definite and $\textbf{w}_1^T \cdot
|
||||||
|
\textbf{g} \neq 0$, $(\textbf{H} + \textbf{I}
|
||||||
|
\lambda)$
|
||||||
|
must be positve definite, $-h_1 > 0$, $\lambda \in (-h_1, \infty)$
|
||||||
|
- if $\textbf{H}$ is not positive definite , $\textbf{w}_1^T \cdot
|
||||||
|
\textbf{g} = 0$ and $||\textbf{x}(-h_1)|| > \Delta$ by removing
|
||||||
|
$j=1$ in the sum, $(\textbf{H} + \textbf{I} \lambda)$ must be
|
||||||
|
positive definite, $-h_1 > 0$, $\lambda \in (-h_1, \infty$)
|
||||||
|
- if $\textbf{H}$ is not positive definite , $\textbf{w}_1^T \cdot
|
||||||
|
\textbf{g} = 0$ and $||\textbf{x}(-h_1)|| \leq \Delta$ by removing
|
||||||
|
$j=1$ in the sum, $(\textbf{H} + \textbf{I} \lambda)$ must be
|
||||||
|
positive definite, $-h_1 > 0$, $\lambda = -h_1$). This case is
|
||||||
|
similar to the case where $\textbf{H}$ and $||\textbf{x}(\lambda =
|
||||||
|
0)|| \leq \Delta$
|
||||||
|
but we can also add to $\textbf{x}$, the first eigenvector $\textbf{W}_1$
|
||||||
|
time a constant to ensure the condition $||\textbf{x}(\lambda =
|
||||||
|
-h_1)|| = \Delta$ and escape from the saddle point
|
||||||
|
|
||||||
|
Thus to find the solution, we can write:
|
||||||
|
\begin{align*}
|
||||||
|
||\textbf{x}(\lambda)|| = \Delta
|
||||||
|
\end{align*}
|
||||||
|
\begin{align*}
|
||||||
|
||\textbf{x}(\lambda)|| - \Delta = 0
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
Taking the square of this equation
|
||||||
|
\begin{align*}
|
||||||
|
(||\textbf{x}(\lambda)|| - \Delta)^2 = 0
|
||||||
|
\end{align*}
|
||||||
|
we have a function with one minimum for the optimal $\lambda$.
|
||||||
|
Since we have the formula of $||\textbf{x}(\lambda)||^2$, we solve
|
||||||
|
\begin{align*}
|
||||||
|
(||\textbf{x}(\lambda)||^2 - \Delta^2)^2 = 0
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
But in practice, it is more effective to solve:
|
||||||
|
\begin{align*}
|
||||||
|
(\frac{1}{||\textbf{x}(\lambda)||^2} - \frac{1}{\Delta^2})^2 = 0
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
To do that, we just use the Newton method with "trust_newton" using
|
||||||
|
first and second derivative of $(||\textbf{x}(\lambda)||^2 -
|
||||||
|
\Delta^2)^2$ with respect to $\textbf{x}$.
|
||||||
|
This will give the optimal $\lambda$ to compute the
|
||||||
|
solution $\textbf{x}$ with the formula seen previously:
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot
|
||||||
|
\textbf{g}}{h_i + \lambda} \cdot \textbf{w}_i
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
The solution $\textbf{x}(\lambda)$ with the optimal $\lambda$ is our
|
||||||
|
step to go from the (k)-th to the (k+1)-th iteration, is noted $\textbf{x}^*$.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Evolution of the trust region
|
||||||
|
|
||||||
|
We initialize the trust region at the first iteration using a radius
|
||||||
|
\begin{align*}
|
||||||
|
\Delta = ||\textbf{x}(\lambda=0)||
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
And for the next iteration the trust region will evolves depending of
|
||||||
|
the agreement of the energy prediction based on the Taylor series
|
||||||
|
truncated at the 2nd order and the real energy. If the Taylor series
|
||||||
|
truncated at the 2nd order represents correctly the energy landscape
|
||||||
|
the trust region will be extent else it will be reduced. In order to
|
||||||
|
mesure this agreement we use the ratio rho cf. "rho_model" and
|
||||||
|
"trust_e_model". From that we use the following values:
|
||||||
|
- if $\rho \geq 0.75$, then $\Delta = 2 \Delta$,
|
||||||
|
- if $0.5 \geq \rho < 0.75$, then $\Delta = \Delta$,
|
||||||
|
- if $0.25 \geq \rho < 0.5$, then $\Delta = 0.5 \Delta$,
|
||||||
|
- if $\rho < 0.25$, then $\Delta = 0.25 \Delta$.
|
||||||
|
|
||||||
|
In addition, if $\rho < 0.1$ the iteration is cancelled, so it
|
||||||
|
restarts with a smaller trust region until the energy decreases.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Summary
|
||||||
|
|
||||||
|
To summarize, knowing the hessian (eigenvectors and eigenvalues), the
|
||||||
|
gradient and the radius of the trust region we can compute the norm of
|
||||||
|
the Newton step
|
||||||
|
\begin{align*}
|
||||||
|
||\textbf{x}(\lambda = 0)||^2 = ||- \textbf{H}^{-1} \cdot \textbf{g}||^2 = \sum_{i=1}^n
|
||||||
|
\frac{(\textbf{w}_i^T \cdot \textbf{g})^2}{(h_i + \lambda)^2}, \quad h_i \neq 0
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
- if $h_1 \geq 0$, $||\textbf{x}(\lambda = 0)|| \leq \Delta$ and
|
||||||
|
$\textbf{x}(\lambda=0)$ is in the trust region and it is not
|
||||||
|
necessary to put a constraint on $\textbf{x}$, the solution is the
|
||||||
|
unconstrained one, $\textbf{x}^* = \textbf{x}(\lambda = 0)$.
|
||||||
|
- else if $h_1 < 0$, $\textbf{w}_1^T \cdot \textbf{g} = 0$ and
|
||||||
|
$||\textbf{x}(\lambda = -h_1)|| \leq \Delta$ (by removing $j=1$ in
|
||||||
|
the sum), the solution is $\textbf{x}^* = \textbf{x}(\lambda =
|
||||||
|
-h_1)$, similarly to the previous case.
|
||||||
|
But we can add to $\textbf{x}$, the first eigenvector $\textbf{W}_1$
|
||||||
|
time a constant to ensure the condition $||\textbf{x}(\lambda =
|
||||||
|
-h_1)|| = \Delta$ and escape from the saddle point
|
||||||
|
- else if $h_1 < 0$ and $\textbf{w}_1^T \cdot \textbf{g} \neq 0$ we
|
||||||
|
have to search $\lambda \in (-h_1, \infty)$ such as
|
||||||
|
$\textbf{x}(\lambda) = \Delta$ by solving with the Newton method
|
||||||
|
\begin{align*}
|
||||||
|
(||\textbf{x}(\lambda)||^2 - \Delta^2)^2 = 0
|
||||||
|
\end{align*}
|
||||||
|
or
|
||||||
|
\begin{align*}
|
||||||
|
(\frac{1}{||\textbf{x}(\lambda)||^2} - \frac{1}{\Delta^2})^2 = 0
|
||||||
|
\end{align*}
|
||||||
|
which is numerically more stable. And finally compute
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}^* = \textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot
|
||||||
|
\textbf{g}}{h_i + \lambda} \cdot \textbf{w}_i
|
||||||
|
\end{align*}
|
||||||
|
- else if $h_1 \geq 0$ and $||\textbf{x}(\lambda = 0)|| > \Delta$ we
|
||||||
|
do exactly the same thing that the previous case but we search
|
||||||
|
$\lambda \in (0, \infty)$
|
||||||
|
- else if $h_1 < 0$ and $\textbf{w}_1^T \cdot \textbf{g} = 0$ and
|
||||||
|
$||\textbf{x}(\lambda = -h_1)|| > \Delta$ (by removing $j=1$ in the
|
||||||
|
sum), again we do exactly the same thing that the previous case
|
||||||
|
searching $\lambda \in (-h_1, \infty)$.
|
||||||
|
|
||||||
|
|
||||||
|
For the cases where $\textbf{w}_1^T \cdot \textbf{g} = 0$ it is not
|
||||||
|
necessary in fact to remove the $j = 1$ in the sum since the term
|
||||||
|
where $h_i - \lambda < 10^{-6}$ are not computed.
|
||||||
|
|
||||||
|
After that, we take this vector $\textbf{x}^*$, called "x", and we do
|
||||||
|
the transformation to an antisymmetric matrix $\textbf{X}$, called
|
||||||
|
m_x. This matrix $\textbf{X}$ will be used to compute a rotation
|
||||||
|
matrix $\textbf{R}= \exp(\textbf{X})$ in "rotation_matrix".
|
||||||
|
|
||||||
|
NB:
|
||||||
|
An improvement can be done using a elleptical trust region.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Code
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
Cf. qp_edit in orbital optimization section, for some constants/thresholds
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| m | integer | number of MOs |
|
||||||
|
| n | integer | m*(m-1)/2 |
|
||||||
|
| H(n, n) | double precision | hessian |
|
||||||
|
| v_grad(n) | double precision | gradient |
|
||||||
|
| e_val(n) | double precision | eigenvalues of the hessian |
|
||||||
|
| W(n, n) | double precision | eigenvectors of the hessian |
|
||||||
|
| rho | double precision | agreement between the model and the reality, |
|
||||||
|
| | | represents the quality of the energy prediction |
|
||||||
|
| nb_iter | integer | number of iteration |
|
||||||
|
|
||||||
|
Input/Ouput:
|
||||||
|
| delta | double precision | radius of the trust region |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| x(n) | double precision | vector containing the step |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| accu | double precision | temporary variable to compute the step |
|
||||||
|
| lambda | double precision | lagrange multiplier |
|
||||||
|
| trust_radius2 | double precision | square of the radius of the trust region |
|
||||||
|
| norm2_x | double precision | norm^2 of the vector x |
|
||||||
|
| norm2_g | double precision | norm^2 of the vector containing the gradient |
|
||||||
|
| tmp_wtg(n) | double precision | tmp_wtg(i) = w_i^T . g |
|
||||||
|
| i, j, k | integer | indexes |
|
||||||
|
|
||||||
|
Function:
|
||||||
|
| dnrm2 | double precision | Blas function computing the norm |
|
||||||
|
| f_norm_trust_region_omp | double precision | compute the value of norm(x(lambda)^2) |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
subroutine trust_region_step(n,nb_iter,v_grad,rho,e_val,w,x,delta)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compuet the step in the trust region
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
double precision, intent(in) :: v_grad(n), rho
|
||||||
|
integer, intent(inout) :: nb_iter
|
||||||
|
double precision, intent(in) :: e_val(n), w(n,n)
|
||||||
|
|
||||||
|
! inout
|
||||||
|
double precision, intent(inout) :: delta
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: x(n)
|
||||||
|
|
||||||
|
! Internal
|
||||||
|
double precision :: accu, lambda, trust_radius2
|
||||||
|
double precision :: norm2_x, norm2_g
|
||||||
|
double precision, allocatable :: tmp_wtg(:)
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
integer :: n_neg_eval
|
||||||
|
|
||||||
|
|
||||||
|
! Functions
|
||||||
|
double precision :: ddot, dnrm2
|
||||||
|
double precision :: f_norm_trust_region_omp
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'=================='
|
||||||
|
print*,'---Trust_region---'
|
||||||
|
print*,'=================='
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(tmp_wtg(n))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
|
||||||
|
*** Initialization and norm
|
||||||
|
|
||||||
|
The norm of the step size will be useful for the trust region
|
||||||
|
algorithm. We start from a first guess and the radius of the trust
|
||||||
|
region will evolve during the optimization.
|
||||||
|
|
||||||
|
avoid_saddle is actually a test to avoid saddle points
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
! Initialization of the Lagrange multiplier
|
||||||
|
lambda = 0d0
|
||||||
|
|
||||||
|
! List of w^T.g, to avoid the recomputation
|
||||||
|
tmp_wtg = 0d0
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
tmp_wtg(j) = tmp_wtg(j) + w(i,j) * v_grad(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Replacement of the small tmp_wtg corresponding to a negative eigenvalue
|
||||||
|
! in the case of avoid_saddle
|
||||||
|
if (avoid_saddle .and. e_val(1) < - thresh_eig) then
|
||||||
|
i = 2
|
||||||
|
! Number of negative eigenvalues
|
||||||
|
do while (e_val(i) < - thresh_eig)
|
||||||
|
if (tmp_wtg(i) < thresh_wtg2) then
|
||||||
|
if (version_avoid_saddle == 1) then
|
||||||
|
tmp_wtg(i) = 1d0
|
||||||
|
elseif (version_avoid_saddle == 2) then
|
||||||
|
tmp_wtg(i) = DABS(e_val(i))
|
||||||
|
elseif (version_avoid_saddle == 3) then
|
||||||
|
tmp_wtg(i) = dsqrt(DABS(e_val(i)))
|
||||||
|
else
|
||||||
|
tmp_wtg(i) = thresh_wtg2
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
i = i + 1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! For the fist one it's a little bit different
|
||||||
|
if (tmp_wtg(1) < thresh_wtg2) then
|
||||||
|
tmp_wtg(1) = 0d0
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm^2 of x, ||x||^2
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg,0d0)
|
||||||
|
! We just use this norm for the nb_iter = 0 in order to initialize the trust radius delta
|
||||||
|
! We don't care about the sign of the eigenvalue we just want the size of the step in a normal Newton-Raphson algorithm
|
||||||
|
! Anyway if the step is too big it will be reduced
|
||||||
|
print*,'||x||^2 :', norm2_x
|
||||||
|
|
||||||
|
! Norm^2 of the gradient, ||v_grad||^2
|
||||||
|
norm2_g = (dnrm2(n,v_grad,1))**2
|
||||||
|
print*,'||grad||^2 :', norm2_g
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Trust radius initialization
|
||||||
|
|
||||||
|
At the first iteration (nb_iter = 0) we initialize the trust region
|
||||||
|
with the norm of the step generate by the Newton's method ($\textbf{x}_1 =
|
||||||
|
(\textbf{H}_0)^{-1} \cdot \textbf{g}_0$,
|
||||||
|
we compute this norm using f_norm_trust_region_omp as explain just
|
||||||
|
below)
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
! trust radius
|
||||||
|
if (nb_iter == 0) then
|
||||||
|
trust_radius2 = norm2_x
|
||||||
|
! To avoid infinite loop of cancellation of this first step
|
||||||
|
! without changing delta
|
||||||
|
nb_iter = 1
|
||||||
|
|
||||||
|
! Compute delta, delta = sqrt(trust_radius)
|
||||||
|
delta = dsqrt(trust_radius2)
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Modification of the trust radius
|
||||||
|
|
||||||
|
In function of rho (which represents the agreement between the model
|
||||||
|
and the reality, cf. rho_model) the trust region evolves. We update
|
||||||
|
delta (the radius of the trust region).
|
||||||
|
|
||||||
|
To avoid too big trust region we put a maximum size.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
! Modification of the trust radius in function of rho
|
||||||
|
if (rho >= 0.75d0) then
|
||||||
|
delta = 2d0 * delta
|
||||||
|
elseif (rho >= 0.5d0) then
|
||||||
|
delta = delta
|
||||||
|
elseif (rho >= 0.25d0) then
|
||||||
|
delta = 0.5d0 * delta
|
||||||
|
else
|
||||||
|
delta = 0.25d0 * delta
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Maximum size of the trust region
|
||||||
|
!if (delta > 0.5d0 * n * pi) then
|
||||||
|
! delta = 0.5d0 * n * pi
|
||||||
|
! print*,'Delta > delta_max, delta = 0.5d0 * n * pi'
|
||||||
|
!endif
|
||||||
|
|
||||||
|
if (delta > 1d10) then
|
||||||
|
delta = 1d10
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*, 'Delta :', delta
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Calculation of the optimal lambda
|
||||||
|
|
||||||
|
We search the solution of $(||x||^2 - \Delta^2)^2 = 0$
|
||||||
|
- If $||\textbf{x}|| > \Delta$ or $h_1 < 0$ we have to add a constant
|
||||||
|
$\lambda > 0 \quad \text{and} \quad \lambda > -h_1$
|
||||||
|
- If $||\textbf{x}|| \leq \Delta$ and $h_1 \geq 0$ the solution is the
|
||||||
|
unconstrained one, $\lambda = 0$
|
||||||
|
|
||||||
|
You will find more details at the beginning
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
! By giving delta, we search (||x||^2 - delta^2)^2 = 0
|
||||||
|
! and not (||x||^2 - delta)^2 = 0
|
||||||
|
|
||||||
|
! Research of lambda to solve ||x(lambda)|| = Delta
|
||||||
|
|
||||||
|
! Display
|
||||||
|
print*, 'e_val(1) = ', e_val(1)
|
||||||
|
print*, 'w_1^T.g =', tmp_wtg(1)
|
||||||
|
|
||||||
|
! H positive definite
|
||||||
|
if (e_val(1) > - thresh_eig) then
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg,0d0)
|
||||||
|
print*, '||x(0)||=', dsqrt(norm2_x)
|
||||||
|
print*, 'Delta=', delta
|
||||||
|
|
||||||
|
! H positive definite, ||x(lambda = 0)|| <= Delta
|
||||||
|
if (dsqrt(norm2_x) <= delta) then
|
||||||
|
print*, 'H positive definite, ||x(lambda = 0)|| <= Delta'
|
||||||
|
print*, 'lambda = 0, no lambda optimization'
|
||||||
|
lambda = 0d0
|
||||||
|
|
||||||
|
! H positive definite, ||x(lambda = 0)|| > Delta
|
||||||
|
else
|
||||||
|
! Constraint solution
|
||||||
|
print*, 'H positive definite, ||x(lambda = 0)|| > Delta'
|
||||||
|
print*,'Computation of the optimal lambda...'
|
||||||
|
call trust_region_optimal_lambda(n,e_val,tmp_wtg,delta,lambda)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! H indefinite
|
||||||
|
else
|
||||||
|
if (DABS(tmp_wtg(1)) < thresh_wtg) then
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg, - e_val(1))
|
||||||
|
print*, 'w_1^T.g <', thresh_wtg,', ||x(lambda = -e_val(1))|| =', dsqrt(norm2_x)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| <= Delta
|
||||||
|
if (dsqrt(norm2_x) <= delta .and. DABS(tmp_wtg(1)) < thresh_wtg) then
|
||||||
|
! Add e_val(1) in order to have (H - e_val(1) I) positive definite
|
||||||
|
print*, 'H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| <= Delta'
|
||||||
|
print*, 'lambda = -e_val(1), no lambda optimization'
|
||||||
|
lambda = - e_val(1)
|
||||||
|
|
||||||
|
! H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| > Delta
|
||||||
|
! and
|
||||||
|
! H indefinite, w_1^T.g =/= 0
|
||||||
|
else
|
||||||
|
! Constraint solution/ add lambda
|
||||||
|
if (DABS(tmp_wtg(1)) < thresh_wtg) then
|
||||||
|
print*, 'H indefinite, w_1^T.g = 0, ||x(lambda = -e_val(1))|| > Delta'
|
||||||
|
else
|
||||||
|
print*, 'H indefinite, w_1^T.g =/= 0'
|
||||||
|
endif
|
||||||
|
print*, 'Computation of the optimal lambda...'
|
||||||
|
call trust_region_optimal_lambda(n,e_val,tmp_wtg,delta,lambda)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Recomputation of the norm^2 of the step x
|
||||||
|
norm2_x = f_norm_trust_region_omp(n,e_val,tmp_wtg,lambda)
|
||||||
|
print*,''
|
||||||
|
print*,'Summary after the trust region:'
|
||||||
|
print*,'lambda:', lambda
|
||||||
|
print*,'||x||:', dsqrt(norm2_x)
|
||||||
|
print*,'delta:', delta
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Calculation of the step x
|
||||||
|
|
||||||
|
x refers to $\textbf{x}^*$
|
||||||
|
We compute x in function of lambda using its formula :
|
||||||
|
\begin{align*}
|
||||||
|
\textbf{x}^* = \textbf{x}(\lambda) = - \sum_{i=1}^n \frac{\textbf{w}_i^T \cdot \textbf{g}}{h_i
|
||||||
|
+ \lambda} \cdot \textbf{w}_i
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
! Initialisation
|
||||||
|
x = 0d0
|
||||||
|
|
||||||
|
! Calculation of the step x
|
||||||
|
|
||||||
|
! Normal version
|
||||||
|
if (.not. absolute_eig) then
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (DABS(e_val(i)) > thresh_eig .and. DABS(e_val(i)+lambda) > thresh_eig) then
|
||||||
|
do j = 1, n
|
||||||
|
x(j) = x(j) - tmp_wtg(i) * W(j,i) / (e_val(i) + lambda)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Version to use the absolute value of the eigenvalues
|
||||||
|
else
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (DABS(e_val(i)) > thresh_eig) then
|
||||||
|
do j = 1, n
|
||||||
|
x(j) = x(j) - tmp_wtg(i) * W(j,i) / (DABS(e_val(i)) + lambda)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
double precision :: beta, norm_x
|
||||||
|
|
||||||
|
! Test
|
||||||
|
! If w_1^T.g = 0, the lim of ||x(lambda)|| when lambda tend to -e_val(1)
|
||||||
|
! is not + infinity. So ||x(lambda=-e_val(1))|| < delta, we add the first
|
||||||
|
! eigenvectors multiply by a constant to ensure the condition
|
||||||
|
! ||x(lambda=-e_val(1))|| = delta and escape the saddle point
|
||||||
|
if (avoid_saddle .and. e_val(1) < - thresh_eig) then
|
||||||
|
if (tmp_wtg(1) < 1d-15 .and. (1d0 - dsqrt(norm2_x)/delta) > 1d-3 ) then
|
||||||
|
|
||||||
|
! norm of x
|
||||||
|
norm_x = dnrm2(n,x,1)
|
||||||
|
|
||||||
|
! Computes the coefficient for the w_1
|
||||||
|
beta = delta**2 - norm_x**2
|
||||||
|
|
||||||
|
! Updates the step x
|
||||||
|
x = x + W(:,1) * dsqrt(beta)
|
||||||
|
|
||||||
|
! Recomputes the norm to check
|
||||||
|
norm_x = dnrm2(n,x,1)
|
||||||
|
|
||||||
|
print*, 'Add w_1 * dsqrt(delta^2 - ||x||^2):'
|
||||||
|
print*, '||x||', norm_x
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Transformation of x
|
||||||
|
|
||||||
|
x is a vector of size n, so it can be write as a m by m
|
||||||
|
antisymmetric matrix m_x cf. "mat_to_vec_index" and "vec_to_mat_index".
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
! ! Step transformation vector -> matrix
|
||||||
|
! ! Vector with n element -> mo_num by mo_num matrix
|
||||||
|
! do j = 1, m
|
||||||
|
! do i = 1, m
|
||||||
|
! if (i>j) then
|
||||||
|
! call mat_to_vec_index(i,j,k)
|
||||||
|
! m_x(i,j) = x(k)
|
||||||
|
! else
|
||||||
|
! m_x(i,j) = 0d0
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! ! Antisymmetrization of the previous matrix
|
||||||
|
! do j = 1, m
|
||||||
|
! do i = 1, m
|
||||||
|
! if (i<j) then
|
||||||
|
! m_x(i,j) = - m_x(j,i)
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Deallocation, end
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle trust_region_step.irp.f
|
||||||
|
deallocate(tmp_wtg)
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in trust_region:', t3
|
||||||
|
print*,'======================'
|
||||||
|
print*,'---End trust_region---'
|
||||||
|
print*,'======================'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
||||||
|
|
71
src/utils_trust_region/vec_to_mat_index.irp.f
Normal file
71
src/utils_trust_region/vec_to_mat_index.irp.f
Normal file
@ -0,0 +1,71 @@
|
|||||||
|
! Vector to matrix indexes
|
||||||
|
|
||||||
|
! *Compute the indexes p,q of a matrix element with the vector index i*
|
||||||
|
|
||||||
|
! Vector (i) -> lower diagonal matrix (p,q), p > q
|
||||||
|
|
||||||
|
! If a matrix is antisymmetric it can be reshaped as a vector. And the
|
||||||
|
! vector can be reshaped as an antisymmetric matrix
|
||||||
|
|
||||||
|
! \begin{align*}
|
||||||
|
! \begin{pmatrix}
|
||||||
|
! 0 & -1 & -2 & -4 \\
|
||||||
|
! 1 & 0 & -3 & -5 \\
|
||||||
|
! 2 & 3 & 0 & -6 \\
|
||||||
|
! 4 & 5 & 6 & 0
|
||||||
|
! \end{pmatrix}
|
||||||
|
! \Leftrightarrow
|
||||||
|
! \begin{pmatrix}
|
||||||
|
! 1 & 2 & 3 & 4 & 5 & 6
|
||||||
|
! \end{pmatrix}
|
||||||
|
! \end{align*}
|
||||||
|
|
||||||
|
! !!! Here the algorithm only work for the lower diagonal !!!
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | i | integer | index in the vector |
|
||||||
|
|
||||||
|
! Ouput:
|
||||||
|
! | p,q | integer | corresponding indexes in the lower diagonal of a matrix |
|
||||||
|
! | | | p > q, |
|
||||||
|
! | | | p -> row, |
|
||||||
|
! | | | q -> column |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine vec_to_mat_index(i,p,q)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the indexes (p,q) of the element in the lower diagonal matrix knowing
|
||||||
|
! its index i a vector
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer,intent(in) :: i
|
||||||
|
|
||||||
|
! out
|
||||||
|
integer, intent(out) :: p,q
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: a,b
|
||||||
|
double precision :: da
|
||||||
|
|
||||||
|
da = 0.5d0*(1+ sqrt(1d0+8d0*DBLE(i)))
|
||||||
|
a = INT(da)
|
||||||
|
if ((a*(a-1))/2==i) then
|
||||||
|
p = a-1
|
||||||
|
else
|
||||||
|
p = a
|
||||||
|
endif
|
||||||
|
b = p*(p-1)/2
|
||||||
|
|
||||||
|
! Matrix element indexes
|
||||||
|
p = p + 1
|
||||||
|
q = i - b
|
||||||
|
|
||||||
|
end subroutine
|
72
src/utils_trust_region/vec_to_mat_index.org
Normal file
72
src/utils_trust_region/vec_to_mat_index.org
Normal file
@ -0,0 +1,72 @@
|
|||||||
|
* Vector to matrix indexes
|
||||||
|
|
||||||
|
*Compute the indexes p,q of a matrix element with the vector index i*
|
||||||
|
|
||||||
|
Vector (i) -> lower diagonal matrix (p,q), p > q
|
||||||
|
|
||||||
|
If a matrix is antisymmetric it can be reshaped as a vector. And the
|
||||||
|
vector can be reshaped as an antisymmetric matrix
|
||||||
|
|
||||||
|
\begin{align*}
|
||||||
|
\begin{pmatrix}
|
||||||
|
0 & -1 & -2 & -4 \\
|
||||||
|
1 & 0 & -3 & -5 \\
|
||||||
|
2 & 3 & 0 & -6 \\
|
||||||
|
4 & 5 & 6 & 0
|
||||||
|
\end{pmatrix}
|
||||||
|
\Leftrightarrow
|
||||||
|
\begin{pmatrix}
|
||||||
|
1 & 2 & 3 & 4 & 5 & 6
|
||||||
|
\end{pmatrix}
|
||||||
|
\end{align*}
|
||||||
|
|
||||||
|
!!! Here the algorithm only work for the lower diagonal !!!
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| i | integer | index in the vector |
|
||||||
|
|
||||||
|
Ouput:
|
||||||
|
| p,q | integer | corresponding indexes in the lower diagonal of a matrix |
|
||||||
|
| | | p > q, |
|
||||||
|
| | | p -> row, |
|
||||||
|
| | | q -> column |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle vec_to_mat_index.irp.f
|
||||||
|
subroutine vec_to_mat_index(i,p,q)
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the indexes (p,q) of the element in the lower diagonal matrix knowing
|
||||||
|
! its index i a vector
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer,intent(in) :: i
|
||||||
|
|
||||||
|
! out
|
||||||
|
integer, intent(out) :: p,q
|
||||||
|
|
||||||
|
! internal
|
||||||
|
integer :: a,b
|
||||||
|
double precision :: da
|
||||||
|
|
||||||
|
da = 0.5d0*(1+ sqrt(1d0+8d0*DBLE(i)))
|
||||||
|
a = INT(da)
|
||||||
|
if ((a*(a-1))/2==i) then
|
||||||
|
p = a-1
|
||||||
|
else
|
||||||
|
p = a
|
||||||
|
endif
|
||||||
|
b = p*(p-1)/2
|
||||||
|
|
||||||
|
! Matrix element indexes
|
||||||
|
p = p + 1
|
||||||
|
q = i - b
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
39
src/utils_trust_region/vec_to_mat_v2.irp.f
Normal file
39
src/utils_trust_region/vec_to_mat_v2.irp.f
Normal file
@ -0,0 +1,39 @@
|
|||||||
|
! Vect to antisymmetric matrix using mat_to_vec_index
|
||||||
|
|
||||||
|
! Vector to antisymmetric matrix transformation using mat_to_vec_index
|
||||||
|
! subroutine.
|
||||||
|
|
||||||
|
! Can be done in OMP (for the first part and with omp critical for the second)
|
||||||
|
|
||||||
|
|
||||||
|
subroutine vec_to_mat_v2(n,m,v_x,m_x)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Vector to antisymmetric matrix
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: n,m
|
||||||
|
double precision, intent(in) :: v_x(n)
|
||||||
|
double precision, intent(out) :: m_x(m,m)
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
|
||||||
|
! 1D -> 2D lower diagonal
|
||||||
|
m_x = 0d0
|
||||||
|
do j = 1, m - 1
|
||||||
|
do i = j + 1, m
|
||||||
|
call mat_to_vec_index(i,j,k)
|
||||||
|
m_x(i,j) = v_x(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Antisym
|
||||||
|
do i = 1, m - 1
|
||||||
|
do j = i + 1, m
|
||||||
|
m_x(i,j) = - m_x(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
40
src/utils_trust_region/vec_to_mat_v2.org
Normal file
40
src/utils_trust_region/vec_to_mat_v2.org
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
* Vect to antisymmetric matrix using mat_to_vec_index
|
||||||
|
|
||||||
|
Vector to antisymmetric matrix transformation using mat_to_vec_index
|
||||||
|
subroutine.
|
||||||
|
|
||||||
|
Can be done in OMP (for the first part and with omp critical for the second)
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle vec_to_mat_v2.irp.f
|
||||||
|
subroutine vec_to_mat_v2(n,m,v_x,m_x)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Vector to antisymmetric matrix
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: n,m
|
||||||
|
double precision, intent(in) :: v_x(n)
|
||||||
|
double precision, intent(out) :: m_x(m,m)
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
|
||||||
|
! 1D -> 2D lower diagonal
|
||||||
|
m_x = 0d0
|
||||||
|
do j = 1, m - 1
|
||||||
|
do i = j + 1, m
|
||||||
|
call mat_to_vec_index(i,j,k)
|
||||||
|
m_x(i,j) = v_x(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Antisym
|
||||||
|
do i = 1, m - 1
|
||||||
|
do j = i + 1, m
|
||||||
|
m_x(i,j) = - m_x(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
Loading…
Reference in New Issue
Block a user