mirror of
https://github.com/QuantumPackage/qp2.git
synced 2025-04-25 17:54:44 +02:00
aos_in_r
This commit is contained in:
eginer
parent
7d22e803f6
commit
5d16beceb9
@ -10,31 +10,12 @@ double precision function ao_value(i, r)
|
|||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: i
|
integer, intent(in) :: i
|
||||||
double precision, intent(in) :: r(3)
|
double precision, intent(in) :: r(3)
|
||||||
|
double precision, allocatable :: tmp_array_cart(:)
|
||||||
integer :: m, num_ao
|
double precision, external :: ddot
|
||||||
integer :: power_ao(3)
|
! TODO if in the cartesian basis transformation matrix is identity
|
||||||
double precision :: center_ao(3)
|
allocate(tmp_array_cart(ao_cart_num))
|
||||||
double precision :: beta
|
call give_all_aos_cart_at_r(r, tmp_array_cart)
|
||||||
double precision :: accu, dx, dy, dz, r2
|
ao_value = ddot(ao_cart_num,ao_cart_to_ao_basis_mat_transp(1,i),1,tmp_array_cart,1)
|
||||||
|
|
||||||
num_ao = ao_nucl(i)
|
|
||||||
power_ao(1:3) = ao_power(i,1:3)
|
|
||||||
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
|
||||||
dx = r(1) - center_ao(1)
|
|
||||||
dy = r(2) - center_ao(2)
|
|
||||||
dz = r(3) - center_ao(3)
|
|
||||||
r2 = dx*dx + dy*dy + dz*dz
|
|
||||||
dx = dx**power_ao(1)
|
|
||||||
dy = dy**power_ao(2)
|
|
||||||
dz = dz**power_ao(3)
|
|
||||||
|
|
||||||
accu = 0.d0
|
|
||||||
do m = 1, ao_prim_num(i)
|
|
||||||
beta = ao_expo_ordered_transp(m,i)
|
|
||||||
accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
|
||||||
enddo
|
|
||||||
ao_value = accu * dx * dy * dz
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -53,42 +34,10 @@ subroutine give_all_aos_at_r(r, tmp_array)
|
|||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: r(3)
|
double precision, intent(in) :: r(3)
|
||||||
double precision, intent(out) :: tmp_array(ao_num)
|
double precision, intent(out) :: tmp_array(ao_num)
|
||||||
integer :: p_ao(3)
|
double precision, allocatable :: tmp_array_cart(:)
|
||||||
integer :: i, j, k, l, m
|
allocate(tmp_array_cart(ao_cart_num))
|
||||||
double precision :: dx, dy, dz, r2
|
call give_all_aos_cart_at_r(r, tmp_array_cart)
|
||||||
double precision :: dx2, dy2, dz2
|
call ao_cart_to_ao_basis_vec(tmp_array_cart, tmp_array)
|
||||||
double precision :: c_ao(3)
|
|
||||||
double precision :: beta
|
|
||||||
|
|
||||||
do i = 1, nucl_num
|
|
||||||
|
|
||||||
c_ao(1:3) = nucl_coord(i,1:3)
|
|
||||||
dx = r(1) - c_ao(1)
|
|
||||||
dy = r(2) - c_ao(2)
|
|
||||||
dz = r(3) - c_ao(3)
|
|
||||||
r2 = dx*dx + dy*dy + dz*dz
|
|
||||||
|
|
||||||
do j = 1, Nucl_N_Aos(i)
|
|
||||||
|
|
||||||
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
|
|
||||||
p_ao(1:3) = ao_power_ordered_transp_per_nucl(1:3,j,i)
|
|
||||||
dx2 = dx**p_ao(1)
|
|
||||||
dy2 = dy**p_ao(2)
|
|
||||||
dz2 = dz**p_ao(3)
|
|
||||||
|
|
||||||
tmp_array(k) = 0.d0
|
|
||||||
do l = 1, ao_prim_num(k)
|
|
||||||
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
|
|
||||||
if(beta*r2.gt.50.d0) cycle
|
|
||||||
|
|
||||||
tmp_array(k) += ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
tmp_array(k) = tmp_array(k) * dx2 * dy2 * dz2
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
end
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
@ -110,69 +59,17 @@ subroutine give_all_aos_and_grad_at_r(r, aos_array, aos_grad_array)
|
|||||||
double precision, intent(in) :: r(3)
|
double precision, intent(in) :: r(3)
|
||||||
double precision, intent(out) :: aos_array(ao_num)
|
double precision, intent(out) :: aos_array(ao_num)
|
||||||
double precision, intent(out) :: aos_grad_array(3,ao_num)
|
double precision, intent(out) :: aos_grad_array(3,ao_num)
|
||||||
|
double precision, allocatable :: aos_cart_array(:), aos_cart_grad_array(:,:)
|
||||||
|
allocate(aos_cart_array(ao_cart_num), aos_cart_grad_array(3,ao_cart_num))
|
||||||
|
call give_all_aos_cart_and_grad_at_r(r, aos_cart_array, aos_cart_grad_array)
|
||||||
|
call ao_cart_to_ao_basis_vec(aos_cart_array, aos_array)
|
||||||
|
|
||||||
integer :: power_ao(3)
|
call dgemm('N','T',3,ao_num,ao_cart_num,1.d0, &
|
||||||
integer :: i, j, k, l, m
|
aos_cart_grad_array, size(aos_cart_grad_array,1), &
|
||||||
double precision :: dx, dy, dz, r2
|
ao_cart_to_ao_basis_mat,size(ao_cart_to_ao_basis_mat,1), 0.d0,&
|
||||||
double precision :: dx1, dy1, dz1
|
aos_grad_array, size(aos_grad_array,1))
|
||||||
double precision :: dx2, dy2, dz2
|
|
||||||
double precision :: center_ao(3)
|
|
||||||
double precision :: beta, accu_1, accu_2, contrib
|
|
||||||
|
|
||||||
do i = 1, nucl_num
|
|
||||||
|
|
||||||
center_ao(1:3) = nucl_coord(i,1:3)
|
|
||||||
|
|
||||||
dx = r(1) - center_ao(1)
|
|
||||||
dy = r(2) - center_ao(2)
|
|
||||||
dz = r(3) - center_ao(3)
|
|
||||||
r2 = dx*dx + dy*dy + dz*dz
|
|
||||||
|
|
||||||
do j = 1, Nucl_N_Aos(i)
|
|
||||||
|
|
||||||
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
|
|
||||||
|
|
||||||
aos_array(k) = 0.d0
|
|
||||||
aos_grad_array(1,k) = 0.d0
|
|
||||||
aos_grad_array(2,k) = 0.d0
|
|
||||||
aos_grad_array(3,k) = 0.d0
|
|
||||||
|
|
||||||
power_ao(1:3) = ao_power_ordered_transp_per_nucl(1:3,j,i)
|
|
||||||
dx2 = dx**power_ao(1)
|
|
||||||
dy2 = dy**power_ao(2)
|
|
||||||
dz2 = dz**power_ao(3)
|
|
||||||
|
|
||||||
dx1 = 0.d0
|
|
||||||
if(power_ao(1) .ne. 0) then
|
|
||||||
dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
dy1 = 0.d0
|
|
||||||
if(power_ao(2) .ne. 0) then
|
|
||||||
dy1 = dble(power_ao(2)) * dy**(power_ao(2)-1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
dz1 = 0.d0
|
|
||||||
if(power_ao(3) .ne. 0) then
|
|
||||||
dz1 = dble(power_ao(3)) * dz**(power_ao(3)-1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
accu_1 = 0.d0
|
|
||||||
accu_2 = 0.d0
|
|
||||||
do l = 1, ao_prim_num(k)
|
|
||||||
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
|
|
||||||
if(beta*r2.gt.50.d0) cycle
|
|
||||||
contrib = ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
|
|
||||||
accu_1 += contrib
|
|
||||||
accu_2 += contrib * beta
|
|
||||||
enddo
|
|
||||||
|
|
||||||
aos_array(k) = accu_1 * dx2 * dy2 * dz2
|
|
||||||
aos_grad_array(1,k) = accu_1 * dx1 * dy2 * dz2 - 2.d0 * dx2 * dx * dy2 * dz2 * accu_2
|
|
||||||
aos_grad_array(2,k) = accu_1 * dx2 * dy1 * dz2 - 2.d0 * dx2 * dy2 * dy * dz2 * accu_2
|
|
||||||
aos_grad_array(3,k) = accu_1 * dx2 * dy2 * dz1 - 2.d0 * dx2 * dy2 * dz2 * dz * accu_2
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -187,8 +84,10 @@ subroutine give_all_aos_and_grad_and_lapl_at_r(r, aos_array, aos_grad_array, aos
|
|||||||
! output :
|
! output :
|
||||||
!
|
!
|
||||||
! * aos_array(i) = ao(i) evaluated at $\textbf{r}$
|
! * aos_array(i) = ao(i) evaluated at $\textbf{r}$
|
||||||
|
!
|
||||||
! * aos_grad_array(1,i) = $\nabla_x$ of the ao(i) evaluated at $\textbf{r}$
|
! * aos_grad_array(1,i) = $\nabla_x$ of the ao(i) evaluated at $\textbf{r}$
|
||||||
!
|
!
|
||||||
|
! * aos_lapl_array(1,i) = $d/dx^2$ of the ao(i) evaluated at $\textbf{r}$
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
@ -196,127 +95,20 @@ subroutine give_all_aos_and_grad_and_lapl_at_r(r, aos_array, aos_grad_array, aos
|
|||||||
double precision, intent(out) :: aos_array(ao_num)
|
double precision, intent(out) :: aos_array(ao_num)
|
||||||
double precision, intent(out) :: aos_grad_array(3,ao_num)
|
double precision, intent(out) :: aos_grad_array(3,ao_num)
|
||||||
double precision, intent(out) :: aos_lapl_array(3,ao_num)
|
double precision, intent(out) :: aos_lapl_array(3,ao_num)
|
||||||
|
double precision, allocatable :: aos_cart_array(:), aos_cart_grad_array(:,:), aos_cart_lapl_array(:,:)
|
||||||
|
allocate(aos_cart_array(ao_cart_num), aos_cart_grad_array(3,ao_cart_num))
|
||||||
|
call give_all_aos_cart_and_grad_and_lapl_at_r(r, aos_cart_array, aos_cart_grad_array, aos_cart_lapl_array)
|
||||||
|
call ao_cart_to_ao_basis_vec(aos_cart_array, aos_array)
|
||||||
|
|
||||||
integer :: power_ao(3)
|
call dgemm('N','T',3,ao_num,ao_cart_num,1.d0, &
|
||||||
integer :: i, j, k, l, m
|
aos_cart_grad_array, size(aos_cart_grad_array,1), &
|
||||||
double precision :: dx, dy, dz, r2
|
ao_cart_to_ao_basis_mat,size(ao_cart_to_ao_basis_mat,1), 0.d0,&
|
||||||
double precision :: dx1, dy1, dz1
|
aos_grad_array, size(aos_grad_array,1))
|
||||||
double precision :: dx2, dy2, dz2
|
|
||||||
double precision :: dx3, dy3, dz3
|
|
||||||
double precision :: dx4, dy4, dz4
|
|
||||||
double precision :: dx5, dy5, dz5
|
|
||||||
double precision :: center_ao(3)
|
|
||||||
double precision :: beta, accu_1, accu_2, accu_3, contrib
|
|
||||||
|
|
||||||
do i = 1, nucl_num
|
call dgemm('N','T',3,ao_num,ao_cart_num,1.d0, &
|
||||||
|
aos_cart_lapl_array, size(aos_cart_lapl_array,1), &
|
||||||
center_ao(1:3) = nucl_coord(i,1:3)
|
ao_cart_to_ao_basis_mat,size(ao_cart_to_ao_basis_mat,1), 0.d0,&
|
||||||
|
aos_lapl_array, size(aos_lapl_array,1))
|
||||||
dx = r(1) - center_ao(1)
|
|
||||||
dy = r(2) - center_ao(2)
|
|
||||||
dz = r(3) - center_ao(3)
|
|
||||||
r2 = dx*dx + dy*dy + dz*dz
|
|
||||||
|
|
||||||
do j = 1, Nucl_N_Aos(i)
|
|
||||||
|
|
||||||
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
|
|
||||||
|
|
||||||
aos_array(k) = 0.d0
|
|
||||||
aos_grad_array(1,k) = 0.d0
|
|
||||||
aos_grad_array(2,k) = 0.d0
|
|
||||||
aos_grad_array(3,k) = 0.d0
|
|
||||||
aos_lapl_array(1,k) = 0.d0
|
|
||||||
aos_lapl_array(2,k) = 0.d0
|
|
||||||
aos_lapl_array(3,k) = 0.d0
|
|
||||||
|
|
||||||
power_ao(1:3)= ao_power_ordered_transp_per_nucl(1:3,j,i)
|
|
||||||
dx2 = dx**power_ao(1)
|
|
||||||
dy2 = dy**power_ao(2)
|
|
||||||
dz2 = dz**power_ao(3)
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
dx1 = 0.d0
|
|
||||||
if(power_ao(1) .ne. 0) then
|
|
||||||
dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
dx3 = 0.d0
|
|
||||||
if(power_ao(1) .ge. 2) then
|
|
||||||
dx3 = dble(power_ao(1)) * dble((power_ao(1)-1)) * dx**(power_ao(1)-2)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if(power_ao(1) .ge. 1) then
|
|
||||||
dx4 = dble((2 * power_ao(1) + 1)) * dx**(power_ao(1))
|
|
||||||
else
|
|
||||||
dx4 = dble((power_ao(1) + 1)) * dx**(power_ao(1))
|
|
||||||
endif
|
|
||||||
|
|
||||||
dx5 = dx**(power_ao(1)+2)
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
dy1 = 0.d0
|
|
||||||
if(power_ao(2) .ne. 0) then
|
|
||||||
dy1 = dble(power_ao(2)) * dy**(power_ao(2)-1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
dy3 = 0.d0
|
|
||||||
if(power_ao(2) .ge. 2) then
|
|
||||||
dy3 = dble(power_ao(2)) * dble((power_ao(2)-1)) * dy**(power_ao(2)-2)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if(power_ao(2) .ge. 1) then
|
|
||||||
dy4 = dble((2 * power_ao(2) + 1)) * dy**(power_ao(2))
|
|
||||||
else
|
|
||||||
dy4 = dble((power_ao(2) + 1)) * dy**(power_ao(2))
|
|
||||||
endif
|
|
||||||
|
|
||||||
dy5 = dy**(power_ao(2)+2)
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
dz1 = 0.d0
|
|
||||||
if(power_ao(3) .ne. 0) then
|
|
||||||
dz1 = dble(power_ao(3)) * dz**(power_ao(3)-1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
dz3 = 0.d0
|
|
||||||
if(power_ao(3) .ge. 2) then
|
|
||||||
dz3 = dble(power_ao(3)) * dble((power_ao(3)-1)) * dz**(power_ao(3)-2)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if(power_ao(3) .ge. 1) then
|
|
||||||
dz4 = dble((2 * power_ao(3) + 1)) * dz**(power_ao(3))
|
|
||||||
else
|
|
||||||
dz4 = dble((power_ao(3) + 1)) * dz**(power_ao(3))
|
|
||||||
endif
|
|
||||||
|
|
||||||
dz5 = dz**(power_ao(3)+2)
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
accu_1 = 0.d0
|
|
||||||
accu_2 = 0.d0
|
|
||||||
accu_3 = 0.d0
|
|
||||||
do l = 1,ao_prim_num(k)
|
|
||||||
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
|
|
||||||
if(beta*r2.gt.50.d0) cycle
|
|
||||||
contrib = ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
|
|
||||||
accu_1 += contrib
|
|
||||||
accu_2 += contrib * beta
|
|
||||||
accu_3 += contrib * beta**2
|
|
||||||
enddo
|
|
||||||
|
|
||||||
aos_array(k) = accu_1 * dx2 * dy2 * dz2
|
|
||||||
aos_grad_array(1,k) = accu_1 * dx1 * dy2 * dz2 - 2.d0 * dx2 * dx * dy2 * dz2 * accu_2
|
|
||||||
aos_grad_array(2,k) = accu_1 * dx2 * dy1 * dz2 - 2.d0 * dx2 * dy2 * dy * dz2 * accu_2
|
|
||||||
aos_grad_array(3,k) = accu_1 * dx2 * dy2 * dz1 - 2.d0 * dx2 * dy2 * dz2 * dz * accu_2
|
|
||||||
aos_lapl_array(1,k) = accu_1 * dx3 * dy2 * dz2 - 2.d0 * dx4 * dy2 * dz2 * accu_2 + 4.d0 * dx5 * dy2 * dz2 * accu_3
|
|
||||||
aos_lapl_array(2,k) = accu_1 * dx2 * dy3 * dz2 - 2.d0 * dx2 * dy4 * dz2 * accu_2 + 4.d0 * dx2 * dy5 * dz2 * accu_3
|
|
||||||
aos_lapl_array(3,k) = accu_1 * dx2 * dy2 * dz3 - 2.d0 * dx2 * dy2 * dz4 * accu_2 + 4.d0 * dx2 * dy2 * dz5 * accu_3
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|||||||
@ -1,68 +0,0 @@
|
|||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, Nucl_Aos_transposed, (N_AOs_max,nucl_num)]
|
|
||||||
|
|
||||||
BEGIN_DOC
|
|
||||||
! List of AOs attached on each atom
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer :: i
|
|
||||||
integer, allocatable :: nucl_tmp(:)
|
|
||||||
|
|
||||||
allocate(nucl_tmp(nucl_num))
|
|
||||||
nucl_tmp = 0
|
|
||||||
do i = 1, ao_num
|
|
||||||
nucl_tmp(ao_nucl(i)) += 1
|
|
||||||
Nucl_Aos_transposed(nucl_tmp(ao_nucl(i)),ao_nucl(i)) = i
|
|
||||||
enddo
|
|
||||||
deallocate(nucl_tmp)
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_expo_ordered_transp_per_nucl, (ao_prim_num_max,N_AOs_max,nucl_num) ]
|
|
||||||
implicit none
|
|
||||||
integer :: i,j,k,l
|
|
||||||
do i = 1, nucl_num
|
|
||||||
do j = 1,Nucl_N_Aos(i)
|
|
||||||
k = Nucl_Aos_transposed(j,i)
|
|
||||||
do l = 1, ao_prim_num(k)
|
|
||||||
ao_expo_ordered_transp_per_nucl(l,j,i) = ao_expo_ordered_transp(l,k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, ao_power_ordered_transp_per_nucl, (3,N_AOs_max,nucl_num) ]
|
|
||||||
implicit none
|
|
||||||
integer :: i,j,k,l
|
|
||||||
do i = 1, nucl_num
|
|
||||||
do j = 1,Nucl_N_Aos(i)
|
|
||||||
k = Nucl_Aos_transposed(j,i)
|
|
||||||
do l = 1, 3
|
|
||||||
ao_power_ordered_transp_per_nucl(l,j,i) = ao_power(k,l)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered_transp_per_nucl, (ao_prim_num_max,N_AOs_max,nucl_num) ]
|
|
||||||
implicit none
|
|
||||||
integer :: i,j,k,l
|
|
||||||
do i = 1, nucl_num
|
|
||||||
do j = 1,Nucl_N_Aos(i)
|
|
||||||
k = Nucl_Aos_transposed(j,i)
|
|
||||||
do l = 1, ao_prim_num(k)
|
|
||||||
ao_coef_normalized_ordered_transp_per_nucl(l,j,i) = ao_coef_normalized_ordered_transp(l,k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
@ -1,201 +0,0 @@
|
|||||||
|
|
||||||
BEGIN_PROVIDER [logical, use_cgtos]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
BEGIN_DOC
|
|
||||||
! If true, use cgtos for AO integrals
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
logical :: has
|
|
||||||
PROVIDE ezfio_filename
|
|
||||||
use_cgtos = .False.
|
|
||||||
if (mpi_master) then
|
|
||||||
call ezfio_has_ao_basis_use_cgtos(has)
|
|
||||||
if (has) then
|
|
||||||
! write(6,'(A)') '.. >>>>> [ IO READ: use_cgtos ] <<<<< ..'
|
|
||||||
call ezfio_get_ao_basis_use_cgtos(use_cgtos)
|
|
||||||
else
|
|
||||||
call ezfio_set_ao_basis_use_cgtos(use_cgtos)
|
|
||||||
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( use_cgtos, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
|
|
||||||
if (ierr /= MPI_SUCCESS) then
|
|
||||||
stop 'Unable to read use_cgtos with MPI'
|
|
||||||
endif
|
|
||||||
IRP_ENDIF
|
|
||||||
|
|
||||||
! call write_time(6)
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [complex*16, ao_expo_cgtos_ord_transp, (ao_prim_num_max, ao_num)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord_transp, (4, ao_prim_num_max, ao_num)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord_transp, (4, ao_prim_num_max, ao_num)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j, m
|
|
||||||
|
|
||||||
do j = 1, ao_num
|
|
||||||
do i = 1, ao_prim_num_max
|
|
||||||
|
|
||||||
ao_expo_cgtos_ord_transp(i,j) = ao_expo_cgtos_ord(j,i)
|
|
||||||
|
|
||||||
do m = 1, 4
|
|
||||||
ao_expo_pw_ord_transp(m,i,j) = ao_expo_pw_ord(m,j,i)
|
|
||||||
ao_expo_phase_ord_transp(m,i,j) = ao_expo_phase_ord(m,j,i)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_coef_norm_cgtos_ord, (ao_num, ao_prim_num_max)]
|
|
||||||
&BEGIN_PROVIDER [complex*16 , ao_expo_cgtos_ord, (ao_num, ao_prim_num_max)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord, (4, ao_num, ao_prim_num_max)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord, (4, ao_num, ao_prim_num_max)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j, m
|
|
||||||
integer :: iorder(ao_prim_num_max)
|
|
||||||
double precision :: d(ao_prim_num_max,11)
|
|
||||||
|
|
||||||
d = 0.d0
|
|
||||||
|
|
||||||
do i = 1, ao_num
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
iorder(j) = j
|
|
||||||
d(j,1) = ao_expo(i,j)
|
|
||||||
d(j,2) = ao_coef_norm_cgtos(i,j)
|
|
||||||
d(j,3) = ao_expo_im(i,j)
|
|
||||||
|
|
||||||
do m = 1, 3
|
|
||||||
d(j,3+m) = ao_expo_pw(m,i,j)
|
|
||||||
enddo
|
|
||||||
d(j,7) = d(j,4) * d(j,4) + d(j,5) * d(j,5) + d(j,6) * d(j,6)
|
|
||||||
|
|
||||||
do m = 1, 3
|
|
||||||
d(j,7+m) = ao_expo_phase(m,i,j)
|
|
||||||
enddo
|
|
||||||
d(j,11) = d(j,8) + d(j,9) + d(j,10)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
call dsort(d(1,1), iorder, ao_prim_num(i))
|
|
||||||
do j = 2, 11
|
|
||||||
call dset_order(d(1,j), iorder, ao_prim_num(i))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
ao_expo_cgtos_ord (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
|
|
||||||
ao_coef_norm_cgtos_ord(i,j) = d(j,2)
|
|
||||||
|
|
||||||
do m = 1, 4
|
|
||||||
ao_expo_pw_ord(m,i,j) = d(j,3+m)
|
|
||||||
ao_expo_phase_ord(m,i,j) = d(j,7+m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_coef_cgtos_norm_ord_transp, (ao_prim_num_max, ao_num)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j
|
|
||||||
|
|
||||||
do j = 1, ao_num
|
|
||||||
do i = 1, ao_prim_num_max
|
|
||||||
ao_coef_cgtos_norm_ord_transp(i,j) = ao_coef_norm_cgtos_ord(j,i)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_coef_norm_cgtos, (ao_num, ao_prim_num_max)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j, ii, m, powA(3), nz
|
|
||||||
double precision :: norm
|
|
||||||
double precision :: kA2, phiA
|
|
||||||
complex*16 :: expo, expo_inv, C_Ae(3), C_Ap(3)
|
|
||||||
complex*16 :: overlap_x, overlap_y, overlap_z
|
|
||||||
complex*16 :: integ1, integ2, C1, C2
|
|
||||||
|
|
||||||
nz = 100
|
|
||||||
|
|
||||||
ao_coef_norm_cgtos = 0.d0
|
|
||||||
|
|
||||||
do i = 1, ao_num
|
|
||||||
|
|
||||||
ii = ao_nucl(i)
|
|
||||||
powA(1) = ao_power(i,1)
|
|
||||||
powA(2) = ao_power(i,2)
|
|
||||||
powA(3) = ao_power(i,3)
|
|
||||||
|
|
||||||
if(primitives_normalized) then
|
|
||||||
|
|
||||||
! Normalization of the primitives
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
|
|
||||||
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expo_im(i,j)
|
|
||||||
expo_inv = (1.d0, 0.d0) / expo
|
|
||||||
do m = 1, 3
|
|
||||||
C_Ap(m) = nucl_coord(ii,m)
|
|
||||||
C_Ae(m) = nucl_coord(ii,m) - (0.d0, 0.5d0) * expo_inv * ao_expo_pw(m,i,j)
|
|
||||||
enddo
|
|
||||||
phiA = ao_expo_phase(1,i,j) + ao_expo_phase(2,i,j) + ao_expo_phase(3,i,j)
|
|
||||||
KA2 = ao_expo_pw(1,i,j) * ao_expo_pw(1,i,j) &
|
|
||||||
+ ao_expo_pw(2,i,j) * ao_expo_pw(2,i,j) &
|
|
||||||
+ ao_expo_pw(3,i,j) * ao_expo_pw(3,i,j)
|
|
||||||
|
|
||||||
C1 = zexp(-(0.d0, 2.d0) * phiA - 0.5d0 * expo_inv * KA2)
|
|
||||||
C2 = zexp(-(0.5d0, 0.d0) * real(expo_inv) * KA2)
|
|
||||||
|
|
||||||
call overlap_cgaussian_xyz(C_Ae, C_Ae, expo, expo, powA, powA, &
|
|
||||||
C_Ap, C_Ap, overlap_x, overlap_y, overlap_z, integ1, nz)
|
|
||||||
|
|
||||||
call overlap_cgaussian_xyz(conjg(C_Ae), C_Ae, conjg(expo), expo, powA, powA, &
|
|
||||||
conjg(C_Ap), C_Ap, overlap_x, overlap_y, overlap_z, integ2, nz)
|
|
||||||
|
|
||||||
norm = 2.d0 * real(C1 * integ1 + C2 * integ2)
|
|
||||||
|
|
||||||
!ao_coef_norm_cgtos(i,j) = 1.d0 / dsqrt(norm)
|
|
||||||
ao_coef_norm_cgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
ao_coef_norm_cgtos(i,j) = ao_coef(i,j)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
endif ! primitives_normalized
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
@ -4,7 +4,7 @@
|
|||||||
double precision function ao_cart_value(i, r)
|
double precision function ao_cart_value(i, r)
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Returns the value of the i-th ao at point $\textbf{r}$
|
! Returns the value of the i-th CARTESIAN ao at point $\textbf{r}$
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user