mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Corrected bug in spherical guess MOs
This commit is contained in:
parent
d94138cfed
commit
6e6a8ac82a
@ -95,12 +95,13 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
i += 1
|
||||
|
||||
if (i > N_det) then
|
||||
if (i >= N_det) then
|
||||
return
|
||||
endif
|
||||
|
||||
i += 1
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref)
|
||||
if ( (key(1,1) /= psi_det_sorted_bit(1,1,i)).or. &
|
||||
|
||||
@ -1,3 +1,87 @@
|
||||
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_coef, (ao_num_align,ao_num)]
|
||||
&BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! matrix of the coefficients of the mos generated by the
|
||||
! orthonormalization by the S^{-1/2} canonical transformation of the aos
|
||||
! ao_cart_to_sphe_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital
|
||||
END_DOC
|
||||
integer :: i
|
||||
integer, external :: ao_power_index
|
||||
integer :: ibegin,j,k
|
||||
ao_cart_to_sphe_coef(:,:) = 0.d0
|
||||
! Assume order provided by ao_power_index
|
||||
i = 1
|
||||
ao_cart_to_sphe_num = 0
|
||||
do while (i <= ao_num)
|
||||
select case ( ao_l(i) )
|
||||
case (0)
|
||||
ao_cart_to_sphe_coef(i,i) = 1.d0
|
||||
i += 1
|
||||
ao_cart_to_sphe_num += 1
|
||||
BEGIN_TEMPLATE
|
||||
case ($SHELL)
|
||||
if (ao_power(i,1) == $SHELL) then
|
||||
do k=1,size(cart_to_sphe_$SHELL,2)
|
||||
do j=1,size(cart_to_sphe_$SHELL,1)
|
||||
ao_cart_to_sphe_coef(i+j-1,i+k-1) = cart_to_sphe_$SHELL(j,k)
|
||||
enddo
|
||||
enddo
|
||||
i += size(cart_to_sphe_$SHELL,1)
|
||||
ao_cart_to_sphe_num += size(cart_to_sphe_$SHELL,2)
|
||||
endif
|
||||
SUBST [ SHELL ]
|
||||
1;;
|
||||
2;;
|
||||
3;;
|
||||
4;;
|
||||
5;;
|
||||
6;;
|
||||
7;;
|
||||
8;;
|
||||
9;;
|
||||
END_TEMPLATE
|
||||
case default
|
||||
stop 'Error in ao_cart_to_sphe'
|
||||
end select
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_overlap, (ao_cart_to_sphe_num,ao_cart_to_sphe_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! AO overlap matrix in the spherical basis set
|
||||
END_DOC
|
||||
double precision, allocatable :: S(:,:)
|
||||
allocate (S(ao_cart_to_sphe_num,ao_num))
|
||||
|
||||
call dgemm('T','N',ao_cart_to_sphe_num,ao_num,ao_num, 1.d0, &
|
||||
ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), &
|
||||
ao_overlap,size(ao_overlap,1), 0.d0, &
|
||||
S, size(S,1))
|
||||
|
||||
call dgemm('N','N',ao_cart_to_sphe_num,ao_cart_to_sphe_num,ao_num, 1.d0, &
|
||||
S, size(S,1), &
|
||||
ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), 0.d0, &
|
||||
ao_cart_to_sphe_overlap,size(ao_cart_to_sphe_overlap,1))
|
||||
|
||||
deallocate(S)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_inv, (ao_cart_to_sphe_num,ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! AO_cart_to_sphe_coef^(-1)
|
||||
END_DOC
|
||||
|
||||
call get_pseudo_inverse(ao_cart_to_sphe_coef,ao_num,ao_cart_to_sphe_num, &
|
||||
ao_cart_to_sphe_inv, size(ao_cart_to_sphe_coef,1))
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num_align,ao_num)]
|
||||
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num ]
|
||||
implicit none
|
||||
@ -8,47 +92,39 @@
|
||||
END_DOC
|
||||
integer :: i
|
||||
ao_ortho_canonical_coef(:,:) = 0.d0
|
||||
do i=1,ao_num
|
||||
ao_ortho_canonical_coef(i,i) = 1.d0
|
||||
enddo
|
||||
|
||||
if (ao_cartesian) then
|
||||
do i=1,ao_num
|
||||
ao_ortho_canonical_coef(i,i) = 1.d0
|
||||
enddo
|
||||
|
||||
ao_ortho_canonical_num = ao_num
|
||||
call ortho_canonical(ao_overlap,size(ao_overlap,1), &
|
||||
ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1), &
|
||||
ao_ortho_canonical_num)
|
||||
|
||||
|
||||
else
|
||||
integer, external :: ao_power_index
|
||||
integer :: ibegin,j,k
|
||||
! Assume order provided by ao_power_index
|
||||
i = 1
|
||||
do while (i <= ao_num)
|
||||
select case ( ao_l(i) )
|
||||
case (0)
|
||||
ao_ortho_canonical_coef(i,i) = 1.d0
|
||||
i += 1
|
||||
BEGIN_TEMPLATE
|
||||
case ($SHELL)
|
||||
if (ao_power(i,1) == $SHELL) then
|
||||
do k=1,size(cart_to_sphe_$SHELL,2)
|
||||
do j=1,size(cart_to_sphe_$SHELL,1)
|
||||
ao_ortho_canonical_coef(i+j-1,i+k-1) = cart_to_sphe_$SHELL(j,k)
|
||||
enddo
|
||||
enddo
|
||||
i += size(cart_to_sphe_$SHELL,1)
|
||||
endif
|
||||
SUBST [ SHELL ]
|
||||
1;;
|
||||
2;;
|
||||
3;;
|
||||
4;;
|
||||
5;;
|
||||
6;;
|
||||
7;;
|
||||
8;;
|
||||
9;;
|
||||
END_TEMPLATE
|
||||
case default
|
||||
stop 'Error in sphe_to_cart'
|
||||
end select
|
||||
|
||||
double precision, allocatable :: S(:,:)
|
||||
|
||||
allocate(S(ao_cart_to_sphe_num,ao_cart_to_sphe_num))
|
||||
S = 0.d0
|
||||
do i=1,ao_cart_to_sphe_num
|
||||
S(i,i) = 1.d0
|
||||
enddo
|
||||
|
||||
ao_ortho_canonical_num = ao_cart_to_sphe_num
|
||||
call ortho_canonical (ao_cart_to_sphe_overlap, size(ao_cart_to_sphe_overlap,1), &
|
||||
ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num)
|
||||
|
||||
call dgemm('N','N', ao_num, ao_ortho_canonical_num, ao_cart_to_sphe_num, 1.d0, &
|
||||
ao_cart_to_sphe_coef, size(ao_cart_to_sphe_coef,1), &
|
||||
S, size(S,1), &
|
||||
0.d0, ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1))
|
||||
|
||||
deallocate(S)
|
||||
endif
|
||||
call ortho_canonical(ao_overlap,ao_num_align,ao_num,ao_ortho_canonical_coef,ao_num_align,ao_ortho_canonical_num)
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_ortho_canonical_num,ao_ortho_canonical_num)]
|
||||
|
||||
@ -88,7 +88,6 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
|
||||
endif
|
||||
enddo
|
||||
do i=m+1,n
|
||||
print *, D(i)
|
||||
D(i) = 0.d0
|
||||
enddo
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user