mirror of
https://gitlab.com/scemama/eplf
synced 2024-09-06 19:54:44 +02:00
Optimized eplf integrals
This commit is contained in:
parent
8a1c7a03a8
commit
40ad59efa8
@ -23,7 +23,18 @@ double precision function binom(k,n)
|
|||||||
!DEC$ ATTRIBUTES ALIGN : 32 :: memo
|
!DEC$ ATTRIBUTES ALIGN : 32 :: memo
|
||||||
integer, save :: ifirst
|
integer, save :: ifirst
|
||||||
double precision :: fact
|
double precision :: fact
|
||||||
if (ifirst == 0) then
|
if (ifirst /= 0) then
|
||||||
|
|
||||||
|
if (n<20) then
|
||||||
|
binom = memo(k,n)
|
||||||
|
return
|
||||||
|
else
|
||||||
|
binom=fact(n)/(fact(k)*fact(n-k))
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
ifirst = 1
|
ifirst = 1
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
do j=0,20
|
do j=0,20
|
||||||
@ -31,12 +42,13 @@ double precision function binom(k,n)
|
|||||||
memo(i,j) = fact(j)/(fact(i)*fact(j-i))
|
memo(i,j) = fact(j)/(fact(i)*fact(j-i))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
endif
|
|
||||||
|
|
||||||
if (n<20) then
|
if (n<20) then
|
||||||
binom = memo(k,n)
|
binom = memo(k,n)
|
||||||
else
|
return
|
||||||
binom=fact(n)/(fact(k)*fact(n-k))
|
else
|
||||||
|
binom=fact(n)/(fact(k)*fact(n-k))
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -244,6 +244,16 @@ double precision function ao_eplf_integral_primitive_oneD(a,xa,i,b,xb,j,gmma,xr)
|
|||||||
integer, intent(in) :: i,j ! Powers of xa and xb
|
integer, intent(in) :: i,j ! Powers of xa and xb
|
||||||
integer :: ii, jj, kk
|
integer :: ii, jj, kk
|
||||||
|
|
||||||
|
integer, save :: ifirst=0
|
||||||
|
double precision, save :: f2(32)
|
||||||
|
|
||||||
|
if (ifirst == 0) then
|
||||||
|
ifirst = 1
|
||||||
|
do ii=1,32
|
||||||
|
f2(ii) = 2.d0**(-ii/2) * fact2(ii-1)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
ASSERT (a>0.)
|
ASSERT (a>0.)
|
||||||
ASSERT (b>0.)
|
ASSERT (b>0.)
|
||||||
ASSERT (i>=0)
|
ASSERT (i>=0)
|
||||||
@ -271,16 +281,43 @@ double precision function ao_eplf_integral_primitive_oneD(a,xa,i,b,xb,j,gmma,xr)
|
|||||||
v=db_inv-xb
|
v=db_inv-xb
|
||||||
|
|
||||||
double precision :: fact2, binom, f, ac
|
double precision :: fact2, binom, f, ac
|
||||||
|
double precision :: ui(-1:i), vj(-1:j), wij(-1:i+j+3)
|
||||||
|
!DEC$ ATTRIBUTES ALIGN : 32 :: ui, vj, wij
|
||||||
|
|
||||||
|
ui(i) = 1.d0
|
||||||
|
ui(i-1) = u
|
||||||
|
do ii=i-2,0,-1
|
||||||
|
ui(ii) = ui(ii+1) * u
|
||||||
|
enddo
|
||||||
|
|
||||||
|
vj(j) = 1.d0
|
||||||
|
vj(j-1) = v
|
||||||
|
do jj=j-2,0,-1
|
||||||
|
vj(jj) = vj(jj+1) * v
|
||||||
|
enddo
|
||||||
|
|
||||||
|
wij(0) = 1.d0
|
||||||
|
wij(1) = w
|
||||||
|
wij(2) = w*w
|
||||||
|
do ii=3,i+j
|
||||||
|
wij(ii) = wij(ii-1) * w
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do ii=2,i+j
|
||||||
|
wij(ii) *= f2(ii)
|
||||||
|
enddo
|
||||||
|
|
||||||
ac = 0.d0
|
ac = 0.d0
|
||||||
integer :: istart(0:1)
|
integer :: istart(0:1)
|
||||||
istart(0) = 0
|
istart(0) = 0
|
||||||
istart(1) = 1
|
istart(1) = 1
|
||||||
do ii=0,i
|
do ii=0,i
|
||||||
do jj=istart(mod(ii,2)),j,2
|
if (istart(mod(ii,2))<=j) then
|
||||||
kk= -(ii+jj)/2
|
f=ui(ii)*binom(ii,i)
|
||||||
f=binom(ii,i)*binom(jj,j)*fact2(ii+jj-1)
|
do jj=istart(mod(ii,2)),j,2
|
||||||
ac += u**(i-ii) * v**(j-jj) * w**(ii+jj) * f * 2.d0**kk
|
ac += vj(jj) * wij(ii+jj) * f *binom(jj,j)
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
enddo
|
enddo
|
||||||
ao_eplf_integral_primitive_oneD = dsqrt_pi*w*c*ac
|
ao_eplf_integral_primitive_oneD = dsqrt_pi*w*c*ac
|
||||||
|
|
||||||
@ -305,12 +342,12 @@ double precision function ao_eplf_integral(i,j,gmma,center)
|
|||||||
ASSERT(j<=ao_num)
|
ASSERT(j<=ao_num)
|
||||||
|
|
||||||
ao_eplf_integral = 0.d0
|
ao_eplf_integral = 0.d0
|
||||||
do p=1,ao_prim_num(i)
|
|
||||||
buffer(p) = 0.d0
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do q=1,ao_prim_num(j)
|
do q=1,ao_prim_num(j)
|
||||||
do p=1,ao_prim_num(i)
|
do p=1,ao_prim_num(i)
|
||||||
|
if (abs(ao_coef(q,j)*ao_coef(p,i)) < 1.e-9) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
integral = &
|
integral = &
|
||||||
ao_eplf_integral_primitive_oneD( &
|
ao_eplf_integral_primitive_oneD( &
|
||||||
ao_expo(p,i), &
|
ao_expo(p,i), &
|
||||||
@ -321,7 +358,7 @@ double precision function ao_eplf_integral(i,j,gmma,center)
|
|||||||
ao_power(j,1), &
|
ao_power(j,1), &
|
||||||
gmma, &
|
gmma, &
|
||||||
center(1))
|
center(1))
|
||||||
if (integral /= 0.d0) then
|
if (dabs(integral) > 1.d-15) then
|
||||||
integral *= &
|
integral *= &
|
||||||
ao_eplf_integral_primitive_oneD( &
|
ao_eplf_integral_primitive_oneD( &
|
||||||
ao_expo(p,i), &
|
ao_expo(p,i), &
|
||||||
@ -332,7 +369,7 @@ double precision function ao_eplf_integral(i,j,gmma,center)
|
|||||||
ao_power(j,2), &
|
ao_power(j,2), &
|
||||||
gmma, &
|
gmma, &
|
||||||
center(2))
|
center(2))
|
||||||
if (integral /= 0.d0) then
|
if (dabs(integral) > 1.d-15) then
|
||||||
integral *= &
|
integral *= &
|
||||||
ao_eplf_integral_primitive_oneD( &
|
ao_eplf_integral_primitive_oneD( &
|
||||||
ao_expo(p,i), &
|
ao_expo(p,i), &
|
||||||
@ -343,14 +380,11 @@ double precision function ao_eplf_integral(i,j,gmma,center)
|
|||||||
ao_power(j,3), &
|
ao_power(j,3), &
|
||||||
gmma, &
|
gmma, &
|
||||||
center(3))
|
center(3))
|
||||||
buffer(p) += integral*ao_coef(p,i)*ao_coef(q,j)
|
ao_eplf_integral += integral*ao_coef(p,i)*ao_coef(q,j)
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do p=1,ao_prim_num(i)
|
|
||||||
ao_eplf_integral += buffer(p)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end function
|
end function
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user