mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-16 11:48:06 +01:00
656 lines
22 KiB
Fortran
Executable File
656 lines
22 KiB
Fortran
Executable File
************************************************************************
|
|
subroutine calcorb(ngrid,grid,natoms,nangmax,ncontrmax,nprimmax,
|
|
$ncartmax,nsphermax,nang,ncontr,nprim,gexp,gcoef,coord,ctostr,
|
|
$cartg,dvec,nbasis,gexp2,ibasis,nangmin,gcn,itol,lpre,bfmap,
|
|
$iatrange)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,natoms,nangmax,ncontrmax,nprimmax,ncartmax,nsphermax
|
|
integer nang(natoms),ncontr(0:nangmax,natoms),iatoms,igrid,jbasis
|
|
integer nprim(0:nangmax,natoms),nicontr,niprim,nicart,nispher,iang
|
|
integer nangmin(natoms),gcn(2,ncontrmax,0:nangmax,natoms),i,j,ii
|
|
integer nbasis,ibasis,iprim,bfmap(nbasis),iatrange(2,natoms)
|
|
integer icontr
|
|
real*8 grid(3,ngrid),gexp(nprimmax,0:nangmax,natoms),r2,itol,cmax
|
|
real*8 gcoef(nprimmax,ncontrmax,0:nangmax,natoms)
|
|
real*8 coord(3,natoms),ctostr(ncartmax**2,0:nangmax),rmin,rmax
|
|
real*8 x,y,z,ax,ay,az,gexp2(nprimmax),dvec(ngrid*1,nbasis),amin,a
|
|
logical cartg,lat,lpre
|
|
C Loop over atoms
|
|
ibasis=0
|
|
jbasis=0
|
|
do iatoms=1,natoms
|
|
if(lpre) iatrange(1,iatoms)=ibasis
|
|
x=coord(1,iatoms)
|
|
y=coord(2,iatoms)
|
|
z=coord(3,iatoms)
|
|
C Prescreening
|
|
rmin=1d30
|
|
rmax=1.d0
|
|
C$OMP PARALLEL DO Schedule(Static)
|
|
C$OMP& DEFAULT(SHARED)
|
|
C$OMP& PRIVATE(igrid,ax,ay,az,r2)
|
|
C$OMP& REDUCTION(min:rmin)
|
|
C$OMP& REDUCTION(max:rmax)
|
|
do igrid=1,ngrid
|
|
ax=grid(1,igrid)-x
|
|
ay=grid(2,igrid)-y
|
|
az=grid(3,igrid)-z
|
|
r2=ax*ax+ay*ay+az*az
|
|
rmin=min(rmin,r2)
|
|
rmax=max(rmax,r2)
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
rmin=dsqrt(rmin)
|
|
rmax=dsqrt(rmax)
|
|
C Loop over angular momenta
|
|
do iang=nangmin(iatoms),nang(iatoms)
|
|
nicontr=ncontr(iang,iatoms)
|
|
niprim=nprim(iang,iatoms)
|
|
nicart=(iang+1)*(iang+2)/2
|
|
nispher=2*iang+1
|
|
if(cartg) nispher=nicart
|
|
amin=1d30
|
|
cmax=0.d0
|
|
do iprim=1,niprim
|
|
a=gexp(iprim,iang,iatoms)
|
|
amin=min(amin,a)
|
|
gexp2(iprim)=-a
|
|
do icontr=1,nicontr
|
|
cmax=max(cmax,dabs(gcoef(iprim,icontr,iang,iatoms)))
|
|
enddo
|
|
enddo
|
|
cmax=dble(niprim)*cmax
|
|
if(cmax*rmax**(iang+0)*dexp(-amin*rmin*rmin).ge.itol) then
|
|
if(iang.gt.5.or.cartg) then
|
|
call calco0_gn(ngrid,grid,x,y,z,niprim,nicontr,nispher,
|
|
$nicart,nprimmax,gcoef(1,1,iang,iatoms),ctostr(1,iang),gexp2,iang,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
else if(iang.eq.0) then
|
|
call calco0_s(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef(1,1,iang,iatoms),gexp2,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
else if(iang.eq.1) then
|
|
call calco0_p(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef(1,1,iang,iatoms),gexp2,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
else if(iang.eq.2) then
|
|
call calco0_d(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef(1,1,iang,iatoms),gexp2,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
else if(iang.eq.3) then
|
|
call calco0_f(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef(1,1,iang,iatoms),gexp2,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
else if(iang.eq.4) then
|
|
call calco0_g(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef(1,1,iang,iatoms),gexp2,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
else if(iang.eq.5) then
|
|
call calco0_h(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef(1,1,iang,iatoms),gexp2,
|
|
$gcn(1,1,iang,iatoms),dvec(1,ibasis+1),nbasis)
|
|
endif
|
|
if(lpre) then
|
|
ii=0
|
|
do i=ibasis+1,ibasis+nispher*nicontr
|
|
jbasis=jbasis+1
|
|
lat=.false.
|
|
do j=1,ngrid*1
|
|
if(dabs(dvec(j,i)).ge.itol) then
|
|
lat=.true.
|
|
exit
|
|
endif
|
|
enddo
|
|
if(lat) then
|
|
ii=ii+1
|
|
bfmap(ibasis+ii)=jbasis
|
|
if(ibasis+ii.ne.i)
|
|
$ dvec(1:ngrid*1,ibasis+ii)=dvec(1:ngrid*1,i)
|
|
endif
|
|
enddo
|
|
ibasis=ibasis+ii
|
|
else
|
|
ibasis=ibasis+nispher*nicontr
|
|
endif
|
|
else
|
|
if(lpre) then
|
|
jbasis=jbasis+nispher*nicontr
|
|
else
|
|
ibasis=ibasis+nispher*nicontr
|
|
endif
|
|
endif
|
|
enddo
|
|
if(lpre) iatrange(2,iatoms)=ibasis
|
|
enddo
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_gn(ngrid,grid,x,y,z,niprim,nicontr,nispher,
|
|
$nicart,nprimmax,gcoef,ctostr,gexp2,iang,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid, general shell
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,iang,nicontr,nispher
|
|
integer nicart,nprimmax,icart,gcn(2,*),icontr,j1,j2,ispher
|
|
integer nbasis
|
|
real*8 grid(3,ngrid),ax,ay,az,r2,x,y,z,a,gexp2(niprim),ex,exa
|
|
real*8 gcoef(nprimmax,*),ctostr(nispher,nicart),inta(nicart)
|
|
real*8 intr(niprim),ints(nispher),inti
|
|
real*8 dvec(ngrid,nbasis),axy,axz,ayz,ax2,ay2,az2,exa2
|
|
C Loop over grid points
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,iang,gcn,ctostr,gcoef,dvec)
|
|
C$OMP& SHARED(nicontr,nispher)
|
|
do igrid=1,ngrid
|
|
ax=grid(1,igrid)-x
|
|
ay=grid(2,igrid)-y
|
|
az=grid(3,igrid)-z
|
|
ax2=ax*ax
|
|
ay2=ay*ay
|
|
az2=az*az
|
|
r2=ax2+ay2+az2
|
|
do iprim=1,niprim
|
|
ex=dexp(gexp2(iprim)*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
icart=0
|
|
do i=0,iang
|
|
do j=0,iang-i
|
|
k=iang-i-j
|
|
icart=icart+1
|
|
inta(icart)=ax**i*ay**j*az**k
|
|
enddo
|
|
enddo
|
|
ints=matmul(ctostr,inta)
|
|
ii=0
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
inti=dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
dvec(igrid,ii+1:ii+nispher)=ints(1:nispher)*inti
|
|
ii=ii+nispher
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_s(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef,gexp2,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,nicontr
|
|
integer nprimmax,gcn(2,*),icontr,j1,j2,ispher,nbasis
|
|
real*8 grid(3,ngrid),x,y,z,a,gexp2(niprim)
|
|
real*8 gcoef(nprimmax,*),intr(niprim),inti,dvec(ngrid,nbasis),ex
|
|
real*8 r2,a001,a002,a010,a011,a020,a100,a101,a110,a200
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,gcn,gcoef,dvec,nicontr)
|
|
do igrid=1,ngrid
|
|
a100=grid(1,igrid)-x
|
|
a010=grid(2,igrid)-y
|
|
a001=grid(3,igrid)-z
|
|
a002=a001*a001
|
|
a020=a010*a010
|
|
a200=a100*a100
|
|
r2=a200+a020+a002
|
|
do iprim=1,niprim
|
|
a=gexp2(iprim)
|
|
ex=dexp(a*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
dvec(igrid,icontr)=
|
|
$dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_p(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef,gexp2,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,nicontr
|
|
integer nprimmax,gcn(2,*),icontr,j1,j2,ispher,nbasis
|
|
real*8 grid(3,ngrid),x,y,z,a,gexp2(niprim)
|
|
real*8 gcoef(nprimmax,*),intr(niprim),inti,dvec(ngrid,nbasis),ex
|
|
real*8 r2,a001,a002,a010,a011,a020,a100,a101,a110,a200
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,gcn,gcoef,dvec,nicontr)
|
|
do igrid=1,ngrid
|
|
a100=grid(1,igrid)-x
|
|
a010=grid(2,igrid)-y
|
|
a001=grid(3,igrid)-z
|
|
a002=a001*a001
|
|
a020=a010*a010
|
|
a200=a100*a100
|
|
r2=a200+a020+a002
|
|
do iprim=1,niprim
|
|
a=gexp2(iprim)
|
|
ex=dexp(a*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
ii=0
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
inti=dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
ii=ii+1
|
|
dvec(igrid,ii)=a001*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=a010*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=a100*inti
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_d(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef,gexp2,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,nicontr
|
|
integer nprimmax,gcn(2,*),icontr,j1,j2,ispher,nbasis
|
|
real*8 grid(3,ngrid),x,y,z,a,gexp2(niprim)
|
|
real*8 gcoef(nprimmax,*),intr(niprim),inti,dvec(ngrid,nbasis),ex
|
|
real*8 ints(5)
|
|
real*8 r2,a001,a002,a010,a011,a020,a100,a101,a110,a200
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,gcn,gcoef,dvec,nicontr)
|
|
do igrid=1,ngrid
|
|
a100=grid(1,igrid)-x
|
|
a010=grid(2,igrid)-y
|
|
a001=grid(3,igrid)-z
|
|
a002=a001*a001
|
|
a020=a010*a010
|
|
a200=a100*a100
|
|
r2=a200+a020+a002
|
|
do iprim=1,niprim
|
|
a=gexp2(iprim)
|
|
ex=dexp(a*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
a011=a010*a001
|
|
a101=a100*a001
|
|
a110=a100*a010
|
|
ints(1)=a110*1.73205080756887697113d0
|
|
ints(2)=a011*1.73205080756887697113d0
|
|
ints(3)=a002-(a020+a200)*0.5d0
|
|
ints(4)=a101*1.73205080756887697113d0
|
|
ints(5)=(a200-a020)*0.86602540378443848557d0
|
|
ii=0
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
inti=dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(1)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(2)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(3)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(4)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(5)*inti
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_f(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef,gexp2,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,nicontr
|
|
integer nprimmax,gcn(2,*),icontr,j1,j2,ispher,nbasis
|
|
real*8 grid(3,ngrid),x,y,z,a,gexp2(niprim)
|
|
real*8 gcoef(nprimmax,*),intr(niprim),inti,dvec(ngrid,nbasis),ex
|
|
real*8 ints(7)
|
|
real*8 r2,a001,a002,a003,a010,a011,a012,a020,a021,a030,a100,a101,a
|
|
$102,a110,a111,a120,a200,a201,a210,a300
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,gcn,gcoef,dvec,nicontr)
|
|
do igrid=1,ngrid
|
|
a100=grid(1,igrid)-x
|
|
a010=grid(2,igrid)-y
|
|
a001=grid(3,igrid)-z
|
|
a002=a001*a001
|
|
a003=a002*a001
|
|
a020=a010*a010
|
|
a030=a020*a010
|
|
a200=a100*a100
|
|
a300=a200*a100
|
|
r2=a200+a020+a002
|
|
do iprim=1,niprim
|
|
a=gexp2(iprim)
|
|
ex=dexp(a*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
a011=a010*a001
|
|
a012=a011*a001
|
|
a021=a020*a001
|
|
a101=a100*a001
|
|
a102=a101*a001
|
|
a110=a100*a010
|
|
a111=a110*a001
|
|
a120=a110*a010
|
|
a201=a200*a001
|
|
a210=a200*a010
|
|
ints(1)=a210*2.37170824512628453107d0-a030*0.7905694150420947696
|
|
$7d0
|
|
ints(2)=a111*3.87298334620741657730d0
|
|
ints(3)=a012*2.44948974278317788134d0-(a030+a210)*0.612372435695
|
|
$79447033d0
|
|
ints(4)=a003-(a021+a201)*1.5d0
|
|
ints(5)=a102*2.44948974278317788134d0-(a120+a300)*0.612372435695
|
|
$79447033d0
|
|
ints(6)=(a201-a021)*1.93649167310370828865d0
|
|
ints(7)=a300*0.79056941504209476967d0-a120*2.3717082451262845310
|
|
$7d0
|
|
ii=0
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
inti=dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(1)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(2)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(3)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(4)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(5)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(6)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(7)*inti
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_g(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef,gexp2,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,nicontr
|
|
integer nprimmax,gcn(2,*),icontr,j1,j2,ispher,nbasis
|
|
real*8 grid(3,ngrid),x,y,z,a,gexp2(niprim)
|
|
real*8 gcoef(nprimmax,*),intr(niprim),inti,dvec(ngrid,nbasis),ex
|
|
real*8 ints(9)
|
|
real*8 r2,a001,a002,a003,a004,a010,a011,a012,a013,a020,a021,a022,a
|
|
$030,a031,a040,a100,a101,a102,a103,a110,a111,a112,a120,a121,a130,a2
|
|
$00,a201,a202,a210,a211,a220,a300,a301,a310,a400
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,gcn,gcoef,dvec,nicontr)
|
|
do igrid=1,ngrid
|
|
a100=grid(1,igrid)-x
|
|
a010=grid(2,igrid)-y
|
|
a001=grid(3,igrid)-z
|
|
a002=a001*a001
|
|
a003=a002*a001
|
|
a004=a003*a001
|
|
a020=a010*a010
|
|
a030=a020*a010
|
|
a040=a030*a010
|
|
a200=a100*a100
|
|
a300=a200*a100
|
|
a400=a300*a100
|
|
r2=a200+a020+a002
|
|
do iprim=1,niprim
|
|
a=gexp2(iprim)
|
|
ex=dexp(a*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
a011=a010*a001
|
|
a012=a011*a001
|
|
a013=a012*a001
|
|
a021=a020*a001
|
|
a022=a021*a001
|
|
a031=a030*a001
|
|
a101=a100*a001
|
|
a102=a101*a001
|
|
a103=a102*a001
|
|
a110=a100*a010
|
|
a111=a110*a001
|
|
a112=a111*a001
|
|
a120=a110*a010
|
|
a121=a120*a001
|
|
a130=a120*a010
|
|
a201=a200*a001
|
|
a202=a201*a001
|
|
a210=a200*a010
|
|
a211=a210*a001
|
|
a220=a210*a010
|
|
a301=a300*a001
|
|
a310=a300*a010
|
|
ints(1)=(a310-a130)*2.95803989154980806475d0
|
|
ints(2)=a211*6.27495019900556627590d0-a031*2.0916500663351889066
|
|
$6d0
|
|
ints(3)=a112*6.70820393249936941515d0-(a130+a310)*1.118033988749
|
|
$89490253d0
|
|
ints(4)=a013*3.16227766016837907870d0-(a031+a211)*2.371708245126
|
|
$28453107d0
|
|
ints(5)=a004-(a022+a202)*3.d0+(a040+a400)*0.375d0+a220*0.75d0
|
|
ints(6)=a103*3.16227766016837907870d0-(a121+a301)*2.371708245126
|
|
$28453107d0
|
|
ints(7)=(a202-a022)*3.35410196624968470758d0+(a040-a400)*0.55901
|
|
$699437494745126d0
|
|
ints(8)=a301*2.09165006633518890666d0-a121*6.2749501990055662759
|
|
$0d0
|
|
ints(9)=(a040+a400)*0.73950997288745201619d0-a220*4.437059837324
|
|
$71231917d0
|
|
ii=0
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
inti=dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(1)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(2)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(3)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(4)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(5)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(6)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(7)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(8)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(9)*inti
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine calco0_h(ngrid,grid,x,y,z,niprim,nicontr,
|
|
$nprimmax,gcoef,gexp2,gcn,dvec,nbasis)
|
|
************************************************************************
|
|
* Calculate orbital values on grid
|
|
************************************************************************
|
|
implicit none
|
|
integer ngrid,igrid,ii,iprim,niprim,i,j,k,nicontr
|
|
integer nprimmax,gcn(2,*),icontr,j1,j2,ispher,nbasis
|
|
real*8 grid(3,ngrid),x,y,z,a,gexp2(niprim)
|
|
real*8 gcoef(nprimmax,*),intr(niprim),inti,dvec(ngrid,nbasis),ex
|
|
real*8 ints(11)
|
|
real*8 r2,a001,a002,a003,a004,a005,a010,a011,a012,a013,a014,a020,a
|
|
$021,a022,a023,a030,a031,a032,a040,a041,a050,a100,a101,a102,a103,a1
|
|
$04,a110,a111,a112,a113,a120,a121,a122,a130,a131,a140,a200,a201,a20
|
|
$2,a203,a210,a211,a212,a220,a221,a230,a300,a301,a302,a310,a311,a320
|
|
$,a400,a401,a410,a500
|
|
C$OMP PARALLEL DO
|
|
C$OMP& DEFAULT(PRIVATE)
|
|
C$OMP& SHARED(ngrid,grid,x,y,z,niprim,gexp2,gcn,gcoef,dvec,nicontr)
|
|
do igrid=1,ngrid
|
|
a100=grid(1,igrid)-x
|
|
a010=grid(2,igrid)-y
|
|
a001=grid(3,igrid)-z
|
|
a002=a001*a001
|
|
a003=a002*a001
|
|
a004=a003*a001
|
|
a005=a004*a001
|
|
a020=a010*a010
|
|
a030=a020*a010
|
|
a040=a030*a010
|
|
a050=a040*a010
|
|
a200=a100*a100
|
|
a300=a200*a100
|
|
a400=a300*a100
|
|
a500=a400*a100
|
|
r2=a200+a020+a002
|
|
do iprim=1,niprim
|
|
a=gexp2(iprim)
|
|
ex=dexp(a*r2)
|
|
intr(iprim)=ex
|
|
enddo
|
|
a011=a010*a001
|
|
a012=a011*a001
|
|
a013=a012*a001
|
|
a014=a013*a001
|
|
a021=a020*a001
|
|
a022=a021*a001
|
|
a023=a022*a001
|
|
a031=a030*a001
|
|
a032=a031*a001
|
|
a041=a040*a001
|
|
a101=a100*a001
|
|
a102=a101*a001
|
|
a103=a102*a001
|
|
a104=a103*a001
|
|
a110=a100*a010
|
|
a111=a110*a001
|
|
a112=a111*a001
|
|
a113=a112*a001
|
|
a120=a110*a010
|
|
a121=a120*a001
|
|
a122=a121*a001
|
|
a130=a120*a010
|
|
a131=a130*a001
|
|
a140=a130*a010
|
|
a201=a200*a001
|
|
a202=a201*a001
|
|
a203=a202*a001
|
|
a210=a200*a010
|
|
a211=a210*a001
|
|
a212=a211*a001
|
|
a220=a210*a010
|
|
a221=a220*a001
|
|
a230=a220*a010
|
|
a301=a300*a001
|
|
a302=a301*a001
|
|
a310=a300*a010
|
|
a311=a310*a001
|
|
a320=a310*a010
|
|
a401=a400*a001
|
|
a410=a400*a010
|
|
ints(1)=a050*0.70156076002011391601d0-a230*7.0156076002011387160
|
|
$5d0+a410*3.50780380010056935802d0
|
|
ints(2)=(a311-a131)*8.87411967464942463835d0
|
|
ints(3)=a050*0.52291251658379711564d0-a032*4.1833001326703769251
|
|
$5d0+a212*12.54990039801113255180d0-a230*1.04582503316759423129d0-a
|
|
$410*1.56873754975139156898d0
|
|
ints(4)=a113*10.24695076595959974952d0-(a131+a311)*5.12347538297
|
|
$979987476d0
|
|
ints(5)=a014*3.87298334620741613321d0-(a032+a212)*5.809475019311
|
|
$12419982d0+a230*0.96824583655185403330d0+(a050+a410)*0.48412291827
|
|
$592701665d0
|
|
ints(6)=a005-(a023+a203)*5.d0+a221*3.75d0+(a041+a401)*1.875d0
|
|
ints(7)=a104*3.87298334620741613321d0-(a122+a302)*5.809475019311
|
|
$12419982d0+a320*0.96824583655185403330d0+(a140+a500)*0.48412291827
|
|
$592701665d0
|
|
ints(8)=(a203-a023)*5.12347538297979987476d0+(a041-a401)*2.56173
|
|
$769148989993738d0
|
|
ints(9)=a140*1.56873754975139156898d0-a122*12.549900398011132551
|
|
$80d0+a302*4.18330013267037692515d0+a320*1.04582503316759423129d0-a
|
|
$500*0.52291251658379711564d0
|
|
ints(10)=(a041+a401)*2.21852991866235615959d0-a221*13.3111795119
|
|
$7413695752d0
|
|
ints(11)=a140*3.50780380010056935802d0-a320*7.015607600201138716
|
|
$05d0+a500*0.70156076002011391601d0
|
|
ii=0
|
|
do icontr=1,nicontr
|
|
j1=gcn(1,icontr)
|
|
j2=gcn(2,icontr)
|
|
inti=dot_product(gcoef(j1:j2,icontr),intr(j1:j2))
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(1)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(2)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(3)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(4)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(5)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(6)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(7)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(8)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(9)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(10)*inti
|
|
ii=ii+1
|
|
dvec(igrid,ii)=ints(11)*inti
|
|
enddo
|
|
enddo
|
|
C$OMP END PARALLEL DO
|
|
C
|
|
return
|
|
end
|
|
C
|