LCPQ/quack
4
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-22 04:14:26 +01:00
Code Releases Activity

inital commit for quack

Browse Source
This commit is contained in:
Pierre-Francois Loos 2019-02-07 22:49:12 +01:00
parent b484fce849
commit 86964672d7
363 changed files with 23876 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
GoDuck Executable file
View File

@ -0,0 +1,18 @@
#! /bin/bash
set -e
if [ $# -ne 2 ]
then
echo "You need two arguments [Molecule] [Basis] !!"
fi
if [ $# = 2 ]
then
cp examples/molecule."$1" input/molecule
cp examples/basis."$1"."$2" input/basis
cp examples/basis."$1"."$2" input/weight
./bin/IntPak
./bin/MCQC
fi

17
GoSph Executable file
View File

@ -0,0 +1,17 @@
#! /bin/bash
if [ $# -ne 1 ]
then
echo "You need one argument [BasisSetSize] !!"
fi
if [ $# = 1 ]
then
cp examples/molecule.Sph input/molecule
cp examples/basis.Sph.Ylm"$1" input/basis
cp int/Sph_ERI_"$1".dat int/ERI.dat
cp int/Sph_Kin_"$1".dat int/Kin.dat
cp int/Sph_Nuc_"$1".dat int/Nuc.dat
cp int/Sph_Ov_"$1".dat int/Ov.dat
./bin/MCQC
fi

321
PyDuck Executable file
View File

@ -0,0 +1,321 @@
#!/usr/bin/env python2
import sys
from termcolor import colored
import shlex
from subprocess import Popen, PIPE
import itertools
import re
import numpy as np
import os
from shutil import copy2
import matplotlib.pyplot as plt
import json
from math import *
from collections import OrderedDict
import csv
import argparse
def GetDuckDir():
return os.path.dirname(os.path.realpath(__file__))
def nNucl(molbaselines):
return float(molbaselines[1].split()[0])
def isMononucle(molbaselines):
return nNucl(molbaselines)==1
def openfileindir(path,readwrite):
mydir=os.path.dirname(path)
if not os.path.exists(mydir) and mydir!="":
os.makedirs(mydir)
return open(path,readwrite)
def outfile(Outdic,item,index=None):
itemdata=Outdic[item]
if itemdata["Enabled"]:
fmt=itemdata["Format"]
if index is not None:
filename=fmt.format(index)
else:
filename=fmt
if "Parent" in Outdic:
path=os.path.join(Outdic["Parent"],filename)
else:
path=filename
return openfileindir(path,'w')
else:
return
def runDuck(mol,basis,x,molbaselines,molbase,basisbase):
#gennerate molecule file
currdir=os.getcwd()
os.chdir(GetDuckDir())
molname='.'.join([mol,str(x)])
lstw=list()
for i,line in enumerate(molbaselines):
if i<3:
lstw.append(line)
else:
if isMononucle(molbaselines):
if i==3:
lstw.append(' '.join([str(x)]+line.split()[1:]))
else:
v=[float(abs(x))/float(2),float(-abs(x)/float(2))]
val=v[i-3]
lstw.append(' '.join([line.split()[0],'0.','0.',str(val)]))
junkfiles=list()
with open(molbase+molname,'w') as n:
junkfiles.append(n.name)
n.write(os.linesep.join(lstw))
#Copy basis
basisfile=basisbase+'.'.join([mol,basis])
newbasisfile=basisbase+'.'.join([molname,basis])
copy2(basisfile,newbasisfile)
junkfiles.append(newbasisfile)
#start child process Goduck
cmd=" ".join(["./GoDuck",molname, basis])
Duck=Popen(shlex.split(cmd),stdout=PIPE)
(DuckOut, DuckErr) = Duck.communicate()
excode=Duck.wait()
for junk in junkfiles:
os.remove(junk)
os.chdir(currdir)
return (excode,DuckOut,DuckErr)
def addvalue(dic,key,x,y):
if key not in dic:
dic[key]=list()
dic[key].append(y)
print(key)
print(x,y)
def main(mol):
#get basepath for files
molbase='examples/molecule.'
basisbase=molbase.replace('molecule','basis')
with open('PyOptions.json','r') as jfile:
options=json.loads(jfile.read())
basis=str(options['Basis'])
#Get mehtod to analyse
methodsdic=options['Methods']
#Get datas to analyse in this method
scandic=options['Scan']
scan=np.arange(scandic['Start'],scandic['Stop']+scandic['Step'],scandic['Step'])
print(scan)
mymethods=dict()
alllabels=list()
for method,methoddatas in methodsdic.iteritems():
if methoddatas['Enabled']:
mymethods[method]=methoddatas
for label,labeldatas in methoddatas['Labels'].iteritems():
if type(labeldatas) is dict:
enabled=labeldatas['Enabled']
else:
enabled=labeldatas
if enabled and label not in alllabels:
alllabels.append(label)
graphdic=dict()
errorconvstring="Convergence failed"
with open(os.path.join(GetDuckDir(),molbase+mol),'r') as b:
molbaselines=b.read().splitlines()
if isMononucle(molbaselines):
print('monoatomic system: variation of the nuclear charge')
else:
print('polyatomic system: variation is on the distance')
for x in scan:
(DuckExit,DuckOut,DuckErr)=runDuck(mol,basis,x,molbaselines,molbase,basisbase)
#print DuckOut on file or not
if "Outputs" in options:
outdat=options["Outputs"]
if 'DuckOutput' in outdat:
outopt=outdat["DuckOutput"]
if outopt['Enabled']:
if outopt['Multiple']:
duckoutf=outfile(outopt,"DuckOutput",x)
else:
if x==scan[0]:
duckoutf=outfile(outdat,"DuckOutput")
duckoutf.write('Z' if isMononucle(molbaselines) else 'Distance'+' '+str(x)+os.linesep+os.linesep)
duckoutf.write(DuckOut)
if outopt['Multiple']:
duckoutf.close()
print("GoDuk exit code " + str(DuckExit))
if DuckExit !=0:
#if GoDuck is not happy
print(DuckErr)
sys.exit(-1)
#get all data for the method
for method,methoddatas in mymethods.iteritems():
isnan=False
if '{0}' in method:
if "index" in methoddatas:
methodheaders=[method.format(str(x)) for x in methoddatas['Index']]
else:
try:
print(method)
reglist=re.findall('(\d+)'.join([re.escape(s) for s in method.split('{0}')]),DuckOut)
print(reglist)
final=max([(int(i[0]) if type(i) is tuple else int(i)) for i in reglist])
print(final)
methodheaders=[method.format(str(final))]
except:
isnan=True
methodheaders=[None]
method=method.replace('{0}','')
else:
methodheaders=list([method])
for methodheader in methodheaders:
if len(methodheaders)!=1:
method=methodheader
lbldic=methoddatas['Labels']
print(methodheader)
if methodheader is None:
methodtxt=''
else:
it=itertools.dropwhile(lambda line: methodheader + ' calculation' not in line , DuckOut.splitlines())
it=itertools.takewhile(lambda line: 'Total CPU time for ' not in line, it)
methodtxt=os.linesep.join(it)
if errorconvstring in methodtxt:
print(colored(' '.join([method, errorconvstring, '!!!!!']),'red'))
isnan=True
if methodtxt=='':
print(colored('No data' +os.linesep+ 'RHF scf not converged or method not enabled','red'))
isnan=True
#find the expected values
for label,labeldatas in lbldic.iteritems():
if type(labeldatas) is dict:
indexed=('Index' in labeldatas)
enabled=labeldatas['Enabled']
graph=labeldatas['Graph'] if 'Graph' in labeldatas else 1
else:
enabled=labeldatas
graph=1
indexed=False
if enabled:
if graph not in graphdic:
graphdic[graph]=OrderedDict()
y=graphdic[graph]
if not indexed:
v=np.nan
print(method)
print(label)
if not isnan:
try:
m=re.search('\s+'.join([re.escape(w) for w in label.split()]) + "\s+(?:"+re.escape("(eV):")+"\s+)?(?:=\s+)?(-?\d+.?\d*)",methodtxt)
v=m.group(1)
except:
v=np.nan
addvalue(y,(method,label),x,v)
else:
startindex=-1
columnindex=-1
linedtxt=methodtxt.split(os.linesep)
for n,line in enumerate(linedtxt):
if all(x in line for x in ['|',' '+label+' ','#']):
startindex=n+2
columnindex=[s.strip() for s in line.split('|')].index(label)
break
with open(os.path.join(GetDuckDir(),'input','molecule'),'r') as molfile:
molfile.readline()
line=molfile.readline()
nel=int(line.split()[1])
print(nel)
HOMO=int(nel/2)
HO=HOMO
LUMO=HOMO+1
BV=LUMO
for i in labeldatas['Index']:
v=np.nan
if type(i) is str or type(i) is unicode:
ival=eval(i)
if type(ival) is not int:
print('Index '+ str(i) + 'must be integer')
sys.exit(-2)
else:
ival=i
v=np.nan
if not isnan:
try:
if startindex!=-1 and columnindex!=-1:
line=linedtxt[startindex+ival-1]
v=float(line.split('|')[columnindex].split()[0])
print(method)
print(label)
print(i)
else:
v=np.nan
except:
v=np.nan
key=(method,label,i)
addvalue(y,key,x,v)
tpl=(x,scan.tolist().index(x)+1,len(y[key]))
print(tpl)
if tpl[1]-tpl[2]:
sys.exit()
#define graph grid
maxgraph=max(graphdic.keys())
maxrow=int(round(sqrt(maxgraph)))
maxcol=int(ceil(float(maxgraph)/float(maxrow)))
#define label ls
for graph,y in graphdic.iteritems():
datas=list()
datas.append(["#x"]+scan.tolist())
if len(y.keys())!=0:
plt.subplot(maxrow,maxcol,graph)
plt.xlabel('Z' if isMononucle(molbaselines) else 'Distance '+mol)
ylbls=list([basis])
for i in range(0,2):
lst=list(set([key[i] for key in y.keys()]))
if len(lst)==1:
ylbls.append(lst[0])
plt.ylabel(' '.join(ylbls))
print('Legend')
print(list(y.keys()))
for key,values in y.iteritems():
legend=list()
for el in key[0:2]:
if el not in ylbls:
legend.append(el)
if len(key)>2:
legend.append(str(key[2]))
#plot curves
lbl=' '.join(legend)
plt.plot(scan,y[key],'-o',label=lbl)
#print("min",x[y.index(min(y))]/2)
#generate legends
plt.legend()
dataout=False
if "Outputs" in options:
outputs=options['Outputs']
if "DataOutput" in outputs:
DataOutput=outputs['DataOutput']
dataout=DataOutput['Enabled']
if dataout:
fmtlegendf='{0}({1})'
datas.append([fmtlegendf.format("y",lbl)]+y[key])
if dataout:
csvdatas=zip(*datas)
with outfile(outputs,"DataOutput",graph) as csvf:
writer = csv.writer(csvf, delimiter=' ')
writer.writerow(['#']+ylbls)
writer.writerows(csvdatas)
#show graph
if "Outputs" in options:
outputs=options['Outputs']
if "FigureOutput" in outputs:
figout=outputs["FigureOutput"]
if figout["Enabled"]:
plt.savefig(figout['Path'])
plt.show()
if __name__ == '__main__':
parser=argparse.ArgumentParser()
parser.add_argument("mol",nargs='?', help="molecule to compute",type=str)
parser.add_argument("-c,--copy", help="Copy sample option file",action="store_true",dest="copy")
args = parser.parse_args()
if len(sys.argv)==1:
parser.print_help()
else:
if args.copy:
copy2(os.path.join(GetDuckDir(),"PyOptions.template.json"),"PyOptions.json")
if args.mol is not None:
os.system("vim PyOptions.json")
if args.mol is not None:
main(args.mol)

145
PyOptions.json Normal file
View File

@ -0,0 +1,145 @@
{
"Scan": {
"Start":0.8,
"Stop":1.2,
"Step":0.01
},
"Basis":"6-31G",
"Outputs": {
"DataOutput": {
"Enabled":true,
"Format":"Duck{0}.dat"
},
"DuckOutput": {
"Enabled":true,
"Multiple":false,
"Format":"DuckOut.out"
},
"FigureOutput":{
"Enabled":false,
"Path":"Figure.png"
}
},
"Methods": {
"RHF":{
"Enabled": true,
"Labels": {
"One-electron energy":false,
"Kinetic energy":false,
"Potential energy":false,
"Two-electron energy":false,
"Coulomb energy":false,
"Exchange energy":false,
"Electronic energy":false,
"Nuclear repulsion":false,
"Hartree-Fock energy":true,
"HF HOMO energy":false,
"HF LUMO energy":false,
"HF HOMO-LUMO gap":false
}
},
"One-shot G0W0": {
"Enabled": true,
"Labels": {
"G0W0 HOMO energy":true,
"G0W0 LUMO energy":true,
"G0W0 HOMO-LUMO gap":false,
"G0W0 total energy":false,
"RPA correlation energy" :false,
"Z": {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":1
},
"Sigma_c (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":2
},
"e_QP (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO+1","LUMO+2"],
"Graph":3
},
"e_HF (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":4
}
}
},
"Self-consistent evG{0}W{0}": {
"Enabled":false,
"Labels": {
"evGW HOMO energy":false,
"evGW LUMO energy":false,
"evGW HOMO-LUMO gap":false,
"evGW total energy":false,
"RPA correlation energy" :false,
"Z": {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":1
},
"Sigma_c (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":2
},
"e_QP (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":3
},
"e_HF (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":4
}
}
},
"Self-consistent qsG{0}W{0}": {
"Enabled": false,
"Labels": {
"qsGW HOMO energy":false,
"qsGW LUMO energy":false,
"qsGW HOMO-LUMO gap":false,
"qsGW total energy":false,
"qsGW exchange energy":false,
"qsGW correlation energy":false,
"RPA correlation energy":{
"Enabled":false,
"Graph":2
},
"Z": {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":4
},
"e_QP-e_HF (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":5
},
"e_QP (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":6
}
}
},
"MP2": {
"Enabled": false,
"Labels": {
"MP2 correlation energy": {
"Enabled":true,
"Graph":4
},
"Direct part":false,
"Exchange part":false,
"MP2 total energy":true,
"MP2 energy":false
}
}
}
}

145
PyOptions.template.json Normal file
View File

@ -0,0 +1,145 @@
{
"Scan": {
"Start":0.8,
"Stop":1.2,
"Step":0.01
},
"Basis":"6-31G",
"Outputs": {
"DataOutput": {
"Enabled":true,
"Format":"Duck{0}.dat"
},
"DuckOutput": {
"Enabled":true,
"Multiple":false,
"Format":"DuckOut.out"
},
"FigureOutput":{
"Enabled":false,
"Path":"Figure.png"
}
},
"Methods": {
"RHF":{
"Enabled": true,
"Labels": {
"One-electron energy":false,
"Kinetic energy":false,
"Potential energy":false,
"Two-electron energy":false,
"Coulomb energy":false,
"Exchange energy":false,
"Electronic energy":false,
"Nuclear repulsion":false,
"Hartree-Fock energy":true,
"HF HOMO energy":false,
"HF LUMO energy":false,
"HF HOMO-LUMO gap":false
}
},
"One-shot G0W0": {
"Enabled": true,
"Labels": {
"G0W0 HOMO energy":true,
"G0W0 LUMO energy":true,
"G0W0 HOMO-LUMO gap":false,
"G0W0 total energy":false,
"RPA correlation energy" :false,
"Z": {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":1
},
"Sigma_c (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":2
},
"e_QP (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO+1","LUMO+2"],
"Graph":3
},
"e_HF (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":4
}
}
},
"Self-consistent evG{0}W{0}": {
"Enabled":false,
"Labels": {
"evGW HOMO energy":false,
"evGW LUMO energy":false,
"evGW HOMO-LUMO gap":false,
"evGW total energy":false,
"RPA correlation energy" :false,
"Z": {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":1
},
"Sigma_c (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":2
},
"e_QP (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":3
},
"e_HF (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":4
}
}
},
"Self-consistent qsG{0}W{0}": {
"Enabled": false,
"Labels": {
"qsGW HOMO energy":false,
"qsGW LUMO energy":false,
"qsGW HOMO-LUMO gap":false,
"qsGW total energy":false,
"qsGW exchange energy":false,
"qsGW correlation energy":false,
"RPA correlation energy":{
"Enabled":false,
"Graph":2
},
"Z": {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":4
},
"e_QP-e_HF (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":5
},
"e_QP (eV)" : {
"Enabled":true,
"Index":["HOMO","LUMO","LUMO+1","LUMO+2"],
"Graph":6
}
}
},
"MP2": {
"Enabled": false,
"Labels": {
"MP2 correlation energy": {
"Enabled":true,
"Graph":4
},
"Direct part":false,
"Exchange part":false,
"MP2 total energy":true,
"MP2 energy":false
}
}
}
}

12
include/parameters.h Normal file
View File

@ -0,0 +1,12 @@
integer,parameter :: nspin = 2
integer,parameter :: maxShell = 50
integer,parameter :: n1eInt = 3
integer,parameter :: n2eInt = 4
integer,parameter :: n3eInt = 3
integer,parameter :: n4eInt = 3
integer,parameter :: maxK = 20
double precision,parameter :: pi = acos(-1d0)
double precision,parameter :: HaToeV = 27.21138602d0
double precision,parameter :: pmtoau = 0.0188973d0

17
include/quadrature.h Normal file
View File

@ -0,0 +1,17 @@
! Gauss-Legendre quadrature roots and weights
integer,parameter :: nQuad = 21
double precision, save :: rQuad(1:nQuad) = &
(/ 0.00312391468981d0 , 0.0163865807168d0 , 0.0399503329248d0 , 0.0733183177083d0 , 0.115780018262d0 , &
0.166430597901d0 , 0.224190582056d0 , 0.287828939896d0 , 0.355989341599d0 , 0.42721907292d0 , &
0.5d0 , 0.57278092708d0 , 0.644010658401d0 , 0.712171060104d0 , 0.775809417944d0 , &
0.833569402099d0 , 0.884219981738d0 , 0.926681682292d0 , 0.960049667075d0 , 0.983613419283d0 , &
0.99687608531d0 /)
double precision, save :: wQuad(1:nQuad) = &
(/ 0.0080086141288872d0, 0.018476894885426d0, 0.028567212713429d0, 0.03805005681419d0 , 0.046722211728017d0, &
0.054398649583574d0 , 0.060915708026864d0, 0.066134469316669d0, 0.069943697395537d0, 0.072262201994985d0, &
0.07304056682485d0 , 0.072262201994985d0, 0.069943697395537d0, 0.066134469316669d0, 0.060915708026864d0, &
0.054398649583574d0 , 0.046722211728017d0, 0.03805005681419d0 , 0.028567212713429d0, 0.018476894885426d0, &
0.0080086141288872d0 /)

3
input/auxbasis Normal file
View File

@ -0,0 +1,3 @@
1 0
2 0
3 0

14
input/basis Normal file
View File

@ -0,0 +1,14 @@
1 2
S 3 1.00
18.7311370 0.03349460
2.8253937 0.23472695
0.6401217 0.81375733
S 1 1.00
0.1612778 1.0000000
2 2
S 3 1.00
18.7311370 0.03349460
2.8253937 0.23472695
0.6401217 0.81375733
S 1 1.00
0.1612778 1.0000000

1
input/geminal Normal file
View File

@ -0,0 +1 @@
1.0

13
input/methods Normal file
View File

@ -0,0 +1,13 @@
# HF MOM
T F
# MP2 MP3
F F
# CIS TDHF ADC
F F F
# GF2 GF3
F F
# G0W0 evGW qsGW
T F F
# MCMP2
F

5
input/molecule Normal file
View File

@ -0,0 +1,5 @@
# nAt nEl nCore nRyd
2 2 0 0
# Znuc x y z
1. 0. 0. 0.4
1. 0. 0. -0.4

12
input/options Normal file
View File

@ -0,0 +1,12 @@
# RHF: maxSCF thresh DIIS n_diis guess_type ortho_type
32 0.0000001 T 5 1 1
# MPn:
# CIS/TDHF: singlet triplet
T F
# GF: maxSCF thresh DIIS n_diis renormalization
64 0.00001 T 5 3
# GW: maxSCF thresh DIIS n_diis COHSEX SOSEX BSE TDA G0W GW0 linearize
64 0.00001 T 15 F F F F F F F
# MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift
1000000 100000 10 0.3 10000 1234 T

14
input/weight Normal file
View File

@ -0,0 +1,14 @@
1 2
S 3 1.00
18.7311370 0.03349460
2.8253937 0.23472695
0.6401217 0.81375733
S 1 1.00
0.1612778 1.0000000
2 2
S 3 1.00
18.7311370 0.03349460
2.8253937 0.23472695
0.6401217 0.81375733
S 1 1.00
0.1612778 1.0000000

BIN
src/.DS_Store vendored Normal file
View File

Binary file not shown.

47
src/IntPak/CalcBoysF.f90 Normal file
View File

@ -0,0 +1,47 @@
!module c_functions
! use iso_c_binding
! interface
! function gsl_sf_gamma_inc_P(a,t) bind(C, name="gsl_sf_gamma_inc_P")
! use iso_c_binding, only: c_double
! real(kind=c_double), value :: a,t
! real(kind=c_double) :: gsl_sf_gamma_inc_P
! end function gsl_sf_gamma_inc_P
! end interface
!end module
subroutine CalcBoysF(maxm,t,Fm)
! use c_functions
! Comute the generalized Boys function Fm(t) using Slatec library
implicit none
! Input variables
double precision,intent(in) :: t
integer,intent(in) :: maxm
! Local variables
integer :: m
double precision :: dm
double precision :: dgami
! Output variables
double precision,intent(inout):: Fm(0:maxm)
if(t == 0d0) then
do m=0,maxm
dm = dble(m)
Fm(m) = 1d0/(2d0*dm+1d0)
enddo
else
do m=0,maxm
dm = dble(m)
! Fm(m) = gamma(dm+0.5d0)*gsl_sf_gamma_inc_P(dm+0.5d0,t)/(2d0*t**(dm+0.5d0))
Fm(m) = dgami(dm+0.5d0,t)/(2d0*t**(dm+0.5d0))
enddo
endif
end subroutine CalcBoysF

