PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-01-03 01:55:59 +01:00
Code Releases Activity

cosgtos -> cgtos

Browse Source
This commit is contained in:
AbdAmmar 2024-10-14 13:36:09 +02:00
parent cd3c0cb1a9
commit 6edaaef524
19 changed files with 724 additions and 537 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/ao_basis/EZFIO.cfg
View File

@ -67,15 +67,27 @@ doc: Use normalized primitive functions
interface: ezfio, provider
default: true
[ao_expoim_cosgtos]
type: double precision
doc: imag part for Exponents for each primitive of each cosGTOs |AO|
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
interface: ezfio, provider
[use_cosgtos]
[use_cgtos]
type: logical
doc: If true, use cosgtos for AO integrals
doc: If true, use cgtos for AO integrals
interface: ezfio
default: False
[ao_expo_im_cgtos]
type: double precision
doc: imag part for Exponents for each primitive of each cGTOs |AO|
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
interface: ezfio, provider
[ao_expo_pw]
type: double precision
doc: plane wave part for each primitive GTOs |AO|
size: (3,ao_basis.ao_num,ao_basis.ao_prim_num_max)
interface: ezfio, provider
[ao_expo_phase]
type: double precision
doc: phase shift for each primitive GTOs |AO|
size: (3,ao_basis.ao_num,ao_basis.ao_prim_num_max)
interface: ezfio, provider

37
src/ao_basis/cgtos.irp.f Normal file
View File

@ -0,0 +1,37 @@
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

34
src/ao_basis/cosgtos.irp.f
View File

@ -1,34 +0,0 @@
BEGIN_PROVIDER [ logical, use_cosgtos ]
implicit none
BEGIN_DOC
! If true, use cosgtos for AO integrals
END_DOC
logical :: has
PROVIDE ezfio_filename
use_cosgtos = .False.
if (mpi_master) then
call ezfio_has_ao_basis_use_cosgtos(has)
if (has) then
! write(6,'(A)') '.. >>>>> [ IO READ: use_cosgtos ] <<<<< ..'
call ezfio_get_ao_basis_use_cosgtos(use_cosgtos)
else
call ezfio_set_ao_basis_use_cosgtos(use_cosgtos)
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_cosgtos, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read use_cosgtos with MPI'
endif
IRP_ENDIF
! call write_time(6)
END_PROVIDER

11
src/ao_one_e_ints/ao_overlap.irp.f
View File

@ -30,15 +30,14 @@
else
if(use_cosgtos) then
!print*, ' use_cosgtos for ao_overlap ?', use_cosgtos
if(use_cgtos) then
do j = 1, ao_num
do i = 1, ao_num
ao_overlap (i,j) = ao_overlap_cosgtos (i,j)
ao_overlap_x(i,j) = ao_overlap_cosgtos_x(i,j)
ao_overlap_y(i,j) = ao_overlap_cosgtos_y(i,j)
ao_overlap_z(i,j) = ao_overlap_cosgtos_z(i,j)
ao_overlap (i,j) = ao_overlap_cgtos (i,j)
ao_overlap_x(i,j) = ao_overlap_cgtos_x(i,j)
ao_overlap_y(i,j) = ao_overlap_cgtos_y(i,j)
ao_overlap_z(i,j) = ao_overlap_cgtos_z(i,j)
enddo
enddo

225
src/ao_one_e_ints/aos_cgtos.irp.f Normal file
View File

@ -0,0 +1,225 @@
! ---
BEGIN_PROVIDER [double precision, ao_coef_norm_ord_transp_cgtos, (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_norm_ord_transp_cgtos(i,j) = ao_coef_norm_ord_cgtos(j,i)
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [complex*16, ao_expo_ord_transp_cgtos, (ao_prim_num_max, ao_num)]
implicit none
integer :: i, j
do j = 1, ao_num
do i = 1, ao_prim_num_max
ao_expo_ord_transp_cgtos(i,j) = ao_expo_ord_cgtos(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, powA(3), nz
double precision :: norm
complex*16 :: overlap_x, overlap_y, overlap_z, C_A(3)
complex*16 :: integ1, integ2, expo
nz = 100
C_A(1) = (0.d0, 0.d0)
C_A(2) = (0.d0, 0.d0)
C_A(3) = (0.d0, 0.d0)
ao_coef_norm_cgtos = 0.d0
do i = 1, ao_num
powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3)
! TODO
! Normalization of the primitives
if(primitives_normalized) then
do j = 1, ao_prim_num(i)
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expo_im_cgtos(i,j)
call overlap_cgaussian_xyz(C_A, C_A, expo, expo, powA, powA, overlap_x, overlap_y, overlap_z, integ1, nz)
call overlap_cgaussian_xyz(C_A, C_A, conjg(expo), expo, powA, powA, overlap_x, overlap_y, overlap_z, integ2, nz)
norm = 2.d0 * real(integ1 + integ2)
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
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, ao_coef_norm_ord_cgtos, (ao_num, ao_prim_num_max)]
&BEGIN_PROVIDER [complex*16 , ao_expo_ord_cgtos, (ao_num, ao_prim_num_max)]
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord, (3, ao_num, ao_prim_num_max)]
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord, (3, ao_num, ao_prim_num_max)]
implicit none
integer :: i, j
integer :: iorder(ao_prim_num_max)
double precision :: d(ao_prim_num_max,9)
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_cgtos(i,j)
d(j,4) = ao_expo_pw(1,i,j)
d(j,5) = ao_expo_pw(2,i,j)
d(j,6) = ao_expo_pw(3,i,j)
d(j,7) = ao_expo_phase(1,i,j)
d(j,8) = ao_expo_phase(2,i,j)
d(j,9) = ao_expo_phase(3,i,j)
enddo
call dsort(d(1,1), iorder, ao_prim_num(i))
do j = 2, 9
call dset_order(d(1,j), iorder, ao_prim_num(i))
enddo
do j = 1, ao_prim_num(i)
ao_expo_ord_cgtos (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
ao_coef_norm_ord_cgtos(i,j) = d(j,2)
ao_expo_pw_ord(i,j,1) = d(j,4)
ao_expo_pw_ord(i,j,2) = d(j,5)
ao_expo_pw_ord(i,j,3) = d(j,6)
ao_expo_phase_ord(i,j,1) = d(j,7)
ao_expo_phase_ord(i,j,2) = d(j,8)
ao_expo_phase_ord(i,j,3) = d(j,9)
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, ao_overlap_cgtos, (ao_num, ao_num)]
&BEGIN_PROVIDER [double precision, ao_overlap_cgtos_x, (ao_num, ao_num)]
&BEGIN_PROVIDER [double precision, ao_overlap_cgtos_y, (ao_num, ao_num)]
&BEGIN_PROVIDER [double precision, ao_overlap_cgtos_z, (ao_num, ao_num)]
implicit none
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
double precision :: c, overlap, overlap_x, overlap_y, overlap_z
complex*16 :: alpha, beta, A_center(3), B_center(3)
complex*16 :: overlap1, overlap_x1, overlap_y1, overlap_z1
complex*16 :: overlap2, overlap_x2, overlap_y2, overlap_z2
ao_overlap_cgtos = 0.d0
ao_overlap_cgtos_x = 0.d0
ao_overlap_cgtos_y = 0.d0
ao_overlap_cgtos_z = 0.d0
dim1 = 100
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
!$OMP DEFAULT(NONE) &
!$OMP PRIVATE(A_center, B_center, power_A, power_B, alpha, beta, i, j, n, l, c, &
!$OMP overlap_x , overlap_y , overlap_z , overlap, &
!$OMP overlap_x1, overlap_y1, overlap_z1, overlap1, &
!$OMP overlap_x2, overlap_y2, overlap_z2, overlap2) &
!$OMP SHARED(nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1, &
!$OMP ao_overlap_cgtos_x, ao_overlap_cgtos_y, ao_overlap_cgtos_z, ao_overlap_cgtos, &
!$OMP ao_coef_norm_ord_transp_cgtos, ao_expo_ord_transp_cgtos )
do j = 1, ao_num
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
power_A(1) = ao_power(j,1)
power_A(2) = ao_power(j,2)
power_A(3) = ao_power(j,3)
do i = 1, ao_num
B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0)
B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
power_B(1) = ao_power(i,1)
power_B(2) = ao_power(i,2)
power_B(3) = ao_power(i,3)
do n = 1, ao_prim_num(j)
alpha = ao_expo_ord_transp_cgtos(n,j)
do l = 1, ao_prim_num(i)
c = ao_coef_norm_ord_transp_cgtos(n,j) * ao_coef_norm_ord_transp_cgtos(l,i)
beta = ao_expo_ord_transp_cgtos(l,i)
call overlap_cgaussian_xyz(A_center, B_center, alpha, beta, power_A, power_B, &
overlap_x1, overlap_y1, overlap_z1, overlap1, dim1)
call overlap_cgaussian_xyz(A_center, B_center, conjg(alpha), beta, power_A, power_B, &
overlap_x2, overlap_y2, overlap_z2, overlap2, dim1)
overlap_x = 2.d0 * real(overlap_x1 + overlap_x2)
overlap_y = 2.d0 * real(overlap_y1 + overlap_y2)
overlap_z = 2.d0 * real(overlap_z1 + overlap_z2)
overlap = 2.d0 * real(overlap1 + overlap2 )
ao_overlap_cgtos(i,j) = ao_overlap_cgtos(i,j) + c * overlap
if( isnan(ao_overlap_cgtos(i,j)) ) then
print*,'i, j', i, j
print*,'l, n', l, n
print*,'c, overlap', c, overlap
print*, overlap_x, overlap_y, overlap_z
stop
endif
ao_overlap_cgtos_x(i,j) = ao_overlap_cgtos_x(i,j) + c * overlap_x
ao_overlap_cgtos_y(i,j) = ao_overlap_cgtos_y(i,j) + c * overlap_y
ao_overlap_cgtos_z(i,j) = ao_overlap_cgtos_z(i,j) + c * overlap_z
enddo
enddo
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
! ---

210
src/ao_one_e_ints/aos_cosgtos.irp.f
View File

