LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-10-08 17:07:20 +02:00
Code Releases Activity

Merge branch 'dev-stable' of https://github.com/QuantumPackage/qp2 into dev-stable
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
eginer 2023-08-07 17:41:40 +02:00
commit 9eba86fea0
48 changed files with 3328 additions and 419 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
RELEASE_NOTES.org
View File

@ -10,7 +10,8 @@
- Added many types of integrals
- Accelerated four-index transformation
- Added transcorrelated SCF
- Added transcorrelated CIPSI
- Added bi-orthonormal transcorrelated CIPSI
- Added Cholesky decomposition of AO integrals
- Added CCSD and CCSD(T)
- Added MO localization
- Changed coupling parameters for ROHF
@ -20,7 +21,7 @@
- Removed cryptokit dependency in OCaml
- Using now standard convention in RDM
- Added molecular properties
- [ ] Added GTOs with complex exponent
- Added GTOs with complex exponent
*** TODO: take from dev
- Updated version of f77-zmq

66
config/ifort_2021_debug.cfg Normal file
View File

@ -0,0 +1,66 @@
# Common flags
##############
#
# -mkl=[parallel|sequential] : Use the MKL library
# --ninja : Allow the utilisation of ninja. It is mandatory !
# --align=32 : Align all provided arrays on a 32-byte boundary
#
[COMMON]
FC : ifort -fpic
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL
# Global options
################
#
# 1 : Activate
# 0 : Deactivate
#
[OPTION]
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
CACHE : 0 ; Enable cache_compile.py
OPENMP : 1 ; Append OpenMP flags
# Optimization flags
####################
#
# -xHost : Compile a binary optimized for the current architecture
# -O2 : O3 not better than O2.
# -ip : Inter-procedural optimizations
# -ftz : Flushes denormal results to zero
#
[OPT]
FC : -traceback
FCFLAGS : -msse4.2 -O2 -ip -ftz -g
# Profiling flags
#################
#
[PROFILE]
FC : -p -g
FCFLAGS : -msse4.2 -O2 -ip -ftz
# Debugging flags
#################
#
# -traceback : Activate backtrace on runtime
# -fpe0 : All floating point exaceptions
# -C : Checks uninitialized variables, array subscripts, etc...
# -g : Extra debugging information
# -msse4.2 : Valgrind needs a very simple x86 executable
#
[DEBUG]
FC : -g -traceback
FCFLAGS : -msse4.2 -check all -debug all -fpe-all=0 -implicitnone
# OpenMP flags
#################
#
[OPENMP]
FC : -qopenmp
IRPF90_FLAGS : --openmp

13
etc/qp.rc
View File

@ -188,7 +188,18 @@ _qp_Complete()
;;
esac;;
set_file)
COMPREPLY=( $(compgen -W "$(for i in */ $(find . -name ezfio | sed 's/ezfio$/.version/') ; do [[ -f $i ]] && echo ${i%/.version} ; done)" -- ${cur} ) )
# Array to store directory names
dirs=""
# Find directories containing "ezfio/.version" file recursively
for i in $(find . -name ezfio | sed 's/ezfio$/.version/')
do
dir_name=${i%/.version} # Remove the ".version" suffix
dir_name=${dir_name#./} # Remove the leading "./"
dirs+="./$dir_name "
done
COMPREPLY=( $(compgen -W "$dirs" -- ${cur} ) )
return 0
;;
plugins)

6
src/ao_two_e_ints/EZFIO.cfg
View File

@ -4,6 +4,12 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
interface: ezfio,provider,ocaml
default: None
[io_ao_cholesky]
type: Disk_access
doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
interface: ezfio,provider,ocaml
default: None
[ao_integrals_threshold]
type: Threshold
doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero

512
src/ao_two_e_ints/cholesky.irp.f
View File

