mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-12 14:43:29 +01:00
create utils trust region
This commit is contained in:
parent
0325e59ebe
commit
c687569bf4
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
|
11
src/utils_trust_region/README.md
Normal file
11
src/utils_trust_region/README.md
Normal file
@ -0,0 +1,11 @@
|
||||
# Utils trust region
|
||||
|
||||
The documentation can be found in the org files.
|
||||
|
||||
# Org files
|
||||
The org files are stored in the directory org in order to avoid overwriting on user changes.
|
||||
The org files can be modified, to export the change to the source code, run
|
||||
```
|
||||
./TANGLE_org_mode.sh
|
||||
mv *.irp.f ../.
|
||||
```
|
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,n2,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,n2, nb_iter
|
||||
double precision, intent(in) :: H(n,n2), W(n,n2), 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,n2,nb_iter,v_grad,rho,e_val,W,x,delta)
|
||||
|
||||
call trust_region_expected_e(n,n2,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
|
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
|
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
|
7
src/utils_trust_region/org/TANGLE_org_mode.sh
Executable file
7
src/utils_trust_region/org/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
|
593
src/utils_trust_region/org/algo_trust.org
Normal file
593
src/utils_trust_region/org/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,n2,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,n2, nb_iter
|
||||
double precision, intent(in) :: H(n,n2), W(n,n2), 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,n2,nb_iter,v_grad,rho,e_val,W,x,delta)
|
||||
|
||||
call trust_region_expected_e(n,n2,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,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,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
|
||||
|
86
src/utils_trust_region/org/apply_mo_rotation.org
Normal file
86
src/utils_trust_region/org/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
|
63
src/utils_trust_region/org/mat_to_vec_index.org
Normal file
63
src/utils_trust_region/org/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
|
||||
|
452
src/utils_trust_region/org/rotation_matrix.org
Normal file
452
src/utils_trust_region/org/rotation_matrix.org
Normal file
@ -0,0 +1,452 @@
|
||||
* 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*, 'WARNING: error in the diagonalization'
|
||||
print*, 'Illegal value of the ', info2,'-th parameter'
|
||||
elseif (info2 >0) then
|
||||
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)
|
||||