PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-03 20:53:54 +01:00
Code Releases Activity

Merge branch 'csf_verified' of ssh://github.com/v1j4y/qp2 into csf_verified

Browse Source
This commit is contained in:
v1j4y 2022-11-23 13:58:52 +01:00
commit 6b1c85bec0
61 changed files with 13970 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/qp_set_frozen_core
View File

@ -11,8 +11,8 @@ Usage:
Options:
-q --query Prints in the standard output the number of frozen MOs
-l --large Use a small core
-s --small Use a large core
-l --large Use a large core
-s --small Use a small core
-u --unset Unset frozen core

2
configure vendored
View File

@ -369,7 +369,7 @@ else
echo ""
echo "${QP_ROOT}/build.ninja does not exist,"
echo "you need to specify the COMPILATION configuration file."
echo "See ./configure --help for more details."
echo "See ./configure -h for more details."
echo ""
fi

8
ocaml/Message.ml
View File

@ -63,11 +63,11 @@ end
module Connect_msg : sig
type t = Tcp | Inproc | Ipc
val create : typ:string -> t
val create : string -> t
val to_string : t -> string
end = struct
type t = Tcp | Inproc | Ipc
let create ~typ =
let create typ =
match typ with
| "tcp" -> Tcp
| "inproc" -> Inproc
@ -515,9 +515,9 @@ let of_string s =
| Connect_ socket ->
Connect (Connect_msg.create socket)
| NewJob_ { state ; push_address_tcp ; push_address_inproc } ->
Newjob (Newjob_msg.create push_address_tcp push_address_inproc state)
Newjob (Newjob_msg.create ~address_tcp:push_address_tcp ~address_inproc:push_address_inproc ~state)
| EndJob_ state ->
Endjob (Endjob_msg.create state)
Endjob (Endjob_msg.create ~state)
| GetData_ { state ; client_id ; key } ->
GetData (GetData_msg.create ~client_id ~state ~key)
| PutData_ { state ; client_id ; key } ->

2
ocaml/TaskServer.ml
View File

@ -776,7 +776,7 @@ let run ~port =
Zmq.Socket.create zmq_context Zmq.Socket.rep
in
Zmq.Socket.set_linger_period rep_socket 1_000_000;
bind_socket "REP" rep_socket port;
bind_socket ~socket_type:"REP" ~socket:rep_socket ~port;
let initial_program_state =
{ queue = Queuing_system.create () ;

5
src/ao_basis/EZFIO.cfg
View File

@ -36,13 +36,13 @@ interface: ezfio, provider
type: double precision
doc: Primitive coefficients, read from input. Those should not be used directly, as the MOs are expressed on the basis of **normalized** AOs.
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
interface: ezfio, provider
interface: ezfio
[ao_expo]
type: double precision
doc: Exponents for each primitive of each |AO|
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
interface: ezfio, provider
interface: ezfio
[ao_md5]
type: character*(32)
@ -67,3 +67,4 @@ doc: Use normalized primitive functions
interface: ezfio, provider
default: true

59
src/ao_basis/aos.irp.f
View File

@ -1,11 +1,3 @@
BEGIN_PROVIDER [ integer, ao_prim_num_max ]
implicit none
BEGIN_DOC
! Max number of primitives.
END_DOC
ao_prim_num_max = maxval(ao_prim_num)
END_PROVIDER
BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
implicit none
BEGIN_DOC
@ -23,6 +15,32 @@ BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef , (ao_num,ao_prim_num_max) ]
&BEGIN_PROVIDER [ double precision, ao_expo , (ao_num,ao_prim_num_max) ]
implicit none
BEGIN_DOC
! Primitive coefficients and exponents for each atomic orbital. Copied from shell info.
END_DOC
integer :: i, l
do i=1,ao_num
l = ao_shell(i)
ao_coef(i,:) = shell_coef(l,:)
ao_expo(i,:) = shell_expo(l,:)
end do
END_PROVIDER
BEGIN_PROVIDER [ integer, ao_prim_num_max ]
implicit none
BEGIN_DOC
! Max number of primitives.
END_DOC
ao_prim_num_max = shell_prim_num_max
END_PROVIDER
BEGIN_PROVIDER [ integer, ao_first_of_shell, (shell_num) ]
implicit none
BEGIN_DOC
@ -44,20 +62,20 @@ END_PROVIDER
BEGIN_DOC
! Coefficients including the |AO| normalization
END_DOC
do i=1,ao_num
l = ao_shell(i)
ao_coef_normalized(i,:) = shell_coef(l,:) * shell_normalization_factor(l)
end do
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz
integer :: i,j,k
nz=100
C_A(1) = 0.d0
C_A(2) = 0.d0
C_A(3) = 0.d0
ao_coef_normalized = 0.d0
C_A = 0.d0
do i=1,ao_num
! powA(1) = ao_power(i,1) + ao_power(i,2) + ao_power(i,3)
! powA(2) = 0
! powA(3) = 0
powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3)
@ -67,18 +85,9 @@ END_PROVIDER
do j=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j), &
powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
ao_coef_normalized(i,j) = ao_coef(i,j)/dsqrt(norm)
enddo
else
do j=1,ao_prim_num(i)
ao_coef_normalized(i,j) = ao_coef(i,j)
ao_coef_normalized(i,j) = ao_coef_normalized(i,j)/dsqrt(norm)
enddo
endif
powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3)
! Normalization of the contracted basis functions
if (ao_normalized) then
norm = 0.d0