28
src/IntPak/CalcNBasis.f90 Normal file
View File

@ -0,0 +1,28 @@
subroutine CalcNBasis(nShell,atot,NBasis)
implicit none
! Input variables
integer,intent(in) :: nShell
integer,intent(in) :: atot(nShell)
! Local variables
integer :: iShell
! Output variables
integer,intent(out) :: NBasis
NBasis = 0
do iShell=1,nShell
NBasis = NBasis + (atot(iShell)*atot(iShell) + 3*atot(iShell) + 2)/2
enddo
write(*,'(A28)') '------------------'
write(*,'(A28,1X,I16)') 'Number of basis functions',NBasis
write(*,'(A28)') '------------------'
write(*,*)
end subroutine CalcNBasis

40
src/IntPak/CalcOm.f90 Normal file
View File

@ -0,0 +1,40 @@
subroutine CalcOm(maxm,ExpPQi,NormPQSq,Om)
! Comute the 0^m: (00|00)^m
implicit none
! Input variables
integer,intent(in) :: maxm
double precision,intent(in) :: ExpPQi,NormPQSq
! Local variables
integer :: m
double precision :: pi,dm,t
double precision,allocatable :: Fm(:)
! Output variables
double precision,intent(inout):: Om (0:maxm)
allocate(Fm(0:maxm))
pi = 4d0*atan(1d0)
! Campute generalized Boys functions
t = NormPQSq/ExpPQi
call CalcBoysF(maxm,t,Fm)
! Compute (00|00)^m
do m=0,maxm
dm =dble(m)
Om(m) = (2d0/sqrt(pi))*(-1d0)**dm*(1d0/ExpPQi)**(dm+0.5d0)*Fm(m)
enddo
deallocate(Fm)
end subroutine CalcOm

44
src/IntPak/CalcOm3e.f90 Normal file
View File

@ -0,0 +1,44 @@
subroutine CalcOm3e(maxm,delta0,delta1,Y1,Y0,Om)
! Compute the 0^m for ERIs: (00|00)^m
implicit none
! Input variables
integer,intent(in) :: maxm
double precision,intent(in) :: delta0,delta1,Y0,Y1
! Local variables
integer :: m
double precision :: pi,t,OG
double precision,allocatable :: Fm(:)
! Output variables
double precision,intent(inout):: Om (0:maxm)
allocate(Fm(0:maxm))
pi = 4d0*atan(1d0)
! Calculate OG
OG = (pi**4/delta0)**(3d0/2d0)*exp(-Y0)
! Campute generalized Boys functions
t = delta1/(delta1-delta0)*(Y1-Y0)
call CalcBoysF(maxm,t,Fm)
! Compute (000|000)^m
do m=0,maxm
Om(m) = (2d0/sqrt(pi))*OG*sqrt(delta0/(delta1-delta0))*(delta1/(delta1-delta0))**m
Om(m) = Om(m)*Fm(m)
enddo
deallocate(Fm)
end subroutine CalcOm3e

39
src/IntPak/CalcOmERI.f90 Normal file
View File

@ -0,0 +1,39 @@
subroutine CalcOmERI(maxm,ExpY,NormYSq,Om)
! Compute the 0^m for ERIs: (00|00)^m
implicit none
! Input variables
integer,intent(in) :: maxm
double precision,intent(in) :: ExpY,NormYSq
! Local variables
integer :: m
double precision :: pi,t
double precision,allocatable :: Fm(:)
! Output variables
double precision,intent(inout):: Om (0:maxm)
allocate(Fm(0:maxm))
pi = 4d0*atan(1d0)
! Campute generalized Boys functions
t = ExpY*NormYSq
call CalcBoysF(maxm,t,Fm)
! Compute (00|00)^m
do m=0,maxm
Om(m) = (2d0/sqrt(pi))*sqrt(ExpY)*Fm(m)
enddo
deallocate(Fm)
end subroutine CalcOmERI

39
src/IntPak/CalcOmErf.f90 Normal file
View File

@ -0,0 +1,39 @@
subroutine CalcOmErf(maxm,ExpY,fG,NormYSq,Om)
! Compute the 0^m for the long-range Coulomb operator: (00|erf(r)/r|00)^m
implicit none
! Input variables
integer,intent(in) :: maxm
double precision,intent(in) :: ExpY,fG,NormYSq
! Local variables
integer :: m
double precision :: pi,t
double precision,allocatable :: Fm(:)
! Output variables
double precision,intent(inout):: Om (0:maxm)
allocate(Fm(0:maxm))
pi = 4d0*atan(1d0)
! Campute generalized Boys functions
t = fG*NormYSq
call CalcBoysF(maxm,t,Fm)
! Compute (00|00)^m
do m=0,maxm
Om(m) = (2d0/sqrt(pi))*sqrt(fG)*(fG/ExpY)**m*Fm(m)
enddo
deallocate(Fm)
end subroutine CalcOmErf

40
src/IntPak/CalcOmNuc.f90 Normal file
View File

@ -0,0 +1,40 @@
subroutine CalcOmNuc(maxm,ExpPQi,NormPQSq,Om)
! Compute (0|V|0)^m
implicit none
! Input variables
integer,intent(in) :: maxm
double precision,intent(in) :: ExpPQi,NormPQSq
! Local variables
integer :: m
double precision :: pi,dm,t
double precision,allocatable :: Fm(:)
! Output variables
double precision,intent(inout):: Om (0:maxm)
allocate(Fm(0:maxm))
pi = 4d0*atan(1d0)
! Campute generalized Boys functions
t = NormPQSq/ExpPQi
call CalcBoysF(maxm,t,Fm)
! Compute (00|00)^m
do m=0,maxm
dm =dble(m)
Om(m) = (2d0/sqrt(pi))*(1d0/ExpPQi)**(dm+0.5d0)*Fm(m)
enddo
deallocate(Fm)
end subroutine CalcOmNuc

43
src/IntPak/CalcOmYuk.f90 Normal file
View File

@ -0,0 +1,43 @@
subroutine CalcOmYuk(maxm,ExpG,ExpY,fG,NormYSq,Om)
! Compute the 0^m for the screened Coulomb operator: (00|f12/r12|00)^m
implicit none
! Input variables
integer,intent(in) :: maxm
double precision,intent(in) :: ExpG,ExpY,fG,NormYSq
! Local variables
integer :: m,k
double precision :: pi,t,dbinom
double precision,allocatable :: Fm(:)
! Output variables
double precision,intent(inout):: Om(0:maxm)
allocate(Fm(0:maxm))
pi = 4d0*atan(1d0)
! Campute generalized Boys functions
t = (ExpY - fG)*NormYSq
call CalcBoysF(maxm,t,Fm)
! Compute (00|00)^m
do m=0,maxm
Om(m) = 0d0
do k=0,m
Om(m) = Om(m) + dbinom(m,k)*(ExpY/ExpG)**k*Fm(k)
enddo
Om(m) = (2d0/sqrt(pi))*sqrt(ExpY)*(fG/ExpG)*exp(-fG*NormYSq)*Om(m)
enddo
deallocate(Fm)
end subroutine CalcOmYuk

308
src/IntPak/Compute2eInt.f90 Normal file
View File

@ -0,0 +1,308 @@
subroutine Compute2eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np2eInt,nSigp2eInt,nc2eInt,nSigc2eInt)
! Compute various two-electron integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: iType,nShell
double precision,intent(in) :: ExpS
integer,intent(in) :: KG
double precision,intent(in) :: DG(KG),ExpG(KG)
double precision,intent(in) :: CenterShell(maxShell,3)
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
! Local variables
logical :: chemist_notation
integer :: KBra(2),KKet(2)
double precision :: CenterBra(2,3),CenterKet(2,3)
integer :: TotAngMomBra(2),TotAngMomKet(2)
integer :: AngMomBra(2,3),AngMomKet(2,3)
integer :: nShellFunctionBra(2),nShellFunctionKet(2)
integer,allocatable :: ShellFunctionA1(:,:),ShellFunctionA2(:,:)
integer,allocatable :: ShellFunctionB1(:,:),ShellFunctionB2(:,:)
double precision :: ExpBra(2),ExpKet(2)
double precision :: DBra(2),DKet(2)
double precision :: NormCoeff
integer :: iBasA1,iBasA2,iBasB1,iBasB2
integer :: iShA1,iShA2,iShB1,iShB2
integer :: iShFA1,iShFA2,iShFB1,iShFB2
integer :: iKA1,iKA2,iKB1,iKB2
integer :: iFile
double precision :: p2eInt,c2eInt
double precision :: start_c2eInt,end_c2eInt,t_c2eInt
! Output variables
integer,intent(out) :: np2eInt,nSigp2eInt,nc2eInt,nSigc2eInt
chemist_notation = .true.
np2eInt = 0
nSigp2eInt = 0
nc2eInt = 0
nSigc2eInt = 0
iBasA1 = 0
iBasA2 = 0
iBasB1 = 0
iBasB2 = 0
! Open file to write down integrals
iFile = 0
if(iType == 1) then
! Compute two-electron integrals over the Coulomb operator
write(*,*) '******************************************'
write(*,*) ' Compute two-electron repulsion integrals '
write(*,*) '******************************************'
write(*,*)
iFile = 21
open(unit=iFile,file='int/ERI.dat')
elseif(iType == 2) then
! Compute two-electron integrals over Slater geminals
write(*,*) '****************************************'
write(*,*) ' Compute two-electron geminal integrals '
write(*,*) '****************************************'
write(*,*)
iFile = 22
open(unit=iFile,file='int/F12.dat')
elseif(iType == 3) then
! Compute two-electron integrals over the Yukawa operator
write(*,*) '***************************************'
write(*,*) ' Compute two-electron Yukawa integrals '
write(*,*) '***************************************'
write(*,*)
iFile = 23
open(unit=iFile,file='int/Yuk.dat')
elseif(iType == 4) then
! Compute two-electron integrals over the long-range Coulomb operator
write(*,*) '**************************************'
write(*,*) ' Compute long-range Coulomb integrals '
write(*,*) '**************************************'
write(*,*)
iFile = 24
open(unit=iFile,file='int/Erf.dat')
endif
!------------------------------------------------------------------------
! Loops over shell A1
!------------------------------------------------------------------------
do iShA1=1,nShell
CenterBra(1,1) = CenterShell(iShA1,1)
CenterBra(1,2) = CenterShell(iShA1,2)
CenterBra(1,3) = CenterShell(iShA1,3)
TotAngMomBra(1) = TotAngMomShell(iShA1)
nShellFunctionBra(1) = (TotAngMomBra(1)*TotAngMomBra(1) + 3*TotAngMomBra(1) + 2)/2
allocate(ShellFunctionA1(1:nShellFunctionBra(1),1:3))
call GenerateShell(TotAngMomBra(1),nShellFunctionBra(1),ShellFunctionA1)
KBra(1) = KShell(iShA1)
do iShFA1=1,nShellFunctionBra(1)
iBasA1 = iBasA1 + 1
AngMomBra(1,1) = ShellFunctionA1(iShFA1,1)
AngMomBra(1,2) = ShellFunctionA1(iShFA1,2)
AngMomBra(1,3) = ShellFunctionA1(iShFA1,3)
!------------------------------------------------------------------------
! Loops over shell B1
!------------------------------------------------------------------------
do iShB1=1,iShA1
CenterKet(1,1) = CenterShell(iShB1,1)
CenterKet(1,2) = CenterShell(iShB1,2)
CenterKet(1,3) = CenterShell(iShB1,3)
TotAngMomKet(1) = TotAngMomShell(iShB1)
nShellFunctionKet(1) = (TotAngMomKet(1)*TotAngMomKet(1) + 3*TotAngMomKet(1) + 2)/2
allocate(ShellFunctionB1(1:nShellFunctionKet(1),1:3))
call GenerateShell(TotAngMomKet(1),nShellFunctionKet(1),ShellFunctionB1)
KKet(1) = KShell(iShB1)
do iShFB1=1,nShellFunctionKet(1)
iBasB1 = iBasB1 + 1
AngMomKet(1,1) = ShellFunctionB1(iShFB1,1)
AngMomKet(1,2) = ShellFunctionB1(iShFB1,2)
AngMomKet(1,3) = ShellFunctionB1(iShFB1,3)
!------------------------------------------------------------------------
! Loops over shell A2
!------------------------------------------------------------------------
do iShA2=1,iShA1
CenterBra(2,1) = CenterShell(iShA2,1)
CenterBra(2,2) = CenterShell(iShA2,2)
CenterBra(2,3) = CenterShell(iShA2,3)
TotAngMomBra(2) = TotAngMomShell(iShA2)
nShellFunctionBra(2) = (TotAngMomBra(2)*TotAngMomBra(2) + 3*TotAngMomBra(2) + 2)/2
allocate(ShellFunctionA2(1:nShellFunctionBra(2),1:3))
call GenerateShell(TotAngMomBra(2),nShellFunctionBra(2),ShellFunctionA2)
KBra(2) = KShell(iShA2)
do iShFA2=1,nShellFunctionBra(2)
iBasA2 = iBasA2 + 1
AngMomBra(2,1) = ShellFunctionA2(iShFA2,1)
AngMomBra(2,2) = ShellFunctionA2(iShFA2,2)
AngMomBra(2,3) = ShellFunctionA2(iShFA2,3)
!------------------------------------------------------------------------
! Loops over shell B2
!------------------------------------------------------------------------
do iShB2=1,iShA2
CenterKet(2,1) = CenterShell(iShB2,1)
CenterKet(2,2) = CenterShell(iShB2,2)
CenterKet(2,3) = CenterShell(iShB2,3)
TotAngMomKet(2) = TotAngMomShell(iShB2)
nShellFunctionKet(2) = (TotAngMomKet(2)*TotAngMomKet(2) + 3*TotAngMomKet(2) + 2)/2
allocate(ShellFunctionB2(1:nShellFunctionKet(2),1:3))
call GenerateShell(TotAngMomKet(2),nShellFunctionKet(2),ShellFunctionB2)
KKet(2) = KShell(iShB2)
do iShFB2=1,nShellFunctionKet(2)
iBasB2 = iBasB2 + 1
AngMomKet(2,1) = ShellFunctionB2(iShFB2,1)
AngMomKet(2,2) = ShellFunctionB2(iShFB2,2)
AngMomKet(2,3) = ShellFunctionB2(iShFB2,3)
!------------------------------------------------------------------------
! Loops over contraction degrees
!-------------------------------------------------------------------------
call cpu_time(start_c2eInt)
c2eInt = 0d0
do iKA1=1,KBra(1)
ExpBra(1) = ExpShell(iShA1,iKA1)
DBra(1) = DShell(iShA1,iKA1)*NormCoeff(ExpBra(1),AngMomBra(1,1:3))
do iKA2=1,KBra(2)
ExpBra(2) = ExpShell(iShA2,iKA2)
DBra(2) = DShell(iShA2,iKA2)*NormCoeff(ExpBra(2),AngMomBra(2,1:3))
do iKB1=1,KKet(1)
ExpKet(1) = ExpShell(iShB1,iKB1)
DKet(1) = DShell(iShB1,iKB1)*NormCoeff(ExpKet(1),AngMomKet(1,1:3))
do iKB2=1,KKet(2)
ExpKet(2) = ExpShell(iShB2,iKB2)
DKet(2) = DShell(iShB2,iKB2)*NormCoeff(ExpKet(2),AngMomKet(2,1:3))
call S2eInt(debug,iType,np2eInt,nSigp2eInt, &
ExpS,KG,DG,ExpG, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet, &
p2eInt)
c2eInt = c2eInt + DBra(1)*DBra(2)*DKet(1)*DKet(2)*p2eInt
enddo
enddo
enddo
enddo
call cpu_time(end_c2eInt)
nc2eInt = nc2eInt + 1
if(abs(c2eInt) > 1d-15) then
nSigc2eInt = nSigc2eInt + 1
t_c2eInt = end_c2eInt - start_c2eInt
if(chemist_notation) then
write(iFile,'(I6,I6,I6,I6,F20.15)') iBasA1,iBasB1,iBasA2,iBasB2,c2eInt
if(debug) then
write(*,'(A10,1X,F16.10,1X,I6,1X,I6,1X,I6,1X,I6)') &
'(a1b1|a2b2) = ',c2eInt,iBasA1,iBasB1,iBasA2,iBasB2
endif
else
write(iFile,'(I6,I6,I6,I6,F20.15)') iBasA1,iBasA2,iBasB1,iBasB2,c2eInt
if(debug) then
write(*,'(A10,1X,F16.10,1X,I6,1X,I6,1X,I6,1X,I6)') &
'<a1a2|b1b2> = ',c2eInt,iBasA1,iBasA2,iBasB1,iBasB2
endif
endif
endif
!------------------------------------------------------------------------
! End loops over contraction degrees
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB2)
enddo
iBasB2 = 0
!------------------------------------------------------------------------
! End loops over shell B2
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA2)
enddo
iBasA2 = 0
!------------------------------------------------------------------------
! End loops over shell A2
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB1)
enddo
iBasB1 = 0
!------------------------------------------------------------------------
! End loops over shell B1
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA1)
enddo
iBasA1 = 0
!------------------------------------------------------------------------
! End loops over shell A1
!------------------------------------------------------------------------
write(*,*)
! Close files to write down integrals
close(unit=iFile)
end subroutine Compute2eInt

328
src/IntPak/Compute3eInt.f90 Normal file
View File