@ -1,121 +1,3 @@
BEGIN_PROVIDER [ integer, cholesky_ao_num_guess ]
implicit none
BEGIN_DOC
! Number of Cholesky vectors in AO basis
END_DOC
cholesky_ao_num_guess = ao_num*ao_num
END_PROVIDER
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
&BEGIN_PROVIDER [ double precision, cholesky_ao, (ao_num, ao_num, cholesky_ao_num_guess) ]
use mmap_module
implicit none
BEGIN_DOC
! Cholesky vectors in AO basis: (ik|a):
! <ij|kl> = (ik|jl) = sum_a (ik|a).(a|jl)
END_DOC
type(c_ptr) :: ptr
integer :: fd, i,j,k,l,m,rank
double precision, pointer :: ao_integrals(:,:,:,:)
double precision, external :: ao_two_e_integral
! Store AO integrals in a memory mapped file
call mmap(trim(ezfio_work_dir)//'ao_integrals', &
(/ int(ao_num,8), int(ao_num,8), int(ao_num,8), int(ao_num,8) /), &
8, fd, .False., ptr)
call c_f_pointer(ptr, ao_integrals, (/ao_num, ao_num, ao_num, ao_num/))
print*, 'Providing the AO integrals (Cholesky)'
call wall_time(wall_1)
call cpu_time(cpu_1)
ao_integrals = 0.d0
double precision :: integral, cpu_1, cpu_2, wall_1, wall_2
logical, external :: ao_two_e_integral_zero
double precision, external :: get_ao_two_e_integral
if (read_ao_two_e_integrals) then
PROVIDE ao_two_e_integrals_in_map
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
do m=0,9
do l=1+m,ao_num,10
!$OMP DO SCHEDULE(dynamic)
do j=1,ao_num
do k=1,ao_num
do i=1,ao_num
if (ao_two_e_integral_zero(i,j,k,l)) cycle
integral = get_ao_two_e_integral(i,j,k,l, ao_integrals_map)
ao_integrals(i,k,j,l) = integral
enddo
enddo
enddo
!$OMP END DO NOWAIT
enddo
!$OMP MASTER
call wall_time(wall_2)
print '(I10,'' % in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
!$OMP END MASTER
enddo
!$OMP END PARALLEL
else
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
do m=0,9
do l=1+m,ao_num,10
!$OMP DO SCHEDULE(dynamic)
do j=1,l
do k=1,ao_num
do i=1,min(k,j)
if (ao_two_e_integral_zero(i,j,k,l)) cycle
integral = ao_two_e_integral(i,k,j,l)
ao_integrals(i,k,j,l) = integral
ao_integrals(k,i,j,l) = integral
ao_integrals(i,k,l,j) = integral
ao_integrals(k,i,l,j) = integral
ao_integrals(j,l,i,k) = integral
ao_integrals(j,l,k,i) = integral
ao_integrals(l,j,i,k) = integral
ao_integrals(l,j,k,i) = integral
enddo
enddo
enddo
!$OMP END DO NOWAIT
enddo
!$OMP MASTER
call wall_time(wall_2)
print '(I10,'' % in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
!$OMP END MASTER
enddo
!$OMP END PARALLEL
call wall_time(wall_2)
call cpu_time(cpu_2)
print*, 'AO integrals provided:'
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
endif
! Call Lapack
cholesky_ao_num = cholesky_ao_num_guess
call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
print *, 'Rank: ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
! Remove mmap
double precision, external :: getUnitAndOpen
call munmap( &
(/ int(ao_num,8), int(ao_num,8), int(ao_num,8), int(ao_num,8) /), &
8, fd, ptr)
open(unit=99,file=trim(ezfio_work_dir)//'ao_integrals')
close(99, status='delete')
END_PROVIDER
BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num, ao_num) ]
implicit none
BEGIN_DOC
@ -131,3 +13,397 @@ BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num,
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
&BEGIN_PROVIDER [ double precision, cholesky_ao, (ao_num, ao_num, 1) ]
implicit none
BEGIN_DOC
! Cholesky vectors in AO basis: (ik|a):
! <ij|kl> = (ik|jl) = sum_a (ik|a).(a|jl)
!
! Last dimension of cholesky_ao is cholesky_ao_num
END_DOC
integer :: rank, ndim
double precision :: tau
double precision, pointer :: L(:,:), L_old(:,:)
double precision :: s
double precision, parameter :: dscale = 1.d0
double precision, allocatable :: D(:), Delta(:,:), Ltmp_p(:,:), Ltmp_q(:,:)
integer, allocatable :: Lset(:), Dset(:), addr(:,:)
logical, allocatable :: computed(:)
integer :: i,j,k,m,p,q, qj, dj, p2, q2
integer :: N, np, nq
double precision :: Dmax, Dmin, Qmax, f
double precision, external :: get_ao_two_e_integral
logical, external :: ao_two_e_integral_zero
double precision, external :: ao_two_e_integral
integer :: block_size, iblock, ierr
double precision :: mem
double precision, external :: memory_of_double, memory_of_int
integer, external :: getUnitAndOpen
integer :: iunit
ndim = ao_num*ao_num
deallocate(cholesky_ao)
if (read_ao_cholesky) then
print *, 'Reading Cholesky vectors from disk...'
iunit = getUnitAndOpen(trim(ezfio_work_dir)//'cholesky_ao', 'R')
read(iunit) rank
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
read(iunit) cholesky_ao
close(iunit)
cholesky_ao_num = rank
else
PROVIDE nucl_coord
if (do_direct_integrals) then
if (ao_two_e_integral(1,1,1,1) < huge(1.d0)) then
! Trigger providers inside ao_two_e_integral
continue
endif
else
PROVIDE ao_two_e_integrals_in_map
endif
tau = ao_cholesky_threshold
mem = 6.d0 * memory_of_double(ndim) + 6.d0 * memory_of_int(ndim)
call check_mem(mem, irp_here)
call print_memory_usage()
allocate(L(ndim,1))
print *, ''
print *, 'Cholesky decomposition of AO integrals'
print *, '======================================'
print *, ''
print *, '============ ============='
print *, ' Rank Threshold'
print *, '============ ============='
rank = 0
allocate( D(ndim), Lset(ndim), Dset(ndim) )
allocate( addr(3,ndim) )
! 1.
k=0
do j=1,ao_num
do i=1,ao_num
k = k+1
addr(1,k) = i
addr(2,k) = j
addr(3,k) = (i-1)*ao_num + j
enddo
enddo
if (do_direct_integrals) then
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
do i=1,ndim
D(i) = ao_two_e_integral(addr(1,i), addr(2,i), &
addr(1,i), addr(2,i))
enddo
!$OMP END PARALLEL DO
else
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
do i=1,ndim
D(i) = get_ao_two_e_integral(addr(1,i), addr(1,i), &
addr(2,i), addr(2,i), &
ao_integrals_map)
enddo
!$OMP END PARALLEL DO
endif
Dmax = maxval(D)
! 2.
np=0
do p=1,ndim
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
np = np+1
Lset(np) = p
endif
enddo
! 3.
N = 0
! 4.
i = 0
! 5.
do while ( (Dmax > tau).and.(rank < ndim) )
! a.
i = i+1
s = 0.01d0
! Inrease s until the arrays fit in memory
do while (.True.)
! b.
Dmin = max(s*Dmax,tau)
! c.
nq=0
do p=1,np
if ( D(Lset(p)) > Dmin ) then
nq = nq+1
Dset(nq) = Lset(p)
endif
enddo
call total_memory(mem)
mem = mem &
+ np*memory_of_double(nq) &! Delta(np,nq)
+ (rank+nq)* memory_of_double(ndim) &! L(ndim,rank+nq)
+ (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
if (mem > qp_max_mem) then
s = s*2.d0
else
exit
endif
if ((s > 1.d0).or.(nq == 0)) then
call print_memory_usage()
print *, 'Not enough memory. Reduce cholesky threshold'
stop -1
endif
enddo
! d., e.
block_size = max(N,24)
L_old => L
allocate(L(ndim,rank+nq), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (L(ndim,rank+nq))'
stop -1
endif
!$OMP PARALLEL DO PRIVATE(k)
do k=1,rank
L(:,k) = L_old(:,k)
enddo
!$OMP END PARALLEL DO
deallocate(L_old)
allocate(Delta(np,nq), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Delta(np,nq))'
stop -1
endif
allocate(Ltmp_p(np,block_size), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Ltmp_p(np,block_size))'
stop -1
endif
allocate(Ltmp_q(nq,block_size), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Ltmp_q(nq,block_size))'
stop -1
endif
allocate(computed(nq))
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(m,k,p,q,j)
!$OMP DO
do q=1,nq
Delta(:,q) = 0.d0
computed(q) = .False.
enddo
!$OMP ENDDO NOWAIT
!$OMP DO
do k=1,N
do p=1,np
Ltmp_p(p,k) = L(Lset(p),k)
enddo
do q=1,nq
Ltmp_q(q,k) = L(Dset(q),k)
enddo
enddo
!$OMP END DO NOWAIT
!$OMP BARRIER
!$OMP END PARALLEL
if (N>0) then
call dgemm('N','T', np, nq, N, -1.d0, &
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
endif
! f.
Qmax = D(Dset(1))
do q=1,nq
Qmax = max(Qmax, D(Dset(q)))
enddo
! g.
iblock = 0
do j=1,nq
if ( (Qmax <= Dmin).or.(N+j > ndim) ) exit
! i.
rank = N+j
if (iblock == block_size) then
call dgemm('N','T',np,nq,block_size,-1.d0, &
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
iblock = 0
endif
! ii.
do dj=1,nq
qj = Dset(dj)
if (D(qj) == Qmax) then
exit
endif
enddo
L(1:ndim, rank) = 0.d0
if (.not.computed(dj)) then
m = dj
!$OMP PARALLEL DO PRIVATE(k) SCHEDULE(guided)
do k=np,1,-1
if (.not.ao_two_e_integral_zero( addr(1,Lset(k)), addr(1,Dset(m)),&
addr(2,Lset(k)), addr(2,Dset(m)) ) ) then
if (do_direct_integrals) then
Delta(k,m) = Delta(k,m) + &
ao_two_e_integral(addr(1,Lset(k)), addr(2,Lset(k)),&
addr(1,Dset(m)), addr(2,Dset(m)))
else
Delta(k,m) = Delta(k,m) + &
get_ao_two_e_integral( addr(1,Lset(k)), addr(1,Dset(m)),&
addr(2,Lset(k)), addr(2,Dset(m)), ao_integrals_map)
endif
endif
enddo
!$OMP END PARALLEL DO
computed(dj) = .True.
endif
iblock = iblock+1
do p=1,np
Ltmp_p(p,iblock) = Delta(p,dj)
enddo
! iv.
if (iblock > 1) then
call dgemv('N', np, iblock-1, -1.d0, Ltmp_p, np, Ltmp_q(dj,1), nq, 1.d0,&
Ltmp_p(1,iblock), 1)
endif
! iii.
f = 1.d0/dsqrt(Qmax)
!$OMP PARALLEL PRIVATE(m,p,q,k) DEFAULT(shared)
!$OMP DO
do p=1,np
Ltmp_p(p,iblock) = Ltmp_p(p,iblock) * f
L(Lset(p), rank) = Ltmp_p(p,iblock)
D(Lset(p)) = D(Lset(p)) - Ltmp_p(p,iblock) * Ltmp_p(p,iblock)
enddo
!$OMP END DO
!$OMP DO
do q=1,nq
Ltmp_q(q,iblock) = L(Dset(q), rank)
enddo
!$OMP END DO
!$OMP END PARALLEL
Qmax = D(Dset(1))
do q=1,nq
Qmax = max(Qmax, D(Dset(q)))
enddo
enddo
print '(I10, 4X, ES12.3)', rank, Qmax
deallocate(computed)
deallocate(Delta)
deallocate(Ltmp_p)
deallocate(Ltmp_q)
! i.
N = rank
! j.
Dmax = D(Lset(1))
do p=1,np
Dmax = max(Dmax, D(Lset(p)))
enddo
np=0
do p=1,ndim
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
np = np+1
Lset(np) = p
endif
enddo
enddo
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': Allocation failed'
stop -1
endif
!$OMP PARALLEL DO PRIVATE(k)
do k=1,rank
call dcopy(ndim, L(1,k), 1, cholesky_ao(1,1,k), 1)
enddo
!$OMP END PARALLEL DO
deallocate(L)
cholesky_ao_num = rank
print *, '============ ============='
print *, ''
if (write_ao_cholesky) then
print *, 'Writing Cholesky vectors to disk...'
iunit = getUnitAndOpen(trim(ezfio_work_dir)//'cholesky_ao', 'W')
write(iunit) rank
write(iunit) cholesky_ao
close(iunit)
call ezfio_set_ao_two_e_ints_io_ao_cholesky('Read')
endif
endif
print *, 'Rank : ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
print *, ''
END_PROVIDER

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

@ -460,7 +460,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num)
!$OMP PARALLEL DO PRIVATE(i,k) &
!$OMP DEFAULT(NONE) &
!$OMP SHARED (ao_num,ao_two_e_integral_schwartz) &
!$OMP SCHEDULE(dynamic)
!$OMP SCHEDULE(guided)
do i=1,ao_num
do k=1,i
ao_two_e_integral_schwartz(i,k) = dsqrt(ao_two_e_integral(i,i,k,k))
@ -951,7 +951,7 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
double precision :: X(0:max_dim)
double precision :: Y(0:max_dim)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
integer :: nx, ix,iy,ny
integer :: nx, ix,iy,ny,ib
ASSERT (a>2)
!DIR$ LOOP COUNT(8)
@ -974,8 +974,43 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
enddo
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_10,2,d,nd)
call multiply_poly_c2(X,nx,B_10,d,nd)
! call multiply_poly_c2_inline_2e(X,nx,B_10,d,nd)
if (nx >= 0) then
select case (nx)
case (0)
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(1) * X(0)
d(2) = d(2) + B_10(2) * X(0)
case (1)
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
d(2) = d(2) + B_10(1) * X(1) + B_10(2) * X(0)
d(3) = d(3) + B_10(2) * X(1)
case (2)
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
d(2) = d(2) + B_10(0) * X(2) + B_10(1) * X(1) + B_10(2) * X(0)
d(3) = d(3) + B_10(1) * X(2) + B_10(2) * X(1)
d(4) = d(4) + B_10(2) * X(2)
case default
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
do ib=2,nx
d(ib) = d(ib) + B_10(0) * X(ib) + B_10(1) * X(ib-1) + B_10(2) * X(ib-2)
enddo
d(nx+1) = d(nx+1) + B_10(1) * X(nx) + B_10(2) * X(nx-1)
d(nx+2) = d(nx+2) + B_10(2) * X(nx)
end select
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
nx = nd
!DIR$ LOOP COUNT(8)
@ -996,9 +1031,47 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
X(ix) *= c
enddo
endif
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_00,2,d,nd)
call multiply_poly_c2(X,nx,B_00,d,nd)
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
if(nx >= 0) then
select case (nx)
case (0)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(2) * X(0)
case (1)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
d(3) = d(3) + B_00(2) * X(1)
case (2)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
d(4) = d(4) + B_00(2) * X(2)
case default
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
do ib=2,nx
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
enddo
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
end select
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
endif
ny=0
@ -1016,8 +1089,45 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
endif
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,C_00,2,d,nd)
call multiply_poly_c2(Y,ny,C_00,d,nd)
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
if(ny >= 0) then
select case (ny)
case (0)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(2) * Y(0)
case (1)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
d(3) = d(3) + C_00(2) * Y(1)
case (2)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
d(4) = d(4) + C_00(2) * Y(2)
case default
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
do ib=2,ny
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
enddo
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
end select
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end
recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
@ -1034,7 +1144,7 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
double precision :: X(0:max_dim)
double precision :: Y(0:max_dim)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
integer :: nx, ix,iy,ny
integer :: nx, ix,iy,ny,ib
if( (c<0).or.(nd<0) )then
nd = -1
@ -1056,8 +1166,44 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
endif
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_00,2,d,nd)
call multiply_poly_c2(X,nx,B_00,d,nd)
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
if(nx >= 0) then
select case (nx)
case (0)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(2) * X(0)
case (1)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
d(3) = d(3) + B_00(2) * X(1)
case (2)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
d(4) = d(4) + B_00(2) * X(2)
case default
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
do ib=2,nx
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
enddo
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
end select
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
ny=0
@ -1068,8 +1214,44 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,C_00,2,d,nd)
call multiply_poly_c2(Y,ny,C_00,d,nd)
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
if(ny >= 0) then
select case (ny)
case (0)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(2) * Y(0)
case (1)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
d(3) = d(3) + C_00(2) * Y(1)
case (2)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
d(4) = d(4) + C_00(2) * Y(2)
case default
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
do ib=2,ny
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
enddo
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
end select
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end
@ -1087,7 +1269,7 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
double precision :: X(0:max_dim)
double precision :: Y(0:max_dim)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
integer :: nx, ix,iy,ny
integer :: nx, ix,iy,ny,ib
!DIR$ LOOP COUNT(8)
do ix=0,n_pt_in
@ -1097,8 +1279,44 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,X,nx,n_pt_in)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_10,2,d,nd)
call multiply_poly_c2(X,nx,B_10,d,nd)
! call multiply_poly_c2_inline_2e(X,nx,B_10,d,nd)
if(nx >= 0) then
select case (nx)
case (0)
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(1) * X(0)
d(2) = d(2) + B_10(2) * X(0)
case (1)
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
d(2) = d(2) + B_10(1) * X(1) + B_10(2) * X(0)
d(3) = d(3) + B_10(2) * X(1)
case (2)
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
d(2) = d(2) + B_10(0) * X(2) + B_10(1) * X(1) + B_10(2) * X(0)
d(3) = d(3) + B_10(1) * X(2) + B_10(2) * X(1)
d(4) = d(4) + B_10(2) * X(2)
case default
d(0) = d(0) + B_10(0) * X(0)
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
do ib=2,nx
d(ib) = d(ib) + B_10(0) * X(ib) + B_10(1) * X(ib-1) + B_10(2) * X(ib-2)
enddo
d(nx+1) = d(nx+1) + B_10(1) * X(nx) + B_10(2) * X(nx-1)
d(nx+2) = d(nx+2) + B_10(2) * X(nx)
end select
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
nx = nd
!DIR$ LOOP COUNT(8)
@ -1117,8 +1335,44 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
endif
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_00,2,d,nd)
call multiply_poly_c2(X,nx,B_00,d,nd)
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
if(nx >= 0) then
select case (nx)
case (0)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(2) * X(0)
case (1)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
d(3) = d(3) + B_00(2) * X(1)
case (2)
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
d(4) = d(4) + B_00(2) * X(2)
case default
d(0) = d(0) + B_00(0) * X(0)
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
do ib=2,nx
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
enddo
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
end select
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
ny=0
!DIR$ LOOP COUNT(8)
@ -1129,8 +1383,45 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
call I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,C_00,2,d,nd)
call multiply_poly_c2(Y,ny,C_00,d,nd)
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
if(ny >= 0) then
select case (ny)
case (0)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(2) * Y(0)
case (1)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
d(3) = d(3) + C_00(2) * Y(1)
case (2)
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
d(4) = d(4) + C_00(2) * Y(2)
case default
d(0) = d(0) + C_00(0) * Y(0)
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
do ib=2,ny
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
enddo
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
end select
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end
recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
@ -1147,7 +1438,7 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
integer :: nx, ix,ny
double precision :: X(0:max_dim),Y(0:max_dim)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
integer :: i
integer :: i, ib
select case (c)
case (0)
@ -1178,8 +1469,45 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
Y(2) = D_00(2)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,D_00,2,d,nd)
call multiply_poly_c2(Y,ny,D_00,d,nd)
! call multiply_poly_c2_inline_2e(Y,ny,D_00,d,nd)
if(ny >= 0) then
select case (ny)
case (0)
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(1) * Y(0)
d(2) = d(2) + D_00(2) * Y(0)
case (1)
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
d(2) = d(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
d(3) = d(3) + D_00(2) * Y(1)
case (2)
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
d(2) = d(2) + D_00(0) * Y(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
d(3) = d(3) + D_00(1) * Y(2) + D_00(2) * Y(1)
d(4) = d(4) + D_00(2) * Y(2)
case default
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
do ib=2,ny
d(ib) = d(ib) + D_00(0) * Y(ib) + D_00(1) * Y(ib-1) + D_00(2) * Y(ib-2)
enddo
d(ny+1) = d(ny+1) + D_00(1) * Y(ny) + D_00(2) * Y(ny-1)
d(ny+2) = d(ny+2) + D_00(2) * Y(ny)
end select
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
return
@ -1198,8 +1526,44 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
enddo
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_01,2,d,nd)
call multiply_poly_c2(X,nx,B_01,d,nd)
! call multiply_poly_c2_inline_2e(X,nx,B_01,d,nd)
if(nx >= 0) then
select case (nx)
case (0)
d(0) = d(0) + B_01(0) * X(0)
d(1) = d(1) + B_01(1) * X(0)
d(2) = d(2) + B_01(2) * X(0)
case (1)
d(0) = d(0) + B_01(0) * X(0)
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
d(2) = d(2) + B_01(1) * X(1) + B_01(2) * X(0)
d(3) = d(3) + B_01(2) * X(1)
case (2)
d(0) = d(0) + B_01(0) * X(0)
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
d(2) = d(2) + B_01(0) * X(2) + B_01(1) * X(1) + B_01(2) * X(0)
d(3) = d(3) + B_01(1) * X(2) + B_01(2) * X(1)
d(4) = d(4) + B_01(2) * X(2)
case default
d(0) = d(0) + B_01(0) * X(0)
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
do ib=2,nx
d(ib) = d(ib) + B_01(0) * X(ib) + B_01(1) * X(ib-1) + B_01(2) * X(ib-2)
enddo
d(nx+1) = d(nx+1) + B_01(1) * X(nx) + B_01(2) * X(nx-1)
d(nx+2) = d(nx+2) + B_01(2) * X(nx)
end select
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
ny = 0
!DIR$ LOOP COUNT(6)
@ -1209,8 +1573,45 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
call I_x2_pol_mult(c-1,B_10,B_01,B_00,C_00,D_00,Y,ny,dim)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,D_00,2,d,nd)
call multiply_poly_c2(Y,ny,D_00,d,nd)
! call multiply_poly_c2_inline_2e(Y,ny,D_00,d,nd)
if(ny >= 0) then
select case (ny)
case (0)
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(1) * Y(0)
d(2) = d(2) + D_00(2) * Y(0)
case (1)
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
d(2) = d(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
d(3) = d(3) + D_00(2) * Y(1)
case (2)
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
d(2) = d(2) + D_00(0) * Y(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
d(3) = d(3) + D_00(1) * Y(2) + D_00(2) * Y(1)
d(4) = d(4) + D_00(2) * Y(2)
case default
d(0) = d(0) + D_00(0) * Y(0)
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
do ib=2,ny
d(ib) = d(ib) + D_00(0) * Y(ib) + D_00(1) * Y(ib-1) + D_00(2) * Y(ib-2)
enddo
d(ny+1) = d(ny+1) + D_00(1) * Y(ny) + D_00(2) * Y(ny-1)
d(ny+2) = d(ny+2) + D_00(2) * Y(ny)
end select
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end select
end
@ -1232,7 +1633,8 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
logical, external :: ao_two_e_integral_zero