1
src/basis/EZFIO.cfg
View File

@ -72,4 +72,3 @@ doc: Exponents in the shell
size: (basis.prim_num)
interface: ezfio, provider

153
src/basis/basis.irp.f
View File

@ -1,67 +1,11 @@
BEGIN_PROVIDER [ double precision, shell_normalization_factor , (shell_num) ]
BEGIN_PROVIDER [ integer, shell_prim_num_max ]
implicit none
BEGIN_DOC
! Number of primitives per |AO|
! Max number of primitives.
END_DOC
logical :: has
PROVIDE ezfio_filename
if (mpi_master) then
if (size(shell_normalization_factor) == 0) return
call ezfio_has_basis_shell_normalization_factor(has)
if (has) then
write(6,'(A)') '.. >>>>> [ IO READ: shell_normalization_factor ] <<<<< ..'
call ezfio_get_basis_shell_normalization_factor(shell_normalization_factor)
else
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz
integer :: i,j,k
nz=100
C_A(1) = 0.d0
C_A(2) = 0.d0
C_A(3) = 0.d0
do i=1,shell_num
powA(1) = shell_ang_mom(i)
powA(2) = 0
powA(3) = 0
norm = 0.d0
do k=1, prim_num
if (shell_index(k) /= i) cycle
do j=1, prim_num
if (shell_index(j) /= i) cycle
call overlap_gaussian_xyz(C_A,C_A,prim_expo(j),prim_expo(k), &
powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
norm = norm+c*prim_coef(j)*prim_coef(k) * prim_normalization_factor(j) * prim_normalization_factor(k)
enddo
enddo
shell_normalization_factor(i) = 1.d0/dsqrt(norm)
enddo
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( shell_normalization_factor, (shell_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read shell_normalization_factor with MPI'
endif
IRP_ENDIF
call write_time(6)
shell_prim_num_max = maxval(shell_prim_num)
END_PROVIDER
BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ]
implicit none
BEGIN_DOC
@ -120,3 +64,94 @@ BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ]
call write_time(6)
END_PROVIDER
BEGIN_PROVIDER [ double precision, shell_coef , (shell_num, shell_prim_num_max) ]
&BEGIN_PROVIDER [ double precision, shell_expo , (shell_num, shell_prim_num_max) ]
implicit none
BEGIN_DOC
! Primitive coefficients and exponents for each shell.
END_DOC
integer :: i, idx
integer :: count(shell_num)
count(:) = 0
do i=1, prim_num
idx = shell_index(i)
count(idx) += 1
shell_coef(idx, count(idx)) = prim_coef(i)
shell_expo(idx, count(idx)) = prim_expo(i)
end do
END_PROVIDER
BEGIN_PROVIDER [ double precision, shell_coef_normalized, (shell_num,shell_prim_num_max) ]
&BEGIN_PROVIDER [ double precision, shell_normalization_factor, (shell_num) ]
implicit none
BEGIN_DOC
! Coefficients including the |shell| normalization
END_DOC
logical :: has
PROVIDE ezfio_filename
shell_normalization_factor(:) = 1.d0
if (mpi_master) then
if (size(shell_normalization_factor) == 0) return
call ezfio_has_basis_shell_normalization_factor(has)
if (has) then
write(6,'(A)') '.. >>>>> [ IO READ: shell_normalization_factor ] <<<<< ..'
call ezfio_get_basis_shell_normalization_factor(shell_normalization_factor)
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( shell_normalization_factor, (shell_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read shell_normalization_factor with MPI'
endif
IRP_ENDIF
call write_time(6)
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz
integer :: i,j,k
nz=100
C_A = 0.d0
powA = 0
shell_coef_normalized = 0.d0
do i=1,shell_num
powA(1) = shell_ang_mom(i)
! Normalization of the primitives
if (primitives_normalized) then
do j=1,shell_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,shell_expo(i,j),shell_expo(i,j), &
powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
shell_coef_normalized(i,j) = shell_coef(i,j)/dsqrt(norm)
enddo
else
do j=1,shell_prim_num(i)
shell_coef_normalized(i,j) = shell_coef(i,j)
enddo
endif
! Normalization of the contracted basis functions
norm = 0.d0
do j=1,shell_prim_num(i)
do k=1,shell_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,shell_expo(i,j),shell_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
norm = norm+c*shell_coef_normalized(i,j)*shell_coef_normalized(i,k)
enddo
enddo
shell_normalization_factor(i) *= 1.d0/dsqrt(norm)
enddo
END_PROVIDER

4
src/bitmask/core_inact_act_virt.irp.f
View File

@ -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)
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ]
implicit none
BEGIN_DOC
@ -444,4 +441,3 @@ BEGIN_PROVIDER [integer, list_all_but_del_orb, (n_all_but_del_orb)]
enddo
END_PROVIDER

1
src/csf/cfgCI_utils.c
View File

@ -255,6 +255,7 @@ 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 gramSchmidt_qp(double *overlapMatrix, int rows, int cols, double *orthoMatrix){
// int i,j;
// //for(j=0;j<cols;++j){

12
src/csf/sigma_vector.irp.f
View File

@ -112,7 +112,7 @@
! endif
!enddo
n_CSF = 0
print *," -9(((((((((((((( NSOMOMin=",NSOMOMin
!print *," -9(((((((((((((( NSOMOMin=",NSOMOMin
ncfgprev = cfg_seniority_index(NSOMOMin) ! can be -1
if(ncfgprev.eq.-1)then
ncfgprev=1
@ -145,10 +145,10 @@
endif
endif
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)
end do
print *," ^^^^^ N_CSF = ",n_CSF," N_CFG=",N_configuration
!print *," ^^^^^ N_CSF = ",n_CSF," N_CFG=",N_configuration
END_PROVIDER
@ -342,8 +342,8 @@ end subroutine get_phase_qp_to_cfg
nsomomin = elec_alpha_num-elec_beta_num
rowsmax = 0
colsmax = 0
print *,"NSOMOMax = ",NSOMOMax
print *,"NSOMOMin = ",NSOMOMin
!print *,"NSOMOMax = ",NSOMOMax
!print *,"NSOMOMin = ",NSOMOMin
!allocate(AIJpqMatrixDimsList(NSOMOMax,NSOMOMax,4,NSOMOMax,NSOMOMax,2))
! Type
! 1. SOMO -> SOMO
@ -525,7 +525,7 @@ end subroutine get_phase_qp_to_cfg
end do
end do
end do
print *,"Rowsmax=",rowsmax," Colsmax=",colsmax
!print *,"Rowsmax=",rowsmax," Colsmax=",colsmax
END_PROVIDER
BEGIN_PROVIDER [ real*8, AIJpqContainer, (NBFMax,NBFmax,NSOMOMax+1,NSOMOMax+1,4,NSOMOMin:NSOMOMax)]

14
src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f
View File

@ -27,7 +27,7 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
double precision, intent(in) :: H_jj(sze),Dress_jj(sze)
double precision, intent(inout) :: u_in(sze,N_st_diag_in)
double precision, intent(out) :: energies(N_st)
external hcalc
external :: hcalc
integer :: iter, N_st_diag
integer :: i,j,k,l,m
@ -207,7 +207,7 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
enddo
! Normalize all states
do k=1,N_st_diag
call normalize(u_in(1,k),sze)
call normalize(u_in(:,k),sze)
enddo
! Copy from the guess input "u_in" to the working vectors "U"
@ -238,10 +238,10 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
call ortho_qr(U,size(U,1),sze,shift2)
! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag)
! where sze is the size of the vector, N_st_diag is the number of states
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
! Compute then the DIAGONAL PART OF THE DRESSING
! <i|W_k> += Dress_jj(i) * <i|U>
call dressing_diag_uv(W(1,shift+1),U(1,shift+1),Dress_jj,N_st_diag_in,sze)
call dressing_diag_uv(W(:,shift+1),U(:,shift+1),Dress_jj,N_st_diag_in,sze)
else
! Already computed in update below
continue
@ -303,9 +303,9 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
! --------------------------------------------------
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
! Compute residual vector and davidson step
! -----------------------------------------
@ -319,7 +319,7 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
enddo
if (k <= N_st) then
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
to_print(1,k) = lambda(k)
to_print(2,k) = residual_norm(k)
endif