@ -1,210 +0,0 @@
! ---
BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_transp_cosgtos, (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_norm_ord_transp_cosgtos(i,j) = ao_coef_norm_ord_cosgtos(j,i)
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ complex*16, ao_expo_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
implicit none
integer :: i, j
do j = 1, ao_num
do i = 1, ao_prim_num_max
ao_expo_ord_transp_cosgtos(i,j) = ao_expo_ord_cosgtos(j,i)
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, ao_coef_norm_cosgtos, (ao_num, ao_prim_num_max) ]
implicit none
integer :: i, j, powA(3), nz
double precision :: norm
complex*16 :: overlap_x, overlap_y, overlap_z, C_A(3)
complex*16 :: integ1, integ2, expo
nz = 100
C_A(1) = (0.d0, 0.d0)
C_A(2) = (0.d0, 0.d0)
C_A(3) = (0.d0, 0.d0)
ao_coef_norm_cosgtos = 0.d0
do i = 1, ao_num
powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3)
! Normalization of the primitives
if(primitives_normalized) then
do j = 1, ao_prim_num(i)
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expoim_cosgtos(i,j)
call overlap_cgaussian_xyz(C_A, C_A, expo, expo, powA, powA, overlap_x, overlap_y, overlap_z, integ1, nz)
call overlap_cgaussian_xyz(C_A, C_A, conjg(expo), expo, powA, powA, overlap_x, overlap_y, overlap_z, integ2, nz)
norm = 2.d0 * real( integ1 + integ2 )
ao_coef_norm_cosgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
enddo
else
do j = 1, ao_prim_num(i)
ao_coef_norm_cosgtos(i,j) = ao_coef(i,j)
enddo
endif
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_cosgtos, (ao_num, ao_prim_num_max) ]
&BEGIN_PROVIDER [ complex*16 , ao_expo_ord_cosgtos, (ao_num, ao_prim_num_max) ]
implicit none
integer :: i, j
integer :: iorder(ao_prim_num_max)
double precision :: d(ao_prim_num_max,3)
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_cosgtos(i,j)
d(j,3) = ao_expoim_cosgtos(i,j)
enddo
call dsort (d(1,1), iorder, ao_prim_num(i))
call dset_order(d(1,2), iorder, ao_prim_num(i))
call dset_order(d(1,3), iorder, ao_prim_num(i))
do j = 1, ao_prim_num(i)
ao_expo_ord_cosgtos (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
ao_coef_norm_ord_cosgtos(i,j) = d(j,2)
enddo
enddo
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_x, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_y, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_z, (ao_num, ao_num) ]
implicit none
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
double precision :: c, overlap, overlap_x, overlap_y, overlap_z
complex*16 :: alpha, beta, A_center(3), B_center(3)
complex*16 :: overlap1, overlap_x1, overlap_y1, overlap_z1
complex*16 :: overlap2, overlap_x2, overlap_y2, overlap_z2
ao_overlap_cosgtos = 0.d0
ao_overlap_cosgtos_x = 0.d0
ao_overlap_cosgtos_y = 0.d0
ao_overlap_cosgtos_z = 0.d0
dim1 = 100
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
!$OMP DEFAULT(NONE) &
!$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, n, l, c &
!$OMP , overlap_x , overlap_y , overlap_z , overlap &
!$OMP , overlap_x1, overlap_y1, overlap_z1, overlap1 &
!$OMP , overlap_x2, overlap_y2, overlap_z2, overlap2 ) &
!$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1 &
!$OMP , ao_overlap_cosgtos_x, ao_overlap_cosgtos_y, ao_overlap_cosgtos_z, ao_overlap_cosgtos &
!$OMP , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos )
do j = 1, ao_num
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
power_A(1) = ao_power(j,1)
power_A(2) = ao_power(j,2)
power_A(3) = ao_power(j,3)
do i = 1, ao_num
B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0)
B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
power_B(1) = ao_power(i,1)
power_B(2) = ao_power(i,2)
power_B(3) = ao_power(i,3)
do n = 1, ao_prim_num(j)
alpha = ao_expo_ord_transp_cosgtos(n,j)
do l = 1, ao_prim_num(i)
c = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
beta = ao_expo_ord_transp_cosgtos(l,i)
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
, overlap_x1, overlap_y1, overlap_z1, overlap1, dim1 )
call overlap_cgaussian_xyz( A_center, B_center, conjg(alpha), beta, power_A, power_B &
, overlap_x2, overlap_y2, overlap_z2, overlap2, dim1 )
overlap_x = 2.d0 * real( overlap_x1 + overlap_x2 )
overlap_y = 2.d0 * real( overlap_y1 + overlap_y2 )
overlap_z = 2.d0 * real( overlap_z1 + overlap_z2 )
overlap = 2.d0 * real( overlap1 + overlap2 )
ao_overlap_cosgtos(i,j) = ao_overlap_cosgtos(i,j) + c * overlap
if( isnan(ao_overlap_cosgtos(i,j)) ) then
print*,'i, j', i, j
print*,'l, n', l, n
print*,'c, overlap', c, overlap
print*, overlap_x, overlap_y, overlap_z
stop
endif
ao_overlap_cosgtos_x(i,j) = ao_overlap_cosgtos_x(i,j) + c * overlap_x
ao_overlap_cosgtos_y(i,j) = ao_overlap_cosgtos_y(i,j) + c * overlap_y
ao_overlap_cosgtos_z(i,j) = ao_overlap_cosgtos_z(i,j) + c * overlap_z
enddo
enddo
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
! ---

10
src/ao_one_e_ints/kin_ao_ints.irp.f
View File

@ -23,14 +23,14 @@
double precision :: A_center(3), B_center(3)
double precision :: d_a_2,d_2
if(use_cosgtos) then
!print*, 'use_cosgtos for ao_kinetic_integrals ?', use_cosgtos
if(use_cgtos) then
!print*, 'use_cgtos for ao_kinetic_integrals ?', use_cgtos
do j = 1, ao_num
do i = 1, ao_num
ao_deriv2_x(i,j) = ao_deriv2_cosgtos_x(i,j)
ao_deriv2_y(i,j) = ao_deriv2_cosgtos_y(i,j)
ao_deriv2_z(i,j) = ao_deriv2_cosgtos_z(i,j)
ao_deriv2_x(i,j) = ao_deriv2_cgtos_x(i,j)
ao_deriv2_y(i,j) = ao_deriv2_cgtos_y(i,j)
ao_deriv2_z(i,j) = ao_deriv2_cgtos_z(i,j)
enddo
enddo

82
src/ao_one_e_ints/one_e_Coul_integrals_cosgtos.irp.f → src/ao_one_e_ints/one_e_Coul_integrals_cgtos.irp.f
View File

