mirror of
https://github.com/QuantumPackage/qp2.git
synced 2025-04-25 17:54:44 +02:00
Merge branch 'dev-stable' of github.com:QuantumPackage/qp2 into dev-stable
This commit is contained in:
commit
84a8f476e7
138
src/ao_one_e_ints/ao_spherical.irp.f
Normal file
138
src/ao_one_e_ints/ao_spherical.irp.f
Normal file
@ -0,0 +1,138 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_coef, (ao_num,ao_sphe_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Coefficients to go from current cartesian AO basis set to spherical AO basis set
|
||||||
|
!
|
||||||
|
! ao_cart_to_sphe_coef(i,j) = coefficient of the i-th cartesian |AO| on the j-th spherical |AO|
|
||||||
|
!
|
||||||
|
! :math:`\chi^s_{\nu} = \sum_{\nu}^{N_{\text{cart}}} B^{sc}_{\mu\nu} \chi^c_{\mu}`
|
||||||
|
!
|
||||||
|
! where :math:`\chi^s_{\nu}` is an element of the spherical AO basis,
|
||||||
|
! :math:`\chi^c_{\mu}` is an element of the cartesian AO basis,
|
||||||
|
! and :math:`B^{sc}_{\mu\nu}` is an change of basis matrix
|
||||||
|
END_DOC
|
||||||
|
integer :: row,col,k,j
|
||||||
|
!
|
||||||
|
if (ao_cartesian) then
|
||||||
|
! Identity matrix
|
||||||
|
integer :: i
|
||||||
|
do i=1,ao_sphe_num
|
||||||
|
ao_cart_to_sphe_coef(i,i) = 1.d0
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
ao_cart_to_sphe_coef(:,:) = 0.d0
|
||||||
|
row = 1
|
||||||
|
col = 1
|
||||||
|
do while (row <= ao_num)
|
||||||
|
! Select case based on azimuthal quantum number of i-th AO orbitals
|
||||||
|
select case ( ao_l(row) )
|
||||||
|
case (0)
|
||||||
|
! S orbital
|
||||||
|
ao_cart_to_sphe_coef(row,col) = 1.d0
|
||||||
|
row += 1
|
||||||
|
col += 1
|
||||||
|
BEGIN_TEMPLATE
|
||||||
|
case ($SHELL)
|
||||||
|
! P,D,F,... orbitals
|
||||||
|
do k=1,size(cart_to_sphe_$SHELL,2)
|
||||||
|
do j=1,size(cart_to_sphe_$SHELL,1)
|
||||||
|
ao_cart_to_sphe_coef(row+j-1,col+k-1) = cart_to_sphe_$SHELL(j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
row += size(cart_to_sphe_$SHELL,1)
|
||||||
|
col += size(cart_to_sphe_$SHELL,2)
|
||||||
|
SUBST [ SHELL ]
|
||||||
|
1;;
|
||||||
|
2;;
|
||||||
|
3;;
|
||||||
|
4;;
|
||||||
|
5;;
|
||||||
|
6;;
|
||||||
|
7;;
|
||||||
|
8;;
|
||||||
|
9;;
|
||||||
|
END_TEMPLATE
|
||||||
|
case default
|
||||||
|
stop 'Error in ao_cart_to_sphe : angular momentum too high'
|
||||||
|
end select
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_coef_transp, (ao_sphe_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transpose of :c:data:`ao_cart_to_sphe_coef`
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_sphe_num
|
||||||
|
ao_cart_to_sphe_coef_transp(j,i) = ao_cart_to_sphe_coef(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_cart_to_ao_sphe(A_ao_cart,LDA_ao_cart,A_ao_sphe,LDA_ao_sphe)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform matrix A from the |AO| cartesian basis to the |AO| spherical basis
|
||||||
|
!
|
||||||
|
! :math:`(B^{sc})^T.A^c.B^{sc}`
|
||||||
|
!
|
||||||
|
! where :math:`B^{sc}` is :c:data:`ao_cart_to_sphe_coef`,
|
||||||
|
! the matrix of coefficients from the cartesian AO basis to spherical one,
|
||||||
|
! and :math:`B^{sc}` is :c:data:`ao_cart_to_sphe_coef_transp`, its transpose.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao_cart,LDA_ao_sphe
|
||||||
|
double precision, intent(in) :: A_ao_cart(LDA_ao_cart,ao_num)
|
||||||
|
double precision, intent(out) :: A_ao_sphe(LDA_ao_sphe,ao_sphe_num)
|
||||||
|
double precision, allocatable :: T(:,:)
|
||||||
|
!
|
||||||
|
allocate (T(ao_num,ao_sphe_num) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
|
||||||
|
call dgemm('N','N', ao_num, ao_sphe_num, ao_num, &
|
||||||
|
1.d0, A_ao_cart, LDA_ao_cart, &
|
||||||
|
ao_cart_to_sphe_coef, size(ao_cart_to_sphe_coef,1), &
|
||||||
|
0.d0, T, size(T,1))
|
||||||
|
! Notice that for the following dgemm we could have used
|
||||||
|
! ao_cart_to_sphe_coef_transp, but instead we transposed with the 'T' argument
|
||||||
|
call dgemm('T','N', ao_sphe_num, ao_sphe_num, ao_num, &
|
||||||
|
1.d0, ao_cart_to_sphe_coef, size(ao_cart_to_sphe_coef,1), &
|
||||||
|
T, ao_num, &
|
||||||
|
0.d0, A_ao_sphe, size(A_ao_sphe,1))
|
||||||
|
!
|
||||||
|
! call restore_symmetry(mo_num,mo_num,A_ao_sphe,size(A_ao_sphe,1),1.d-15)
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_overlap, (ao_sphe_num,ao_sphe_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |AO| overlap matrix in the spherical basis set obtained as
|
||||||
|
!
|
||||||
|
! :math:`(B^{sc})^T.S^c.B^{sc}`
|
||||||
|
!
|
||||||
|
! where :math:`S^c` is the overlap matrix in the cartesian AO basis
|
||||||
|
END_DOC
|
||||||
|
!
|
||||||
|
call ao_cart_to_ao_sphe(ao_overlap,ao_num,ao_cart_to_sphe_overlap,ao_sphe_num)
|
||||||
|
!
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_cart_to_sphe_overlap_inv, (ao_sphe_num,ao_sphe_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Inverse of :c:data:`ao_cart_to_sphe_overlap`
|
||||||
|
END_DOC
|
||||||
|
!
|
||||||
|
call get_pseudo_inverse( &
|
||||||
|
ao_cart_to_sphe_overlap, size(ao_cart_to_sphe_overlap,1), &
|
||||||
|
ao_sphe_num,ao_sphe_num, &
|
||||||
|
ao_cart_to_sphe_overlap_inv, size(ao_cart_to_sphe_overlap_inv,1), &
|
||||||
|
lin_dep_cutoff)
|
||||||
|
END_PROVIDER
|
||||||
Loading…
x
Reference in New Issue
Block a user