mirror of https://github.com/pfloos/quack
inital commit for quack
This commit is contained in:
parent
b484fce849
commit
86964672d7
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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)
|
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
|
@ -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
|
||||
|
|
@ -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 /)
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
1 0
|
||||
2 0
|
||||
3 0
|
|
@ -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
|
|
@ -0,0 +1 @@
|
|||
1.0
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
Binary file not shown.
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -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
Loading…
Reference in New Issue