mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 12:10:50 +01:00
139 lines
4.6 KiB
Fortran
139 lines
4.6 KiB
Fortran
$gcnk,
|
|
$nicontr,njcontr,nkcontr,niprim,njprim,nkprim,
|
|
$imem,imem1,maxcor,dcore,iout,nprimmax,
|
|
$ncontrmax,gexpk,boysval,
|
|
$ax,ay,az,sb2,cx,cy,cz,itol,cf,nmboys,bx,by,bz,
|
|
$dfscr,
|
|
$gexpi,gexpj,gcni,gcnj,
|
|
$scr,scrc,scrc0,scrn,scrn0,
|
|
$gci,gcj,ip,jp,gck,kp,
|
|
$dpremat,nc12,sig,primintder,rearr,derspher,lrearr)
|
|
***********************************************************************
|
|
! Calculate the geometrical first derivatives of a three-center ERI shell triplet
|
|
***********************************************************************
|
|
implicit none
|
|
integer imem,imem1,maxcor,nc12
|
|
integer iout,maxang
|
|
integer nicontr,njcontr,nkcontr,niprim,njprim,nkprim,ncontrmax
|
|
integer nprimmax,nmboys
|
|
integer nzipr(0:nprimmax),nzjpr(0:nprimmax)
|
|
integer gcni(2,ncontrmax),gcnj(2,ncontrmax),gcnk(2,ncontrmax)
|
|
integer scrc(3),scrc0(3),scrn(4),scrn0(4)
|
|
real*8 dcore(*),gexpi(nprimmax),gexpj(nprimmax),itol,cf(0:nmboys)
|
|
real*8 gexpk(nprimmax),ax,ay,az,sb2,cx,cy,cz
|
|
real*8 bx,by,bz,sig
|
|
real*8 dfscr(*)
|
|
logical lrearr
|
|
! Internal variables
|
|
integer ccontr,nckl,nclkj
|
|
integer it2,it3,it4,nc12p,irearr,itd
|
|
integer ilo,iup,nzip,ipr,iprim,aa
|
|
integer niprim2,njprim2
|
|
integer nclkj1,gc1,gc2,ncklp,aaa,aaaa
|
|
integer jlength,jplace,jplace1,iplace,iplace1,nc121,nckl1
|
|
integer scr,kbuff,kbuff1,jbuff,jbuff1,ibuff,ibuff1
|
|
! Primitive loops
|
|
integer nzjp,jprim,ncklj,kprim,ij,var_c
|
|
real*8 ptol,a,b,p,rp,ap,bp,px,py,pz,xpa,ypa,zpa,xpq,ypq,zpq,norm2
|
|
real*8 argij,c,psq,alp,alq,norm,arg,ptoli,ptolj,cf0
|
|
real*8 boysval((1+nmboys)*1481),minc2,cf02
|
|
real*8 gck(nprimmax,ncontrmax)
|
|
real*8 gcj(nprimmax,ncontrmax)
|
|
real*8 gci(nprimmax,ncontrmax)
|
|
integer ip(niprim),jp(njprim),kp(nkprim),icontr,jcontr,kcontr
|
|
real*8 jcc,icc,kcc,rc(nkprim),xpb,ypb,zpb
|
|
real*8 w,ra,rb(njprim),xab,yab,zab,dpremat(nprimmax,nprimmax)
|
|
interface
|
|
subroutine primintder(dcore,xpq,ypq,zpq,norm,arg,boysval,nmboys,
|
|
$cf,xpa,ypa,zpa,w,rp,alp,alq,psq,alqrc,xab,yab,zab,ra,rb,a,b,c)
|
|
integer nmboys
|
|
real*8 dcore(*),xpq,ypq,zpq,norm,arg,boysval((1+nmboys)*1481),
|
|
$cf(0:*),xpa,ypa,zpa,w,rp,alp,alq,psq,alqrc,xab,yab,zab,ra,rb,a,b,c
|
|
end
|
|
subroutine rearr(to,from)
|
|
real*8 to(*),from(*)
|
|
end
|
|
subroutine derspher(dic,dfscr,scr,scrn,scr0)
|
|
integer scr,scrn(4),scr0(4)
|
|
real*8 dfscr(*),dic(*)
|
|
end
|
|
end interface
|
|
! Set some necessary variables for the integral calculations
|
|
ccontr=nicontr*njcontr*nkcontr
|
|
nckl=nc12*nkcontr
|
|
nclkj=nckl*njcontr
|
|
ncklp=nckl*njprim
|
|
nc12p=nc12*nkprim
|
|
nckl1=nckl-1
|
|
nclkj1=nclkj-1
|
|
nc121=nc12-1
|
|
! niprim2=niprim**2
|
|
! njprim2=njprim**2
|
|
! Allocate memory
|
|
it2=imem
|
|
imem=imem+nc12*nkprim
|
|
kbuff=imem
|
|
imem=imem+nc12
|
|
kbuff1=imem-1
|
|
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(lrearr) then
|
|
irearr=imem
|
|
imem=imem+nc12
|
|
endif
|
|
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*nkprim))
|
|
! ptol2=ptol*ptol
|
|
cf0=cf(0)
|
|
cf02=cf0*cf0
|
|
nzip=0
|
|
! minc=gexpk(1)
|
|
! maxc=gexpk(nkprim)
|
|
do var_c=1,nkprim
|
|
rc(var_c)=1.d0/gexpk(var_c)
|
|
! if(gexpk(var_c).lt.minc) minc=gexpk(var_c)
|
|
! if(gexpk(var_c).gt.maxc) maxc=gexpk(var_c)
|
|
enddo
|
|
do var_c=1,njprim
|
|
rb(var_c)=0.5d0/gexpj(var_c)
|
|
enddo
|
|
! minc2=minc*minc
|
|
jlength=it4-nclkj
|
|
do iprim=1,niprim
|
|
icc=1.d0
|
|
ptoli=ptol
|
|
if(ip(iprim).ne.0) then
|
|
icc=gci(iprim,ip(iprim))
|
|
c ptoli=ptol*niprim
|
|
endif
|
|
a=gexpi(iprim)
|
|
ra=0.5d0/a
|
|
nzjp=0
|
|
jlength=jlength+nclkj
|
|
do jprim=1,njprim
|
|
jcc=icc
|
|
ncklj=it3+(jprim-1)*nckl
|
|
ptolj=ptoli
|
|
if(jp(jprim).ne.0) then
|
|
jcc=jcc*gcj(jprim,jp(jprim))
|
|
ncklj=jlength+(jp(jprim)-1)*nckl
|
|
c ptolj=ptoli*njprim
|
|
endif
|
|
if(dpremat(jprim,iprim).gt.ptolj) then
|
|
b=gexpj(jprim)
|