23
src/dav_general_mat/dav_double_dress_ext_rout.irp.f
View File

@ -31,7 +31,8 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
double precision, intent(inout) :: u_in(sze,N_st_diag)
double precision, intent(out) :: energies(N_st_diag)
logical, intent(out) :: converged
external hcalc
external :: hcalc
double precision, allocatable :: H_jj_tmp(:)
ASSERT (N_st > 0)
@ -224,7 +225,7 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
u_in(k,k) = u_in(k,k) + 10.d0
enddo
do k=1,N_st_diag_in
call normalize(u_in(1,k),sze)
call normalize(u_in(:,k),sze)
enddo
do k=1,N_st_diag_in
@ -248,10 +249,10 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
if ((iter > 1).or.(itertot == 1)) then
! Compute |W_k> = \sum_i |i><i|H|u_k>
! -----------------------------------
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag_in,sze)
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag_in,sze)
! Compute then the DIAGONAL PART OF THE DRESSING
! <i|W_k> += Dress_jj(i) * <i|U>
call dressing_diag_uv(W(1,shift+1),U(1,shift+1),Dress_jj,N_st_diag_in,sze)
call dressing_diag_uv(W(:,shift+1),U(:,shift+1),Dress_jj,N_st_diag_in,sze)
else
! Already computed in update below
continue
@ -275,20 +276,20 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
!
! call dgemm('T','N', N_st, N_st_diag_in, sze, 1.d0, &
! psi_coef, size(psi_coef,1), &
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
!
! call dgemm('N','N', sze, N_st_diag_in, N_st, 1.0d0, &
! Dressing_vec, size(Dressing_vec,1), s_tmp, size(s_tmp,1), &
! 1.d0, W(1,shift+1), size(W,1))
! 1.d0, W(:,shift+1), size(W,1))
!
!
! call dgemm('T','N', N_st, N_st_diag_in, sze, 1.d0, &
! Dressing_vec, size(Dressing_vec,1), &
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
!
! call dgemm('N','N', sze, N_st_diag_in, N_st, 1.0d0, &
! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
! 1.d0, W(1,shift+1), size(W,1))
! 1.d0, W(:,shift+1), size(W,1))
!
endif
@ -376,9 +377,9 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
! --------------------------------------------------
call dgemm('N','N', sze, N_st_diag_in, shift2, &
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
call dgemm('N','N', sze, N_st_diag_in, shift2, &
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
! Compute residual vector and davidson step
! -----------------------------------------
@ -392,7 +393,7 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
enddo
if (k <= N_st) then
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
to_print(1,k) = lambda(k)
to_print(2,k) = residual_norm(k)
endif

18
src/dav_general_mat/dav_dressed_ext_rout.irp.f
View File

@ -214,7 +214,7 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
enddo
! Normalize all states
do k=1,N_st_diag
call normalize(u_in(1,k),sze)
call normalize(u_in(:,k),sze)
enddo
! Copy from the guess input "u_in" to the working vectors "U"
@ -244,7 +244,7 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
call ortho_qr(U,size(U,1),sze,shift2)
! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag)
! where sze is the size of the vector, N_st_diag is the number of states
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
else
! Already computed in update below
continue
@ -268,20 +268,20 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
stop
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
! psi_coef, size(psi_coef,1), &
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
!
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
! dressing_vec, size(dressing_vec,1), s_tmp, size(s_tmp,1), &
! 1.d0, W(1,shift+1), size(W,1))
! 1.d0, W(:,shift+1), size(W,1))
!
!
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
! dressing_vec, size(dressing_vec,1), &
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
!
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
! 1.d0, W(1,shift+1), size(W,1))
! 1.d0, W(:,shift+1), size(W,1))
endif
endif
@ -370,9 +370,9 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
! --------------------------------------------------
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
! Compute residual vector and davidson step
! -----------------------------------------
@ -386,7 +386,7 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
enddo
if (k <= N_st) then
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
to_print(1,k) = lambda(k)
to_print(2,k) = residual_norm(k)
endif

