2019-01-25 11:39:31 +01:00
BEGIN _ PROVIDER [ double precision , mo_coef_begin_iteration , ( ao_num , mo_n um) ]
im p licit none
BE G IN_DOC
! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration
!
2019-12-02 18:18:30 +01:00
! Useful to track some orbitals
2019-01-25 11:39:31 +01:00
EN D _ DOC
END_P R OVIDER
subro u tine initialize_mo_coef_begin_iteration
impl i cit none
BEGI N _ DOC
!
! Initialize :c:data:`mo_coef_begin_iteration` to the current :c:data:`mo_coef`
END_ D OC
mo_c o ef_begin_iteration = mo_coef
end
subro u tine reorder_core_orb
impl i cit none
BEGI N _ DOC
! routines that takes the current :c:data:`mo_coef` and reorder the core orbitals (see :c:data:`list_core` and :c:data:`n_core_orb`) according to the overlap with :c:data:`mo_coef_begin_iteration`
END_ D OC
inte g er :: i , j , iorb
inte g er :: k , l
doub l e precision , allocatable :: accu ( : )
inte g er , allocatable :: index_core_orb ( : ) , iorder ( : )
doub l e precision , allocatable :: mo_coef_tmp ( : , : )
allo c ate ( accu ( mo_num ) , index_core_orb ( n_core_orb ) , iorder ( mo_num ) )
allo c ate ( mo_coef_tmp ( ao_num , mo_num ) )
do i = 1 , n_core_orb
ior b = list_core ( i )
do j = 1 , mo_num
ac c u ( j ) = 0.d0
io r der ( j ) = j
do k = 1 , ao_num
d o l = 1 , ao_num
a ccu ( j ) + = mo_coef_begin_iteration ( k , iorb ) * mo_coef ( l , j ) * ao_over lap(k,l)
e n ddo
en d do
ac c u ( j ) = - dabs ( accu ( j ) )
end d o
cal l dsort ( accu , iorder , mo_num )
ind e x_core_orb ( i ) = iorder ( 1 )
endd o
doub l e precision :: x
inte g er :: i1 , i2
do j = 1 , n_core_orb
i1 = list_core ( j )
i2 = index_core_orb ( j )
do i = 1 , ao_num
x = mo_coef ( i , i1 )
m o _ coef ( i , i1 ) = mo_coef ( i , i2 )
m o _ coef ( i , i2 ) = x
end d o
endd o
!call loc_cele_routine
deal l ocate ( accu , index_core_orb , iorder )
end