2024-07-25 10:27:17 +02:00

495 lines
23 KiB
Fortran
Executable File

************************************************************************
subroutine nucatt(natoms,nangmax,ncontrmax,nprimmax,ncartmax,
$nsphermax,nang,nangmin,ncontr,nprim,gexp,gcoef,coord,ctostr,
$nbasis,smat,work,gcn,nshrange,cartg,boysval,nmboys,cf,itol,atchg,
$ncent,ccoord)
************************************************************************
* Calculate nucatt integrals
************************************************************************
implicit none
integer natoms,nangmax,ncontrmax,nprimmax,ncartmax,iatoms,jatoms
integer nang(natoms),ncontr(0:nangmax,natoms),iang,jang,nsphermax
integer nicontr,niprim,nicart,njcontr,njprim,njcart,nispher,nn
integer nprim(0:nangmax,natoms),njspher,nbasis,nangmin(natoms)
integer isx,isy,isz,inti,intj,intf,ints,intc,iitn,jjtn,jangmax
integer gcn(2,ncontrmax,0:nangmax,natoms),rank
integer nshrange(2,0:nangmax,natoms)
real*8 gexp(nprimmax,0:nangmax,natoms),coord(3,natoms)
real*8 gcoef(nprimmax,ncontrmax,0:nangmax,natoms),ccoord(1,ncent)
real*8 work(*),ax,bx,ay,by,az,bz,xab2,yab2,zab2
real*8 ctostr(ncartmax**2,0:nangmax),smat(nbasis,nbasis)
logical cartg
integer ncent,iprim,jprim,nmax,nmboys,mm,in1,in2,jn1,jn2,iitm,jjtm
real*8 a,b,p,mu,xab,yab,zab,ptol,rab2,normg
real*8 boysval,cf,itol,atchg(ncent),atchmax
interface
subroutine nucatt_gn
end
subroutine nucatt_ss
end
subroutine nucatt_ps
end
subroutine nucatt_pp
end
subroutine nucatt_ds
end
subroutine nucatt_dp
end
subroutine nucatt_dd
end
subroutine nucatt_fs
end
subroutine nucatt_fp
end
subroutine nucatt_fd
end
subroutine nucatt_ff
end
subroutine nucatt_gs
end
subroutine nucatt_gp
end
subroutine nucatt_gd
end
subroutine nucatt_gf
end
subroutine nucatt_gg
end
subroutine nucatt_hs
end
subroutine nucatt_hp
end
subroutine nucatt_hd
end
subroutine nucatt_hf
end
subroutine nucatt_hg
end
subroutine nucatt_hh
end
end interface
#if defined (OMP)
integer OMP_GET_NUM_THREADS,OMP_GET_THREAD_NUM,omplen
if(nangmax.le.5) then
omplen=3445+ncartmax**2+ncartmax*nsphermax+
$nsphermax**2*nprimmax+nsphermax**2*nprimmax*ncontrmax
else
omplen=(2*nangmax+1)**4+(2*nangmax+1)**3+
$ncartmax**2+ncartmax*nsphermax+
$nsphermax**2*nprimmax+nsphermax**2*nprimmax*ncontrmax
endif
#endif
atchmax=0.d0
do iatoms=1,ncent
atchmax=max(atchmax,dabs(atchg(iatoms)))
enddo
smat=0.d0
C Loop over atoms
C$OMP PARALLEL DO Schedule(Dynamic)
C$OMP& DEFAULT(PRIVATE)
C$OMP& SHARED(natoms,nangmax,ncontrmax,nprimmax,ncartmax,nsphermax,nang)
C$OMP& SHARED(nangmin,ncontr,nprim,gexp,gcoef,coord,ctostr,nbasis,smat)
C$OMP& SHARED(boysval,nmboys,cf,itol,atchg,ncent,atchmax,ccoord)
C$OMP& SHARED(work,gcn,nshrange,cartg,omplen)
do iatoms=1,natoms
#if defined (OMP)
rank=OMP_GET_THREAD_NUM()*omplen
#else
rank=0
#endif
ax=coord(1,iatoms)
ay=coord(2,iatoms)
az=coord(3,iatoms)
do iang=nangmin(iatoms),nang(iatoms)
in1=nshrange(1,iang,iatoms)+1
in2=nshrange(2,iang,iatoms)
iitn=in1-1
iitm=iitn*nbasis
nicontr=ncontr(iang,iatoms)
niprim=nprim(iang,iatoms)
nicart=(iang+1)*(iang+2)/2
nispher=2*iang+1
if(cartg) nispher=nicart
nn=nispher*nicontr
a=gexp(1,iang,iatoms)
do iprim=2,niprim
a=min(a,gexp(iprim,iang,iatoms))
enddo
do jatoms=1,iatoms
bx=coord(1,jatoms)
by=coord(2,jatoms)
bz=coord(3,jatoms)
xab=ax-bx
yab=ay-by
zab=az-bz
xab2=xab**2
yab2=yab**2
zab2=zab**2
rab2=xab2+yab2+zab2
jangmax=nang(jatoms)
if(iatoms.eq.jatoms) jangmax=iang
do jang=nangmin(jatoms),jangmax
jn1=nshrange(1,jang,jatoms)+1
jn2=nshrange(2,jang,jatoms)
jjtn=(jn1-1)*nbasis+iitn
jjtm=iitm+jn1-1
njcontr=ncontr(jang,jatoms)
njprim=nprim(jang,jatoms)
njcart=(jang+1)*(jang+2)/2
njspher=2*jang+1
if(cartg) njspher=njcart
mm=njspher*njcontr
b=gexp(1,jang,jatoms)
do jprim=2,njprim
b=min(b,gexp(jprim,jang,jatoms))
enddo
ptol=itol/dble(max(1,niprim*njprim*ncent))
p=a+b
mu=a*b/p
normg=
$6.28318530717958647692528676655900577d0*dexp(-mu*rab2)/p
if(atchmax*normg.gt.ptol) then
if(iang.gt.5.or.jang.gt.5.or.cartg) then
nmax=iang+jang
isx=rank+1
isy=isx+(nmax+1)**4
isz=isy
ints=isy+(nmax+1)**3
intc=ints+nicart*njcart
intj=intc+nispher*njcart
inti=intj+nispher*njspher*niprim
call oneint_gn(ncontrmax,nprimmax,gexp(1,iang,iatoms),
$gexp(1,jang,jatoms),gcoef(1,1,iang,iatoms),gcoef(1,1,jang,jatoms),
$ctostr(1,iang),ctostr(1,jang),work(isx),work(isy),work(isz),
$work(ints),work(intc),work(intj),work(inti),smat,nbasis,
$gcn(1,1,iang,iatoms),gcn(1,1,jang,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,nicart,njcart,nispher,njspher,
$xab,yab,zab,iang,jang,cartg,nucatt_gn,nmboys,cf,nmax,rab2,atchg,
$boysval,ptol,ncent,ccoord)
else if(iang.eq.0) then
if(jang.eq.0) then
call oneint_ss(ncontrmax,nprimmax,gexp(1,0,iatoms),
$gexp(1,0,jatoms),gcoef(1,1,0,iatoms),gcoef(1,1,0,jatoms),
$work(rank+1),work(rank+1),work(rank+1),
$work(rank+1),work(rank+1+1*niprim),smat,
$nbasis,gcn(1,1,0,iatoms),gcn(1,1,0,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_ss,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.1) then
call oneint_ps(ncontrmax,nprimmax,gexp(1,1,jatoms),
$gexp(1,0,iatoms),gcoef(1,1,1,jatoms),gcoef(1,1,0,iatoms),
$work(rank+1),work(rank+3),work(rank+3),
$work(rank+3),work(rank+3+3*njprim),smat,
$nbasis,gcn(1,1,1,jatoms),gcn(1,1,0,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_ps,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.2) then
call oneint_ds(ncontrmax,nprimmax,gexp(1,2,jatoms),
$gexp(1,0,iatoms),gcoef(1,1,2,jatoms),gcoef(1,1,0,iatoms),
$work(rank+1),work(rank+10),work(rank+16),
$work(rank+16),work(rank+16+5*njprim),smat,
$nbasis,gcn(1,1,2,jatoms),gcn(1,1,0,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_ds,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.3) then
call oneint_fs(ncontrmax,nprimmax,gexp(1,3,jatoms),
$gexp(1,0,iatoms),gcoef(1,1,3,jatoms),gcoef(1,1,0,iatoms),
$work(rank+1),work(rank+26),work(rank+36),
$work(rank+36),work(rank+36+7*njprim),smat,
$nbasis,gcn(1,1,3,jatoms),gcn(1,1,0,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_fs,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.4) then
call oneint_gs(ncontrmax,nprimmax,gexp(1,4,jatoms),
$gexp(1,0,iatoms),gcoef(1,1,4,jatoms),gcoef(1,1,0,iatoms),
$work(rank+1),work(rank+56),work(rank+71),
$work(rank+71),work(rank+71+9*njprim),smat,
$nbasis,gcn(1,1,4,jatoms),gcn(1,1,0,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_gs,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.5) then
call oneint_hs(ncontrmax,nprimmax,gexp(1,5,jatoms),
$gexp(1,0,iatoms),gcoef(1,1,5,jatoms),gcoef(1,1,0,iatoms),
$work(rank+1),work(rank+106),work(rank+127),
$work(rank+127),work(rank+127+11*njprim),smat,
$nbasis,gcn(1,1,5,jatoms),gcn(1,1,0,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_hs,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
endif
else if(iang.eq.1) then
if(jang.eq.0) then
call oneint_ps(ncontrmax,nprimmax,gexp(1,1,iatoms),
$gexp(1,0,jatoms),gcoef(1,1,1,iatoms),gcoef(1,1,0,jatoms),
$work(rank+1),work(rank+3),work(rank+3),
$work(rank+3),work(rank+3+3*niprim),smat,
$nbasis,gcn(1,1,1,iatoms),gcn(1,1,0,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_ps,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.1) then
call oneint_pp(ncontrmax,nprimmax,gexp(1,1,iatoms),
$gexp(1,1,jatoms),gcoef(1,1,1,iatoms),gcoef(1,1,1,jatoms),
$work(rank+1),work(rank+16),work(rank+16),
$work(rank+16),work(rank+16+9*niprim),smat,
$nbasis,gcn(1,1,1,iatoms),gcn(1,1,1,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_pp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.2) then
call oneint_dp(ncontrmax,nprimmax,gexp(1,2,jatoms),
$gexp(1,1,iatoms),gcoef(1,1,2,jatoms),gcoef(1,1,1,iatoms),
$work(rank+1),work(rank+36),work(rank+54),
$work(rank+54),work(rank+54+15*njprim),smat,
$nbasis,gcn(1,1,2,jatoms),gcn(1,1,1,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_dp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.3) then
call oneint_fp(ncontrmax,nprimmax,gexp(1,3,jatoms),
$gexp(1,1,iatoms),gcoef(1,1,3,jatoms),gcoef(1,1,1,iatoms),
$work(rank+1),work(rank+71),work(rank+101),
$work(rank+101),work(rank+101+21*njprim),smat,
$nbasis,gcn(1,1,3,jatoms),gcn(1,1,1,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_fp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.4) then
call oneint_gp(ncontrmax,nprimmax,gexp(1,4,jatoms),
$gexp(1,1,iatoms),gcoef(1,1,4,jatoms),gcoef(1,1,1,iatoms),
$work(rank+1),work(rank+127),work(rank+172),
$work(rank+172),work(rank+172+27*njprim),smat,
$nbasis,gcn(1,1,4,jatoms),gcn(1,1,1,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_gp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.5) then
call oneint_hp(ncontrmax,nprimmax,gexp(1,5,jatoms),
$gexp(1,1,iatoms),gcoef(1,1,5,jatoms),gcoef(1,1,1,iatoms),
$work(rank+1),work(rank+211),work(rank+274),
$work(rank+274),work(rank+274+33*njprim),smat,
$nbasis,gcn(1,1,5,jatoms),gcn(1,1,1,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_hp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
endif
else if(iang.eq.2) then
if(jang.eq.0) then
call oneint_ds(ncontrmax,nprimmax,gexp(1,2,iatoms),
$gexp(1,0,jatoms),gcoef(1,1,2,iatoms),gcoef(1,1,0,jatoms),
$work(rank+1),work(rank+10),work(rank+16),
$work(rank+16),work(rank+16+5*niprim),smat,
$nbasis,gcn(1,1,2,iatoms),gcn(1,1,0,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_ds,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.1) then
call oneint_dp(ncontrmax,nprimmax,gexp(1,2,iatoms),
$gexp(1,1,jatoms),gcoef(1,1,2,iatoms),gcoef(1,1,1,jatoms),
$work(rank+1),work(rank+36),work(rank+54),
$work(rank+54),work(rank+54+15*niprim),smat,
$nbasis,gcn(1,1,2,iatoms),gcn(1,1,1,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_dp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.2) then
call oneint_dd(ncontrmax,nprimmax,gexp(1,2,iatoms),
$gexp(1,2,jatoms),gcoef(1,1,2,iatoms),gcoef(1,1,2,jatoms),
$work(rank+1),work(rank+114),work(rank+150),
$work(rank+180),work(rank+180+25*niprim),smat,
$nbasis,gcn(1,1,2,iatoms),gcn(1,1,2,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_dd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.3) then
call oneint_fd(ncontrmax,nprimmax,gexp(1,3,jatoms),
$gexp(1,2,iatoms),gcoef(1,1,3,jatoms),gcoef(1,1,2,iatoms),
$work(rank+1),work(rank+196),work(rank+256),
$work(rank+298),work(rank+298+35*njprim),smat,
$nbasis,gcn(1,1,3,jatoms),gcn(1,1,2,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_fd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.4) then
call oneint_gd(ncontrmax,nprimmax,gexp(1,4,jatoms),
$gexp(1,2,iatoms),gcoef(1,1,4,jatoms),gcoef(1,1,2,iatoms),
$work(rank+1),work(rank+312),work(rank+402),
$work(rank+456),work(rank+456+45*njprim),smat,
$nbasis,gcn(1,1,4,jatoms),gcn(1,1,2,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_gd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.5) then
call oneint_hd(ncontrmax,nprimmax,gexp(1,5,jatoms),
$gexp(1,2,iatoms),gcoef(1,1,5,jatoms),gcoef(1,1,2,iatoms),
$work(rank+1),work(rank+470),work(rank+596),
$work(rank+662),work(rank+662+55*njprim),smat,
$nbasis,gcn(1,1,5,jatoms),gcn(1,1,2,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_hd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
endif
else if(iang.eq.3) then
if(jang.eq.0) then
call oneint_fs(ncontrmax,nprimmax,gexp(1,3,iatoms),
$gexp(1,0,jatoms),gcoef(1,1,3,iatoms),gcoef(1,1,0,jatoms),
$work(rank+1),work(rank+26),work(rank+36),
$work(rank+36),work(rank+36+7*niprim),smat,
$nbasis,gcn(1,1,3,iatoms),gcn(1,1,0,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_fs,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.1) then
call oneint_fp(ncontrmax,nprimmax,gexp(1,3,iatoms),
$gexp(1,1,jatoms),gcoef(1,1,3,iatoms),gcoef(1,1,1,jatoms),
$work(rank+1),work(rank+71),work(rank+101),
$work(rank+101),work(rank+101+21*niprim),smat,
$nbasis,gcn(1,1,3,iatoms),gcn(1,1,1,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_fp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.2) then
call oneint_fd(ncontrmax,nprimmax,gexp(1,3,iatoms),
$gexp(1,2,jatoms),gcoef(1,1,3,iatoms),gcoef(1,1,2,jatoms),
$work(rank+1),work(rank+196),work(rank+256),
$work(rank+298),work(rank+298+35*niprim),smat,
$nbasis,gcn(1,1,3,iatoms),gcn(1,1,2,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_fd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.3) then
call oneint_ff(ncontrmax,nprimmax,gexp(1,3,iatoms),
$gexp(1,3,jatoms),gcoef(1,1,3,iatoms),gcoef(1,1,3,jatoms),
$work(rank+1),work(rank+462),work(rank+562),
$work(rank+632),work(rank+632+49*niprim),smat,
$nbasis,gcn(1,1,3,iatoms),gcn(1,1,3,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_ff,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.4) then
call oneint_gf(ncontrmax,nprimmax,gexp(1,4,jatoms),
$gexp(1,3,iatoms),gcoef(1,1,4,jatoms),gcoef(1,1,3,iatoms),
$work(rank+1),work(rank+696),work(rank+846),
$work(rank+936),work(rank+936+63*njprim),smat,
$nbasis,gcn(1,1,4,jatoms),gcn(1,1,3,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_gf,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
else if(jang.eq.5) then
call oneint_hf(ncontrmax,nprimmax,gexp(1,5,jatoms),
$gexp(1,3,iatoms),gcoef(1,1,5,jatoms),gcoef(1,1,3,iatoms),
$work(rank+1),work(rank+996),work(rank+1206),
$work(rank+1316),work(rank+1316+77*njprim),smat,
$nbasis,gcn(1,1,5,jatoms),gcn(1,1,3,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_hf,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
endif
else if(iang.eq.4) then
if(jang.eq.0) then
call oneint_gs(ncontrmax,nprimmax,gexp(1,4,iatoms),
$gexp(1,0,jatoms),gcoef(1,1,4,iatoms),gcoef(1,1,0,jatoms),
$work(rank+1),work(rank+56),work(rank+71),
$work(rank+71),work(rank+71+9*niprim),smat,
$nbasis,gcn(1,1,4,iatoms),gcn(1,1,0,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_gs,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.1) then
call oneint_gp(ncontrmax,nprimmax,gexp(1,4,iatoms),
$gexp(1,1,jatoms),gcoef(1,1,4,iatoms),gcoef(1,1,1,jatoms),
$work(rank+1),work(rank+127),work(rank+172),
$work(rank+172),work(rank+172+27*niprim),smat,
$nbasis,gcn(1,1,4,iatoms),gcn(1,1,1,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_gp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.2) then
call oneint_gd(ncontrmax,nprimmax,gexp(1,4,iatoms),
$gexp(1,2,jatoms),gcoef(1,1,4,iatoms),gcoef(1,1,2,jatoms),
$work(rank+1),work(rank+312),work(rank+402),
$work(rank+456),work(rank+456+45*niprim),smat,
$nbasis,gcn(1,1,4,iatoms),gcn(1,1,2,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_gd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.3) then
call oneint_gf(ncontrmax,nprimmax,gexp(1,4,iatoms),
$gexp(1,3,jatoms),gcoef(1,1,4,iatoms),gcoef(1,1,3,jatoms),
$work(rank+1),work(rank+696),work(rank+846),
$work(rank+936),work(rank+936+63*niprim),smat,
$nbasis,gcn(1,1,4,iatoms),gcn(1,1,3,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_gf,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.4) then
call oneint_gg(ncontrmax,nprimmax,gexp(1,4,iatoms),
$gexp(1,4,jatoms),gcoef(1,1,4,iatoms),gcoef(1,1,4,jatoms),
$work(rank+1),work(rank+1386),work(rank+1611),
$work(rank+1746),work(rank+1746+81*niprim),smat,
$nbasis,gcn(1,1,4,iatoms),gcn(1,1,4,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_gg,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.5) then
call oneint_hg(ncontrmax,nprimmax,gexp(1,5,jatoms),
$gexp(1,4,iatoms),gcoef(1,1,5,jatoms),gcoef(1,1,4,iatoms),
$work(rank+1),work(rank+1931),work(rank+2246),
$work(rank+2411),work(rank+2411+99*njprim),smat,
$nbasis,gcn(1,1,5,jatoms),gcn(1,1,4,iatoms),bx,by,bz,ax,ay,az,mm,
$jjtm,njcontr,nicontr,njprim,niprim,-xab,-yab,-zab,nucatt_hg,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
smat(in1:in2,jn1:jn2)=transpose(smat(jn1:jn2,in1:in2))
endif
else if(iang.eq.5) then
if(jang.eq.0) then
call oneint_hs(ncontrmax,nprimmax,gexp(1,5,iatoms),
$gexp(1,0,jatoms),gcoef(1,1,5,iatoms),gcoef(1,1,0,jatoms),
$work(rank+1),work(rank+106),work(rank+127),
$work(rank+127),work(rank+127+11*niprim),smat,
$nbasis,gcn(1,1,5,iatoms),gcn(1,1,0,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_hs,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.1) then
call oneint_hp(ncontrmax,nprimmax,gexp(1,5,iatoms),
$gexp(1,1,jatoms),gcoef(1,1,5,iatoms),gcoef(1,1,1,jatoms),
$work(rank+1),work(rank+211),work(rank+274),
$work(rank+274),work(rank+274+33*niprim),smat,
$nbasis,gcn(1,1,5,iatoms),gcn(1,1,1,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_hp,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.2) then
call oneint_hd(ncontrmax,nprimmax,gexp(1,5,iatoms),
$gexp(1,2,jatoms),gcoef(1,1,5,iatoms),gcoef(1,1,2,jatoms),
$work(rank+1),work(rank+470),work(rank+596),
$work(rank+662),work(rank+662+55*niprim),smat,
$nbasis,gcn(1,1,5,iatoms),gcn(1,1,2,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_hd,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.3) then
call oneint_hf(ncontrmax,nprimmax,gexp(1,5,iatoms),
$gexp(1,3,jatoms),gcoef(1,1,5,iatoms),gcoef(1,1,3,jatoms),
$work(rank+1),work(rank+996),work(rank+1206),
$work(rank+1316),work(rank+1316+77*niprim),smat,
$nbasis,gcn(1,1,5,iatoms),gcn(1,1,3,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_hf,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.4) then
call oneint_hg(ncontrmax,nprimmax,gexp(1,5,iatoms),
$gexp(1,4,jatoms),gcoef(1,1,5,iatoms),gcoef(1,1,4,jatoms),
$work(rank+1),work(rank+1931),work(rank+2246),
$work(rank+2411),work(rank+2411+99*niprim),smat,
$nbasis,gcn(1,1,5,iatoms),gcn(1,1,4,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_hg,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
else if(jang.eq.5) then
call oneint_hh(ncontrmax,nprimmax,gexp(1,5,iatoms),
$gexp(1,5,jatoms),gcoef(1,1,5,iatoms),gcoef(1,1,5,jatoms),
$work(rank+1),work(rank+3446),work(rank+3887),
$work(rank+4118),work(rank+4118+121*niprim),smat,
$nbasis,gcn(1,1,5,iatoms),gcn(1,1,5,jatoms),ax,ay,az,bx,by,bz,nn,
$jjtn,nicontr,njcontr,niprim,njprim,xab,yab,zab,nucatt_hh,
$nmboys,cf,rab2,atchg,boysval,ptol,ncent,ccoord)
endif
endif
endif !Prescreening
enddo !jang
enddo !jatoms
enddo !iang
enddo !iatoms
C$OMP END PARALLEL DO
C
return
end
C