10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-26 15:12:19 +02:00

working on aos debug

This commit is contained in:
Abdallah Ammar 2024-05-07 01:56:14 +02:00
parent bd8d45b99b
commit 2a8b9e544b
2 changed files with 285 additions and 239 deletions

View File

@ -31,12 +31,14 @@ subroutine print_aos()
integer :: i, ipoint integer :: i, ipoint
double precision :: r(3) double precision :: r(3)
double precision :: ao_val, ao_der(3), ao_lap double precision :: ao_val, ao_der(3), ao_lap
double precision :: mo_val, mo_der(3), mo_lap
PROVIDE final_grid_points aos_in_r_array aos_grad_in_r_array aos_lapl_in_r_array PROVIDE final_grid_points aos_in_r_array aos_grad_in_r_array aos_lapl_in_r_array
write(1000, *) n_points_final_grid
do ipoint = 1, n_points_final_grid do ipoint = 1, n_points_final_grid
r(:) = final_grid_points(:,ipoint) r(:) = final_grid_points(:,ipoint)
print*, r write(1000, '(3(f15.7, 3X))') r
enddo enddo
do ipoint = 1, n_points_final_grid do ipoint = 1, n_points_final_grid
@ -45,7 +47,17 @@ subroutine print_aos()
ao_val = aos_in_r_array (i,ipoint) ao_val = aos_in_r_array (i,ipoint)
ao_der(:) = aos_grad_in_r_array(i,ipoint,:) ao_der(:) = aos_grad_in_r_array(i,ipoint,:)
ao_lap = aos_lapl_in_r_array(1,i,ipoint) + aos_lapl_in_r_array(2,i,ipoint) + aos_lapl_in_r_array(3,i,ipoint) ao_lap = aos_lapl_in_r_array(1,i,ipoint) + aos_lapl_in_r_array(2,i,ipoint) + aos_lapl_in_r_array(3,i,ipoint)
write(*, '(5(f15.7, 3X))') ao_val, ao_der, ao_lap write(1010, '(5(f15.7, 3X))') ao_val, ao_der, ao_lap
enddo
enddo
do ipoint = 1, n_points_final_grid
r(:) = final_grid_points(:,ipoint)
do i = 1, mo_num
mo_val = mos_in_r_array (i,ipoint)
mo_der(:) = mos_grad_in_r_array(i,ipoint,:)
mo_lap = mos_lapl_in_r_array(i,ipoint,1) + mos_lapl_in_r_array(i,ipoint,2) + mos_lapl_in_r_array(i,ipoint,3)
write(2010, '(5(f15.7, 3X))') mo_val, mo_der, mo_lap
enddo enddo
enddo enddo

View File

