mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-06-24 06:02:26 +02:00
197 lines
6.7 KiB
Fortran
197 lines
6.7 KiB
Fortran
!todo: add kpts
|
|
|
|
BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt)]
|
|
&BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Coefficients to go from cartesian to spherical coordinates in the current
|
|
! basis set
|
|
END_DOC
|
|
integer :: i
|
|
integer, external :: ao_power_index
|
|
integer :: ibegin,j,k
|
|
integer :: prev
|
|
prev = 0
|
|
ao_cart_to_sphe_coef_kpts(:,:) = (0.d0,0.d0)
|
|
! Assume order provided by ao_power_index
|
|
i = 1
|
|
ao_cart_to_sphe_num_per_kpt = 0
|
|
do while (i <= ao_num_per_kpt)
|
|
select case ( ao_l(i) )
|
|
case (0)
|
|
ao_cart_to_sphe_num_per_kpt += 1
|
|
ao_cart_to_sphe_coef_kpts(i,ao_cart_to_sphe_num_per_kpt) = (1.d0,0.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_cart_to_sphe_coef_kpts(i+j-1,ao_cart_to_sphe_num_per_kpt+k) = dcmplx(cart_to_sphe_$SHELL(j,k),0.d0)
|
|
enddo
|
|
enddo
|
|
i += size(cart_to_sphe_$SHELL,1)
|
|
ao_cart_to_sphe_num_per_kpt += 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_kpts : angular momentum too high'
|
|
end select
|
|
enddo
|
|
|
|
END_PROVIDER
|
|
!BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ]
|
|
! implicit none
|
|
! ao_cart_to_sphe_num_per_kpt = ao_cart_to_sphe_num / kpt_num
|
|
!END_PROVIDER
|
|
!
|
|
!BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt) ]
|
|
! implicit none
|
|
! BEGIN_DOC
|
|
! ! complex version of ao_cart_to_sphe_coef for one k-point
|
|
! END_DOC
|
|
! call zlacp2('A',ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt, &
|
|
! ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), &
|
|
! ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1))
|
|
!END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_kpts, (ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,kpt_num) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! AO overlap matrix in the spherical basis set
|
|
END_DOC
|
|
integer :: k
|
|
complex*16, allocatable :: S(:,:)
|
|
allocate (S(ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt))
|
|
|
|
!todo: call with (:,:,k) vs (1,1,k)? is there a difference? does one create a temporary array?
|
|
do k=1, kpt_num
|
|
|
|
call zgemm('T','N',ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), &
|
|
ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), &
|
|
ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), (0.d0,0.d0), &
|
|
S, size(S,1))
|
|
|
|
call zgemm('N','N',ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), &
|
|
S, size(S,1), &
|
|
ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), (0.d0,0.d0), &
|
|
ao_cart_to_sphe_overlap_kpts(:,:,k),size(ao_cart_to_sphe_overlap_kpts,1))
|
|
enddo
|
|
deallocate(S)
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_kpts, (ao_num_per_kpt,ao_num_per_kpt, kpt_num)]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! ao_ortho_canonical_coef_complex^(-1)
|
|
END_DOC
|
|
integer :: k
|
|
do k=1, kpt_num
|
|
call get_inverse_complex(ao_ortho_canonical_coef_kpts,size(ao_ortho_canonical_coef_kpts,1),&
|
|
ao_num_per_kpt, ao_ortho_cano_coef_inv_kpts, size(ao_ortho_cano_coef_inv_kpts,1))
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
|
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt, (kpt_num) ]
|
|
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt_max ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! TODO: ao_ortho_canonical_num_complex should be the same as the real version
|
|
! maybe if the providers weren't linked we could avoid making a complex one?
|
|
! matrix of the coefficients of the mos generated by the
|
|
! orthonormalization by the S^{-1/2} canonical transformation of the aos
|
|
! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital
|
|
END_DOC
|
|
integer :: i,k
|
|
ao_ortho_canonical_coef_kpts = (0.d0,0.d0)
|
|
do k=1,kpt_num
|
|
do i=1,ao_num
|
|
ao_ortho_canonical_coef_kpts(i,i,k) = (1.d0,0.d0)
|
|
enddo
|
|
enddo
|
|
|
|
!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
|
|
!ao_ortho_canonical_num=ao_num
|
|
!return
|
|
|
|
if (ao_cartesian) then
|
|
|
|
ao_ortho_canonical_num_per_kpt = ao_num_per_kpt
|
|
do k=1,kpt_num
|
|
call ortho_canonical_complex(ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), &
|
|
ao_num_per_kpt,ao_ortho_canonical_coef_kpts(:,:,k),size(ao_ortho_canonical_coef_kpts,1), &
|
|
ao_ortho_canonical_num_per_kpt(k),lin_dep_cutoff)
|
|
enddo
|
|
|
|
|
|
else
|
|
|
|
complex*16, allocatable :: S(:,:)
|
|
|
|
allocate(S(ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt))
|
|
do k=1,kpt_num
|
|
S = (0.d0,0.d0)
|
|
do i=1,ao_cart_to_sphe_num_per_kpt
|
|
S(i,i) = (1.d0,0.d0)
|
|
enddo
|
|
|
|
ao_ortho_canonical_num_per_kpt(k) = ao_cart_to_sphe_num_per_kpt
|
|
call ortho_canonical_complex(ao_cart_to_sphe_overlap_kpts, size(ao_cart_to_sphe_overlap_kpts,1), &
|
|
ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k),lin_dep_cutoff)
|
|
|
|
call zgemm('N','N', ao_num_per_kpt, ao_ortho_canonical_num_per_kpt(k), ao_cart_to_sphe_num_per_kpt, (1.d0,0.d0), &
|
|
ao_cart_to_sphe_coef_kpts, size(ao_cart_to_sphe_coef_kpts,1), &
|
|
S, size(S,1), &
|
|
(0.d0,0.d0), ao_ortho_canonical_coef_kpts(:,:,k), size(ao_ortho_canonical_coef_kpts,1))
|
|
enddo
|
|
|
|
deallocate(S)
|
|
endif
|
|
ao_ortho_canonical_num_per_kpt_max = maxval(ao_ortho_canonical_num_per_kpt)
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_kpts, (ao_ortho_canonical_num_per_kpt_max,ao_ortho_canonical_num_per_kpt_max,kpt_num)]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! overlap matrix of the ao_ortho_canonical.
|
|
! Expected to be the Identity
|
|
END_DOC
|
|
integer :: i,j,k,l,kk
|
|
complex*16 :: c
|
|
do k=1,kpt_num
|
|
do j=1, ao_ortho_canonical_num_per_kpt_max
|
|
do i=1, ao_ortho_canonical_num_per_kpt_max
|
|
ao_ortho_canonical_overlap_kpts(i,j,k) = (0.d0,0.d0)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
do kk=1,kpt_num
|
|
do j=1, ao_ortho_canonical_num_per_kpt(kk)
|
|
do k=1, ao_num_per_kpt
|
|
c = (0.d0,0.d0)
|
|
do l=1, ao_num_per_kpt
|
|
c += conjg(ao_ortho_canonical_coef_kpts(l,j,kk)) * ao_overlap_kpts(l,k,kk)
|
|
enddo
|
|
do i=1, ao_ortho_canonical_num_per_kpt(kk)
|
|
ao_ortho_canonical_overlap_kpts(i,j,kk) += ao_ortho_canonical_coef_kpts(k,i,kk) * c
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|