@ -0,0 +1,328 @@
subroutine Compute3eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np3eInt,nSigp3eInt,nc3eInt,nSigc3eInt)
! Compute long-range Coulomb integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: iType,nShell
double precision,intent(in) :: ExpS
integer,intent(in) :: KG
double precision,intent(in) :: DG(KG),ExpG(KG)
double precision,intent(in) :: CenterShell(maxShell,3)
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
! Local variables
integer :: KBra(3),KKet(3)
double precision :: CenterBra(3,3),CenterKet(3,3)
integer :: TotAngMomBra(3),TotAngMomKet(3)
integer :: AngMomBra(3,3),AngMomKet(3,3)
integer :: nShellFunctionBra(3),nShellFunctionKet(3)
integer,allocatable :: ShellFunctionA1(:,:),ShellFunctionA2(:,:),ShellFunctionA3(:,:)
integer,allocatable :: ShellFunctionB1(:,:),ShellFunctionB2(:,:),ShellFunctionB3(:,:)
double precision :: ExpBra(3),ExpKet(3)
double precision :: DBra(3),DKet(3)
double precision :: NormCoeff
integer :: iBasA1,iBasA2,iBasA3,iBasB1,iBasB2,iBasB3
integer :: iShA1,iShA2,iShA3,iShB1,iShB2,iShB3
integer :: iShFA1,iShFA2,iShFA3,iShFB1,iShFB2,iShFB3
integer :: iKA1,iKA2,iKA3,iKB1,iKB2,iKB3
integer :: iFile
double precision :: p3eInt,c3eInt
double precision :: start_c3eInt,end_c3eInt,t_c3eInt
! Output variables
integer,intent(out) :: np3eInt,nSigp3eInt,nc3eInt,nSigc3eInt
! Compute three-electron integrals
write(*,*) '**********************************'
write(*,*) ' Compute three-electron integrals '
write(*,*) '**********************************'
write(*,*)
np3eInt = 0
nSigp3eInt = 0
nc3eInt = 0
nSigc3eInt = 0
iBasA1 = 0
iBasA2 = 0
iBasA3 = 0
iBasB1 = 0
iBasB2 = 0
iBasB3 = 0
! Open file to write down integrals
iFile = 0
if(iType == 1) then
iFile = 31
open(unit=iFile,file='int/3eInt_Type1.dat')
elseif(iType == 2) then
iFile = 32
open(unit=iFile,file='int/3eInt_Type2.dat')
elseif(iType == 3) then
iFile = 33
open(unit=iFile,file='int/3eInt_Type3.dat')
endif
!------------------------------------------------------------------------
! Loops over shell A1
!------------------------------------------------------------------------
do iShA1=1,nShell
CenterBra(1,1) = CenterShell(iShA1,1)
CenterBra(1,2) = CenterShell(iShA1,2)
CenterBra(1,3) = CenterShell(iShA1,3)
TotAngMomBra(1) = TotAngMomShell(iShA1)
nShellFunctionBra(1) = (TotAngMomBra(1)*TotAngMomBra(1) + 3*TotAngMomBra(1) + 2)/2
allocate(ShellFunctionA1(1:nShellFunctionBra(1),1:3))
call GenerateShell(TotAngMomBra(1),nShellFunctionBra(1),ShellFunctionA1)
KBra(1) = KShell(iShA1)
do iShFA1=1,nShellFunctionBra(1)
iBasA1 = iBasA1 + 1
AngMomBra(1,1) = ShellFunctionA1(iShFA1,1)
AngMomBra(1,2) = ShellFunctionA1(iShFA1,2)
AngMomBra(1,3) = ShellFunctionA1(iShFA1,3)
!------------------------------------------------------------------------
! Loops over shell A2
!------------------------------------------------------------------------
do iShA2=1,nShell
CenterBra(2,1) = CenterShell(iShA2,1)
CenterBra(2,2) = CenterShell(iShA2,2)
CenterBra(2,3) = CenterShell(iShA2,3)
TotAngMomBra(2) = TotAngMomShell(iShA2)
nShellFunctionBra(2) = (TotAngMomBra(2)*TotAngMomBra(2) + 3*TotAngMomBra(2) + 2)/2
allocate(ShellFunctionA2(1:nShellFunctionBra(2),1:3))
call GenerateShell(TotAngMomBra(2),nShellFunctionBra(2),ShellFunctionA2)
KBra(2) = KShell(iShA2)
do iShFA2=1,nShellFunctionBra(2)
iBasA2 = iBasA2 + 1
AngMomBra(2,1) = ShellFunctionA2(iShFA2,1)
AngMomBra(2,2) = ShellFunctionA2(iShFA2,2)
AngMomBra(2,3) = ShellFunctionA2(iShFA2,3)
!------------------------------------------------------------------------
! Loops over shell A3
!------------------------------------------------------------------------
do iShA3=1,nShell
CenterBra(3,1) = CenterShell(iShA3,1)
CenterBra(3,2) = CenterShell(iShA3,2)
CenterBra(3,3) = CenterShell(iShA3,3)
TotAngMomBra(3) = TotAngMomShell(iShA3)
nShellFunctionBra(3) = (TotAngMomBra(3)*TotAngMomBra(3) + 3*TotAngMomBra(3) + 2)/2
allocate(ShellFunctionA3(1:nShellFunctionBra(3),1:3))
call GenerateShell(TotAngMomBra(3),nShellFunctionBra(3),ShellFunctionA3)
KBra(3) = KShell(iShA3)
do iShFA3=1,nShellFunctionBra(3)
iBasA3 = iBasA3 + 1
AngMomBra(3,1) = ShellFunctionA3(iShFA3,1)
AngMomBra(3,2) = ShellFunctionA3(iShFA3,2)
AngMomBra(3,3) = ShellFunctionA3(iShFA3,3)
!------------------------------------------------------------------------
! Loops over shell B1
!------------------------------------------------------------------------
do iShB1=1,nShell
CenterKet(1,1) = CenterShell(iShB1,1)
CenterKet(1,2) = CenterShell(iShB1,2)
CenterKet(1,3) = CenterShell(iShB1,3)
TotAngMomKet(1) = TotAngMomShell(iShB1)
nShellFunctionKet(1) = (TotAngMomKet(1)*TotAngMomKet(1) + 3*TotAngMomKet(1) + 2)/2
allocate(ShellFunctionB1(1:nShellFunctionKet(1),1:3))
call GenerateShell(TotAngMomKet(1),nShellFunctionKet(1),ShellFunctionB1)
KKet(1) = KShell(iShB1)
do iShFB1=1,nShellFunctionKet(1)
iBasB1 = iBasB1 + 1
AngMomKet(1,1) = ShellFunctionB1(iShFB1,1)
AngMomKet(1,2) = ShellFunctionB1(iShFB1,2)
AngMomKet(1,3) = ShellFunctionB1(iShFB1,3)
!------------------------------------------------------------------------
! Loops over shell B2
!------------------------------------------------------------------------
do iShB2=1,nShell
CenterKet(2,1) = CenterShell(iShB2,1)
CenterKet(2,2) = CenterShell(iShB2,2)
CenterKet(2,3) = CenterShell(iShB2,3)
TotAngMomKet(2) = TotAngMomShell(iShB2)
nShellFunctionKet(2) = (TotAngMomKet(2)*TotAngMomKet(2) + 3*TotAngMomKet(2) + 2)/2
allocate(ShellFunctionB2(1:nShellFunctionKet(2),1:3))
call GenerateShell(TotAngMomKet(2),nShellFunctionKet(2),ShellFunctionB2)
KKet(2) = KShell(iShB2)
do iShFB2=1,nShellFunctionKet(2)
iBasB2 = iBasB2 + 1
AngMomKet(2,1) = ShellFunctionB2(iShFB2,1)
AngMomKet(2,2) = ShellFunctionB2(iShFB2,2)
AngMomKet(2,3) = ShellFunctionB2(iShFB2,3)
!------------------------------------------------------------------------
! Loops over shell B3
!------------------------------------------------------------------------
do iShB3=1,nShell
CenterKet(3,1) = CenterShell(iShB3,1)
CenterKet(3,2) = CenterShell(iShB3,2)
CenterKet(3,3) = CenterShell(iShB3,3)
TotAngMomKet(3) = TotAngMomShell(iShB3)
nShellFunctionKet(3) = (TotAngMomKet(3)*TotAngMomKet(3) + 3*TotAngMomKet(3) + 2)/2
allocate(ShellFunctionB3(1:nShellFunctionKet(3),1:3))
call GenerateShell(TotAngMomKet(3),nShellFunctionKet(3),ShellFunctionB3)
KKet(3) = KShell(iShB3)
do iShFB3=1,nShellFunctionKet(3)
iBasB3 = iBasB3 + 1
AngMomKet(3,1) = ShellFunctionB3(iShFB3,1)
AngMomKet(3,2) = ShellFunctionB3(iShFB3,2)
AngMomKet(3,3) = ShellFunctionB3(iShFB3,3)
!------------------------------------------------------------------------
! Loops over contraction degrees
!-------------------------------------------------------------------------
call cpu_time(start_c3eInt)
c3eInt = 0d0
do iKA1=1,KBra(1)
ExpBra(1) = ExpShell(iShA1,iKA1)
DBra(1) = DShell(iShA1,iKA1)*NormCoeff(ExpBra(1),AngMomBra(1,1:3))
do iKA2=1,KBra(2)
ExpBra(2) = ExpShell(iShA2,iKA2)
DBra(2) = DShell(iShA2,iKA2)*NormCoeff(ExpBra(2),AngMomBra(2,1:3))
do iKA3=1,KBra(3)
ExpBra(3) = ExpShell(iShA3,iKA3)
DBra(3) = DShell(iShA3,iKA3)*NormCoeff(ExpBra(3),AngMomBra(3,1:3))
do iKB1=1,KKet(1)
ExpKet(1) = ExpShell(iShB1,iKB1)
DKet(1) = DShell(iShB1,iKB1)*NormCoeff(ExpKet(1),AngMomKet(1,1:3))
do iKB2=1,KKet(2)
ExpKet(2) = ExpShell(iShB2,iKB2)
DKet(2) = DShell(iShB2,iKB2)*NormCoeff(ExpKet(2),AngMomKet(2,1:3))
do iKB3=1,KKet(3)
ExpKet(3) = ExpShell(iShB3,iKB3)
DKet(3) = DShell(iShB3,iKB3)*NormCoeff(ExpKet(3),AngMomKet(3,1:3))
call S3eInt(debug,iType,np3eInt,nSigp3eInt, &
ExpS,KG,DG,ExpG, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet, &
p3eInt)
c3eInt = c3eInt + DBra(1)*DBra(2)*DBra(3)*DKet(1)*DKet(2)*DKet(3)*p3eInt
enddo
enddo
enddo
enddo
enddo
enddo
call cpu_time(end_c3eInt)
nc3eInt = nc3eInt + 1
if(abs(c3eInt) > 1d-15) then
nSigc3eInt = nSigc3eInt + 1
t_c3eInt = end_c3eInt - start_c3eInt
write(iFile,'(F20.15,I6,I6,I6,I6,I6,I6)') &
c3eInt,iBasA1,iBasA2,iBasA3,iBasB1,iBasB2,iBasB3
if(.true.) then
write(*,'(A15,1X,F16.10,1X,I6,1X,I6,1X,I6,1X,I6,1X,I6,1X,I6)') &
'(a1a2a3|b1b2b3) = ',c3eInt,iBasA1,iBasA2,iBasA3,iBasB1,iBasB2,iBasB3
endif
endif
!------------------------------------------------------------------------
! End loops over contraction degrees
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB3)
enddo
iBasB3 = 0
!------------------------------------------------------------------------
! End loops over shell B3
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB2)
enddo
iBasB2 = 0
!------------------------------------------------------------------------
! End loops over shell B2
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB1)
enddo
iBasB1 = 0
!------------------------------------------------------------------------
! End loops over shell B1
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA3)
enddo
iBasA3 = 0
!------------------------------------------------------------------------
! End loops over shell A3
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA2)
enddo
iBasA2 = 0
!------------------------------------------------------------------------
! End loops over shell A2
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA1)
enddo
iBasA1 = 0
!------------------------------------------------------------------------
! End loops over shell A1
!------------------------------------------------------------------------
write(*,*)
! Close files to write down integrals
close(unit=iFile)
end subroutine Compute3eInt

246
src/IntPak/Compute4eInt.f90 Normal file
View File

@ -0,0 +1,246 @@
subroutine Compute4eInt(debug,nEl,iType,nShell,ExpS, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
npErf,nSigpErf,ncErf,nSigcErf)
! Compute long-range Coulomb integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: nEl,iType,nShell
double precision :: ExpS
double precision,intent(in) :: CenterShell(maxShell,3)
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
! Local variables
integer :: KA,KB,KC,KD
double precision :: CenterA(3),CenterB(3),CenterC(3),CenterD(3)
integer :: TotAngMomA,TotAngMomB,TotAngMomC,TotAngMomD
integer :: AngMomA(3),AngMomB(3),AngMomC(3),AngMomD(3)
integer :: nShellFunctionA,nShellFunctionB, &
nShellFunctionC,nShellFunctionD
integer,allocatable :: ShellFunctionA(:,:),ShellFunctionB(:,:), &
ShellFunctionC(:,:),ShellFunctionD(:,:)
double precision :: ExpA,ExpB,ExpC,ExpD
double precision,allocatable :: DA,DB,DC,DD
double precision :: NormCoeff
integer :: iBasA,iBasB,iBasC,iBasD
integer :: iShA,iShB,iShC,iShD
integer :: iShFA,iShFB,iShFC,iShFD
integer :: iKA,iKB,iKC,iKD
double precision :: pErf,cErf
double precision :: start_cErf,end_cErf,t_cErf
! Output variables
integer,intent(out) :: npErf,nSigpErf,ncErf,nSigcErf
! Compute two-electron integrals over long-range Coulomb operator
write(*,*) '**********************************'
write(*,*) ' Compute three-electron integrals '
write(*,*) '**********************************'
write(*,*)
npErf = 0
nSigpErf = 0
ncErf = 0
nSigcErf = 0
iBasA = 0
iBasB = 0
iBasC = 0
iBasD = 0
! Open file to write down integrals
open(unit=41,file='int/4eInt_Type1.dat')
!------------------------------------------------------------------------
! Loops over shell A
!------------------------------------------------------------------------
do iShA=1,nShell
CenterA(1) = CenterShell(iShA,1)
CenterA(2) = CenterShell(iShA,2)
CenterA(3) = CenterShell(iShA,3)
TotAngMomA = TotAngMomShell(iShA)
nShellFunctionA = (TotAngMomA*TotAngMomA + 3*TotAngMomA + 2)/2
allocate(ShellFunctionA(1:nShellFunctionA,1:3))
call GenerateShell(TotAngMomA,nShellFunctionA,ShellFunctionA)
KA = KShell(iShA)
do iShFA=1,nShellFunctionA
iBasA = iBasA + 1
AngMomA(1) = ShellFunctionA(iShFA,1)
AngMomA(2) = ShellFunctionA(iShFA,2)
AngMomA(3) = ShellFunctionA(iShFA,3)
!------------------------------------------------------------------------
! Loops over shell B
!------------------------------------------------------------------------
do iShB=1,iShA
CenterB(1) = CenterShell(iShB,1)
CenterB(2) = CenterShell(iShB,2)
CenterB(3) = CenterShell(iShB,3)
TotAngMomB = TotAngMomShell(iShB)
nShellFunctionB = (TotAngMomB*TotAngMomB + 3*TotAngMomB + 2)/2
allocate(ShellFunctionB(1:nShellFunctionB,1:3))
call GenerateShell(TotAngMomB,nShellFunctionB,ShellFunctionB)
KB = KShell(iShB)
do iShFB=1,nShellFunctionB
iBasB = iBasB + 1
AngMomB(1) = ShellFunctionB(iShFB,1)
AngMomB(2) = ShellFunctionB(iShFB,2)
AngMomB(3) = ShellFunctionB(iShFB,3)
!------------------------------------------------------------------------
! Loops over shell C
!------------------------------------------------------------------------
do iShC=1,iShA
CenterC(1) = CenterShell(iShC,1)
CenterC(2) = CenterShell(iShC,2)
CenterC(3) = CenterShell(iShC,3)
TotAngMomC = TotAngMomShell(iShC)
nShellFunctionC = (TotAngMomC*TotAngMomC + 3*TotAngMomC + 2)/2
allocate(ShellFunctionC(1:nShellFunctionC,1:3))
call GenerateShell(TotAngMomC,nShellFunctionC,ShellFunctionC)
KC = KShell(iShC)
do iShFC=1,nShellFunctionC
iBasC = iBasC + 1
AngMomC(1) = ShellFunctionC(iShFC,1)
AngMomC(2) = ShellFunctionC(iShFC,2)
AngMomC(3) = ShellFunctionC(iShFC,3)
!------------------------------------------------------------------------
! Loops over shell D
!------------------------------------------------------------------------
do iShD=1,iShC
CenterD(1) = CenterShell(iShD,1)
CenterD(2) = CenterShell(iShD,2)
CenterD(3) = CenterShell(iShD,3)
TotAngMomD = TotAngMomShell(iShD)
nShellFunctionD = (TotAngMomD*TotAngMomD + 3*TotAngMomD + 2)/2
allocate(ShellFunctionD(1:nShellFunctionD,1:3))
call GenerateShell(TotAngMomD,nShellFunctionD,ShellFunctionD)
KD = KShell(iShD)
do iShFD=1,nShellFunctionD
iBasD = iBasD + 1
AngMomD(1) = ShellFunctionD(iShFD,1)
AngMomD(2) = ShellFunctionD(iShFD,2)
AngMomD(3) = ShellFunctionD(iShFD,3)
!------------------------------------------------------------------------
! Loops over contraction degrees
!-------------------------------------------------------------------------
call cpu_time(start_cErf)
cErf = 0d0
do iKA=1,KA
ExpA = ExpShell(iShA,iKA)
DA = DShell(iShA,iKA)*NormCoeff(ExpA,AngMomA)
do iKB=1,KB
ExpB = ExpShell(iShB,iKB)
DB = DShell(iShB,iKB)*NormCoeff(ExpB,AngMomB)
do iKC=1,KC
ExpC = ExpShell(iShC,iKC)
DC = DShell(iShC,iKC)*NormCoeff(ExpC,AngMomC)
do iKD=1,KD
ExpD = ExpShell(iShD,iKD)
DD = DShell(iShD,iKD)*NormCoeff(ExpD,AngMomD)
! Erf module
! call ErfInt(debug,npErf,nSigpErf, &
! ExpS, &
! ExpA,CenterA,AngMomA, &
! ExpB,CenterB,AngMomB, &
! ExpC,CenterC,AngMomC, &
! ExpD,CenterD,AngMomD, &
! pErf)
! cErf = cErf + DA*DB*DC*DD*pErf
enddo
enddo
enddo
enddo
call cpu_time(end_cErf)
ncErf = ncErf + 1
if(abs(cErf) > 1d-15) then
nSigcErf = nSigcErf + 1
t_cErf = end_cErf - start_cErf
write(41,'(F20.15,I6,I6,I6,I6)') &
cErf,iBasA,iBasB,iBasC,iBasD
if(debug) then
write(*,'(A10,1X,F16.10,1X,I6,1X,I6,1X,I6,1X,I6)') &
'(ab|erf(r)/r|cd) = ',cErf,iBasA,iBasB,iBasC,iBasD
endif
endif
!------------------------------------------------------------------------
! End loops over contraction degrees
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionD)
enddo
iBasD = 0
!------------------------------------------------------------------------
! End loops over shell D
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionC)
enddo
iBasC = 0
!------------------------------------------------------------------------
! End loops over shell C
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB)
enddo
iBasB = 0
!------------------------------------------------------------------------
! End loops over shell B
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA)
enddo
iBasA = 0
!------------------------------------------------------------------------
! End loops over shell A
!------------------------------------------------------------------------
write(*,*)
! Close files to write down integrals
close(unit=41)
end subroutine Compute4eInt

166
src/IntPak/ComputeKin.f90 Normal file
View File

@ -0,0 +1,166 @@
subroutine ComputeKin(debug,nShell, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
npKin,nSigpKin,ncKin,nSigcKin)
! Compute one-electron kinetic integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: nShell
double precision,intent(in) :: CenterShell(maxShell,3)
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
! Local variables
integer :: KA,KB
double precision :: CenterA(3),CenterB(3)
integer :: TotAngMomA,TotAngMomB
integer :: AngMomA(3),AngMomB(3)
integer :: nShellFunctionA,nShellFunctionB
integer,allocatable :: ShellFunctionA(:,:),ShellFunctionB(:,:)
double precision :: ExpA,ExpB
double precision,allocatable :: DA,DB
double precision :: NormCoeff
integer :: iBasA,iBasB
integer :: iShA,iShB
integer :: iShFA,iShFB
integer :: iKA,iKB
double precision :: pKin,cKin
double precision :: start_cKin,end_cKin,t_cKin
! Output variables
integer,intent(out) :: npKin,nSigpKin,ncKin,nSigcKin
! Compute one-electron integrals
write(*,*) '****************************************'
write(*,*) ' Compute one-electron kinetic integrals '
write(*,*) '****************************************'
write(*,*)
npKin = 0
nSigpKin = 0
ncKin = 0
nSigcKin = 0
iBasA = 0
iBasB = 0
! Open file to write down integrals
open(unit=9,file='int/Kin.dat')
!------------------------------------------------------------------------
! Loops over shell A
!------------------------------------------------------------------------
do iShA=1,nShell
CenterA(1) = CenterShell(iShA,1)
CenterA(2) = CenterShell(iShA,2)
CenterA(3) = CenterShell(iShA,3)
TotAngMomA = TotAngMomShell(iShA)
nShellFunctionA = (TotAngMomA*TotAngMomA + 3*TotAngMomA + 2)/2
allocate(ShellFunctionA(1:nShellFunctionA,1:3))
call GenerateShell(TotAngMomA,nShellFunctionA,ShellFunctionA)
KA = KShell(iShA)
do iShFA=1,nShellFunctionA
iBasA = iBasA + 1
AngMomA(1) = ShellFunctionA(iShFA,1)
AngMomA(2) = ShellFunctionA(iShFA,2)
AngMomA(3) = ShellFunctionA(iShFA,3)
!------------------------------------------------------------------------
! Loops over shell B
!------------------------------------------------------------------------
do iShB=1,nShell
CenterB(1) = CenterShell(iShB,1)
CenterB(2) = CenterShell(iShB,2)
CenterB(3) = CenterShell(iShB,3)
TotAngMomB = TotAngMomShell(iShB)
nShellFunctionB = (TotAngMomB*TotAngMomB + 3*TotAngMomB + 2)/2
allocate(ShellFunctionB(1:nShellFunctionB,1:3))
call GenerateShell(TotAngMomB,nShellFunctionB,ShellFunctionB)
KB = KShell(iShB)
do iShFB=1,nShellFunctionB
iBasB = iBasB + 1
AngMomB(1) = ShellFunctionB(iShFB,1)
AngMomB(2) = ShellFunctionB(iShFB,2)
AngMomB(3) = ShellFunctionB(iShFB,3)
!------------------------------------------------------------------------
! Loops over contraction degrees
!-------------------------------------------------------------------------
call cpu_time(start_cKin)
cKin = 0d0
do iKA=1,KA
ExpA = ExpShell(iShA,iKA)
DA = DShell(iShA,iKA)*NormCoeff(ExpA,AngMomA)
do iKB=1,KB
ExpB = ExpShell(iShB,iKB)
DB = DShell(iShB,iKB)*NormCoeff(ExpB,AngMomB)
call KinInt(npKin,nSigpKin, &
ExpA,CenterA,AngMomA, &
ExpB,CenterB,AngMomB, &
pKin)
cKin = cKin + DA*DB*pKin
enddo
enddo
call cpu_time(end_cKin)
ncKin = ncKin + 1
if(abs(cKin) > 1d-15) then
nSigcKin = nSigcKin + 1
t_cKin = end_cKin - start_cKin
write(9,'(I6,I6,F20.15)') iBasA,iBasB,cKin
if(debug) then
write(*,'(A10,1X,F16.10,1X,I6,1X,I6)') '(a|T|b) = ',cKin,iBasA,iBasB
endif
endif
!------------------------------------------------------------------------
! End loops over contraction degrees
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB)
enddo
iBasB = 0
!------------------------------------------------------------------------
! End loops over shell B
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA)
enddo
iBasA = 0
!------------------------------------------------------------------------
! End loops over shell A
!------------------------------------------------------------------------
write(*,*)
! Close files to write down integrals
close(unit=9)
end subroutine ComputeKin

189
src/IntPak/ComputeNuc.f90 Normal file
View File

