easyconfigs-it4i/m/MRCC/mrcc_files/dfint_mid_kc_OUT_ijk.f
2024-07-25 10:27:17 +02:00

99 lines
2.7 KiB
Fortran

! Set some necessary variables for the integral calculations
ccontr=nicontr*njcontr*nkcontr
nckl=nc12*nkcontr
nclkj=nckl*njcontr
ncklp=nckl*njprim
nckl1=nckl-1
nclkj1=nclkj-1
nc121=nc12-1
! Allocate memory
it3=imem
imem=imem+nc12*nkcontr*njprim
jbuff=imem
imem=imem+nc12*nkcontr
jbuff1=imem-1
it4=imem
imem=imem+nc12*nkcontr*njcontr*niprim
ibuff=imem
imem=imem+nc12*nkcontr*njcontr
ibuff1=imem-1
if(max(imem,imem+nc12)-imem1.gt.maxcor) then
write(iout,*)
write(iout,*) 'Insufficient memory for integral calculation! '
write(iout,*) 'Increase the memory available to the program '
write(iout,*) 'or run integral-direct calculations! '
call mrccend(1)
endif
! Loop over primitives
ptol=itol/dfloat(max(1,niprim*njprim))
ptol2=ptol*ptol
cf0=cf(0)
cf02=cf0*cf0
nzip=0
minc=gexpk(1)
niprim2=niprim**2
njprim2=njprim**2
do var_c=1,nkprim
rc(var_c)=1.d0/gexpk(var_c)
if(gexpk(var_c).lt.minc) minc=gexpk(var_c)
gckdiag(var_c)=gcoefk(var_c,var_c)
enddo
minc2=minc*minc
jlength=it4-nclkj
do iprim=1,niprim
ptol2i=ptol2
icc=1.d0
if(ip(iprim).ne.0) then
icc=gci(iprim,ip(iprim))
c ptol2i=ptol2*niprim2
! elseif(iseg(iprim).eq.1) then
! icc=gci(iprim,isegc(iprim))
endif
a=gexpi(iprim)
nzjp=0
jlength=jlength+nclkj
! ncklj=it3-nckl
do jprim=1,njprim
! ncklj=ncklj+nckl
ptol2j=ptol2i
jcc=icc
ncklj=it3+(jprim-1)*nckl
if(jp(jprim).ne.0) then
jcc=jcc*gcj(jprim,jp(jprim))
ncklj=jlength+(jp(jprim)-1)*nckl
c ptol2j=ptol2i*njprim2
! elseif(jseg(jprim).eq.1) then
! jcc=jcc*gcj(jprim,jsegc(jprim))
endif
b=gexpj(jprim)
p=a+b
rp=1.d0/p
ap=a*rp
bp=b*rp
px=ap*ax+bp*bx
py=ap*ay+bp*by
pz=ap*az+bp*bz
xpa=px-ax
ypa=py-ay
zpa=pz-az
xpq=px-cx
ypq=py-cy
zpq=pz-cz
norm2=34.98683665524972569252564335974310d0*dexp(-ap*b*sb2)*rp
rp=0.5d0*rp
argij=p*(xpq*xpq+ypq*ypq+zpq*zpq)
psq=1.d0/(p+minc)
alp=minc*psq
arg=alp*argij
if(norm2*norm2*psq*cf02/(minc2*arg).gt.ptol2j) then
ij=ncklj-nc12
do kprim=1,nkprim
ij=ij+nc12
c=gexpk(kprim)
psq=1.d0/(p+c)
alp=c*psq
arg=alp*argij
alq=p*psq
norm=norm2*dsqrt(psq)*rc(kprim)*gckdiag(kprim)*jcc