@ -1,67 +1,76 @@
double precision function ao_value(i,r)
implicit none
BEGIN_DOC
! Returns the value of the i-th ao at point $\textbf{r}$
END_DOC
double precision, intent(in) :: r(3)
integer, intent(in) :: i
integer :: m,num_ao ! ---
double precision :: center_ao(3)
double precision :: beta
integer :: power_ao(3)
double precision :: accu,dx,dy,dz,r2
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 double precision function ao_value(i, r)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i) BEGIN_DOC
accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2) ! Returns the value of the i-th ao at point $\textbf{r}$
enddo END_DOC
ao_value = accu * dx * dy * dz
implicit none
integer, intent(in) :: i
double precision, intent(in) :: r(3)
integer :: m, num_ao
integer :: power_ao(3)
double precision :: center_ao(3)
double precision :: beta
double precision :: accu, dx, dy, dz, r2
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
double precision function primitive_value(i,j,r) double precision function primitive_value(i, j, r)
implicit none
BEGIN_DOC
! Returns the value of the j-th primitive of the i-th |AO| at point $\textbf{r}
! **without the coefficient**
END_DOC
double precision, intent(in) :: r(3)
integer, intent(in) :: i,j
integer :: m,num_ao BEGIN_DOC
double precision :: center_ao(3) ! Returns the value of the j-th primitive of the i-th |AO| at point $\textbf{r}
double precision :: beta ! **without the coefficient**
integer :: power_ao(3) END_DOC
double precision :: accu,dx,dy,dz,r2
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 implicit none
m=j integer, intent(in) :: i, j
beta = ao_expo_ordered_transp(m,i) double precision, intent(in) :: r(3)
accu += dexp(-beta*r2)
primitive_value = accu * dx * dy * dz integer :: m, num_ao
integer :: power_ao(3)
double precision :: center_ao(3)
double precision :: beta
double precision :: accu, dx, dy, dz, r2
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
m = j
beta = ao_expo_ordered_transp(m,i)
accu += dexp(-beta*r2)
primitive_value = accu * dx * dy * dz
end end
@ -104,9 +113,9 @@ subroutine give_all_aos_at_r(r, tmp_array)
dz2 = dz**p_ao(3) dz2 = dz**p_ao(3)
tmp_array(k) = 0.d0 tmp_array(k) = 0.d0
do l = 1,ao_prim_num(k) do l = 1, ao_prim_num(k)
beta = ao_expo_ordered_transp_per_nucl(l,j,i) beta = ao_expo_ordered_transp_per_nucl(l,j,i)
if(dabs(beta*r2).gt.40.d0) cycle if(beta*r2.gt.50.d0) cycle
tmp_array(k) += ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2) tmp_array(k) += ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
enddo enddo
@ -120,207 +129,232 @@ end
! --- ! ---
subroutine give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array) subroutine give_all_aos_and_grad_at_r(r, aos_array, aos_grad_array)
implicit none
BEGIN_DOC
! input : r(1) ==> r(1) = x, r(2) = y, r(3) = z
!
! output :
!
! * aos_array(i) = ao(i) evaluated at ro
! * aos_grad_array(1,i) = gradient X of the ao(i) evaluated at $\textbf{r}$
!
END_DOC
double precision, intent(in) :: r(3)
double precision, intent(out) :: aos_array(ao_num)
double precision, intent(out) :: aos_grad_array(3,ao_num)
integer :: power_ao(3) BEGIN_DOC
integer :: i,j,k,l,m !
double precision :: dx,dy,dz,r2 ! input : r(1) ==> r(1) = x, r(2) = y, r(3) = z
double precision :: dx2,dy2,dz2 !
double precision :: dx1,dy1,dz1 ! output :
double precision :: center_ao(3) !
double precision :: beta,accu_1,accu_2,contrib ! * aos_array(i) = ao(i) evaluated at ro
do i = 1, nucl_num ! * aos_grad_array(1,i) = gradient X of the ao(i) evaluated at $\textbf{r}$
center_ao(1:3) = nucl_coord(i,1:3) !
dx = (r(1) - center_ao(1)) END_DOC
dy = (r(2) - center_ao(2))
dz = (r(3) - center_ao(3)) implicit none
r2 = dx*dx + dy*dy + dz*dz double precision, intent(in) :: r(3)
do j = 1,Nucl_N_Aos(i) double precision, intent(out) :: aos_array(ao_num)
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format double precision, intent(out) :: aos_grad_array(3,ao_num)
aos_array(k) = 0.d0
aos_grad_array(1,k) = 0.d0 integer :: power_ao(3)
aos_grad_array(2,k) = 0.d0 integer :: i, j, k, l, m
aos_grad_array(3,k) = 0.d0 double precision :: dx, dy, dz, r2
power_ao(1:3)= ao_power_ordered_transp_per_nucl(1:3,j,i) double precision :: dx1, dy1, dz1
dx2 = dx**power_ao(1) double precision :: dx2, dy2, dz2
dy2 = dy**power_ao(2) double precision :: center_ao(3)
dz2 = dz**power_ao(3) double precision :: beta, accu_1, accu_2, contrib
if(power_ao(1) .ne. 0)then
dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1) do i = 1, nucl_num
else
dx1 = 0.d0 center_ao(1:3) = nucl_coord(i,1:3)
endif
if(power_ao(2) .ne. 0)then dx = r(1) - center_ao(1)
dy1 = dble(power_ao(2)) * dy**(power_ao(2)-1) dy = r(2) - center_ao(2)
else dz = r(3) - center_ao(3)
dy1 = 0.d0 r2 = dx*dx + dy*dy + dz*dz
endif
if(power_ao(3) .ne. 0)then do j = 1, Nucl_N_Aos(i)
dz1 = dble(power_ao(3)) * dz**(power_ao(3)-1)
else k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
dz1 = 0.d0
endif aos_array(k) = 0.d0
accu_1 = 0.d0 aos_grad_array(1,k) = 0.d0
accu_2 = 0.d0 aos_grad_array(2,k) = 0.d0
do l = 1,ao_prim_num(k) aos_grad_array(3,k) = 0.d0
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
contrib = 0.d0 power_ao(1:3) = ao_power_ordered_transp_per_nucl(1:3,j,i)
if(beta*r2.gt.50.d0)cycle dx2 = dx**power_ao(1)
contrib = ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2) dy2 = dy**power_ao(2)
accu_1 += contrib dz2 = dz**power_ao(3)
accu_2 += contrib * beta
enddo dx1 = 0.d0
aos_array(k) = accu_1 * dx2 * dy2 * dz2 if(power_ao(1) .ne. 0) then
aos_grad_array(1,k) = accu_1 * dx1 * dy2 * dz2- 2.d0 * dx2 * dx * dy2 * dz2 * accu_2 dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1)
aos_grad_array(2,k) = accu_1 * dx2 * dy1 * dz2- 2.d0 * dx2 * dy2 * dy * dz2 * accu_2 endif
aos_grad_array(3,k) = accu_1 * dx2 * dy2 * dz1- 2.d0 * dx2 * dy2 * dz2 * dz * accu_2
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 enddo
enddo
end end
! ---
subroutine give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array) subroutine give_all_aos_and_grad_and_lapl_at_r(r, aos_array, aos_grad_array, aos_lapl_array)
implicit none
BEGIN_DOC
! input : r(1) ==> r(1) = x, r(2) = y, r(3) = z
!
! output :
!
! * aos_array(i) = ao(i) evaluated at $\textbf{r}$
! * aos_grad_array(1,i) = $\nabla_x$ of the ao(i) evaluated at $\textbf{r}$
END_DOC
double precision, intent(in) :: r(3)
double precision, intent(out) :: aos_array(ao_num)
double precision, intent(out) :: aos_grad_array(3,ao_num)
double precision, intent(out) :: aos_lapl_array(3,ao_num)
integer :: power_ao(3) BEGIN_DOC
integer :: i,j,k,l,m !
double precision :: dx,dy,dz,r2 ! input : r(1) ==> r(1) = x, r(2) = y, r(3) = z
double precision :: dx2,dy2,dz2 !
double precision :: dx1,dy1,dz1 ! output :
double precision :: dx3,dy3,dz3 !
double precision :: dx4,dy4,dz4 ! * aos_array(i) = ao(i) evaluated at $\textbf{r}$
double precision :: dx5,dy5,dz5 ! * aos_grad_array(1,i) = $\nabla_x$ of the ao(i) evaluated at $\textbf{r}$
double precision :: center_ao(3) !
double precision :: beta,accu_1,accu_2,accu_3,contrib END_DOC
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
aos_lapl_array(1,k) = 0.d0 implicit none
aos_lapl_array(2,k) = 0.d0 double precision, intent(in) :: r(3)
aos_lapl_array(3,k) = 0.d0 double precision, intent(out) :: aos_array(ao_num)
double precision, intent(out) :: aos_grad_array(3,ao_num)
double precision, intent(out) :: aos_lapl_array(3,ao_num)
power_ao(1:3)= ao_power_ordered_transp_per_nucl(1:3,j,i) integer :: power_ao(3)
dx2 = dx**power_ao(1) integer :: i, j, k, l, m
dy2 = dy**power_ao(2) double precision :: dx, dy, dz, r2
dz2 = dz**power_ao(3) double precision :: dx1, dy1, dz1
if(power_ao(1) .ne. 0)then double precision :: dx2, dy2, dz2
dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1) double precision :: dx3, dy3, dz3
else double precision :: dx4, dy4, dz4
dx1 = 0.d0 double precision :: dx5, dy5, dz5
endif double precision :: center_ao(3)
! For the Laplacian double precision :: beta, accu_1, accu_2, accu_3, contrib
if(power_ao(1) .ge. 2)then
dx3 = dble(power_ao(1)) * dble((power_ao(1)-1)) * dx**(power_ao(1)-2)
else
dx3 = 0.d0
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) do i = 1, nucl_num
if(power_ao(2) .ne. 0)then center_ao(1:3) = nucl_coord(i,1:3)
dy1 = dble(power_ao(2)) * dy**(power_ao(2)-1)
else
dy1 = 0.d0
endif
! For the Laplacian
if(power_ao(2) .ge. 2)then
dy3 = dble(power_ao(2)) * dble((power_ao(2)-1)) * dy**(power_ao(2)-2)
else
dy3 = 0.d0
endif
if(power_ao(2) .ge. 1)then dx = r(1) - center_ao(1)
dy4 = dble((2 * power_ao(2) + 1)) * dy**(power_ao(2)) dy = r(2) - center_ao(2)
else dz = r(3) - center_ao(3)
dy4 = dble((power_ao(2) + 1)) * dy**(power_ao(2)) r2 = dx*dx + dy*dy + dz*dz
endif
do j = 1, Nucl_N_Aos(i)
dy5 = dy**(power_ao(2)+2) 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)
if(power_ao(3) .ne. 0)then ! ---
dz1 = dble(power_ao(3)) * dz**(power_ao(3)-1)
else
dz1 = 0.d0
endif
! For the Laplacian
if(power_ao(3) .ge. 2)then
dz3 = dble(power_ao(3)) * dble((power_ao(3)-1)) * dz**(power_ao(3)-2)
else
dz3 = 0.d0
endif
if(power_ao(3) .ge. 1)then dx1 = 0.d0
dz4 = dble((2 * power_ao(3) + 1)) * dz**(power_ao(3)) if(power_ao(1) .ne. 0) then
else dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1)
dz4 = dble((power_ao(3) + 1)) * dz**(power_ao(3)) endif
endif
dz5 = dz**(power_ao(3)+2) 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
accu_1 = 0.d0 dy3 = 0.d0
accu_2 = 0.d0 if(power_ao(2) .ge. 2) then
accu_3 = 0.d0 dy3 = dble(power_ao(2)) * dble((power_ao(2)-1)) * dy**(power_ao(2)-2)
do l = 1,ao_prim_num(k) endif
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
contrib = ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2) if(power_ao(2) .ge. 1) then
accu_1 += contrib dy4 = dble((2 * power_ao(2) + 1)) * dy**(power_ao(2))
accu_2 += contrib * beta else
accu_3 += contrib * beta**2 dy4 = dble((power_ao(2) + 1)) * dy**(power_ao(2))
enddo endif
aos_array(k) = accu_1 * dx2 * dy2 * dz2
dy5 = dy**(power_ao(2)+2)
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 dz1 = 0.d0
if(power_ao(3) .ne. 0) then
dz1 = dble(power_ao(3)) * dz**(power_ao(3)-1)
endif
aos_lapl_array(1,k) = accu_1 * dx3 * dy2 * dz2- 2.d0 * dx4 * dy2 * dz2* accu_2 +4.d0 * dx5 *dy2 * dz2* accu_3 dz3 = 0.d0
aos_lapl_array(2,k) = accu_1 * dx2 * dy3 * dz2- 2.d0 * dx2 * dy4 * dz2* accu_2 +4.d0 * dx2 *dy5 * dz2* accu_3 if(power_ao(3) .ge. 2) then
aos_lapl_array(3,k) = accu_1 * dx2 * dy2 * dz3- 2.d0 * dx2 * dy2 * dz4* accu_2 +4.d0 * dx2 *dy2 * dz5* accu_3 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 enddo
enddo
end end
! ---