@ -0,0 +1,189 @@
subroutine ComputeNuc(debug,nShell, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
NAtoms,ZNuc,XYZAtoms, &
npNuc,nSigpNuc,ncNuc,nSigcNuc)
! Compute electron repulsion integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: nShell
double precision,intent(in) :: CenterShell(maxShell,3)
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
integer :: NAtoms
double precision :: ZNuc(NAtoms),XYZAtoms(NAtoms,3)
! Local variables
integer :: KA,KB
double precision :: CenterA(3),CenterB(3),CenterC(3)
integer :: TotAngMomA,TotAngMomB
integer :: AngMomA(3),AngMomB(3)
integer :: nShellFunctionA,nShellFunctionB
integer,allocatable :: ShellFunctionA(:,:),ShellFunctionB(:,:)
double precision :: ExpA,ExpB,ZC
double precision,allocatable :: DA,DB
double precision :: NormCoeff
integer :: iBasA,iBasB
integer :: iShA,iShB,iNucC
integer :: iShFA,iShFB
integer :: iKA,iKB
double precision :: pNuc,cNuc
double precision :: start_cNuc,end_cNuc,t_cNuc
! Output variables
integer,intent(out) :: npNuc,nSigpNuc,ncNuc,nSigcNuc
! Compute one-electron nuclear attraction integrals
write(*,*) '***************************************************'
write(*,*) ' Compute one-electron nuclear attraction integrals '
write(*,*) '***************************************************'
write(*,*)
npNuc = 0
nSigpNuc = 0
ncNuc = 0
nSigcNuc = 0
iBasA = 0
iBasB = 0
iNucC = 0
! Open file to write down integrals
open(unit=10,file='int/Nuc.dat')
!------------------------------------------------------------------------
! Loops over shell A
!------------------------------------------------------------------------
do iShA=1,nShell
CenterA(1) = CenterShell(iShA,1)
CenterA(2) = CenterShell(iShA,2)
CenterA(3) = CenterShell(iShA,3)
TotAngMomA = TotAngMomShell(iShA)
nShellFunctionA = (TotAngMomA*TotAngMomA + 3*TotAngMomA + 2)/2
allocate(ShellFunctionA(1:nShellFunctionA,1:3))
call GenerateShell(TotAngMomA,nShellFunctionA,ShellFunctionA)
KA = KShell(iShA)
do iShFA=1,nShellFunctionA
iBasA = iBasA + 1
AngMomA(1) = ShellFunctionA(iShFA,1)
AngMomA(2) = ShellFunctionA(iShFA,2)
AngMomA(3) = ShellFunctionA(iShFA,3)
!------------------------------------------------------------------------
! Loops over shell B
!------------------------------------------------------------------------
do iShB=1,nShell
CenterB(1) = CenterShell(iShB,1)
CenterB(2) = CenterShell(iShB,2)
CenterB(3) = CenterShell(iShB,3)
TotAngMomB = TotAngMomShell(iShB)
nShellFunctionB = (TotAngMomB*TotAngMomB + 3*TotAngMomB + 2)/2
allocate(ShellFunctionB(1:nShellFunctionB,1:3))
call GenerateShell(TotAngMomB,nShellFunctionB,ShellFunctionB)
KB = KShell(iShB)
do iShFB=1,nShellFunctionB
iBasB = iBasB + 1
AngMomB(1) = ShellFunctionB(iShFB,1)
AngMomB(2) = ShellFunctionB(iShFB,2)
AngMomB(3) = ShellFunctionB(iShFB,3)
!------------------------------------------------------------------------
! Loops over nuclear centers
!------------------------------------------------------------------------
call cpu_time(start_cNuc)
cNuc = 0d0
do iNucC=1,NAtoms
CenterC(1) = XYZAtoms(iNucC,1)
CenterC(2) = XYZAtoms(iNucC,2)
CenterC(3) = XYZAtoms(iNucC,3)
ZC = ZNuc(iNucC)
!------------------------------------------------------------------------
! Loops over contraction degrees
!-------------------------------------------------------------------------
do iKA=1,KA
ExpA = ExpShell(iShA,iKA)
DA = DShell(iShA,iKA)*NormCoeff(ExpA,AngMomA)
do iKB=1,KB
ExpB = ExpShell(iShB,iKB)
DB = DShell(iShB,iKB)*NormCoeff(ExpB,AngMomB)
call NucInt(debug,npNuc,nSigpNuc, &
ExpA,CenterA,AngMomA, &
ExpB,CenterB,AngMomB, &
CenterC, &
pNuc)
cNuc = cNuc - DA*DB*ZC*pNuc
enddo
enddo
!------------------------------------------------------------------------
! End loops over contraction degrees
!------------------------------------------------------------------------
enddo
call cpu_time(end_cNuc)
!------------------------------------------------------------------------
! End loops over nuclear centers C
!------------------------------------------------------------------------
ncNuc = ncNuc + 1
if(abs(cNuc) > 1d-15) then
nSigcNuc = nSigcNuc + 1
t_cNuc = end_cNuc - start_cNuc
write(10,'(I6,I6,F20.15)') iBasA,iBasB,cNuc
if(debug) then
write(*,'(A10,1X,F16.10,1X,I6,1X,I6)') '(a|V|b) = ',cNuc,iBasA,iBasB
write(*,*)
endif
endif
enddo
deallocate(ShellFunctionB)
enddo
iBasB = 0
!------------------------------------------------------------------------
! End loops over shell B
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA)
enddo
iBasA = 0
!------------------------------------------------------------------------
! End loops over shell A
!------------------------------------------------------------------------
write(*,*)
! Close files to write down integrals
close(unit=10)
end subroutine ComputeNuc

170
src/IntPak/ComputeOv.f90 Normal file
View File

@ -0,0 +1,170 @@
subroutine ComputeOv(debug,NBasis,nShell, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
npOv,nSigpOv,ncOv,nSigcOv,S)
! Compute one-electron overlap integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: NBasis,nShell
double precision,intent(in) :: CenterShell(maxShell,3)
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
! Local variables
integer :: KA,KB
double precision :: CenterA(3),CenterB(3)
integer :: TotAngMomA,TotAngMomB
integer :: AngMomA(3),AngMomB(3)
integer :: nShellFunctionA,nShellFunctionB
integer,allocatable :: ShellFunctionA(:,:),ShellFunctionB(:,:)
double precision :: ExpA,ExpB
double precision,allocatable :: DA,DB
double precision :: NormCoeff
integer :: iBasA,iBasB
integer :: iShA,iShB
integer :: iShFA,iShFB
integer :: iKA,iKB
double precision :: pOv,cOv
double precision :: start_cOv,end_cOv,t_cOv
! Output variables
integer,intent(out) :: npOv,nSigpOv,ncOv,nSigcOv
double precision,intent(out) :: S(NBasis,NBasis)
! Compute one-electron integrals
write(*,*) '****************************************'
write(*,*) ' Compute one-electron overlap integrals '
write(*,*) '****************************************'
write(*,*)
npOv = 0
nSigpOv = 0
ncOv = 0
nSigcOv = 0
iBasA = 0
iBasB = 0
! Open file to write down integrals
open(unit=8,file='int/Ov.dat')
!------------------------------------------------------------------------
! Loops over shell A
!------------------------------------------------------------------------
do iShA=1,nShell
CenterA(1) = CenterShell(iShA,1)
CenterA(2) = CenterShell(iShA,2)
CenterA(3) = CenterShell(iShA,3)
TotAngMomA = TotAngMomShell(iShA)
nShellFunctionA = (TotAngMomA*TotAngMomA + 3*TotAngMomA + 2)/2
allocate(ShellFunctionA(1:nShellFunctionA,1:3))
call GenerateShell(TotAngMomA,nShellFunctionA,ShellFunctionA)
KA = KShell(iShA)
do iShFA=1,nShellFunctionA
iBasA = iBasA + 1
AngMomA(1) = ShellFunctionA(iShFA,1)
AngMomA(2) = ShellFunctionA(iShFA,2)
AngMomA(3) = ShellFunctionA(iShFA,3)
!------------------------------------------------------------------------
! Loops over shell B
!------------------------------------------------------------------------
do iShB=1,nShell
CenterB(1) = CenterShell(iShB,1)
CenterB(2) = CenterShell(iShB,2)
CenterB(3) = CenterShell(iShB,3)
TotAngMomB = TotAngMomShell(iShB)
nShellFunctionB = (TotAngMomB*TotAngMomB + 3*TotAngMomB + 2)/2
allocate(ShellFunctionB(1:nShellFunctionB,1:3))
call GenerateShell(TotAngMomB,nShellFunctionB,ShellFunctionB)
KB = KShell(iShB)
do iShFB=1,nShellFunctionB
iBasB = iBasB + 1
AngMomB(1) = ShellFunctionB(iShFB,1)
AngMomB(2) = ShellFunctionB(iShFB,2)
AngMomB(3) = ShellFunctionB(iShFB,3)
!------------------------------------------------------------------------
! Loops over contraction degrees
!-------------------------------------------------------------------------
call cpu_time(start_cOv)
cOv = 0d0
do iKA=1,KA
ExpA = ExpShell(iShA,iKA)
DA = DShell(iShA,iKA)*NormCoeff(ExpA,AngMomA)
do iKB=1,KB
ExpB = ExpShell(iShB,iKB)
DB = DShell(iShB,iKB)*NormCoeff(ExpB,AngMomB)
call OvInt(npOv,nSigpOv, &
ExpA,CenterA,AngMomA, &
ExpB,CenterB,AngMomB, &
pOv)
cOv = cOv + DA*DB*pOv
enddo
enddo
call cpu_time(end_cOv)
ncOv = ncOv + 1
S(iBasA,iBasB) = cOv
if(abs(cOv) > 1d-15) then
nSigcOv = nSigcOv + 1
t_cOv = end_cOv - start_cOv
write(8,'(I6,I6,F20.15)') iBasA,iBasB,cOv
if(debug) then
write(*,'(A10,1X,F16.10,1X,I6,1X,I6)') '(a|b) = ',cOv,iBasA,iBasB
endif
endif
!------------------------------------------------------------------------
! End loops over contraction degrees
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionB)
enddo
iBasB = 0
!------------------------------------------------------------------------
! End loops over shell B
!------------------------------------------------------------------------
enddo
deallocate(ShellFunctionA)
enddo
iBasA = 0
!------------------------------------------------------------------------
! End loops over shell A
!------------------------------------------------------------------------
write(*,*)
! Close files to write down integrals
close(unit=8)
end subroutine ComputeOv

174
src/IntPak/FormVRR3e.f90 Normal file
View File

@ -0,0 +1,174 @@
subroutine FormVRR3e(ExpZ,ExpG,CenterZ,DY0,DY1,D2Y0,D2Y1,delta0,delta1,Y0,Y1)
! Form stuff we need...
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: ExpZ(3),ExpG(3,3)
double precision,intent(in) :: CenterZ(3,3)
! Local variables
integer :: i,j,k,l
double precision :: ZetaMat(3,3)
double precision :: CMat(3,3),GMat(3,3)
double precision :: Delta0Mat(3,3),Delta1Mat(3,3)
double precision :: InvDelta0Mat(3,3),InvDelta1Mat(3,3)
double precision :: CenterY(3,3,3)
double precision :: YMat(3,3),Y2Mat(3,3)
double precision :: DYMat(3,3,3),D2YMat(3,3,3,3)
double precision :: D0Mat(3,3),D1Mat(3,3)
double precision :: KappaCross
! Output variables
double precision,intent(out) :: DY0(3),DY1(3),D2Y0(3,3),D2Y1(3,3)
double precision,intent(out) :: delta0,delta1,Y0,Y1
! Initalize arrays
ZetaMat = 0d0
CMat = 0d0
GMat = 0d0
YMat = 0d0
Y2Mat = 0d0
D0Mat = 0d0
D1Mat = 0d0
! Form the zeta matrix Eq. (15a)
do i=1,3
ZetaMat(i,i) = ExpZ(i)
enddo
! print*,'Zeta'
! call matout(3,3,ZetaMat)
! Form the C matrix Eq. (15a)
CMat(1,1) = 1d0
CMat(2,2) = 1d0
CMat(1,2) = -1d0
CMat(2,1) = -1d0
! print*,'C'
! call matout(3,3,CMat)
! Form the G matrix Eq. (15b)
do i=1,3
do j=1,i-1
GMat(i,j) = - ExpG(j,i)
enddo
do j=i+1,3
GMat(i,j) = - ExpG(i,j)
enddo
enddo
do i=1,3
do j=1,i-1
GMat(i,i) = GMat(i,i) + ExpG(j,i)
enddo
do j=i+1,3
GMat(i,i) = GMat(i,i) + ExpG(i,j)
enddo
enddo
! print*,'G'
! call matout(3,3,GMat)
! Form the Y and Y^2 matrices Eq. (16b)
do i=1,3
do j=i+1,3
do k=1,3
CenterY(i,j,k) = CenterZ(i,k) - CenterZ(j,k)
Y2Mat(i,j) = Y2Mat(i,j) + CenterY(i,j,k)**2
enddo
YMat(i,j) = sqrt(Y2Mat(i,j))
enddo
enddo
! print*,'Y'
! call matout(3,3,YMat)
! print*,'Y2'
! call matout(3,3,Y2Mat)
! Form the delta0 and delta1 matrices Eq. (14)
do i=1,3
do j=1,3
Delta0Mat(i,j) = ZetaMat(i,j) + GMat(i,j)
Delta1Mat(i,j) = Delta0Mat(i,j) + CMat(i,j)
enddo
enddo
! Form the DY and D2Y matrices
do i=1,3
do j=1,3
do k=1,3
DYMat(i,j,k) = KappaCross(i,j,k)*YMat(j,k)/ExpZ(i)
do l=1,3
D2YMat(i,j,k,l) = 0.5d0*KappaCross(i,k,l)*KappaCross(j,k,l)/(ExpZ(i)*ExpZ(j))
enddo
enddo
enddo
enddo
! Compute the inverse of the Delta0 and Delta1 matrices
! InvDelta0Mat = Delta0Mat
! InvDelta1Mat = Delta1Mat
do i=1,3
do j=1,3
InvDelta0Mat(i,j) = Delta0Mat(i,j)
InvDelta1Mat(i,j) = Delta1Mat(i,j)
enddo
enddo
! call amove(3,3,Delta0Mat,InvDelta0Mat)
! call amove(3,3,Delta1Mat,InvDelta1Mat)
call CalcInv3(InvDelta0Mat,delta0)
call CalcInv3(InvDelta1Mat,delta1)
! call matout(3,3,InvDelta0Mat)
! call matout(3,3,InvDelta1Mat)
! print*, 'delta0,delta1 = ',delta0,delta1
! Form the Delta matrix Eq. (16a)
do i=1,3
do j=1,3
do k=1,3
do l=1,3
D0Mat(i,j) = D0Mat(i,k) + ZetaMat(i,k)*InvDelta0Mat(k,l)*ZetaMat(l,j)
D1Mat(i,j) = D1Mat(i,k) + ZetaMat(i,k)*InvDelta1Mat(k,l)*ZetaMat(l,j)
enddo
enddo
enddo
enddo
! Form the derivative matrices
do i=1,3
call CalcTrAB(3,D0Mat,D2YMat,DY0(i))
call CalcTrAB(3,D1Mat,D2YMat,DY1(i))
do j=1,3
call CalcTrAB(3,D0Mat,D2YMat,D2Y0(i,j))
call CalcTrAB(3,D1Mat,D2YMat,D2Y1(i,j))
enddo
enddo
! Compute Y0 and Y1
call CalcTrAB(3,D0Mat,Y2Mat,Y0)
call CalcTrAB(3,D1Mat,Y2Mat,Y1)
end subroutine FormVRR3e

140
src/IntPak/G2eInt.f90 Normal file
View File

@ -0,0 +1,140 @@
function G2eInt(debug,iType, &
ExpG, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet)
! Compute recursively the primitive two-electron integral [ab|cd]
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: iType
double precision,intent(in) :: ExpBra(2),ExpKet(2)
double precision,intent(in) :: ExpG
double precision,intent(in) :: CenterBra(2,3),CenterKet(2,3)
integer,intent(in) :: AngMomBra(2,3),AngMomKet(2,3)
! Local variables
integer :: TotAngMomBra(3),TotAngMomKet(3)
double precision :: ExpZi(2),ExpY(2,2)
double precision :: CenterZ(2,3),CenterAB(2,3),CenterZA(2,3),CenterY(2,2,3)
double precision :: NormABSq(2),NormYSq(2,2)
double precision :: GAB(2)
double precision,allocatable :: Om(:)
double precision :: fG
double precision :: HRR2e,VRR2e
double precision :: a1a2b1b2
integer :: i,j,k,maxm
double precision :: start_Om,finish_Om,start_RR,finish_RR,t_Om,t_RR
! Output variables
double precision :: G2eInt
! Pre-computed shell-pair quantities
do i=1,2
ExpZi(i) = 1d0/(ExpBra(i) + ExpKet(i))
enddo
NormABSq = 0d0
do j=1,3
do i=1,2
CenterZ(i,j) = (ExpBra(i)*CenterBra(i,j) + ExpKet(i)*CenterKet(i,j))*ExpZi(i)
CenterAB(i,j) = CenterBra(i,j) - CenterKet(i,j)
CenterZA(i,j) = CenterZ(i,j) - CenterBra(i,j)
NormABSq(i) = NormABSq(i) + CenterAB(i,j)**2
enddo
enddo
do i=1,2
GAB(i) = (pi*ExpZi(i))**(1.5d0)*exp(-ExpBra(i)*ExpKet(i)*NormABSq(i)*ExpZi(i))
enddo
! Pre-computed shell-quartet quantities
do i=1,2
do j=1,2
ExpY(i,j) = 1d0/(ExpZi(i) + ExpZi(j))
enddo
enddo
do i=1,2
do j=1,2
NormYSq(i,j) = 0d0
do k=1,3
CenterY(i,j,k) = CenterZ(i,k) - CenterZ(j,k)
NormYSq(i,j) = NormYSq(i,j) + CenterY(i,j,k)**2
enddo
enddo
enddo
! fG = (ExpZ(1)*ExpZ(2)*ExpG)/(ExpZ(1)*ExpZ(2) + ExpZ(1)*ExpG + ExpZ(2)*ExpG)
fG = 1d0/(ExpZi(1) + 1d0/ExpG + ExpZi(2))
! Total angular momemtum
maxm = 0
do i=1,2
TotAngMomBra(i) = AngMomBra(i,1) + AngMomBra(i,2) + AngMomBra(i,3)
TotAngMomKet(i) = AngMomKet(i,1) + AngMomKet(i,2) + AngMomKet(i,3)
maxm = maxm + TotAngMomBra(i) + TotAngMomKet(i)
enddo
! Pre-compute (00|00)^m
allocate(Om(0:maxm))
call cpu_time(start_Om)
if(iType == 1) then
call CalcOmERI(maxm,ExpY(1,2),NormYSq(1,2),Om)
elseif(iType == 3) then
call CalcOmYuk(maxm,ExpG,ExpY(1,2),fG,NormYSq(1,2),Om)
elseif(iType == 4) then
call CalcOmErf(maxm,ExpY(1,2),fG,NormYSq(1,2),Om)
endif
call cpu_time(finish_Om)
! Print (00|00)^m
if(debug) then
write(*,*) '(00|00)^m'
do i=0,maxm
write(*,*) i,Om(i)
enddo
write(*,*)
endif
!------------------------------------------------------------------------
! Launch reccurence relations!
!------------------------------------------------------------------------
call cpu_time(start_RR)
if(TotAngMomKet(1) == 0 .and. TotAngMomKet(2) == 0) then
if(TotAngMomBra(1) == 0 .and. TotAngMomBra(2) == 0) then
a1a2b1b2 = Om(0)
else
a1a2b1b2 = VRR2e(0,AngMomBra,maxm,Om,ExpZi,ExpY,CenterZA,CenterY)
endif
else
a1a2b1b2 = HRR2e(AngMomBra,AngMomKet,maxm,Om,ExpZi,ExpY,CenterAB,CenterZA,CenterY)
endif
call cpu_time(finish_RR)
! Timings
t_Om = finish_Om - start_Om
t_RR = finish_RR - start_RR
! Print result
G2eInt = GAB(1)*GAB(2)*a1a2b1b2
end function G2eInt

124
src/IntPak/G3eInt.f90 Normal file
View File