@ -1,11 +1,11 @@
! ---
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cgtos, (ao_num, ao_num)]
BEGIN_DOC
!
! Nucleus-electron interaction, in the cosgtos |AO| basis set.
! Nucleus-electron interaction, in the cgtos |AO| basis set.
!
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
!
@ -17,17 +17,17 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
double precision :: c, Z, A_center(3), B_center(3), C_center(3)
complex*16 :: alpha, beta, c1, c2
complex*16 :: NAI_pol_mult_cosgtos
complex*16 :: NAI_pol_mult_cgtos
ao_integrals_n_e_cosgtos = 0.d0
ao_integrals_n_e_cgtos = 0.d0
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE ( i, j, k, l, m, alpha, beta, A_center, B_center, C_center &
!$OMP , power_A, power_B, num_A, num_B, Z, c, c1, c2, n_pt_in ) &
!$OMP SHARED ( ao_num, ao_prim_num, ao_nucl, nucl_coord, ao_power, nucl_num, nucl_charge &
!$OMP , ao_expo_ord_transp_cosgtos, ao_coef_norm_ord_transp_cosgtos &
!$OMP , n_pt_max_integrals, ao_integrals_n_e_cosgtos )
!$OMP , ao_expo_ord_transp_cgtos, ao_coef_norm_ord_transp_cgtos &
!$OMP , n_pt_max_integrals, ao_integrals_n_e_cgtos )
n_pt_in = n_pt_max_integrals
@ -44,10 +44,10 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
B_center(1:3) = nucl_coord(num_B,1:3)
do l = 1, ao_prim_num(j)
alpha = ao_expo_ord_transp_cosgtos(l,j)
alpha = ao_expo_ord_transp_cgtos(l,j)
do m = 1, ao_prim_num(i)
beta = ao_expo_ord_transp_cosgtos(m,i)
beta = ao_expo_ord_transp_cgtos(m,i)
c = 0.d0
do k = 1, nucl_num
@ -60,11 +60,11 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
!print *, A_center, B_center, C_center, power_A, power_B
!print *, real(alpha), real(beta)
c1 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
c1 = NAI_pol_mult_cgtos( A_center, B_center, power_A, power_B &
, alpha, beta, C_center, n_pt_in )
!c2 = c1
c2 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
c2 = NAI_pol_mult_cgtos( A_center, B_center, power_A, power_B &
, conjg(alpha), beta, C_center, n_pt_in )
!print *, ' c1 = ', real(c1)
@ -73,9 +73,9 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
c = c - Z * 2.d0 * real(c1 + c2)
enddo
ao_integrals_n_e_cosgtos(i,j) = ao_integrals_n_e_cosgtos(i,j) &
+ ao_coef_norm_ord_transp_cosgtos(l,j) &
* ao_coef_norm_ord_transp_cosgtos(m,i) * c
ao_integrals_n_e_cgtos(i,j) = ao_integrals_n_e_cgtos(i,j) &
+ ao_coef_norm_ord_transp_cgtos(l,j) &
* ao_coef_norm_ord_transp_cgtos(m,i) * c
enddo
enddo
enddo
@ -88,11 +88,11 @@ END_PROVIDER
! ---
complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in)
complex*16 function NAI_pol_mult_cgtos(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in)
BEGIN_DOC
!
! Computes the electron-nucleus attraction with two primitves cosgtos.
! Computes the electron-nucleus attraction with two primitves cgtos.
!
! :math:`\langle g_i | \frac{1}{|r-R_c|} | g_j \rangle`
!
@ -111,7 +111,7 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
complex*16 :: accu, P_center(3)
complex*16 :: d(0:n_pt_in)
complex*16, external :: V_n_e_cosgtos
complex*16, external :: V_n_e_cgtos
complex*16, external :: crint_2
complex*16, external :: crint_sum_2
@ -122,7 +122,7 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
else
NAI_pol_mult_cosgtos = V_n_e_cosgtos( power_A(1), power_A(2), power_A(3) &
NAI_pol_mult_cgtos = V_n_e_cgtos( power_A(1), power_A(2), power_A(3) &
, power_B(1), power_B(2), power_B(3) &
, alpha, beta )
return
@ -146,7 +146,7 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
const_mod = dsqrt(real(const_factor)*real(const_factor) + aimag(const_factor)*aimag(const_factor))
if(const_mod > 80.d0) then
NAI_pol_mult_cosgtos = (0.d0, 0.d0)
NAI_pol_mult_cgtos = (0.d0, 0.d0)
return
endif
@ -159,7 +159,7 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
n_pt = 2 * ( (power_A(1) + power_B(1)) + (power_A(2) + power_B(2)) + (power_A(3) + power_B(3)) )
if(n_pt == 0) then
NAI_pol_mult_cosgtos = coeff * crint_2(0, const)
NAI_pol_mult_cgtos = coeff * crint_2(0, const)
return
endif
@ -167,7 +167,7 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
power_A, power_B, C_center, n_pt_in, d, n_pt_out)
if(n_pt_out < 0) then
NAI_pol_mult_cosgtos = (0.d0, 0.d0)
NAI_pol_mult_cgtos = (0.d0, 0.d0)
return
endif
@ -176,7 +176,7 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
! accu += crint_2(shiftr(i, 1), const) * d(i)
!enddo
accu = crint_sum_2(n_pt_out, const, d)
NAI_pol_mult_cosgtos = accu * coeff
NAI_pol_mult_cgtos = accu * coeff
return
end
@ -241,7 +241,7 @@ subroutine give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
a_x = power_A(1)
b_x = power_B(1)
call I_x1_pol_mult_one_e_cosgtos(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
call I_x1_pol_mult_one_e_cgtos(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
if(n_pt1 < 0) then
n_pt_out = -1
@ -265,7 +265,7 @@ subroutine give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
a_y = power_A(2)
b_y = power_B(2)
call I_x1_pol_mult_one_e_cosgtos(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
call I_x1_pol_mult_one_e_cgtos(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
if(n_pt2 < 0) then
n_pt_out = -1
@ -289,7 +289,7 @@ subroutine give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
a_z = power_A(3)
b_z = power_B(3)
call I_x1_pol_mult_one_e_cosgtos(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
call I_x1_pol_mult_one_e_cgtos(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
if(n_pt3 < 0) then
n_pt_out = -1
@ -317,7 +317,7 @@ end
! ---
recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_pt_in)
recursive subroutine I_x1_pol_mult_one_e_cgtos(a, c, R1x, R1xp, R2x, d, nd, n_pt_in)
BEGIN_DOC
! Recursive routine involved in the electron-nucleus potential
@ -351,7 +351,7 @@ recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_
elseif((a == 0) .and. (c .ne. 0)) then
call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, n_pt_in)
call I_x2_pol_mult_one_e_cgtos(c, R1x, R1xp, R2x, d, nd, n_pt_in)
elseif(a == 1) then
@ -361,7 +361,7 @@ recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_
Y(ix) = (0.d0, 0.d0)
enddo
call I_x2_pol_mult_one_e_cosgtos(c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
call I_x2_pol_mult_one_e_cgtos(c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
do ix = 0, nx
X(ix) *= dble(c)
@ -370,7 +370,7 @@ recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_
call multiply_cpoly(X, nx, R2x, 2, d, nd)
ny = 0
call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, Y, ny, n_pt_in)
call I_x2_pol_mult_one_e_cgtos(c, R1x, R1xp, R2x, Y, ny, n_pt_in)
call multiply_cpoly(Y, ny, R1x, 2, d, nd)
else
@ -381,7 +381,7 @@ recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_
Y(ix) = (0.d0, 0.d0)
enddo
call I_x1_pol_mult_one_e_cosgtos(a-2, c, R1x, R1xp, R2x, X, nx, n_pt_in)
call I_x1_pol_mult_one_e_cgtos(a-2, c, R1x, R1xp, R2x, X, nx, n_pt_in)
do ix = 0, nx
X(ix) *= dble(a-1)
@ -393,7 +393,7 @@ recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_
X(ix) = (0.d0, 0.d0)
enddo
call I_x1_pol_mult_one_e_cosgtos(a-1, c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
call I_x1_pol_mult_one_e_cgtos(a-1, c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
do ix = 0, nx
X(ix) *= dble(c)
enddo
@ -401,7 +401,7 @@ recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_
call multiply_cpoly(X, nx, R2x, 2, d, nd)
ny = 0
call I_x1_pol_mult_one_e_cosgtos(a-1, c, R1x, R1xp, R2x, Y, ny, n_pt_in)
call I_x1_pol_mult_one_e_cgtos(a-1, c, R1x, R1xp, R2x, Y, ny, n_pt_in)
call multiply_cpoly(Y, ny, R1x, 2, d, nd)
endif
@ -410,7 +410,7 @@ end
! ---
recursive subroutine I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, dim)
recursive subroutine I_x2_pol_mult_one_e_cgtos(c, R1x, R1xp, R2x, d, nd, dim)
BEGIN_DOC
! Recursive routine involved in the electron-nucleus potential
@ -447,7 +447,7 @@ recursive subroutine I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, dim)
Y(ix) = (0.d0, 0.d0)
enddo
call I_x1_pol_mult_one_e_cosgtos(0, c-2, R1x, R1xp, R2x, X, nx, dim)
call I_x1_pol_mult_one_e_cgtos(0, c-2, R1x, R1xp, R2x, X, nx, dim)
do ix = 0, nx
X(ix) *= dble(c-1)
@ -460,7 +460,7 @@ recursive subroutine I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, dim)
Y(ix) = (0.d0, 0.d0)
enddo
call I_x1_pol_mult_one_e_cosgtos(0, c-1, R1x, R1xp, R2x, Y, ny, dim)
call I_x1_pol_mult_one_e_cgtos(0, c-1, R1x, R1xp, R2x, Y, ny, dim)
if(ny .ge. 0) then
call multiply_cpoly(Y, ny, R1xp, 2, d, nd)
@ -472,7 +472,7 @@ end
! ---
complex*16 function V_n_e_cosgtos(a_x, a_y, a_z, b_x, b_y, b_z, alpha, beta)
complex*16 function V_n_e_cgtos(a_x, a_y, a_z, b_x, b_y, b_z, alpha, beta)
BEGIN_DOC
! Primitve nuclear attraction between the two primitves centered on the same atom.
@ -488,17 +488,17 @@ complex*16 function V_n_e_cosgtos(a_x, a_y, a_z, b_x, b_y, b_z, alpha, beta)
complex*16, intent(in) :: alpha, beta
double precision :: V_phi, V_theta
complex*16 :: V_r_cosgtos
complex*16 :: V_r_cgtos
if( (iand(a_x + b_x, 1) == 1) .or. &
(iand(a_y + b_y, 1) == 1) .or. &
(iand(a_z + b_z, 1) == 1) ) then
V_n_e_cosgtos = (0.d0, 0.d0)
V_n_e_cgtos = (0.d0, 0.d0)
else
V_n_e_cosgtos = V_r_cosgtos(a_x + b_x + a_y + b_y + a_z + b_z + 1, alpha + beta) &
V_n_e_cgtos = V_r_cgtos(a_x + b_x + a_y + b_y + a_z + b_z + 1, alpha + beta) &
* V_phi(a_x + b_x, a_y + b_y) &
* V_theta(a_z + b_z, a_x + b_x + a_y + b_y + 1)
endif
@ -507,7 +507,7 @@ end
! ---
complex*16 function V_r_cosgtos(n, alpha)
complex*16 function V_r_cgtos(n, alpha)
BEGIN_DOC
! Computes the radial part of the nuclear attraction integral:
@ -525,9 +525,9 @@ complex*16 function V_r_cosgtos(n, alpha)
double precision :: fact
if(iand(n, 1) .eq. 1) then
V_r_cosgtos = 0.5d0 * fact(shiftr(n, 1)) / (alpha**(shiftr(n, 1) + 1))
V_r_cgtos = 0.5d0 * fact(shiftr(n, 1)) / (alpha**(shiftr(n, 1) + 1))
else
V_r_cosgtos = sqpi * fact(n) / fact(shiftr(n, 1)) * (0.5d0/zsqrt(alpha))**(n+1)
V_r_cgtos = sqpi * fact(n) / fact(shiftr(n, 1)) * (0.5d0/zsqrt(alpha))**(n+1)
endif
end

40
src/ao_one_e_ints/one_e_kin_integrals_cosgtos.irp.f → src/ao_one_e_ints/one_e_kin_integrals_cgtos.irp.f
View File

@ -1,9 +1,9 @@
! ---
BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_x, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_y, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_z, (ao_num, ao_num) ]
BEGIN_PROVIDER [ double precision, ao_deriv2_cgtos_x, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_deriv2_cgtos_y, (ao_num, ao_num) ]
&BEGIN_PROVIDER [ double precision, ao_deriv2_cgtos_z, (ao_num, ao_num) ]
implicit none
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
@ -40,8 +40,8 @@
!$OMP , overlap_m2_1, overlap_p2_1, overlap_m2_2, overlap_p2_2 &
!$OMP , overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap_x0_2, overlap_y0_2, overlap_z0_2 ) &
!$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1 &
!$OMP , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos &
!$OMP , ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z )
!$OMP , ao_coef_norm_ord_transp_cgtos, ao_expo_ord_transp_cgtos &
!$OMP , ao_deriv2_cgtos_x, ao_deriv2_cgtos_y, ao_deriv2_cgtos_z )
do j = 1, ao_num
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
@ -59,16 +59,16 @@
power_B(2) = ao_power(i,2)
power_B(3) = ao_power(i,3)
ao_deriv2_cosgtos_x(i,j) = 0.d0
ao_deriv2_cosgtos_y(i,j) = 0.d0
ao_deriv2_cosgtos_z(i,j) = 0.d0
ao_deriv2_cgtos_x(i,j) = 0.d0
ao_deriv2_cgtos_y(i,j) = 0.d0
ao_deriv2_cgtos_z(i,j) = 0.d0
do n = 1, ao_prim_num(j)
alpha = ao_expo_ord_transp_cosgtos(n,j)
alpha = ao_expo_ord_transp_cgtos(n,j)
do l = 1, ao_prim_num(i)
c = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
beta = ao_expo_ord_transp_cosgtos(l,i)
c = ao_coef_norm_ord_transp_cgtos(n,j) * ao_coef_norm_ord_transp_cgtos(l,i)
beta = ao_expo_ord_transp_cgtos(l,i)
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
, overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
@ -109,7 +109,7 @@
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
ao_deriv2_cosgtos_x(i,j) += c * deriv_tmp
ao_deriv2_cgtos_x(i,j) += c * deriv_tmp
! ---
@ -144,7 +144,7 @@
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
ao_deriv2_cosgtos_y(i,j) += c * deriv_tmp
ao_deriv2_cgtos_y(i,j) += c * deriv_tmp
! ---
@ -179,7 +179,7 @@
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
ao_deriv2_cosgtos_z(i,j) += c * deriv_tmp
ao_deriv2_cgtos_z(i,j) += c * deriv_tmp
! ---
@ -193,11 +193,11 @@ END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, ao_kinetic_integrals_cosgtos, (ao_num, ao_num)]
BEGIN_PROVIDER [double precision, ao_kinetic_integrals_cgtos, (ao_num, ao_num)]
BEGIN_DOC
!
! Kinetic energy integrals in the cosgtos |AO| basis.
! Kinetic energy integrals in the cgtos |AO| basis.
!
! $\langle \chi_i |\hat{T}| \chi_j \rangle$
!
@ -208,12 +208,12 @@ BEGIN_PROVIDER [double precision, ao_kinetic_integrals_cosgtos, (ao_num, ao_num)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP PRIVATE(i, j) &
!$OMP SHARED(ao_num, ao_kinetic_integrals_cosgtos, ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z)
!$OMP SHARED(ao_num, ao_kinetic_integrals_cgtos, ao_deriv2_cgtos_x, ao_deriv2_cgtos_y, ao_deriv2_cgtos_z)
do j = 1, ao_num
do i = 1, ao_num
ao_kinetic_integrals_cosgtos(i,j) = -0.5d0 * ( ao_deriv2_cosgtos_x(i,j) &
+ ao_deriv2_cosgtos_y(i,j) &
+ ao_deriv2_cosgtos_z(i,j) )
ao_kinetic_integrals_cgtos(i,j) = -0.5d0 * (ao_deriv2_cgtos_x(i,j) + &
ao_deriv2_cgtos_y(i,j) + &
ao_deriv2_cgtos_z(i,j))
enddo
enddo
!$OMP END PARALLEL DO

6
src/ao_one_e_ints/pot_ao_ints.irp.f
View File

@ -27,12 +27,12 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
else
if(use_cosgtos) then
!print *, " use_cosgtos for ao_integrals_n_e ?", use_cosgtos
if(use_cgtos) then
!print *, " use_cgtos for ao_integrals_n_e ?", use_cgtos
do j = 1, ao_num
do i = 1, ao_num
ao_integrals_n_e(i,j) = ao_integrals_n_e_cosgtos(i,j)
ao_integrals_n_e(i,j) = ao_integrals_n_e_cgtos(i,j)
enddo
enddo

6
src/ao_one_e_ints/pot_pt_charges.irp.f
View File

@ -25,12 +25,12 @@ BEGIN_PROVIDER [ double precision, ao_integrals_pt_chrg, (ao_num,ao_num)]
!
! else
! if(use_cosgtos) then
! !print *, " use_cosgtos for ao_integrals_pt_chrg ?", use_cosgtos
! if(use_cgtos) then
! !print *, " use_cgtos for ao_integrals_pt_chrg ?", use_cgtos
!
! do j = 1, ao_num
! do i = 1, ao_num
! ao_integrals_pt_chrg(i,j) = ao_integrals_pt_chrg_cosgtos(i,j)
! ao_integrals_pt_chrg(i,j) = ao_integrals_pt_chrg_cgtos(i,j)
! enddo
! enddo
!

2
src/ao_two_e_ints/EZFIO.cfg
View File

@ -27,7 +27,7 @@ default: 1.e-12
type: logical
doc: Compute integrals on the fly (Useful only for Cholesky decomposition)
interface: ezfio,provider,ocaml
default: True
default: False
ezfio_name: direct
[do_ao_cholesky]

153
src/ao_two_e_ints/deb_2eint_cgtos.irp.f Normal file
View File

@ -0,0 +1,153 @@
! ---
subroutine deb_ao_2eint_cgtos(i, j, k, l)
BEGIN_DOC
! integral of the AO basis <ik|jl> or (ij|kl)
! i(r1) j(r1) 1/r12 k(r2) l(r2)
END_DOC
implicit none
include 'utils/constants.include.F'
integer, intent(in) :: i, j, k, l
integer :: p, q, r, s
integer :: num_i, num_j, num_k, num_l, dim1, I_power(3), J_power(3), K_power(3), L_power(3)
integer :: iorder_p1(3), iorder_p2(3), iorder_q1(3), iorder_q2(3)
complex*16 :: I_center(3), J_center(3), K_center(3), L_center(3)
complex*16 :: expo1, expo2, expo3, expo4
complex*16 :: P1_center(3), pp1
complex*16 :: P2_center(3), pp2
complex*16 :: Q1_center(3), qq1
complex*16 :: Q2_center(3), qq2
dim1 = n_pt_max_integrals
num_i = ao_nucl(i)
num_j = ao_nucl(j)
num_k = ao_nucl(k)
num_l = ao_nucl(l)
if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then
!print*, ao_prim_num(i), ao_prim_num(j), ao_prim_num(k), ao_prim_num(l)
do p = 1, 3
I_power(p) = ao_power(i,p)
J_power(p) = ao_power(j,p)
K_power(p) = ao_power(k,p)
L_power(p) = ao_power(l,p)
I_center(p) = nucl_coord(num_i,p) * (1.d0, 0.d0)
J_center(p) = nucl_coord(num_j,p) * (1.d0, 0.d0)
K_center(p) = nucl_coord(num_k,p) * (1.d0, 0.d0)
L_center(p) = nucl_coord(num_l,p) * (1.d0, 0.d0)
enddo
do p = 1, ao_prim_num(i)
expo1 = ao_expo_ord_transp_cgtos(p,i)
!print*, "expo1 = ", expo1
!print*, "center1 = ", I_center
do q = 1, ao_prim_num(j)
expo2 = ao_expo_ord_transp_cgtos(q,j)
!print*, "expo2 = ", expo2
!print*, "center2 = ", J_center
pp1 = expo1 + expo2
P1_center(1:3) = (expo1 * I_center(1:3) + expo2 * J_center(1:3)) / pp1
iorder_p1(1:3) = I_power(1:3) + J_power(1:3)
pp2 = conjg(expo1) + expo2
P2_center(1:3) = (conjg(expo1) * I_center(1:3) + expo2 * J_center(1:3)) / pp2
iorder_p2(1:3) = I_power(1:3) + J_power(1:3)
do r = 1, ao_prim_num(k)
expo3 = ao_expo_ord_transp_cgtos(r,k)
!print*, "expo3 = ", expo3
!print*, "center3 = ", K_center
do s = 1, ao_prim_num(l)
expo4 = ao_expo_ord_transp_cgtos(s,l)
!print*, "expo4 = ", expo4
!print*, "center4 = ", L_center
qq1 = expo3 + expo4
Q1_center(1:3) = (expo3 * K_center(1:3) + expo4 * L_center(1:3)) / qq1
iorder_q1(1:3) = K_power(1:3) + L_power(1:3)
qq2 = conjg(expo3) + expo4
Q2_center(1:3) = (conjg(expo3) * K_center(1:3) + expo4 * L_center(1:3)) / qq2
iorder_q2(1:3) = K_power(1:3) + L_power(1:3)
call deb_cboys(P1_center, pp1, iorder_p1, Q1_center, qq1, iorder_q1)
call deb_cboys(P1_center, pp1, iorder_p1, Q2_center, qq2, iorder_q2)
call deb_cboys(P2_center, pp2, iorder_p2, Q1_center, qq1, iorder_q1)
call deb_cboys(P2_center, pp2, iorder_p2, Q2_center, qq2, iorder_q2)
call deb_cboys(conjg(P2_center), conjg(pp2), iorder_p2, Q1_center, qq1, iorder_q1)
call deb_cboys(conjg(P2_center), conjg(pp2), iorder_p2, Q2_center, qq2, iorder_q2)
call deb_cboys(conjg(P1_center), conjg(pp1), iorder_p1, Q1_center, qq1, iorder_q1)
call deb_cboys(conjg(P1_center), conjg(pp1), iorder_p1, Q2_center, qq2, iorder_q2)
enddo ! s
enddo ! r
enddo ! q
enddo ! p
endif ! same centers
return
end
! ---
subroutine deb_cboys(P_center, p, iorder_p, Q_center, q, iorder_q)
implicit none
include 'utils/constants.include.F'
integer, intent(in) :: iorder_p(3), iorder_q(3)
complex*16, intent(in) :: P_center(3), p
complex*16, intent(in) :: Q_center(3), q
integer :: iorder, n
complex*16 :: dist, rho
complex*16 :: int1, int2
complex*16, external :: crint_2
dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
+ (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
+ (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
rho = dist * p * q / (p + q)
if(abs(rho) .lt. 1d-15) return
iorder = 2*iorder_p(1)+2*iorder_q(1) + 2*iorder_p(2)+2*iorder_q(2) + 2*iorder_p(3)+2*iorder_q(3)
n = shiftr(iorder, 1)
!write(33,*) n, real(rho), aimag(rho)
!print*, n, real(rho), aimag(rho)
int1 = crint_2(n, rho)
call crint_quad_12(n, rho, 1000000, int2)
if(abs(int1 - int2) .gt. 1d-5) then
print*, ' important error found: '
print*, p!, P_center
print*, q!, Q_center
print*, dist
print*, " n, tho = ", n, real(rho), aimag(rho)
print*, real(int1), real(int2), dabs(real(int1-int2))
print*, aimag(int1), aimag(int2), dabs(aimag(int1-int2))
stop
endif
end
! ---

2
src/ao_two_e_ints/screening.irp.f
View File

@ -3,7 +3,7 @@ logical function ao_two_e_integral_zero(i,j,k,l)
integer, intent(in) :: i,j,k,l
ao_two_e_integral_zero = .False.
if (.not.(read_ao_two_e_integrals.or.is_periodic.or.use_cosgtos)) then
if (.not.(read_ao_two_e_integrals.or.is_periodic.or.use_cgtos)) then
if (ao_overlap_abs(j,l)*ao_overlap_abs(i,k) < ao_integrals_threshold) then
ao_two_e_integral_zero = .True.
return

340
src/ao_two_e_ints/two_e_Coul_integrals_cosgtos.irp.f → src/ao_two_e_ints/two_e_Coul_integrals_cgtos.irp.f
View File

@ -1,7 +1,7 @@
! ---
double precision function ao_two_e_integral_cosgtos(i, j, k, l)
double precision function ao_two_e_integral_cgtos(i, j, k, l)
BEGIN_DOC
! integral of the AO basis <ik|jl> or (ij|kl)
@ -27,13 +27,13 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
complex*16 :: integral5, integral6, integral7, integral8
complex*16 :: integral_tot
double precision, external :: ao_2e_cosgtos_schwartz_accel
complex*16, external :: ERI_cosgtos
complex*16, external :: general_primitive_integral_cosgtos
double precision, external :: ao_2e_cgtos_schwartz_accel
complex*16, external :: ERI_cgtos
complex*16, external :: general_primitive_integral_cgtos
if(ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024) then
ao_two_e_integral_cosgtos = ao_2e_cosgtos_schwartz_accel(i, j, k, l)
ao_two_e_integral_cgtos = ao_2e_cgtos_schwartz_accel(i, j, k, l)
else
@ -44,7 +44,7 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
num_k = ao_nucl(k)
num_l = ao_nucl(l)
ao_two_e_integral_cosgtos = 0.d0
ao_two_e_integral_cgtos = 0.d0
if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then
@ -60,12 +60,12 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
enddo
do p = 1, ao_prim_num(i)
coef1 = ao_coef_norm_ord_transp_cosgtos(p,i)
expo1 = ao_expo_ord_transp_cosgtos(p,i)
coef1 = ao_coef_norm_ord_transp_cgtos(p,i)
expo1 = ao_expo_ord_transp_cgtos(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(q,j)
expo2 = ao_expo_ord_transp_cosgtos(q,j)
coef2 = coef1 * ao_coef_norm_ord_transp_cgtos(q,j)
expo2 = ao_expo_ord_transp_cgtos(q,j)
call give_explicit_cpoly_and_cgaussian(P1_new, P1_center, pp1, fact_p1, iorder_p1, &
expo1, expo2, I_power, J_power, I_center, J_center, dim1)
@ -76,12 +76,12 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
p2_inv = (1.d0, 0.d0) / pp2
do r = 1, ao_prim_num(k)
coef3 = coef2 * ao_coef_norm_ord_transp_cosgtos(r,k)
expo3 = ao_expo_ord_transp_cosgtos(r,k)
coef3 = coef2 * ao_coef_norm_ord_transp_cgtos(r,k)
expo3 = ao_expo_ord_transp_cgtos(r,k)
do s = 1, ao_prim_num(l)
coef4 = coef3 * ao_coef_norm_ord_transp_cosgtos(s,l)
expo4 = ao_expo_ord_transp_cosgtos(s,l)
coef4 = coef3 * ao_coef_norm_ord_transp_cgtos(s,l)
expo4 = ao_expo_ord_transp_cgtos(s,l)
call give_explicit_cpoly_and_cgaussian(Q1_new, Q1_center, qq1, fact_q1, iorder_q1, &
expo3, expo4, K_power, L_power, K_center, L_center, dim1)
@ -91,41 +91,41 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
conjg(expo3), expo4, K_power, L_power, K_center, L_center, dim1)
q2_inv = (1.d0, 0.d0) / qq2
integral1 = general_primitive_integral_cosgtos(dim1, &
integral1 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral2 = general_primitive_integral_cosgtos(dim1, &
integral2 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral3 = general_primitive_integral_cosgtos(dim1, &
integral3 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral4 = general_primitive_integral_cosgtos(dim1, &
integral4 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral5 = general_primitive_integral_cosgtos(dim1, &
integral5 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral6 = general_primitive_integral_cosgtos(dim1, &
integral6 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral7 = general_primitive_integral_cosgtos(dim1, &
integral7 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral8 = general_primitive_integral_cosgtos(dim1, &
integral8 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
ao_two_e_integral_cosgtos = ao_two_e_integral_cosgtos + coef4 * 2.d0 * real(integral_tot)
ao_two_e_integral_cgtos = ao_two_e_integral_cgtos + coef4 * 2.d0 * real(integral_tot)
enddo ! s
enddo ! r
enddo ! q
@ -141,57 +141,57 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
enddo
do p = 1, ao_prim_num(i)
coef1 = ao_coef_norm_ord_transp_cosgtos(p,i)
expo1 = ao_expo_ord_transp_cosgtos(p,i)
coef1 = ao_coef_norm_ord_transp_cgtos(p,i)
expo1 = ao_expo_ord_transp_cgtos(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(q,j)
expo2 = ao_expo_ord_transp_cosgtos(q,j)
coef2 = coef1 * ao_coef_norm_ord_transp_cgtos(q,j)
expo2 = ao_expo_ord_transp_cgtos(q,j)
do r = 1, ao_prim_num(k)
coef3 = coef2 * ao_coef_norm_ord_transp_cosgtos(r,k)
expo3 = ao_expo_ord_transp_cosgtos(r,k)
coef3 = coef2 * ao_coef_norm_ord_transp_cgtos(r,k)
expo3 = ao_expo_ord_transp_cgtos(r,k)
do s = 1, ao_prim_num(l)
coef4 = coef3 * ao_coef_norm_ord_transp_cosgtos(s,l)
expo4 = ao_expo_ord_transp_cosgtos(s,l)
coef4 = coef3 * ao_coef_norm_ord_transp_cgtos(s,l)
expo4 = ao_expo_ord_transp_cgtos(s,l)
integral1 = ERI_cosgtos(expo1, expo2, expo3, expo4, &
integral1 = ERI_cgtos(expo1, expo2, expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral2 = ERI_cosgtos(expo1, expo2, conjg(expo3), expo4, &
integral2 = ERI_cgtos(expo1, expo2, conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral3 = ERI_cosgtos(conjg(expo1), expo2, expo3, expo4, &
integral3 = ERI_cgtos(conjg(expo1), expo2, expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo3), expo4, &
integral4 = ERI_cgtos(conjg(expo1), expo2, conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral5 = ERI_cosgtos(expo1, conjg(expo2), expo3, expo4, &
integral5 = ERI_cgtos(expo1, conjg(expo2), expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo3), expo4, &
integral6 = ERI_cgtos(expo1, conjg(expo2), conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo3, expo4, &
integral7 = ERI_cgtos(conjg(expo1), conjg(expo2), expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo3), expo4, &
integral8 = ERI_cgtos(conjg(expo1), conjg(expo2), conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
@ -199,7 +199,7 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
ao_two_e_integral_cosgtos = ao_two_e_integral_cosgtos + coef4 * 2.d0 * real(integral_tot)
ao_two_e_integral_cgtos = ao_two_e_integral_cgtos + coef4 * 2.d0 * real(integral_tot)
enddo ! s
enddo ! r
enddo ! q
@ -212,7 +212,7 @@ end
! ---
double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
double precision function ao_2e_cgtos_schwartz_accel(i, j, k, l)
BEGIN_DOC
! integral of the AO basis <ik|jl> or (ij|kl)
@ -242,10 +242,10 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
double precision :: thr
double precision :: schwartz_ij
complex*16, external :: ERI_cosgtos
complex*16, external :: general_primitive_integral_cosgtos
complex*16, external :: ERI_cgtos
complex*16, external :: general_primitive_integral_cgtos
ao_2e_cosgtos_schwartz_accel = 0.d0
ao_2e_cgtos_schwartz_accel = 0.d0
dim1 = n_pt_max_integrals
@ -274,13 +274,13 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
schwartz_kl(0,0) = 0.d0
do r = 1, ao_prim_num(k)
coef1 = ao_coef_norm_ord_transp_cosgtos(r,k) * ao_coef_norm_ord_transp_cosgtos(r,k)
expo1 = ao_expo_ord_transp_cosgtos(r,k)
coef1 = ao_coef_norm_ord_transp_cgtos(r,k) * ao_coef_norm_ord_transp_cgtos(r,k)
expo1 = ao_expo_ord_transp_cgtos(r,k)
schwartz_kl(0,r) = 0.d0
do s = 1, ao_prim_num(l)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(s,l) * ao_coef_norm_ord_transp_cosgtos(s,l)
expo2 = ao_expo_ord_transp_cosgtos(s,l)
coef2 = coef1 * ao_coef_norm_ord_transp_cgtos(s,l) * ao_coef_norm_ord_transp_cgtos(s,l)
expo2 = ao_expo_ord_transp_cgtos(s,l)
call give_explicit_cpoly_and_cgaussian(P1_new, P1_center, pp1, fact_p1, iorder_p1, &
expo1, expo2, K_power, L_power, K_center, L_center, dim1)
@ -290,35 +290,35 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
conjg(expo1), expo2, K_power, L_power, K_center, L_center, dim1)
p2_inv = (1.d0, 0.d0) / pp2
integral1 = general_primitive_integral_cosgtos(dim1, &
integral1 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral2 = general_primitive_integral_cosgtos(dim1, &
integral2 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral3 = general_primitive_integral_cosgtos(dim1, &
integral3 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral4 = general_primitive_integral_cosgtos(dim1, &
integral4 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral5 = general_primitive_integral_cosgtos(dim1, &
integral5 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral6 = general_primitive_integral_cosgtos(dim1, &
integral6 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral7 = general_primitive_integral_cosgtos(dim1, &
integral7 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral8 = general_primitive_integral_cosgtos(dim1, &
integral8 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
@ -334,12 +334,12 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
do p = 1, ao_prim_num(i)
coef1 = ao_coef_norm_ord_transp_cosgtos(p,i)
expo1 = ao_expo_ord_transp_cosgtos(p,i)
coef1 = ao_coef_norm_ord_transp_cgtos(p,i)
expo1 = ao_expo_ord_transp_cgtos(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(q,j)
expo2 = ao_expo_ord_transp_cosgtos(q,j)
coef2 = coef1 * ao_coef_norm_ord_transp_cgtos(q,j)
expo2 = ao_expo_ord_transp_cgtos(q,j)
call give_explicit_cpoly_and_cgaussian(P1_new, P1_center, pp1, fact_p1, iorder_p1, &
expo1, expo2, I_power, J_power, I_center, J_center, dim1)
@ -349,35 +349,35 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
conjg(expo1), expo2, I_power, J_power, I_center, J_center, dim1)
p2_inv = (1.d0, 0.d0) / pp2
integral1 = general_primitive_integral_cosgtos(dim1, &
integral1 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral2 = general_primitive_integral_cosgtos(dim1, &
integral2 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral3 = general_primitive_integral_cosgtos(dim1, &
integral3 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral4 = general_primitive_integral_cosgtos(dim1, &
integral4 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral5 = general_primitive_integral_cosgtos(dim1, &
integral5 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral6 = general_primitive_integral_cosgtos(dim1, &
integral6 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral7 = general_primitive_integral_cosgtos(dim1, &
integral7 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral8 = general_primitive_integral_cosgtos(dim1, &
integral8 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
@ -390,14 +390,14 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
do r = 1, ao_prim_num(k)
if(schwartz_kl(0,r)*schwartz_ij < thr) cycle
coef3 = coef2 * ao_coef_norm_ord_transp_cosgtos(r,k)
expo3 = ao_expo_ord_transp_cosgtos(r,k)
coef3 = coef2 * ao_coef_norm_ord_transp_cgtos(r,k)
expo3 = ao_expo_ord_transp_cgtos(r,k)
do s = 1, ao_prim_num(l)
if(schwartz_kl(s,r)*schwartz_ij < thr) cycle
coef4 = coef3 * ao_coef_norm_ord_transp_cosgtos(s,l)
expo4 = ao_expo_ord_transp_cosgtos(s,l)
coef4 = coef3 * ao_coef_norm_ord_transp_cgtos(s,l)
expo4 = ao_expo_ord_transp_cgtos(s,l)
call give_explicit_cpoly_and_cgaussian(Q1_new, Q1_center, qq1, fact_q1, iorder_q1, &
expo3, expo4, K_power, L_power, K_center, L_center, dim1)
@ -407,41 +407,41 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
conjg(expo3), expo4, K_power, L_power, K_center, L_center, dim1)
q2_inv = (1.d0, 0.d0) / qq2
integral1 = general_primitive_integral_cosgtos(dim1, &
integral1 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral2 = general_primitive_integral_cosgtos(dim1, &
integral2 = general_primitive_integral_cgtos(dim1, &
P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral3 = general_primitive_integral_cosgtos(dim1, &
integral3 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral4 = general_primitive_integral_cosgtos(dim1, &
integral4 = general_primitive_integral_cgtos(dim1, &
P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral5 = general_primitive_integral_cosgtos(dim1, &
integral5 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral6 = general_primitive_integral_cosgtos(dim1, &
integral6 = general_primitive_integral_cgtos(dim1, &
conjg(P2_new), conjg(P2_center), conjg(fact_p2), conjg(pp2), conjg(p2_inv), iorder_p2, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral7 = general_primitive_integral_cosgtos(dim1, &
integral7 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q1)
integral8 = general_primitive_integral_cosgtos(dim1, &
integral8 = general_primitive_integral_cgtos(dim1, &
conjg(P1_new), conjg(P1_center), conjg(fact_p1), conjg(pp1), conjg(p1_inv), iorder_p1, &
Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q2)
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
ao_2e_cosgtos_schwartz_accel = ao_2e_cosgtos_schwartz_accel + coef4 * 2.d0 * real(integral_tot)
ao_2e_cgtos_schwartz_accel = ao_2e_cgtos_schwartz_accel + coef4 * 2.d0 * real(integral_tot)
enddo ! s
enddo ! r
enddo ! q
@ -458,50 +458,50 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
schwartz_kl(0,0) = 0.d0
do r = 1, ao_prim_num(k)
coef1 = ao_coef_norm_ord_transp_cosgtos(r,k) * ao_coef_norm_ord_transp_cosgtos(r,k)
expo1 = ao_expo_ord_transp_cosgtos(r,k)
coef1 = ao_coef_norm_ord_transp_cgtos(r,k) * ao_coef_norm_ord_transp_cgtos(r,k)
expo1 = ao_expo_ord_transp_cgtos(r,k)
schwartz_kl(0,r) = 0.d0
do s = 1, ao_prim_num(l)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(s,l) * ao_coef_norm_ord_transp_cosgtos(s,l)
expo2 = ao_expo_ord_transp_cosgtos(s,l)
coef2 = coef1 * ao_coef_norm_ord_transp_cgtos(s,l) * ao_coef_norm_ord_transp_cgtos(s,l)
expo2 = ao_expo_ord_transp_cgtos(s,l)
integral1 = ERI_cosgtos(expo1, expo2, expo1, expo2, &
integral1 = ERI_cgtos(expo1, expo2, expo1, expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral2 = ERI_cosgtos(expo1, expo2, conjg(expo1), expo2, &
integral2 = ERI_cgtos(expo1, expo2, conjg(expo1), expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral3 = ERI_cosgtos(conjg(expo1), expo2, expo1, expo2, &
integral3 = ERI_cgtos(conjg(expo1), expo2, expo1, expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo1), expo2, &
integral4 = ERI_cgtos(conjg(expo1), expo2, conjg(expo1), expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral5 = ERI_cosgtos(expo1, conjg(expo2), expo1, expo2, &
integral5 = ERI_cgtos(expo1, conjg(expo2), expo1, expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo1), expo2, &
integral6 = ERI_cgtos(expo1, conjg(expo2), conjg(expo1), expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo1, expo2, &
integral7 = ERI_cgtos(conjg(expo1), conjg(expo2), expo1, expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo1), expo2, &
integral8 = ERI_cgtos(conjg(expo1), conjg(expo2), conjg(expo1), expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
@ -517,49 +517,49 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
enddo
do p = 1, ao_prim_num(i)
coef1 = ao_coef_norm_ord_transp_cosgtos(p,i)
expo1 = ao_expo_ord_transp_cosgtos(p,i)
coef1 = ao_coef_norm_ord_transp_cgtos(p,i)
expo1 = ao_expo_ord_transp_cgtos(p,i)
do q = 1, ao_prim_num(j)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(q,j)
expo2 = ao_expo_ord_transp_cosgtos(q,j)
coef2 = coef1 * ao_coef_norm_ord_transp_cgtos(q,j)
expo2 = ao_expo_ord_transp_cgtos(q,j)
integral1 = ERI_cosgtos(expo1, expo2, expo1, expo2, &
integral1 = ERI_cgtos(expo1, expo2, expo1, expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral2 = ERI_cosgtos(expo1, expo2, conjg(expo1), expo2, &
integral2 = ERI_cgtos(expo1, expo2, conjg(expo1), expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral3 = ERI_cosgtos(conjg(expo1), expo2, expo1, expo2, &
integral3 = ERI_cgtos(conjg(expo1), expo2, expo1, expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo1), expo2, &
integral4 = ERI_cgtos(conjg(expo1), expo2, conjg(expo1), expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral5 = ERI_cosgtos(expo1, conjg(expo2), expo1, expo2, &
integral5 = ERI_cgtos(expo1, conjg(expo2), expo1, expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo1), expo2, &
integral6 = ERI_cgtos(expo1, conjg(expo2), conjg(expo1), expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo1, expo2, &
integral7 = ERI_cgtos(conjg(expo1), conjg(expo2), expo1, expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo1), expo2, &
integral8 = ERI_cgtos(conjg(expo1), conjg(expo2), conjg(expo1), expo2, &
I_power(1), J_power(1), I_power(1), J_power(1), &
I_power(2), J_power(2), I_power(2), J_power(2), &
I_power(3), J_power(3), I_power(3), J_power(3))
@ -572,58 +572,58 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
do r = 1, ao_prim_num(k)
if(schwartz_kl(0,r)*schwartz_ij < thr) cycle
coef3 = coef2 * ao_coef_norm_ord_transp_cosgtos(r,k)
expo3 = ao_expo_ord_transp_cosgtos(r,k)
coef3 = coef2 * ao_coef_norm_ord_transp_cgtos(r,k)
expo3 = ao_expo_ord_transp_cgtos(r,k)
do s = 1, ao_prim_num(l)
if(schwartz_kl(s,r)*schwartz_ij < thr) cycle
coef4 = coef3 * ao_coef_norm_ord_transp_cosgtos(s,l)
expo4 = ao_expo_ord_transp_cosgtos(s,l)
coef4 = coef3 * ao_coef_norm_ord_transp_cgtos(s,l)
expo4 = ao_expo_ord_transp_cgtos(s,l)
integral1 = ERI_cosgtos(expo1, expo2, expo3, expo4, &
integral1 = ERI_cgtos(expo1, expo2, expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral2 = ERI_cosgtos(expo1, expo2, conjg(expo3), expo4, &
integral2 = ERI_cgtos(expo1, expo2, conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral3 = ERI_cosgtos(conjg(expo1), expo2, expo3, expo4, &
integral3 = ERI_cgtos(conjg(expo1), expo2, expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo3), expo4, &
integral4 = ERI_cgtos(conjg(expo1), expo2, conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral5 = ERI_cosgtos(expo1, conjg(expo2), expo3, expo4, &
integral5 = ERI_cgtos(expo1, conjg(expo2), expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo3), expo4, &
integral6 = ERI_cgtos(expo1, conjg(expo2), conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo3, expo4, &
integral7 = ERI_cgtos(conjg(expo1), conjg(expo2), expo3, expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo3), expo4, &
integral8 = ERI_cgtos(conjg(expo1), conjg(expo2), conjg(expo3), expo4, &
I_power(1), J_power(1), K_power(1), L_power(1), &
I_power(2), J_power(2), K_power(2), L_power(2), &
I_power(3), J_power(3), K_power(3), L_power(3))
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
ao_2e_cosgtos_schwartz_accel = ao_2e_cosgtos_schwartz_accel + coef4 * 2.d0 * real(integral_tot)
ao_2e_cgtos_schwartz_accel = ao_2e_cgtos_schwartz_accel + coef4 * 2.d0 * real(integral_tot)
enddo ! s
enddo ! r
enddo ! q
@ -637,7 +637,7 @@ end
! ---
BEGIN_PROVIDER [double precision, ao_2e_cosgtos_schwartz, (ao_num, ao_num)]
BEGIN_PROVIDER [double precision, ao_2e_cgtos_schwartz, (ao_num, ao_num)]
BEGIN_DOC
! Needed to compute Schwartz inequalities
@ -645,18 +645,18 @@ BEGIN_PROVIDER [double precision, ao_2e_cosgtos_schwartz, (ao_num, ao_num)]
implicit none
integer :: i, k
double precision :: ao_two_e_integral_cosgtos
double precision :: ao_two_e_integral_cgtos
ao_2e_cosgtos_schwartz(1,1) = ao_two_e_integral_cosgtos(1, 1, 1, 1)
ao_2e_cgtos_schwartz(1,1) = ao_two_e_integral_cgtos(1, 1, 1, 1)
!$OMP PARALLEL DO PRIVATE(i,k) &
!$OMP DEFAULT(NONE) &
!$OMP SHARED(ao_num, ao_2e_cosgtos_schwartz) &
!$OMP SHARED(ao_num, ao_2e_cgtos_schwartz) &
!$OMP SCHEDULE(dynamic)
do i = 1, ao_num
do k = 1, i
ao_2e_cosgtos_schwartz(i,k) = dsqrt(ao_two_e_integral_cosgtos(i, i, k, k))
ao_2e_cosgtos_schwartz(k,i) = ao_2e_cosgtos_schwartz(i,k)
ao_2e_cgtos_schwartz(i,k) = dsqrt(ao_two_e_integral_cgtos(i, i, k, k))
ao_2e_cgtos_schwartz(k,i) = ao_2e_cgtos_schwartz(i,k)
enddo
enddo
!$OMP END PARALLEL DO
@ -665,7 +665,7 @@ END_PROVIDER
! ---
complex*16 function general_primitive_integral_cosgtos(dim, P_new, P_center, fact_p, p, p_inv, iorder_p, &
complex*16 function general_primitive_integral_cgtos(dim, P_new, P_center, fact_p, p, p_inv, iorder_p, &
Q_new, Q_center, fact_q, q, q_inv, iorder_q)
BEGIN_DOC
@ -697,7 +697,7 @@ complex*16 function general_primitive_integral_cosgtos(dim, P_new, P_center, fac
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
general_primitive_integral_cosgtos = (0.d0, 0.d0)
general_primitive_integral_cgtos = (0.d0, 0.d0)
pq = (0.5d0, 0.d0) * p_inv * q_inv
pq_inv = (0.5d0, 0.d0) / (p + q)
@ -832,13 +832,13 @@ complex*16 function general_primitive_integral_cosgtos(dim, P_new, P_center, fac
accu = crint_sum_2(n_pt_out, const, d1)
general_primitive_integral_cosgtos = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / sq_ppq
general_primitive_integral_cgtos = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / sq_ppq
end
! ---
complex*16 function ERI_cosgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_z, b_z, c_z, d_z)
complex*16 function ERI_cgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_z, b_z, c_z, d_z)
BEGIN_DOC
! ATOMIC PRIMTIVE two-electron integral between the 4 primitives ::
@ -860,7 +860,7 @@ complex*16 function ERI_cosgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_
double precision :: ppq_re, ppq_im, ppq_mod, sq_ppq_re, sq_ppq_im
complex*16 :: p, q, ppq, sq_ppq, coeff, I_f
ERI_cosgtos = (0.d0, 0.d0)
ERI_cgtos = (0.d0, 0.d0)
ASSERT (REAL(alpha) >= 0.d0)
ASSERT (REAL(beta ) >= 0.d0)
@ -869,19 +869,19 @@ complex*16 function ERI_cosgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_
nx = a_x + b_x + c_x + d_x
if(iand(nx,1) == 1) then
ERI_cosgtos = (0.d0, 0.d0)
ERI_cgtos = (0.d0, 0.d0)
return
endif
ny = a_y + b_y + c_y + d_y
if(iand(ny,1) == 1) then
ERI_cosgtos = (0.d0, 0.d0)
ERI_cgtos = (0.d0, 0.d0)
return
endif
nz = a_z + b_z + c_z + d_z
if(iand(nz,1) == 1) then
ERI_cosgtos = (0.d0, 0.d0)
ERI_cgtos = (0.d0, 0.d0)
return
endif
@ -902,19 +902,19 @@ complex*16 function ERI_cosgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_
coeff = pi_5_2 / (p * q * sq_ppq)
if(n_pt == 0) then
ERI_cosgtos = coeff
ERI_cgtos = coeff
return
endif
call integrale_new_cosgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_z, b_z, c_z, d_z, p, q, n_pt)
call integrale_new_cgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_z, b_z, c_z, d_z, p, q, n_pt)
ERI_cosgtos = I_f * coeff
ERI_cgtos = I_f * coeff
end
! ---
subroutine integrale_new_cosgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_z, b_z, c_z, d_z, p, q, n_pt)
subroutine integrale_new_cgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_z, b_z, c_z, d_z, p, q, n_pt)
BEGIN_DOC
! Calculates the integral of the polynomial :
@ -966,7 +966,7 @@ subroutine integrale_new_cosgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_
enddo
if(sx > 0) then
call I_x1_new_cosgtos(ix, jx, B10, B01, B00, t1, n_pt)
call I_x1_new_cgtos(ix, jx, B10, B01, B00, t1, n_pt)
else
do i = 1, n_pt
t1(i) = (1.d0, 0.d0)
@ -974,14 +974,14 @@ subroutine integrale_new_cosgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_
endif
if(sy > 0) then
call I_x1_new_cosgtos(iy, jy, B10, B01, B00, t2, n_pt)
call I_x1_new_cgtos(iy, jy, B10, B01, B00, t2, n_pt)
do i = 1, n_pt
t1(i) = t1(i) * t2(i)
enddo
endif
if(sz > 0) then
call I_x1_new_cosgtos(iz, jz, B10, B01, B00, t2, n_pt)
call I_x1_new_cgtos(iz, jz, B10, B01, B00, t2, n_pt)
do i = 1, n_pt
t1(i) = t1(i) * t2(i)
enddo
@ -996,7 +996,7 @@ end
! ---
recursive subroutine I_x1_new_cosgtos(a, c, B_10, B_01, B_00, res, n_pt)
recursive subroutine I_x1_new_cgtos(a, c, B_10, B_01, B_00, res, n_pt)
BEGIN_DOC
! recursive function involved in the two-electron integral
@ -1020,19 +1020,19 @@ recursive subroutine I_x1_new_cosgtos(a, c, B_10, B_01, B_00, res, n_pt)
else if (a == 0) then
call I_x2_new_cosgtos(c, B_10, B_01, B_00, res, n_pt)
call I_x2_new_cgtos(c, B_10, B_01, B_00, res, n_pt)
else if (a == 1) then
call I_x2_new_cosgtos(c-1, B_10, B_01, B_00, res, n_pt)
call I_x2_new_cgtos(c-1, B_10, B_01, B_00, res, n_pt)
do i = 1, n_pt
res(i) = dble(c) * B_00(i) * res(i)
enddo
else
call I_x1_new_cosgtos(a-2, c , B_10, B_01, B_00, res , n_pt)
call I_x1_new_cosgtos(a-1, c-1, B_10, B_01, B_00, res2, n_pt)
call I_x1_new_cgtos(a-2, c , B_10, B_01, B_00, res , n_pt)
call I_x1_new_cgtos(a-1, c-1, B_10, B_01, B_00, res2, n_pt)
do i = 1, n_pt
res(i) = dble(a-1) * B_10(i) * res(i) + dble(c) * B_00(i) * res2(i)
enddo
@ -1043,7 +1043,7 @@ end
! ---
recursive subroutine I_x2_new_cosgtos(c, B_10, B_01, B_00, res, n_pt)
recursive subroutine I_x2_new_cgtos(c, B_10, B_01, B_00, res, n_pt)
BEGIN_DOC
! recursive function involved in the two-electron integral
@ -1072,7 +1072,7 @@ recursive subroutine I_x2_new_cosgtos(c, B_10, B_01, B_00, res, n_pt)
else
call I_x1_new_cosgtos(0, c-2, B_10, B_01, B_00, res, n_pt)
call I_x1_new_cgtos(0, c-2, B_10, B_01, B_00, res, n_pt)
do i = 1, n_pt
res(i) = dble(c-1) * B_01(i) * res(i)
enddo
@ -1133,7 +1133,7 @@ subroutine give_cpolynom_mult_center_x(P_center, Q_center, a_x, d_x, p, q, n_pt_
n_pt1 = n_pt_in
!DIR$ FORCEINLINE
call I_x1_pol_mult_cosgtos(a_x, d_x, B10, B01, B00, C00, D00, d, n_pt1, n_pt_in)
call I_x1_pol_mult_cgtos(a_x, d_x, B10, B01, B00, C00, D00, d, n_pt1, n_pt_in)
n_pt_out = n_pt1
if(n_pt1 < 0) then
@ -1148,7 +1148,7 @@ end
! ---
subroutine I_x1_pol_mult_cosgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
subroutine I_x1_pol_mult_cgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
BEGIN_DOC
! Recursive function involved in the two-electron integral
@ -1165,11 +1165,11 @@ subroutine I_x1_pol_mult_cosgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt
if( (c >= 0) .and. (nd >= 0) ) then
if(a == 1) then
call I_x1_pol_mult_a1_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
call I_x1_pol_mult_a1_cgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
else if(a == 2) then
call I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
call I_x1_pol_mult_a2_cgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
else if(a > 2) then
call I_x1_pol_mult_recurs_cosgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
call I_x1_pol_mult_recurs_cgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
else ! a == 0
if(c == 0)then
@ -1178,7 +1178,7 @@ subroutine I_x1_pol_mult_cosgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt
return
endif
call I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
call I_x2_pol_mult_cgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
endif
else
@ -1191,7 +1191,7 @@ end
! ---
recursive subroutine I_x1_pol_mult_recurs_cosgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
recursive subroutine I_x1_pol_mult_recurs_cgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
BEGIN_DOC
! Recursive function involved in the two-electron integral
@ -1219,12 +1219,12 @@ recursive subroutine I_x1_pol_mult_recurs_cosgtos(a, c, B_10, B_01, B_00, C_00,
nx = 0
if(a == 3) then
call I_x1_pol_mult_a1_cosgtos(c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x1_pol_mult_a1_cgtos(c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
elseif(a == 4) then
call I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x1_pol_mult_a2_cgtos(c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
else
ASSERT (a >= 5)
call I_x1_pol_mult_recurs_cosgtos(a-2, c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x1_pol_mult_recurs_cgtos(a-2, c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
endif
!DIR$ LOOP COUNT(8)
@ -1244,10 +1244,10 @@ recursive subroutine I_x1_pol_mult_recurs_cosgtos(a, c, B_10, B_01, B_00, C_00,
if(c > 0) then
if(a == 3) then
call I_x1_pol_mult_a2_cosgtos(c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x1_pol_mult_a2_cgtos(c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
else
ASSERT(a >= 4)
call I_x1_pol_mult_recurs_cosgtos(a-1, c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x1_pol_mult_recurs_cgtos(a-1, c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
endif
if(c > 1) then
@ -1271,10 +1271,10 @@ recursive subroutine I_x1_pol_mult_recurs_cosgtos(a, c, B_10, B_01, B_00, C_00,
ASSERT (a > 2)
if(a == 3) then
call I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
call I_x1_pol_mult_a2_cgtos(c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
else
ASSERT(a >= 4)
call I_x1_pol_mult_recurs_cosgtos(a-1, c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
call I_x1_pol_mult_recurs_cgtos(a-1, c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
endif
!DIR$ FORCEINLINE
@ -1284,7 +1284,7 @@ end
! ---
recursive subroutine I_x1_pol_mult_a1_cosgtos(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
recursive subroutine I_x1_pol_mult_a1_cgtos(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
BEGIN_DOC
! Recursive function involved in the two-electron integral
@ -1313,7 +1313,7 @@ recursive subroutine I_x1_pol_mult_a1_cosgtos(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_
do ix = 0, n_pt_in
X(ix) = (0.d0, 0.d0)
enddo
call I_x2_pol_mult_cosgtos(c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x2_pol_mult_cgtos(c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
if(c > 1) then
!DIR$ LOOP COUNT(8)
@ -1331,7 +1331,7 @@ recursive subroutine I_x1_pol_mult_a1_cosgtos(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_
do ix = 0, n_pt_in
Y(ix) = (0.d0, 0.d0)
enddo
call I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
call I_x2_pol_mult_cgtos(c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
!DIR$ FORCEINLINE
call multiply_cpoly(Y, ny, C_00, 2, d, nd)
@ -1340,7 +1340,7 @@ end
! ---
recursive subroutine I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
recursive subroutine I_x1_pol_mult_a2_cgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt_in)
BEGIN_DOC
! Recursive function involved in the two-electron integral
@ -1365,7 +1365,7 @@ recursive subroutine I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d
enddo
nx = 0
call I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x2_pol_mult_cgtos(c, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
!DIR$ FORCEINLINE
call multiply_cpoly(X, nx, B_10, 2, d, nd)
@ -1377,7 +1377,7 @@ recursive subroutine I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d
enddo
!DIR$ FORCEINLINE
call I_x1_pol_mult_a1_cosgtos(c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
call I_x1_pol_mult_a1_cgtos(c-1, B_10, B_01, B_00, C_00, D_00, X, nx, n_pt_in)
if (c>1) then
!DIR$ LOOP COUNT(8)
@ -1395,7 +1395,7 @@ recursive subroutine I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d
Y(ix) = 0.d0
enddo
!DIR$ FORCEINLINE
call I_x1_pol_mult_a1_cosgtos(c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
call I_x1_pol_mult_a1_cgtos(c, B_10, B_01, B_00, C_00, D_00, Y, ny, n_pt_in)
!DIR$ FORCEINLINE
call multiply_cpoly(Y, ny, C_00, 2, d, nd)
@ -1404,7 +1404,7 @@ end
! ---
recursive subroutine I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, dim)
recursive subroutine I_x2_pol_mult_cgtos(c, B_10, B_01, B_00, C_00, D_00, d, nd, dim)
BEGIN_DOC
! Recursive function involved in the two-electron integral
@ -1463,7 +1463,7 @@ recursive subroutine I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, n
X(ix) = (0.d0, 0.d0)
enddo
nx = 0
call I_x2_pol_mult_cosgtos(c-2, B_10, B_01, B_00, C_00, D_00, X, nx, dim)
call I_x2_pol_mult_cgtos(c-2, B_10, B_01, B_00, C_00, D_00, X, nx, dim)
!DIR$ LOOP COUNT(6)
do ix = 0, nx
@ -1478,7 +1478,7 @@ recursive subroutine I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, n
do ix = 0, c+c
Y(ix) = 0.d0
enddo
call I_x2_pol_mult_cosgtos(c-1, B_10, B_01, B_00, C_00, D_00, Y, ny, dim)
call I_x2_pol_mult_cgtos(c-1, B_10, B_01, B_00, C_00, D_00, Y, ny, dim)
!DIR$ FORCEINLINE
call multiply_cpoly(Y, ny, D_00, 2, d, nd)

6
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -38,14 +38,14 @@ double precision function ao_two_e_integral(i, j, k, l)
double precision :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
double precision, external :: ao_two_e_integral_erf
double precision, external :: ao_two_e_integral_cosgtos
double precision, external :: ao_two_e_integral_cgtos
double precision, external :: ao_two_e_integral_schwartz_accel
logical, external :: do_schwartz_accel
if(use_cosgtos) then
if(use_cgtos) then
ao_two_e_integral = ao_two_e_integral_cosgtos(i, j, k, l)
ao_two_e_integral = ao_two_e_integral_cgtos(i, j, k, l)
else if (use_only_lr) then

59
src/hartree_fock/deb_ao_2e_int.irp.f
View File

@ -3,60 +3,65 @@ program deb_ao_2e_int
implicit none
!call check_ao_two_e_integral_cosgtos()
call check_ao_two_e_integral_cgtos()
!call check_crint1()
!call check_crint2()
call check_crint3()
!call check_crint3()
end
! ---
subroutine check_ao_two_e_integral_cosgtos()
subroutine check_ao_two_e_integral_cgtos()
implicit none
integer :: i, j, k, l
double precision :: acc, nrm, dif
double precision :: tmp1, tmp2
double precision :: pw, pw0
double precision :: t1, t2, tt
double precision, external :: ao_two_e_integral
double precision, external :: ao_two_e_integral_cosgtos
double precision, external :: ao_two_e_integral_cgtos
acc = 0.d0
nrm = 0.d0
!i = 11
!j = 100
!k = 74
!l = 104
pw0 = dble(ao_num**3)
pw = 0.d0
tt = 0.d0
do i = 1, ao_num
call wall_time(t1)
do j = 1, ao_num
do k = 1, ao_num
j = i
l = k
!do j = 1, ao_num
! do l = 1, ao_num
do l = 1, ao_num
tmp1 = ao_two_e_integral (i, j, k, l)
tmp2 = ao_two_e_integral_cosgtos(i, j, k, l)
call deb_ao_2eint_cgtos(i, j, k, l)
dif = abs(tmp1 - tmp2)
!if(dif .gt. 1d-10) then
if(tmp1 .lt. 0.d0) then
print*, ' error on:', i, j, k, l
print*, tmp1, tmp2, dif
!stop
endif
!endif
!tmp1 = ao_two_e_integral (i, j, k, l)
!tmp2 = ao_two_e_integral_cgtos(i, j, k, l)
acc += dif
nrm += abs(tmp1)
! enddo
! enddo
!print*, i, j, k, l
!dif = abs(tmp1 - tmp2)
!!if(dif .gt. 1d-10) then
! print*, ' error on:', i, j, k, l
! print*, tmp1, tmp2, dif
! !stop
!!endif
!acc += dif
!nrm += abs(tmp1)
enddo
enddo
enddo
call wall_time(t2)
tt += t2 - t1
print*, " % done = ", 100.d0 * dble(i) / ao_num
print*, ' ellepsed time (sec) =', tt
enddo
print *, ' acc (%) = ', dif * 100.d0 / nrm
!print *, ' acc (%) = ', dif * 100.d0 / nrm
end

2
src/utils/cgtos_utils.irp.f
View File

@ -101,7 +101,7 @@ subroutine give_explicit_cpoly_and_cgaussian(P_new, P_center, p, fact_k, iorder,
! IF fact_k is too smal then: returns a "s" function centered in zero
! with an inifinite exponent and a zero polynom coef
tmp_mod = dsqrt(REAL(fact_k)*REAL(fact_k) + AIMAG(fact_k)*AIMAG(fact_k))
tmp_mod = dsqrt(real(fact_k)*real(fact_k) + aimag(fact_k)*aimag(fact_k))
if(tmp_mod < 1d-14) then
iorder = 0
p = (1.d+14, 0.d0)

6
src/utils/cpx_boys.irp.f
View File

@ -408,9 +408,9 @@ complex*16 function crint_sum_2(n_pt_out, rho, d1)
n_max = shiftr(n_pt_out, 1)
allocate(vals(0:n_max))
call crint_2_vec(n_max, rho, vals)
!call crint_2_vec(n_max, rho, vals)
! FOR DEBUG
!call crint_quad_12_vec(n_max, rho, vals)
call crint_quad_12_vec(n_max, rho, vals)
crint_sum_2 = d1(0) * vals(0)
do i = 2, n_pt_out, 2
@ -859,7 +859,7 @@ subroutine crint_quad_12_vec(n_max, rho, vals)
double precision :: tmp, abs_rho
complex*16 :: rho2, rho3, erho
do n = 1, n_max
do n = 0, n_max
call crint_quad_12(n, rho, 10000000, vals(n))
enddo