commit 432cbe073615d569a816b064ba45c18c67e28311 Author: Anthony Scemama Date: Mon May 11 22:17:21 2009 +0200 Obara Saika for primitive overlap integral diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..5bb0761 --- /dev/null +++ b/Makefile @@ -0,0 +1,12 @@ +IRPF90 = irpf90 #-a -d +FC = ifort +FCFLAGS= -O3 -xP + +SRC= +OBJ= +LIB= + +include irpf90.make + +irpf90.make: $(wildcard *.irp.f) + $(IRPF90) diff --git a/constants.F b/constants.F new file mode 100644 index 0000000..7d671f3 --- /dev/null +++ b/constants.F @@ -0,0 +1 @@ + double precision, parameter :: pi=3.14159265359d0 diff --git a/debug.irp.f b/debug.irp.f new file mode 100644 index 0000000..66d47b8 --- /dev/null +++ b/debug.irp.f @@ -0,0 +1,6 @@ +program debug + double precision a + double precision primitive_overlap + a = primitive_overlap(3.d0,-1.d0,3,2.d0,1.d0,4) + print *, a +end diff --git a/integral.irp.f b/integral.irp.f new file mode 100644 index 0000000..ee94fb3 --- /dev/null +++ b/integral.irp.f @@ -0,0 +1,73 @@ +subroutine gaussian_product(a,xa,b,xb,k,p,xp) + implicit none +! e^{-a (x-x_A)^2} e^{-b (x-x_B)^2} = K_{ab}^x e^{-p (x-x_P)^2} + + double precision, intent(in) :: a,b ! Exponents + double precision, intent(in) :: xa,xb ! Centers + double precision, intent(out) :: p ! New exponent + double precision, intent(out) :: xp ! New center + double precision, intent(out) :: k ! Constant + + double precision:: p_inv + + p = a+b + xp = (a*xa+b*xb) + + p_inv = 1./p + + xp = xp*p_inv + k = dexp(-a*b*p_inv*(xa-xb)**2) + +end subroutine + +double precision function primitive_overlap(a,xa,i,b,xb,j) + implicit none + include 'constants.F' + double precision, intent(in) :: a,b ! Exponents + double precision, intent(in) :: xa,xb ! Centers + integer, intent(in) :: i,j ! Powers of xa and xb + + integer :: ii, jj, kk, ll + double precision:: xp + double precision:: p + double precision :: S(0:i,0:j) + double precision :: inv_2p, di(i), dj(j) + + call gaussian_product(a,xa,b,xb,S(0,0),p,xp) + S(0,0) = S(0,0) * dsqrt(pi/p) + + if (i>0) then + S(1,0) = (xp-xa) * S(0,0) ! TODO verifier signe + endif + if (j>0) then + S(0,1) = (xp-xb) * S(0,0) ! TODO verifier signe + endif + + inv_2p = 1./(2.*p) + + do ii=1,max(i,j) + di(ii) = inv_2p * dble(ii) + enddo + + if (i>1) then + do ii=1,i-1 + S(ii+1,0) = (xp-xa) * S(ii,0) + di(ii)*S(ii-1,0) + enddo + endif + + if (j>1) then + do jj=1,j-1 + S(0,jj+1) = (xp-xb) * S(0,jj) + di(jj)*S(0,jj-1) + enddo + endif + + do jj=1,j + do ii=1,i + S(ii,jj) = (xp-xa) * S(ii-1,jj) + di(ii-1) * S(ii-2,jj) + di(jj) * S(ii-1,jj-1) + enddo + enddo + + primitive_overlap = S(i,j) + +end function +