@ -0,0 +1,124 @@
function G3eInt(debug,iType, &
ExpG13,ExpG23, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet)
! Compute two-electron integrals over the Yukawa operator
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: iType
double precision,intent(in) :: ExpG13,ExpG23
double precision,intent(in) :: ExpBra(3),ExpKet(3)
double precision,intent(in) :: CenterBra(3,3),CenterKet(3,3)
integer,intent(in) :: AngMomBra(3,3),AngMomKet(3,3)
! Local variables
double precision :: ExpG(3,3)
integer :: TotAngMomBra(3),TotAngMomKet(3)
double precision :: ExpZ(3)
double precision :: CenterZ(3,3),CenterAB(3,3),CenterZA(3,3)
double precision :: NormABSq(3)
double precision :: GAB(3)
double precision,allocatable :: Om(:)
double precision :: HRR3e,VRR3e
double precision :: DY0(3),DY1(3),D2Y0(3,3),D2Y1(3,3)
double precision :: delta0,delta1,Y0,Y1
integer :: i,j,maxm
double precision :: start_Om,finish_Om,t_Om,start_RR,finish_RR,t_RR
double precision :: a1a2a3b1b2b3
! Output variables
double precision :: G3eInt
! Gaussian geminal exponents
ExpG = 0d0
ExpG(1,3) = ExpG13
ExpG(2,3) = ExpG23
! Pre-computed quantities for shell-pair
do i=1,3
ExpZ(i) = ExpBra(i) + ExpKet(i)
enddo
NormABSq = 0d0
do i=1,3
do j=1,3
CenterZ(i,j) = (ExpBra(i)*CenterBra(i,j) + ExpKet(i)*CenterKet(i,j))/ExpZ(i)
CenterAB(i,j) = CenterBra(i,j) - CenterKet(i,j)
CenterZA(i,j) = CenterZ(i,j) - CenterBra(i,j)
NormABSq(i) = NormABSq(i) + CenterAB(i,j)**2
enddo
enddo
do i=1,3
GAB(i) = (pi/ExpZ(i))**(1.5d0)*exp(-ExpBra(i)*ExpKet(i)*NormABSq(i)/ExpZ(i))
enddo
! Pre-computed shell-sextet quantities
call FormVRR3e(ExpZ,ExpG,CenterZ,DY0,DY1,D2Y0,D2Y1,delta0,delta1,Y0,Y1)
! Total angular momemtum
maxm = 0
do i=1,3
TotAngMomBra(i) = AngMomBra(i,1) + AngMomBra(i,2) + AngMomBra(i,3)
TotAngMomKet(i) = AngMomKet(i,1) + AngMomKet(i,2) + AngMomKet(i,3)
maxm = maxm + TotAngMomBra(i) + TotAngMomKet(i)
enddo
! Pre-compute (000|000)^m
allocate(Om(0:maxm))
call cpu_time(start_Om)
call CalcOm3e(maxm,delta0,delta1,Y0,Y1,Om)
call cpu_time(finish_Om)
! Print (000|000)^m
if(.false.) then
write(*,*) '(000|000)^m'
do i=0,maxm
write(*,*) i,Om(i)
enddo
write(*,*)
endif
!------------------------------------------------------------------------
! Launch reccurence relations!
!------------------------------------------------------------------------
call cpu_time(start_RR)
if(TotAngMomKet(1) == 0 .and. TotAngMomKet(2) == 0 .and. TotAngMomKet(3) == 0) then
if(TotAngMomBra(1) == 0 .and. TotAngMomBra(2) == 0 .and. TotAngMomBra(3) == 0) then
a1a2a3b1b2b3 = Om(0)
else
a1a2a3b1b2b3 = VRR3e(0,AngMomBra,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
else
a1a2a3b1b2b3 = HRR3e(AngMomBra,AngMomKet,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
call cpu_time(finish_RR)
! Timings
t_Om = finish_Om - start_Om
t_RR = finish_RR - start_RR
! Print result
G3eInt = GAB(1)*GAB(2)*GAB(3)*a1a2a3b1b2b3
end function G3eInt

107
src/IntPak/GF12Int.f90 Normal file
View File

@ -0,0 +1,107 @@
function GF12Int(ExpG,ExpA,CenterA,AngMomA,ExpB,CenterB,AngMomB,ExpC,CenterC,AngMomC,ExpD,CenterD,AngMomD)
! Compute two-electron integrals over Gaussian geminals
implicit none
! Input variables
double precision,intent(in) :: ExpG
double precision,intent(in) :: ExpA,ExpB,ExpC,ExpD
double precision,intent(in) :: CenterA(3),CenterB(3),CenterC(3),CenterD(3)
integer,intent(in) :: AngMomA(3),AngMomB(3),AngMomC(3),AngMomD(3)
! Local variables
double precision :: ExpAi,ExpBi,ExpCi,ExpDi,ExpGi
double precision :: ExpP,ExpQ,ExpPi,ExpQi,ExpPGQi
double precision :: CenterP(3),CenterQ(3),CenterAB(3),CenterCD(3),CenterPQSq(3),CenterRA(3),CenterRC(3)
double precision :: NormABSq,NormCDSq
double precision :: GAB,GCD
double precision :: fP,fG,fQ,gP,gG,gQ
double precision :: HRRF12
integer :: i
double precision :: pi
double precision :: start_RR,finish_RR,t_RR
double precision :: Gabcd(3)
! Output variables
double precision :: GF12Int
pi = 4d0*atan(1d0)
! Pre-computed shell quantities
ExpAi = 1d0/ExpA
ExpBi = 1d0/ExpB
ExpCi = 1d0/ExpC
ExpDi = 1d0/ExpD
ExpGi = 1d0/ExpG
! Pre-computed quantities for shell-pair AB
ExpP = ExpA + ExpB
ExpPi = 1d0/ExpP
NormABSq = 0d0
Do i=1,3
CenterP(i) = (ExpA*CenterA(i) + ExpB*CenterB(i))*ExpPi
CenterAB(i) = CenterA(i) - CenterB(i)
NormABSq = NormABSq + CenterAB(i)**2
Enddo
GAB = (pi*ExpPi)**(1.5d0)*exp(-NormABSq/(ExpAi+ExpBi))
! Pre-computed quantities for shell-pair CD
ExpQ = ExpC + ExpD
ExpQi = 1d0/ExpQ
NormCDSq = 0d0
Do i=1,3
CenterQ(i) = (ExpC*CenterC(i) + ExpD*CenterD(i))*ExpQi
CenterCD(i) = CenterC(i) - CenterD(i)
NormCDSq = NormCDSq + CenterCD(i)**2
Enddo
GCD = (pi*ExpQi)**(1.5d0)*exp(-NormCDSq/(ExpCi+ExpDi))
! Pre-computed shell-quartet quantities
ExpPGQi = ExpPi + ExpGi + ExpQi
Do i=1,3
CenterPQSq(i) = (CenterP(i) - CenterQ(i))**2
Enddo
fP = ExpPi/ExpPGQi
fG = ExpGi/ExpPGQi
fQ = ExpQi/ExpPGQi
gP = (1d0 - fP)*0.5d0*ExpPi
gG = fP*0.5d0*expQi
gQ = (1d0 - fQ)*0.5d0*ExpQi
do i=1,3
CenterRA(i) = CenterP(i) - CenterA(i) + fP*(CenterQ(i) - CenterP(i))
CenterRC(i) = CenterQ(i) - CenterC(i) + fQ*(CenterP(i) - CenterQ(i))
enddo
!------------------------------------------------------------------------
! Launch reccurence relations!
!------------------------------------------------------------------------
call cpu_time(start_RR)
! Loop over cartesian directions
Do i=1,3
Gabcd(i) = HRRF12(AngMomA(i),AngMomB(i),AngMomC(i),AngMomD(i),fG,gP,gG,gQ,ExpPGQi, &
CenterPQSq(i),CenterRA(i),CenterRC(i),CenterAB(i),CenterCD(i))
Enddo
call cpu_time(finish_RR)
! Print result
GF12Int = GAB*GCD*Gabcd(1)*Gabcd(2)*Gabcd(3)
t_RR = finish_RR - start_RR
end function GF12Int

30
src/IntPak/GenerateShell.f90 Normal file
View File

@ -0,0 +1,30 @@
subroutine GenerateShell(atot,nShellFunction,ShellFunction)
implicit none
! Input variables
integer,intent(in) :: atot,nShellFunction
! Local variables
integer :: ax,ay,az,ia
! Output variables
integer,intent(out) :: ShellFunction(nShellFunction,3)
ia = 0
do ax=atot,0,-1
do az=0,atot
ay = atot - ax - az
if(ay >= 0) then
ia = ia + 1
ShellFunction(ia,1) = ax
ShellFunction(ia,2) = ay
ShellFunction(ia,3) = az
endif
enddo
enddo
end subroutine GenerateShell

101
src/IntPak/HRR2e.f90 Normal file
View File

@ -0,0 +1,101 @@
recursive function HRR2e(AngMomBra,AngMomKet, &
maxm,Om,ExpZi,ExpY, &
CenterAB,CenterZA,CenterY) &
result(a1a2b1b2)
! Horintal recurrence relations for two-electron integrals
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: AngMomBra(2,3),AngMomKet(2,3)
integer,intent(in) :: maxm
double precision,intent(in) :: Om(0:maxm),ExpZi(2),ExpY(2,2)
double precision,intent(in) :: CenterAB(2,3),CenterZA(2,3),CenterY(2,2,3)
! Local variables
logical :: NegAngMomKet(2)
integer :: TotAngMomBra(2),TotAngMomKet(2)
integer :: a1p(2,3),b1m(2,3),a2p(2,3),b2m(2,3)
integer :: i,j,xyz
double precision :: VRR2e
! Output variables
double precision :: a1a2b1b2
do i=1,2
NegAngMomKet(i) = AngMomKet(i,1) < 0 .or. AngMomKet(i,2) < 0 .or. AngMomKet(i,3) < 0
TotAngMomBra(i) = AngMomBra(i,1) + AngMomBra(i,2) + AngMomBra(i,3)
TotAngMomKet(i) = AngMomKet(i,1) + AngMomKet(i,2) + AngMomKet(i,3)
enddo
!------------------------------------------------------------------------
! Termination condition
!------------------------------------------------------------------------
! if(NegAngMomKet(1) .or. NegAngMomKet(2)) then
! a1a2b1b2 = 0d0
!------------------------------------------------------------------------
! 1st and 2nd vertical recurrence relations: <a1a2|00>
!------------------------------------------------------------------------
! elseif(TotAngMomKet(1) == 0 .and. TotAngMomKet(2) == 0) then
if(TotAngMomKet(1) == 0 .and. TotAngMomKet(2) == 0) then
a1a2b1b2 = VRR2e(0,AngMomBra,maxm,Om,ExpZi,ExpY,CenterZA,CenterY)
!------------------------------------------------------------------------
! 1st horizontal recurrence relation (2 terms): <a1a2|b1+0>
!------------------------------------------------------------------------
elseif(TotAngMomKet(2) == 0) then
do i=1,2
do j=1,3
a1p(i,j) = AngMomBra(i,j)
b1m(i,j) = AngMomKet(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomKet(1,1) > 0) then
xyz = 1
elseif(AngMomKet(1,2) > 0) then
xyz = 2
elseif(AngMomKet(1,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in HRR2e!'
endif
! End loop over cartesian directions
a1p(1,xyz) = a1p(1,xyz) + 1
b1m(1,xyz) = b1m(1,xyz) - 1
a1a2b1b2 = HRR2e(a1p,b1m,maxm,Om,ExpZi,ExpY,CenterAB,CenterZA,CenterY) &
+ CenterAB(1,xyz)*HRR2e(AngMomBra,b1m,maxm,Om,ExpZi,ExpY,CenterAB,CenterZA,CenterY)
!------------------------------------------------------------------------
! 2nd horizontal recurrence relation (2 terms): <a1a2|b1b2+>
!------------------------------------------------------------------------
else
do i=1,2
do j=1,3
a2p(i,j) = AngMomBra(i,j)
b2m(i,j) = AngMomKet(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomKet(2,1) > 0) then
xyz = 1
elseif(AngMomKet(2,2) > 0) then
xyz = 2
elseif(AngMomKet(2,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in HRR2e!'
endif
! End loop over cartesian directions
a2p(2,xyz) = a2p(2,xyz) + 1
b2m(2,xyz) = b2m(2,xyz) - 1
a1a2b1b2 = HRR2e(a2p,b2m,maxm,Om,ExpZi,ExpY,CenterAB,CenterZA,CenterY) &
+ CenterAB(2,xyz)*HRR2e(AngMomBra,b2m,maxm,Om,ExpZi,ExpY,CenterAB,CenterZA,CenterY)
endif
end function HRR2e

128
src/IntPak/HRR3e.f90 Normal file
View File

@ -0,0 +1,128 @@
recursive function HRR3e(AngMomBra,AngMomKet,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1) &
result(a1a2a3b1b2b3)
! Horizontal recurrence relations for three-electron integrals
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: AngMomBra(3,3),AngMomKet(3,3)
integer,intent(in) :: maxm
double precision,intent(in) :: Om(0:maxm),ExpZ(3),CenterAB(3,3),CenterZA(3,3)
double precision,intent(in) :: DY0(3),DY1(3),D2Y0(3,3),D2Y1(3,3)
! Local variables
logical :: NegAngMomKet(3)
integer :: TotAngMomBra(3),TotAngMomKet(3)
integer :: a1p(3,3),b1m(3,3),a2p(3,3),b2m(3,3),a3p(3,3),b3m(3,3)
integer :: i,j,xyz
double precision :: VRR3e
! Output variables
double precision :: a1a2a3b1b2b3
do i=1,3
NegAngMomKet(i) = AngMomKet(i,1) < 0 .or. AngMomKet(i,2) < 0 .or. AngMomKet(i,3) < 0
TotAngMomBra(i) = AngMomBra(i,1) + AngMomBra(i,2) + AngMomBra(i,3)
TotAngMomKet(i) = AngMomKet(i,1) + AngMomKet(i,2) + AngMomKet(i,3)
enddo
!------------------------------------------------------------------------
! Termination condition
!------------------------------------------------------------------------
if(NegAngMomKet(1) .or. NegAngMomKet(2) .or. NegAngMomKet(3)) then
a1a2a3b1b2b3 = 0d0
!------------------------------------------------------------------------
! 1st and 2nd vertical recurrence relations: <a1a2a3|000>
!------------------------------------------------------------------------
elseif(TotAngMomKet(1) == 0 .and. TotAngMomKet(2) == 0 .and. TotAngMomKet(3) == 0) then
a1a2a3b1b2b3 = VRR3e(0,AngMomBra,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
!------------------------------------------------------------------------
! 1st horizontal recurrence relation (2 terms): <a1a2a3|b1+00>
!------------------------------------------------------------------------
elseif(TotAngMomKet(2) == 0 .and. TotAngMomKet(3) == 0) then
do i=1,3
do j=1,3
a1p(i,j) = AngMomBra(i,j)
b1m(i,j) = AngMomKet(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomKet(1,1) > 0) then
xyz = 1
elseif(AngMomKet(1,2) > 0) then
xyz = 2
elseif(AngMomKet(1,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in HRR3e!'
endif
! End loop over cartesian directions
a1p(1,xyz) = a1p(1,xyz) + 1
b1m(1,xyz) = b1m(1,xyz) - 1
a1a2a3b1b2b3 = HRR3e(a1p,b1m,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1) &
+ CenterAB(1,xyz)* &
HRR3e(AngMomBra,b1m,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1)
!------------------------------------------------------------------------
! 2nd horizontal recurrence relation (2 terms): <a1a2a3|b1b2+0>
!------------------------------------------------------------------------
elseif(TotAngMomKet(3) == 0) then
do i=1,3
do j=1,3
a2p(i,j) = AngMomBra(i,j)
b2m(i,j) = AngMomKet(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomKet(2,1) > 0) then
xyz = 1
elseif(AngMomKet(2,2) > 0) then
xyz = 2
elseif(AngMomKet(2,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in HRR3e!'
endif
! End loop over cartesian directions
a2p(2,xyz) = a2p(2,xyz) + 1
b2m(2,xyz) = b2m(2,xyz) - 1
a1a2a3b1b2b3 = HRR3e(a2p,b2m,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1) &
+ CenterAB(2,xyz)* &
HRR3e(AngMomBra,b2m,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1)
!------------------------------------------------------------------------
! 3rd horizontal recurrence relation (2 terms): <a1a2a3|b1b2b3+>
!------------------------------------------------------------------------
else
do i=1,3
do j=1,3
a3p(i,j) = AngMomBra(i,j)
b3m(i,j) = AngMomKet(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomKet(3,1) > 0) then
xyz = 1
elseif(AngMomKet(3,2) > 0) then
xyz = 2
elseif(AngMomKet(3,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in HRR3e!'
endif
! End loop over cartesian directions
a3p(3,xyz) = a3p(3,xyz) + 1
b3m(3,xyz) = b3m(3,xyz) - 1
a1a2a3b1b2b3 = HRR3e(a3p,b3m,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1) &
+ CenterAB(3,xyz)* &
HRR3e(AngMomBra,b3m,maxm,Om,ExpZ,CenterAB,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
end function HRR3e

40
src/IntPak/HRRF12.f90 Normal file
View File

@ -0,0 +1,40 @@
recursive function HRRF12(AngMomA,AngMomB,AngMomC,AngMomD,fG,gP,gG,gQ,ExpPGQi, &
CenterPQSq,CenterRA,CenterRC,CenterAB,CenterCD) &
result(Gabcd)
! Compute two-electron integrals over Gaussian geminals
implicit none
! Input variables
integer,intent(in) :: AngMomA,AngMomB,AngMomC,AngMomD
double precision,intent(in) :: ExpPGQi
double precision,intent(in) :: fG,gP,gG,gQ
double precision,intent(in) :: CenterPQSq,CenterRA,CenterRC
double precision,intent(in) :: CenterAB,CenterCD
! Local variables
double precision :: VRRF12
double precision :: Gabcd
If(AngMomB < 0 .or. AngMomD < 0) then
Gabcd = 0d0
Else
If(AngMomB == 0 .and. AngMomD == 0) then
Gabcd = VRRF12(AngMomA,AngMomC,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC)
Else
If(AngMomD == 0) then
Gabcd = HRRF12(AngMomA+1,AngMomB-1,AngMomC,AngMomD,fG,gP,gG,gQ,ExpPGQi, &
CenterPQSq,CenterRA,CenterRC,CenterAB,CenterCD) &
+ CenterAB*HRRF12(AngMomA,AngMomB-1,AngMomC,AngMomD,fG,gP,gG,gQ, &
ExpPGQi,CenterPQSq,CenterRA,CenterRC,CenterAB,CenterCD)
Else
Gabcd = HRRF12(AngMomA,AngMomB,AngMomC+1,AngMomD-1,fG,gP,gG,gQ,ExpPGQi, &
CenterPQSq,CenterRA,CenterRC,CenterAB,CenterCD) &
+ CenterCD*HRRF12(AngMomA,AngMomB,AngMomC,AngMomD-1,fG,gP,gG,gQ, &
ExpPGQi,CenterPQSq,CenterRA,CenterRC,CenterAB,CenterCD)
EndIf
EndIf
EndIf
end function HRRF12

71
src/IntPak/HRRNuc.f90 Normal file
View File

@ -0,0 +1,71 @@
recursive function HRRNuc(AngMomA,AngMomB,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC) &
result(Gab)
! Horizontal recurrence relation for one-electron nuclear attraction integrals
implicit none
! Input variables
integer,intent(in) :: AngMomA(3),AngMomB(3)
integer,intent(in) :: maxm
double precision,intent(in) :: Om(0:maxm)
double precision,intent(in) :: ExpPi
double precision,intent(in) :: CenterAB(3),CenterPA(3),CenterPC(3)
! Local variables
logical :: NegAngMomB
integer :: TotAngMomA,TotAngMomB
integer :: xyz,ap(3),bm(3)
integer :: i
double precision :: VRRNuc
! Output variables
double precision :: Gab
NegAngMomB = AngMomB(1) < 0 .or. AngMomB(2) < 0 .or. AngMomB(3) < 0
TotAngMomA = AngMomA(1) + AngMomA(2) + AngMomA(3)
TotAngMomB = AngMomB(1) + AngMomB(2) + AngMomB(3)
!------------------------------------------------------------------------
! Termination condition
!------------------------------------------------------------------------
if(NegAngMomB) then
Gab = 0d0
else
!------------------------------------------------------------------------
! Vertical recurrence relations: (a|0)
!------------------------------------------------------------------------
if(TotAngMomB == 0) then
Gab = VRRNuc(0,AngMomA,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC)
else
!------------------------------------------------------------------------
! 1st horizontal recurrence relation (2 terms): (a|b+)
!------------------------------------------------------------------------
do i=1,3
ap(i) = AngMomA(i)
bm(i) = AngMomB(i)
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomB(1) > 0) then
xyz = 1
elseif(AngMomB(2) > 0) then
xyz = 2
elseif(AngMomB(3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in HRRNuc!'
endif
! End loop over cartesian directions
ap(xyz) = ap(xyz) + 1
bm(xyz) = bm(xyz) - 1
Gab = HRRNuc(ap,bm,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC) &
+ CenterAB(xyz)*HRRNuc(AngMomA,bm,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC)
endif
endif
end function HRRNuc

28
src/IntPak/HRROv.f90 Normal file
View File

@ -0,0 +1,28 @@
recursive function HRROv(AngMomA,AngMomB,ExpPi,CenterAB,CenterPA) &
result(Gab)
! Horizontal recurrence relations for one-electron overlap integrals
implicit none
! Input variables
integer,intent(in) :: AngMomA,AngMomB
double precision,intent(in) :: ExpPi
double precision,intent(in) :: CenterAB,CenterPA
! Local variables
double precision :: VRROv
double precision :: Gab
if(AngMomB < 0) then
Gab = 0d0
else
if(AngMomB == 0) then
Gab = VRROv(AngMomA,ExpPi,CenterPA)
else
Gab = HRROv(AngMomA+1,AngMomB-1,ExpPi,CenterAB,CenterPA) &
+ CenterAB*HRROv(AngMomA,AngMomB-1,ExpPi,CenterAB,CenterPA)
endif
endif
end function HRROv

555
src/IntPak/IntPak.f90 Normal file
View File

@ -0,0 +1,555 @@
program IntPak
implicit none
include 'parameters.h'
logical :: debug
logical :: doOv,doKin,doNuc,doERI,doF12,doYuk,doErf
logical :: do3eInt(n3eInt),do4eInt(n4eInt)
integer :: NAtoms,NBasis,iType
double precision :: ExpS
integer :: KG
double precision,allocatable :: DG(:),ExpG(:)
double precision,allocatable :: ZNuc(:),XYZAtoms(:,:)
integer :: nShell
integer,allocatable :: TotAngMomShell(:),KShell(:)
double precision,allocatable :: CenterShell(:,:),DShell(:,:),ExpShell(:,:)
double precision :: start_1eInt(n1eInt),end_1eInt(n1eInt),t_1eInt(n1eInt)
double precision :: start_2eInt(n2eInt),end_2eInt(n2eInt),t_2eInt(n2eInt)
double precision :: start_3eInt(n3eInt),end_3eInt(n3eInt),t_3eInt(n3eInt)
double precision :: start_4eInt(n4eInt),end_4eInt(n4eInt),t_4eInt(n4eInt)
integer :: np1eInt(n1eInt),nSigp1eInt(n1eInt),nc1eInt(n1eInt),nSigc1eInt(n1eInt)
integer :: np2eInt(n2eInt),nSigp2eInt(n2eInt),nc2eInt(n2eInt),nSigc2eInt(n2eInt)
integer :: np3eInt(n3eInt),nSigp3eInt(n3eInt),nc3eInt(n3eInt),nSigc3eInt(n3eInt)
integer :: np4eInt(n4eInt),nSigp4eInt(n4eInt),nc4eInt(n4eInt),nSigc4eInt(n4eInt)
double precision,allocatable :: S(:,:)
! Hello World
write(*,*)
write(*,*) '********************************'
write(*,*) '* IntPak *'
write(*,*) '* Integral Package for dummies *'
write(*,*) '********************************'
write(*,*)
! Debugger on?
debug = .false.
! debug = .true.
! Which integrals do you want?
doOv = .true.
doKin = .true.
doNuc = .true.
doERI = .true.
doF12 = .false.
doYuk = .false.
doErf = .false.
do3eInt(1) = .false.
do3eInt(2) = .false.
do3eInt(3) = .false.
do4eInt(1) = .false.
do4eInt(2) = .false.
do4eInt(3) = .false.
!------------------------------------------------------------------------
! Read input information
!------------------------------------------------------------------------
call ReadNAtoms(NAtoms)
allocate(ZNuc(1:NAtoms),XYZAtoms(1:NAtoms,1:3))
call ReadGeometry(NAtoms,ZNuc,XYZAtoms)
allocate(CenterShell(1:maxShell,1:3),TotAngMomShell(1:maxShell),KShell(1:maxShell), &
DShell(1:maxShell,1:maxK),ExpShell(1:maxShell,1:maxK))
call ReadBasis(NAtoms,XYZAtoms,nShell,CenterShell, &
TotAngMomShell,KShell,DShell,ExpShell)
call CalcNBasis(nShell,TotAngMomShell,NBasis)
call ReadGeminal(ExpS)
!------------------------------------------------------------------------
! Memory allocation
!------------------------------------------------------------------------
allocate(S(1:NBasis,1:NBasis))
!------------------------------------------------------------------------
! Compute one-electron overlap integrals
!------------------------------------------------------------------------
if(doOv) then
iType = 1
call cpu_time(start_1eInt(iType))
call ComputeOv(debug,NBasis,nShell, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np1eInt(iType),nSigp1eInt(iType),nc1eInt(iType),nSigc1eInt(iType),S)
call cpu_time(end_1eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive overlap integrals = ',np1eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive overlap integrals = ',nSigp1eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted overlap integrals = ',nc1eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted overlap integrals = ',nSigc1eInt(iType)
write(*,*)
t_1eInt(iType) = end_1eInt(iType) - start_1eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_1eInt(iType),' seconds'
write(*,*)
endif
!------------------------------------------------------------------------
! Compute one-electron kinetic integrals
!------------------------------------------------------------------------
if(doKin) then
iType = 2
call cpu_time(start_1eInt(iType))
call ComputeKin(debug,nShell, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np1eInt(iType),nSigp1eInt(iType),nc1eInt(iType),nSigc1eInt(iType))
call cpu_time(end_1eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive kinetic integrals = ',np1eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive kinetic integrals = ',nSigp1eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted kinetic integrals = ',nc1eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted kinetic integrals = ',nSigc1eInt(iType)
write(*,*)
t_1eInt(iType) = end_1eInt(iType) - start_1eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_1eInt(iType),' seconds'
write(*,*)
endif
!------------------------------------------------------------------------
! Compute one-electron nuclear attraction integrals
!------------------------------------------------------------------------
if(doNuc) then
iType = 3
call cpu_time(start_1eInt(iType))
call ComputeNuc(debug,nShell, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
NAtoms,ZNuc,XYZAtoms, &
np1eInt(iType),nSigp1eInt(iType),nc1eInt(iType),nSigc1eInt(iType))
call cpu_time(end_1eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive nuclear integrals = ',np1eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive nuclear integrals = ',nSigp1eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted nuclear integrals = ',nc1eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted nuclear integrals = ',nSigc1eInt(iType)
write(*,*)
t_1eInt(iType) = end_1eInt(iType) - start_1eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_1eInt(iType),' seconds'
write(*,*)
endif
!------------------------------------------------------------------------
! Compute ERIs
!------------------------------------------------------------------------
if(doERI) then
iType = 1
KG = 1
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 1d0 /)
ExpG = (/ 0d0 /)
call cpu_time(start_2eInt(iType))
call Compute2eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np2eInt(iType),nSigp2eInt(iType),nc2eInt(iType),nSigc2eInt(iType))
call cpu_time(end_2eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive ERIs = ',np2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive ERIs = ',nSigp2eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted ERIs = ',nc2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted ERIs = ',nSigc2eInt(iType)
write(*,*)
t_2eInt(iType) = end_2eInt(iType) - start_2eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_2eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute F12 two-electron integrals
!------------------------------------------------------------------------
if(doF12) then
iType = 2
KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
! KG = 10
! allocate(DG(1:KG),ExpG(1:KG))
! DG = (/ 220.983854141, 18.52358977132, 4.81060044582, 1.892812227999, &
! 0.920641976732, 0.505281134191, 0.295757471525, 0.1753021140139, &
! 0.0969611396173, 0.0386163391551 /)
! ExpG = (/ 5722.54799330, 191.0413784782, 27.4417708701, 6.39987966572, &
! 1.82203908762, 0.548835646170, 0.156252937904, 0.036440796942, &
! 0.0052344680925, 0.00017474733304 /)
! KG = 20
! allocate(DG(1:KG),ExpG(1:KG))
! DG = (/ 841.88478132, 70.590185207, 18.3616020768, 7.2608642093, &
!3.57483416444, 2.01376031082, 1.24216542801, 0.81754348620, &
!0.564546514023, 0.404228610699, 0.297458536575, 0.223321219537, &
!0.169933732064, 0.130190978230, 0.099652303426, 0.075428246546, &
!0.0555635614051, 0.0386791283055, 0.0237550435652, 0.0100062783874 /)
! ExpG = (/84135.654509, 2971.58727634, 474.716025959, 130.676724560, &
!47.3938388887, 20.2078651631, 9.5411021938, 4.8109546955, &
!2.52795733067, 1.35894103210, 0.73586710268, 0.39557629706, &
!0.20785895177, 0.104809693858, 0.049485682527, 0.021099788990, &
!0.007652472186, 0.0021065225215, 0.0003365204879, 0.00001188556749 /)
call cpu_time(start_2eInt(iType))
call Compute2eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np2eInt(iType),nSigp2eInt(iType),nc2eInt(iType),nSigc2eInt(iType))
call cpu_time(end_2eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive geminal integrals = ',np2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive geminal integrals = ',nSigp2eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted geminal integrals = ',nc2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted geminal integrals = ',nSigc2eInt(iType)
write(*,*)
t_2eInt(iType) = end_2eInt(iType) - start_2eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_2eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute Yukawa two-electron integrals
!------------------------------------------------------------------------
if(doYuk) then
iType = 3
KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_2eInt(iType))
call Compute2eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np2eInt(iType),nSigp2eInt(iType),nc2eInt(iType),nSigc2eInt(iType))
call cpu_time(end_2eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive Yukawa integrals = ',np2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive Yukawa integrals = ',nSigp2eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted Yukawa integrals = ',nc2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted Yukawa integrals = ',nSigc2eInt(iType)
write(*,*)
t_2eInt(iType) = end_2eInt(iType) - start_2eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_2eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute long-range Coulomb two-electron integrals
!------------------------------------------------------------------------
if(doErf) then
iType = 4
KG = 1
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 1d0 /)
ExpG = (/ 1d0 /)
ExpS = ExpS*ExpS
call cpu_time(start_2eInt(iType))
call Compute2eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np2eInt(iType),nSigp2eInt(iType),nc2eInt(iType),nSigc2eInt(iType))
call cpu_time(end_2eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive long-range Coulomb integrals = ',np2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive long-range Coulomb integrals = ',nSigp2eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted long-range Coulomb integrals = ',nc2eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted long-range Coulomb integrals = ',nSigc2eInt(iType)
write(*,*)
t_2eInt(iType) = end_2eInt(iType) - start_2eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_2eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute three-electron integrals: Type 1 => chain C12 S23
!------------------------------------------------------------------------
if(do3eInt(1)) then
iType = 1
KG = 1
! KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 1d0 /)
ExpG = (/ 1d0 /)
! DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
! ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_3eInt(iType))
call Compute3eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np3eInt(iType),nSigp3eInt(iType),nc3eInt(iType),nSigc3eInt(iType))
call cpu_time(end_3eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive f23/r12 integrals = ',np3eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive f23/r12 integrals = ',nSigp3eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted f23/r12 integrals = ',nc3eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted f23/r12 integrals = ',nSigc3eInt(iType)
write(*,*)
t_3eInt(iType) = end_3eInt(iType) - start_3eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_3eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute three-electron integrals: Type 2 => cyclic C12 S13 S23
!------------------------------------------------------------------------
if(do3eInt(2)) then
iType = 2
KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_3eInt(iType))
call Compute3eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np3eInt(iType),nSigp3eInt(iType),nc3eInt(iType),nSigc3eInt(iType))
call cpu_time(end_3eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive f13.f23/r12 integrals = ',np3eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive f13.f23/r12 integrals = ',nSigp3eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted f13.f23/r12 integrals = ',nc3eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted f13.f23/r12 integrals = ',nSigc3eInt(iType)
write(*,*)
t_3eInt(iType) = end_3eInt(iType) - start_3eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_3eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute three-electron integrals: Type 3 => chain S13 S23
!------------------------------------------------------------------------
if(do3eInt(3)) then
iType = 3
KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_3eInt(iType))
call Compute3eInt(debug,iType,nShell, &
ExpS,KG,DG,ExpG, &
CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
np3eInt(iType),nSigp3eInt(iType),nc3eInt(iType),nSigc3eInt(iType))
call cpu_time(end_3eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive f13.f23 integrals = ',np3eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive f13.f23 integrals = ',nSigp3eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted f13.f23 integrals = ',nc3eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted f13.f23 integrals = ',nSigc3eInt(iType)
write(*,*)
t_3eInt(iType) = end_3eInt(iType) - start_3eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_3eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute four-electron integrals: Type 1 => chain C12 S14 S23
!------------------------------------------------------------------------
if(do4eInt(1)) then
iType = 1
KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_4eInt(iType))
! call Compute4eInt(debug,iType,nShell,ExpS, &
! ExpS,KG,DG,ExpG, &
! CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
! np4eInt(iType),nSigp4eInt(iType),nc4eInt(iType),nSigc4eInt(iType))
call cpu_time(end_4eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive f14.f23/r12 integrals = ',np4eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive f14.f23/r12 integrals = ',nSigp4eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted f14.f23/r12 integrals = ',nc4eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted f14.f23/r12 integrals = ',nSigc4eInt(iType)
write(*,*)
t_4eInt(iType) = end_4eInt(iType) - start_4eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_4eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute four-electron integrals: Type 2 => trident C12 S13 S14
!------------------------------------------------------------------------
if(do4eInt(2)) then
iType = 2
KG = 6
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_4eInt(iType))
! call Compute4eInt(debug,iType,nShell,ExpS, &
! ExpS,KG,DG,ExpG, &
! CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
! np4eInt(iType),nSigp4eInt(iType),nc4eInt(iType),nSigc4eInt(iType))
call cpu_time(end_4eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive f13.f14/r12 integrals = ',np4eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive f13.f14/r12 integrals = ',nSigp4eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted f13.f14/r12 integrals = ',nc4eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted f13.f14/r12 integrals = ',nSigc4eInt(iType)
write(*,*)
t_4eInt(iType) = end_4eInt(iType) - start_4eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_4eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! Compute four-electron integrals: Type 3 => chain C12 S13 S34
!------------------------------------------------------------------------
if(do4eInt(3)) then
iType = 3
KG = 6
allocate(DG(1:KG),ExpG(1:KG))
DG = (/ 0.3144d0, 0.3037d0, 0.1681d0, 0.09811d0, 0.06024d0, 0.03726d0 /)
ExpG = (/ 0.2209d0, 1.004d0, 3.622d0, 12.16d0, 45.87d0, 254.4d0 /)
call cpu_time(start_4eInt(iType))
! call Compute4eInt(debug,iType,nShell, &
! ExpS,KG,DG,ExpG, &
! CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
! np4eInt(iType),nSigp4eInt(iType),nc4eInt(iType),nSigc4eInt(iType))
call cpu_time(end_4eInt(iType))
write(*,'(A65,1X,I9)') 'Total number of primitive f13.f34/r12 integrals = ',np4eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant primitive f13.f34/r12 integrals = ',nSigp4eInt(iType)
write(*,'(A65,1X,I9)') 'Total number of contracted f13.f34/r12 integrals = ',nc4eInt(iType)
write(*,'(A65,1X,I9)') 'Number of significant contracted f13.f34/r12 integrals = ',nSigc4eInt(iType)
write(*,*)
t_4eInt(iType) = end_4eInt(iType) - start_4eInt(iType)
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time = ',t_4eInt(iType),' seconds'
write(*,*)
deallocate(DG,ExpG)
endif
!------------------------------------------------------------------------
! End of IntPak
!------------------------------------------------------------------------
end program IntPak

76
src/IntPak/KinInt.f90 Normal file
View File

@ -0,0 +1,76 @@
subroutine KinInt(npKin,nSigpKin,ExpA,CenterA,AngMomA,ExpB,CenterB,AngMomB,pKin)
! Compute one-electron kinetic integrals
implicit none
! Input variables
double precision,intent(in) :: ExpA,ExpB
double precision,intent(in) :: CenterA(3),CenterB(3)
integer,intent(in) :: AngMomA(3),AngMomB(3)
! Local variables
double precision :: ExpAi,ExpBi
double precision :: ExpP,ExpPi
double precision :: CenterP(3),CenterAB(3),CenterPA(3)
double precision :: NormABSq
double precision :: GAB
double precision :: HRROv,RRKin
integer :: i
double precision :: pi
double precision :: start_RR,finish_RR,t_RR
double precision :: s(3),k(3)
! Output variables
integer,intent(inout) :: npKin,nSigpKin
double precision,intent(out) :: pKin
pi = 4d0*atan(1d0)
! Pre-computed shell quantities
ExpAi = 1d0/ExpA
ExpBi = 1d0/ExpB
! Pre-computed quantities for shell-pair AB
ExpP = ExpA + ExpB
ExpPi = 1d0/ExpP
NormABSq = 0d0
Do i=1,3
CenterP(i) = (ExpA*CenterA(i) + ExpB*CenterB(i))*ExpPi
CenterPA(i) = CenterP(i) - CenterA(i)
CenterAB(i) = CenterA(i) - CenterB(i)
NormABSq = NormABSq + CenterAB(i)**2
Enddo
GAB = (pi*ExpPi)**(1.5d0)*exp(-NormABSq/(ExpAi+ExpBi))
!------------------------------------------------------------------------
! Launch reccurence relations!
!------------------------------------------------------------------------
call cpu_time(start_RR)
! Loop over cartesian directions
Do i=1,3
s(i) = HRROv(AngMomA(i),AngMomB(i),ExpPi,CenterAB(i),CenterPA(i))
k(i) = RRKin(AngMomA(i),AngMomB(i),ExpA,ExpB,ExpPi,CenterAB(i),CenterPA(i))
Enddo
call cpu_time(finish_RR)
pKin = k(1)*s(2)*s(3) + s(1)*k(2)*s(3) + s(1)*s(2)*k(3)
pKin = GAB*pKin
t_RR = finish_RR - start_RR
! Print result
npKin = npKin + 1
if(abs(pKin) > 1d-15) then
nSigpKin = nSigpKin + 1
endif
end subroutine KinInt

29
src/IntPak/Makefile Normal file
View File

@ -0,0 +1,29 @@
IDIR =../../include
LDIR =../../lib
BDIR =../../bin
ODIR = obj
SDIR =.
FC = gfortran
FFLAGS = -Wall -O3 -I$(IDIR)
DFLAGS = -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant
LIBS = $(LDIR)/*.a $(LDIR)/slatec/src/static/libslatec.a
SRC = $(wildcard *.f90)
OBJ = $(patsubst %.f90,$(ODIR)/%.o,$(SRC))
$(ODIR)/%.o: %.f90
$(FC) -c -o $@ $< $(FFLAGS)
$(BDIR)/IntPak: $(OBJ)
$(FC) -o $@ $^ $(FFLAGS) $(LIBS)
debug: $(OBJ)
$(FC) -o $(BDIR)/$@ $^ $(FFLAGS) $(LIBS) $(DFLAGS)
clean:
rm -f $(ODIR)/*.o $(BDIR)/IntPak $(BDIR)/debug

29
src/IntPak/NormCoeff.f90 Normal file
View File

@ -0,0 +1,29 @@
function NormCoeff(alpha,a)
implicit none
! Input variables
double precision,intent(in) :: alpha
integer,intent(in) :: a(3)
! local variable
double precision :: pi,dfa(3),dfac
integer :: atot
! Output variable
double precision NormCoeff
pi = 4d0*atan(1d0)
atot = a(1) + a(2) + a(3)
dfa(1) = dfac(2*a(1))/(2d0**a(1)*dfac(a(1)))
dfa(2) = dfac(2*a(2))/(2d0**a(2)*dfac(a(2)))
dfa(3) = dfac(2*a(3))/(2d0**a(3)*dfac(a(3)))
NormCoeff = (2d0*alpha/pi)**(3d0/2d0)*(4d0*alpha)**atot
NormCoeff = NormCoeff/(dfa(1)*dfa(2)*dfa(3))
NormCoeff = sqrt(NormCoeff)
end function NormCoeff

114
src/IntPak/NucInt.f90 Normal file
View File

@ -0,0 +1,114 @@
subroutine NucInt(debug,npNuc,nSigpNuc, &
ExpA,CenterA,AngMomA, &
ExpB,CenterB,AngMomB, &
CenterC, &
pNuc)
! Compute recursively the primitive one-electron nuclear attraction integrals
implicit none
! Input variables
logical,intent(in) :: debug
double precision,intent(in) :: ExpA,ExpB
double precision,intent(in) :: CenterA(3),CenterB(3),CenterC(3)
integer,intent(in) :: AngMomA(3),AngMomB(3)
! Local variables
double precision :: ExpAi,ExpBi
integer :: TotAngMomA,TotAngMomB
double precision :: ExpP,ExpPi
double precision :: CenterP(3),CenterAB(3),CenterPA(3),CenterPC(3)
double precision :: NormABSq,NormPCSq
double precision :: G
double precision,allocatable :: Om(:)
double precision :: HRRNuc
double precision :: Gab
double precision :: pi
integer :: i,maxm
double precision :: start_Om,finish_Om,start_RR,finish_RR,t_Om,t_RR
! Output variables
integer,intent(inout) :: npNuc,nSigpNuc
double precision,intent(out) :: pNuc
pi = 4d0*atan(1d0)
! Pre-computed shell quantities
ExpAi = 1d0/ExpA
ExpBi = 1d0/ExpB
! Pre-computed quantities for shell-pair AB
ExpP = ExpA + ExpB
ExpPi = 1d0/ExpP
NormABSq = 0d0
NormPCSq = 0d0
do i=1,3
CenterP(i) = (ExpA*CenterA(i) + ExpB*CenterB(i))*ExpPi
CenterAB(i) = CenterA(i) - CenterB(i)
CenterPA(i) = CenterP(i) - CenterA(i)
CenterPC(i) = CenterP(i) - CenterC(i)
NormABSq = NormABSq + CenterAB(i)**2
NormPCSq = NormPCSq + CenterPC(i)**2
enddo
G = (pi*ExpPi)**(1.5d0)*exp(-NormABSq/(ExpAi+ExpBi))
! Total angular momemtum
TotAngMomA = AngMomA(1) + AngMomA(2) + AngMomA(3)
TotAngMomB = AngMomB(1) + AngMomB(2) + AngMomB(3)
maxm = TotAngMomA + TotAngMomB
! Pre-compute (0|V|0)^m
allocate(Om(0:maxm))
call cpu_time(start_Om)
call CalcOmNuc(maxm,ExpPi,NormPCSq,Om)
call cpu_time(finish_Om)
! Print (0|V|0)^m
if(debug) then
write(*,*) '(0|V|0)^m'
do i=0,maxm
write(*,*) i,Om(i)
enddo
write(*,*)
endif
!------------------------------------------------------------------------
! Launch reccurence relations!
!------------------------------------------------------------------------
call cpu_time(start_RR)
Gab = HRRNuc(AngMomA,AngMomB,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC)
call cpu_time(finish_RR)
! Timings
t_Om = finish_Om - start_Om
t_RR = finish_RR - start_RR
! Print result
pNuc = G*Gab
npNuc = npNuc + 1
if(abs(pNuc) > 1d-15) then
nSigpNuc = nSigpNuc + 1
! write(*,'(A10,1X,F16.10,1X,I6,1X,I6)') '[a|V|b] = ',pNuc
endif
! Deallocate arrays
deallocate(Om)
end subroutine NucInt

74
src/IntPak/OvInt.f90 Normal file
View File

@ -0,0 +1,74 @@
subroutine OvInt(npOv,nSigpOv,ExpA,CenterA,AngMomA,ExpB,CenterB,AngMomB,pOv)
! Compute one-electron overlap integrals
implicit none
! Input variables
double precision,intent(in) :: ExpA,ExpB
double precision,intent(in) :: CenterA(3),CenterB(3)
integer,intent(in) :: AngMomA(3),AngMomB(3)
! Local variables
double precision :: ExpAi,ExpBi
double precision :: ExpP,ExpPi
double precision :: CenterP(3),CenterAB(3),CenterPA(3)
double precision :: NormABSq
double precision :: G
double precision :: HRROv
integer :: i
double precision :: pi
double precision :: start_RR,finish_RR,t_RR
double precision :: Gab(3)
! Output variables
integer,intent(inout) :: npOv,nSigpOv
double precision,intent(out) :: pOv
pi = 4d0*atan(1d0)
! Pre-computed shell quantities
ExpAi = 1d0/ExpA
ExpBi = 1d0/ExpB
! Pre-computed quantities for shell-pair AB
ExpP = ExpA + ExpB
ExpPi = 1d0/ExpP
NormABSq = 0d0
Do i=1,3
CenterP(i) = (ExpA*CenterA(i) + ExpB*CenterB(i))*ExpPi
CenterPA(i) = CenterP(i) - CenterA(i)
CenterAB(i) = CenterA(i) - CenterB(i)
NormABSq = NormABSq + CenterAB(i)**2
Enddo
G = (pi*ExpPi)**(1.5d0)*exp(-NormABSq/(ExpAi+ExpBi))
!------------------------------------------------------------------------
! Launch reccurence relations!
!------------------------------------------------------------------------
call cpu_time(start_RR)
! Loop over cartesian directions
Do i=1,3
Gab(i) = HRROv(AngMomA(i),AngMomB(i),ExpPi,CenterAB(i),CenterPA(i))
Enddo
call cpu_time(finish_RR)
pOv = G*Gab(1)*Gab(2)*Gab(3)
t_RR = finish_RR - start_RR
! Print result
npOv = npOv + 1
if(abs(pOv) > 1d-15) then
nSigpOv = nSigpOv + 1
endif
end subroutine OvInt

29
src/IntPak/RRKin.f90 Normal file
View File

@ -0,0 +1,29 @@
function RRKin(AngMomA,AngMomB,ExpA,ExpB,ExpPi,CenterAB,CenterPA) &
result(Gab)
! Recurrence relation for one-electron kinetic integrals
implicit none
! Input variables
integer,intent(in) :: AngMomA,AngMomB
double precision,intent(in) :: ExpA,ExpB,ExpPi
double precision,intent(in) :: CenterAB,CenterPA
! Local variables
double precision :: HRROv
double precision :: a,b,s1,s2,s3,s4
double precision :: Gab
a = dble(AngMomA)
b = dble(AngMomB)
s1 = HRROv(AngMomA-1,AngMomB-1,ExpPi,CenterAB,CenterPA)
s2 = HRROv(AngMomA+1,AngMomB-1,ExpPi,CenterAB,CenterPA)
s3 = HRROv(AngMomA-1,AngMomB+1,ExpPi,CenterAB,CenterPA)
s4 = HRROv(AngMomA+1,AngMomB+1,ExpPi,CenterAB,CenterPA)
Gab = 0.5d0*a*b*s1 - ExpA*b*s2 - a*ExpB*s3 + 2d0*ExpA*ExpB*s4
end function RRKin

176
src/IntPak/ReadBasis.f90 Normal file
View File

@ -0,0 +1,176 @@
subroutine ReadBasis(NAtoms,XYZAtoms,nShell,CenterShell, &
TotAngMomShell,KShell,DShell,ExpShell)
! Read basis set information
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: NAtoms
double precision,intent(in) :: XYZAtoms(NAtoms,3)
! Local variables
integer :: nShAt,iAt
integer :: i,j,k
character :: shelltype
! Output variables
integer,intent(out) :: nShell
double precision,intent(out) :: CenterShell(maxShell,3)
integer,intent(out) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(out) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
!------------------------------------------------------------------------
! Primary basis set information
!------------------------------------------------------------------------
! Open file with basis set specification
open(unit=2,file='input/basis')
! Read basis information
write(*,'(A28)') 'Gaussian basis set'
write(*,'(A28)') '------------------'
nShell = 0
do i=1,NAtoms
read(2,*) iAt,nShAt
write(*,'(A28,1X,I16)') 'Atom n. ',iAt
write(*,'(A28,1X,I16)') 'number of shells ',nShAt
write(*,'(A28)') '------------------'
! Basis function centers
do j=1,nShAt
nShell = nShell + 1
do k=1,3
CenterShell(nShell,k) = XYZAtoms(iAt,k)
enddo
! Shell type and contraction degree
read(2,*) shelltype,KShell(nShell)
if(shelltype == "S") then
TotAngMomShell(nShell) = 0
write(*,'(A28,1X,I16)') 's-type shell with K = ',KShell(nShell)
elseif(shelltype == "P") then
TotAngMomShell(nShell) = 1
write(*,'(A28,1X,I16)') 'p-type shell with K = ',KShell(nShell)
elseif(shelltype == "D") then
TotAngMomShell(nShell) = 2
write(*,'(A28,1X,I16)') 'd-type shell with K = ',KShell(nShell)
elseif(shelltype == "F") then
TotAngMomShell(nShell) = 3
write(*,'(A28,1X,I16)') 'f-type shell with K = ',KShell(nShell)
elseif(shelltype == "G") then
TotAngMomShell(nShell) = 4
write(*,'(A28,1X,I16)') 'g-type shell with K = ',KShell(nShell)
elseif(shelltype == "H") then
TotAngMomShell(nShell) = 5
write(*,'(A28,1X,I16)') 'h-type shell with K = ',KShell(nShell)
elseif(shelltype == "I") then
TotAngMomShell(nShell) = 6
write(*,'(A28,1X,I16)') 'i-type shell with K = ',KShell(nShell)
endif
! Read exponents and contraction coefficients
write(*,'(A28,1X,A16,A16)') '','Exponents','Contraction'
do k=1,Kshell(nShell)
read(2,*) ExpShell(nShell,k),DShell(nShell,k)
write(*,'(A28,1X,F16.10,F16.10)') '',ExpShell(nShell,k),DShell(nShell,k)
enddo
enddo
write(*,'(A28)') '------------------'
enddo
! Total number of shells
write(*,'(A28,1X,I16)') 'Number of shells in OBS',nShell
write(*,'(A28)') '------------------'
write(*,*)
! Close file with basis set specification
close(unit=2)
!------------------------------------------------------------------------
! Auxiliary basis set information
!------------------------------------------------------------------------
! Open file with auxilairy basis specification
open(unit=3,file='input/auxbasis')
! Read basis information
write(*,'(A28)') 'Auxiliary basis set'
write(*,'(A28)') '-------------------'
do i=1,NAtoms
read(3,*) iAt,nShAt
write(*,'(A28,1X,I16)') 'Atom n. ',iAt
write(*,'(A28,1X,I16)') 'number of shells ',nShAt
write(*,'(A28)') '------------------'
! Basis function centers
do j=1,nShAt
nShell = nShell + 1
do k=1,3
CenterShell(nShell,k) = XYZAtoms(iAt,k)
enddo
! Shell type and contraction degree
read(3,*) shelltype,KShell(nShell)
if(shelltype == "S") then
TotAngMomShell(nShell) = 0
write(*,'(A28,1X,I16)') 's-type shell with K = ',KShell(nShell)
elseif(shelltype == "P") then
TotAngMomShell(nShell) = 1
write(*,'(A28,1X,I16)') 'p-type shell with K = ',KShell(nShell)
elseif(shelltype == "D") then
TotAngMomShell(nShell) = 2
write(*,'(A28,1X,I16)') 'd-type shell with K = ',KShell(nShell)
elseif(shelltype == "F") then
TotAngMomShell(nShell) = 3
write(*,'(A28,1X,I16)') 'f-type shell with K = ',KShell(nShell)
elseif(shelltype == "G") then
TotAngMomShell(nShell) = 4
write(*,'(A28,1X,I16)') 'g-type shell with K = ',KShell(nShell)
elseif(shelltype == "H") then
TotAngMomShell(nShell) = 5
write(*,'(A28,1X,I16)') 'h-type shell with K = ',KShell(nShell)
elseif(shelltype == "I") then
TotAngMomShell(nShell) = 6
write(*,'(A28,1X,I16)') 'i-type shell with K = ',KShell(nShell)
endif
! Read exponents and contraction coefficients
write(*,'(A28,1X,A16,A16)') '','Exponents','Contraction'
do k=1,Kshell(nShell)
read(3,*) ExpShell(nShell,k),DShell(nShell,k)
write(*,'(A28,1X,F16.10,F16.10)') '',ExpShell(nShell,k),DShell(nShell,k)
enddo
enddo
write(*,'(A28)') '------------------'
enddo
! Total number of shells
write(*,'(A28,1X,I16)') 'Number of shells in ABS',nShell
write(*,'(A28)') '------------------'
write(*,*)
! Close file with basis set specification
close(unit=3)
end subroutine ReadBasis

25
src/IntPak/ReadGeminal.f90 Normal file
View File

@ -0,0 +1,25 @@
subroutine ReadGeminal(ExpS)
! Read the geminal information
implicit none
! Input variables
double precision,intent(out) :: ExpS
! Open file with geometry specification
open(unit=4,file='input/geminal')
! Read exponent of Slater geminal
read(4,*) ExpS
write(*,'(A28)') '------------------'
write(*,'(A28,1X,F16.10)') 'Slater geminal exponent',ExpS
write(*,'(A28)') '------------------'
write(*,*)
! Close file with geminal information
close(unit=4)
end subroutine ReadGeminal

40
src/IntPak/ReadGeometry.f90 Normal file
View File

@ -0,0 +1,40 @@
subroutine ReadGeometry(NAtoms,ZNuc,XYZAtoms)
! Read molecular geometry
implicit none
! Input variables
integer,intent(in) :: NAtoms
double precision,intent(out) :: ZNuc(NAtoms),XYZAtoms(NAtoms,3)
! Local variables
integer :: i
! Open file with geometry specification
open(unit=1,file='input/molecule')
! Read number of atoms
read(1,*)
read(1,*)
read(1,*)
do i=1,NAtoms
read(1,*) ZNuc(i),XYZAtoms(i,1),XYZAtoms(i,2),XYZAtoms(i,3)
enddo
! Print geometry
write(*,'(A28)') 'Molecular geometry'
write(*,'(A28)') '------------------'
do i=1,NAtoms
write(*,'(A28,1X,I16)') 'Atom n. ',i
write(*,'(A28,1X,F16.10)') 'Z = ',ZNuc(i)
write(*,'(A28,1X,F16.10,F16.10,F16.10)') 'Atom coordinates:',XYZAtoms(i,1),XYZAtoms(i,2),XYZAtoms(i,3)
enddo
write(*,'(A28)') '------------------'
write(*,*)
! Close file with geometry specification
close(unit=1)
end subroutine ReadGeometry

20
src/IntPak/ReadNAtoms.f90 Normal file
View File

@ -0,0 +1,20 @@
subroutine ReadNAtoms(NAtoms)
! Read number of atoms
implicit none
! Input variables
integer,intent(out) :: NAtoms
! Open file with geometry specification
open(unit=1,file='input/molecule')
! Read number of atoms
read(1,*)
read(1,*) NAtoms
! Close file with geometry specification
close(unit=1)
end subroutine ReadNAtoms

70
src/IntPak/S2eInt.f90 Normal file
View File

@ -0,0 +1,70 @@
subroutine S2eInt(debug,iType,np2eInt,nSigp2eInt, &
ExpS,KG,DG,ExpG, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet, &
p2eInt)
! Perform contraction over the operator for two-electron integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: iType
double precision,intent(in) :: ExpS
integer,intent(in) :: KG
double precision,intent(in) :: DG(KG),ExpG(KG)
double precision,intent(in) :: ExpBra(2),ExpKet(2)
double precision,intent(in) :: CenterBra(2,3),CenterKet(2,3)
integer,intent(in) :: AngMomBra(2,3),AngMomKet(2,3)
! Local variables
double precision :: ExpSG
double precision :: G2eInt,GF12Int
integer :: k
! Output variables
integer,intent(out) :: np2eInt,nSigp2eInt
double precision :: p2eInt
p2eInt = 0d0
! Gaussian geminal
if(iType == 2) then
do k=1,KG
ExpSG = ExpG(k)*ExpS**2
p2eInt = p2eInt &
+ DG(k)*GF12Int(ExpSG, &
ExpBra(1),CenterBra(1,1:3),AngMomBra(1,1:3), &
ExpKet(1),CenterKet(1,1:3),AngMomKet(1,1:3), &
ExpBra(2),CenterBra(2,1:3),AngMomBra(2,1:3), &
ExpKet(2),CenterKet(2,1:3),AngMomKet(2,1:3))
enddo
else
do k=1,KG
ExpSG = ExpG(k)*ExpS**2
p2eInt = p2eInt &
+ DG(k)*G2eInt(debug,iType, &
ExpSG, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet)
enddo
endif
! Print result
np2eInt = np2eInt + 1
if(abs(p2eInt) > 1d-15) then
nSigp2eInt = nSigp2eInt + 1
if(.false.) write(*,'(A15,1X,F16.10)') '[a1a2|b1b2] = ',p2eInt
endif
end subroutine S2eInt

58
src/IntPak/S3eInt.f90 Normal file
View File

@ -0,0 +1,58 @@
subroutine S3eInt(debug,iType,np3eInt,nSigp3eInt, &
ExpS,KG,DG,ExpG, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet, &
p3eInt)
! Perform contraction over the operators for three-electron integrals
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: debug
integer,intent(in) :: iType
double precision,intent(in) :: ExpS
integer,intent(in) :: KG
double precision,intent(in) :: DG(KG),ExpG(KG)
double precision,intent(in) :: ExpBra(3),ExpKet(3)
double precision,intent(in) :: CenterBra(3,3),CenterKet(3,3)
integer,intent(in) :: AngMomBra(3,3),AngMomKet(3,3)
! Local variables
double precision :: ExpSG13,ExpSG23
double precision :: G3eInt
integer :: k,l
! Output variables
integer,intent(out) :: np3eInt,nSigp3eInt
double precision :: p3eInt
p3eInt = 0d0
do k=1,KG
do l=1,KG
ExpSG13 = ExpG(k)*ExpS**2
ExpSG23 = ExpG(l)*ExpS**2
p3eInt = p3eInt &
+ DG(k)*DG(l)*G3eInt(debug,iType, &
ExpSG13,ExpSG23, &
ExpBra,CenterBra,AngMomBra, &
ExpKet,CenterKet,AngMomKet)
enddo
enddo
! Print result
np3eInt = np3eInt + 1
if(abs(p3eInt) > 1d-15) then
nSigp3eInt = nSigp3eInt + 1
if(.false.) write(*,'(A15,1X,F16.10)') '[a1a2a3|b1b2b3] = ',p3eInt
endif
end subroutine S3eInt

130
src/IntPak/VRR2e.f90 Normal file
View File

@ -0,0 +1,130 @@
recursive function VRR2e(m,AngMomBra,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
result(a1a2)
! Compute two-electron integrals over Gaussian geminals
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: m
integer,intent(in) :: AngMomBra(2,3)
integer,intent(in) :: maxm
double precision,intent(in) :: Om(0:maxm),ExpZi(2),ExpY(2,2)
double precision,intent(in) :: CenterZA(2,3),CenterY(2,2,3)
! Local variables
logical :: NegAngMomBra(2)
integer :: TotAngMomBra(2)
integer :: a1m(2,3),a2m(2,3)
integer :: a1mm(2,3),a2mm(2,3)
integer :: a1m2m(2,3)
double precision :: fZ(2)
integer :: i,j,xyz
! Output variables
double precision :: a1a2
do i=1,2
NegAngMomBra(i) = AngMomBra(i,1) < 0 .or. AngMomBra(i,2) < 0 .or. AngMomBra(i,3) < 0
TotAngMomBra(i) = AngMomBra(i,1) + AngMomBra(i,2) + AngMomBra(i,3)
enddo
fZ(1) = ExpY(1,2)*ExpZi(1)
fZ(2) = ExpY(1,2)*ExpZi(2)
!------------------------------------------------------------------------
! Termination condition
!------------------------------------------------------------------------
! if(NegAngMomBra(1) .or. NegAngMomBra(2)) then
! a1a2 = 0d0
!------------------------------------------------------------------------
! Fundamental integral: (00|00)^m
!------------------------------------------------------------------------
! elseif(TotAngMomBra(1) == 0 .and. TotAngMomBra(2) == 0) then
if(TotAngMomBra(1) == 0 .and. TotAngMomBra(2) == 0) then
a1a2 = Om(m)
!------------------------------------------------------------------------
! 1st vertical recurrence relation (4 terms): (a+0|00)^m
!------------------------------------------------------------------------
elseif(TotAngMomBra(2) == 0) then
do i=1,2
do j=1,3
a1m(i,j) = AngMomBra(i,j)
a1mm(i,j) = AngMomBra(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomBra(1,1) > 0) then
xyz = 1
elseif(AngMomBra(1,2) > 0) then
xyz = 2
elseif(AngMomBra(1,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in VRR2e!'
endif
! End loop over cartesian directions
a1m(1,xyz) = a1m(1,xyz) - 1
a1mm(1,xyz) = a1mm(1,xyz) - 2
if(AngMomBra(1,xyz) <= 0) then
a1a2 = 0d0
elseif(AngMomBra(1,xyz) == 1) then
a1a2 = CenterZA(1,xyz)*VRR2e(m,a1m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
- fZ(1)*CenterY(1,2,xyz)*VRR2e(m+1,a1m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY)
else
a1a2 = CenterZA(1,xyz)*VRR2e(m,a1m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
- fZ(1)*CenterY(1,2,xyz)*VRR2e(m+1,a1m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
+ 0.5d0*dble(AngMomBra(1,xyz)-1)*ExpZi(1)*( &
VRR2e(m,a1mm,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
- fZ(1)*VRR2e(m+1,a1mm,maxm,Om,ExpZi,ExpY,CenterZA,CenterY))
endif
!------------------------------------------------------------------------
! 2nd vertical recurrence relation (5 terms): (a0|c+0)^m
!------------------------------------------------------------------------
else
do i=1,2
do j=1,3
a2m(i,j) = AngMomBra(i,j)
a2mm(i,j) = AngMomBra(i,j)
a1m2m(i,j) = AngMomBra(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomBra(2,1) > 0) then
xyz = 1
elseif(AngMomBra(2,2) > 0) then
xyz = 2
elseif(AngMomBra(2,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in VRR2e!'
endif
! End loop over cartesian directions
a2m(2,xyz) = a2m(2,xyz) - 1
a2mm(2,xyz) = a2mm(2,xyz) - 2
a1m2m(1,xyz) = a1m2m(1,xyz) - 1
a1m2m(2,xyz) = a1m2m(2,xyz) - 1
if(AngMomBra(2,xyz) <= 0) then
a1a2 = 0d0
elseif(AngMomBra(2,xyz) == 1) then
a1a2 = CenterZA(2,xyz)*VRR2e(m,a2m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
+ fZ(2)*CenterY(1,2,xyz)*VRR2e(m+1,a2m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY)
else
a1a2 = CenterZA(2,xyz)*VRR2e(m,a2m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
+ fZ(2)*CenterY(1,2,xyz)*VRR2e(m+1,a2m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
+ 0.5d0*dble(AngMomBra(2,xyz)-1)*ExpZi(2)*( &
VRR2e(m,a2mm,maxm,Om,ExpZi,ExpY,CenterZA,CenterY) &
- fZ(2)*VRR2e(m+1,a2mm,maxm,Om,ExpZi,ExpY,CenterZA,CenterY))
endif
if(AngMomBra(1,xyz) > 0) &
a1a2 = a1a2 &
+ 0.5d0*dble(AngMomBra(1,xyz))*fZ(2)*ExpZi(1)*VRR2e(m+1,a1m2m,maxm,Om,ExpZi,ExpY,CenterZA,CenterY)
endif
end function VRR2e

174
src/IntPak/VRR3e.f90 Normal file
View File

@ -0,0 +1,174 @@
recursive function VRR3e(m,AngMomBra,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
result(a1a2a3)
! Vertical recurrence relations for three-electron integrals
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: m
integer,intent(in) :: AngMomBra(3,3)
integer,intent(in) :: maxm
double precision,intent(in) :: Om(0:maxm),ExpZ(3),CenterZA(3,3)
double precision,intent(in) :: DY0(3),DY1(3),D2Y0(3,3),D2Y1(3,3)
! Local variables
logical :: NegAngMomBra(3)
integer :: TotAngMomBra(3)
integer :: a1m(3,3),a2m(3,3),a3m(3,3)
integer :: a1mm(3,3),a2mm(3,3),a3mm(3,3)
integer :: a1m2m(3,3),a1m3m(3,3),a2m3m(3,3)
integer :: i,j,xyz
! Output variables
double precision :: a1a2a3
do i=1,3
NegAngMomBra(i) = AngMomBra(i,1) < 0 .or. AngMomBra(i,2) < 0 .or. AngMomBra(i,3) < 0
TotAngMomBra(i) = AngMomBra(i,1) + AngMomBra(i,2) + AngMomBra(i,3)
enddo
!------------------------------------------------------------------------
! Termination condition
!------------------------------------------------------------------------
if(NegAngMomBra(1) .or. NegAngMomBra(2) .or. NegAngMomBra(3)) then
a1a2a3 = 0d0
!------------------------------------------------------------------------
! Fundamental integral: (000|000)^m
!------------------------------------------------------------------------
elseif(TotAngMomBra(1) == 0 .and. TotAngMomBra(2) == 0 .and. TotAngMomBra(3) == 0) then
a1a2a3 = Om(m)
!------------------------------------------------------------------------
! 1st vertical recurrence relation (4 terms): (a1+00|000)^m
!------------------------------------------------------------------------
elseif(TotAngMomBra(2) == 0 .and. TotAngMomBra(3) == 0) then
do i=1,3
do j=1,3
a1m(i,j) = AngMomBra(i,j)
a1mm(i,j) = AngMomBra(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomBra(1,1) > 0) then
xyz = 1
elseif(AngMomBra(1,2) > 0) then
xyz = 2
elseif(AngMomBra(1,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in VRR3e!'
endif
! End loop over cartesian directions
a1m(1,xyz) = a1m(1,xyz) - 1
a1mm(1,xyz) = a1mm(1,xyz) - 2
if(AngMomBra(1,xyz) == 0) then
a1a2a3 = 0d0
elseif(AngMomBra(1,xyz) == 1) then
a1a2a3 = (CenterZA(1,xyz) - DY0(1))*VRR3e(m, a1m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- (DY1(1) - DY0(1))*VRR3e(m+1,a1m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
else
a1a2a3 = (CenterZA(1,xyz) - DY0(1))*VRR3e(m, a1m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- (DY1(1) - DY0(1))*VRR3e(m+1,a1m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
+ dble(AngMomBra(1,xyz)-1)*(0.5d0/ExpZ(1) - D2Y0(1,1))*VRR3e(m, a1mm,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- dble(AngMomBra(1,xyz)-1)*(D2Y1(1,1) - D2Y0(1,1))*VRR3e(m+1,a1mm,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
!------------------------------------------------------------------------
! 2nd vertical recurrence relation (6 terms): (a1a2+0|000)^m
!------------------------------------------------------------------------
elseif(TotAngMomBra(3) == 0) then
do i=1,3
do j=1,3
a2m(i,j) = AngMomBra(i,j)
a2mm(i,j) = AngMomBra(i,j)
a1m2m(i,j) = AngMomBra(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomBra(2,1) > 0) then
xyz = 1
elseif(AngMomBra(2,2) > 0) then
xyz = 2
elseif(AngMomBra(2,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in VRR3e!'
endif
! End loop over cartesian directions
a2m(2,xyz) = a2m(2,xyz) - 1
a2mm(2,xyz) = a2mm(2,xyz) - 2
a1m2m(1,xyz) = a1m2m(1,xyz) - 1
a1m2m(2,xyz) = a1m2m(2,xyz) - 1
if(AngMomBra(2,xyz) == 0) then
a1a2a3 = 0d0
elseif(AngMomBra(2,xyz) == 1) then
a1a2a3 = (CenterZA(2,xyz) - DY0(2))*VRR3e(m, a2m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- (DY1(2) - DY0(2))*VRR3e(m+1,a2m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
else
a1a2a3 = (CenterZA(2,xyz) - DY0(2))*VRR3e(m, a2m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- (DY1(2) - DY0(2))*VRR3e(m+1,a2m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
+ dble(AngMomBra(2,xyz)-1)*(0.5d0/ExpZ(2) - D2Y0(2,2))*VRR3e(m, a2mm, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- dble(AngMomBra(2,xyz)-1)*(D2Y1(2,2) - D2Y0(2,2))*VRR3e(m+1,a2mm, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
if(AngMomBra(1,xyz) > 0) &
a1a2a3 = a1a2a3 &
+ dble(AngMomBra(1,xyz))*(-D2Y0(2,1))*VRR3e(m, a1m2m,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- dble(AngMomBra(1,xyz))*(D2Y1(2,1) - D2Y0(2,1))*VRR3e(m+1,a1m2m,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
!------------------------------------------------------------------------
! 3rd vertical recurrence relation (8 terms): (a1a2a3+|000)^m
!------------------------------------------------------------------------
else
do i=1,3
do j=1,3
a3m(i,j) = AngMomBra(i,j)
a3mm(i,j) = AngMomBra(i,j)
a1m3m(i,j) = AngMomBra(i,j)
a2m3m(i,j) = AngMomBra(i,j)
enddo
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomBra(3,1) > 0) then
xyz = 1
elseif(AngMomBra(3,2) > 0) then
xyz = 2
elseif(AngMomBra(3,3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in VRR3e!'
endif
! End loop over cartesian directions
a3m(3,xyz) = a3m(3,xyz) - 1
a3mm(3,xyz) = a3mm(3,xyz) - 2
a1m3m(1,xyz) = a1m3m(1,xyz) - 1
a1m3m(3,xyz) = a1m3m(3,xyz) - 1
a2m3m(2,xyz) = a2m3m(2,xyz) - 1
a2m3m(3,xyz) = a2m3m(3,xyz) - 1
if(AngMomBra(3,xyz) == 0) then
a1a2a3 = 0d0
elseif(AngMomBra(3,xyz) == 1) then
a1a2a3 = (CenterZA(3,xyz) - DY0(3))*VRR3e(m, a3m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- (DY1(3) - DY0(3))*VRR3e(m+1,a3m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
else
a1a2a3 = (CenterZA(3,xyz) - DY0(3))*VRR3e(m, a3m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- (DY1(3) - DY0(3))*VRR3e(m+1,a3m, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
+ dble(AngMomBra(3,xyz)-1)*(0.5d0/ExpZ(3) - D2Y0(3,3))*VRR3e(m, a3mm, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- dble(AngMomBra(3,xyz)-1)*(D2Y1(3,3) - D2Y0(3,3))*VRR3e(m+1,a3mm, maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
if(dble(AngMomBra(1,xyz)) > 0) &
a1a2a3 = a1a2a3 &
+ dble(AngMomBra(1,xyz))*(-D2Y0(3,1))*VRR3e(m, a1m3m,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- dble(AngMomBra(1,xyz))*(D2Y1(3,1) - D2Y0(3,1))*VRR3e(m+1,a1m3m,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
if(dble(AngMomBra(2,xyz)) > 0) &
a1a2a3 = a1a2a3 &
+ dble(AngMomBra(2,xyz))*(-D2Y0(3,2))*VRR3e(m, a2m3m,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1) &
- dble(AngMomBra(2,xyz))*(D2Y1(3,2) - D2Y0(3,2))*VRR3e(m+1,a2m3m,maxm,Om,ExpZ,CenterZA,DY0,DY1,D2Y0,D2Y1)
endif
end function VRR3e

36
src/IntPak/VRRF12.f90 Normal file
View File

@ -0,0 +1,36 @@
recursive function VRRF12(AngMomA,AngMomC,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC) &
result(Gac)
! Compute two-electron integrals over Gaussian geminals
implicit none
! Input variables
integer,intent(in) :: AngMomA,AngMomC
double precision,intent(in) :: ExpPGQi
double precision,intent(in) :: fG,gP,gG,gQ
double precision,intent(in) :: CenterPQSq,CenterRA,CenterRC
! Output variables
double precision :: Gac
if(AngMomA < 0 .or. AngMomC < 0) then
Gac = 0d0
else
if(AngMomA == 0 .and. AngMomC == 0) then
Gac = sqrt(fG)*exp(-CenterPQSq/ExpPGQi)
else
If(AngMomC == 0) then
Gac = CenterRA*VRRF12(AngMomA-1,AngMomC,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC) &
+ dble(AngMomA-1)*gP*VRRF12(AngMomA-2,AngMomC,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC)
else
Gac = CenterRC*VRRF12(AngMomA,AngMomC-1,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC) &
+ dble(AngMomA)*gG*VRRF12(AngMomA-1,AngMomC-1,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC) &
+ dble(AngMomC-1)*gQ*VRRF12(AngMomA,AngMomC-2,fG,gP,gG,gQ,ExpPGQi,CenterPQSq,CenterRA,CenterRC)
endIf
endIf
endIf
end function VRRF12

76
src/IntPak/VRRNuc.f90 Normal file
View File

@ -0,0 +1,76 @@
recursive function VRRNuc(m,AngMomA,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC) &
result(Ga)
! Compute two-electron integrals over Gaussian geminals
implicit none
! Input variables
integer,intent(in) :: m
integer,intent(in) :: AngMomA(3)
integer,intent(in) :: maxm
double precision,intent(in) :: Om(0:maxm)
double precision,intent(in) :: ExpPi
double precision,intent(in) :: CenterAB(3),CenterPA(3),CenterPC(3)
! Local variables
logical :: NegAngMomA
integer :: TotAngMomA
integer :: xyz,am(3),amm(3)
integer :: i
! Output variables
double precision :: Ga
NegAngMomA = AngMomA(1) < 0 .or. AngMomA(2) < 0 .or. AngMomA(3) < 0
TotAngMomA = AngMomA(1) + AngMomA(2) + AngMomA(3)
!------------------------------------------------------------------------
! Termination condition
!------------------------------------------------------------------------
if(NegAngMomA) then
Ga = 0d0
else
!------------------------------------------------------------------------
! Fundamental integral: (0|0)^m
!------------------------------------------------------------------------
if(TotAngMomA == 0) then
Ga = Om(m)
else
!------------------------------------------------------------------------
! Vertical recurrence relation (4 terms): (a+|0)^m
!------------------------------------------------------------------------
do i=1,3
am(i) = AngMomA(i)
amm(i) = AngMomA(i)
enddo
! Loop over cartesian directions
xyz = 0
if (AngMomA(1) > 0) then
xyz = 1
elseif(AngMomA(2) > 0) then
xyz = 2
elseif(AngMomA(3) > 0) then
xyz = 3
else
write(*,*) 'xyz = 0 in VRRNuc!'
endif
! End loop over cartesian directions
am(xyz) = am(xyz) - 1
amm(xyz) = amm(xyz) - 2
Ga = CenterPA(xyz)*VRRNuc(m,am,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC) &
+ 0.5d0*dble(am(xyz))*ExpPi*VRRNuc(m,amm,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC) &
- CenterPC(xyz)*ExpPi*VRRNuc(m+1,am,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC) &
- 0.5d0*dble(am(xyz))*ExpPi**2*VRRNuc(m+1,amm,maxm,Om,ExpPi,CenterAB,CenterPA,CenterPC)
endif
endif
end function VRRNuc

28
src/IntPak/VRROv.f90 Normal file
View File

@ -0,0 +1,28 @@
recursive function VRROv(AngMomA,ExpPi,CenterPA) &
result(Ga)
! Compute two-electron integrals over Gaussian geminals
implicit none
! Input variables
integer,intent(in) :: AngMomA
double precision,intent(in) :: ExpPi
double precision,intent(in) :: CenterPA
! Output variables
double precision :: Ga
if(AngMomA < 0) then
Ga = 0d0
else
if(AngMomA == 0) then
Ga = 1d0
else
Ga = CenterPA*VRROv(AngMomA-1,ExpPi,CenterPA) + 0.5d0*dble(AngMomA-1)*ExpPi*VRROv(AngMomA-2,ExpPi,CenterPA)
endif
endif
end function VRROv

BIN
src/IntPak/obj/CalcBoysF.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcNBasis.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcOm.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcOm3e.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcOmERI.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcOmErf.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcOmNuc.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/CalcOmYuk.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/Compute2eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/Compute3eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/Compute4eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ComputeKin.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ComputeNuc.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ComputeOv.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/FormVRR3e.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/G2eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/G3eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/GF12Int.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/GenerateShell.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/HRR2e.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/HRR3e.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/HRRF12.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/HRRNuc.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/HRROv.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/IntPak.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/KinInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/NormCoeff.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/NucInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/OvInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/RRKin.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ReadBasis.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ReadGeminal.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ReadGeometry.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/ReadNAtoms.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/S2eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/S3eInt.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/VRR2e.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/VRR3e.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/VRRF12.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/VRRNuc.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/VRROv.o Normal file
View File

Binary file not shown.

BIN
src/IntPak/obj/utils.o Normal file
View File

Binary file not shown.

385
src/IntPak/utils.f90 Normal file
View File

@ -0,0 +1,385 @@
!------------------------------------------------------------------------
function KroneckerDelta(i,j) result(delta)
! Kronecker Delta
implicit none
! Input variables
integer,intent(in) :: i,j
! Output variables
integer :: delta
if(i == j) then
delta = 1
else
delta = 0
endif
end function KroneckerDelta
!------------------------------------------------------------------------
subroutine matout(m,n,A)
! Print the MxN array A
implicit none
integer,parameter :: ncol = 5
double precision,parameter :: small = 1d-10
integer,intent(in) :: m,n
double precision,intent(in) :: A(m,n)
double precision :: B(ncol)
integer :: ilower,iupper,num,i,j
do ilower=1,n,ncol
iupper = min(ilower + ncol - 1,n)
num = iupper - ilower + 1
write(*,'(3X,10(7X,I6))') (j,j=ilower,iupper)
do i=1,m
do j=ilower,iupper
B(j-ilower+1) = A(i,j)
enddo
do j=1,num
if(abs(B(j)) < small) B(j) = 0d0
enddo
write(*,'(I7,10F15.8)') i,(B(j),j=1,num)
enddo
enddo
end subroutine matout
!------------------------------------------------------------------------
subroutine CalcTrAB(n,A,B,Tr)
! Calculate the trace of the square matrix A.B
implicit none
! Input variables
integer,intent(in) :: n
double precision,intent(in) :: A(n,n),B(n,n)
! Local variables
integer :: i,j
! Output variables
double precision,intent(out) :: Tr
Tr = 0d0
do i=1,n
do j=1,n
Tr = Tr + A(i,j)*B(j,i)
enddo
enddo
end subroutine CalcTrAB
!------------------------------------------------------------------------
function EpsilonSwitch(i,j) result(delta)
! Epsilon function
implicit none
! Input variables
integer,intent(in) :: i,j
integer :: delta
if(i <= j) then
delta = 1
else
delta = -1
endif
end function EpsilonSwitch
!------------------------------------------------------------------------
function KappaCross(i,j,k) result(kappa)
! kappa(i,j,k) = eps(i,j) delta(i,k) - eps(k,i) delta(i,j)
implicit none
! Input variables
integer,intent(in) :: i,j,k
! Local variables
integer :: EpsilonSwitch,KroneckerDelta
double precision :: kappa
kappa = dble(EpsilonSwitch(i,j)*KroneckerDelta(i,k) - EpsilonSwitch(k,i)*KroneckerDelta(i,j))
end function KappaCross
!------------------------------------------------------------------------
subroutine CalcInv3(a,det)
! Calculate the inverse and the determinant of a 3x3 matrix
implicit none
double precision,intent(inout) :: a(3,3)
double precision, intent(inout) :: det
double precision :: b(3,3)
integer :: i,j
det = a(1,1)*(a(2,2)*a(3,3)-a(2,3)*a(3,2)) &
- a(1,2)*(a(2,1)*a(3,3)-a(2,3)*a(3,1)) &
+ a(1,3)*(a(2,1)*a(3,2)-a(2,2)*a(3,1))
do i=1,3
b(i,1) = a(i,1)
b(i,2) = a(i,2)
b(i,3) = a(i,3)
enddo
a(1,1) = b(2,2)*b(3,3) - b(2,3)*b(3,2)
a(2,1) = b(2,3)*b(3,1) - b(2,1)*b(3,3)
a(3,1) = b(2,1)*b(3,2) - b(2,2)*b(3,1)
a(1,2) = b(1,3)*b(3,2) - b(1,2)*b(3,3)
a(2,2) = b(1,1)*b(3,3) - b(1,3)*b(3,1)
a(3,2) = b(1,2)*b(3,1) - b(1,1)*b(3,2)
a(1,3) = b(1,2)*b(2,3) - b(1,3)*b(2,2)
a(2,3) = b(1,3)*b(2,1) - b(1,1)*b(2,3)
a(3,3) = b(1,1)*b(2,2) - b(1,2)*b(2,1)
do i=1,3
do j=1,3
a(i,j) = a(i,j)/det
enddo
enddo
end subroutine CalcInv3
!------------------------------------------------------------------------
subroutine CalcInv4(a,det)
implicit none
double precision,intent(inout) :: a(4,4)
double precision,intent(inout) :: det
double precision :: b(4,4)
integer :: i,j
det = a(1,1)*(a(2,2)*(a(3,3)*a(4,4)-a(3,4)*a(4,3)) &
-a(2,3)*(a(3,2)*a(4,4)-a(3,4)*a(4,2)) &
+a(2,4)*(a(3,2)*a(4,3)-a(3,3)*a(4,2))) &
- a(1,2)*(a(2,1)*(a(3,3)*a(4,4)-a(3,4)*a(4,3)) &
-a(2,3)*(a(3,1)*a(4,4)-a(3,4)*a(4,1)) &
+a(2,4)*(a(3,1)*a(4,3)-a(3,3)*a(4,1))) &
+ a(1,3)*(a(2,1)*(a(3,2)*a(4,4)-a(3,4)*a(4,2)) &
-a(2,2)*(a(3,1)*a(4,4)-a(3,4)*a(4,1)) &
+a(2,4)*(a(3,1)*a(4,2)-a(3,2)*a(4,1))) &
- a(1,4)*(a(2,1)*(a(3,2)*a(4,3)-a(3,3)*a(4,2)) &
-a(2,2)*(a(3,1)*a(4,3)-a(3,3)*a(4,1)) &
+a(2,3)*(a(3,1)*a(4,2)-a(3,2)*a(4,1)))
do i=1,4
b(1,i) = a(1,i)
b(2,i) = a(2,i)
b(3,i) = a(3,i)
b(4,i) = a(4,i)
enddo
a(1,1) = b(2,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(2,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))
a(2,1) = -b(2,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))+b(2,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))-b(2,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))
a(3,1) = b(2,1)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))-b(2,2)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(2,4)*(b(3,1)*b(4,2)-b(3,2)*b(4,1))
a(4,1) = -b(2,1)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))+b(2,2)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))-b(2,3)*(b(3,1)*b(4,2)-b(3,2)*b(4,1))
a(1,2) = -b(1,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))+b(1,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))-b(1,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))
a(2,2) = b(1,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(1,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))+b(1,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))
a(3,2) = -b(1,1)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(1,2)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))-b(1,4)*(b(3,1)*b(4,2)-b(3,2)*b(4,1))
a(4,2) = b(1,1)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))-b(1,2)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))+b(1,3)*(b(3,1)*b(4,2)-b(3,2)*b(4,1))
a(1,3) = b(1,2)*(b(2,3)*b(4,4)-b(2,4)*b(4,3))-b(1,3)*(b(2,2)*b(4,4)-b(2,4)*b(4,2))+b(1,4)*(b(2,2)*b(4,3)-b(2,3)*b(4,2))
a(2,3) = -b(1,1)*(b(2,3)*b(4,4)-b(2,4)*b(4,3))+b(1,3)*(b(2,1)*b(4,4)-b(2,4)*b(4,1))-b(1,4)*(b(2,1)*b(4,3)-b(2,3)*b(4,1))
a(3,3) = b(1,1)*(b(2,2)*b(4,4)-b(2,4)*b(4,2))-b(1,2)*(b(2,1)*b(4,4)-b(2,4)*b(4,1))+b(1,4)*(b(2,1)*b(4,2)-b(2,2)*b(4,1))
a(4,3) = -b(1,1)*(b(2,2)*b(4,3)-b(2,3)*b(4,2))+b(1,2)*(b(2,1)*b(4,3)-b(2,3)*b(4,1))-b(1,3)*(b(2,1)*b(4,2)-b(2,2)*b(4,1))
a(1,4) = -b(1,2)*(b(2,3)*b(3,4)-b(2,4)*b(3,3))+b(1,3)*(b(2,2)*b(3,4)-b(2,4)*b(3,2))-b(1,4)*(b(2,2)*b(3,3)-b(2,3)*b(3,2))
a(2,4) = b(1,1)*(b(2,3)*b(3,4)-b(2,4)*b(3,3))-b(1,3)*(b(2,1)*b(3,4)-b(2,4)*b(3,1))+b(1,4)*(b(2,1)*b(3,3)-b(2,3)*b(3,1))
a(3,4) = -b(1,1)*(b(2,2)*b(3,4)-b(2,4)*b(3,2))+b(1,2)*(b(2,1)*b(3,4)-b(2,4)*b(3,1))-b(1,4)*(b(2,1)*b(3,2)-b(2,2)*b(3,1))
a(4,4) = b(1,1)*(b(2,2)*b(3,3)-b(2,3)*b(3,2))-b(1,2)*(b(2,1)*b(3,3)-b(2,3)*b(3,1))+b(1,3)*(b(2,1)*b(3,2)-b(2,2)*b(3,1))
do i=1,4
do j=1,4
a(i,j) = a(i,j)/det
enddo
enddo
end subroutine CalcInv4
!double precision function binom(i,j)
! implicit none
! integer,intent(in) :: i,j
! double precision :: logfact
! integer, save :: ifirst
! double precision, save :: memo(0:15,0:15)
! integer :: k,l
! if (ifirst == 0) then
! ifirst = 1
! do k=0,15
! do l=0,15
! memo(k,l) = dexp( logfact(k)-logfact(l)-logfact(k-l) )
! enddo
! enddo
! endif
! if ( (i<=15).and.(j<=15) ) then
! binom = memo(i,j)
! else
! binom = dexp( logfact(i)-logfact(j)-logfact(i-j) )
! endif
!end
!
!double precision function fact(n)
! implicit none
! integer :: n
! double precision, save :: memo(1:100)
! integer, save :: memomax = 1
!
! if (n<=memomax) then
! if (n<2) then
! fact = 1.d0
! else
! fact = memo(n)
! endif
! return
! endif
!
! integer :: i
! memo(1) = 1.d0
! do i=memomax+1,min(n,100)
! memo(i) = memo(i-1)*dble(i)
! enddo
! memomax = min(n,100)
! double precision :: logfact
! fact = dexp(logfact(n))
!end function
!
!double precision function logfact(n)
! implicit none
! integer :: n
! double precision, save :: memo(1:100)
! integer, save :: memomax = 1
!
! if (n<=memomax) then
! if (n<2) then
! logfact = 0.d0
! else
! logfact = memo(n)
! endif
! return
! endif
!
! integer :: i
! memo(1) = 0.d0
! do i=memomax+1,min(n,100)
! memo(i) = memo(i-1)+dlog(dble(i))
! enddo
! memomax = min(n,100)
! logfact = memo(memomax)
! do i=101,n
! logfact += dlog(dble(i))
! enddo
!end function
!
!double precision function dble_fact(n)
! implicit none
! integer :: n
! double precision :: dble_fact_even, dble_fact_odd
!
! dble_fact = 1.d0
!
! if(n.lt.0) return
!
! if(iand(n,1).eq.0)then
! dble_fact = dble_fact_even(n)
! else
! dble_fact= dble_fact_odd(n)
! endif
!
!end function
!
!double precision function dble_fact_even(n) result(fact2)
! implicit none
! integer :: n,k
! double precision, save :: memo(0:100)
! integer, save :: memomax = 0
! double precision :: prod
!
!
! if (n <= memomax) then
! if (n < 2) then
! fact2 = 1.d0
! else
! fact2 = memo(n)
! endif
! return
! endif
!
! integer :: i
! memo(0)=1.d0
! memo(1)=1.d0
! do i=memomax+2,min(n,100),2
! memo(i) = memo(i-2)* dble(i)
! enddo
! memomax = min(n,100)
! fact2 = memo(memomax)
!
! if (n > 100) then
! double precision :: dble_logfact
! fact2 = dexp(dble_logfact(n))
! endif
!
!end function
!
!double precision function dble_fact_odd(n) result(fact2)
! implicit none
! integer :: n
! double precision, save :: memo(1:100)
! integer, save :: memomax = 1
!
! if (n<=memomax) then
! if (n<3) then
! fact2 = 1.d0
! else
! fact2 = memo(n)
! endif
! return
! endif
!
! integer :: i
! memo(1) = 1.d0
! do i=memomax+2,min(n,99),2
! memo(i) = memo(i-2)* dble(i)
! enddo
! memomax = min(n,99)
! fact2 = memo(memomax)
!
! if (n > 99) then
! double precision :: dble_logfact
! fact2 = dexp(dble_logfact(n))
! endif
!
!end function

Some files were not shown because too many files have changed in this diff Show More