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

426 lines
21 KiB
Fortran
Executable File

************************************************************************
subroutine nuceq1(natoms,nangmax,ncontrmax,nprimmax,ncartmax,
$nsphermax,nang,nangmin,ncontr,nprim,gexp,gcoef,coord,ctostr,
$nbasis,work,nshrange,cartg,boysval,nmboys,cf,itol,ncent,dens,dpre,
$efield)
************************************************************************
* Calculate nuceq1 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,iitn,jjtn,jangmax,it1
integer idma,idmp,itrmi
integer nshrange(2,0:nangmax,natoms),itrmj
real*8 gexp(nprimmax,0:nangmax,natoms),coord(3,natoms)
real*8 gcoef(nprimmax,ncontrmax,0:nangmax,natoms)
real*8 work(*),ax,bx,ay,by,az,bz,xab2,yab2,zab2
real*8 ctostr(ncartmax**2,0:nangmax)
real*8 dpre(natoms,0:nangmax,natoms,0:nangmax)
logical cartg,ldiag
integer ncent,iprim,jprim,nmax,nmboys,mm,in1,in2,jn1,jn2
real*8 a,b,p,mu,xab,yab,zab,ptol,rab2,normg,efield(3,ncent)
real*8 boysval,cf,itol,dens(nbasis,nbasis)
interface
subroutine nuceq1_gn
end
subroutine nuceq1_ss
end
subroutine nuceq1_ps
end
subroutine nuceq1_pp
end
subroutine nuceq1_ds
end
subroutine nuceq1_dp
end
subroutine nuceq1_dd
end
subroutine nuceq1_fs
end
subroutine nuceq1_fp
end
subroutine nuceq1_fd
end
subroutine nuceq1_ff
end
subroutine nuceq1_gs
end
subroutine nuceq1_gp
end
subroutine nuceq1_gd
end
subroutine nuceq1_gf
end
subroutine nuceq1_gg
end
end interface
C Loop over atoms
do iatoms=1,natoms
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
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
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))
p=a+b
mu=a*b/p
normg=
$6.28318530717958647692528676655900577d0*dexp(-mu*rab2)/p
if(normg*dpre(iatoms,iang,jatoms,jang).gt.ptol) then
ldiag=iatoms.eq.jatoms.and.iang.eq.jang
if(iang.gt.4.or.jang.gt.4.or.cartg) then
nmax=iang+jang
isx=1
isy=isx+(nmax+2)*(iang+1)*(jang+1)
isz=isy+(nmax+2)*(iang+1)*(jang+1)
idma=isz+(nmax+2)*(iang+1)*(jang+1)
idmp=idma+nispher*nicontr*njspher*njcontr
itrmi=idmp+nicart*niprim*njcart*njprim
itrmj=itrmi+nispher*nicontr*nicart*niprim
it1=itrmj+njspher*njcontr*njcart*njprim
call nuceq1_sh(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),
$nbasis,ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_gn,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(it1),dens,
$efield,ldiag,work(idma),work(idma),work(idmp),work(itrmi),
$work(itrmj))
else if(iang.eq.0) then
if(jang.eq.0) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_ss,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(2),work(2),work(2+1*nicontr*njcontr),
$work(2+1*nicontr*njcontr+1*niprim*njprim),
$work(2+1*nicontr*njcontr+1*niprim*njprim+
$1*nicontr*niprim))
else if(jang.eq.1) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_ps,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(15),work(15),work(15+3*njcontr*nicontr),
$work(15+3*njcontr*nicontr+3*njprim*niprim),
$work(15+3*njcontr*nicontr+3*njprim*niprim+
$9*njcontr*njprim))
else if(jang.eq.2) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_ds,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(35),work(35),work(35+5*njcontr*nicontr),
$work(35+5*njcontr*nicontr+6*njprim*niprim),
$work(35+5*njcontr*nicontr+6*njprim*niprim+
$30*njcontr*njprim))
else if(jang.eq.3) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_fs,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(70),work(70),work(70+7*njcontr*nicontr),
$work(70+7*njcontr*nicontr+10*njprim*niprim),
$work(70+7*njcontr*nicontr+10*njprim*niprim+
$70*njcontr*njprim))
else if(jang.eq.4) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_gs,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(126),work(126),work(126+9*njcontr*nicontr),
$work(126+9*njcontr*nicontr+15*njprim*niprim),
$work(126+9*njcontr*nicontr+15*njprim*niprim+
$135*njcontr*njprim))
endif
else if(iang.eq.1) then
if(jang.eq.0) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_ps,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(15),work(15),work(15+3*nicontr*njcontr),
$work(15+3*nicontr*njcontr+3*niprim*njprim),
$work(15+3*nicontr*njcontr+3*niprim*njprim+
$9*nicontr*niprim))
else if(jang.eq.1) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_pp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(35),work(35),work(35+9*nicontr*njcontr),
$work(35+9*nicontr*njcontr+9*niprim*njprim),
$work(35+9*nicontr*njcontr+9*niprim*njprim+
$9*nicontr*niprim))
else if(jang.eq.2) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_dp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(70),work(70),work(70+15*njcontr*nicontr),
$work(70+15*njcontr*nicontr+18*njprim*niprim),
$work(70+15*njcontr*nicontr+18*njprim*niprim+
$30*njcontr*njprim))
else if(jang.eq.3) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_fp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(126),work(126),work(126+21*njcontr*nicontr),
$work(126+21*njcontr*nicontr+30*njprim*niprim),
$work(126+21*njcontr*nicontr+30*njprim*niprim+
$70*njcontr*njprim))
else if(jang.eq.4) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_gp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(210),work(210),work(210+27*njcontr*nicontr),
$work(210+27*njcontr*nicontr+45*njprim*niprim),
$work(210+27*njcontr*nicontr+45*njprim*niprim+
$135*njcontr*njprim))
endif
else if(iang.eq.2) then
if(jang.eq.0) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_ds,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(35),work(35),work(35+5*nicontr*njcontr),
$work(35+5*nicontr*njcontr+6*niprim*njprim),
$work(35+5*nicontr*njcontr+6*niprim*njprim+
$30*nicontr*niprim))
else if(jang.eq.1) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_dp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(70),work(70),work(70+15*nicontr*njcontr),
$work(70+15*nicontr*njcontr+18*niprim*njprim),
$work(70+15*nicontr*njcontr+18*niprim*njprim+
$30*nicontr*niprim))
else if(jang.eq.2) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_dd,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(126),work(126),work(126+25*nicontr*njcontr),
$work(126+25*nicontr*njcontr+36*niprim*njprim),
$work(126+25*nicontr*njcontr+36*niprim*njprim+
$30*nicontr*niprim))
else if(jang.eq.3) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_fd,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(210),work(210),work(210+35*njcontr*nicontr),
$work(210+35*njcontr*nicontr+60*njprim*niprim),
$work(210+35*njcontr*nicontr+60*njprim*niprim+
$70*njcontr*njprim))
else if(jang.eq.4) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_gd,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(330),work(330),work(330+45*njcontr*nicontr),
$work(330+45*njcontr*nicontr+90*njprim*niprim),
$work(330+45*njcontr*nicontr+90*njprim*niprim+
$135*njcontr*njprim))
endif
else if(iang.eq.3) then
if(jang.eq.0) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_fs,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(70),work(70),work(70+7*nicontr*njcontr),
$work(70+7*nicontr*njcontr+10*niprim*njprim),
$work(70+7*nicontr*njcontr+10*niprim*njprim+
$70*nicontr*niprim))
else if(jang.eq.1) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_fp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(126),work(126),work(126+21*nicontr*njcontr),
$work(126+21*nicontr*njcontr+30*niprim*njprim),
$work(126+21*nicontr*njcontr+30*niprim*njprim+
$70*nicontr*niprim))
else if(jang.eq.2) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_fd,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(210),work(210),work(210+35*nicontr*njcontr),
$work(210+35*nicontr*njcontr+60*niprim*njprim),
$work(210+35*nicontr*njcontr+60*niprim*njprim+
$70*nicontr*niprim))
else if(jang.eq.3) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_ff,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(330),work(330),work(330+49*nicontr*njcontr),
$work(330+49*nicontr*njcontr+100*niprim*njprim),
$work(330+49*nicontr*njcontr+100*niprim*njprim+
$70*nicontr*niprim))
else if(jang.eq.4) then
call nuceq1_sh(ncontrmax,nprimmax,gexp(1,jang,jatoms),
$gexp(1,iang,iatoms),gcoef(1,1,jang,jatoms),gcoef(1,1,iang,iatoms),
$ctostr(1,jang),ctostr(1,iang),work(1),work(1),work(1),nbasis,
$bx,by,bz,ax,ay,az,mm,nn,iitn*nbasis+jn1-1,njcontr,nicontr,njprim,
$niprim,njcart,nicart,njspher,nispher,jang,iang,nuceq1_gf,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(495),work(495),work(495+63*njcontr*nicontr),
$work(495+63*njcontr*nicontr+150*njprim*niprim),
$work(495+63*njcontr*nicontr+150*njprim*niprim+
$135*njcontr*njprim))
endif
else if(iang.eq.4) then
if(jang.eq.0) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_gs,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(126),work(126),work(126+9*nicontr*njcontr),
$work(126+9*nicontr*njcontr+15*niprim*njprim),
$work(126+9*nicontr*njcontr+15*niprim*njprim+
$135*nicontr*niprim))
else if(jang.eq.1) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_gp,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(210),work(210),work(210+27*nicontr*njcontr),
$work(210+27*nicontr*njcontr+45*niprim*njprim),
$work(210+27*nicontr*njcontr+45*niprim*njprim+
$135*nicontr*niprim))
else if(jang.eq.2) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_gd,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(330),work(330),work(330+45*nicontr*njcontr),
$work(330+45*nicontr*njcontr+90*niprim*njprim),
$work(330+45*nicontr*njcontr+90*niprim*njprim+
$135*nicontr*niprim))
else if(jang.eq.3) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_gf,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(495),work(495),work(495+63*nicontr*njcontr),
$work(495+63*nicontr*njcontr+150*niprim*njprim),
$work(495+63*nicontr*njcontr+150*niprim*njprim+
$135*nicontr*niprim))
else if(jang.eq.4) then
call nuceq1_sh(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(1),work(1),work(1),nbasis,
$ax,ay,az,bx,by,bz,nn,mm,jjtn,nicontr,njcontr,niprim,
$njprim,nicart,njcart,nispher,njspher,iang,jang,nuceq1_gg,nmboys,
$cf,nmax,rab2,boysval,ptol,ncent,coord(1,natoms+1),work(1),dens,
$efield,ldiag,work(715),work(715),work(715+81*nicontr*njcontr),
$work(715+81*nicontr*njcontr+225*niprim*njprim),
$work(715+81*nicontr*njcontr+225*niprim*njprim+
$135*nicontr*niprim))
endif
endif
endif !Prescreening
enddo !jang
enddo !jatoms
enddo !iang
enddo !iatoms
C
return
end
C