10
src/dav_general_mat/dav_ext_rout.irp.f
View File

@ -196,7 +196,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
enddo
! Normalize all states
do k=1,N_st_diag
call normalize(u_in(1,k),sze)
call normalize(u_in(:,k),sze)
enddo
! Copy from the guess input "u_in" to the working vectors "U"
@ -226,7 +226,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
call ortho_qr(U,size(U,1),sze,shift2)
! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag)
! where sze is the size of the vector, N_st_diag is the number of states
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
else
! Already computed in update below
continue
@ -288,9 +288,9 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
! --------------------------------------------------
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
! Compute residual vector and davidson step
! -----------------------------------------
@ -304,7 +304,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
enddo
if (k <= N_st) then
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
to_print(1,k) = lambda(k)
to_print(2,k) = residual_norm(k)
endif

12
src/dav_general_mat/dav_general.irp.f
View File

@ -206,7 +206,7 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
enddo
! Normalize all states
do k=1,N_st_diag
call normalize(u_in(1,k),sze)
call normalize(u_in(:,k),sze)
enddo
! Copy from the guess input "u_in" to the working vectors "U"
@ -236,8 +236,8 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
call ortho_qr(U,size(U,1),sze,shift2)
call ortho_qr(U,size(U,1),sze,shift2)
! call H_S2_u_0_nstates_openmp(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
call hpsi(W(1,shift+1),U(1,shift+1),N_st_diag,sze,h_mat)
! call H_S2_u_0_nstates_openmp(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
call hpsi(W(:,shift+1),U(:,shift+1),N_st_diag,sze,h_mat)
else
! Already computed in update below
continue
@ -299,9 +299,9 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
! --------------------------------------------------
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
call dgemm('N','N', sze, N_st_diag, shift2, &
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
! Compute residual vector and davidson step
! -----------------------------------------
@ -315,7 +315,7 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
enddo
if (k <= N_st) then
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
to_print(1,k) = lambda(k)
to_print(2,k) = residual_norm(k)
endif

10
src/determinants/determinants.irp.f
View File

@ -537,6 +537,7 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
double precision, intent(in) :: psicoef(dim_psicoef,nstates)
integer*8, allocatable :: psi_det_save(:,:,:)
double precision, allocatable :: psi_coef_save(:,:)
double precision, allocatable :: psi_coef_save2(:,:)
double precision :: accu_norm
integer :: i,j,k, ndet_qp_edit
@ -572,18 +573,17 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
enddo
call ezfio_set_determinants_psi_coef(psi_coef_save)
deallocate (psi_coef_save)
allocate (psi_coef_save(ndet_qp_edit,nstates))
allocate (psi_coef_save2(ndet_qp_edit,nstates))
do k=1,nstates
do i=1,ndet_qp_edit
psi_coef_save(i,k) = psicoef(i,k)
psi_coef_save2(i,k) = psi_coef_save(i,k)
enddo
call normalize(psi_coef_save(1,k),ndet_qp_edit)
enddo
call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save)
call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save2)
deallocate (psi_coef_save)
deallocate (psi_coef_save2)
call write_int(6,ndet,'Saved determinants')
endif

54
src/mo_localization/EZFIO.cfg Normal file
View 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
View File

@ -0,0 +1,2 @@
hartree_fock
utils_trust_region

108
src/mo_localization/README.md Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View File

File diff suppressed because it is too large Load Diff

2054
src/mo_localization/localization_sub.irp.f Normal file
View File

File diff suppressed because it is too large Load Diff

1
src/utils/linear_algebra.irp.f
View File

@ -1230,6 +1230,7 @@ end
! call ortho_qr_withB(A,LDA,B,m,n)
!end subroutine ortho_qr_csf
subroutine ortho_qr(A,LDA,m,n)
implicit none
BEGIN_DOC

25
src/utils/util.irp.f
View File

@ -411,3 +411,28 @@ subroutine lowercase(txt,n)
enddo
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
View 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
View File

@ -0,0 +1 @@
hartree_fock

5
src/utils_trust_region/README.rst Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View File

File diff suppressed because it is too large Load Diff

1665
src/utils_trust_region/trust_region_optimal_lambda.org Normal file
View File

File diff suppressed because it is too large Load Diff

121
src/utils_trust_region/trust_region_rho.irp.f Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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