diff --git a/bin/lowdin b/bin/lowdin
index 9976b19f..da82a9d3 100755
--- a/bin/lowdin
+++ b/bin/lowdin
@@ -177,32 +177,41 @@ if [ $extFile="lowdin" ]; then
'{
printf("\n&InputParticle\n\tInputParticle_name = \"%s\"\n\tInputParticle_basisSetName = \"%s\"\n",toupper($1),toupper($2))
for(i=1;i<=NF;i++){
- if($i=="addParticles"){
+ if(toupper($i)==toupper("addParticles")){
printf("\tInputParticle_addParticles = %s\n",toupper($(i+2)) )
}
- else if($i=="multiplicity"){
+ else if(toupper($i)==toupper("multiplicity")){
printf("\tInputParticle_multiplicity = %s\n",toupper($(i+2)) )
}
- else if($i=="fix"){
+ else if(toupper($i)==toupper("fix")){
printf("\tInputParticle_fixedCoordinates = %s\n",toupper($(i+2)) )
}
- else if($i=="fragmentNumber"){
+ else if(toupper($i)==toupper("fragmentNumber")){
printf("\tInputParticle_fragmentNumber = %s\n",toupper($(i+2)) )
}
- else if($i=="translationCenter"){
+ else if(toupper($i)==toupper("translationCenter")){
printf("\tInputParticle_translationCenter = %s\n",toupper($(i+2)) )
}
- else if($i=="rotationPoint"){
+ else if(toupper($i)==toupper("rotationPoint")){
printf("\tInputParticle_rotationPoint = %s\n",toupper($(i+2)) )
}
- else if($i=="rotateAround"){
+ else if(toupper($i)==toupper("rotateAround")){
printf("\tInputParticle_rotateAround = %s\n",toupper($(i+2)) )
}
- else if($i=="q"){
+ else if(toupper($i)==toupper("q")){
printf("\tInputParticle_charge = %s\n",toupper($(i+2)) )
}
- else if($i=="m"){
+ else if(toupper($i)==toupper("m")){
printf("\tInputParticle_mass = %s\n",toupper($(i+2)) )
+ }
+ else if(toupper($i)==toupper("eta")){
+ printf("\tInputParticle_eta = %s\n",toupper($(i+2)) )
+ }
+ else if(toupper($i)==toupper("omega")){
+ printf("\tInputParticle_omega = %s\n",toupper($(i+2)) )
+ }
+ else if(toupper($i)==toupper("qdoCenterOf")){
+ printf("\tInputParticle_qdoCenterOf = \"%s\"\n",toupper($(i+2)) )
};
};
printf("\tInputParticle_origin = %15.12E %15.12E %15.12E \n/\n",$3,$4,$5)
@@ -285,28 +294,67 @@ if [ $extFile="lowdin" ]; then
'{
printf("\n&Output\n")
for(i=1;i<=NF;i++){
- if($i=="species"){
+ if(toupper($i)==toupper("species")){
printf("\tOutput_species = %s\n",$toupper((i+2)) )
}
- else if($i=="orbital"){
- printf("\tOutput_orbital = %s\n",$toupper((i+2)) )
+ else if(toupper($i)==toupper("plane")){
+ printf("\tOutput_plane = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("axis")){
+ printf("\tOutput_axis = %s\n",$toupper((i+2)) )
}
- else if($i=="state"){
+ else if(toupper($i)==toupper("state")){
printf("\tOutput_state = %s\n",$toupper((i+2)) )
}
- else if($i=="dimensions"){
+ else if(toupper($i)==toupper("orbital")){
+ printf("\tOutput_orbital = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("dimensions")){
printf("\tOutput_dimensions = %s\n",$toupper((i+2)) )
}
- else if($i=="cubeSize"){
+ else if(toupper($i)==toupper("pointsPerDim")){
+ printf("\tOutput_pointsPerDim = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("scanStep")){
+ printf("\tOutput_scanStep = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("cubeSize")){
printf("\tOutput_cubeSize = %s\n",$toupper((i+2)) )
}
- else if($i=="point1"){
+ else if(toupper($i)==toupper("minValue")){
+ printf("\tOutput_minValue = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("maxValue")){
+ printf("\tOutput_maxValue = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("offsetX")){
+ printf("\tOutput_offsetX = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("offsetY")){
+ printf("\tOutput_offsetY = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("offsetZ")){
+ printf("\tOutput_offsetZ = %s\n",$toupper((i+2)) )
+ }
+ else if(toupper($i)==toupper("limitX")){
+ printf("\tOutput_limitX = %15.12E %15.12E \n",$(i+2),$(i+3))
+ }
+ else if(toupper($i)==toupper("limitY")){
+ printf("\tOutput_limitY = %15.12E %15.12E \n",$(i+2),$(i+3))
+ }
+ else if(toupper($i)==toupper("limitZ")){
+ printf("\tOutput_limitZ = %15.12E %15.12E \n",$(i+2),$(i+3))
+ }
+ else if(toupper($i)==toupper("center")){
+ printf("\tOutput_center = %15.12E %15.12E %15.12E \n",$(i+2),$(i+3),$(i+4))
+ }
+ else if(toupper($i)==toupper("point1")){
printf("\tOutput_point1 = %15.12E %15.12E %15.12E \n",$(i+2),$(i+3),$(i+4))
}
- else if($i=="point2"){
+ else if(toupper($i)==toupper("point2")){
printf("\tOutput_point2 = %15.12E %15.12E %15.12E \n",$(i+2),$(i+3),$(i+4))
}
- else if($i=="point3"){
+ else if(toupper($i)==toupper("point3")){
printf("\tOutput_point3 = %15.12E %15.12E %15.12E \n",$(i+2),$(i+3),$(i+4))
};
};
@@ -318,16 +366,16 @@ if [ $extFile="lowdin" ]; then
'{
printf("\n&InputCINamelist\n")
for(i=1;i<=NF;i++){
- if($i=="species"){
+ if(toupper($i)==toupper("species")){
printf("\tInputCI_species = %s\n",$toupper((i+2)) )
}
- else if($i=="core"){
+ else if(toupper($i)==toupper("core")){
printf("\tInputCI_core = %s\n",$toupper((i+2)) )
}
- else if($i=="active"){
+ else if(toupper($i)==toupper("active")){
printf("\tInputCI_active = %s\n",$toupper((i+2)) )
}
- else if($i=="excitation"){
+ else if(toupper($i)==toupper("excitation")){
printf("\tInputCI_excitation = %s\n",$toupper((i+2)) )
};
};
@@ -336,10 +384,10 @@ if [ $extFile="lowdin" ]; then
' | $SED "s/,/./g" >> $nameFile.aux
###########################################
- # Check custom basis sets in the input
+ # Check custom basis sets/potentials in the input
###########################################
- BASIS_NAMES=(`gawk '($1~/BASIS/){print toupper($2)}' $nameFile`)
+ BASIS_NAMES=(`gawk '($1~/^BASIS$/){print toupper($2)}' $nameFile`)
if [ ${#BASIS_NAMES[@]} -gt "0" ]
then
for BASIS_NAME in ${BASIS_NAMES[@]}
@@ -352,10 +400,27 @@ if [ $extFile="lowdin" ]; then
fi
gawk '($1~/BASIS/ && toupper($2)~/^'$BASIS_NAME'$/){flag=1; next}
($0~/END/){flag=0};
- (flag==1){print toupper($0)}' $nameFile > $LOWDIN_DATA/basis/$BASIS_NAME
+ (flag==1){print toupper($0)}' $nameFile > $BASIS_NAME.$PID
done
fi
+ POTENTIALS_NAMES=(`gawk '($1~/^POTENTIAL$/){print toupper($2)}' $nameFile`)
+ if [ ${#POTENTIALS_NAMES[@]} -gt "0" ]
+ then
+ for POTENTIALS_NAME in ${POTENTIALS_NAMES[@]}
+ do
+ if [ -e $LOWDIN_DATA/basis/$POTENTIALS_NAME ]
+ then
+ echo "## ERROR: ## The custom potential file already exists in " $LOWDIN_DATA/potentials/$POTENTIALS_NAME
+ echo "Modify the POTENTIALS block in your input and select a different name"
+ exit 1
+ fi
+ gawk '($1~/^POTENTIAL$/ && toupper($2)~/^'$POTENTIALS_NAME'$/){flag=1; next}
+ ($0~/END/){flag=0};
+ (flag==1){print toupper($0)}' $nameFile > $POTENTIALS_NAME.$PID
+ done
+ fi
+
###########################################
# Exec lowdin.x
@@ -376,6 +441,7 @@ if [ $extFile="lowdin" ]; then
cp $nameFile*.vec $LOWDIN_SCRATCH/$nameFile &> /dev/null
cp $nameFile*.plainvec $LOWDIN_SCRATCH/$nameFile &> /dev/null
+ cp $nameFile*.fchk $LOWDIN_SCRATCH/$nameFile &> /dev/null
cp $nameFile*.val $LOWDIN_SCRATCH/$nameFile &> /dev/null
cp $nameFile*.dens $LOWDIN_SCRATCH/$nameFile &> /dev/null
cp $nameFile*.sup $LOWDIN_SCRATCH/$nameFile &> /dev/null
@@ -387,12 +453,24 @@ if [ $extFile="lowdin" ]; then
mv $nameFile*.over $LOWDIN_SCRATCH/$nameFile &> /dev/null
mv $nameFile*.kin $LOWDIN_SCRATCH/$nameFile &> /dev/null
mv $nameFile*.coeff $LOWDIN_SCRATCH/$nameFile &> /dev/null
-
- if [ -e $nameFile.gms.bs ]
+ cp $nameFile*.gms.bs $LOWDIN_SCRATCH/$nameFile &> /dev/null
+
+ #PID to avoid basis/potentials duplicates in simultaneous calculations
+ if [ ${#BASIS_NAMES[@]} -gt "0" ]
then
- cp $nameFile.gms.bs $LOWDIN_SCRATCH/$nameFile
+ for BASIS_NAME in ${BASIS_NAMES[@]}
+ do
+ mv $BASIS_NAME.$PID $LOWDIN_SCRATCH/$nameFile/$BASIS_NAME &> /dev/null
+ done
fi
-
+ if [ ${#POTENTIALS_NAMES[@]} -gt "0" ]
+ then
+ for POTENTIALS_NAME in ${POTENTIALS_NAMES[@]}
+ do
+ mv $POTENTIALS_NAME.$PID $LOWDIN_SCRATCH/$nameFile/$POTENTIALS_NAME &> /dev/null
+ done
+ fi
+
# setting default number of cores for OpenMP
if [ -z "$OMP_NUM_THREADS" ]; then
@@ -462,6 +540,7 @@ if [ $extFile="lowdin" ]; then
mv $LOWDIN_SCRATCH/$nameFile/$nameFile*.47 $currentPath &> 2
mv $LOWDIN_SCRATCH/$nameFile/*.vec $currentPath &> 2
mv $LOWDIN_SCRATCH/$nameFile/*.plainvec $currentPath &> 2
+ mv $LOWDIN_SCRATCH/$nameFile/*.fchk $currentPath &> 2
# mv $LOWDIN_SCRATCH/$nameFile/*.val $currentPath &> 2
mv $LOWDIN_SCRATCH/$nameFile/*.NOCI.coords $currentPath &> 2
mv $LOWDIN_SCRATCH/$nameFile/*.NOCI.s* $currentPath &> 2
@@ -486,15 +565,6 @@ if [ $extFile="lowdin" ]; then
rm -rf $LOWDIN_SCRATCH/$nameFile
fi
- ### Clean custom basis files
- if [ ${#BASIS_NAMES[@]} -gt "0" ]
- then
- for BASIS_NAME in ${BASIS_NAMES[@]}
- do
- rm $LOWDIN_DATA/basis/$BASIS_NAME
- done
- fi
-
else
echo $1 ", this file does not exist. "
exit 1
diff --git a/lib/basis/AUG-CC-PVTZ b/lib/basis/AUG-CC-PVTZ
index d20392ca..c5b49971 100644
--- a/lib/basis/AUG-CC-PVTZ
+++ b/lib/basis/AUG-CC-PVTZ
@@ -65,7 +65,29 @@ O-HYDROGEN EA- (AUG-CC-PVTZ) BASIS TYPE: 1
9 2 1
0.24700000 1.00000000
-
+O-HYDROGEN EB- (AUG-CC-PVTZ) BASIS TYPE: 1
+#
+9
+1 0 3
+33.87000000 0.00606800
+5.09500000 0.04530800
+1.15900000 0.20282200
+2 0 1
+0.32580000 1.00000000
+3 0 1
+0.10270000 1.00000000
+4 0 1
+0.02526000 1.00000000
+5 1 1
+1.40700000 1.00000000
+6 1 1
+0.38800000 1.00000000
+7 1 1
+0.10200000 1.00000000
+8 2 1
+1.05700000 1.00000000
+9 2 1
+0.24700000 1.00000000
O-HELIUM HE (AUG-CC-PVTZ) BASIS TYPE: 1
#
diff --git a/lib/basis/H2O-1S1P1D b/lib/basis/H2O-1S1P1D
deleted file mode 100644
index cc7027ba..00000000
--- a/lib/basis/H2O-1S1P1D
+++ /dev/null
@@ -1,44 +0,0 @@
-O-HYDROGEN H_1 (1S) BASIS TYPE: 2
-3
-1 0 1
-14.509888498676842 1.0
-2 1 1
-6.885507269761004 1.0
-3 2 1
-9.023681376783887 1.0
-
-O-HYDROGEN H-A_1 (1S) BASIS TYPE: 2
-3
-1 0 1
-14.509888498676842 1.0
-2 1 1
-6.885507269761004 1.0
-3 2 1
-9.023681376783887 1.0
-
-O-HYDROGEN H-B_1 (1S) BASIS TYPE: 2
-3
-1 0 1
-14.509888498676842 1.0
-2 1 1
-6.885507269761004 1.0
-3 2 1
-9.023681376783887 1.0
-
-O-H-TIP X0.5+ (1S) BASIS TYPE: 2
-3
-1 0 1
-14.509888498676842 1.0
-2 1 1
-6.885507269761004 1.0
-3 2 1
-9.023681376783887 1.0
-
-O-H-TIP Y0.5+ (1S) BASIS TYPE: 2
-3
-1 0 1
-14.509888498676842 1.0
-2 1 1
-6.885507269761004 1.0
-3 2 1
-9.023681376783887 1.0
diff --git a/lib/basis/NAKAI-CC-PVDZ b/lib/basis/NAKAI-CC-PVDZ
new file mode 100644
index 00000000..cf7c2174
--- /dev/null
+++ b/lib/basis/NAKAI-CC-PVDZ
@@ -0,0 +1,14 @@
+O-HYDROGEN H (CC-PVDZ) BASIS TYPE: 1
+#
+5
+1 0 1
+13.01000000 1.0
+2 0 1
+1.96200000 1.0
+3 0 1
+0.44460000 1.0
+4 0 1
+0.12200000 1.00000000
+5 1 1
+0.72700000 1.00000000
+
diff --git a/lib/basis/PSX-DZ b/lib/basis/PSX-DZ
index 35b403de..0d5600b6 100644
--- a/lib/basis/PSX-DZ
+++ b/lib/basis/PSX-DZ
@@ -1,5 +1,53 @@
-O-POSITRON E+ (5S) BASIS TYPE: 3
-# (5S)-[5S]
+O-POSITRON E+ (5S3P2D) BASIS TYPE: 3
+# (5S3P2D)-[5S3P2D]
+10
+1 0 1
+.0189693659 1.0
+1 0 1
+.05186863351164733038 1.0
+1 0 1
+.14182630861506996771 1.0
+1 0 1
+.38780088183468771642 1.0
+1 0 1
+1.06037818667291718709 1.0
+1 1 1
+.0590955656 1.0
+1 1 1
+.16127967470846848928 1.0
+1 1 1
+.44015372744092004227 1.0
+1 2 1
+.11654481880000000000 1.0
+1 2 1
+.31287113568838127412 1.0
+
+O-POSITRON E+A (5S3P2D) BASIS TYPE: 3
+# (5S3P2D)-[5S3P2D]
+10
+1 0 1
+.0189693659 1.0
+1 0 1
+.05186863351164733038 1.0
+1 0 1
+.14182630861506996771 1.0
+1 0 1
+.38780088183468771642 1.0
+1 0 1
+1.06037818667291718709 1.0
+1 1 1
+.0590955656 1.0
+1 1 1
+.16127967470846848928 1.0
+1 1 1
+.44015372744092004227 1.0
+1 2 1
+.11654481880000000000 1.0
+1 2 1
+.31287113568838127412 1.0
+
+O-POSITRON E+B (5S3P2D) BASIS TYPE: 3
+# (5S3P2D)-[5S3P2D]
10
1 0 1
.0189693659 1.0
diff --git a/lib/basis/SHARON-E+6S2P b/lib/basis/SHARON-E+6S2P
index bb97e337..cba1a34f 100755
--- a/lib/basis/SHARON-E+6S2P
+++ b/lib/basis/SHARON-E+6S2P
@@ -17,3 +17,43 @@ O-POSITRON E+ (sharon) BASIS TYPE: 2
0.27492 1.0
8 1 1
0.084534 1.0
+
+O-POSITRON E+A (sharon) BASIS TYPE: 2
+#
+8
+1 0 1
+4.9231 1.0
+2 0 1
+0.92126 1.0
+3 0 1
+0.32058 1.0
+4 0 1
+0.14169 1.0
+5 0 1
+0.061803 1.0
+6 0 1
+0.0267577 1.0
+7 1 1
+0.27492 1.0
+8 1 1
+0.084534 1.0
+
+O-POSITRON E+B (sharon) BASIS TYPE: 2
+#
+8
+1 0 1
+4.9231 1.0
+2 0 1
+0.92126 1.0
+3 0 1
+0.32058 1.0
+4 0 1
+0.14169 1.0
+5 0 1
+0.061803 1.0
+6 0 1
+0.0267577 1.0
+7 1 1
+0.27492 1.0
+8 1 1
+0.084534 1.0
diff --git a/lib/basis/T-AUG-CC-PVDZ b/lib/basis/T-AUG-CC-PVDZ
new file mode 100644
index 00000000..f7044d5b
--- /dev/null
+++ b/lib/basis/T-AUG-CC-PVDZ
@@ -0,0 +1,47 @@
+O-HELIUM HE (T-AUG-CC-PVDZ) BASIS TYPE: 1
+#
+9
+1 0 3
+38.36000000 0.02380900
+5.77000000 0.15489100
+1.24000000 0.46998700
+2 0 1
+0.29760000 1.00000000
+3 0 1
+0.07255000 1.00000000
+4 0 1
+0.01770000 1.00000000
+5 0 1
+0.00431826 1.00000000
+6 1 1
+1.27500000 1.00000000
+7 1 1
+0.24730000 1.00000000
+8 1 1
+0.04800000 1.00000000
+9 1 1
+0.00931662 1.00000000
+
+O-HELIUM E+ (T-AUG-CC-PVDZ) BASIS TYPE: 1
+#
+9
+1 0 3
+38.36000000 0.02380900
+5.77000000 0.15489100
+1.24000000 0.46998700
+2 0 1
+0.29760000 1.00000000
+3 0 1
+0.07255000 1.00000000
+4 0 1
+0.01770000 1.00000000
+5 0 1
+0.00431826 1.00000000
+6 1 1
+1.27500000 1.00000000
+7 1 1
+0.24730000 1.00000000
+8 1 1
+0.04800000 1.00000000
+9 1 1
+0.00931662 1.00000000
diff --git a/lib/basis/T-AUG-CC-PVQZ b/lib/basis/T-AUG-CC-PVQZ
index 175e0d9e..3f129b37 100644
--- a/lib/basis/T-AUG-CC-PVQZ
+++ b/lib/basis/T-AUG-CC-PVQZ
@@ -123,4 +123,55 @@ O-POSITRON E+ (D-AUG-CC-PVQZ) BASIS TYPE: 1
22 3 1
0.02392177 1.0000000
+O-HELIUM HE (D-AUG-CC-PVQZ) BASIS TYPE: 1
+#
+22
+1 0 4
+528.50000000 0.00094000
+79.31000000 0.00721400
+18.05000000 0.03597500
+5.08500000 0.12778200
+2 0 1
+1.60900000 1.00000000
+3 0 1
+0.53630000 1.00000000
+4 0 1
+0.18330000 1.00000000
+5 0 1
+0.04819000 1.00000000
+6 0 1
+0.01270000 1.00000000
+7 0 1
+0.00334696 1.00000000
+8 1 1
+5.99400000 1.00000000
+9 1 1
+1.74500000 1.00000000
+10 1 1
+0.56000000 1.00000000
+11 1 1
+0.16260000 1.00000000
+12 1 1
+0.04720000 1.00000000
+13 1 1
+0.01370135 1.00000000
+14 2 1
+4.29900000 1.00000000
+15 2 1
+1.22300000 1.00000000
+16 2 1
+0.35100000 1.00000000
+17 2 1
+0.10100000 1.00000000
+18 2 1
+0.02906268 1.00000000
+19 3 1
+2.68000000 1.00000000
+20 3 1
+0.69060000 1.00000000
+21 3 1
+0.17800000 1.00000000
+22 3 1
+0.04587895 1.00000000
+
diff --git a/lib/basis/T-AUG-CC-PVTZ b/lib/basis/T-AUG-CC-PVTZ
index 6cab94ae..a0d29169 100644
--- a/lib/basis/T-AUG-CC-PVTZ
+++ b/lib/basis/T-AUG-CC-PVTZ
@@ -93,3 +93,40 @@ O-POSITRON E+ (D-AUG-CC-PVTZ) BASIS TYPE: 1
0.00704156 1.00000000
15 2 1
0.01347890 1.00000000
+
+O-HELIUM HE (D-AUG-CC-PVTZ) BASIS TYPE: 1
+#
+15
+1 0 4
+234.00000000 0.00258700
+35.16000000 0.01953300
+7.98900000 0.09099800
+2.21200000 0.27205000
+2 0 1
+0.66690000 1.00000000
+3 0 1
+0.20890000 1.00000000
+4 0 1
+0.05138000 1.00000000
+5 0 1
+0.01260000 1.00000000
+6 0 1
+0.00308992 1.00000000
+7 1 1
+3.04400000 1.00000000
+8 1 1
+0.75800000 1.00000000
+9 1 1
+0.19930000 1.00000000
+10 1 1
+0.05240000 1.00000000
+11 1 1
+0.01377702 1.00000000
+12 2 1
+1.96500000 1.00000000
+13 2 1
+0.45920000 1.00000000
+14 2 1
+0.10700000 1.00000000
+15 2 1
+0.02493250 1.00000000
diff --git a/lib/dataBases/constantsOfCoupling.lib b/lib/dataBases/constantsOfCoupling.lib
index bda5b291..1f940075 100644
--- a/lib/dataBases/constantsOfCoupling.lib
+++ b/lib/dataBases/constantsOfCoupling.lib
@@ -4525,19 +4525,3 @@
LAMBDA = 2.0
PARTICLESFRACTION = 0.5
/
-&SPECIE
- NAME = "HA-TIP"
- SYMBOL = "X0.5+"
- KAPPA = -1.0
- ETA = 1.0
- LAMBDA = 1.0
- PARTICLESFRACTION = 1
-/
-&SPECIE
- NAME = "HB-TIP"
- SYMBOL = "Y0.5+"
- KAPPA = -1.0
- ETA = 1.0
- LAMBDA = 1.0
- PARTICLESFRACTION = 1
-/
diff --git a/lib/dataBases/elementalParticles.lib b/lib/dataBases/elementalParticles.lib
index d6630a9b..54376343 100644
--- a/lib/dataBases/elementalParticles.lib
+++ b/lib/dataBases/elementalParticles.lib
@@ -171,7 +171,7 @@
SYMBOL = "HEA3"
CATEGORY = "LEPTON"
CHARGE = 1
- MASS = 5494.892576965
+ MASS = 5495.8851
SPIN = 0.5
/
&PARTICLE
@@ -179,7 +179,7 @@
SYMBOL = "HEB3"
CATEGORY = "LEPTON"
CHARGE = 1
- MASS = 5494.892576965
+ MASS = 5495.8851
SPIN = 0.5
/
&PARTICLE
@@ -187,7 +187,7 @@
SYMBOL = "HES3"
CATEGORY = "LEPTON"
CHARGE = 1
- MASS = 5494.892576965
+ MASS = 5495.8851
SPIN = 0.5
/
&PARTICLE
@@ -195,7 +195,7 @@
SYMBOL = "HEA4"
CATEGORY = "LEPTON"
CHARGE = 1
- MASS = 7292.327967297
+ MASS = 7294.2994
SPIN = 0.5
/
&PARTICLE
@@ -203,7 +203,7 @@
SYMBOL = "HEB4"
CATEGORY = "LEPTON"
CHARGE = 1
- MASS = 7292.327967297
+ MASS = 7294.2994
SPIN = 0.5
/
&PARTICLE
@@ -211,31 +211,7 @@
SYMBOL = "HES4"
CATEGORY = "LEPTON"
CHARGE = 1
- MASS = 7292.327967297
- SPIN = 0.5
-/
-&PARTICLE
- NAME = "HA-TIP"
- SYMBOL = "X0.5+"
- CATEGORY = "LEPTON"
- CHARGE = 0.5564
- MASS = 1836.15267247
- SPIN = 0.5
-/
-&PARTICLE
- NAME = "HB-TIP"
- SYMBOL = "Y0.5+"
- CATEGORY = "LEPTON"
- CHARGE = 0.5564
- MASS = 1836.15267247
- SPIN = -0.5
-/
-&PARTICLE
- NAME = "M-TIP"
- SYMBOL = "X1.1-"
- CATEGORY = "LEPTON"
- CHARGE = -1.1128
- MASS = 1836.15267247
+ MASS = 7294.2994
SPIN = 0.5
/
&PARTICLE
diff --git a/lib/potentials/VHH-CCSDT b/lib/potentials/VHH-CCSDT
deleted file mode 100644
index 138f0597..00000000
--- a/lib/potentials/VHH-CCSDT
+++ /dev/null
@@ -1,567 +0,0 @@
-#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
-O-H_1H_1
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
-
-O-H-A_1H-A_1
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
-
-O-H-A_1H-B_1
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
-
-O-H-B_1H-B_1
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
-
-O-X0.5+X0.5+
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
-
-O-X0.5+Y0.5+
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
-
-O-Y0.5+Y0.5+
-26
-1 0
-10.000000000 1.313644267
-0.0 0.0 0.0
-2 0
-7.498942093 3.312208762
-0.0 0.0 0.0
-3 0
-5.623413252 -4.290599715
-0.0 0.0 0.0
-4 0
-4.216965034 -2.400490962
-0.0 0.0 0.0
-5 0
-3.162277660 6.160643793
-0.0 0.0 0.0
-6 0
-2.371373706 2.406172066
-0.0 0.0 0.0
-7 0
-1.778279410 -6.852617537
-0.0 0.0 0.0
-8 0
-1.333521432 -1.043562213
-0.0 0.0 0.0
-9 0
-1.000000000 7.556790649
-0.0 0.0 0.0
-10 0
-0.749894209 0.777037995
-0.0 0.0 0.0
-11 0
-0.562341325 -8.976316536
-0.0 0.0 0.0
-12 0
-0.421696503 0.575296040
-0.0 0.0 0.0
-13 0
-0.316227766 8.672468936
-0.0 0.0 0.0
-14 0
-0.237137371 -0.855388714
-0.0 0.0 0.0
-15 0
-0.177827941 -6.271012179
-0.0 0.0 0.0
-16 0
-0.133352143 1.152328020
-0.0 0.0 0.0
-17 0
-0.100000000 3.403807143
-0.0 0.0 0.0
-18 0
-0.074989421 -1.745300340
-0.0 0.0 0.0
-19 0
-0.056234133 -1.349326021
-0.0 0.0 0.0
-20 0
-0.042169650 1.605561812
-0.0 0.0 0.0
-21 0
-0.031622777 -0.267553445
-0.0 0.0 0.0
-22 0
-0.023713737 0.034566428
-0.0 0.0 0.0
-23 0
-0.017782794 -0.185356609
-0.0 0.0 0.0
-24 0
-0.013335214 -0.103128899
-0.0 0.0 0.0
-25 0
-0.010000000 0.128087663
-0.0 0.0 0.0
-26 0
-0.000000000 0.085213897
-0.0 0.0 0.0
diff --git a/lib/potentials/VOH-CCSDT b/lib/potentials/VOH-CCSDT
deleted file mode 100644
index d3b76b4d..00000000
--- a/lib/potentials/VOH-CCSDT
+++ /dev/null
@@ -1,420 +0,0 @@
-#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
-O-H-A_1
-27
-1 0
-13.892336977 9.839539381
-0.0 0.0 0.0
-2 0
-10.000000000 15.916259785
-0.0 0.0 0.0
-3 0
-7.498942093 -18.199008237
-0.0 0.0 0.0
-4 0
-5.623413252 6.723316202
-0.0 0.0 0.0
-5 0
-4.216965034 4.671467422
-0.0 0.0 0.0
-6 0
-3.162277660 1.703771884
-0.0 0.0 0.0
-7 0
-2.371373706 0.297676262
-0.0 0.0 0.0
-8 0
-1.778279410 0.967600283
-0.0 0.0 0.0
-9 0
-1.333521432 1.034932150
-0.0 0.0 0.0
-10 0
-1.000000000 0.657621305
-0.0 0.0 0.0
-11 0
-0.749894209 -0.327381267
-0.0 0.0 0.0
-12 0
-0.562341325 0.221528399
-0.0 0.0 0.0
-13 0
-0.421696503 -0.255694044
-0.0 0.0 0.0
-14 0
-0.316227766 0.097853405
-0.0 0.0 0.0
-15 0
-0.237137371 0.744489008
-0.0 0.0 0.0
-16 0
-0.177827941 -0.750090202
-0.0 0.0 0.0
-17 0
-0.133352143 -0.309090719
-0.0 0.0 0.0
-18 0
-0.100000000 -0.998800172
-0.0 0.0 0.0
-19 0
-0.074989421 0.718795407
-0.0 0.0 0.0
-20 0
-0.056234133 0.228002288
-0.0 0.0 0.0
-21 0
-0.042169650 0.573744431
-0.0 0.0 0.0
-22 0
-0.031622777 -0.056969092
-0.0 0.0 0.0
-23 0
-0.023713737 -0.392241803
-0.0 0.0 0.0
-24 0
-0.017782794 -0.569609681
-0.0 0.0 0.0
-25 0
-0.013335214 0.759323484
-0.0 0.0 0.0
-26 0
-0.010000000 -0.194525832
-0.0 0.0 0.0
-27 0
-0.000000000 0.138912412
-0.0 0.0 0.0
-
-O-H-B_1
-27
-1 0
-13.892336977 9.839539381
-0.0 0.0 0.0
-2 0
-10.000000000 15.916259785
-0.0 0.0 0.0
-3 0
-7.498942093 -18.199008237
-0.0 0.0 0.0
-4 0
-5.623413252 6.723316202
-0.0 0.0 0.0
-5 0
-4.216965034 4.671467422
-0.0 0.0 0.0
-6 0
-3.162277660 1.703771884
-0.0 0.0 0.0
-7 0
-2.371373706 0.297676262
-0.0 0.0 0.0
-8 0
-1.778279410 0.967600283
-0.0 0.0 0.0
-9 0
-1.333521432 1.034932150
-0.0 0.0 0.0
-10 0
-1.000000000 0.657621305
-0.0 0.0 0.0
-11 0
-0.749894209 -0.327381267
-0.0 0.0 0.0
-12 0
-0.562341325 0.221528399
-0.0 0.0 0.0
-13 0
-0.421696503 -0.255694044
-0.0 0.0 0.0
-14 0
-0.316227766 0.097853405
-0.0 0.0 0.0
-15 0
-0.237137371 0.744489008
-0.0 0.0 0.0
-16 0
-0.177827941 -0.750090202
-0.0 0.0 0.0
-17 0
-0.133352143 -0.309090719
-0.0 0.0 0.0
-18 0
-0.100000000 -0.998800172
-0.0 0.0 0.0
-19 0
-0.074989421 0.718795407
-0.0 0.0 0.0
-20 0
-0.056234133 0.228002288
-0.0 0.0 0.0
-21 0
-0.042169650 0.573744431
-0.0 0.0 0.0
-22 0
-0.031622777 -0.056969092
-0.0 0.0 0.0
-23 0
-0.023713737 -0.392241803
-0.0 0.0 0.0
-24 0
-0.017782794 -0.569609681
-0.0 0.0 0.0
-25 0
-0.013335214 0.759323484
-0.0 0.0 0.0
-26 0
-0.010000000 -0.194525832
-0.0 0.0 0.0
-27 0
-0.000000000 0.138912412
-0.0 0.0 0.0
-
-O-H_1
-27
-1 0
-13.892336977 9.839539381
-0.0 0.0 0.0
-2 0
-10.000000000 15.916259785
-0.0 0.0 0.0
-3 0
-7.498942093 -18.199008237
-0.0 0.0 0.0
-4 0
-5.623413252 6.723316202
-0.0 0.0 0.0
-5 0
-4.216965034 4.671467422
-0.0 0.0 0.0
-6 0
-3.162277660 1.703771884
-0.0 0.0 0.0
-7 0
-2.371373706 0.297676262
-0.0 0.0 0.0
-8 0
-1.778279410 0.967600283
-0.0 0.0 0.0
-9 0
-1.333521432 1.034932150
-0.0 0.0 0.0
-10 0
-1.000000000 0.657621305
-0.0 0.0 0.0
-11 0
-0.749894209 -0.327381267
-0.0 0.0 0.0
-12 0
-0.562341325 0.221528399
-0.0 0.0 0.0
-13 0
-0.421696503 -0.255694044
-0.0 0.0 0.0
-14 0
-0.316227766 0.097853405
-0.0 0.0 0.0
-15 0
-0.237137371 0.744489008
-0.0 0.0 0.0
-16 0
-0.177827941 -0.750090202
-0.0 0.0 0.0
-17 0
-0.133352143 -0.309090719
-0.0 0.0 0.0
-18 0
-0.100000000 -0.998800172
-0.0 0.0 0.0
-19 0
-0.074989421 0.718795407
-0.0 0.0 0.0
-20 0
-0.056234133 0.228002288
-0.0 0.0 0.0
-21 0
-0.042169650 0.573744431
-0.0 0.0 0.0
-22 0
-0.031622777 -0.056969092
-0.0 0.0 0.0
-23 0
-0.023713737 -0.392241803
-0.0 0.0 0.0
-24 0
-0.017782794 -0.569609681
-0.0 0.0 0.0
-25 0
-0.013335214 0.759323484
-0.0 0.0 0.0
-26 0
-0.010000000 -0.194525832
-0.0 0.0 0.0
-27 0
-0.000000000 0.138912412
-0.0 0.0 0.0
-
-O-X0.5+
-27
-1 0
-13.892336977 9.839539381
-0.0 0.0 0.0
-2 0
-10.000000000 15.916259785
-0.0 0.0 0.0
-3 0
-7.498942093 -18.199008237
-0.0 0.0 0.0
-4 0
-5.623413252 6.723316202
-0.0 0.0 0.0
-5 0
-4.216965034 4.671467422
-0.0 0.0 0.0
-6 0
-3.162277660 1.703771884
-0.0 0.0 0.0
-7 0
-2.371373706 0.297676262
-0.0 0.0 0.0
-8 0
-1.778279410 0.967600283
-0.0 0.0 0.0
-9 0
-1.333521432 1.034932150
-0.0 0.0 0.0
-10 0
-1.000000000 0.657621305
-0.0 0.0 0.0
-11 0
-0.749894209 -0.327381267
-0.0 0.0 0.0
-12 0
-0.562341325 0.221528399
-0.0 0.0 0.0
-13 0
-0.421696503 -0.255694044
-0.0 0.0 0.0
-14 0
-0.316227766 0.097853405
-0.0 0.0 0.0
-15 0
-0.237137371 0.744489008
-0.0 0.0 0.0
-16 0
-0.177827941 -0.750090202
-0.0 0.0 0.0
-17 0
-0.133352143 -0.309090719
-0.0 0.0 0.0
-18 0
-0.100000000 -0.998800172
-0.0 0.0 0.0
-19 0
-0.074989421 0.718795407
-0.0 0.0 0.0
-20 0
-0.056234133 0.228002288
-0.0 0.0 0.0
-21 0
-0.042169650 0.573744431
-0.0 0.0 0.0
-22 0
-0.031622777 -0.056969092
-0.0 0.0 0.0
-23 0
-0.023713737 -0.392241803
-0.0 0.0 0.0
-24 0
-0.017782794 -0.569609681
-0.0 0.0 0.0
-25 0
-0.013335214 0.759323484
-0.0 0.0 0.0
-26 0
-0.010000000 -0.194525832
-0.0 0.0 0.0
-27 0
-0.000000000 0.138912412
-0.0 0.0 0.0
-
-O-Y0.5+
-27
-1 0
-13.892336977 9.839539381
-0.0 0.0 0.0
-2 0
-10.000000000 15.916259785
-0.0 0.0 0.0
-3 0
-7.498942093 -18.199008237
-0.0 0.0 0.0
-4 0
-5.623413252 6.723316202
-0.0 0.0 0.0
-5 0
-4.216965034 4.671467422
-0.0 0.0 0.0
-6 0
-3.162277660 1.703771884
-0.0 0.0 0.0
-7 0
-2.371373706 0.297676262
-0.0 0.0 0.0
-8 0
-1.778279410 0.967600283
-0.0 0.0 0.0
-9 0
-1.333521432 1.034932150
-0.0 0.0 0.0
-10 0
-1.000000000 0.657621305
-0.0 0.0 0.0
-11 0
-0.749894209 -0.327381267
-0.0 0.0 0.0
-12 0
-0.562341325 0.221528399
-0.0 0.0 0.0
-13 0
-0.421696503 -0.255694044
-0.0 0.0 0.0
-14 0
-0.316227766 0.097853405
-0.0 0.0 0.0
-15 0
-0.237137371 0.744489008
-0.0 0.0 0.0
-16 0
-0.177827941 -0.750090202
-0.0 0.0 0.0
-17 0
-0.133352143 -0.309090719
-0.0 0.0 0.0
-18 0
-0.100000000 -0.998800172
-0.0 0.0 0.0
-19 0
-0.074989421 0.718795407
-0.0 0.0 0.0
-20 0
-0.056234133 0.228002288
-0.0 0.0 0.0
-21 0
-0.042169650 0.573744431
-0.0 0.0 0.0
-22 0
-0.031622777 -0.056969092
-0.0 0.0 0.0
-23 0
-0.023713737 -0.392241803
-0.0 0.0 0.0
-24 0
-0.017782794 -0.569609681
-0.0 0.0 0.0
-25 0
-0.013335214 0.759323484
-0.0 0.0 0.0
-26 0
-0.010000000 -0.194525832
-0.0 0.0 0.0
-27 0
-0.000000000 0.138912412
-0.0 0.0 0.0
diff --git a/src/CI/CI.f90 b/src/CI/CI.f90
index 8aa13b62..587ec088 100644
--- a/src/CI/CI.f90
+++ b/src/CI/CI.f90
@@ -30,9 +30,10 @@ program CI
use CONTROL_
use MolecularSystem_
use Exception_
- use ConfigurationInteraction_
+ use CIcore_
use String_
use InputCI_
+ use CImod_
implicit none
character(50) :: job
@@ -65,12 +66,12 @@ program CI
else
call InputCI_load( MolecularSystem_getNumberOfQuantumSpecies() )
end if
- call ConfigurationInteraction_constructor(CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL )
- call ConfigurationInteraction_run()
- call ConfigurationInteraction_show()
- call ConfigurationInteraction_showEigenVectors()
- call ConfigurationInteraction_densityMatrices()
- call ConfigurationInteraction_destructor()
+ call CIcore_constructor(CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL )
+ call CImod_run()
+ call CImod_show()
+ call CImod_showEigenVectors()
+ call CImod_densityMatrices()
+ call CImod_destructor()
!!stop time
call Stopwatch_stop(lowdin_stopwatch)
diff --git a/src/CI/CIDiag.f90 b/src/CI/CIDiag.f90
new file mode 100644
index 00000000..19ae5a6c
--- /dev/null
+++ b/src/CI/CIDiag.f90
@@ -0,0 +1,253 @@
+module CIDiag_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use CIcore_
+
+contains
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CIDiag_buildDiagonal()
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: ci
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies, auxnumberOfSpecies
+ integer :: size1, size2
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer(8), allocatable :: indexConf(:)
+ integer, allocatable :: cilevel(:), auxcilevel(:), dd(:)
+
+!$ timeA = omp_get_wtime()
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ coupling = 0
+ CIenergy = 0
+ s = 0
+ c = 0
+ numberOfConfigurations = 0
+
+ allocate ( ciLevel ( numberOfSpecies ) )
+ allocate ( auxciLevel ( numberOfSpecies ) )
+ allocate ( dd ( numberOfSpecies ) )
+
+ ciLevel = 0
+ auxciLevel = 0
+
+ !!auxnumberOfSpecies = CIcore_numberOfConfigurationsRecursion2(s, numberOfSpecies, numberOfConfigurations, ciLevel)
+
+ numberOfConfigurations = 0
+ ciLevel = 0
+
+ !! call recursion to get the number of configurations...
+ do ci = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ auxnumberOfSpecies = CIDiag_numberOfConfigurationsRecursion(s, numberOfSpecies, numberOfConfigurations, ciLevel)
+
+ end do
+
+ call Vector_constructor8 ( CIcore_instance%diagonalHamiltonianMatrix2, &
+ numberOfConfigurations, 0.0_8 )
+
+ CIcore_instance%numberOfConfigurations = numberOfConfigurations
+
+ write (*,*) "Number Of Configurations: ", numberOfConfigurations
+
+ allocate ( indexConf ( numberOfSpecies ) )
+ indexConf = 0
+
+ !! calculate the diagonal
+ s = 0
+ c = 0
+ ciLevel = 0
+
+ do ci = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ dd = 0
+
+ u = CIcore_instance%auxciOrderList(ci)
+ auxnumberOfSpecies = CIDiag_buildDiagonalRecursion( s, numberOfSpecies, indexConf, c, dd, u, cilevel, auxcilevel )
+ end do
+ !stop
+
+ deallocate ( dd )
+ deallocate ( indexConf )
+ deallocate ( ciLevel )
+ deallocate ( auxciLevel )
+
+!$ timeB = omp_get_wtime()
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for Building diagonal of CI matrix : ", timeB - timeA ," (s)"
+
+ write (*,*) "Reference energy, H_0: ", CIcore_instance%diagonalHamiltonianMatrix2%values(1)
+
+ end subroutine CIDiag_buildDiagonal
+
+recursive function CIDiag_numberOfConfigurationsRecursion(s, numberOfSpecies, c, cilevel) result (os)
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies
+ integer :: os,is
+ integer :: cilevel(:)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ i = cilevel(is) + 1
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ os = CIDiag_numberOfConfigurationsRecursion( is, numberOfSpecies, c, cilevel )
+ end do
+ else
+ os = is
+
+ i = cilevel(is) + 1
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ c = c + 1
+ end do
+ end if
+
+ end function CIDiag_numberOfConfigurationsRecursion
+
+
+recursive function CIDiag_buildDiagonalRecursion(s, numberOfSpecies, indexConf, c, dd, u, cilevel, auxcilevel) result (os)
+ implicit none
+
+ integer(8) :: a,b,c,cc,d
+ integer :: u,v
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies
+ integer :: os,is
+ integer :: size1, size2
+ integer(8) :: indexConf(:)
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer :: ssize
+ integer :: cilevel(:), auxcilevel(:), dd(:)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ indexConf(is) = ssize + a
+
+ dd(is) =(a + CIcore_instance%ciOrderSize1(u,is))* CIcore_instance%ciOrderSize2(u,is)
+ os = CIDiag_buildDiagonalRecursion( is, numberOfSpecies, indexConf, c, dd, u, cilevel, auxcilevel )
+ end do
+ else
+ os = is
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ c = c + 1
+ indexConf(is) = ssize + a
+ !print *, indexConf
+ dd(is) =(a + CIcore_instance%ciOrderSize1(u,is))* CIcore_instance%ciOrderSize2(u,is)
+ d = sum(dd)
+
+ CIcore_instance%diagonalHamiltonianMatrix2%values(c) = &
+ CIDiag_calculateEnergyZero ( indexConf )
+
+ end do
+ end if
+
+ end function CIDiag_buildDiagonalRecursion
+
+ function CIDiag_calculateEnergyZero( this ) result (auxCIenergy)
+ implicit none
+
+ integer(8) :: this(:)
+ integer(8) :: a, b
+ integer :: i,j,s
+ integer :: l,k,z,kk,ll
+ integer :: factor
+ integer(2) :: numberOfDiffOrbitals
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex2, auxIndex
+ real(8) :: auxCIenergy
+
+ auxCIenergy = 0.0_8
+
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = this(i)
+ do kk=1, CIcore_instance%occupationNumber( i ) !! 1 is from a and 2 from b
+
+ k = CIcore_instance%strings(i)%values(kk,a)
+
+ !One particle terms
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%twoCenterIntegrals(i)%values( k, k )
+
+ !Two particles, same specie
+ auxIndex1 = CIcore_instance%twoIndexArray(i)%values(k,k)
+
+ do ll = kk + 1, CIcore_instance%occupationNumber( i ) !! 1 is from a and 2 from b
+
+ l = CIcore_instance%strings(i)%values(ll,a)
+ auxIndex2 = CIcore_instance%twoIndexArray(i)%values(l,l)
+ auxIndex = CIcore_instance%fourIndexArray(i)%values(auxIndex1,auxIndex2)
+
+ !Coulomb
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ !Exchange, depends on spin
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(k,l), &
+ CIcore_instance%twoIndexArray(i)%values(l,k) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(i)%kappa*CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+ end do
+
+ !!Two particles, different species
+ do j = i + 1, MolecularSystem_instance%numberOfQuantumSpecies
+ b = this(j)
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+
+ do ll = 1, CIcore_instance%occupationNumber( j ) !! 1 is from a and 2 from b
+ l = CIcore_instance%strings(j)%values(ll,b)
+
+ auxIndex2= CIcore_instance%twoIndexArray(j)%values(l,l)
+ auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
+
+ auxCIenergy = auxCIenergy + &!couplingEnergy
+ CIcore_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
+
+ end do
+
+ end do
+
+ end do
+ end do
+
+ auxCIenergy= auxCIenergy + HartreeFock_instance%puntualInteractionEnergy
+
+ end function CIDiag_calculateEnergyZero
+
+
+end module CIDiag_
diff --git a/src/CI/CIFullMatrix.f90 b/src/CI/CIFullMatrix.f90
new file mode 100644
index 00000000..b4d04185
--- /dev/null
+++ b/src/CI/CIFullMatrix.f90
@@ -0,0 +1,443 @@
+ module CIFullMatrix_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use CIcore_
+
+contains
+
+!>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CIFullMatrix_buildHamiltonianMatrix( timeA, timeB)
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v,p
+ integer :: ci
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies, auxnumberOfSpecies
+ integer :: size1, size2
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer(8), allocatable :: indexConf(:)
+ integer(8), allocatable :: pindexConf(:,:)
+ integer, allocatable :: cilevel(:), auxcilevel(:), dd(:)
+ integer(8), allocatable :: indexConfA(:,:)
+ integer(8), allocatable :: indexConfB(:,:)
+ integer, allocatable :: stringAinB(:)
+ integer(1), allocatable :: couplingSpecies(:,:)
+ integer :: n,nproc
+
+
+!$ timeA = omp_get_wtime()
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ numberOfConfigurations = CIcore_instance%numberOfConfigurations
+
+ allocate ( CIcore_instance%allIndexConf( numberOfSpecies, numberOfConfigurations ) )
+ allocate ( ciLevel ( numberOfSpecies ) )
+ allocate ( indexConf ( numberOfSpecies ) )
+ ciLevel = 0
+ CIcore_instance%allIndexConf = 0
+ indexConf = 0
+
+ !! gather all configurations
+ s = 0
+ c = 0
+ ciLevel = 0
+
+ do ci = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ auxnumberOfSpecies = CIcore_gatherConfRecursion( s, numberOfSpecies, indexConf, c, cilevel )
+ end do
+ !stop
+
+ deallocate ( indexConf )
+ deallocate ( ciLevel )
+
+ !! allocate the hamiltonian matrix
+ call Matrix_constructor ( CIcore_instance%hamiltonianMatrix, &
+ int(CIcore_instance%numberOfConfigurations,8), &
+ int(CIcore_instance%numberOfConfigurations,8), 0.0_8)
+
+
+ nproc = omp_get_max_threads()
+ !! calculate the matrix elements
+ allocate ( indexConfA ( numberOfSpecies, nproc ) )
+ allocate ( indexConfB ( numberOfSpecies, nproc ) )
+ allocate ( pindexConf ( numberOfSpecies, nproc ) )
+ allocate ( couplingSpecies ( numberOfSpecies, nproc ) )
+
+ indexConfA = 0
+ indexConfB = 0
+ pindexConf = 0
+ couplingSpecies = 0
+
+!$omp parallel &
+!$omp& private(a,b,coupling,i,p,stringAinB,n),&
+!$omp& shared(CIcore_instance, HartreeFock_instance)
+ n = omp_get_thread_num() + 1
+!$omp do schedule (dynamic)
+ do a = 1, numberOfConfigurations
+ indexConfA(:,n) = CIcore_instance%allIndexConf(:,a)
+ do b = a, numberOfConfigurations
+
+ indexConfB(:,n) = CIcore_instance%allIndexConf(:,b)
+
+ do i = 1, numberOfSpecies
+ if ( pindexConf(i,n) /= indexConfB(i,n) ) then
+ allocate (stringAinB (CIcore_instance%numberOfOccupiedOrbitals%values(i) ))
+ stringAinB = 0
+ do p = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ stringAinB(p) = CIcore_instance%orbitals(i)%values( &
+ CIcore_instance%strings(i)%values(p,indexConfA(i,n) ), indexConfB(i,n) )
+ end do
+ couplingSpecies(i,n) = CIcore_instance%numberOfOccupiedOrbitals%values(i) - sum ( stringAinB )
+ deallocate (stringAinB )
+ end if
+ end do
+ coupling = sum(couplingSpecies(:,n))
+
+ if ( coupling == 0 ) then
+ CIcore_instance%hamiltonianMatrix%values(a,b) = &
+ CIcore_instance%diagonalHamiltonianMatrix2%values(a)
+
+ else if ( coupling == 1 ) then
+
+ CIcore_instance%hamiltonianMatrix%values(a,b) = &
+ CIFullMatrix_calculateEnergyOne ( n, indexConfA(:,n), indexConfB(:,n) )
+
+ else if ( coupling == 2 ) then
+
+ CIcore_instance%hamiltonianMatrix%values(a,b) = &
+ CIFullMatrix_calculateEnergyTwo ( n, indexConfA(:,n), indexConfB(:,n) )
+
+ end if
+
+ pindexConf(:,n) = indexConfB(:,n)
+
+ end do
+ pindexConf(:,n) = 0
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+
+ deallocate ( pindexConf )
+ deallocate ( couplingSpecies )
+ deallocate ( indexConfB )
+ deallocate ( indexConfA )
+
+ !! symmetrize
+ do a = 1, numberOfConfigurations
+ do b = a, numberOfConfigurations
+ CIcore_instance%hamiltonianMatrix%values(b,a) = &
+ CIcore_instance%hamiltonianMatrix%values(a,b)
+ end do
+ end do
+
+ deallocate ( CIcore_instance%allIndexConf )
+
+!$ timeB = omp_get_wtime()
+
+ end subroutine CIFullMatrix_buildHamiltonianMatrix
+
+ function CIFullMatrix_calculateEnergyOne( n, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: a, b
+ integer :: i,j,s,n, nn
+ integer :: l,k,z,kk,ll
+ integer :: factor
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex2, auxIndex
+ integer :: diffOrb(2), otherdiffOrb(2) !! to avoid confusions
+ real(8) :: auxCIenergy
+ integer :: auxOcc
+
+ auxCIenergy = 0.0_8
+
+ factor = 1
+
+ !! copy a
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(i)
+
+ CIcore_instance%auxstring(n,i)%values(:) = CIcore_instance%strings(i)%values(:,a)
+ end do
+
+ !! set at maximum coincidence
+
+ do s = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(s)
+ b = thisB(s)
+
+ do i = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !b
+ do j = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !a
+ if ( CIcore_instance%auxstring(n,s)%values(j) == &
+ CIcore_instance%strings(s)%values(i,b) ) then
+
+ auxOcc = CIcore_instance%auxstring(n,s)%values(i)
+ CIcore_instance%auxstring(n,s)%values(i) = CIcore_instance%strings(s)%values(i,b)
+ CIcore_instance%auxstring(n,s)%values(j) = auxOcc
+ if ( i /= j ) factor = -1*factor
+ exit
+ end if
+ end do
+ end do
+ end do
+
+ !! calculate
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+
+ a = thisA(i)
+ b = thisB(i)
+ diffOrb = 0
+
+ do kk = 1, CIcore_instance%occupationNumber( i) !! 1 is from a and 2 from b
+
+ if ( CIcore_instance%auxstring(n,i)%values(kk) .ne. &
+ CIcore_instance%strings(i)%values(kk,b) ) then
+ diffOrb(1) = CIcore_instance%auxstring(n,i)%values(kk)
+ diffOrb(2) = CIcore_instance%strings(i)%values(kk,b)
+ exit
+ end if
+
+ end do
+ if ( diffOrb(2) > 0 ) then
+
+ !One particle terms
+ auxCIenergy= auxCIenergy + CIcore_instance%twoCenterIntegrals(i)%values( &
+ diffOrb(1), diffOrb(2) )
+
+ auxIndex1= CIcore_instance%twoIndexArray(i)%values( &
+ diffOrb(1), diffOrb(2))
+
+ do ll = 1, CIcore_instance%occupationNumber( i ) !! 1 is from a and 2 from b
+
+ if ( CIcore_instance%auxstring(n,i)%values(ll) .eq. &
+ CIcore_instance%strings(i)%values(ll,b) ) then
+
+ l = CIcore_instance%auxstring(n,i)%values(ll) !! or b
+
+ auxIndex2 = CIcore_instance%twoIndexArray(i)%values( l,l)
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( auxIndex1, auxIndex2 )
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(diffOrb(1),l), &
+ CIcore_instance%twoIndexArray(i)%values(l,diffOrb(2)) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(i)%kappa*CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ end if
+ end do
+ if (MolecularSystem_instance%numberOfQuantumSpecies .gt. 1 ) then !.and. spin(1) .eq. spin(2) ) then
+ do j=1, MolecularSystem_instance%numberOfQuantumSpecies
+
+ if (i .ne. j) then
+
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+
+ do ll=1, CIcore_instance%occupationNumber( j ) !! 1 is from a and 2 from b
+ l = CIcore_instance%auxstring(n,j)%values(ll) !! or b?
+
+ auxIndex2 = CIcore_instance%twoIndexArray(j)%values( l,l)
+ auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
+ end do
+ end if
+ end do
+ end if
+ end if
+ end do
+
+ auxCIenergy= auxCIenergy * factor
+
+
+ end function CIFullMatrix_calculateEnergyOne
+
+ function CIFullMatrix_calculateEnergyTwo( n, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: a, b
+ integer :: i,j,s,n
+ integer :: l,k,z,kk,ll
+ integer :: factor
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex2, auxIndex
+ integer :: diffOrb(4), otherdiffOrb(4) !! to avoid confusions
+ real(8) :: auxCIenergy
+ integer :: auxOcc
+
+ auxCIenergy = 0.0_8
+ factor = 1
+
+ !! copy a
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(i)
+ CIcore_instance%auxstring(n,i)%values(:) = CIcore_instance%strings(i)%values(:,a)
+ end do
+
+ !! set at maximum coincidence
+
+ do s = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(s)
+ b = thisB(s)
+
+ do i = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !b
+ do j = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !a
+ if ( CIcore_instance%auxstring(n,s)%values(j) == &
+ CIcore_instance%strings(s)%values(i,b) ) then
+
+ auxOcc = CIcore_instance%auxstring(n,s)%values(i)
+ CIcore_instance%auxstring(n,s)%values(i) = CIcore_instance%strings(s)%values(i,b)
+ CIcore_instance%auxstring(n,s)%values(j) = auxOcc
+ if ( i /= j ) factor = -1*factor
+ exit
+ end if
+ end do
+ end do
+ end do
+
+ !!calculate
+ do i=1, MolecularSystem_instance%numberOfQuantumSpecies
+
+ a = thisA(i)
+ b = thisB(i)
+ diffOrb = 0
+ z = 1
+ do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+
+ if ( CIcore_instance%auxstring(n,i)%values(k) .ne. &
+ CIcore_instance%strings(i)%values(k,b) ) then
+ diffOrb(z) = CIcore_instance%auxstring(n,i)%values(k)
+ diffOrb(z+2) = CIcore_instance%strings(i)%values(k,b)
+ z = z + 1
+ cycle
+ end if
+ end do
+ if ( diffOrb(2) > 0 ) then
+
+ !Coulomb
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(1),diffOrb(3)),&
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(2),diffOrb(4)) )
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(1),diffOrb(4)),&
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(2),diffOrb(3)) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(i)%kappa*CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ end if
+ !! different species
+ do j = i + 1, MolecularSystem_instance%numberOfQuantumSpecies
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+ otherdiffOrb = 0
+ a = thisA(j)
+ b = thisB(j)
+
+ do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(j)
+ if ( CIcore_instance%auxstring(n,j)%values(k) .ne. &
+ CIcore_instance%strings(j)%values(k,b) ) then
+ otherdiffOrb(1) = CIcore_instance%auxstring(n,j)%values(k)
+ otherdiffOrb(3) = CIcore_instance%strings(j)%values(k,b)
+ exit
+ end if
+
+ end do
+
+ if ( diffOrb(3) .gt. 0 .and. otherdiffOrb(3) .gt. 0 ) then
+ auxIndex1 = CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(1),diffOrb(3) )
+ auxIndex2 = CIcore_instance%twoIndexArray(j)%values(&
+ otherdiffOrb(1),otherdiffOrb(3) )
+ auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
+
+ end if
+ end do
+ end do
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CIFullMatrix_calculateEnergyTwo
+
+!>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CIFullMatrix_PT2()
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: i, j, ii, jj
+ integer(8) :: numberOfConfigurations
+ integer :: n,nproc
+ real(8) :: timeA, timeB
+ real(8) :: CIEnergy_PT2
+ real(8) :: auxEnergy
+
+!$ timeA = omp_get_wtime()
+
+ numberOfConfigurations = CIcore_instance%numberOfConfigurations
+ nproc = omp_get_max_threads()
+
+ CIEnergy_PT2 = 0.0_8
+!$omp parallel &
+!$omp& private(a,b,n,auxEnergy),&
+!$omp& shared(CIcore_instance) reduction(+:CIEnergy_PT2)
+ n = omp_get_thread_num() + 1
+!$omp do schedule (dynamic)
+ do a = 2, numberOfConfigurations
+ auxEnergy = 0.0_8
+ do b = 1, numberOfConfigurations
+ auxEnergy = auxEnergy + CIcore_instance%hamiltonianMatrix%values(b,a) * CIcore_instance%eigenVectors%values(b,1)
+ end do
+ print *, ( CIcore_instance%hamiltonianMatrix%values(a,a) - CIcore_instance%eigenvalues%values(1) )
+ CIEnergy_PT2 = CIEnergy_PT2 + (auxEnergy**2) / ( CIcore_instance%hamiltonianMatrix%values(a,a) - CIcore_instance%eigenvalues%values(1) )
+ end do
+!$omp end do nowait
+!$omp end parallel
+
+ print *, "PT2 ", CIEnergy_PT2
+
+!$ timeB = omp_get_wtime()
+!!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for calculating PT2 correction : ", timeB - timeA ," (s)"
+
+ end subroutine CIFullMatrix_PT2
+
+ end module CIFullMatrix_
diff --git a/src/CI/CIInitial.f90 b/src/CI/CIInitial.f90
new file mode 100644
index 00000000..ceb41f66
--- /dev/null
+++ b/src/CI/CIInitial.f90
@@ -0,0 +1,534 @@
+module CIInitial_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use CIcore_
+
+contains
+
+
+ subroutine CIInitial_buildInitialCIMatrix2()
+ implicit none
+
+ type(Configuration) :: auxConfigurationA, auxConfigurationB
+ type (Vector8) :: diagonalHamiltonianMatrix
+ integer :: a,b,c,aa,bb,i
+ real(8) :: timeA, timeB
+ real(8) :: CIenergy
+ integer :: initialCIMatrixSize
+ integer :: nproc
+
+ !$ timeA = omp_get_wtime()
+ initialCIMatrixSize = CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
+ if ( CIcore_instance%numberOfConfigurations < CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX ) then
+ CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX = CIcore_instance%numberOfConfigurations !! assign to an internal variable
+ end if
+
+ call Vector_constructorInteger8 ( CIcore_instance%auxIndexCIMatrix, &
+ CIcore_instance%numberOfConfigurations, 0_8 ) !hmm
+
+ do a = 1, CIcore_instance%numberOfConfigurations
+ CIcore_instance%auxIndexCIMatrix%values(a)= a
+ end do
+
+ !! save the unsorted diagonal Matrix
+ call Vector_constructor8 ( CIcore_instance%diagonalHamiltonianMatrix, &
+ CIcore_instance%numberOfConfigurations, 0.0_8 )
+
+
+ CIcore_instance%diagonalHamiltonianMatrix%values = CIcore_instance%diagonalHamiltonianMatrix2%values
+
+ !! To get only the lowest 300 values.
+ call Vector_reverseSortElements8( CIcore_instance%diagonalHamiltonianMatrix2, &
+ CIcore_instance%auxIndexCIMatrix, int(initialCIMatrixSize,8))
+
+ call Matrix_constructor ( CIcore_instance%initialHamiltonianMatrix, int(initialCIMatrixSize,8) , &
+ int(initialCIMatrixSize,8) , 0.0_8 )
+
+ !! get the configurations for the initial hamiltonian matrix
+ call CIInitial_getInitialIndexes()
+
+ call CIInitial_calculateInitialCIMatrix()
+
+ !! diagonalize the initial matrix
+ call Vector_constructor8 ( CIcore_instance%initialEigenValues, int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ call Matrix_constructor (CIcore_instance%initialEigenVectors, &
+ int(initialCIMatrixSize,8), &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ call Matrix_eigen_select ( CIcore_instance%initialHamiltonianMatrix, &
+ CIcore_instance%initialEigenValues, &
+ 1, int(CONTROL_instance%NUMBER_OF_CI_STATES,4), &
+ eigenVectors = CIcore_instance%initialEigenVectors, &
+ flags = int(SYMMETRIC,4))
+
+ write(*,*) "Initial eigenValues"
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ write (*,*) i, CIcore_instance%initialEigenValues%values(i)
+ end do
+
+ call Vector_destructor8 ( CIcore_instance%diagonalHamiltonianMatrix2 )
+
+!$ timeB = omp_get_wtime()
+!$ write(*,"(A,F10.3,A4)") "** TOTAL Elapsed Time for Solving Initial CI : ", timeB - timeA ," (s)"
+
+ end subroutine CIInitial_buildInitialCIMatrix2
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ !! Map the indexes of initial CI matrix to the complete matrix.
+ subroutine CIInitial_getInitialIndexes()
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: ci
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies, auxnumberOfSpecies
+ integer :: size1, size2
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer(8), allocatable :: indexConf(:)
+ integer, allocatable :: cilevel(:)
+
+!$ timeA = omp_get_wtime()
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ s = 0
+ c = 0
+
+ call Matrix_constructorInteger ( CIcore_instance%auxConfigurations, int( numberOfSpecies,8), &
+ int(CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX,8), 0 )
+
+ !! call recursion
+
+ allocate ( cilevel ( numberOfSpecies ) )
+ allocate ( indexConf ( numberOfSpecies ) )
+
+ s = 0
+ c = 0
+ indexConf = 0
+ cilevel = 0
+
+ do ci = 1, CIcore_instance%sizeCiOrderList
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ auxnumberOfSpecies = CIInitial_getIndexesRecursion( s, numberOfSpecies, indexConf, c, cilevel )
+ end do
+
+ deallocate ( indexConf )
+ deallocate ( cilevel )
+
+!$ timeB = omp_get_wtime()
+
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for getting initial indexes : ", timeB - timeA ," (s)"
+
+ end subroutine CIInitial_getInitialIndexes
+
+
+recursive function CIInitial_getIndexesRecursion(s, numberOfSpecies, indexConf, c, cilevel) result (os)
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: i, j, ii, jj
+ integer :: s, ss, numberOfSpecies
+ integer :: os,is
+ integer :: size1, size2
+ integer(8) :: indexConf(:)
+ integer(1) :: coupling
+ integer :: ssize
+ integer :: cilevel(:)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ indexConf(is) = ssize + a
+ os = CIInitial_getIndexesRecursion( is, numberOfSpecies, indexConf, c, cilevel)
+ end do
+ else
+ os = is
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ c = c + 1
+ indexConf(is) = ssize + a
+ do u = 1, CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
+ if ( c == CIcore_instance%auxIndexCIMatrix%values(u) ) then
+ do ss = 1, numberOfSpecies
+ CIcore_instance%auxConfigurations%values(ss,u) = indexConf(ss)
+ end do
+ end if
+ end do
+ end do
+ end if
+
+ end function CIInitial_getIndexesRecursion
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CIInitial_calculateInitialCIMatrix()
+ implicit none
+
+ integer(8) :: a,b,aa,bb
+ integer :: u,v
+ integer :: i
+ integer :: numberOfSpecies
+ real(8) :: timeA1, timeB1
+ integer(1) :: coupling
+ integer(1), allocatable :: orbitalsA(:), orbitalsB(:)
+ integer :: initialCIMatrixSize
+ integer :: nproc
+ integer(8), allocatable :: indexConfA(:)
+ integer(8), allocatable :: indexConfB(:)
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ initialCIMatrixSize = CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
+
+ allocate ( indexConfA ( numberOfSpecies ) )
+ allocate ( indexConfB ( numberOfSpecies ) )
+
+!$ timeA1 = omp_get_wtime()
+
+ do a = 1, initialCIMatrixSize
+ aa = CIcore_instance%auxIndexCIMatrix%values(a)
+ do b = a, initialCIMatrixSize
+ bb = CIcore_instance%auxIndexCIMatrix%values(b)
+ coupling = 0
+
+ indexConfA = 0
+ indexConfB = 0
+
+ do i = 1, numberOfSpecies
+
+ allocate (orbitalsA ( CIcore_instance%numberOfOrbitals%values(i) ))
+ allocate (orbitalsB ( CIcore_instance%numberOfOrbitals%values(i) ))
+ orbitalsA = 0
+ orbitalsB = 0
+
+ indexConfA(i) = CIcore_instance%auxConfigurations%values(i,a)
+ indexConfB(i) = CIcore_instance%auxConfigurations%values(i,b)
+
+ do u = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ orbitalsA( CIcore_instance%strings(i)%values(u,indexConfA(i) ) ) = 1
+ end do
+ do v = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ orbitalsB( CIcore_instance%strings(i)%values(v,indexConfB(i) ) ) = 1
+ end do
+ coupling = coupling + &
+ CIcore_instance%numberOfOccupiedOrbitals%values(i) - sum ( orbitalsA * orbitalsB )
+
+ deallocate (orbitalsA )
+ deallocate (orbitalsB )
+
+ end do
+ if ( coupling == 0 ) then
+ CIcore_instance%initialHamiltonianMatrix%values(a,b) = &
+ CIcore_instance%diagonalHamiltonianMatrix2%values(a)
+
+ else if ( coupling == 1 ) then
+
+ CIcore_instance%initialHamiltonianMatrix%values(a,b) = &
+ CIInitial_calculateEnergyOne ( 1, indexConfA, indexConfB )
+
+ else if ( coupling == 2 ) then
+
+ CIcore_instance%initialHamiltonianMatrix%values(a,b) = &
+ CIInitial_calculateEnergyTwo ( 1, indexConfA, indexConfB )
+
+ end if
+
+
+ end do
+
+
+ end do
+
+ deallocate ( indexConfB )
+ deallocate ( indexConfA )
+
+!$ timeB1 = omp_get_wtime()
+ !! symmetrize
+ do a = 1, initialCIMatrixSize
+ do b = a, initialCIMatrixSize
+
+ CIcore_instance%initialHamiltonianMatrix%values(b,a) = &
+ CIcore_instance%initialHamiltonianMatrix%values(a,b)
+ end do
+ end do
+
+ !!open(unit=318, file="cimatrix.dat", action = "write", form="formatted")
+ !!do a = 1, initialCIMatrixSize
+ !! do b = 1, initialCIMatrixSize
+ !! write (318,*) a,b, CIcore_instance%initialHamiltonianMatrix%values(a,b)
+ !! end do
+ !! write (318,*) " "
+ !!end do
+ !!close(318)
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for Calculating initial CI matrix : ", timeB1 - timeA1 ," (s)"
+
+ end subroutine CIInitial_calculateInitialCIMatrix
+
+ function CIInitial_calculateEnergyOne( n, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: a, b
+ integer :: i,j,s,n, nn
+ integer :: l,k,z,kk,ll
+ integer :: factor
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex2, auxIndex
+ integer :: diffOrb(2), otherdiffOrb(2) !! to avoid confusions
+ real(8) :: auxCIenergy
+ integer :: auxOcc
+
+ auxCIenergy = 0.0_8
+
+ factor = 1
+
+ !! copy a
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(i)
+
+ CIcore_instance%auxstring(n,i)%values(:) = CIcore_instance%strings(i)%values(:,a)
+ end do
+
+ !! set at maximum coincidence
+
+ do s = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(s)
+ b = thisB(s)
+
+ do i = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !b
+ do j = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !a
+ if ( CIcore_instance%auxstring(n,s)%values(j) == &
+ CIcore_instance%strings(s)%values(i,b) ) then
+
+ auxOcc = CIcore_instance%auxstring(n,s)%values(i)
+ CIcore_instance%auxstring(n,s)%values(i) = CIcore_instance%strings(s)%values(i,b)
+ CIcore_instance%auxstring(n,s)%values(j) = auxOcc
+ if ( i /= j ) factor = -1*factor
+ exit
+ end if
+ end do
+ end do
+ end do
+
+ !! calculate
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+
+ a = thisA(i)
+ b = thisB(i)
+ diffOrb = 0
+
+ do kk = 1, CIcore_instance%occupationNumber( i) !! 1 is from a and 2 from b
+
+ if ( CIcore_instance%auxstring(n,i)%values(kk) .ne. &
+ CIcore_instance%strings(i)%values(kk,b) ) then
+ diffOrb(1) = CIcore_instance%auxstring(n,i)%values(kk)
+ diffOrb(2) = CIcore_instance%strings(i)%values(kk,b)
+ exit
+ end if
+
+ end do
+ if ( diffOrb(2) > 0 ) then
+
+ !One particle terms
+ auxCIenergy= auxCIenergy + CIcore_instance%twoCenterIntegrals(i)%values( &
+ diffOrb(1), diffOrb(2) )
+
+ auxIndex1= CIcore_instance%twoIndexArray(i)%values( &
+ diffOrb(1), diffOrb(2))
+
+ do ll = 1, CIcore_instance%occupationNumber( i ) !! 1 is from a and 2 from b
+
+ if ( CIcore_instance%auxstring(n,i)%values(ll) .eq. &
+ CIcore_instance%strings(i)%values(ll,b) ) then
+
+ l = CIcore_instance%auxstring(n,i)%values(ll) !! or b
+
+ auxIndex2 = CIcore_instance%twoIndexArray(i)%values( l,l)
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( auxIndex1, auxIndex2 )
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(diffOrb(1),l), &
+ CIcore_instance%twoIndexArray(i)%values(l,diffOrb(2)) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(i)%kappa*CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ end if
+ end do
+ if (MolecularSystem_instance%numberOfQuantumSpecies .gt. 1 ) then !.and. spin(1) .eq. spin(2) ) then
+ do j=1, MolecularSystem_instance%numberOfQuantumSpecies
+
+ if (i .ne. j) then
+
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+
+ do ll=1, CIcore_instance%occupationNumber( j ) !! 1 is from a and 2 from b
+ l = CIcore_instance%auxstring(n,j)%values(ll) !! or b?
+
+ auxIndex2 = CIcore_instance%twoIndexArray(j)%values( l,l)
+ auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
+ end do
+ end if
+ end do
+ end if
+ end if
+ end do
+
+ auxCIenergy= auxCIenergy * factor
+
+
+ end function CIInitial_calculateEnergyOne
+
+
+ function CIInitial_calculateEnergyTwo( n, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: a, b
+ integer :: i,j,s,n
+ integer :: l,k,z,kk,ll
+ integer :: factor
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex2, auxIndex
+ integer :: diffOrb(4), otherdiffOrb(4) !! to avoid confusions
+ real(8) :: auxCIenergy
+ integer :: auxOcc
+
+ auxCIenergy = 0.0_8
+ factor = 1
+
+ !! copy a
+ do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(i)
+ CIcore_instance%auxstring(n,i)%values(:) = CIcore_instance%strings(i)%values(:,a)
+ end do
+
+ !! set at maximum coincidence
+
+ do s = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ a = thisA(s)
+ b = thisB(s)
+
+ do i = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !b
+ do j = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s) !a
+ if ( CIcore_instance%auxstring(n,s)%values(j) == &
+ CIcore_instance%strings(s)%values(i,b) ) then
+
+ auxOcc = CIcore_instance%auxstring(n,s)%values(i)
+ CIcore_instance%auxstring(n,s)%values(i) = CIcore_instance%strings(s)%values(i,b)
+ CIcore_instance%auxstring(n,s)%values(j) = auxOcc
+ if ( i /= j ) factor = -1*factor
+ exit
+ end if
+ end do
+ end do
+ end do
+
+ !!calculate
+ do i=1, MolecularSystem_instance%numberOfQuantumSpecies
+
+ a = thisA(i)
+ b = thisB(i)
+ diffOrb = 0
+ z = 1
+ do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+
+ if ( CIcore_instance%auxstring(n,i)%values(k) .ne. &
+ CIcore_instance%strings(i)%values(k,b) ) then
+ diffOrb(z) = CIcore_instance%auxstring(n,i)%values(k)
+ diffOrb(z+2) = CIcore_instance%strings(i)%values(k,b)
+ z = z + 1
+ cycle
+ end if
+ end do
+ if ( diffOrb(2) > 0 ) then
+
+ !Coulomb
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(1),diffOrb(3)),&
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(2),diffOrb(4)) )
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ auxIndex = CIcore_instance%fourIndexArray(i)%values( &
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(1),diffOrb(4)),&
+ CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(2),diffOrb(3)) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(i)%kappa*CIcore_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
+
+ end if
+ !! different species
+ do j = i + 1, MolecularSystem_instance%numberOfQuantumSpecies
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+ otherdiffOrb = 0
+ a = thisA(j)
+ b = thisB(j)
+
+ do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(j)
+ if ( CIcore_instance%auxstring(n,j)%values(k) .ne. &
+ CIcore_instance%strings(j)%values(k,b) ) then
+ otherdiffOrb(1) = CIcore_instance%auxstring(n,j)%values(k)
+ otherdiffOrb(3) = CIcore_instance%strings(j)%values(k,b)
+ exit
+ end if
+
+ end do
+
+ if ( diffOrb(3) .gt. 0 .and. otherdiffOrb(3) .gt. 0 ) then
+ auxIndex1 = CIcore_instance%twoIndexArray(i)%values(&
+ diffOrb(1),diffOrb(3) )
+ auxIndex2 = CIcore_instance%twoIndexArray(j)%values(&
+ otherdiffOrb(1),otherdiffOrb(3) )
+ auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
+
+ end if
+ end do
+ end do
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CIInitial_calculateEnergyTwo
+
+end module CIInitial_
diff --git a/src/CI/CIJadamilu.f90 b/src/CI/CIJadamilu.f90
new file mode 100644
index 00000000..aa285e48
--- /dev/null
+++ b/src/CI/CIJadamilu.f90
@@ -0,0 +1,1381 @@
+ module CIJadamilu_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use CIcore_
+
+contains
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CIJadamilu_buildCouplingMatrix()
+ implicit none
+
+ integer(8) :: a,b,c1,c2
+ integer :: u,v,p
+ integer :: i,n
+ integer :: auxis,auxos
+ integer :: numberOfSpecies
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(1), allocatable :: orbitalsA(:), orbitalsB(:)
+ integer(8), allocatable :: indexConfA(:)
+ integer(8), allocatable :: indexConfB(:)
+ integer(1), allocatable :: couplingOrder(:)
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ coupling = 0
+
+ !! allocate arrays
+ do n = 1, CIcore_instance%nproc
+ do i = 1, numberOfSpecies
+
+ call Matrix_constructorInteger ( CIcore_instance%couplingMatrix(i,n), &
+ sum(CIcore_instance%numberOfStrings(i)%values), 3_8 , 0)
+
+ call Matrix_constructorInteger(CIcore_instance%nCouplingOneTwo(i,n), &
+ 3_8, int(size(CIcore_instance%numberOfStrings(i)%values, dim=1),8), 0 )
+
+ call Matrix_constructorInteger(CIcore_instance%nCouplingSize(i,n), &
+ 3_8, int(size(CIcore_instance%numberOfStrings(i)%values, dim=1) + 1 ,8), 0 )
+
+ call Vector_constructor(CIcore_instance%couplingMatrixEnergyOne(i,n), &
+ int(sum(CIcore_instance%numberOfStrings(i)%values),4), 0.0_8 )
+
+ call Vector_constructorInteger(CIcore_instance%couplingMatrixFactorOne(i,n), &
+ int(sum(CIcore_instance%numberOfStrings(i)%values),4), 2 )
+
+ call Vector_constructorInteger( CIcore_instance%couplingMatrixOrbOne(i,n), &
+ int(sum(CIcore_instance%numberOfStrings(i)%values),4), 0 )
+
+ end do
+ end do
+
+ end subroutine CIJadamilu_buildCouplingMatrix
+
+!! Build a list with all possible combinations of number of different orbitals from all quantum species, coupling (0,1,2)
+ subroutine CIJadamilu_buildCouplingOrderList()
+ implicit none
+
+ integer(8) :: a,b,c,c1,c2,aa,d
+ integer :: u,uu,vv, p, nn,z
+ integer :: i
+ integer :: numberOfSpecies, auxnumberOfSpecies,s
+ integer(1), allocatable :: couplingOrder(:)
+ integer(1) :: coupling
+ real(8) :: timeA, timeB
+ integer :: ncouplingOrderOne
+ integer :: ncouplingOrderTwo
+ integer :: ssize
+ integer, allocatable :: cilevel(:)
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+
+ ssize = 1
+ do i = 1, numberOfSpecies
+ ssize = ssize * 3 !! ( 0,1,2) different orbitals
+ end do
+
+ allocate ( CIcore_instance%couplingOrderList( 3, ssize ) ) !! one, two same, two diff
+ allocate ( CIcore_instance%couplingOrderIndex( 3, ssize ) ) !! one, two same, two diff
+
+ do a = 1, 3
+ do b = 1, ssize
+ call Vector_constructorInteger1( CIcore_instance%couplingOrderList(a,b), &
+ int( numberOfSpecies,8), int(0,1) )
+
+ end do
+ end do
+
+ !! same species
+ do b = 1, ssize
+ call Vector_constructorInteger1( CIcore_instance%couplingOrderIndex(1,b), 1_8, int(0,1) )
+ call Vector_constructorInteger1( CIcore_instance%couplingOrderIndex(2,b), 1_8, int(0,1) )
+ end do
+
+ !! diff species
+ do b = 1, ssize
+ call Vector_constructorInteger1( CIcore_instance%couplingOrderIndex(3,b), 2_8, int(0,1) )
+ end do
+
+
+ allocate ( couplingOrder ( numberOfSpecies )) !! 0, 1, 2
+ couplingOrder = 0
+
+ !! call recursion
+ s = 0
+ CIcore_instance%ncouplingOrderOne = 0
+ CIcore_instance%ncouplingOrderTwo = 0
+ CIcore_instance%ncouplingOrderTwoDiff = 0
+
+ allocate ( ciLevel ( numberOfSpecies ) )
+ ciLevel = 0
+
+ !! get all combinations
+ auxnumberOfSpecies = CIJadamilu_buildCouplingOrderRecursion( s, numberOfSpecies, couplingOrder, cilevel )
+
+ !! save the index for species (speciesID) just to avoid a lot of conditionals later!
+
+ do u = 1, CIcore_instance%ncouplingOrderOne
+ do i = 1, numberOfSpecies
+ if ( CIcore_instance%couplingOrderList(1,u)%values(i) == 1 ) then
+ CIcore_instance%couplingOrderIndex(1,u)%values(1) = i
+ end if
+ end do
+ end do
+
+ do u = 1, CIcore_instance%ncouplingOrderTwo
+ do i = 1, numberOfSpecies
+ if ( CIcore_instance%couplingOrderList(2,u)%values(i) == 2 ) then
+ CIcore_instance%couplingOrderIndex(2,u)%values(1) = i
+ end if
+ end do
+ end do
+
+ do u = 1, CIcore_instance%ncouplingOrderTwoDiff
+ z = 0
+ do i = 1, numberOfSpecies
+ if ( CIcore_instance%couplingOrderList(3,u)%values(i) == 1 ) then
+ z = z + 1
+ CIcore_instance%couplingOrderIndex(3,u)%values(z) = i
+ end if
+ end do
+ end do
+
+
+ deallocate ( ciLevel )
+ deallocate ( couplingOrder )
+
+ end subroutine CIJadamilu_buildCouplingOrderList
+
+
+!! Get all possible combinations of number of different orbitals from all quantum species.
+recursive function CIJadamilu_buildCouplingOrderRecursion( s, numberOfSpecies, couplingOrder, cilevel ) result (os)
+ implicit none
+
+ integer(8) :: a,b,c,d
+ integer :: u,v
+ integer :: i, j, ii, jj, nn
+ integer :: s, numberOfSpecies
+ integer :: os,is,auxis, auxos
+ integer(1) :: couplingOrder(:)
+ logical :: same
+ integer :: cilevel(:)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ if ( sum ( couplingOrder) <= 2 ) then
+ do i = 1, 3 - sum ( couplingOrder ) !! 0,1,2
+ couplingOrder(is) = i-1
+ couplingOrder(is+1:) = 0
+ os = CIJadamilu_buildCouplingOrderRecursion( is, numberOfSpecies, couplingOrder, cilevel )
+ end do
+ end if
+ else
+ if ( sum ( couplingOrder) <= 2 ) then
+ do i = 1, 3 - sum ( couplingOrder ) !! 0,1,2
+ couplingOrder(is) = i-1
+ couplingOrder(is+1:) = 0
+ os = is
+ if ( sum ( couplingOrder ) == 1 ) then
+
+ auxis = 0
+ CIcore_instance%ncouplingOrderOne = CIcore_instance%ncouplingOrderOne + 1
+ b = CIcore_instance%ncouplingOrderOne
+ CIcore_instance%couplingOrderList(1,b)%values = couplingOrder
+
+ else if ( sum ( couplingOrder ) == 2 ) then
+
+ same = .false.
+
+ do j = 1, numberOfSpecies
+ if ( couplingOrder(j) == 2 ) same = .true.
+ end do
+
+ if ( same ) then
+ auxis = 0
+ CIcore_instance%ncouplingOrderTwo = CIcore_instance%ncouplingOrderTwo + 1
+ b = CIcore_instance%ncouplingOrderTwo
+ CIcore_instance%couplingOrderList(2,b)%values = couplingOrder
+ else
+ auxis = 0
+ CIcore_instance%ncouplingOrderTwoDiff = CIcore_instance%ncouplingOrderTwoDiff + 1
+ b = CIcore_instance%ncouplingOrderTwoDiff
+ CIcore_instance%couplingOrderList(3,b)%values = couplingOrder
+ end if
+
+ end if
+ end do
+ end if
+ end if
+
+ end function CIJadamilu_buildCouplingOrderRecursion
+
+ subroutine CIJadamilu_jadamiluInterface(n, maxeig, eigenValues, eigenVectors, timeA, timeB)
+ implicit none
+ external DPJDREVCOM
+ integer(8) :: maxnev
+ real(8) :: CIenergy
+ integer(8) :: nproc
+ type(Vector8), intent(inout) :: eigenValues
+ type(Matrix), intent(inout) :: eigenVectors
+
+! N: size of the problem
+! MAXEIG: max. number of wanteg eig (NEIG<=MAXEIG)
+! MAXSP: max. value of MADSPACE
+ integer(8) :: n, maxeig, MAXSP
+ integer(8) :: LX
+ real(8), allocatable :: EIGS(:), RES(:), X(:)!, D(:)
+! arguments to pass to the routines
+ integer(8) :: NEIG, MADSPACE, ISEARCH, NINIT
+ integer(8) :: JA(1), IA(1)
+ integer(8) :: ICNTL(5)
+ integer(8) :: ITER, IPRINT, INFO
+ real(8) :: SIGMA, TOL, GAP, MEM, DROPTOL, SHIFT
+ integer(8) :: NDX1, NDX2, NDX3
+ integer(8) :: IJOB! some local variables
+ integer(8) :: auxSize
+ integer(4) :: size1,size2
+ integer(8) :: I,J,K,ii,jj,jjj
+ integer(4) :: iiter
+ logical :: fullMatrix
+ real(8) :: timeA, timeB
+
+!$ timeA = omp_get_wtime()
+ maxsp = CONTROL_instance%CI_MADSPACE
+ !!if ( CONTROL_instance%CI_JACOBI ) then
+
+ LX = N*(3*MAXSP+MAXEIG+1)+4*MAXSP*MAXSP
+
+ if ( allocated ( eigs ) ) deallocate ( eigs )
+ allocate ( eigs ( maxeig ) )
+ eigs = 0.0_8
+ if ( allocated ( res ) ) deallocate ( res )
+ allocate ( res ( maxeig ) )
+ res = 0.0_8
+ if ( allocated ( x ) ) deallocate ( x )
+ allocate ( x ( lx ) )
+ x = 0.0_8
+
+
+! set input variables
+! the matrix is already in the required format
+
+ IPRINT = 0 ! standard report on standard output
+ ISEARCH = 1 ! we want the smallest eigenvalues
+ NEIG = maxeig ! number of wanted eigenvalues
+ !NINIT = 0 ! no initial approximate eigenvectors
+ NINIT = NEIG ! initial approximate eigenvectors
+ MADSPACE = maxsp ! desired size of the search space
+ ITER = 1000*NEIG ! maximum number of iteration steps
+ TOL = CONTROL_instance%CI_CONVERGENCE !1.0d-4 ! tolerance for the eigenvector residual
+
+ NDX1 = 0
+ NDX2 = 0
+ MEM = 0
+
+! additional parameters set to default
+ ICNTL(1)=0
+ ICNTL(2)=0
+ ICNTL(3)=0
+ ICNTL(4)=0
+ ICNTL(5)=1
+
+ IJOB=0
+
+ JA(1) = -1
+ IA(1) = -1
+
+ ! set initial eigenpairs
+ if ( CONTROL_instance%CI_LOAD_EIGENVECTOR ) then
+ print *, "Loading the eigenvector to the initial guess"
+ do j = 1, n
+ X(j) = eigenVectors%values(j,1)
+ end do
+
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ EIGS(i) = eigenValues%values(i)
+ end do
+ else
+ jj = 0
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ jj = (i - 1) * n
+ do j = 1, CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
+ X(jj + CIcore_instance%auxIndexCIMatrix%values(j)) = CIcore_instance%initialEigenVectors%values(j,i)
+ end do
+ end do
+
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ EIGS(i) = CIcore_instance%initialEigenValues%values(i)
+ end do
+ end if
+
+ DROPTOL = 0
+
+ SIGMA = EIGS(1)
+ gap = 0
+ SHIFT = EIGS(1)
+
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ write(6,"(T2,A5,I4,2X,A10,F20.10,2X,A11,F20.10)") "State", i, "Eigenvalue", eigs( i ), "Eigenvector", x((i-1)*n + i)
+ end do
+
+ iiter = 0
+
+!10 CALL DPJDREVCOM( N, A, JA, IA,EIGS, RES, X, LX, NEIG, &
+! SIGMA, ISEARCH, NINIT, MADSPACE, ITER, TOL, &
+! SHIFT, DROPTOL, MEM, ICNTL, &
+! IJOB, NDX1, NDX2, IPRINT, INFO, GAP)
+10 CALL DPJDREVCOM( N, CIcore_instance%diagonalHamiltonianMatrix%values , JA, IA, EIGS, RES, X, LX, NEIG, &
+ SIGMA, ISEARCH, NINIT, MADSPACE, ITER, TOL, &
+ SHIFT, DROPTOL, MEM, ICNTL, &
+ IJOB, NDX1, NDX2, IPRINT, INFO, GAP)
+ if (CONTROL_instance%CI_JACOBI ) then
+ fullMatrix = .false.
+ else
+ fullMatrix = .true.
+ end if
+!! your private matrix-vector multiplication
+
+ iiter = iiter +1
+ IF (IJOB.EQ.1) THEN
+ if ( CONTROL_instance%CI_BUILD_FULL_MATRIX ) then
+ call av ( n, x(ndx1), x(ndx2))
+ else
+ call matvec2 ( N, X(NDX1), X(NDX2), iiter)
+ end if
+
+ GOTO 10
+ END IF
+
+ !! saving the eigenvalues
+ eigenValues%values = EIGS
+
+ !! saving the eigenvectors
+ k = 0
+ do j = 1, maxeig
+ do i = 1, N
+ k = k + 1
+ eigenVectors%values(i,j) = X(k)
+ end do
+ end do
+
+! release internal memory and discard preconditioner
+ CALL PJDCLEANUP
+ if ( allocated ( x ) ) deallocate ( x )
+
+!$ timeB = omp_get_wtime()
+
+ end subroutine CIJadamilu_jadamiluInterface
+
+ subroutine matvec2 ( nx, v, w, iter)
+
+ !*******************************************************************************
+ !! AV computes w <- A * V where A is a discretized Laplacian.
+ ! Parameters:
+ ! Input, integer NX, the length of the vectors.
+ ! Input, real V(NX), the vector to be operated on by A.
+ ! Output, real W(NX), the result of A*V.
+ !
+ implicit none
+
+ integer(8) nx
+ real(8) v(nx)
+ real(8) w(nx)
+ real(8) :: CIEnergy
+ integer(8) :: nonzero
+ integer(8) :: i, j, ia, ib, ii, jj, iii, jjj
+ integer(4) :: nproc, n, nn
+ real(8) :: wi
+ real(8) :: timeA, timeB
+ real(8) :: tol
+ integer(4) :: iter, size1, size2
+ !integer(8), allocatable :: indexArray(:)
+ logical :: fullMatrix
+ integer :: ci
+ integer :: auxSize
+ integer(8) :: a,b,c
+ integer :: s, numberOfSpecies, auxnumberOfSpecies
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ integer(8), allocatable :: cc(:) !! ncore
+ integer(8), allocatable :: indexConf(:,:) !! ncore, species
+ integer(8), allocatable :: auxindexConf(:,:) !! ncore, species
+ integer, allocatable :: cilevel(:,:), auxcilevel(:,:)
+
+ call omp_set_num_threads(omp_get_max_threads())
+ nproc = omp_get_max_threads()
+
+
+ allocate( cc ( nproc ) )
+ cc = 0
+
+ nonzero = 0
+ w = 0
+ tol = CONTROL_instance%CI_MATVEC_TOLERANCE
+
+ do i = 1 , nx
+ if ( abs(v(i) ) >= tol) nonzero = nonzero + 1
+ end do
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+
+ allocate ( indexConf ( numberOfSpecies, nproc ) )
+ allocate ( auxindexConf ( numberOfSpecies, nproc ) )
+ allocate ( cilevel ( numberOfSpecies, nproc ) )
+ allocate ( auxcilevel ( numberOfSpecies, nproc ) )
+
+ cilevel = 0
+ auxcilevel = 0
+ indexConf = 0
+ auxindexConf = 0
+ !! call recursion
+ s = 0
+ c = 0
+ n = 1
+!$ timeA = omp_get_wtime()
+ do ci = 1, CIcore_instance%sizeCiOrderList
+ do nn = n, nproc
+ cilevel(:,nn) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ end do
+ s = 0
+ auxnumberOfSpecies = CIJadamilu_buildMatrixRecursion(nproc, s, indexConf, auxindexConf,cc, c, n, v, w, &
+ cilevel, auxcilevel )
+
+ end do
+
+ if ( n > 1 ) then
+ do nn = 1, n-1
+
+ call CIJadamilu_buildRow( nn, auxindexConf(:,nn), cc(nn), w, v(cc(nn)), auxcilevel(:,nn))
+ end do
+ end if
+
+ CIcore_instance%pindexConf = 0
+
+!$ timeB = omp_get_wtime()
+ deallocate ( cilevel )
+ deallocate ( auxindexConf )
+ deallocate ( indexConf )
+ deallocate ( cc )
+!$ write(*,"(A,I2,A,E10.3,A2,I12)") " ", iter, " ", timeB -timeA ," ", nonzero
+! stop
+ return
+
+ end subroutine matvec2
+
+ subroutine av ( nx, v, w)
+
+ !*******************************************************************************
+ !! AV computes w <- A * V where A is a discretized Laplacian.
+ ! Parameters:
+ ! Input, integer NX, the length of the vectors.
+ ! Input, real V(NX), the vector to be operated on by A.
+ ! Output, real W(NX), the result of A*V.
+ !
+ implicit none
+
+ integer(8) nx
+ real(8) v(nx)
+ real(8) w(nx)
+ character(50) :: CIFile
+ integer :: CIUnit
+ integer, allocatable :: jj(:)
+ real(8), allocatable :: CIEnergy(:)
+ integer :: nonzero,ii, kk
+ integer :: maxStackSize, i, ia, ib
+
+ CIFile = "lowdin.ci"
+ CIUnit = 20
+ nonzero = 0
+ maxStackSize = CONTROL_instance%CI_STACK_SIZE
+
+ w = 0
+#ifdef intel
+ open(unit=CIUnit, file=trim(CIFile), action = "read", form="unformatted", BUFFERED="YES")
+#else
+ open(unit=CIUnit, file=trim(CIFile), action = "read", form="unformatted")
+#endif
+
+ readmatrix : do
+ read (CIUnit) nonzero
+ if (nonzero > 0 ) then
+
+ read (CIUnit) ii
+
+ if ( allocated(jj)) deallocate (jj)
+ allocate (jj(nonzero))
+ jj = 0
+
+ if ( allocated(CIEnergy)) deallocate (CIEnergy)
+ allocate (CIEnergy(nonzero))
+ CIEnergy = 0
+
+ do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
+
+ ib = maxStackSize * i
+ ia = ib - maxStackSize + 1
+ if ( ib > nonZero ) ib = nonZero
+ read (CIUnit) jj(ia:ib)
+
+ end do
+
+ do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
+
+ ib = maxStackSize * i
+ ia = ib - maxStackSize + 1
+ if ( ib > nonZero ) ib = nonZero
+ read (CIUnit) CIEnergy(ia:ib)
+
+ end do
+
+ w(ii) = w(ii) + CIEnergy(1)*v(jj(1)) !! disk
+ do kk = 2, nonzero
+ !w(ii) = w(ii) + CIcore_calculateCIenergy(ii,jj(kk))*v(jj(kk)) !! direct
+ w(ii) = w(ii) + CIEnergy(kk)*v(jj(kk)) !! disk
+ w(jj(kk)) = w(jj(kk)) + CIEnergy(kk)*v(ii) !! disk
+ end do
+
+ else if ( nonzero == -1 ) then
+ exit readmatrix
+ end if
+ end do readmatrix
+
+!! memory
+! do i = 1, nx
+! w(:) = w(:) + CIcore_instance%hamiltonianMatrix%values(:,i)*v(i)
+! end do
+
+ close(CIUnit)
+
+ return
+ end subroutine av
+
+recursive function CIJadamilu_buildMatrixRecursion(nproc, s, indexConf, auxindexConf, cc, c, n, v, w, &
+ cilevel, auxcilevel) result (os)
+ implicit none
+
+ integer(8) :: a,c,aa
+ integer :: i, n, nn, nproc
+ integer :: s, numberOfSpecies
+ integer :: os,is,ss,ssize
+ integer(8) :: cc(:)
+ integer(8) :: indexConf(:,:)
+ integer(8) :: auxindexConf(:,:)
+ real(8) :: v(:)
+ real(8) :: w(:)
+ integer :: cilevel(:,:)
+ integer :: auxcilevel(:,:)
+
+ is = s + 1
+ !if ( is < numberOfSpecies ) then
+ do ss = 1, CIcore_instance%recursionVector1(is)
+ i = cilevel(is,n) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ indexConf(is,n:) = ssize + a
+ os = CIJadamilu_buildMatrixRecursion( nproc, is, indexConf, auxindexConf, cc, c, n, v, w, cilevel, auxcilevel )
+ end do
+ end do
+ !else
+ do ss = 1, CIcore_instance%recursionVector2(is)
+ os = is
+ i = cilevel(is,n) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ c = c + 1
+
+ if ( abs(v(c)) > CONTROL_instance%CI_MATVEC_TOLERANCE ) then
+ cc(n) = c
+ indexConf(is,n:) = ssize + a
+
+ auxindexConf = indexConf
+ auxcilevel = cilevel
+
+ if ( n == nproc ) then
+
+ !$omp parallel &
+ !$omp& private(nn),&
+ !$omp& shared(v,w, indexConf, cc, nproc, cilevel)
+ !$omp do schedule (static)
+ do nn = 1, nproc
+ call CIJadamilu_buildRow( nn, indexConf(:,nn), cc(nn), w, v(cc(nn)), cilevel(:,nn))
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+ n = 0
+
+ do nn = 1, nproc
+ indexConf(:,nn) = indexConf(:,nproc)
+ cilevel(:,nn) = cilevel(:,nproc)
+ end do
+ end if
+
+ n = n + 1
+
+ end if
+
+ end do
+ end do
+ !end if
+
+
+ end function CIJadamilu_buildMatrixRecursion
+
+ !! Alternative option to the recursion with the same computational cost... However, it may be helpul some day.
+
+ function CIJadamilu_buildMatrixRecursion2(nproc, s, indexConf, auxindexConf, cc, c, n, v, w, &
+ cilevel, auxcilevel) result (os)
+ implicit none
+
+ integer(8) :: a,c,aa, x
+ integer :: i, j, n, nn, nproc, ci
+ integer :: s, numberOfSpecies
+ integer :: os,is,ss,ssize
+ integer(8) :: cc(:)
+ integer(8) :: indexConf(:,:)
+ integer(8) :: auxindexConf(:,:)
+ real(8) :: v(:)
+ real(8) :: w(:)
+ integer :: cilevel(:,:)
+ integer(8) :: totalsize, auxtotalsize
+ integer :: auxcilevel(:,:)
+ integer, allocatable :: counter(:)
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+
+ allocate (counter(numberOfSpecies))
+ counter = 0
+
+ totalsize = 1
+ do i = 1 , numberOfSpecies
+ totalsize = totalsize * CIcore_instance%numberOfStrings(i)%values(cilevel(i,n) + 1)
+ end do
+
+ do i = 1 , numberOfSpecies
+ ci = cilevel(i,n) + 1
+ ssize = CIcore_instance%numberOfStrings2(i)%values(ci)
+ indexConf(i,n:) = ssize + 1
+ end do
+
+ indexConf(numberOfSpecies,n:) = indexConf(numberOfSpecies,n:) -1
+
+ do x = 1, totalsize
+
+ indexConf(numberOfSpecies,n:) = indexConf(numberOfSpecies,n:) + 1
+
+ do i = numberOfSpecies, 1 + 1, -1
+ auxtotalsize = 1
+ do j = i, numberOfSpecies
+ auxtotalsize = auxtotalsize * CIcore_instance%numberOfStrings(j)%values(cilevel(j,n) + 1)
+ end do
+ if (counter(i) == auxtotalsize) then
+ do j = i, numberOfSpecies
+ ci = cilevel(j,n) + 1
+ ssize = CIcore_instance%numberOfStrings2(j)%values(ci)
+ indexConf(j,n:) = ssize + 1
+ end do
+ counter(i) = 0
+ indexConf(i-1,n:) = indexConf(i-1,n:) + 1
+ end if
+ counter(i) = counter(i) + 1
+
+ end do
+ !print *, indexConf(:,1)
+ end do
+
+ deallocate (counter)
+
+ end function CIJadamilu_buildMatrixRecursion2
+
+ subroutine CIJadamilu_buildRow( nn, indexConfA, c, w, vc, cilevelA)
+ implicit none
+
+ integer(8) :: a,b,c,bb,ci,d,cj
+ integer :: u,v,uu,vv, p, nn
+ integer :: i, j, auxis,auxos,is, ii, aa
+ integer :: numberOfSpecies, s
+ integer, allocatable :: stringAinB(:)
+ integer(4) :: coupling
+ integer(4) :: coupling2
+ integer(4) :: ssize,auxcoupling(3) !! 0,1,2
+ integer(8) :: indexConfA(:)
+ integer(8), allocatable :: indexConfB(:)
+ integer(8), allocatable :: dd(:)
+ real(8) :: vc, CIenergy
+ real(8) :: w(:)
+ integer :: cilevelA(:)
+ integer, allocatable :: cilevel(:)
+
+
+ !CIcore_instance%pindexConf = 0
+
+ !!$ CIcore_instance%timeA(1) = omp_get_wtime()
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+
+ do i = 1, numberOfSpecies
+
+ if ( CIcore_instance%pindexConf(i,nn) /= indexConfA(i) ) then
+
+ CIcore_instance%nCouplingOneTwo(i,nn)%values = 0
+ auxcoupling = 0
+
+ !allocate (stringBinA (CIcore_instance%numberOfOccupiedOrbitals%values(i) ))
+ allocate (stringAinB (CIcore_instance%numberOfOccupiedOrbitals%values(i) ))
+
+ stringAinB = 0
+ !stringBinA = 0
+
+ a = indexConfA(i)
+
+ !!$ CIcore_instance%timeA(2) = omp_get_wtime()
+
+ ssize = 0
+ do ci = 1, size(CIcore_instance%numberOfStrings(i)%values, dim = 1)
+ do b = 1 + ssize , CIcore_instance%numberOfStrings(i)%values(ci) + ssize
+
+ !do p = CIcore_instance%numberOfCoreOrbitals%values(i)+1, &
+ ! CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ ! stringAinB(p) = CIcore_instance%orbitals(i)%values( &
+ ! CIcore_instance%strings(i)%values(p,a),b)
+ !end do
+
+ !coupling = CIcore_instance%numberOfOccupiedOrbitals%values(i) - sum ( stringAinB ) - CIcore_instance%numberOfCoreOrbitals%values(i)
+
+ !coupling = 0
+ !!$omp simd
+ !do p = CIcore_instance%numberOfCoreOrbitals%values(i)+1, CIcore_instance%numberOfOrbitals%values(i)
+ ! coupling = coupling + CIcore_instance%orbitals(i)%values(p,a) * CIcore_instance%orbitals(i)%values(p,b)
+ !end do
+ !coupling = CIcore_instance%numberOfOccupiedOrbitals%values(i) - coupling - CIcore_instance%numberOfCoreOrbitals%values(i)
+
+
+ coupling = CIcore_instance%numberOfOccupiedOrbitals%values(i) - sum(CIcore_instance%orbitals(i)%values(:,a) * CIcore_instance%orbitals(i)%values(:,b)) ! - CIcore_instance%numberOfCoreOrbitals%values(i)
+
+ !!$omp simd
+ !coupling = sum(abs(CIcore_instance%orbitals(i)%values(:,a) - CIcore_instance%orbitals(i)%values(:,b)))
+ !coupling = coupling / 2
+
+ if ( coupling <= 2 ) then
+
+ coupling = coupling + 1
+
+ auxcoupling(coupling) = auxcoupling(coupling) + 1
+
+ CIcore_instance%nCouplingOneTwo(i,nn)%values( coupling, ci) = &
+ CIcore_instance%nCouplingOneTwo(i,nn)%values( coupling, ci) + 1
+
+ CIcore_instance%couplingMatrix(i,nn)%values( auxcoupling(coupling), coupling ) = b
+ end if
+
+ end do
+
+ ssize = ssize + CIcore_instance%numberOfStrings(i)%values(ci)
+
+ end do
+
+ deallocate (stringAinB)
+ !deallocate (stringBinA)
+ end if
+
+ end do
+
+ !!$ CIcore_instance%timeB(1) = omp_get_wtime()
+
+ do is = 1, numberOfSpecies
+ do i = 1, 3 !! 0,1,2
+ ssize = 0
+ do ci = 1, size(CIcore_instance%numberOfStrings(is)%values, dim = 1) !! 1 is always zero
+ ssize = ssize + CIcore_instance%nCouplingOneTwo(is,nn)%values( i,ci )
+ CIcore_instance%nCouplingSize(is,nn)%values( i,ci+1 ) = ssize
+ end do
+ CIcore_instance%nCouplingSize(is,nn)%values( i,1 ) = 0 !0?
+ end do
+ end do
+
+
+ !!$ CIcore_instance%timeA(2) = omp_get_wtime()
+ allocate ( indexConfB ( numberOfSpecies ) )
+ allocate ( cilevel ( numberOfSpecies ) )
+ allocate ( dd ( numberOfSpecies ) )
+ indexConfB = 0
+
+ !!$ CIcore_instance%timeB(2) = omp_get_wtime()
+ !!$ CIcore_instance%timeA(3) = omp_get_wtime()
+
+ !!one diff same species
+ do i = 1, numberOfSpecies
+
+ if ( CIcore_instance%pindexConf(i,nn) /= indexConfA(i) ) then
+ cilevel(:) = 0
+ indexConfB = indexConfA
+
+ cilevel = cilevelA
+
+ do ci = 1, size(CIcore_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
+ cilevel(i) = ci - 1
+
+ if ( CIcore_instance%nCouplingOneTwo(i,nn)%values( 2,ci ) == 0 ) cycle
+ auxos = CIJadamilu_buildRowRecursionFirstOne( i, indexConfA, indexConfB, nn, cilevel )
+
+ end do
+ end if
+ end do
+
+ !!$ CIcore_instance%timeB(3) = omp_get_wtime()
+
+ !!$ CIcore_instance%timeA(4) = omp_get_wtime()
+ !$omp atomic
+ w(c) = w(c) + vc*CIcore_instance%diagonalHamiltonianMatrix%values(c)
+ !$omp end atomic
+
+ !!$ CIcore_instance%timeB(4) = omp_get_wtime()
+
+ !!$ CIcore_instance%timeA(5) = omp_get_wtime()
+ !! one diff
+ do i = 1, numberOfSpecies
+ cilevel(:) = 0
+ indexConfB = indexConfA
+
+ cilevel = cilevelA
+
+ do ci = 1, size(CIcore_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
+ cilevel(i) = ci - 1
+ if ( CIcore_instance%nCouplingOneTwo(i,nn)%values( 2,ci ) == 0 ) cycle
+ do u = 1, CIcore_instance%sizeciorderlist
+ if ( sum(abs(cilevel - &
+ CIcore_instance%ciorderlist( CIcore_instance%auxciorderlist(u), :))) == 0 ) then
+
+ uu = CIcore_instance%auxciorderlist(u)
+ dd = 0
+
+ auxos = CIJadamilu_buildRowRecursionSecondOne( i, indexConfB, w, vc, dd, nn, cilevel, uu )
+ exit
+
+ end if
+ end do
+ end do
+ end do
+
+ !!$ CIcore_instance%timeB(5) = omp_get_wtime()
+ !!$ CIcore_instance%timeA(6) = omp_get_wtime()
+
+ !! two diff same species
+ do i = 1, numberOfSpecies
+
+ cilevel(:) = 0
+ indexConfB = indexConfA
+ cilevel = cilevelA
+
+ do ci = 1, size(CIcore_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
+ cilevel(i) = ci - 1
+ if ( CIcore_instance%nCouplingOneTwo(i,nn)%values( 3,ci ) == 0 ) cycle
+ do u = 1, CIcore_instance%sizeCiOrderList
+ if ( sum(abs(cilevel - &
+ CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(u), :))) == 0 ) then
+ uu = CIcore_instance%auxciOrderList(u)
+ dd = 0
+
+ if ( CIcore_instance%pindexConf(i,nn) /= indexConfA(i) ) then
+ auxos = CIJadamilu_buildRowRecursionSecondTwoCal( i, indexConfA, indexConfB, w, vc, dd, nn, cilevel, uu )
+ else
+ auxos = CIJadamilu_buildRowRecursionSecondTwoGet( i, indexConfA, indexConfB, w, vc, dd, nn, cilevel, uu )
+ end if
+
+ exit
+
+ end if
+ end do
+ end do
+ end do
+
+ !!$ CIcore_instance%timeB(6) = omp_get_wtime()
+ !!$ CIcore_instance%timeA(7) = omp_get_wtime()
+
+ !! two diff diff species
+ do v = 1, CIcore_instance%ncouplingOrderTwoDiff
+
+ i = CIcore_instance%couplingOrderIndex(3,v)%values(1)
+ j = CIcore_instance%couplingOrderIndex(3,v)%values(2)
+
+ indexConfB = indexConfA
+ cilevel = cilevelA
+
+ do ci = 1, size(CIcore_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
+ cilevel(i) = ci - 1
+ if ( CIcore_instance%nCouplingOneTwo(i,nn)%values( 2,ci ) == 0 ) cycle
+ do cj = 1, size(CIcore_instance%numberOfStrings(j)%values, dim = 1) !! 1 is always zero
+ if ( CIcore_instance%nCouplingOneTwo(j,nn)%values( 2,cj ) == 0 ) cycle
+ cilevel(j) = cj - 1
+ do u = 1, CIcore_instance%sizeCiOrderList
+ if ( sum(abs(cilevel - &
+ CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(u), :))) == 0 ) then
+
+ uu = CIcore_instance%auxciOrderList(u)
+ dd = 0
+ auxos = CIJadamilu_buildRowRecursionSecondTwoDiff( i, j, indexConfB, w, vc, dd, nn, cilevel, uu )
+ exit
+ end if
+ end do
+ end do
+ end do
+ end do
+
+ !!$ CIcore_instance%timeB(7) = omp_get_wtime()
+
+ !!$ print *, "omptime"
+ !!$ print *, "1", CIcore_instance%timeB(1) - CIcore_instance%timeA(1)
+ !!$ print *, "2", CIcore_instance%timeB(2) - CIcore_instance%timeA(2)
+ !!$ print *, "3", CIcore_instance%timeB(3) - CIcore_instance%timeA(3)
+ !!$ print *, "4", CIcore_instance%timeB(4) - CIcore_instance%timeA(4)
+ !!$ print *, "5", CIcore_instance%timeB(5) - CIcore_instance%timeA(5)
+ !!$ print *, "6", CIcore_instance%timeB(6) - CIcore_instance%timeA(6)
+ !!$ print *, "7", CIcore_instance%timeB(7) - CIcore_instance%timeA(7)
+
+ CIcore_instance%pindexConf(:,nn) = indexConfA(:)
+
+ deallocate ( dd )
+ deallocate ( cilevel )
+ deallocate ( indexConfB )
+
+ end subroutine CIJadamilu_buildRow
+
+recursive function CIJadamilu_buildRowRecursionFirstOne( ii, indexConfA, indexConfB, nn, cilevel ) result (os)
+ implicit none
+
+ integer(8) :: a, aa
+ integer :: ii, nn, ci
+ integer :: os, ssize
+ integer(8) :: indexConfA(:)
+ integer(8) :: indexConfB(:)
+ real(8) :: CIenergy
+ integer :: cilevel(:)
+
+ ci = cilevel(ii) + 1
+ ssize = CIcore_instance%nCouplingSize(ii,nn)%values( 2,ci )
+ do aa = 1, CIcore_instance%nCouplingOneTwo(ii,nn)%values( 2,ci )
+ a = ssize + aa
+
+ indexConfB(ii) = CIcore_instance%couplingMatrix(ii,nn)%values(a, 2)
+ CIenergy = CIJadamilu_calculateEnergyOneSame ( nn, ii, indexConfA, indexConfB )
+ CIcore_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii)) = CIenergy
+
+ end do
+
+ end function CIJadamilu_buildRowRecursionFirstOne
+
+recursive function CIJadamilu_buildRowRecursionSecondOne( ii, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
+ implicit none
+
+ integer(8) :: a,d, aa
+ integer :: ii, nn, ci, u, j
+ integer :: ssize
+ integer :: os,numberOfSpecies
+ integer(8) :: indexConfB(:)
+ integer(8) :: dd(:)
+ real(8) :: vc
+ real(8) :: w(:)
+ real(8) :: CIenergy
+ integer :: cilevel(:)
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ ci = cilevel(ii) + 1
+ ssize = CIcore_instance%nCouplingSize(ii,nn)%values( 2,ci )
+
+ do j = 1, numberOfSpecies
+ dd(j) = (indexConfB(j) - CIcore_instance%numberOfStrings2(j)%values(cilevel(j)+1) + &
+ CIcore_instance%ciOrderSize1(u,j) )* CIcore_instance%ciOrderSize2(u,j)
+ end do
+
+ do aa = 1, CIcore_instance%nCouplingOneTwo(ii,nn)%values( 2,ci )
+ a = ssize + aa
+
+ indexConfB(ii) = CIcore_instance%couplingMatrix(ii,nn)%values(a, 2)
+
+ dd(ii) = (indexConfB(ii) - CIcore_instance%numberOfStrings2(ii)%values(ci) + &
+ CIcore_instance%ciOrderSize1(u,ii) )* CIcore_instance%ciOrderSize2(u,ii)
+
+ d = sum(dd)
+
+ CIenergy = CIcore_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii))
+ CIenergy = CIenergy + CIJadamilu_calculateEnergyOneDiff ( ii, indexConfB, nn )
+ CIenergy = vc*CIenergy
+
+ !$omp atomic
+ w(d) = w(d) + CIenergy
+ !$omp end atomic
+ end do
+
+ end function CIJadamilu_buildRowRecursionSecondOne
+
+
+ function CIJadamilu_buildRowRecursionSecondTwoCal( ii, indexConfA, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
+ implicit none
+
+ integer(8) :: a,d, aa
+ integer :: i, ii, nn, ci, u, j
+ integer :: s, ssize
+ integer :: os,numberOfSpecies
+ integer(8) :: indexConfA(:)
+ integer(8) :: indexConfB(:)
+ integer(8) :: dd(:)
+ real(8) :: vc
+ real(8) :: w(:)
+ real(8) :: CIenergy
+ integer :: cilevel(:)
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ ci = cilevel(ii) + 1
+ ssize = CIcore_instance%nCouplingSize(ii,nn)%values( 3,ci )
+
+ do j = 1, numberOfSpecies
+ dd(j) = (indexConfB(j) - CIcore_instance%numberOfStrings2(j)%values(cilevel(j)+1) + &
+ CIcore_instance%ciOrderSize1(u,j) )* CIcore_instance%ciOrderSize2(u,j)
+ end do
+
+ do aa = 1, CIcore_instance%nCouplingOneTwo(ii,nn)%values( 3,ci )
+ a = ssize + aa
+
+ indexConfB(ii) = CIcore_instance%couplingMatrix(ii,nn)%values(a, 3)
+ dd(ii) = (indexConfB(ii) - CIcore_instance%numberOfStrings2(ii)%values(ci) + &
+ CIcore_instance%ciOrderSize1(u,ii) )* CIcore_instance%ciOrderSize2(u,ii)
+
+ d = sum(dd)
+
+ !CIenergy = CIcore_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii))
+ CIenergy = CIJadamilu_calculateEnergyTwoSame ( ii, indexConfA(ii), indexConfB(ii) )
+ CIcore_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii)) = CIenergy
+ CIenergy = vc*CIenergy
+
+ !$omp atomic
+ w(d) = w(d) + CIenergy
+ !$omp end atomic
+ end do
+
+ end function CIJadamilu_buildRowRecursionSecondTwoCal
+
+ function CIJadamilu_buildRowRecursionSecondTwoGet( ii, indexConfA, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
+ implicit none
+
+ integer(8) :: a,d, aa
+ integer :: i, ii, nn, ci, u, j
+ integer :: s, ssize
+ integer :: os,numberOfSpecies
+ integer(8) :: indexConfA(:)
+ integer(8) :: indexConfB(:)
+ integer(8) :: dd(:)
+ real(8) :: vc
+ real(8) :: w(:)
+ real(8) :: CIenergy
+ integer :: cilevel(:)
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ ci = cilevel(ii) + 1
+ ssize = CIcore_instance%nCouplingSize(ii,nn)%values( 3,ci )
+
+ do j = 1, numberOfSpecies
+ dd(j) = (indexConfB(j) - CIcore_instance%numberOfStrings2(j)%values(cilevel(j)+1) + &
+ CIcore_instance%ciOrderSize1(u,j) )* CIcore_instance%ciOrderSize2(u,j)
+ end do
+
+ do aa = 1, CIcore_instance%nCouplingOneTwo(ii,nn)%values( 3,ci )
+ a = ssize + aa
+
+ indexConfB(ii) = CIcore_instance%couplingMatrix(ii,nn)%values(a, 3)
+ dd(ii) = (indexConfB(ii) - CIcore_instance%numberOfStrings2(ii)%values(ci) + &
+ CIcore_instance%ciOrderSize1(u,ii) )* CIcore_instance%ciOrderSize2(u,ii)
+
+ d = sum(dd)
+
+ CIenergy = CIcore_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii))
+ !CIenergy = CIcore_calculateEnergyTwoSame ( ii, indexConfA(ii), indexConfB(ii) )
+ CIenergy = vc*CIenergy
+
+ !$omp atomic
+ w(d) = w(d) + CIenergy
+ !$omp end atomic
+ end do
+
+ end function CIJadamilu_buildRowRecursionSecondTwoGet
+
+ function CIJadamilu_buildRowRecursionSecondTwoDiff( ii, jj, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
+ implicit none
+
+ integer, intent(in) :: ii, nn, u, jj
+ integer, intent(in) :: cilevel(:)
+ integer(8), intent(out) :: dd(:)
+ real(8), intent(in) :: vc
+ integer(8), intent(inout) :: indexConfB(:)
+ real(8), intent(inout) :: w(:)
+ integer(8) :: ai,aj,d, aai, aaj
+ integer :: ci, k, cj
+ integer(8) :: ssizei, ssizej
+ integer(8) :: dd_i_shift, dd_j_shift
+ integer :: bi, bj, factor, factori
+ integer :: auxIndex1, auxIndex2, auxIndex
+ integer :: os,numberOfSpecies
+ real(8) :: CIenergy
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ ci = cilevel(ii) + 1
+ cj = cilevel(jj) + 1
+ ssizei = CIcore_instance%nCouplingSize(ii,nn)%values( 2,ci )
+ ssizej = CIcore_instance%nCouplingSize(jj,nn)%values( 2,cj )
+
+ do k = 1, numberOfSpecies
+ dd(k) = (indexConfB(k) - CIcore_instance%numberOfStrings2(k)%values(cilevel(k)+1) + &
+ CIcore_instance%ciOrderSize1(u,k) )* CIcore_instance%ciOrderSize2(u,k)
+ end do
+
+ dd_i_shift = - CIcore_instance%numberOfStrings2(ii)%values(ci) + &
+ CIcore_instance%ciOrderSize1(u,ii)
+
+ dd_j_shift = - CIcore_instance%numberOfStrings2(jj)%values(cj) + &
+ CIcore_instance%ciOrderSize1(u,jj)
+
+ do aai = 1, CIcore_instance%nCouplingOneTwo(ii,nn)%values( 2,ci )
+ ai = ssizei + aai
+ indexConfB(ii) = CIcore_instance%couplingMatrix(ii,nn)%values(ai, 2)
+ dd(ii) = (indexConfB(ii) + dd_i_shift )* CIcore_instance%ciOrderSize2(u,ii)
+
+ bi = indexConfB(ii)
+ factori = CIcore_instance%couplingMatrixFactorOne(ii,nn)%values(bi)
+ auxIndex1 = CIcore_instance%couplingMatrixOrbOne(ii,nn)%values(bi)
+ auxIndex1 = CIcore_instance%numberOfSpatialOrbitals2%values(jj) * (auxIndex1 - 1 )
+
+ do aaj = 1, CIcore_instance%nCouplingOneTwo(jj,nn)%values( 2,cj )
+ aj = ssizej + aaj
+ indexConfB(jj) = CIcore_instance%couplingMatrix(jj,nn)%values(aj, 2)
+
+ dd(jj) = (indexConfB(jj) + dd_j_shift )* CIcore_instance%ciOrderSize2(u,jj)
+
+ d = sum(dd)
+ !CIenergy = vc*CIcore_calculateEnergyTwoDiff ( ii, jj, indexConfB, nn )
+
+ bj = indexConfB(jj)
+ factor = factori * CIcore_instance%couplingMatrixFactorOne(jj,nn)%values(bj)
+ auxIndex2 = CIcore_instance%couplingMatrixOrbOne(jj,nn)%values(bj)
+ auxIndex = auxIndex1 + auxIndex2
+
+ CIenergy = vc * factor *CIcore_instance%fourCenterIntegrals(ii,jj)%values(auxIndex, 1)
+ !CIenergy = vc*CIenergy
+
+ !$omp atomic
+ w(d) = w(d) + CIenergy
+ !$omp end atomic
+ end do
+ end do
+
+ end function CIJadamilu_buildRowRecursionSecondTwoDiff
+
+
+ function CIJadamilu_calculateEnergyOneSame( n, ii, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: a, b
+ integer :: i,j,s,n, nn,ii
+ integer :: l,k,z,kk,ll
+ integer :: factor, factor2, auxOcc, AA, BB
+ logical(1) :: equalA, equalB
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex2, auxIndex
+ integer :: diffOrb(2), otherdiffOrb(2) !! to avoid confusions
+ real(8) :: auxCIenergy
+
+ auxCIenergy = 0.0_8
+ factor = 1
+
+ !! copy a
+ a = thisA(ii)
+ b = thisB(ii)
+
+ diffOrb = 0
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,a),b) == 0 ) then
+ diffOrb(1) = CIcore_instance%strings(ii)%values(kk,a)
+ AA = kk
+ exit
+ end if
+ end do
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,b),a) == 0 ) then
+ diffOrb(2) = CIcore_instance%strings(ii)%values(kk,b)
+ BB = kk
+ exit
+ end if
+ end do
+
+ factor = (-1)**(AA-BB)
+
+ CIcore_instance%couplingMatrixFactorOne(ii,n)%values(b) = factor
+
+ !One particle terms
+
+ auxCIenergy= auxCIenergy + CIcore_instance%twoCenterIntegrals(ii)%values( diffOrb(1), diffOrb(2) )
+
+ !! save the different orbitals
+
+ auxIndex1= CIcore_instance%twoIndexArray(ii)%values( diffOrb(1), diffOrb(2))
+ CIcore_instance%couplingMatrixOrbOne(ii,n)%values(b) = auxIndex1
+
+ do ll=1, CIcore_instance%occupationNumber( ii ) !! the same orbitals pair are excluded by the exchange
+
+ l = CIcore_instance%strings(ii)%values(ll,b) !! or a
+
+ auxIndex2 = CIcore_instance%twoIndexArray(ii)%values( l,l)
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( auxIndex1, auxIndex2 )
+
+ auxCIenergy = auxCIenergy + CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( &
+ CIcore_instance%twoIndexArray(ii)%values(diffOrb(1),l), &
+ CIcore_instance%twoIndexArray(ii)%values(l,diffOrb(2)) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(ii)%kappa*CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ end do
+
+ !end if
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CIJadamilu_calculateEnergyOneSame
+
+ function CIJadamilu_calculateEnergyOneDiff( ii, thisB, nn ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisB(:)
+ integer(8) :: b
+ integer :: i,j,ii, nn
+ integer :: l,ll
+ integer :: factor
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer :: auxIndex1, auxIndex11, auxIndex
+ real(8) :: auxCIenergy
+
+ auxCIenergy = 0.0_8
+
+ b = thisB(ii)
+
+ auxIndex1 = CIcore_instance%couplingMatrixOrbOne(ii,nn)%values(b)
+ factor = CIcore_instance%couplingMatrixFactorOne(ii,nn)%values(b)
+
+ do j=1, ii - 1 !! avoid ii, same species
+
+ b = thisB(j)
+
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+ auxIndex11 = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 )
+
+ do ll=1, CIcore_instance%occupationNumber( j )
+
+ l = CIcore_instance%strings(j)%values(ll,b)
+
+ auxIndex = auxIndex11 + CIcore_instance%twoIndexArray(j)%values( l,l)
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(ii,j)%values(auxIndex, 1)
+
+ end do
+
+ end do
+
+ do j= ii + 1, MolecularSystem_instance%numberOfQuantumSpecies!! avoid ii, same species
+
+ b = thisB(j)
+
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+
+ auxIndex11 = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 )
+
+ do ll=1, CIcore_instance%occupationNumber( j )
+
+ l = CIcore_instance%strings(j)%values(ll,b)
+
+ auxIndex = auxIndex11 + CIcore_instance%twoIndexArray(j)%values( l,l)
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(ii,j)%values(auxIndex, 1)
+ end do
+
+ end do
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CIJadamilu_calculateEnergyOneDiff
+
+
+ function CIJadamilu_calculateEnergyTwoSame( ii, a, b ) result (auxCIenergy)
+ implicit none
+ integer(8) :: a, b
+ integer :: ii
+ integer :: kk,z
+ integer :: factor, AA(2), BB(2)
+ integer(8) :: auxIndex
+ integer :: diffOrbA(2), diffOrbB(2) !! to avoid confusions
+ real(8) :: auxCIenergy
+
+ !diffOrbA = 0
+ !diffOrbB = 0
+ z = 0
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,a),b) == 0 ) then
+ z = z + 1
+ diffOrbA(z) = CIcore_instance%strings(ii)%values(kk,a)
+ AA(z) = kk
+ if ( z == 2 ) exit
+ end if
+ end do
+
+ z = 0
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,b),a) == 0 ) then
+ z = z + 1
+ diffOrbB(z) = CIcore_instance%strings(ii)%values(kk,b)
+ BB(z) = kk
+ if ( z == 2 ) exit
+ end if
+ end do
+
+ factor = (-1)**(AA(1)-BB(1) + AA(2) - BB(2) )
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( &
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(1),diffOrbB(1)),&
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(2),diffOrbB(2)) )
+
+ auxCIenergy = CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( &
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(1),diffOrbB(2)),&
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(2),diffOrbB(1)) )
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(ii)%kappa*CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CIJadamilu_calculateEnergyTwoSame
+
+end module CIJadamilu_
diff --git a/src/CI/CIOrder.f90 b/src/CI/CIOrder.f90
new file mode 100644
index 00000000..84850344
--- /dev/null
+++ b/src/CI/CIOrder.f90
@@ -0,0 +1,368 @@
+module CIOrder_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use CIcore_
+
+contains
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CIOrder_settingCILevel()
+ implicit none
+
+ integer :: numberOfSpecies
+ integer :: i,ii,j,k,l,m,n,p,q,a,b,d,r,s
+ integer(8) :: c, cc
+ integer :: ma,mb,mc,md,me,pa,pb,pc,pd,pe
+ integer :: isLambdaEqual1
+ type(ivector) :: order
+ type(vector), allocatable :: occupiedCode(:)
+ type(vector), allocatable :: unoccupiedCode(:)
+ integer, allocatable :: auxArray(:,:), auxvector(:),auxvectorA(:)
+ integer :: lambda, otherlambda
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ if ( allocated( occupiedCode ) ) deallocate( occupiedCode )
+ allocate (occupiedCode ( numberOfSpecies ) )
+ if ( allocated( unoccupiedCode ) ) deallocate( unoccupiedCode )
+ allocate (unoccupiedCode ( numberOfSpecies ) )
+
+ !1 auxiliary string for omp paralelization
+ do n = 1, CIcore_instance%nproc
+ do i = 1, numberOfSpecies
+ call Vector_constructorInteger( CIcore_instance%auxstring(n,i), &
+ int(CIcore_instance%numberOfOccupiedOrbitals%values(i),4), int(0,4))
+ end do
+ end do
+
+ select case ( trim(CIcore_instance%level) )
+
+ case ( "FCI" )
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+
+ CIcore_instance%maxCILevel = sum(CIcore_instance%CILevel)
+
+ case ( "SCI" ) !! same as FCI
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+
+ CIcore_instance%maxCILevel = sum(CIcore_instance%CILevel)
+
+ case ( "CIS" )
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 1
+ end do
+ CIcore_instance%maxCILevel = 1
+
+ case ( "CISD" )
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 2
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) < 2 ) &
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ CIcore_instance%maxCILevel = 2
+
+ case ( "CISD+" )
+
+ if ( .not. numberOfSpecies == 3 ) call CIOrder_exception( ERROR, "CIOrder setting CI level ", "CISD+ is specific for three quantum species")
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 2
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) < 2 ) &
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ CIcore_instance%maxCILevel = 2
+
+ case ( "CISD+2" )
+
+ if ( .not. numberOfSpecies == 4 ) call CIOrder_exception( ERROR, "CIOrder setting CI level", "CISD+2 is specific for three quantum species")
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 2
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) < 2 ) &
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ CIcore_instance%maxCILevel = 2
+
+ case ("CISDT")
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 3
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) < 3 ) &
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ CIcore_instance%maxCILevel = 3
+
+ case ("CISDTQ")
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 4
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) < 4 ) &
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ CIcore_instance%maxCILevel = 4
+
+ case ("CISDTQQ")
+
+ do i=1, numberOfSpecies
+ CIcore_instance%CILevel(i) = 5
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) < 5 ) &
+ CIcore_instance%CILevel(i) = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ CIcore_instance%maxCILevel = 5
+
+ case default
+
+ call CIOrder_exception( ERROR, "Configuration interactor constructor", "Correction level not implemented")
+
+ end select
+
+ if ( CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT == "CISD" .and. trim(CIcore_instance%level) /= "CISD" ) then
+
+ call CIOrder_exception( ERROR, "Configuration interactor constructor", "DDCISD shift are only valid for CISD level!")
+
+ end if
+
+
+ end subroutine CIOrder_settingCILevel
+
+
+
+
+!! Build the CI table with all combinations of excitations between quantum species.
+ subroutine CIOrder_buildCIOrderList()
+ implicit none
+
+ integer :: c
+ integer :: i,j, u,v
+ integer :: ci, ii, jj
+ integer(8) :: output, auxsize
+ integer :: numberOfSpecies, auxnumberOfSpecies,s
+ integer(1) :: coupling
+ real(8) :: timeA, timeB
+ integer :: ncouplingOrderOne
+ integer :: ncouplingOrderTwo
+ logical :: includecilevel, same
+ integer(8) :: ssize, auxssize
+ integer, allocatable :: cilevel(:), auxcilevel(:)
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ !! Allocate size considering all possible combinations, FCI.
+ ssize = 1
+ do i = 1, numberOfSpecies
+ ssize = ssize * (CIcore_instance%CILevel(i) + 1)
+ end do
+
+ allocate ( CIcore_instance%ciOrderList( ssize, numberOfSpecies ) )
+ allocate ( CIcore_instance%ciOrderSize1( ssize, numberOfSpecies ) )
+ allocate ( CIcore_instance%ciOrderSize2( ssize, numberOfSpecies ) )
+ allocate ( CIcore_instance%auxciOrderList( ssize ) )
+
+ CIcore_instance%ciOrderList = 0
+ CIcore_instance%auxciOrderList = 0
+
+ CIcore_instance%ciOrderSize1 = -1 !! I have reasons... -1 for all species except the last one
+ CIcore_instance%ciOrderSize2 = 1 !! and 1 for the last species
+
+ CIcore_instance%sizeCiOrderList = 0
+
+ allocate ( ciLevel ( numberOfSpecies ) )
+ allocate ( auxciLevel ( numberOfSpecies ) )
+ ciLevel = 0
+ auxciLevel = 0
+ s = 0
+ c = 0
+ !! Search which combinations of excitations satifies the desired CI level.
+ auxnumberOfSpecies = CIOrder_buildCIOrderRecursion( s, numberOfSpecies, c, cilevel )
+
+
+ !! Print list
+ write (6,"(T2,A)") "--------------------------"
+ write (6,"(T2,A)") "CI level \ Species"
+ write (6,"(T2,A)") "--------------------------"
+ do u = 1, CIcore_instance%sizeCiOrderList
+ do i = 1, numberOfSpecies
+ write (6,"(T2,I4)",advance="no") CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(u), i)
+ end do
+ write (6,"(A)") ""
+ end do
+ write (6,"(T2,A)") "--------------------------"
+
+ !! Calculates the three required factors in order to get the position of any given configuration.
+ !! position = S1 + (indexConf(i,u) - numberOfStrings2(i) -1 )*S2(i,u)
+ !! i: speciesID, u: cilevelID
+
+ !! Factor S1
+ ssize = 0
+ do u = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(u), :)
+
+ ssize = 0
+ do v = 1, u-1
+
+ auxcilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(v), :)
+ auxnumberOfSpecies = CIOrder_getIndexSize(0, ssize, auxcilevel)
+
+ end do
+
+ CIcore_instance%ciOrderSize1(CIcore_instance%auxciOrderList(u),:) = -1
+ CIcore_instance%ciOrderSize1(CIcore_instance%auxciOrderList(u),numberOfSpecies) = ssize !!just the last
+
+ end do
+
+ !! Factor S2
+ do i = 1, numberOfSpecies-1
+ do u = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(u), :)
+ ssize = 1
+ do j = i+1, numberOfSpecies
+ ssize = ssize * CIcore_instance%numberOfStrings(j)%values(cilevel(j)+1)
+ end do
+
+ CIcore_instance%ciOrderSize2(CIcore_instance%auxciOrderList(u),i) = ssize
+
+ end do
+ end do
+
+ CIcore_instance%ciOrderSize2(:,numberOfSpecies) = 1
+
+ deallocate ( auxcilevel )
+ deallocate ( cilevel )
+
+ end subroutine CIOrder_buildCIOrderList
+
+ !! Search which combinations of excitations satifies the desired CI level.
+recursive function CIOrder_buildCIOrderRecursion( s, numberOfSpecies, c, cilevel ) result (os)
+ implicit none
+
+ integer :: u,v,c
+ integer :: i, j, ii, jj, nn, k, l
+ integer :: s, numberOfSpecies
+ integer :: os,is,auxis, auxos
+ integer :: cilevel(:)
+ integer :: plusOne(3,3) , plusTwo(4,6)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ do i = 1, size(CIcore_instance%numberOfStrings(is)%values, dim = 1)
+ cilevel(is) = i - 1
+ os = CIOrder_buildCIOrderRecursion( is, numberOfSpecies, c, cilevel )
+ end do
+ cilevel(is) = 0
+ else
+ do i = 1, size(CIcore_instance%numberOfStrings(is)%values, dim = 1)
+ cilevel(is) = i - 1
+ c = c + 1
+
+ CIcore_instance%ciOrderList( c, : ) = cilevel(:)
+ if ( sum(cilevel) <= CIcore_instance%maxCIlevel ) then
+ CIcore_instance%sizeCiOrderList = CIcore_instance%sizeCiOrderList + 1
+ CIcore_instance%auxciOrderList( CIcore_instance%sizeCiOrderList ) = c
+ end if
+
+ if ( trim(CIcore_instance%level) == "CISD+" ) then !!special case.
+ plusOne(:,1) = (/1,1,1/)
+ plusOne(:,2) = (/2,0,1/)
+ plusOne(:,3) = (/0,2,1/)
+
+ do k = 1, 3
+ if ( sum( abs(cilevel(:) - plusOne(:,k)) ) == 0 ) then
+ CIcore_instance%sizeCiOrderList = CIcore_instance%sizeCiOrderList + 1
+ CIcore_instance%auxciOrderList( CIcore_instance%sizeCiOrderList ) = c
+ end if
+ end do
+
+ end if
+
+ if ( trim(CIcore_instance%level) == "CISD+2" ) then !!special case.
+ plusTwo(:,1) = (/1,1,1,0/)
+ plusTwo(:,2) = (/1,1,0,1/)
+ plusTwo(:,3) = (/2,0,1,0/)
+ plusTwo(:,4) = (/2,0,0,1/)
+ plusTwo(:,5) = (/0,2,1,0/)
+ plusTwo(:,6) = (/0,2,0,1/)
+
+ do k = 1, 6
+ if ( sum( abs(cilevel(:) - plusTwo(:,k)) ) == 0 ) then
+ CIcore_instance%sizeCiOrderList = CIcore_instance%sizeCiOrderList + 1
+ CIcore_instance%auxciOrderList( CIcore_instance%sizeCiOrderList ) = c
+ end if
+ end do
+
+ end if
+
+ end do
+ cilevel(is) = 0
+ end if
+
+ end function CIOrder_buildCIOrderRecursion
+
+recursive function CIOrder_getIndexSize(s, c, auxcilevel) result (os)
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: i, j, ii, jj, ss
+ integer :: s, numberOfSpecies
+ integer :: os,is,cc, ssize
+ integer :: auxcilevel(:)
+
+ is = s + 1
+ do ss = 1, CIcore_instance%recursionVector1(is)
+ i = auxcilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ os = CIOrder_getIndexSize( is, c, auxcilevel )
+ end do
+ end do
+ do ss = 1, CIcore_instance%recursionVector2(is)
+ os = is
+ i = auxcilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+ c = c + CIcore_instance%numberOfStrings(is)%values(i)
+ end do
+
+ end function CIOrder_getIndexSize
+
+ !>
+ !! @brief Maneja excepciones de la clase
+ !<
+ subroutine CIOrder_exception( typeMessage, description, debugDescription)
+ implicit none
+ integer :: typeMessage
+ character(*) :: description
+ character(*) :: debugDescription
+
+ type(Exception) :: ex
+
+ call Exception_constructor( ex , typeMessage )
+ call Exception_setDebugDescription( ex, debugDescription )
+ call Exception_setDescription( ex, description )
+ call Exception_show( ex )
+ call Exception_destructor( ex )
+
+ end subroutine CIOrder_exception
+
+
+end module CIOrder_
diff --git a/src/CI/CISCI.f90 b/src/CI/CISCI.f90
new file mode 100644
index 00000000..dd1ce794
--- /dev/null
+++ b/src/CI/CISCI.f90
@@ -0,0 +1,1027 @@
+module CISCI_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use CIcore_
+ use CIJadamilu_
+ use CIInitial_
+ use omp_lib
+ implicit none
+
+ type, public :: CISCI
+ type (Vector8) :: amplitudeCore
+ type (Vector8) :: amplitudeCore2
+ type (Vector8) :: coefficientCore
+ type (Matrix) :: coefficientTarget
+ type (Vector8) :: auxcoefficientTarget
+ type (Vector8) :: diagonalTarget
+ type (Vector8) :: eigenValues
+ integer :: coreSpaceSize
+ integer :: targetSpaceSize
+ real(8) :: PT2energy
+ end type CISCI
+
+ type(CISCI) :: CISCI_instance
+
+contains
+
+ subroutine CISCI_show()
+
+ write (6,*) ""
+ write (6,"(T2,A62)") " SELECTED CONFIGURATION INTERACTION (SCI): "
+ write (6,"(T2,A62)") " Adaptive Sampling CI (ASCI) "
+ write (6,"(T2,A62)") " Deterministic Algorithm "
+ write (6,"(T2,A62)") " Based on 10.1063/1.4955109 "
+
+ write(6,*) ""
+ write(6,*) " Diagonalizer for target space hamiltonian : ", trim(String_getUppercase((CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
+ write(6,*) "============================================================="
+ write(6,*) "M. BOLLHÖFER AND Y. NOTAY, JADAMILU:"
+ write(6,*) "a software code for computing selected eigenvalues of "
+ write(6,*) "large sparse symmetric matrices, "
+ write(6,*) "Computer Physics Communications, vol. 177, pp. 951-964, 2007."
+ write(6,*) "============================================================="
+
+ write (6,*) ""
+ write (6,"(T2,A,F14.5,A3 )") "Estimated memory needed: ", float(CIcore_instance%numberOfConfigurations*3*8)/(1024**3) , " GB"
+ write (6,*) ""
+
+ end subroutine CISCI_show
+
+ !! Allocating arrays
+ subroutine CISCI_constructor()
+ implicit none
+
+ type(Configuration) :: auxConfigurationA, auxConfigurationB
+ integer :: a,b,c,aa,bb,i
+ real(8) :: CIenergy
+ integer :: nproc
+
+ CISCI_instance%coreSpaceSize = CONTROL_instance%CI_SCI_CORE_SPACE
+ CISCI_instance%targetSpaceSize = CONTROL_instance%CI_SCI_TARGET_SPACE
+
+ !! copy and destroying diagonal vector... because of the intial matrix subroutine
+ call Vector_constructor8 ( CIcore_instance%diagonalHamiltonianMatrix, &
+ CIcore_instance%numberOfConfigurations, 0.0_8 )
+ CIcore_instance%diagonalHamiltonianMatrix%values = CIcore_instance%diagonalHamiltonianMatrix2%values
+ call Vector_destructor8 ( CIcore_instance%diagonalHamiltonianMatrix2 )
+
+
+ !!This will carry the index changes after sorting configurations
+ call Vector_constructorInteger8 ( CIcore_instance%auxIndexCIMatrix, &
+ CIcore_instance%numberOfConfigurations, 0_8 ) !hmm
+
+ do a = 1, CIcore_instance%numberOfConfigurations
+ CIcore_instance%auxIndexCIMatrix%values(a)= a
+ end do
+
+ !! auxiliary array to get the index vector to build a configuration. get the configurations for the hamiltonian matrix in the core and target space
+ call CISCI_getInitialIndexes( CIcore_instance%coreConfigurations, CIcore_instance%coreConfigurationsLevel, CISCI_instance%coreSpaceSize )
+ call CISCI_getInitialIndexes( CIcore_instance%targetConfigurations, CIcore_instance%targetConfigurationsLevel, CISCI_instance%targetSpaceSize )
+
+ !! arrays for CISCI
+ call Vector_constructor8 ( CISCI_instance%amplitudeCore, CIcore_instance%numberOfConfigurations, 0.0_8)
+ call Vector_constructor8 ( CISCI_instance%coefficientCore, int(CISCI_instance%coreSpaceSize,8), 0.0_8)
+ call Matrix_constructor ( CISCI_instance%coefficientTarget, int(CISCI_instance%targetSpaceSize,8), &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+ call Vector_constructor8 ( CISCI_instance%auxcoefficientTarget, int(CISCI_instance%targetSpaceSize,8), 0.0_8) !! meh... just to avoid changing everything from matrix to vector format
+ call Vector_constructor8 ( CISCI_instance%diagonalTarget, int(CISCI_instance%targetSpaceSize,8), 0.0_8) !! Jadamilu requires to store diagonal vector (in target space)
+ call Vector_constructor8 ( CISCI_instance%eigenValues, 15_8, 0.0_8) !! store the eigenvalues per macro iterations
+
+ end subroutine CISCI_constructor
+
+ !! main part
+ subroutine CISCI_run()
+ implicit none
+ integer(8) :: i, j, ii, jj
+ integer :: k ! macro SCI iteration
+ real(8) :: timeA(15), timeB(15)
+ real(8) :: timeAA, timeBB
+ type(Vector8) :: eigenValuesTarget
+ real(8) :: currentEnergy
+
+ currentEnergy = HartreeFock_instance%totalEnergy
+ call Vector_constructor8 ( eigenValuesTarget, int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ !! HF determinant coefficient
+ CISCI_instance%coefficientCore%values(1) = 1.0_8
+ CISCI_instance%coefficientTarget%values(1,1) = 1.0_8
+ CIcore_instance%eigenVectors%values(1,1) = 1.0_8
+ CISCI_instance%eigenValues%values(1) = HartreeFock_instance%totalEnergy
+
+ write (6,*) ""
+ write (6,"(T2,A29 )") "Starting SCI macro iterations "
+ write (6,*) ""
+ do k = 2, 15
+
+!$ timeA(k) = omp_get_wtime()
+
+ !! calculating the amplitudes in core space. This is the pertubation guess of CI eigenvector
+ CISCI_instance%amplitudeCore%values = 0.0_8
+ call CISCI_core_amplitudes ( CISCI_instance%amplitudeCore%values, CIcore_instance%numberOfConfigurations, &
+ CISCI_instance%coefficientCore%values, CISCI_instance%coreSpaceSize, currentEnergy )
+
+ !! setting the HF again... because the HF amplitude diverges
+ if ( k == 2 ) CISCI_instance%amplitudeCore%values(1) = 1.0_8
+
+ !! resetting the original index changes
+ do i = 1, CIcore_instance%numberOfConfigurations
+ CIcore_instance%auxIndexCIMatrix%values(i)= i
+ end do
+
+ !! getting the target absolute largest coefficients
+ call Vector_sortElementsAbsolute8( CISCI_instance%amplitudeCore, &
+ CIcore_instance%auxIndexCIMatrix, int( CISCI_instance%targetSpaceSize ,8) )
+
+ !! recover the configurations for the hamiltonian matrix in the target space
+ call CISCI_getInitialIndexes( CIcore_instance%targetConfigurations, CIcore_instance%targetConfigurationsLevel, CISCI_instance%targetSpaceSize )
+
+ !! storing only the largest diagonal elements (for jadamilu)
+ do i = 1, CISCI_instance%targetSpaceSize
+ ii = CIcore_instance%auxIndexCIMatrix%values(i)
+ !! storing only the largest diagonal elements (for jadamilu)
+ CISCI_instance%diagonalTarget%values(i) = CIcore_instance%diagonalHamiltonianMatrix%values(ii)
+ enddo
+
+ !! using the amplitued as the initial coeff guess, after that, use the previous diganolized eigenvectors in target space
+ if ( k == 2 ) then
+ do i = 1, CISCI_instance%targetSpaceSize
+ ii = CIcore_instance%auxIndexCIMatrix%values(i)
+ CISCI_instance%coefficientTarget%values(i,1) = CISCI_instance%amplitudeCore%values(ii)
+ enddo
+ else
+ do i = 1, CISCI_instance%targetSpaceSize
+ ii = CIcore_instance%auxIndexCIMatrix%values(i)
+ CISCI_instance%coefficientTarget%values(i,1) = CIcore_instance%eigenVectors%values(ii,1)
+ enddo
+ end if
+
+ !! eigenvalue guess
+ eigenValuesTarget%values(1) = currentEnergy
+
+ !! diagonalize in target space
+ call CISCI_jadamiluInterface( int(CISCI_instance%targetSpaceSize,8), &
+ 1_8, &
+ eigenValuesTarget, &
+ CISCI_instance%coefficientTarget, timeAA, timeBB )
+
+ !! saving the eigenvectors coeff to an aux vector. Only ground state
+ CISCI_instance%auxcoefficientTarget%values(:) = CISCI_instance%coefficientTarget%values(:,1)
+
+ !! updating the full eigenvector with the solution in the target space
+ CIcore_instance%eigenVectors%values(:,1) = 0.0_8
+ do i = 1, CISCI_instance%targetSpaceSize
+ ii = CIcore_instance%auxIndexCIMatrix%values(i)
+ CIcore_instance%eigenVectors%values(ii,1) = CISCI_instance%coefficientTarget%values(i,1)
+ end do
+
+ !! convergence criteria
+ CISCI_instance%eigenValues%values(k) = eigenValuesTarget%values(1)
+ if ( abs( CISCI_instance%eigenValues%values(k) - currentEnergy ) < 1.0E-5 ) then
+ write (6,"(T2,A10,I4,A8,F25.12)") "SCI Iter: ", k , " Energy: ", CISCI_instance%eigenValues%values(k)
+ !$ timeB(k) = omp_get_wtime()
+ exit
+ end if
+
+ !! getting the core absolute largest coefficients
+ call Vector_sortElementsAbsolute8( CISCI_instance%auxcoefficientTarget, &
+ CIcore_instance%auxIndexCIMatrix, int( CISCI_instance%coreSpaceSize ,8) )
+
+ !! recover the configurations for the hamiltonian matrix in the core space
+ call CISCI_getInitialIndexes( CIcore_instance%coreConfigurations, CIcore_instance%coreConfigurationsLevel, CISCI_instance%coreSpaceSize )
+ !! call CISCI_getInitialIndexes( CIcore_instance%fullConfigurations, CIcore_instance%fullConfigurationsLevel , int(CIcore_instance%numberOfConfigurations,4) )
+
+ !! storing only the largest coefficients, and rearraing the next eigenvector guess
+ do i = 1, CISCI_instance%coreSpaceSize
+ CISCI_instance%coefficientCore%values(i) = CISCI_instance%auxcoefficientTarget%values(i)
+ enddo
+
+ !! restart amplitudes for next run
+ CISCI_instance%amplitudeCore%values = 0.0_8
+ write (6,"(T2,A10,I4,A8,F25.12)") "SCI Iter: ", k , " Energy: ", CISCI_instance%eigenValues%values(k)
+
+!$ timeB(k) = omp_get_wtime()
+ !! updating new reference
+ currentEnergy = eigenValuesTarget%values(1)
+
+ enddo !k
+
+ !! summary of the macro iteration
+ write (6,*) ""
+ write (6,"(T2,A95 )") " Selected CI (SCI) summary "
+ write (6,"(T2,A95 )") "Iter Ground-State Energy Correlation Energy Energy Diff. Time(s) "
+ do k = 2, 15
+ write (6,"(T2,I2, F25.12, F25.12, F25.12, F16.4 )") k-1, CISCI_instance%eigenValues%values(k), &
+ CISCI_instance%eigenValues%values(k) - HartreeFock_instance%totalEnergy, &
+ CISCI_instance%eigenValues%values(k) - CISCI_instance%eigenValues%values(k-1), &
+ timeB(k) - timeA(k)
+ if ( abs( CISCI_instance%eigenValues%values(k) - CISCI_instance%eigenValues%values(k-1) ) < 1.0E-5 ) then
+ CIcore_instance%eigenvalues%values(1) = CISCI_instance%eigenValues%values(k)
+ exit
+ endif
+ enddo !k
+
+ !! calculating PT2 correction. A pertuberd estimation of configurations not include in the target space
+ call CISCI_PT2 ( CIcore_instance%eigenVectors%values(:,1), CISCI_instance%amplitudeCore%values, &
+ CISCI_instance%targetSpaceSize, CIcore_instance%numberOfConfigurations, &
+ CISCI_instance%eigenValues%values(k), CISCI_instance%PT2energy )
+
+ write (6,*) ""
+ write (6,"(T2,A,F25.12)") "CI-PT2 energy correction :", CISCI_instance%PT2energy
+
+ end subroutine CISCI_run
+
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ !! Map the indexes of initial CI matrix to the complete matrix.
+ subroutine CISCI_getInitialIndexes( auxConfigurationMatrix, auxConfigurationLevel, auxMatrixSize )
+ implicit none
+
+ type(imatrix) :: auxConfigurationMatrix
+ type(imatrix) :: auxConfigurationLevel
+ integer :: auxMatrixSize
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: ci
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies, auxnumberOfSpecies
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer(8), allocatable :: indexConf(:)
+ integer, allocatable :: cilevel(:)
+
+!$ timeA = omp_get_wtime()
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ s = 0
+ c = 0
+
+ call Matrix_constructorInteger ( auxConfigurationMatrix, int( numberOfSpecies,8), &
+ int(auxMatrixSize,8), 0 )
+ call Matrix_constructorInteger ( auxConfigurationLevel, int( numberOfSpecies,8), &
+ int(auxMatrixSize,8), 0 )
+
+ !! call recursion
+ allocate ( cilevel ( numberOfSpecies ) )
+ allocate ( indexConf ( numberOfSpecies ) )
+
+ s = 0
+ c = 0
+ indexConf = 0
+ cilevel = 0
+
+ do ci = 1, CIcore_instance%sizeCiOrderList
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ auxnumberOfSpecies = CISCI_getIndexesRecursion( auxConfigurationMatrix, auxConfigurationLevel, auxMatrixSize, s, numberOfSpecies, indexConf, c, cilevel )
+ end do
+
+ deallocate ( indexConf )
+ deallocate ( cilevel )
+
+!$ timeB = omp_get_wtime()
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for getting sorted indexes : ", timeB - timeA ," (s)"
+
+ end subroutine CISCI_getInitialIndexes
+
+
+recursive function CISCI_getIndexesRecursion(auxConfigurationMatrix, auxConfigurationLevel, auxMatrixSize, s, numberOfSpecies, indexConf, c, cilevel) result (os)
+ implicit none
+
+ type(imatrix) :: auxConfigurationMatrix
+ type(imatrix) :: auxConfigurationLevel
+ integer :: auxMatrixSize
+ integer(8) :: a,b,c
+ integer :: u,v
+ integer :: i, j, ii, jj
+ integer :: s, ss, numberOfSpecies
+ integer :: os,is
+ integer :: size1, size2
+ integer(8) :: indexConf(:)
+ integer(1) :: coupling
+ integer :: ssize
+ integer :: cilevel(:)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ indexConf(is) = ssize + a
+ os = CISCI_getIndexesRecursion( auxConfigurationMatrix, auxConfigurationLevel, auxMatrixSize, is, numberOfSpecies, indexConf, c, cilevel)
+
+ end do
+ else
+ os = is
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ c = c + 1
+ indexConf(is) = ssize + a
+ do u = 1, auxMatrixSize
+ if ( c == CIcore_instance%auxIndexCIMatrix%values(u) ) then
+ do ss = 1, numberOfSpecies
+ auxConfigurationMatrix%values(ss,u) = indexConf(ss)
+ auxConfigurationLevel%values(ss,u) = cilevel(ss) !? check...
+ end do
+ exit
+ end if
+ end do
+ end do
+ end if
+
+ end function CISCI_getIndexesRecursion
+
+
+ subroutine CISCI_core_amplitudes ( amplitudeCore, numberOfConfigurations, coefficientCore, SCICoreSpaceSize, oldEnergy )
+
+ implicit none
+
+ integer(4) SCICoreSpaceSize
+ integer(8) numberOfConfigurations
+ real(8) amplitudeCore ( numberOfConfigurations )
+ real(8) coefficientCore ( SCICoreSpaceSize )
+ real(8) :: CIEnergy
+ integer(8) :: nonzero
+ integer(8) :: i, j, ia, ib, ii, jj, iii, jjj
+ integer(4) :: nproc, n, nn
+ real(8) :: wi
+ real(8) :: timeA, timeB
+ real(8) :: tol
+ integer(4) :: iter, size1, size2
+ integer :: ci
+ integer :: auxSize
+ integer(8) :: a,b,c, aa
+ integer :: s, numberOfSpecies
+ integer(8), allocatable :: indexConfA(:) !! ncore, species
+ integer, allocatable :: cilevel(:)
+ real(8) :: diagEnergy
+ real(8) :: oldEnergy
+ real(8) :: shift
+
+!$ timeA = omp_get_wtime()
+ call omp_set_num_threads(omp_get_max_threads())
+ nproc = omp_get_max_threads()
+ shift = 1E-6 !! to avoid divergence
+! shift = 0.0_8
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+
+ allocate ( indexConfA ( numberOfSpecies ) )
+ allocate ( cilevel ( numberOfSpecies ) )
+
+ cilevel = 0
+ indexConfA = 0
+
+ !$omp parallel &
+ !$omp& private( n, a, aa, cilevel, indexConfA, diagEnergy ),&
+ !$omp& shared( amplitudeCore, coefficientCore, oldEnergy )
+ !$omp do schedule (static)
+ do a = 1, SCICoreSpaceSize
+ aa = CIcore_instance%auxIndexCIMatrix%values(a)
+ cilevel = CIcore_instance%coreConfigurationsLevel%values(:,a)
+ indexConfA = CIcore_instance%coreConfigurations%values(:,a)
+ n = OMP_GET_THREAD_NUM() + 1
+
+ !! using jadamilu subroutine to calculate all configurations coupled to configuration a
+ call CIJadamilu_buildRow( n, indexConfA, aa, amplitudeCore, coefficientCore(a), cilevel )
+
+ !! removing diagonal term
+ amplitudeCore(aa) = amplitudeCore(aa) - CIcore_instance%diagonalHamiltonianMatrix%values(aa) * coefficientCore(a)
+
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+
+ do b = 1, CIcore_instance%numberOfConfigurations
+ amplitudeCore(b) = amplitudeCore(b) / ( CIcore_instance%diagonalHamiltonianMatrix%values(b) - oldEnergy + shift )
+ end do
+
+ CIcore_instance%pindexConf = 0
+!$ timeB = omp_get_wtime()
+ deallocate ( cilevel )
+ deallocate ( indexConfA )
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for calculating SCI amplitudes : ", timeB - timeA ," (s)"
+
+ end subroutine CISCI_core_amplitudes
+
+ subroutine CISCI_jadamiluInterface(n, maxeig, eigenValues, eigenVectors, timeA, timeB)
+ implicit none
+ external DPJDREVCOM
+ integer(8) :: maxnev
+ real(8) :: CIenergy
+ integer(8) :: nproc
+ type(Vector8), intent(inout) :: eigenValues
+ type(Matrix), intent(inout) :: eigenVectors
+
+! N: size of the problem
+! MAXEIG: max. number of wanteg eig (NEIG<=MAXEIG)
+! MAXSP: max. value of MADSPACE
+ integer(8) :: n, maxeig, MAXSP
+ integer(8) :: LX
+ real(8), allocatable :: EIGS(:), RES(:), X(:)!, D(:)
+! arguments to pass to the routines
+ integer(8) :: NEIG, MADSPACE, ISEARCH, NINIT
+ integer(8) :: JA(1), IA(1)
+ integer(8) :: ICNTL(5)
+ integer(8) :: ITER, IPRINT, INFO
+ real(8) :: SIGMA, TOL, GAP, MEM, DROPTOL, SHIFT
+ integer(8) :: NDX1, NDX2, NDX3
+ integer(8) :: IJOB! some local variables
+ integer(8) :: auxSize
+ integer(4) :: size1,size2
+ integer(8) :: I,J,K,ii,jj,jjj
+ integer(4) :: iiter
+ logical :: fullMatrix
+ real(8) :: timeA, timeB
+
+!$ timeA = omp_get_wtime()
+ maxsp = CONTROL_instance%CI_MADSPACE
+
+ LX = N*(3*MAXSP+MAXEIG+1)+4*MAXSP*MAXSP
+
+ if ( allocated ( eigs ) ) deallocate ( eigs )
+ allocate ( eigs ( maxeig ) )
+ eigs = 0.0_8
+ if ( allocated ( res ) ) deallocate ( res )
+ allocate ( res ( maxeig ) )
+ res = 0.0_8
+ if ( allocated ( x ) ) deallocate ( x )
+ allocate ( x ( lx ) )
+ x = 0.0_8
+
+! set input variables
+ IPRINT = 0 ! standard report on standard output
+ ISEARCH = 1 ! we want the smallest eigenvalues
+ NEIG = maxeig ! number of wanted eigenvalues
+ !NINIT = 0 ! no initial approximate eigenvectors
+ NINIT = NEIG ! initial approximate eigenvectors
+ MADSPACE = maxsp ! desired size of the search space
+ ITER = 1000*NEIG ! maximum number of iteration steps
+ TOL = CONTROL_instance%CI_CONVERGENCE !1.0d-4 ! tolerance for the eigenvector residual
+ TOL = 1e-3 !1.0d-4 ! tolerance for the eigenvector residual, for ASCI this can be higher
+
+ NDX1 = 0
+ NDX2 = 0
+ MEM = 0
+
+! additional parameters set to default
+ ICNTL(1)=0
+ ICNTL(2)=0
+ ICNTL(3)=0
+ ICNTL(4)=0
+ ICNTL(5)=1
+
+ IJOB=0
+
+ JA(1) = -1
+ IA(1) = -1
+
+ ! set initial eigenpairs
+ do j = 1, n
+ X(j) = eigenVectors%values(j,1)
+ end do
+
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ EIGS(i) = eigenValues%values(i)
+ end do
+
+ DROPTOL = 1E-4
+
+ SIGMA = EIGS(1)
+ gap = 0
+ SHIFT = 0!EIGS(1)
+
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ write(6,"(T2,A5,I4,2X,A10,F20.10,2X,A11,F20.10)") "State", i, "Eigenvalue", eigs( i ), "Eigenvector", x((i-1)*n + i)
+ end do
+
+ iiter = 0
+
+10 CALL DPJDREVCOM( N, CISCI_instance%diagonalTarget%values , JA, IA, EIGS, RES, X, LX, NEIG, &
+ SIGMA, ISEARCH, NINIT, MADSPACE, ITER, TOL, &
+ SHIFT, DROPTOL, MEM, ICNTL, &
+ IJOB, NDX1, NDX2, IPRINT, INFO, GAP)
+ if (CONTROL_instance%CI_JACOBI ) then
+ fullMatrix = .false.
+ else
+ fullMatrix = .true.
+ end if
+
+!! your private matrix-vector multiplication
+ iiter = iiter +1
+ IF (IJOB.EQ.1) THEN
+ call CISCI_matvec ( N, X(NDX1), X(NDX2), iiter)
+ GOTO 10
+ END IF
+
+ !! saving the eigenvalues
+ eigenValues%values = EIGS
+
+ !! saving the eigenvectors
+ k = 0
+ do j = 1, maxeig
+ do i = 1, N
+ k = k + 1
+ eigenVectors%values(i,j) = X(k)
+ end do
+ end do
+
+! release internal memory and discard preconditioner
+ CALL PJDCLEANUP
+ if ( allocated ( x ) ) deallocate ( x )
+
+!$ timeB = omp_get_wtime()
+
+ end subroutine CISCI_jadamiluInterface
+
+ subroutine CISCI_matvec ( nx, v, w, iter)
+
+ !*******************************************************************************
+ !! AV computes w <- A * V where A is a discretized Laplacian.
+ ! Parameters:
+ ! Input, integer NX, the length of the vectors.
+ ! Input, real V(NX), the vector to be operated on by A.
+ ! Output, real W(NX), the result of A*V.
+ !
+ implicit none
+
+ integer(8) nx
+ real(8) v(nx)
+ real(8) w(nx)
+ integer(4) :: iter
+ integer(8) :: a,b,aa,bb
+ integer(8) :: nonzero, nonzerow
+ real(8) :: tol
+ integer :: uu,vv
+ integer :: i, ii, jj, n
+ integer :: numberOfSpecies
+ real(8) :: timeA, timeB
+ real(8) :: CIenergy
+ real(8) :: CIenergy2
+ integer(1) :: coupling
+ integer(1), allocatable :: orbitalsA(:,:), orbitalsB(:,:), couplingS(:)
+ integer :: initialCIMatrixSize
+ integer :: nproc
+ integer(8), allocatable :: indexConfA(:)
+ integer(8), allocatable :: indexConfB(:)
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ call omp_set_num_threads(omp_get_max_threads())
+ nproc = omp_get_max_threads()
+
+ allocate ( couplingS ( numberOfSpecies ) )
+ allocate ( indexConfA ( numberOfSpecies ) )
+ allocate ( indexConfB ( numberOfSpecies ) )
+ allocate (orbitalsA ( maxval(CIcore_instance%numberOfOrbitals%values(:)), numberOfSpecies))
+ allocate (orbitalsB ( maxval(CIcore_instance%numberOfOrbitals%values(:)), numberOfSpecies))
+
+
+ nonzero = 0
+ nonzerow = 0
+ w = 0.0_8
+ tol = CONTROL_instance%CI_MATVEC_TOLERANCE
+ do a = 1 , nx
+ if ( abs(v(a) ) >= tol) nonzero = nonzero + 1
+ end do
+
+!$ timeA= omp_get_wtime()
+
+ !$omp parallel &
+ !$omp& private( a, aa, b, bb, uu, vv, coupling, couplingS, CIenergy, i, ii, jj, orbitalsA, orbitalsB),&
+ !$omp& firstprivate( indexConfA, indexConfB ),&
+ !$omp& shared( v, nx, numberOfSpecies, tol ) reduction (+:w)
+ !$omp do schedule (dynamic)
+ do a = 1, nx
+
+ indexConfA = CIcore_instance%targetConfigurations%values(:,a)
+
+ orbitalsA = 0
+ do i = 1, numberOfSpecies
+ do uu = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ orbitalsA( CIcore_instance%strings(i)%values(uu,indexConfA(i) ), i ) = 1
+ end do
+ end do
+
+ do b = a, nx
+
+ couplingS = 0
+ indexConfB(:) = CIcore_instance%targetConfigurations%values(:,b)
+
+ orbitalsB = 0
+ do i = 1, numberOfSpecies
+ do vv = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ orbitalsB( CIcore_instance%strings(i)%values(vv,indexConfB(i) ), i ) = 1
+ end do
+ end do
+
+ do i = 1, numberOfSpecies
+ couplingS(i) = couplingS(i) + &
+ CIcore_instance%numberOfOccupiedOrbitals%values(i) - sum ( orbitalsA(:,i) * orbitalsB(:,i) ) + 1
+ end do
+
+ coupling = product(couplingS)
+
+ select case (coupling)
+
+ case(1)
+ CIenergy = CISCI_instance%diagonalTarget%values(a)
+ w(a) = w(a) + CIEnergy*v(a)
+
+ case(2)
+ do i = 1, numberOfSpecies
+ if ( couplingS(i) == 2 ) ii = i
+ end do
+
+ CIenergy = CISCI_calculateEnergyOne ( ii, indexConfA, indexConfB )
+ w(b) = w(b) + CIenergy * v(a)
+ w(a) = w(a) + CIenergy * v(b)
+
+ case(3)
+ do i = 1, numberOfSpecies
+ if ( couplingS(i) == 3 ) ii = i
+ end do
+
+ CIenergy = CISCI_calculateEnergyTwoSame ( ii, indexConfA, indexConfB )
+ w(b) = w(b) + CIenergy * v(a)
+ w(a) = w(a) + CIenergy * v(b)
+
+ case(4)
+ do i = 1, numberOfSpecies
+ if ( couplingS(i) == 2 ) then
+ ii = i
+ exit
+ end if
+ end do
+ do i = ii+1, numberOfSpecies
+ if ( couplingS(i) == 2 ) jj = i
+ end do
+ CIenergy = CISCI_calculateEnergyTwoDiff ( ii, jj, indexConfA, indexConfB )
+ w(b) = w(b) + CIenergy * v(a)
+ w(a) = w(a) + CIenergy * v(b)
+
+ end select
+
+ end do !b
+ end do !a
+ !$omp end do nowait
+ !$omp end parallel
+
+!$ timeB = omp_get_wtime()
+ !! to check how dense is the w vector
+ do a = 1 , nx
+ if ( abs(w(a) ) >= tol) nonzerow = nonzerow + 1
+ end do
+ !stop
+ deallocate (orbitalsA )
+ deallocate (orbitalsB )
+ deallocate ( indexConfB )
+ deallocate ( indexConfA )
+ deallocate ( couplingS )
+
+!$ write(*,"(A,I2,A,E10.3,A2,I12,I12)") " ", iter, " ", timeB -timeA ," ", nonzero, nonzerow
+ return
+
+ end subroutine CISCI_matvec
+
+ function CISCI_calculateEnergyOne( ii, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: a, b
+ integer :: i,j,s,n, nn,ii
+ integer :: l,k,z,kk,ll
+ integer :: factor, factor2, auxOcc, AA, BB
+ logical(1) :: equalA, equalB
+ integer :: auxnumberOfOtherSpecieSpatialOrbitals
+ integer(8) :: auxIndex1, auxIndex11, auxIndex2, auxIndex
+ integer :: diffOrb(2), otherdiffOrb(2) !! to avoid confusions
+ real(8) :: auxCIenergy
+
+ auxCIenergy = 0.0_8
+ factor = 1
+
+ !! copy a
+ a = thisA(ii)
+ b = thisB(ii)
+
+ diffOrb = 0
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,a),b) == 0 ) then
+ diffOrb(1) = CIcore_instance%strings(ii)%values(kk,a)
+ AA = kk
+ exit
+ end if
+ end do
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,b),a) == 0 ) then
+ diffOrb(2) = CIcore_instance%strings(ii)%values(kk,b)
+ BB = kk
+ exit
+ end if
+ end do
+
+ factor = (-1)**(AA-BB)
+
+ !One particle terms
+
+ auxCIenergy= auxCIenergy + CIcore_instance%twoCenterIntegrals(ii)%values( diffOrb(1), diffOrb(2) )
+
+ !! save the different orbitals
+
+ auxIndex1= CIcore_instance%twoIndexArray(ii)%values( diffOrb(1), diffOrb(2))
+
+ do ll=1, CIcore_instance%occupationNumber( ii ) !! the same orbitals pair are excluded by the exchange
+
+ l = CIcore_instance%strings(ii)%values(ll,b) !! or a
+
+ auxIndex2 = CIcore_instance%twoIndexArray(ii)%values( l,l)
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( auxIndex1, auxIndex2 )
+
+ auxCIenergy = auxCIenergy + CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( &
+ CIcore_instance%twoIndexArray(ii)%values(diffOrb(1),l), &
+ CIcore_instance%twoIndexArray(ii)%values(l,diffOrb(2)) )
+
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(ii)%kappa*CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ end do
+
+ !end if
+ do j=1, ii - 1 !! avoid ii, same species
+
+ b = thisB(j)
+
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+ auxIndex11 = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 )
+
+ do ll=1, CIcore_instance%occupationNumber( j )
+
+ l = CIcore_instance%strings(j)%values(ll,b)
+
+ auxIndex = auxIndex11 + CIcore_instance%twoIndexArray(j)%values( l,l)
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(ii,j)%values(auxIndex, 1)
+
+ end do
+
+ end do
+
+ do j= ii + 1, MolecularSystem_instance%numberOfQuantumSpecies!! avoid ii, same species
+
+ b = thisB(j)
+
+ auxnumberOfOtherSpecieSpatialOrbitals = CIcore_instance%numberOfSpatialOrbitals2%values(j)
+
+ auxIndex11 = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 )
+
+ do ll=1, CIcore_instance%occupationNumber( j )
+
+ l = CIcore_instance%strings(j)%values(ll,b)
+
+ auxIndex = auxIndex11 + CIcore_instance%twoIndexArray(j)%values( l,l)
+
+ auxCIenergy = auxCIenergy + &
+ CIcore_instance%fourCenterIntegrals(ii,j)%values(auxIndex, 1)
+ end do
+
+ end do
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CISCI_calculateEnergyOne
+
+ function CISCI_calculateEnergyTwoSame( ii, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: a, b
+ integer :: ii
+ integer :: kk,z
+ integer :: factor, AA(2), BB(2)
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: auxIndex
+ integer :: diffOrbA(2), diffOrbB(2) !! to avoid confusions
+ real(8) :: auxCIenergy
+
+ a = thisA(ii)
+ b = thisB(ii)
+ !diffOrbA = 0
+ !diffOrbB = 0
+ z = 0
+ auxCIenergy = 0.0_8
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,a),b) == 0 ) then
+ z = z + 1
+ diffOrbA(z) = CIcore_instance%strings(ii)%values(kk,a)
+ AA(z) = kk
+ if ( z == 2 ) exit
+ end if
+ end do
+
+ z = 0
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,b),a) == 0 ) then
+ z = z + 1
+ diffOrbB(z) = CIcore_instance%strings(ii)%values(kk,b)
+ BB(z) = kk
+ if ( z == 2 ) exit
+ end if
+ end do
+
+ factor = (-1)**(AA(1)-BB(1) + AA(2) - BB(2) )
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( &
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(1),diffOrbB(1)),&
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(2),diffOrbB(2)) )
+
+ auxCIenergy = CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ auxIndex = CIcore_instance%fourIndexArray(ii)%values( &
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(1),diffOrbB(2)),&
+ CIcore_instance%twoIndexArray(ii)%values(&
+ diffOrbA(2),diffOrbB(1)) )
+ auxCIenergy = auxCIenergy + &
+ MolecularSystem_instance%species(ii)%kappa*CIcore_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
+
+ auxCIenergy= auxCIenergy * factor
+
+ end function CISCI_calculateEnergyTwoSame
+
+ function CISCI_calculateEnergyTwoDiff( ii, jj, thisA, thisB ) result (auxCIenergy)
+ implicit none
+ integer(8) :: a, b
+ integer :: ii, jj
+ integer :: kk,z
+ integer :: factori, factorj, AA, BB
+ integer(8) :: thisA(:), thisB(:)
+ integer(8) :: auxIndex, auxIndex1, auxIndex2
+ integer :: diffOrb(2)
+ real(8) :: auxCIenergy
+
+ a = thisA(ii)
+ b = thisB(ii)
+
+ diffOrb = 0
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,a),b) == 0 ) then
+ diffOrb(1) = CIcore_instance%strings(ii)%values(kk,a)
+ AA = kk
+ exit
+ end if
+ end do
+
+ do kk = 1, CIcore_instance%occupationNumber(ii)
+ if ( CIcore_instance%orbitals(ii)%values( &
+ CIcore_instance%strings(ii)%values(kk,b),a) == 0 ) then
+ diffOrb(2) = CIcore_instance%strings(ii)%values(kk,b)
+ BB = kk
+ exit
+ end if
+ end do
+
+ factori = (-1)**(AA-BB)
+ auxIndex1= CIcore_instance%twoIndexArray(ii)%values( diffOrb(1), diffOrb(2))
+ auxIndex1 = CIcore_instance%numberOfSpatialOrbitals2%values(jj) * (auxIndex1 - 1 )
+
+ a = thisA(jj)
+ b = thisB(jj)
+
+ diffOrb = 0
+
+ do kk = 1, CIcore_instance%occupationNumber(jj)
+ if ( CIcore_instance%orbitals(jj)%values( &
+ CIcore_instance%strings(jj)%values(kk,a),b) == 0 ) then
+ diffOrb(1) = CIcore_instance%strings(jj)%values(kk,a)
+ AA = kk
+ exit
+ end if
+ end do
+
+ do kk = 1, CIcore_instance%occupationNumber(jj)
+ if ( CIcore_instance%orbitals(jj)%values( &
+ CIcore_instance%strings(jj)%values(kk,b),a) == 0 ) then
+ diffOrb(2) = CIcore_instance%strings(jj)%values(kk,b)
+ BB = kk
+ exit
+ end if
+ end do
+
+ factorj = (-1)**(AA-BB)
+
+ auxIndex2= CIcore_instance%twoIndexArray(jj)%values( diffOrb(1), diffOrb(2))
+ auxIndex = auxIndex1 + auxIndex2
+
+ auxCIenergy = factori * factorj *CIcore_instance%fourCenterIntegrals(ii,jj)%values(auxIndex, 1)
+
+ end function CISCI_calculateEnergyTwoDiff
+
+ subroutine CISCI_PT2 ( coefficients, auxenergyCorrection, SCITargetSpaceSize, numberOfConfigurations, refEnergy, energyCorrection )
+
+ !*******************************************************************************
+ !! AV computes w <- A * V where A is a discretized Laplacian.
+ ! Parameters:
+ ! Input, integer NX, the length of the vectors.
+ ! Input, real V(NX), the vector to be operated on by A.
+ ! Output, real W(NX), the result of A*V.
+ !
+ implicit none
+ integer :: SCITargetSpaceSize
+ integer(8) numberOfConfigurations
+ real(8) :: coefficients ( numberOfConfigurations )
+ real(8) :: auxenergyCorrection ( numberOfConfigurations )
+ real(8) :: refEnergy
+ real(8) :: energyCorrection
+ real(8) :: CIEnergy
+ integer(8) :: nonzero
+ integer(8) :: i, j, ia, ib, ii, jj, iii, jjj
+ integer(4) :: nproc, n, nn
+ real(8) :: wi
+ real(8) :: timeA, timeB
+ real(8) :: tol
+ integer(4) :: iter, size1, size2
+ integer :: ci
+ integer :: auxSize
+ integer(8) :: a,b,c, aa, bb
+ integer :: s, numberOfSpecies
+ integer(8), allocatable :: indexConfA(:) !! ncore, species
+ integer, allocatable :: cilevel(:)
+ real(8) :: diagEnergy
+ real(8) :: oldEnergy
+ real(8) :: shift
+
+ call omp_set_num_threads(omp_get_max_threads())
+ nproc = omp_get_max_threads()
+!$ timeA = omp_get_wtime()
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+
+ allocate ( indexConfA ( numberOfSpecies ) )
+ allocate ( cilevel ( numberOfSpecies ) )
+
+ cilevel = 0
+ indexConfA = 0
+ energyCorrection = 0.0_8
+ auxenergyCorrection = 0.0_8
+
+ !$omp parallel &
+ !$omp& private( n, a, aa, cilevel, indexConfA ),&
+ !$omp& shared( auxenergyCorrection, coefficients, refEnergy )
+ !$omp do schedule (static)
+ do a = 1, SCITargetSpaceSize
+ aa = CIcore_instance%auxIndexCIMatrix%values(a)
+ cilevel = CIcore_instance%targetConfigurationsLevel%values(:,a)
+ indexConfA = CIcore_instance%targetConfigurations%values(:,a)
+ n = OMP_GET_THREAD_NUM() + 1
+
+ !! using jadamilu subroutine to calculate all configurations coupled to configuration a
+ call CIJadamilu_buildRow( n, indexConfA, aa, auxenergyCorrection, coefficients(aa), cilevel )
+
+ !! removing the contributions from configurations within the target space
+ do b = 1, SCITargetSpaceSize
+ bb = CIcore_instance%auxIndexCIMatrix%values(b)
+ auxenergyCorrection(bb) = 0.0_8
+ enddo
+
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+
+ do b = 1, numberOfConfigurations
+ energyCorrection = energyCorrection + auxenergyCorrection(b) **2 / ( refEnergy - CIcore_instance%diagonalHamiltonianMatrix%values(b) )
+ enddo
+
+
+ CIcore_instance%pindexConf = 0
+!$ timeB = omp_get_wtime()
+ deallocate ( cilevel )
+ deallocate ( indexConfA )
+!$ write(*,"(A,E10.3)") "Time for CI-PT2 correction: ", timeB -timeA
+
+ end subroutine CISCI_PT2
+
+end module CISCI_
diff --git a/src/CI/CIStrings.f90 b/src/CI/CIStrings.f90
new file mode 100644
index 00000000..16603832
--- /dev/null
+++ b/src/CI/CIStrings.f90
@@ -0,0 +1,262 @@
+module CIStrings_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use CIcore_
+
+contains
+
+ subroutine CIStrings_buildStrings()
+ implicit none
+
+ integer(8) :: a,b,c,c1,c2,aa,d
+ integer :: ci, oci, cilevel,maxcilevel
+ integer :: u,uu,vv, p, nn,z
+ integer :: i,j
+ integer :: numberOfSpecies, auxnumberOfSpecies,s
+ type(ivector) :: order
+ integer(8) :: ssize
+ real(8) :: timeA, timeB
+ type(vector), allocatable :: occupiedCode(:)
+ type(vector), allocatable :: unoccupiedCode(:)
+
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ if ( allocated( occupiedCode ) ) deallocate( occupiedCode )
+ allocate (occupiedCode ( numberOfSpecies ) )
+ if ( allocated( unoccupiedCode ) ) deallocate( unoccupiedCode )
+ allocate (unoccupiedCode ( numberOfSpecies ) )
+
+ call Vector_constructorInteger (order, numberOfSpecies, 0 )
+ order%values = 0
+
+ s = 0
+ do i = 1, numberOfSpecies
+
+ call Vector_constructorInteger8 (CIcore_instance%numberOfStrings(i), &
+ int(CIcore_instance%CILevel(i) + 1,8), 0_8)
+
+ CIcore_instance%numberOfStrings(i)%values(1) = 1 !! ground
+
+ write (*,"(A,A)") " ", MolecularSystem_getNameOfSpecies(i)
+
+ do cilevel = 1,CIcore_instance%CILevel(i)
+
+ call Vector_constructor (occupiedCode(i), cilevel, real(CIcore_instance%numberOfCoreOrbitals%values(i),8) )
+ call Vector_constructor (unoccupiedCode(i), cilevel, 0.0_8)
+
+ unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i) ! it's also a lower bound in a for loop
+
+ if ( cilevel <= CIcore_instance%numberOfOccupiedOrbitals%values(i) ) then
+
+ !! just get the number of strings...
+ ci = 0
+ oci = CIStrings_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel)
+
+ write (*,"(A,I4,I8)") " ", cilevel, CIcore_instance%numberOfStrings(i)%values(cilevel+1)
+
+ end if
+ end do
+ write (*,"(A,I8)") " Total:", sum(CIcore_instance%numberOfStrings(i)%values)
+ write (*,"(A)") ""
+
+ !! allocate the strings arrays
+ if ( CIcore_instance%numberOfOccupiedOrbitals%values(i) > 0 ) then
+ call Matrix_constructorInteger( CIcore_instance%strings(i), &
+ int(CIcore_instance%numberOfOccupiedOrbitals%values(i),8), &
+ sum(CIcore_instance%numberOfStrings(i)%values), int(0,4))
+
+ call Matrix_constructorInteger1( CIcore_instance%orbitals(i), &
+ int(CIcore_instance%numberOfOrbitals%values(i),8), &
+ sum(CIcore_instance%numberOfStrings(i)%values), 0_1)
+
+ else
+ call Matrix_constructorInteger( CIcore_instance%strings(i), &
+ 1_8, 1_8, int(0,4))
+ call Matrix_constructorInteger1( CIcore_instance%orbitals(i), &
+ 1_8, 1_8, 0_1)
+
+ end if
+
+ !! zero, build the reference
+ call Vector_constructorInteger (order, numberOfSpecies, 0 )
+
+ call Vector_constructor (occupiedCode(i), 1, 0.0_8) !! initialize in zero
+ call Vector_constructor (unoccupiedCode(i), 1, 0.0_8)
+
+ c = 0
+ c = c + 1
+ call Configuration_constructorB(CIcore_instance%strings(i), CIcore_instance%orbitals(i), &
+ occupiedCode, unoccupiedCode, i, c, order)
+
+ !! now build the strings
+ do cilevel = 1,CIcore_instance%CILevel(i)
+
+ call Vector_constructorInteger (order, numberOfSpecies, 0 )
+ order%values(i) = cilevel
+
+ call Vector_constructor (occupiedCode(i), cilevel, real(CIcore_instance%numberOfCoreOrbitals%values(i),8) )
+ call Vector_constructor (unoccupiedCode(i), cilevel, 0.0_8)
+
+ unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i) ! it's also a lower bound in a for loop
+
+ if ( cilevel <= CIcore_instance%numberOfOccupiedOrbitals%values(i) ) then
+
+ !! recursion to build the strings
+ ci = 0
+ oci = CIStrings_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel, order, c)
+
+ end if
+ end do
+
+ end do
+
+ !! useful array
+ do i = 1, numberOfSpecies
+ CIcore_instance%sumstrings(i) = sum(CIcore_instance%numberOfStrings(i)%values)
+ end do
+
+ !! useful array, save the total number of string for a previous CI level.
+ do i = 1, numberOfSpecies
+ call Vector_constructorInteger8 (CIcore_instance%numberOfStrings2(i), &
+ int(size(CIcore_instance%numberOfStrings(i)%values, dim = 1) + 1,8), 0_8)
+
+ ssize = 0
+ do j = 1, size(CIcore_instance%numberOfStrings(i)%values, dim = 1) !
+ ssize = ssize + CIcore_instance%numberOfStrings(i)%values(j)
+ CIcore_instance%numberOfStrings2(i)%values(j+1) = ssize
+ end do
+ CIcore_instance%numberOfStrings2(i)%values(1) = 0
+ end do
+
+
+ end subroutine CIStrings_buildStrings
+
+!! This is just to get the total number of strings...
+recursive function CIStrings_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ici, cilevel ) result (oci)
+ implicit none
+
+ integer :: i, numberOfSpecies
+ integer :: ci, ici, oci, cilevel
+ integer :: m, a
+ type(vector), allocatable :: occupiedCode(:)
+ type(vector), allocatable :: unoccupiedCode(:)
+
+ ci = ici + 1
+
+ if ( ci == 1 .and. ci < cilevel ) then ! first
+ do m = int(occupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ oci = CIStrings_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel )
+ end do
+ unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ else if ( ci > 1 .and. ci < cilevel ) then ! mid
+ do m = int(occupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ oci = CIStrings_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel )
+ end do
+ end do
+
+ else if ( ci == 1 .and. ci == cilevel ) then ! mid
+ do m = int(occupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ CIcore_instance%numberOfStrings(i)%values(ci+1) = &
+ CIcore_instance%numberOfStrings(i)%values(ci+1) + 1
+ end do
+ if ( ci == 1 ) unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+
+ else !final
+
+ do m = int(occupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ CIcore_instance%numberOfStrings(i)%values(ci+1) = &
+ CIcore_instance%numberOfStrings(i)%values(ci+1) + 1
+ end do
+ if ( ci == 1 ) unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ end if
+
+ end function CIStrings_buildStringsRecursion
+
+!! and this is for building the strings
+recursive function CIStrings_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, &
+ ici, cilevel, order, c ) result (oci)
+ implicit none
+
+ integer :: i, numberOfSpecies
+ integer :: ci, ici, oci, cilevel
+ integer(8) :: c
+ integer :: m, a
+ type(ivector) :: order
+ type(vector), allocatable :: occupiedCode(:)
+ type(vector), allocatable :: unoccupiedCode(:)
+
+ ci = ici + 1
+
+ if ( ci == 1 .and. ci < cilevel ) then ! first
+ do m = int(occupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ oci = CIStrings_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel, order, c )
+ end do
+ unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ else if ( ci > 1 .and. ci < cilevel ) then ! mid
+ do m = int(occupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ oci = CIStrings_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel, order, c )
+ end do
+ end do
+
+ else if ( ci == 1 .and. ci == cilevel ) then ! mid
+ do m = int(occupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+
+ c = c + 1
+ call Configuration_constructorB(CIcore_instance%strings(i), CIcore_instance%orbitals(i), &
+ occupiedCode, unoccupiedCode, i, c, order)
+ end do
+ if ( ci == 1 ) unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+
+ else !final
+
+ do m = int(occupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOccupiedOrbitals%values(i))
+ do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(CIcore_instance%numberOfOrbitals%values(i) )
+ occupiedCode(i)%values(ci) = m
+ unoccupiedCode(i)%values(ci) = a
+ c = c + 1
+ call Configuration_constructorB(CIcore_instance%strings(i), CIcore_instance%orbitals(i), &
+ occupiedCode, unoccupiedCode, i, c, order)
+ end do
+ if ( ci == 1 ) unoccupiedCode(i)%values = CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ end if
+
+
+ end function CIStrings_buildStringsRecursion2
+
+end module CIStrings_
diff --git a/src/CI/CIcore.f90 b/src/CI/CIcore.f90
new file mode 100644
index 00000000..8021df01
--- /dev/null
+++ b/src/CI/CIcore.f90
@@ -0,0 +1,366 @@
+ module CIcore_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ implicit none
+
+ type, public :: CIcore
+ logical :: isInstanced
+ integer :: numberOfSpecies
+ type(matrix) :: hamiltonianMatrix
+ type(ivector8) :: auxIndexCIMatrix
+ type(matrix) :: eigenVectors
+ type(matrix) :: initialEigenVectors
+ type(vector8) :: initialEigenValues
+ integer(8) :: numberOfConfigurations
+ integer :: nproc
+ integer :: numberOfQuantumSpecies
+ type(ivector) :: numberOfCoreOrbitals
+ type(ivector) :: numberOfOccupiedOrbitals
+ type(ivector) :: numberOfOrbitals
+ type(vector) :: numberOfSpatialOrbitals2
+ type(vector8) :: eigenvalues
+ type(vector) :: groundStateEnergies
+ type(vector) :: DDCISDTiming
+ type(vector) :: lambda !!Number of particles per orbital, module only works for 1 or 2 particles per orbital
+ type(matrix), allocatable :: fourCenterIntegrals(:,:)
+ type(matrix), allocatable :: twoCenterIntegrals(:)
+ type(imatrix8), allocatable :: twoIndexArray(:)
+ type(imatrix8), allocatable :: fourIndexArray(:)
+ type(imatrix), allocatable :: strings(:) !! species, conf, occupations. index for occupied orbitals, e.g. 1 2 5 6
+ type(imatrix1), allocatable :: orbitals(:) !! species, conf, occupations. array with 1 for occupied and 0 unoccupied orb, e.g. 1 1 0 0 1 1
+ integer, allocatable :: sumstrings(:) !! species
+ type(ivector), allocatable :: auxstring(:,:) !! species, occupations
+ type(ivector8), allocatable :: numberOfStrings(:) !! species, excitation level, number of strings
+ type(ivector8), allocatable :: numberOfStrings2(:) !! species, excitation level, number of strings
+
+ !! species, threads
+ type(imatrix), allocatable :: couplingMatrix(:,:)
+ type(Vector), allocatable :: couplingMatrixEnergyOne(:,:)
+! type(matrix), allocatable :: couplingMatrixEnergyTwo(:)
+ type(ivector), allocatable :: couplingMatrixFactorOne(:,:)
+ type(ivector), allocatable :: couplingMatrixOrbOne(:,:)
+ type(imatrix), allocatable :: nCouplingOneTwo(:,:)
+ type(imatrix), allocatable :: nCouplingSize(:,:)
+
+ type(ivector1), allocatable :: couplingOrderList(:,:)
+ type(ivector1), allocatable :: couplingOrderIndex(:,:)
+
+ integer, allocatable :: ciOrderList(:,:)
+ integer, allocatable :: auxciOrderList(:)
+ integer :: sizeCiOrderList
+ integer(8), allocatable :: ciOrderSize1(:,:)
+ integer(8), allocatable :: ciOrderSize2(:,:)
+ integer(4), allocatable :: allIndexConf(:,:) !! species, total number of configurations
+
+ integer :: ncouplingOrderOne
+ integer :: ncouplingOrderTwo
+ integer :: ncouplingOrderTwoDiff
+
+ type(imatrix) :: auxConfigurations !! species, configurations for initial hamiltonian
+ type(imatrix) :: coreConfigurations !! species, configurations for core SCI space
+ type(imatrix) :: targetConfigurations !! species, configurations for target SCI space
+ type(imatrix) :: fullConfigurations !! species, configurations for target SCI space
+ type(imatrix) :: coreConfigurationsLevel !! species, configurations for CI level of core SCI space
+ type(imatrix) :: targetConfigurationsLevel !! species, configurations for CI level target SCI space
+ type(imatrix) :: fullConfigurationsLevel !! species, configurations for CI level target SCI space
+
+ type(configuration), allocatable :: configurations(:)
+ integer(2), allocatable :: auxconfs(:,:,:) ! nconf, species, occupation
+ type (Vector8) :: diagonalHamiltonianMatrix
+ type (Vector8) :: diagonalHamiltonianMatrix2
+ real(8) :: totalEnergy
+ integer, allocatable :: totalNumberOfContractions(:)
+ integer, allocatable :: occupationNumber(:)
+ integer, allocatable :: recursionVector1(:)
+ integer, allocatable :: recursionVector2(:)
+ integer, allocatable :: CILevel(:)
+ integer, allocatable :: pindexConf(:,:) !! save previous configuration to avoid unneccesary calculations
+
+ integer :: maxCILevel
+ type (Matrix) :: initialHamiltonianMatrix
+ type (Matrix) :: initialHamiltonianMatrix2
+ character(20) :: level
+ real(8) :: timeA(7)
+ real(8) :: timeB(7)
+
+ end type CIcore
+
+ type, public :: HartreeFock
+ real(8) :: totalEnergy
+ real(8) :: puntualInteractionEnergy
+ type(matrix) :: coefficientsofcombination
+ type(matrix) :: HcoreMatrix
+ end type HartreeFock
+
+ integer, allocatable :: Conf_occupationNumber(:)
+ type(HartreeFock) :: HartreeFock_instance
+ type(CIcore) :: CIcore_instance
+
+ public :: &
+ CIcore_constructor
+
+
+contains
+
+ !>
+ !! @brief Constructor por omision
+ !!
+ !! @param this
+ !<
+ subroutine CIcore_constructor(level)
+ implicit none
+ character(*) :: level
+
+ integer :: numberOfSpecies
+ integer :: i,j,k,l,m,n,p,q,cc,r,s,el, nproc
+ integer(8) :: c
+ integer :: ma,mb,mc,md,me,pa,pb,pc,pd,pe
+ integer :: isLambdaEqual1,lambda,otherlambda
+ type(vector) :: occupiedCode
+ type(vector) :: unoccupiedCode
+ real(8) :: totalEnergy
+
+ character(50) :: wfnFile
+ integer :: wfnUnit
+ character(50) :: nameOfSpecie
+ integer :: numberOfContractions
+ character(50) :: arguments(2)
+
+ wfnFile = "lowdin.wfn"
+ wfnUnit = 20
+
+ !! Open file for wavefunction
+ open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+
+ !! Load results...
+ call Vector_getFromFile(unit=wfnUnit, binary=.true., value=HartreeFock_instance%totalEnergy, &
+ arguments=["TOTALENERGY"])
+ call Vector_getFromFile(unit=wfnUnit, binary=.true., value=HartreeFock_instance%puntualInteractionEnergy, &
+ arguments=["PUNTUALINTERACTIONENERGY"])
+
+ CIcore_instance%numberOfQuantumSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ CIcore_instance%numberOfSpecies = numberOfSpecies
+
+
+ do i=1, numberOfSpecies
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( i ) )
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i )
+
+ arguments(2) = nameOfSpecie
+ arguments(1) = "HCORE"
+ HartreeFock_instance%HcoreMatrix = &
+ Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ arguments(1) = "COEFFICIENTS"
+ HartreeFock_instance%coefficientsofcombination = &
+ Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+ end do
+
+ CIcore_instance%isInstanced=.true.
+ CIcore_instance%level=level
+ CIcore_instance%numberOfConfigurations=0
+
+ call Vector_constructorInteger (CIcore_instance%numberOfCoreOrbitals, numberOfSpecies)
+ call Vector_constructorInteger (CIcore_instance%numberOfOccupiedOrbitals, numberOfSpecies)
+ call Vector_constructorInteger (CIcore_instance%numberOfOrbitals, numberOfSpecies)
+ call Vector_constructor (CIcore_instance%lambda, numberOfSpecies)
+ call Vector_constructor (CIcore_instance%numberOfSpatialOrbitals2, numberOfSpecies)
+
+ CIcore_instance%nproc = omp_get_max_threads()
+
+ if ( allocated (CIcore_instance%strings ) ) &
+ deallocate ( CIcore_instance%strings )
+ allocate ( CIcore_instance%strings ( numberOfSpecies ) )
+
+ if ( allocated (CIcore_instance%orbitals ) ) &
+ deallocate ( CIcore_instance%orbitals )
+ allocate ( CIcore_instance%orbitals ( numberOfSpecies ) )
+
+ if ( allocated (CIcore_instance%auxstring ) ) &
+ deallocate ( CIcore_instance%auxstring )
+ allocate ( CIcore_instance%auxstring ( CIcore_instance%nproc, numberOfSpecies ) )
+
+ if ( allocated (CIcore_instance%couplingMatrix ) ) &
+ deallocate ( CIcore_instance%couplingMatrix )
+ allocate ( CIcore_instance%couplingMatrix ( numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated (CIcore_instance%couplingMatrixEnergyOne ) ) &
+ deallocate ( CIcore_instance%couplingMatrixEnergyOne )
+ allocate ( CIcore_instance%couplingMatrixEnergyOne ( numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated (CIcore_instance%couplingMatrixFactorOne ) ) &
+ deallocate ( CIcore_instance%couplingMatrixFactorOne )
+ allocate ( CIcore_instance%couplingMatrixFactorOne ( numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated (CIcore_instance%couplingMatrixOrbOne ) ) &
+ deallocate ( CIcore_instance%couplingMatrixOrbOne )
+ allocate ( CIcore_instance%couplingMatrixOrbOne ( numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated (CIcore_instance%nCouplingOneTwo ) ) &
+ deallocate ( CIcore_instance%nCouplingOneTwo )
+ allocate ( CIcore_instance%nCouplingOneTwo ( numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated (CIcore_instance%nCouplingSize ) ) &
+ deallocate ( CIcore_instance%nCouplingSize )
+ allocate ( CIcore_instance%nCouplingSize ( numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated (CIcore_instance%numberOfStrings ) ) &
+ deallocate ( CIcore_instance%numberOfStrings )
+ allocate ( CIcore_instance%numberOfStrings ( numberOfSpecies ) )
+
+ if ( allocated (CIcore_instance%numberOfStrings2 ) ) &
+ deallocate ( CIcore_instance%numberOfStrings2 )
+ allocate ( CIcore_instance%numberOfStrings2 ( numberOfSpecies ) )
+
+ if ( allocated (CIcore_instance%sumstrings ) ) &
+ deallocate ( CIcore_instance%sumstrings )
+ allocate ( CIcore_instance%sumstrings ( numberOfSpecies ) )
+
+ if ( allocated ( CIcore_instance%totalNumberOfContractions ) ) &
+ deallocate ( CIcore_instance%totalNumberOfContractions )
+ allocate ( CIcore_instance%totalNumberOfContractions (numberOfSpecies ) )
+
+ if ( allocated ( CIcore_instance%occupationNumber ) ) &
+ deallocate ( CIcore_instance%occupationNumber )
+ allocate ( CIcore_instance%occupationNumber (numberOfSpecies ) )
+
+ if ( allocated ( CIcore_instance%recursionVector1 ) ) &
+ deallocate ( CIcore_instance%recursionVector1 )
+ allocate ( CIcore_instance%recursionVector1 (numberOfSpecies ) )
+
+ if ( allocated ( CIcore_instance%recursionVector2 ) ) &
+ deallocate ( CIcore_instance%recursionVector2 )
+ allocate ( CIcore_instance%recursionVector2 (numberOfSpecies ) )
+
+ if ( allocated ( CIcore_instance%CILevel) ) &
+ deallocate ( CIcore_instance%CILevel )
+ allocate ( CIcore_instance%CILevel (numberOfSpecies ) )
+
+ if ( allocated ( CIcore_instance%pindexConf) ) &
+ deallocate ( CIcore_instance%pindexConf )
+ allocate ( CIcore_instance%pindexConf (numberOfSpecies, CIcore_instance%nproc ) )
+
+ if ( allocated ( Conf_occupationNumber ) ) &
+ deallocate ( Conf_occupationNumber )
+ allocate ( Conf_occupationNumber (numberOfSpecies ) )
+
+
+ CIcore_instance%recursionVector1 = 1
+ CIcore_instance%recursionVector2 = 0
+
+ CIcore_instance%recursionVector1(numberOfSpecies) = 0
+ CIcore_instance%recursionVector2(numberOfSpecies) = 1
+
+ CIcore_instance%pindexConf = 0
+
+ do i=1, numberOfSpecies
+ !! We are working in spin orbitals not in spatial orbitals!
+ CIcore_instance%lambda%values(i) = MolecularSystem_getLambda( i )
+ CIcore_instance%numberOfCoreOrbitals%values(i) = 0
+ CIcore_instance%numberOfOccupiedOrbitals%values(i) = int (MolecularSystem_getOcupationNumber( i )* &
+ CIcore_instance%lambda%values(i))
+ CIcore_instance%numberOfOrbitals%values(i) = MolecularSystem_getTotalNumberOfContractions( i )* &
+ CIcore_instance%lambda%values(i)
+ CIcore_instance%numberOfSpatialOrbitals2%values(i) = MolecularSystem_getTotalNumberOfContractions( i )
+ CIcore_instance%numberOfSpatialOrbitals2%values(i) = &
+ CIcore_instance%numberOfSpatialOrbitals2%values(i) * ( &
+ CIcore_instance%numberOfSpatialOrbitals2%values(i) + 1 ) / 2
+
+
+ CIcore_instance%totalNumberOfContractions( i ) = MolecularSystem_getTotalNumberOfContractions( i )
+ CIcore_instance%occupationNumber( i ) = int( MolecularSystem_instance%species(i)%ocupationNumber )
+ Conf_occupationNumber( i ) = MolecularSystem_instance%species(i)%ocupationNumber
+
+
+ !! Take the active space from input
+ if ( InputCI_Instance(i)%coreOrbitals /= 0 ) then
+ CIcore_instance%numberOfCoreOrbitals%values(i) = InputCI_Instance(i)%coreOrbitals
+ end if
+ if ( InputCI_Instance(i)%activeOrbitals /= 0 ) then
+ CIcore_instance%numberOfOrbitals%values(i) = InputCI_Instance(i)%activeOrbitals * &
+ CIcore_instance%lambda%values(i) + &
+ CIcore_instance%numberOfCoreOrbitals%values(i)
+ end if
+
+ !!Uneven occupation number = alpha
+ !!Even occupation number = beta
+ end do
+
+ call Configuration_globalConstructor()
+
+ close(wfnUnit)
+
+ end subroutine CIcore_constructor
+
+recursive function CIcore_gatherConfRecursion(s, numberOfSpecies, indexConf, c, cilevel ) result (os)
+ implicit none
+
+ integer(8) :: a,b,c,cc,d
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies
+ integer :: os,is
+ integer :: size1, size2
+ integer(8) :: indexConf(:)
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer :: ssize
+ integer :: cilevel(:)
+
+ is = s + 1
+ if ( is < numberOfSpecies ) then
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ indexConf(is) = ssize + a
+ os = CIcore_gatherConfRecursion( is, numberOfSpecies, indexConf, c, cilevel )
+ end do
+ else
+ os = is
+ i = cilevel(is) + 1
+ ssize = CIcore_instance%numberOfStrings2(is)%values(i)
+ do a = 1, CIcore_instance%numberOfStrings(is)%values(i)
+ c = c + 1
+ indexConf(is) = ssize + a
+ CIcore_instance%allIndexConf(:,c) = indexConf
+
+ end do
+ end if
+
+ end function CIcore_gatherConfRecursion
+
+
+ function CIcore_getIndex ( indexConf ) result ( output )
+ implicit none
+ integer(8) :: indexConf(:)
+ integer(8) :: output, ssize
+ integer :: i,j, numberOfSpecies
+
+ numberOfSpecies = CIcore_instance%numberOfQuantumSpecies
+ output = 0
+ !! simplify!!
+ do i = 1, numberOfSpecies
+ ssize = 1
+ do j = i + 1, numberOfSpecies
+ ssize = ssize * CIcore_instance%sumstrings(j)
+ !ssize = ssize * sum(CIcore_instance%numberOfStrings(j)%values(1:2))
+ end do
+ output = output + ( indexConf(i) - 1 ) * ssize
+ end do
+ output = output + 1
+
+ end function CIcore_getIndex
+
+end module CIcore_
+
diff --git a/src/CI/CImod.f90 b/src/CI/CImod.f90
new file mode 100644
index 00000000..3acc0911
--- /dev/null
+++ b/src/CI/CImod.f90
@@ -0,0 +1,1757 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module CImod_
+ use Exception_
+ use Matrix_
+ use Vector_
+ use MolecularSystem_
+ use Configuration_
+ use ReadTransformedIntegrals_
+ use MolecularSystem_
+ use String_
+ use IndexMap_
+ use InputCI_
+ use omp_lib
+ use JadamiluInterface_
+ use CIcore_
+ use CIDiag_
+ use CIFullMatrix_
+ use CIInitial_
+ use CISCI_
+ use CIJadamilu_
+ use CIOrder_
+ use CIStrings_
+
+ ! use ArpackInterface_
+ implicit none
+
+ !>
+ !! @brief Configuration Interaction Module, works in spin orbitals
+ !!
+ !! @author felix
+ !!
+ !! Creation data : 07-24-12
+ !!
+ !! History change:
+ !!
+ !! - 07-24-12 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# description.
+ !! - 07-09-16 : Jorge Charry ( jacharrym@unal.edu.co )
+ !! -# Add CIS, and Fix CISD.
+ !! - MM-DD-YYYY : authorOfChange ( email@server )
+ !! -# description
+ !!
+ !<
+
+
+ public :: &
+! CIcore_constructor, &
+ CImod_destructor, &
+ CImod_getTotalEnergy, &
+ CImod_run, &
+ CImod_showEigenVectors, &
+ CImod_densityMatrices, &
+ CImod_show
+
+ private
+
+contains
+
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CImod_run()
+ implicit none
+ integer :: i,j,m, numberOfSpecies
+ integer :: a, ms
+ real(8) :: timeA, timeB
+ real(8), allocatable :: eigenValues(:)
+ real(8) :: ecorr
+
+! select case ( trim(CIcore_instance%level) )
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ ms = CONTROL_instance%CI_MADSPACE
+
+ write (*,*) ""
+ write (*,*) "==============================================="
+ write (*,*) " BEGIN ", trim(CIcore_instance%level)," CALCULATION"
+ write (*,*) " J. Charry, F. Moncada "
+ write (*,*) "-----------------------------------------------"
+ write (*,*) ""
+
+ write (*,"(A32)",advance="no") "Number of orbitals for species: "
+ do i = 1, numberOfSpecies-1
+ write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecies(i))//", "
+ end do
+ write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecies(numberOfSpecies))
+ write (*,*) ""
+
+ write (*,"(A28)",advance="no") " occupied orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)", advance="no") CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ write (*,*) ""
+
+ write (*,"(A28)",advance="no") " virtual orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)",advance="no") int(MolecularSystem_getTotalNumberOfContractions( i )* &
+ CIcore_instance%lambda%values(i) - &
+ CIcore_instance%numberOfOccupiedOrbitals%values(i) )
+ end do
+ write (*,*) ""
+
+ write (*,"(A28)",advance="no") " total number of orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)",advance="no") int(MolecularSystem_getTotalNumberOfContractions( i )* &
+ CIcore_instance%lambda%values(i) )
+ end do
+ write (*,*) ""
+
+
+ write (*,"(A28)",advance="no") " frozen core orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)",advance="no") CIcore_instance%numberOfCoreOrbitals%values(i)
+ end do
+ write (*,*) ""
+
+ write (*,"(A28)",advance="no") " active occupied orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)",advance="no") CIcore_instance%numberOfOccupiedOrbitals%values(i) - &
+ CIcore_instance%numberOfCoreOrbitals%values(i)
+ end do
+ write (*,*) ""
+
+ write (*,"(A28)",advance="no") " active virtual orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)",advance="no") CIcore_instance%numberOfOrbitals%values(i) - &
+ CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ end do
+ write (*,*) ""
+
+ write (*,"(A28)",advance="no") " total active orbitals: "
+ do i = 1, numberOfSpecies
+ write (*,"(I5)",advance="no") CIcore_instance%numberOfOrbitals%values(i) - &
+ CIcore_instance%numberOfCoreOrbitals%values(i)
+ end do
+ write (*,*) ""
+ write (*,*) " "
+
+ write (*,*) "Getting transformed integrals..."
+ call CImod_getTransformedIntegrals()
+ write (*,*) " "
+
+ !write (*,*) CIcore_instance%fourCenterIntegrals(1,1)%values(171, 1) a bug...
+ write (*,*) "Setting CI level..."
+
+ call CIOrder_settingCILevel()
+
+ !! write (*,*) "Total number of configurations", CIcore_instance%numberOfConfigurations
+ write (*,*) ""
+ call Vector_constructor8 ( CIcore_instance%eigenvalues, &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8 )
+
+
+ if ( CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL /= "SCI" ) then
+
+ select case (trim(String_getUppercase(CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
+
+ ! case ("ARPACK")
+
+ ! write (*,*) "This method was removed"
+
+ case ("JADAMILU")
+
+ write (*,*) "Building Strings..."
+ call CIStrings_buildStrings()
+
+ write (*,*) "Building CI level table..."
+ call CIOrder_buildCIOrderList()
+
+ call CIJadamilu_buildCouplingMatrix()
+ call CIJadamilu_buildCouplingOrderList()
+
+ write (*,*) "Building diagonal..."
+ call CIDiag_buildDiagonal()
+
+ write (*,*) "Building initial hamiltonian..."
+ call CIInitial_buildInitialCIMatrix2()
+
+ call Matrix_constructor (CIcore_instance%eigenVectors, &
+ int(CIcore_instance%numberOfConfigurations,8), &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ if ( CONTROL_instance%CI_LOAD_EIGENVECTOR ) then
+ call CImod_loadEigenVector (CIcore_instance%eigenvalues, &
+ CIcore_instance%eigenVectors)
+ end if
+
+ write(*,*) ""
+ write(*,*) "Diagonalizing hamiltonian..."
+ write(*,*) " Using : ", trim(String_getUppercase((CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
+ write(*,*) "============================================================="
+ write(*,*) "M. BOLLHÖFER AND Y. NOTAY, JADAMILU:"
+ write(*,*) " a software code for computing selected eigenvalues of "
+ write(*,*) " large sparse symmetric matrices, "
+ write(*,*) "Computer Physics Communications, vol. 177, pp. 951-964, 2007."
+ write(*,*) "============================================================="
+
+ write (6,*) ""
+ write (6,"(T2,A,F14.5,A3 )") "Estimated memory needed: ", &
+ float(CIcore_instance%numberOfConfigurations*( 2 + (3*ms + CONTROL_instance%NUMBER_OF_CI_STATES + 1) + 4*ms*ms)*8)/(1024**3) , " GB"
+ write (6,*) ""
+
+ !! diagonal correction. See 10.1016/j.chemphys.2007.07.001
+ if ( CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT == "CISD") then
+
+ call Vector_constructor ( CIcore_instance%groundStateEnergies, 30, 0.0_8)
+ call Vector_constructor ( CIcore_instance%DDCISDTiming, 30, 0.0_8)
+
+ write (6,*) ""
+ write (6,"(T2,A50, A12)") " ITERATIVE DIAGONAL DRESSED CISD SHIFT: " , CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT
+ write (6,"(T2,A62)") " ( Size-extensive correction) "
+ write (6,"(T2,A62)") " Based on 10.1016/j.chemphys.2007.07.001 and 10.1063/5.0182498"
+ write (6,*) ""
+
+ ecorr = 0.0_8
+
+ do i = 2, 31
+
+ !! add the diagonal shift
+ do a = 2, CIcore_instance%numberOfConfigurations
+ CIcore_instance%diagonalHamiltonianMatrix%values(a) = CIcore_instance%diagonalHamiltonianMatrix%values(a) + ecorr
+ end do
+
+ call CIJadamilu_jadamiluInterface(CIcore_instance%numberOfConfigurations, &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), &
+ CIcore_instance%eigenvalues, &
+ CIcore_instance%eigenVectors, timeA, timeB)
+
+ !! restore the original diagonal
+ do a = 2, CIcore_instance%numberOfConfigurations
+ CIcore_instance%diagonalHamiltonianMatrix%values(a) = CIcore_instance%diagonalHamiltonianMatrix%values(a) - ecorr
+ end do
+
+ ecorr = CIcore_instance%eigenvalues%values(1) - HartreeFock_instance%totalEnergy
+ CIcore_instance%groundStateEnergies%values(i) = CIcore_instance%eigenvalues%values(1)
+ CIcore_instance%DDCISDTiming%values(i) = timeB - timeA
+
+ write (6,"(T2,I2, F25.12, F25.12, F25.12, F16.4 )") i-1, CIcore_instance%groundStateEnergies%values(i), ecorr, (CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i)) , timeB - timeA
+
+ !! Restart ci matrix diagonalization from previous eigenvectors
+ CONTROL_instance%CI_LOAD_EIGENVECTOR = .True.
+
+ if ( abs( CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i) ) <= 1e-6) exit
+
+ end do
+
+
+ write (6,*) ""
+ write (6,"(T2,A42 )") " ITERATIVE DIAGONAL DRESSED CONVERGENCE "
+ write (6,"(T2,A95 )") "Iter Ground-State Energy Correlation Energy Energy Diff. Time(s) "
+ do i = 2, 31
+ write (6,"(T2,I2, F25.12, F25.12, F25.12, F16.4 )") i-1, CIcore_instance%groundStateEnergies%values(i), ecorr, (CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i)) , CIcore_instance%DDCISDTiming%values(i)
+ if ( abs( CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i) ) <= 1e-6) exit
+ end do
+
+ if ( CONTROL_instance%CI_SAVE_EIGENVECTOR ) then
+ call CImod_saveEigenVector ()
+ end if
+
+ else !! standard CI, no diagonal correction
+
+ call CIJadamilu_jadamiluInterface(CIcore_instance%numberOfConfigurations, &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), &
+ CIcore_instance%eigenvalues, &
+ CIcore_instance%eigenVectors, timeA, timeB )
+
+ if ( CONTROL_instance%CI_SAVE_EIGENVECTOR ) then
+ call CImod_saveEigenVector ()
+ end if
+
+ end if
+
+ case ("DSYEVX")
+
+ write (*,*) "Building Strings..."
+ call CIStrings_buildStrings()
+
+ write (*,*) "Building CI level table..."
+ call CIOrder_buildCIOrderList()
+
+ write (*,*) "Building diagonal..."
+ call CIDiag_buildDiagonal()
+
+ call Matrix_constructor (CIcore_instance%eigenVectors, &
+ int(CIcore_instance%numberOfConfigurations,8), &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ write(*,*) ""
+ write(*,*) "Diagonalizing hamiltonian..."
+ write(*,*) " Using : ", trim(String_getUppercase((CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
+
+ write (6,*) ""
+ write (6,"(T2,A,F14.5,A3 )") "Estimated memory needed: ", &
+ float((CIcore_instance%numberOfConfigurations**2 + 2 )*8)/(1024**3) , " GB"
+ write (6,*) ""
+
+
+ !! diagonal correction. See 10.1016/j.chemphys.2007.07.001
+ if ( CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT == "CISD") then
+
+ call Vector_constructor ( CIcore_instance%groundStateEnergies, 30, 0.0_8)
+
+ write (6,*) ""
+ write (6,"(T2,A50, A12)") " ITERATIVE DIAGONAL DRESSED CISD SHIFT: " , CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT
+ write (6,"(T2,A62)") " ( Size-extensive correction) "
+ write (6,"(T2,A62)") " Based on 10.1016/j.chemphys.2007.07.001 and 10.1063/5.0182498"
+ write (6,*) ""
+ write (6,"(T2,A95 )") "Iter Ground-State Energy Correlation Energy Energy Diff. Time(s) "
+
+ ecorr = 0.0_8
+
+ do i = 2, 31
+
+ call CIFullMatrix_buildHamiltonianMatrix( timeA, timeB)
+
+ do a = 2, CIcore_instance%numberOfConfigurations
+ CIcore_instance%hamiltonianMatrix%values(a,a) = CIcore_instance%hamiltonianMatrix%values(a,a) + ecorr
+ end do
+
+
+ call Matrix_eigen_select (CIcore_instance%hamiltonianMatrix, CIcore_instance%eigenvalues, &
+ int(1), int(CONTROL_instance%NUMBER_OF_CI_STATES), &
+ eigenVectors = CIcore_instance%eigenVectors, &
+ flags = int(SYMMETRIC,4))
+
+ ecorr = CIcore_instance%eigenvalues%values(1) - HartreeFock_instance%totalEnergy
+ CIcore_instance%groundStateEnergies%values(i) = CIcore_instance%eigenvalues%values(1)
+
+ write (6,"(T2,I2, F25.12, F25.12, F25.12, F16.4 )") i-1, CIcore_instance%groundStateEnergies%values(i), ecorr, (CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i)) , timeB - timeA
+
+ if ( abs( CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i) ) <= 1e-6) exit
+
+ end do
+
+ else !! standard CI, no diagonal correction
+
+ call CIFullMatrix_buildHamiltonianMatrix(timeA, timeB)
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for building Hamiltonian Matrix : ", timeB - timeA ," (s)"
+
+ call Matrix_eigen_select (CIcore_instance%hamiltonianMatrix, CIcore_instance%eigenvalues, &
+ int(1), int(CONTROL_instance%NUMBER_OF_CI_STATES), &
+ eigenVectors = CIcore_instance%eigenVectors, &
+ flags = int(SYMMETRIC,4))
+
+ end if
+
+ !! deallocate transformed integrals
+ deallocate(CIcore_instance%twoCenterIntegrals)
+ deallocate(CIcore_instance%fourCenterIntegrals)
+
+ case ("DSYEVR")
+
+ write (*,*) "Building Strings..."
+ call CIStrings_buildStrings()
+
+ write (*,*) "Building CI level table..."
+ call CIOrder_buildCIOrderList()
+
+ write (*,*) "Building diagonal..."
+ call CIDiag_buildDiagonal()
+
+ call Matrix_constructor (CIcore_instance%eigenVectors, &
+ int(CIcore_instance%numberOfConfigurations,8), &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ write(*,*) ""
+ write(*,*) "Diagonalizing hamiltonian..."
+ write(*,*) " Using : ", trim(String_getUppercase((CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
+ write (6,*) ""
+ write (6,"(T2,A,F14.5,A3 )") "Estimated memory needed: ", &
+ float((CIcore_instance%numberOfConfigurations**2 + 2 )*8)/(1024**3) , " GB"
+ write (6,*) ""
+
+ !! diagonal correction. See 10.1016/j.chemphys.2007.07.001
+ if ( CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT == "CISD") then
+
+ call Vector_constructor ( CIcore_instance%groundStateEnergies, 30, 0.0_8)
+
+ write (6,*) ""
+ write (6,"(T2,A50, A12)") " ITERATIVE DIAGONAL DRESSED CISD SHIFT: " , CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT
+ write (6,"(T2,A62)") " ( Size-extensive correction) "
+ write (6,"(T2,A62)") " Based on 10.1016/j.chemphys.2007.07.001 and 10.1063/5.0182498"
+ write (6,*) ""
+ write (6,"(T2,A95 )") "Iter Ground-State Energy Correlation Energy Energy Diff. Time(s) "
+
+ ecorr = 0.0_8
+
+ do i = 2, 31
+
+ call CIFullMatrix_buildHamiltonianMatrix( timeA, timeB)
+
+ do a = 2, CIcore_instance%numberOfConfigurations
+ CIcore_instance%hamiltonianMatrix%values(a,a) = CIcore_instance%hamiltonianMatrix%values(a,a) + ecorr
+ end do
+
+ call Matrix_eigen_dsyevr (CIcore_instance%hamiltonianMatrix, CIcore_instance%eigenvalues, &
+ 1, CONTROL_instance%NUMBER_OF_CI_STATES, &
+ eigenVectors = CIcore_instance%eigenVectors, &
+ flags = SYMMETRIC)
+
+ ecorr = CIcore_instance%eigenvalues%values(1) - HartreeFock_instance%totalEnergy
+ CIcore_instance%groundStateEnergies%values(i) = CIcore_instance%eigenvalues%values(1)
+
+ write (6,"(T2,I2, F25.12, F25.12, F25.12, F16.4 )") i-1, CIcore_instance%groundStateEnergies%values(i), ecorr, (CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i)) , timeB - timeA
+
+ if ( abs( CIcore_instance%groundStateEnergies%values(i-1) - CIcore_instance%groundStateEnergies%values(i) ) <= 1e-6) exit
+
+ end do
+
+ else !! standard CI, no diagonal correction
+
+ call CIFullMatrix_buildHamiltonianMatrix(timeA, timeB)
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for building Hamiltonian Matrix : ", timeB - timeA ," (s)"
+
+ call Matrix_eigen_dsyevr (CIcore_instance%hamiltonianMatrix, CIcore_instance%eigenvalues, &
+ 1, CONTROL_instance%NUMBER_OF_CI_STATES, &
+ eigenVectors = CIcore_instance%eigenVectors, &
+ flags = SYMMETRIC)
+
+ end if
+
+ !! deallocate transformed integrals
+ deallocate(CIcore_instance%twoCenterIntegrals)
+ deallocate(CIcore_instance%fourCenterIntegrals)
+
+ case default
+
+ call CImod_exception( ERROR, "CImod run", "Diagonalization method not implemented")
+
+
+ end select
+
+
+ elseif ( CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL == "SCI" ) then
+
+ select case (trim(String_getUppercase(CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
+
+ case ("JADAMILU")
+
+ write (*,*) "Building Strings..."
+ call CIStrings_buildStrings()
+
+ write (*,*) "Building CI level table..."
+ call CIOrder_buildCIOrderList()
+
+ call CIJadamilu_buildCouplingMatrix()
+ call CIJadamilu_buildCouplingOrderList()
+
+ write (*,*) "Building diagonal..."
+ call CIDiag_buildDiagonal()
+
+ call CISCI_show()
+
+ write (*,*) "Allocating arrays for SCI ..."
+ call CISCI_constructor()
+
+ call Matrix_constructor (CIcore_instance%eigenVectors, &
+ int(CIcore_instance%numberOfConfigurations,8), &
+ int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
+
+ call CISCI_run()
+
+ case default
+
+ call CImod_exception( ERROR, "CImod run", "Diagonalization method not implemented for SCI")
+
+ end select
+
+ end if
+
+ write(*,*) ""
+ write(*,*) "-----------------------------------------------"
+ write(*,*) " END ", trim(CIcore_instance%level)," CALCULATION"
+ write(*,*) "==============================================="
+ write(*,*) ""
+
+! case ( "FCI-oneSpecie" )
+!
+! print *, ""
+! print *, ""
+! print *, "==============================================="
+! print *, "| Full CI for one specie calculation |"
+! print *, "| Use fci program to perform the calculation |"
+! print *, "-----------------------------------------------"
+! print *, ""
+! ! call CIcore_getTransformedIntegrals()
+! !call CIcore_printTransformedIntegralsToFile()
+!
+
+ end subroutine CImod_run
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CImod_getTransformedIntegrals()
+ implicit none
+
+ integer :: numberOfSpecies
+ integer :: i,j,m,n,mu,nu,a,b
+ integer(8) :: c
+ integer :: specieID
+ integer :: otherSpecieID
+ character(10) :: nameOfSpecie
+ character(10) :: nameOfOtherSpecie
+ integer :: ocupationNumber
+ integer :: ocupationNumberOfOtherSpecie
+ integer :: numberOfContractions
+ integer :: numberOfContractionsOfOtherSpecie
+ type(Matrix) :: hcoreMatrix
+ type(Matrix) :: coefficients
+ real(8) :: charge
+ real(8) :: otherSpecieCharge
+
+ integer :: ssize1, ssize2
+ type(Matrix) :: externalPotential
+
+ character(50) :: wfnFile
+ character(50) :: arguments(20)
+ integer :: wfnUnit
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ allocate(CIcore_instance%twoCenterIntegrals(numberOfSpecies))
+ allocate(CIcore_instance%fourCenterIntegrals(numberOfSpecies,numberOfSpecies))
+
+ allocate(CIcore_instance%twoIndexArray(numberOfSpecies))
+ allocate(CIcore_instance%fourIndexArray(numberOfSpecies))
+
+ do i=1, numberOfSpecies
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( i ) )
+ specieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfSpecie )
+ ocupationNumber = MolecularSystem_getOcupationNumber( i )
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i )
+ charge=MolecularSystem_getCharge(i)
+
+! write (6,"(T10,A)")"ONE PARTICLE INTEGRALS TRANSFORMATION FOR: "//trim(nameOfSpecie)
+ call Matrix_constructor (CIcore_instance%twoCenterIntegrals(i), &
+ int(numberOfContractions,8), int(numberOfContractions,8), 0.0_8 )
+
+ call Matrix_constructor (hcoreMatrix,int(numberOfContractions,8), int(numberOfContractions,8), 0.0_8)
+
+ !! Open file for wavefunction
+
+ wfnFile = "lowdin.wfn"
+ wfnUnit = 20
+
+ open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+
+ arguments(2) = MolecularSystem_getNameOfSpecies(i)
+ arguments(1) = "COEFFICIENTS"
+
+ coefficients = &
+ Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ arguments(1) = "HCORE"
+
+ hcoreMatrix = &
+ Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ !! transform two center integrals (one body operators)
+ do m=1,numberOfContractions
+ do n=m, numberOfContractions
+ do mu=1, numberOfContractions
+ do nu=1, numberOfContractions
+ CIcore_instance%twoCenterIntegrals(i)%values(m,n) = &
+ CIcore_instance%twoCenterIntegrals(i)%values(m,n) + &
+ coefficients%values(mu,m)* &
+ coefficients%values(nu,n)* &
+ hcoreMatrix%values(mu,nu)
+ end do
+ end do
+ end do
+ end do
+
+ !! symmetrization
+ do m = 1,numberOfContractions
+ do n = m, numberOfContractions
+ CIcore_instance%twoCenterIntegrals(i)%values(n,m)=&
+ CIcore_instance%twoCenterIntegrals(i)%values(m,n)
+ end do
+ end do
+
+ !! auxilary 2-index array
+ call Matrix_constructorInteger8(CIcore_instance%twoIndexArray(i), &
+ int( numberOfContractions,8), int( numberOfContractions,8) , 0_8 )
+
+ c = 0
+ do a=1,numberOfContractions
+ do b = a, numberOfContractions
+ c = c + 1
+ CIcore_instance%twoIndexArray(i)%values(a,b) = c !IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
+ CIcore_instance%twoIndexArray(i)%values(b,a) = CIcore_instance%twoIndexArray(i)%values(a,b)
+ end do
+ end do
+
+
+ !! auxilary 4-index array
+ ssize1 = MolecularSystem_getTotalNumberOfContractions( i )
+ ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2
+
+ call Matrix_constructorInteger8(CIcore_instance%fourIndexArray(i), &
+ int( ssize1,8), int( ssize1,8) , 0_8 )
+ c = 0
+ do a = 1, ssize1
+ do b = a, ssize1
+ c = c + 1
+ CIcore_instance%fourIndexArray(i)%values(a,b) = c! IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
+ CIcore_instance%fourIndexArray(i)%values(b,a) = &
+ CIcore_instance%fourIndexArray(i)%values(a,b)
+ end do
+ end do
+
+
+ call ReadTransformedIntegrals_readOneSpecies( specieID, CIcore_instance%fourCenterIntegrals(i,i) )
+ CIcore_instance%fourCenterIntegrals(i,i)%values = &
+ CIcore_instance%fourCenterIntegrals(i,i)%values * charge * charge
+
+ if ( numberOfSpecies > 1 ) then
+ do j = 1 , numberOfSpecies
+ if ( i .ne. j) then
+ nameOfOtherSpecie = trim( MolecularSystem_getNameOfSpecies( j ) )
+ otherSpecieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie )
+ ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( j )
+ numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( j )
+ otherSpecieCharge = MolecularSystem_getCharge(j)
+
+ call ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, &
+ CIcore_instance%fourCenterIntegrals(i,j) )
+ CIcore_instance%fourCenterIntegrals(i,j)%values = &
+ CIcore_instance%fourCenterIntegrals(i,j)%values * charge * otherSpeciecharge
+
+
+ end if
+ end do
+ end if
+ end do
+ close (wfnUnit)
+ call Matrix_destructor (hcoreMatrix)
+
+ end subroutine CImod_getTransformedIntegrals
+
+
+ !**
+ ! @ Retorna la energia final com correccion Moller-Plesset de orrden dado
+ !**
+ function CImod_getTotalEnergy() result(output)
+ implicit none
+ real(8) :: output
+
+ output = CIcore_instance%totalEnergy
+
+ end function CImod_getTotalEnergy
+
+
+ subroutine CImod_saveEigenVector ()
+ implicit none
+ character(50) :: nameFile
+ integer :: unitFile
+ integer(8) :: i, ia
+ integer :: ib, nonzero
+ integer, allocatable :: auxIndexArray(:)
+ real(8), allocatable :: auxArray(:)
+ integer :: maxStackSize
+
+ maxStackSize = CONTROL_instance%CI_STACK_SIZE
+ nameFile = "lowdin.civec"
+ unitFile = 20
+
+ nonzero = 0
+ do i = 1, CIcore_instance%numberOfConfigurations
+ if ( abs(CIcore_instance%eigenVectors%values(i,1) ) >= 1E-12 ) nonzero = nonzero + 1
+ end do
+
+ write (*,*) "nonzero", nonzero
+
+ allocate(auxArray(nonzero))
+ allocate(auxIndexArray(nonzero))
+
+ ia = 0
+ do i = 1, CIcore_instance%numberOfConfigurations
+ if ( abs(CIcore_instance%eigenVectors%values(i,1) ) >= 1E-12 ) then
+ ia = ia + 1
+ auxIndexArray(ia) = i
+ auxArray(ia) = CIcore_instance%eigenVectors%values(i,1)
+ end if
+ end do
+
+ open(unit=unitFile, file=trim(nameFile), status="replace", form="unformatted")
+
+ write(unitFile) CIcore_instance%eigenValues%values(1)
+ write(unitFile) nonzero
+
+ do i = 1, ceiling(real(nonzero) / real(maxStackSize) )
+ ib = maxStackSize * i
+ ia = ib - maxStackSize + 1
+ if ( ib > nonzero ) ib = nonzero
+ write(unitFile) auxIndexArray(ia:ib)
+ end do
+ deallocate(auxIndexArray)
+
+ do i = 1, ceiling(real(nonzero) / real(maxStackSize) )
+ ib = maxStackSize * i
+ ia = ib - maxStackSize + 1
+ if ( ib > nonzero ) ib = nonzero
+ write(unitFile) auxArray(ia:ib)
+ end do
+ deallocate(auxArray)
+
+ close(unitFile)
+
+ end subroutine CImod_saveEigenVector
+
+ subroutine CImod_loadEigenVector (eigenValues,eigenVectors)
+ implicit none
+ type(Vector8) :: eigenValues
+ type(Matrix) :: eigenVectors
+ character(50) :: nameFile
+ integer :: unitFile
+ integer :: i, ia, ib, nonzero
+ real(8) :: eigenValue
+ integer, allocatable :: auxIndexArray(:)
+ real(8), allocatable :: auxArray(:)
+ integer :: maxStackSize
+
+ maxStackSize = CONTROL_instance%CI_STACK_SIZE
+
+
+ nameFile = "lowdin.civec"
+ unitFile = 20
+
+
+ open(unit=unitFile, file=trim(nameFile), status="old", action="read", form="unformatted")
+
+ readvectors : do
+ read (unitFile) eigenValue
+ read (unitFile) nonzero
+ write (*,*) "eigenValue", eigenValue
+ write (*,*) "nonzero", nonzero
+
+ allocate (auxIndexArray(nonzero))
+ auxIndexArray = 0
+
+ do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
+ ib = maxStackSize * i
+ ia = ib - maxStackSize + 1
+ if ( ib > nonZero ) ib = nonZero
+ read (unitFile) auxIndexArray(ia:ib)
+ end do
+
+ allocate (auxArray(nonzero))
+ auxArray = 0
+
+ do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
+ ib = maxStackSize * i
+ ia = ib - maxStackSize + 1
+ if ( ib > nonZero ) ib = nonZero
+ read (unitFile) auxArray(ia:ib)
+ end do
+ exit readvectors
+ end do readvectors
+
+ eigenValues%values(1) = eigenValue
+ do i = 1, nonzero
+ eigenVectors%values(auxIndexArray(i),1) = auxArray(i)
+ end do
+
+ deallocate (auxIndexArray )
+ deallocate (auxArray )
+
+
+ close(unitFile)
+
+ end subroutine CImod_loadEigenVector
+
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+ subroutine CImod_show()
+ implicit none
+ type(CIcore) :: this
+ integer :: i
+ real(8) :: davidsonCorrection, HFcoefficient, CIcorrection
+ integer numberOfSpecies
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ if ( CIcore_instance%isInstanced ) then
+
+ write(*,"(A)") ""
+ write(*,"(A)") " POST HARTREE-FOCK CALCULATION"
+ write(*,"(A)") " CONFIGURATION INTERACTION THEORY:"
+ write(*,"(A)") "=============================="
+ write(*,"(A)") ""
+ write (6,"(T8,A30, A5)") "LEVEL = ", CIcore_instance%level
+ write (6,"(T8,A30, I8)") "NUMBER OF CONFIGURATIONS = ", CIcore_instance%numberOfConfigurations
+ do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ write (6,"(T8,A17,I3,A10, F25.12)") "STATE: ", i, " ENERGY = ", CIcore_instance%eigenvalues%values(i)
+ end do
+ write(*,"(A)") ""
+ CIcorrection = CIcore_instance%eigenvalues%values(1) - &
+ HartreeFock_instance%totalEnergy
+
+ write (6,"(T4,A34, F25.12)") "GROUND STATE CORRELATION ENERGY = ", CIcorrection
+
+ if ( CIcore_instance%level == "CISD" ) then
+ write(*,"(A)") ""
+ write (6,"(T2,A34)") "RENORMALIZED DAVIDSON CORRECTION:"
+ write(*,"(A)") ""
+ write (6,"(T8,A54)") "E(CISDTQ) \approx E(CISD) + \delta E(Q) "
+ write (6,"(T8,A54)") "\delta E(Q) = (1 - c_0^2) * \delta E(CISD) / c_0^2 "
+ write (*,*) ""
+ HFcoefficient = CIcore_instance%eigenVectors%values(1,1)
+ davidsonCorrection = ( 1 - HFcoefficient*HFcoefficient) * CIcorrection / (HFcoefficient*HFcoefficient)
+
+
+ write (6,"(T8,A19, F25.12)") "HF COEFFICIENT = ", HFcoefficient
+ write (6,"(T8,A19, F25.12)") "\delta E(Q) = ", davidsonCorrection
+ write (6,"(T8,A19, F25.12)") "E(CISDTQ) ESTIMATE ", HartreeFock_instance%totalEnergy +&
+ CIcorrection + davidsonCorrection
+
+ else if ( CIcore_instance%level == "SCI" ) then
+
+ write(*,"(A)") ""
+ write (6,"(T2,A34)") "EPSTEIN-NESBET PT2 CORRECTION:"
+ write(*,"(A)") ""
+ write (6,"(T8,A19, F25.12)") "E_PT2 :", CISCI_instance%PT2energy
+ write (6,"(T8,A19, F25.12)") "E_SCI + E_PT2 :", CIcore_instance%eigenvalues%values(1) + CISCI_instance%PT2energy
+
+ else
+
+ write(*,"(A)") ""
+ HFcoefficient = CIcore_instance%eigenVectors%values(1,1)
+ write (6,"(T8,A19, F25.12)") "HF COEFFICIENT = ", HFcoefficient
+
+ end if
+
+ end if
+
+ end subroutine CImod_show
+
+ subroutine CImod_showEigenVectors()
+ implicit none
+
+ integer(8) :: a,b,c
+ integer :: u,v,p
+ integer :: ci
+ integer :: i, j, ii, jj
+ integer :: s, numberOfSpecies, auxnumberOfSpecies
+ integer :: size1, size2
+ real(8) :: timeA, timeB
+ integer(1) :: coupling
+ integer(8) :: numberOfConfigurations
+ real(8) :: CIenergy
+ integer(8), allocatable :: indexConf(:)
+ integer, allocatable :: cilevel(:), auxcilevel(:), dd(:)
+
+
+ if ( CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT == "NONE" ) return
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfConfigurations = CIcore_instance%numberOfConfigurations
+
+ allocate ( CIcore_instance%allIndexConf( numberOfSpecies, numberOfConfigurations ) )
+ allocate ( ciLevel ( numberOfSpecies ) )
+ allocate ( indexConf ( numberOfSpecies ) )
+ ciLevel = 0
+ CIcore_instance%allIndexConf = 0
+ indexConf = 0
+
+ !! gather all configurations
+ s = 0
+ c = 0
+ ciLevel = 0
+
+ do ci = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ auxnumberOfSpecies = CIcore_gatherConfRecursion( s, numberOfSpecies, indexConf, c, cilevel )
+ end do
+ !stop
+
+ deallocate ( ciLevel )
+
+ if ( CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT == "ORBITALS" ) then
+ write (*,*) ""
+ write (*, "(T1,A)") "Eigenvectors"
+ write (*,*) ""
+
+ do c = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ write (*, "(T1,A,I4,A,F25.12)") "State: ", c, " Energy: ", CIcore_instance%eigenValues%values(c)
+ write (*, "(T1,A)") "Conf, orbital occupation per species, coefficient"
+ write (*,*) ""
+ do a = 1, numberOfConfigurations
+ if ( abs(CIcore_instance%eigenVectors%values(a,c)) > CONTROL_instance%CI_PRINT_THRESHOLD ) then
+ indexConf(:) = CIcore_instance%allIndexConf(:,a)
+
+ write (*, "(T1,I8,A1)", advance="no") a, " "
+ do i = 1, numberOfSpecies
+ do p = 1, CIcore_instance%numberOfOrbitals%values(i)
+ write (*, "(I1)", advance="no") CIcore_instance%orbitals(i)%values(p,indexConf(i))
+ end do
+ write (*, "(A1)", advance="no") " "
+ end do
+ write (*, "(F11.8)") CIcore_instance%eigenVectors%values(a,c)
+ end if
+ end do
+ write (*,*) ""
+ end do
+
+
+ else if ( CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT == "OCCUPIED" ) then
+ write (*,*) ""
+ write (*, "(T1,A)") "Eigenvectors"
+ write (*,*) ""
+
+ do c = 1, CONTROL_instance%NUMBER_OF_CI_STATES
+ write (*, "(T1,A,I4,A,F25.12)") "State: ", c, " Energy: ", CIcore_instance%eigenValues%values(c)
+ write (*, "(T1,A)") "Conf, occupied orbitals per species, coefficient"
+ write (*,*) ""
+ do a = 1, numberOfConfigurations
+ if ( abs(CIcore_instance%eigenVectors%values(a,c)) > CONTROL_instance%CI_PRINT_THRESHOLD ) then
+ indexConf(:) = CIcore_instance%allIndexConf(:,a)
+
+ write (*, "(T1,I8,A1)", advance="no") a, " "
+ do i = 1, numberOfSpecies
+ do p = 1, CIcore_instance%numberOfOccupiedOrbitals%values(i)
+ write (*, "(I3,A1)", advance="no") CIcore_instance%strings(i)%values(p,indexConf(i) ), " "
+ end do
+ write (*, "(A1)", advance="no") "|"
+ end do
+ write (*, "(A,F11.8)") " ", CIcore_instance%eigenVectors%values(a,c)
+ end if
+ end do
+ write (*,*) ""
+ end do
+
+ end if
+
+ deallocate ( indexConf )
+ deallocate ( CIcore_instance%allIndexConf )
+
+ end subroutine CImod_showEigenVectors
+
+
+ !FELIX IS HERE
+ subroutine CImod_densityMatrices()
+ implicit none
+ type(CIcore) :: this
+ type(Configuration) :: auxthisA, auxthisB
+ integer :: i, j, k, l, mu, nu, n
+ integer :: factor
+ integer :: unit, wfnunit
+ integer :: numberOfOrbitals, numberOfContractions, numberOfOccupiedOrbitals
+ integer :: state, species, orbital, orbitalA, orbitalB
+ character(50) :: file, wfnfile, speciesName, auxstring
+ character(50) :: arguments(2)
+ type(matrix), allocatable :: coefficients(:), atomicDensityMatrix(:,:), ciDensityMatrix(:,:), auxDensMatrix(:,:)
+ type(matrix), allocatable :: kineticMatrix(:), attractionMatrix(:), externalPotMatrix(:)
+ integer numberOfSpecies
+
+ type(matrix) :: auxdensityEigenVectors
+ type(matrix) :: densityEigenVectors
+ type(vector) :: auxdensityEigenValues
+ type(vector) :: densityEigenValues
+ integer, allocatable :: cilevel(:), cilevelA(:)
+ integer(8) :: numberOfConfigurations, c
+ integer(8), allocatable :: indexConf(:)
+ type(ivector), allocatable :: stringAinB(:)
+ integer :: s, ss, ci, auxnumberOfSpecies
+ integer, allocatable :: coupling(:)
+ integer :: a, b, AA, BB, bj
+ integer :: u, uu, ssize
+ integer(8), allocatable :: indexConfA(:)
+ integer(8), allocatable :: indexConfB(:)
+ integer(8), allocatable :: jj(:)
+ real(8) :: timeDA
+ real(8) :: timeDB
+
+
+ ! type(Vector) :: eigenValues
+ ! type(Matrix) :: eigenVectors, auxMatrix
+ ! real(8) :: sumaPrueba
+
+ !!Iterators: i,j - Configurations .... k,l - molecular orbitals .... mu,nu - atomic orbitals ... n - threads
+ if ( CIcore_instance%isInstanced .and. CONTROL_instance%CI_STATES_TO_PRINT .gt. 0 ) then
+ !$ timeDA = omp_get_wtime()
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ numberOfConfigurations = CIcore_instance%numberOfConfigurations
+
+ allocate (stringAinB ( numberOfSpecies ))
+
+ do i = 1, numberOfSpecies
+ call Vector_constructorInteger (stringAinB(i), CIcore_instance%numberOfOccupiedOrbitals%values(i), 0)
+ end do
+
+ allocate ( CIcore_instance%allIndexConf( numberOfSpecies, numberOfConfigurations ) )
+ allocate ( ciLevelA ( numberOfSpecies ) )
+ allocate ( ciLevel ( numberOfSpecies ) )
+ allocate ( indexConf ( numberOfSpecies ) )
+ ciLevelA = 0
+ ciLevel = 0
+ CIcore_instance%allIndexConf = 0
+ indexConf = 0
+
+ !! gather all configurations
+ s = 0
+ c = 0
+ ciLevel = 0
+
+ do ci = 1, CIcore_instance%sizeCiOrderList
+
+ cilevel(:) = CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(ci), :)
+ s = 0
+ auxnumberOfSpecies = CIcore_gatherConfRecursion( s, numberOfSpecies, indexConf, c, cilevel )
+ end do
+ !stop
+
+ deallocate ( indexConf )
+ allocate ( coupling ( numberOfSpecies ) )
+
+
+ write (*,*) ""
+ write (*,*) "=============================="
+ write (*,*) "BUILDING CI DENSITY MATRICES"
+ write (*,*) "=============================="
+ write (*,*) ""
+
+ allocate( coefficients(numberOfSpecies), &
+ kineticMatrix(numberOfSpecies), &
+ attractionMatrix(numberOfSpecies), &
+ externalPotMatrix(numberOfSpecies), &
+ atomicDensityMatrix(numberOfSpecies,CONTROL_instance%CI_STATES_TO_PRINT), &
+ ciDensityMatrix(numberOfSpecies,CONTROL_instance%CI_STATES_TO_PRINT), &
+ auxDensMatrix(numberOfSpecies,CIcore_instance%nproc) )
+
+ wfnFile = "lowdin.wfn"
+ wfnUnit = 20
+ open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+
+ !Inicializando las matrices
+ do species=1, numberOfSpecies
+ speciesName = MolecularSystem_getNameOfSpecies(species)
+
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species )
+ ! numberOfOrbitals = CIcore_instance%numberOfOrbitals%values(species)
+ numberOfOccupiedOrbitals = CIcore_instance%numberOfOccupiedOrbitals%values(species)
+
+ arguments(2) = speciesName
+ ! print *, "trolo", numberOfOrbitals, numberOfContractions, numberOfOccupiedOrbitals
+
+ arguments(1) = "COEFFICIENTS"
+ coefficients(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ arguments(1) = "KINETIC"
+ kineticMatrix(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ arguments(1) = "ATTRACTION"
+ attractionMatrix(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ arguments(1) = "EXTERNAL_POTENTIAL"
+ if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ externalPotMatrix(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+ ! print *, "trololo"
+
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+
+ call Matrix_constructor ( ciDensityMatrix(species,state) , &
+ int(numberOfContractions,8), &
+ int(numberOfContractions,8), 0.0_8 )
+
+ do k=1, numberOfOccupiedOrbitals
+ ciDensityMatrix(species,state)%values( k, k)=1.0_8
+ end do
+
+ end do
+
+ do n=1, CIcore_instance%nproc
+
+ call Matrix_constructor ( auxDensMatrix(species,n) , &
+ int(numberOfContractions,8), &
+ int(numberOfContractions,8), 0.0_8 )
+ end do
+ end do
+
+ close(wfnUnit)
+
+ allocate ( indexConfA ( numberOfSpecies ) )
+ allocate ( indexConfB ( numberOfSpecies ) )
+ allocate ( jj ( numberOfSpecies ) )
+
+ indexConfA = 0
+ indexConfB = 0
+ jj = 0
+
+ !! Building the CI reduced density matrix in the molecular orbital representation in parallel
+ ! call Matrix_show (CIcore_instance%eigenVectors)
+
+ !!print *, " State, Progress"
+
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+
+ !$omp parallel &
+ !$omp& firstprivate (stringAinB,indexConfA,indexConfB, jj) &
+ !$omp& private(i,j, species, s, numberOfOccupiedOrbitals, k, coupling, orbital, orbitalA, orbitalB, AA, BB, a, b, factor, n, cilevelA, ss, ssize, cilevel, ci, u, uu, bj),&
+ !$omp& shared(CIcore_instance, auxDensMatrix )
+ n = omp_get_thread_num() + 1
+ !$omp do schedule (dynamic)
+ do i=1, CIcore_instance%numberOfConfigurations
+
+ !!if( mod( i , 50000 ) .eq. 0 ) print *, state, floor(real(100*i/CIcore_instance%numberOfConfigurations)), "%"
+ !!Filter very small coefficients
+ if( abs(CIcore_instance%eigenVectors%values(i,state)) .ge. 1E-10) then
+
+ indexConfA(:) = CIcore_instance%allIndexConf(:,i)
+
+ !print *, "==", indexConfA , "|", i
+
+
+ !!Diagonal contributions
+ do species=1, numberOfSpecies
+ numberOfOccupiedOrbitals = CIcore_instance%numberOfOccupiedOrbitals%values(species)
+
+ do k=1, numberOfOccupiedOrbitals
+
+ !!Occupied orbitals
+ auxDensMatrix(species,n)%values(k,k)=auxDensMatrix(species,n)%values(k,k) - CIcore_instance%eigenVectors%values(i,state)**2
+ ! ciDensityMatrix(species,state)%values( k, k) = ciDensityMatrix(species,state)%values( k, k) - &
+ ! CIcore_instance%eigenVectors%values(i,state)**2
+
+ !print *, i, j, k, species
+ !orbital = CIcore_instance%configurations(i)%occupations(k,species)
+ orbital = CIcore_instance%strings(species)%values(k,indexConfA(species))
+ !!Unoccupied orbitals
+
+ auxDensMatrix(species,n)%values(orbital,orbital)=auxDensMatrix(species,n)%values(orbital,orbital) + CIcore_instance%eigenVectors%values(i,state)**2
+ ! ciDensityMatrix(species,state)%values( orbital, orbital)= ciDensityMatrix(species,state)%values( orbital, orbital) + &
+ ! CIcore_instance%eigenVectors%values(i,state)**2
+
+ end do
+ end do
+
+ !!Off Diagonal contributions
+ cilevelA = 0
+ do ss = 1, numberOfSpecies
+ stringAinB(ss)%values = 0
+ do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(ss)
+
+ stringAinB(ss)%values(k) = CIcore_instance%orbitals(ss)%values( &
+ CIcore_instance%strings(ss)%values(k, CIcore_instance%allIndexConf(ss,1)), indexConfA(ss))
+ end do
+ cilevelA(ss) = CIcore_instance%numberOfOccupiedOrbitals%values(ss) - sum ( stringAinB(ss)%values )
+ end do
+
+ jj = 0
+ coupling = 0
+ do ss = 1, numberOfSpecies
+ ssize = 0
+
+ indexConfB(:) = indexConfA(:)
+ cilevel = cilevelA
+
+ do ci = 1, size(CIcore_instance%numberOfStrings(ss)%values, dim = 1)
+ cilevel(ss) = ci - 1
+ do u = 1, CIcore_instance%sizeCiOrderList
+ if ( sum(abs(cilevel - &
+ CIcore_instance%ciOrderList( CIcore_instance%auxciOrderList(u), :))) == 0 ) then
+ uu = CIcore_instance%auxciOrderList(u)
+ do bj = 1 + ssize , CIcore_instance%numberOfStrings(ss)%values(ci) + ssize
+ indexConfB(ss) = bj
+
+ do s=1, numberOfSpecies
+ jj(s) = (indexConfB(s) - CIcore_instance%numberOfStrings2(s)%values(cilevel(s)+1) + &
+ CIcore_instance%ciOrderSize1(uu,s) )* CIcore_instance%ciOrderSize2(uu,s)
+ end do
+
+ j = sum(jj)
+ !print *, " ", indexConfB , "|", j, CIcore_instance%eigenVectors%values(j,state)
+ if ( j > i ) then
+ if( abs(CIcore_instance%eigenVectors%values(j,state)) .ge. 1E-10) then
+
+ coupling = 0
+ do s=1, numberOfSpecies
+ stringAinB(s)%values = 0
+ do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s)
+ stringAinB(s)%values(k) = CIcore_instance%orbitals(s)%values( &
+ CIcore_instance%strings(s)%values(k,indexConfA(s) ), indexConfB(s) )
+ end do
+ coupling(s) = CIcore_instance%numberOfOccupiedOrbitals%values(s) - sum ( stringAinB(s)%values )
+ end do
+ if (sum(coupling) == 1) then
+
+ do s = 1, numberOfSpecies
+
+ if ( coupling(s) == 1) then !!hmm
+
+ !print *, " ", coupling
+ orbitalA = 0
+ orbitalB = 0
+ AA = 0
+ BB = 0
+ a = indexConfA(s)
+ b = indexConfB(s)
+
+ do k = 1, CIcore_instance%occupationNumber(s)
+ if ( CIcore_instance%orbitals(s)%values( &
+ CIcore_instance%strings(s)%values(k,a),b) == 0 ) then
+ orbitalA = CIcore_instance%strings(s)%values(k,a)
+ AA = k
+ exit
+ end if
+ end do
+ do k = 1, CIcore_instance%occupationNumber(s)
+ if ( CIcore_instance%orbitals(s)%values( &
+ CIcore_instance%strings(s)%values(k,b),a) == 0 ) then
+ orbitalB = CIcore_instance%strings(s)%values(k,b)
+ BB = k
+ exit
+ end if
+ end do
+
+ factor = (-1)**(AA-BB)
+
+ numberOfOccupiedOrbitals = CIcore_instance%numberOfOccupiedOrbitals%values(s)
+
+ ! print *, i, j, CIcore_instance%configurations(i)%occupations(:,specie), CIcore_instance%configurations(j)%occupations(:,specie)
+ ! print *, i, j, auxthisA%occupations(:,specie), auxthisB%occupations(:,specie)
+ ! print *, i, j, orbitalA, orbitalB, factor*CIcore_instance%eigenVectors%values(i,1)*CIcore_instance%eigenVectors%values(j,1)
+
+ auxDensMatrix(s,n)%values( orbitalA,orbitalB)= auxDensMatrix(s,n)%values( orbitalA, orbitalB) + &
+ factor*CIcore_instance%eigenVectors%values(i,state)* &
+ CIcore_instance%eigenVectors%values(j,state)
+ auxDensMatrix(s,n)%values( orbitalB,orbitalA)= auxDensMatrix(s,n)%values( orbitalB, orbitalA) + &
+ factor*CIcore_instance%eigenVectors%values(i,state)* &
+ CIcore_instance%eigenVectors%values(j,state)
+ end if
+ end do
+ end if
+ end if
+ end if
+ !! here
+ end do
+ ssize = ssize + CIcore_instance%numberOfStrings(ss)%values(ci)
+ !exit
+ end if
+
+ end do
+ end do
+
+ end do
+
+! do j=i+1, CIcore_instance%numberOfConfigurations
+! if( abs(CIcore_instance%eigenVectors%values(j,state)) .ge. 1E-12) then
+
+! indexConfB(:) = CIcore_instance%allIndexConf(:,j)
+
+! coupling = 0
+! do s=1, numberOfSpecies
+! stringAinB(s)%values = 0
+! do k = 1, CIcore_instance%numberOfOccupiedOrbitals%values(s)
+! stringAinB(s)%values(k) = CIcore_instance%orbitals(s)%values( &
+! CIcore_instance%strings(s)%values(k,indexConfA(s) ), indexConfB(s) )
+! end do
+! coupling(s) = CIcore_instance%numberOfOccupiedOrbitals%values(s) - sum ( stringAinB(s)%values )
+! end do
+!
+! if (sum(coupling) == 1) then
+!
+! do s = 1, numberOfSpecies
+!
+! if ( coupling(s) == 1) then
+! orbitalA = 0
+! orbitalB = 0
+! AA = 0
+! BB = 0
+! a = indexConfA(s)
+! b = indexConfB(s)
+!
+! do k = 1, CIcore_instance%occupationNumber(s)
+! if ( CIcore_instance%orbitals(s)%values( &
+! CIcore_instance%strings(s)%values(k,a),b) == 0 ) then
+! orbitalA = CIcore_instance%strings(s)%values(k,a)
+! AA = k
+! exit
+! end if
+! end do
+! do k = 1, CIcore_instance%occupationNumber(s)
+! if ( CIcore_instance%orbitals(s)%values( &
+! CIcore_instance%strings(s)%values(k,b),a) == 0 ) then
+! orbitalB = CIcore_instance%strings(s)%values(k,b)
+! BB = k
+! exit
+! end if
+! end do
+!
+! factor = (-1)**(AA-BB)
+!
+! numberOfOccupiedOrbitals = CIcore_instance%numberOfOccupiedOrbitals%values(s)
+!
+! ! print *, i, j, CIcore_instance%configurations(i)%occupations(:,specie), CIcore_instance%configurations(j)%occupations(:,specie)
+! ! print *, i, j, auxthisA%occupations(:,specie), auxthisB%occupations(:,specie)
+!
+! ! print *, i, j, orbitalA, orbitalB, factor*CIcore_instance%eigenVectors%values(i,1)*CIcore_instance%eigenVectors%values(j,1)
+!
+! auxDensMatrix(s,n)%values( orbitalA,orbitalB)= auxDensMatrix(s,n)%values( orbitalA, orbitalB) + &
+! factor*CIcore_instance%eigenVectors%values(i,state)* &
+! CIcore_instance%eigenVectors%values(j,state)
+! ! ciDensityMatrix(s,state)%values( orbitalA,orbitalB)= ciDensityMatrix(s,state)%values( orbitalA, orbitalB) + &
+! ! factor*CIcore_instance%eigenVectors%values(i,state)* &
+! ! CIcore_instance%eigenVectors%values(j,state)
+!
+! auxDensMatrix(s,n)%values( orbitalB,orbitalA)= auxDensMatrix(s,n)%values( orbitalB, orbitalA) + &
+! factor*CIcore_instance%eigenVectors%values(i,state)* &
+! CIcore_instance%eigenVectors%values(j,state)
+!
+! ! ciDensityMatrix(s,state)%values( orbitalB, orbitalA)= ciDensityMatrix(s,state)%values( orbitalB, orbitalA) + &
+! ! factor*CIcore_instance%eigenVectors%values(i,state)* &
+! ! CIcore_instance%eigenVectors%values(j,state)
+!
+! end if
+! end do
+! end if
+! end if
+! end do
+
+ end if
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+
+ !! Gather the parallel results
+ do species=1, numberOfSpecies
+ do n=1, CIcore_instance%nproc
+ ciDensityMatrix(species,state)%values = ciDensityMatrix(species,state)%values + auxDensMatrix(species,n)%values
+ auxDensMatrix(species,n)%values=0.0
+ end do
+ end do
+
+ end do
+
+
+ !! Open file - to write density matrices
+ unit = 29
+
+ file = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
+ open(unit = unit, file=trim(file), status="new", form="formatted")
+
+ !! Building the CI reduced density matrix in the atomic orbital representation
+ do species=1, numberOfSpecies
+ speciesName = MolecularSystem_getNameOfSpecies(species)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species )
+
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+
+ ! print *, "CI density matrix ", trim(speciesName), state
+ ! call Matrix_show ( ciDensityMatrix(species,state))
+
+ call Matrix_constructor ( atomicDensityMatrix(species,state) , &
+ int(numberOfContractions,8), &
+ int(numberOfContractions,8), 0.0_8 )
+
+ do mu=1, numberOfContractions
+ do nu=1, numberOfContractions
+ do k=1, numberOfContractions
+ atomicDensityMatrix(species,state)%values(mu,nu) = &
+ atomicDensityMatrix(species,state)%values(mu,nu) + &
+ ciDensityMatrix(species,state)%values(k,k) *&
+ coefficients(species)%values(mu,k)*coefficients(species)%values(nu,k)
+
+ do l=k+1, numberOfContractions
+
+ atomicDensityMatrix(species,state)%values(mu,nu) = &
+ atomicDensityMatrix(species,state)%values(mu,nu) + &
+ ciDensityMatrix(species,state)%values(k,l) *&
+ (coefficients(species)%values(mu,k)*coefficients(species)%values(nu,l) + &
+ coefficients(species)%values(mu,l)*coefficients(species)%values(nu,k))
+
+ end do
+ end do
+ end do
+ end do
+
+ ! print *, "atomic density matrix ", trim(speciesName), state
+ ! call Matrix_show ( atomicDensityMatrix(species,state))
+
+ write(auxstring,*) state
+ arguments(2) = speciesName
+ arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
+
+ call Matrix_writeToFile ( atomicDensityMatrix(species,state), unit , arguments=arguments(1:2) )
+
+ end do
+ end do
+
+ write(*,*) ""
+ write(*,*) "==============================="
+ write(*,*) " ONE BODY ENERGY CONTRIBUTIONS:"
+ write(*,*) ""
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ write(*,*) " STATE: ", state
+ do species=1, molecularSystem_instance%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(species)%name ) // &
+ " Kinetic energy = ", sum(transpose(atomicDensityMatrix(species,state)%values)*kineticMatrix(species)%values)
+ write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(species)%name ) // &
+ "/Fixed interact. energy = ", sum(transpose(atomicDensityMatrix(species,state)%values)*attractionMatrix(species)%values)
+ if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(species)%name) // &
+ " Ext Pot energy = ", sum(transpose(atomicDensityMatrix(species,state)%values)*externalPotMatrix(species)%values)
+ print *, ""
+ end do
+ print *, ""
+ end do
+
+ !! Natural orbitals
+
+ if (CONTROL_instance%CI_NATURAL_ORBITALS) then
+
+ write(*,*) ""
+ write(*,*) "=============================="
+ write(*,*) " NATURAL ORBITALS: "
+ write(*,*) ""
+
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+
+ write(*,*) " STATE: ", state
+
+ do species=1, numberOfSpecies
+
+ write(*,*) ""
+ write(*,*) " Natural Orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(species)%name )
+ write(*,*) "-----------------"
+
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species )
+ speciesName = MolecularSystem_getNameOfSpecies(species)
+
+
+ call Vector_constructor ( auxdensityEigenValues, &
+ int(numberOfContractions,4), 0.0_8 )
+
+ call Matrix_constructor ( auxdensityEigenVectors, &
+ int(numberOfContractions,8), &
+ int(numberOfContractions,8), 0.0_8 )
+
+ call Vector_constructor ( densityEigenValues, &
+ int(numberOfContractions,4), 0.0_8 )
+
+ call Matrix_constructor ( densityEigenVectors, &
+ int(numberOfContractions,8), &
+ int(numberOfContractions,8), 0.0_8 )
+
+ call Matrix_eigen ( ciDensityMatrix(species,state), auxdensityEigenValues, auxdensityEigenVectors, SYMMETRIC )
+
+ ! reorder and count significant occupations
+ k=0
+ do u = 1, numberOfContractions
+ densityEigenValues%values(u) = auxdensityEigenValues%values(numberOfContractions - u + 1)
+ densityEigenVectors%values(:,u) = auxdensityEigenVectors%values(:,numberOfContractions - u + 1)
+ if(densityEigenValues%values(u) .ge. 5.0E-5 ) k=k+1
+ end do
+
+ !! Transform to atomic basis
+ densityEigenVectors%values = matmul( coefficients(species)%values, densityEigenVectors%values )
+
+ ! Print eigenvectors with occupation larger than 5.0E-5
+ call Matrix_constructor(auxdensityEigenVectors,int(numberOfContractions,8),int(k,8),0.0_8)
+ do u=1, numberOfContractions
+ do j=1, k
+ auxdensityEigenVectors%values(u,j)=densityEigenVectors%values(u,j)
+ end do
+ end do
+ call Matrix_show( auxdensityEigenVectors, &
+ rowkeys = MolecularSystem_getlabelsofcontractions( species ), &
+ columnkeys = string_convertvectorofrealstostring( densityEigenValues ),&
+ flags=WITH_BOTH_KEYS)
+
+ write(auxstring,*) state
+ arguments(2) = speciesName
+ arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring))
+
+ call Matrix_writeToFile ( densityEigenVectors, unit , arguments=arguments(1:2) )
+ arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring))
+
+ call Vector_writeToFile( densityEigenValues, unit, arguments=arguments(1:2) )
+ !! it's the same
+ !!auxdensityEigenVectors%values = 0
+
+ !!do mu=1, numberOfContractions
+ !! do nu=1, numberOfContractions
+ !! do k=1, numberOfContractions
+ !! auxdensityEigenVectors%values(mu,nu) = auxdensityEigenVectors%values(mu,nu) + &
+ !! densityEigenVectors%values(mu,k) * densityEigenVectors%values(nu,k)*densityEigenValues%values(k)
+ !! end do
+ !! end do
+ !!end do
+ !!print *, "atomic density matrix from natural orbitals"
+ !!call Matrix_show ( auxdensityEigenVectors)
+ write(*,"(A10,A10,A40,F17.12)") "sum of ", trim(speciesName) , "natural orbital occupations", sum(densityEigenValues%values)
+
+ write(*,*) " End of natural orbitals in state: ", state, " for: ", trim(speciesName)
+ end do
+ end do
+
+
+
+ write(*,*) ""
+ write(*,*) " END OF NATURAL ORBITALS"
+ write(*,*) "=============================="
+ write(*,*) ""
+
+ end if
+
+ close(unit)
+
+ deallocate ( jj )
+ deallocate ( indexConfB )
+ deallocate ( indexConfA )
+ deallocate ( coupling )
+ deallocate ( cilevel )
+ deallocate ( cilevelA )
+ deallocate ( CIcore_instance%allIndexConf )
+ deallocate ( stringAinB )
+
+ deallocate( coefficients, atomicDensityMatrix, ciDensityMatrix )
+
+ !$ timeDB = omp_get_wtime()
+ !$ write(*,"(A,F10.4,A4)") "** TOTAL Elapsed Time for Building density matrices: ", timeDB - timeDA ," (s)"
+
+
+ end if
+
+ ! print *, i, i, orbital, orbital, CIcore_instance%eigenVectors%values(i,1)**2
+
+ ! do mu = 1 , numberOfOrbitals
+ ! do nu = 1 , numberOfOrbitals
+
+ ! densityMatrix%values(mu,nu) = &
+ ! densityMatrix%values(mu,nu) + &
+ ! CIcore_instance%eigenVectors%values(i,state)**2 *&
+ ! coefficients%values(mu,orbital)*coefficients%values(nu,orbital)
+ ! end do
+ ! end do
+
+ !!off-Diagonal ground state
+
+ ! do mu = 1 , numberOfOrbitals
+ ! do nu = 1 , numberOfOrbitals
+
+ ! densityMatrix%values(mu,nu) = &
+ ! densityMatrix%values(mu,nu) + &
+ ! factor *&
+ ! CIcore_instance%eigenVectors%values(i,state) *&
+ ! CIcore_instance%eigenVectors%values(j,state) *&
+ ! (coefficients%values(mu,orbitalA)*coefficients%values(nu,orbitalB) + coefficients%values(mu,orbitalB)*coefficients%values(nu,orbitalA))
+ ! end do
+ ! end do
+
+ ! call Vector_constructor(eigenValues, numberOfOrbitals)
+ ! call Matrix_constructor(eigenVectors, int(numberOfOrbitals,8), int(numberOfOrbitals,8))
+ ! call Matrix_eigen(ciOccupationMatrix, eigenValues, eigenVectors, SYMMETRIC)
+
+ ! print *, "Diagonal sum", sum(eigenValues%values)
+ ! call Vector_show(eigenValues)
+
+ ! call Matrix_show(eigenVectors)
+ ! print *, arguments(1:2)
+ ! call Matrix_show ( densityMatrix )
+
+ ! call Matrix_constructor ( ciOccupationNumbers , int(numberOfOrbitals,8) , &
+ ! int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8 )
+
+ ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ ! sumaPrueba=0
+ ! do j=1, numberOfOccupiedOrbitals
+ ! ciOccupationNumbers%values(j,state) = 1.0
+ ! end do
+
+ ! ! !Get occupation numbers from each configuration contribution
+
+ ! do i=1, CIcore_instance%numberOfConfigurations
+ ! do j=1, numberOfOccupiedOrbitals
+
+ ! !! Occupied orbitals
+ ! ciOccupationNumbers%values( j, state)= ciOccupationNumbers%values( j, state) - &
+ ! CIcore_instance%eigenVectors%values(i,state)**2
+ ! !! Unoccupied orbitals
+ ! orbital = CIcore_instance%configurations(i)%occupations(j,specie)
+
+ ! ciOccupationNumbers%values( orbital, state)= ciOccupationNumbers%values( orbital, state) + &
+ ! CIcore_instance%eigenVectors%values(i,state)**2
+
+ ! ! print *, j, orbital, CIcore_instance%eigenVectors%values(i,state)**2
+ ! ! sumaPrueba=sumaPrueba+CIcore_instance%eigenVectors%values(i,state)**2
+ ! end do
+ ! ! end if
+
+ ! end do
+
+ ! ! print *, "suma", sumaPrueba
+ ! !Build a new density matrix (P) in atomic orbitals
+
+ ! call Matrix_constructor ( densityMatrix , &
+ ! int(numberOfOrbitals,8), &
+ ! int(numberOfOrbitals,8), 0.0_8 )
+
+ ! wfnFile = "lowdin.wfn"
+ ! wfnUnit = 20
+
+ ! open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+
+ ! arguments(2) = speciesName
+ ! arguments(1) = "COEFFICIENTS"
+
+ ! coefficients = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfOrbitals,4), &
+ ! columns= int(numberOfOrbitals,4), binary=.true., arguments=arguments(1:2))
+
+ ! close(wfnUnit)
+
+ ! do mu = 1 , numberOfOrbitals
+ ! do nu = 1 , numberOfOrbitals
+ ! do k = 1 , numberOfOrbitals
+
+ ! densityMatrix%values(mu,nu) = &
+ ! densityMatrix%values(mu,nu) + &
+ ! ciOccupationNumbers%values(k, state)**2* &
+ ! coefficients%values(mu,k)*coefficients%values(nu,k)
+ ! end do
+ ! end do
+ ! end do
+
+ ! write(auxstring,*) state
+ ! arguments(2) = speciesName
+ ! arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
+
+ ! call Matrix_writeToFile ( densityMatrix, unit , arguments=arguments(1:2) )
+
+ ! print *, arguments(1:2)
+ ! call Matrix_show ( densityMatrix )
+
+ ! call Matrix_destructor(coefficients)
+ ! call Matrix_destructor(densityMatrix)
+
+
+ ! end do
+
+ ! !Write occupation numbers to file
+ ! write (6,"(T8,A10,A20)") trim(MolecularSystem_getNameOfSpecies(specie)),"OCCUPATIONS:"
+
+ ! call Matrix_show ( ciOccupationNumbers )
+
+ ! arguments(2) = speciesName
+ ! arguments(1) = "OCCUPATIONS"
+
+ ! call Matrix_writeToFile ( ciOccupationNumbers, unit , arguments=arguments(1:2) )
+
+ ! call Matrix_destructor(ciOccupationNumbers)
+
+ end subroutine CImod_densityMatrices
+
+ !>
+ !! @brief Maneja excepciones de la clase
+ !<
+ subroutine CImod_exception( typeMessage, description, debugDescription)
+ implicit none
+ integer :: typeMessage
+ character(*) :: description
+ character(*) :: debugDescription
+
+ type(Exception) :: ex
+
+ call Exception_constructor( ex , typeMessage )
+ call Exception_setDebugDescription( ex, debugDescription )
+ call Exception_setDescription( ex, description )
+ call Exception_show( ex )
+ call Exception_destructor( ex )
+
+ end subroutine CImod_exception
+
+ !>
+ !! @brief Destructor por omision
+ !!
+ !! @param this
+ !<
+ subroutine CImod_destructor()
+ implicit none
+ integer i,j,m,n,p,q,c
+ integer numberOfSpecies
+ integer :: isLambdaEqual1
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+
+ !!Destroy configurations
+ !!Ground State
+ if (allocated(CIcore_instance%configurations)) then
+ c=1
+ call Configuration_destructor(CIcore_instance%configurations(c) )
+
+ do c=2, CIcore_instance%numberOfConfigurations
+ call Configuration_destructor(CIcore_instance%configurations(c) )
+ end do
+
+ if (allocated(CIcore_instance%configurations)) deallocate(CIcore_instance%configurations)
+ end if
+
+ call Matrix_destructor(CIcore_instance%hamiltonianMatrix)
+ call Vector_destructorInteger (CIcore_instance%numberOfOccupiedOrbitals)
+ call Vector_destructorInteger (CIcore_instance%numberOfOrbitals)
+ call Vector_destructor (CIcore_instance%lambda)
+
+ CIcore_instance%isInstanced=.false.
+
+ end subroutine CImod_destructor
+
+
+end module CImod_
+
+
diff --git a/src/CI/CImolpro b/src/CI/CImolpro
new file mode 100644
index 00000000..647a9ad1
--- /dev/null
+++ b/src/CI/CImolpro
@@ -0,0 +1,311 @@
+ !>
+ !! @brief Muestra informacion del objeto
+ !!
+ !! @param this
+ !<
+! subroutine CI_core_printTransformedIntegralsToFile()
+! implicit none
+!
+!! type(TransformIntegrals) :: repulsionTransformer
+! integer :: numberOfSpecies
+! integer :: i,j,m,n,mu,nu
+! integer :: a,b,r,s,u, auxIndex
+! integer :: z
+! integer :: stats, recNum
+! character(10) :: nameOfSpecie, auxNameOfSpecie
+! character(10) :: nameOfOtherSpecie
+! integer :: ocupationNumber
+! integer :: ocupationNumberOfOtherSpecie
+! integer :: numberOfContractions
+! integer :: numberOfContractionsOfOtherSpecie
+! type(Matrix) :: auxMatrix
+! type(Matrix) :: molecularCouplingMatrix
+! type(Matrix) :: molecularExtPotentialMatrix
+!
+! integer :: spin
+!
+! real(8) :: totalCoupEnergy
+! real(8) :: fixedPotEnergy
+! real(8) :: fixedIntEnergy
+! real(8) :: KineticEnergy
+! real(8) :: RepulsionEnergy
+! real(8) :: couplingEnergy
+
+
+! numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+!
+! print *,""
+! print *,"BEGIN INTEGRALS TRANFORMATION:"
+! print *,"========================================"
+! print *,""
+! print *,"--------------------------------------------------"
+! print *," Algorithm Four-index integral tranformation"
+! print *," Yamamoto, Shigeyoshi; Nagashima, Umpei. "
+! print *," Computer Physics Communications, 2005, 166, 58-65"
+! print *,"--------------------------------------------------"
+! print *,""
+!
+! totalCoupEnergy = 0.0_8
+! fixedPotEnergy = 0.0_8
+! fixedIntEnergy = 0.0_8
+! KineticEnergy = 0.0_8
+! RepulsionEnergy = 0.0_8
+! couplingEnergy = 0.0_8
+! spin = 0
+!
+! do i=1, numberOfSpecies
+! nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) )
+! numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i )
+! spin = MolecularSystem_getMultiplicity(i) - 1
+!
+! if(trim(nameOfSpecie) /= "E-BETA" ) then
+!
+! if(trim(nameOfSpecie) /= "U-" ) then
+!
+! open(unit=35, file="FCIDUMP-"//trim(nameOfSpecie)//".com", form="formatted", status="replace")
+!
+! write(35,"(A)")"gprint basis"
+! write(35,"(A)")"memory 1000 M"
+! write(35,"(A)")"cartesian"
+! write(35,"(A)")"gthresh twoint=1e-12 prefac=1e-14 energy=1e-10 edens=1e-10 zero=1e-12"
+! write(35,"(A)")"basis={"
+! call CI_core_printBasisSetToFile(35)
+! write(35,"(A)")"}"
+!
+! write(35,"(A)")"symmetry nosym"
+! write(35,"(A)")"angstrom"
+! write(35,"(A)")"geometry={"
+! call CI_core_printGeometryToFile(35)
+! write(35,"(A)")"}"
+!
+! write(35,"(A)")"import 21500.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"jcoup")
+! write(35,"(A)")"import 21510.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"icoup")
+! write(35,"(A)")"import 21520.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"kin")
+! write(35,"(A)")"import 21530.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"coeff")
+!
+! if(trim(nameOfSpecie) == "E-ALPHA") then
+!
+! write(35,"(A)")"import 21550.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//"E-BETA"//"."//"coeff")
+!
+! end if
+!
+! write(35,"(A)")"import 21540.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"dens")
+! !write(35,"(A)")"import 21560.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"pot")
+!
+! write(35,"(A)")"{matrop"
+! write(35,"(A)")"load Jcoup, SQUARE 21500.2"
+! write(35,"(A)")"load Icoup, SQUARE 21510.2"
+! write(35,"(A)")"load K, SQUARE 21520.2"
+! !write(35,"(A)")"load Pot, SQUARE 21560.2"
+! write(35,"(A)")"add H01, K Icoup Jcoup"! Pot"
+! write(35,"(A)")"save H01, 21511.2 H0"
+! write(35,"(A)")"}"
+!
+! if(trim(nameOfSpecie) == "E-ALPHA") then
+! write(35,"(A)")"{matrop"
+! write(35,"(A)")"load Ca, SQUARE 21530.2"
+! write(35,"(A)")"load Cb, SQUARE 21550.2"
+! write(35,"(A)")"save Ca, 2100.1 ORBITALS alpha"
+! write(35,"(A)")"save Cb, 2100.1 ORBITALS beta"
+! write(35,"(A)")"}"
+! else
+! write(35,"(A)")"{matrop"
+! write(35,"(A)")"load C, SQUARE 21530.2"
+! write(35,"(A)")"save C, 2100.1 ORBITALS"
+! write(35,"(A)")"}"
+! end if
+!
+! write(35,"(A)")"{matrop"
+! write(35,"(A)")"load D, SQUARE 21540.2"
+! write(35,"(A)")"save D, 21400.1 DENSITY"
+! write(35,"(A)")"}"
+!
+!
+! ! write(35,"(A,I3,A,I3,A,I3,A1)")"$FCI NORB=",numberOfContractions, ",NELEC=", MolecularSystem_getNumberOfParticles(i)-spin, ", MS2=", spin,","
+! !
+! ! write(35,"(A)",advance="no") "ORBSYM="
+! ! do z=1, numberOfContractions
+! ! write(35,"(I1,A1)",advance="no") 1,","
+! ! end do
+! ! write(35,"(A)") ""
+! !
+! ! write(35, "(A,I3,A,I9)") "ISYM=",1, ",MEMORY=", 200000000
+! !
+! ! write(35, "(A)") "$"
+! !
+! ! print *, "FOUR CENTER INTEGRALS FOR SPECIE: ", trim(nameOfSpecie)
+! !
+! ! recNum = 0
+! ! do a = 1, numberOfContractions
+! ! n = a
+! ! do b=a, numberOfContractions
+! ! u = b
+! ! do r = n, numberOfContractions
+! ! do s = u, numberOfContractions
+! !
+! ! auxIndex = IndexMap_tensorR4ToVector( a, b, r, s, numberOfContractions )
+! ! write(35,"(F20.10,4I3)") CI_core_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1), a, b, r, s
+! !
+! ! end do
+! ! u=r+1
+! ! end do
+! ! end do
+! ! end do
+! !
+! !
+! ! print *, "TWO CENTER TRANSFORMED INTEGRALS FOR SPECIE: ", trim(nameOfSpecie)
+! !
+! ! do m=1,numberOfContractions
+! ! do n=1, m
+! ! write(35,"(F20.10,4I3)") CI_core_instance%twoCenterIntegrals(i)%values(m,n), m, n, 0, 0
+! ! end do
+! ! end do
+!
+! !!Calculating the core energy....
+!
+!
+!
+! totalCoupEnergy = MolecularSystem_instance%totalCouplingEnergy
+! fixedPotEnergy = MolecularSystem_instance%puntualInteractionEnergy
+!
+! do j = 1, numberOfSpecies
+!
+! auxNameOfSpecie= trim( MolecularSystem_getNameOfSpecie( j ) )
+!
+! if(trim(auxNameOfSpecie) == "E-ALPHA" .or. trim(auxNameOfSpecie) == "E-BETA" .or. trim(auxNameOfSpecie) == "e-") cycle
+!
+! fixedIntEnergy = fixedIntEnergy + MolecularSystem_instance%quantumPuntualInteractionEnergy(j)
+! KineticEnergy = KineticEnergy + MolecularSystem_instance%kineticEnergy(j)
+! RepulsionEnergy = RepulsionEnergy + MolecularSystem_instance%repulsionEnergy(j)
+! couplingEnergy = couplingEnergy + MolecularSystem_instance%couplingEnergy(j)
+!
+! end do
+!
+! !!COMO SEA QUE SE META LA ENERGIA DE CORE
+! !write(35,"(F20.10,4I3)") (couplingEnergy-totalCoupEnergy+fixedPotEnergy+fixedIntEnergy+KineticEnergy+RepulsionEnergy), 0, 0, 0, 0
+!
+! print*, "COREENERGY ", (couplingEnergy-totalCoupEnergy+fixedPotEnergy+fixedIntEnergy+KineticEnergy+RepulsionEnergy)
+!
+! write(35,"(A)")"{hf"
+! write(35,"(A)")"maxit 250"
+! write(35,"(A10,I2,A1,A6,I2,A1,A6,I3)")"wf spin=", spin, ",", "charge=",0, ",", "elec=", MolecularSystem_getNumberOfParticles(i)-spin
+! write(35,"(A)")"start 2100.1"
+! write(35,"(A)")"}"
+!
+!
+! write(35,"(A)")"{fci"
+! write(35,"(A)")"maxit 250"
+! write(35,"(A)")"dm 21400.1, IGNORE_ERROR"
+! write(35,"(A)")"orbit 2100.1, IGNORE_ERROR"
+! write(35,"(A10,I2,A1,A6,I2,A1,A6,I3)")"wf spin=", spin, ",", "charge=",0, ",", "elec=", MolecularSystem_getNumberOfParticles(i)-spin
+! ! write(35,"(A)")"print, orbital=2 integral = 2"
+! ! write(35,"(A)")"CORE"
+! write(35,"(A)")"}"
+!
+! write(35,"(A)")"{matrop"
+! write(35,"(A)")"load D, DEN, 21400.1"
+! ! write(35,"(A)")"print D"
+! write(35,"(A)")"natorb Norb, D"
+! write(35,"(A)")"save Norb, 21570.2"
+! ! write(35,"(A)")"print Norb"
+! write(35,"(A)")"}"
+!
+! write(35,"(A)")"put molden "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"molden")//"; orb, 21570.2"
+!
+! close(35)
+!
+! print*, ""
+!
+! stats = system("molpro "//"FCIDUMP-"//trim(nameOfSpecie)//".com ")
+! stats = system("cat "//"FCIDUMP-"//trim(nameOfSpecie)//".out ")
+!
+! print*, ""
+!
+! print *,"END"
+!
+! end if
+!
+! end if
+!
+! end do
+
+! end subroutine CI_core_printTransformedIntegralsToFile
+
+! subroutine CI_core_printGeometryToFile(unit)
+! implicit none
+! integer :: unit
+!
+! integer :: i
+! integer :: from, to
+! real(8) :: origin(3)
+! character(50) :: auxString
+!
+!
+! do i = 1, MolecularSystem_getTotalNumberOfParticles()
+!
+! origin = MolecularSystem_getOrigin( iterator = i ) * AMSTRONG
+! auxString = trim( MolecularSystem_getNickName( iterator = i ) )
+!
+! if( String_findSubstring( trim( auxString ), "e-") == 1 ) then
+! if( String_findSubstring( trim( auxString ), "BETA") > 1 ) then
+! cycle
+! end if
+!
+! from =String_findSubstring( trim(auxString), "[")
+! to = String_findSubstring( trim(auxString), "]")
+! auxString = auxString(from+1:to-1)
+!
+! else if( String_findSubstring( trim( auxString ), "_") /= 0 ) then
+! cycle
+! end if
+!
+!
+! write (unit,"(A10,3F20.10)") trim( auxString ), origin(1), origin(2), origin(3)
+!
+! end do
+
+! end subroutine CI_core_printGeometryToFile
+
+
+! subroutine CI_core_printBasisSetToFile(unit)
+! implicit none
+!
+! integer :: unit
+!
+! integer :: i, j
+! character(16) :: auxString
+!
+!
+! do i =1, MolecularSystem_instance%numberOfQuantumSpecies
+!
+! auxString=trim( Map_getKey( MolecularSystem_instance%speciesID, iterator=i ) )
+!
+! if( String_findSubstring( trim(auxString), "e-") == 1 ) then
+!
+! if( String_findSubstring( trim(auxString), "BETA") > 1 ) then
+!
+! cycle
+!
+! end if
+!
+!
+! end if
+!
+! if(trim(auxString)=="U-") cycle
+!
+! do j =1, size(MolecularSystem_instance%particlesPtr)
+!
+! if ( trim(MolecularSystem_instance%particlesPtr(j)%symbol) == trim( Map_getKey( MolecularSystem_instance%speciesID, iterator=i ) ) &
+! .and. MolecularSystem_instance%particlesPtr(j)%isQuantum ) then
+!
+! call BasisSet_showInMolproForm( MolecularSystem_instance%particlesPtr(j)%basis, trim(MolecularSystem_instance%particlesPtr(j)%nickname), unit=unit )
+!
+! end if
+!
+! end do
+!
+! end do
+
+! end subroutine CI_core_printBasisSetToFile
+
+
diff --git a/src/CI/Configuration.f90 b/src/CI/Configuration.f90
index 030963e4..2f33fe8a 100644
--- a/src/CI/Configuration.f90
+++ b/src/CI/Configuration.f90
@@ -1147,7 +1147,7 @@ subroutine Configuration_show(this)
do i=1, numberOfSpecies
- print *, "For specie ", MolecularSystem_getNameOfSpecie ( i )
+ print *, "For specie ", MolecularSystem_getNameOfSpecies( i )
! print *, "Excitations: ", this%order(i)
! print *, "Ndeterminants: ",this%nDeterminants
! print *, "Occupations"
diff --git a/src/CI/ConfigurationInteraction.f90 b/src/CI/ConfigurationInteraction.f90
deleted file mode 100644
index 10457a9d..00000000
--- a/src/CI/ConfigurationInteraction.f90
+++ /dev/null
@@ -1,5202 +0,0 @@
-!******************************************************************************
-!! This code is part of LOWDIN Quantum chemistry package
-!!
-!! this program has been developed under direction of:
-!!
-!! UNIVERSIDAD NACIONAL DE COLOMBIA"
-!! PROF. ANDRES REYES GROUP"
-!! http://www.qcc.unal.edu.co"
-!!
-!! UNIVERSIDAD DE GUADALAJARA"
-!! PROF. ROBERTO FLORES GROUP"
-!! http://www.cucei.udg.mx/~robertof"
-!!
-!! AUTHORS
-!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
-!!
-!! CONTRIBUTORS
-!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
-!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
-!!
-!!
-!! Todos los derechos reservados, 2011
-!!
-!!******************************************************************************
-
-module ConfigurationInteraction_
- use Exception_
- use Matrix_
- use Vector_
- use MolecularSystem_
- use Configuration_
- use ReadTransformedIntegrals_
- use MolecularSystem_
- use String_
- use IndexMap_
- use InputCI_
- use omp_lib
- ! use ArpackInterface_
- use JadamiluInterface_
- implicit none
-
- !>
- !! @brief Configuration Interaction Module, works in spin orbitals
- !!
- !! @author felix
- !!
- !! Creation data : 07-24-12
- !!
- !! History change:
- !!
- !! - 07-24-12 : Felix Moncada ( fsmoncadaa@unal.edu.co )
- !! -# description.
- !! - 07-09-16 : Jorge Charry ( jacharrym@unal.edu.co )
- !! -# Add CIS, and Fix CISD.
- !! - MM-DD-YYYY : authorOfChange ( email@server )
- !! -# description
- !!
- !<
-
- type, public :: ConfigurationInteraction
- logical :: isInstanced
- integer :: numberOfSpecies
- type(matrix) :: hamiltonianMatrix
- type(ivector8) :: auxIndexCIMatrix
- type(matrix) :: eigenVectors
- type(matrix) :: initialEigenVectors
- type(vector8) :: initialEigenValues
- integer(8) :: numberOfConfigurations
- integer :: nproc
- type(ivector) :: numberOfCoreOrbitals
- type(ivector) :: numberOfOccupiedOrbitals
- type(ivector) :: numberOfOrbitals
- type(vector) :: numberOfSpatialOrbitals2
- type(vector8) :: eigenvalues
- type(vector) :: lambda !!Number of particles per orbital, module only works for 1 or 2 particles per orbital
- type(matrix), allocatable :: fourCenterIntegrals(:,:)
- type(matrix), allocatable :: twoCenterIntegrals(:)
- type(imatrix8), allocatable :: twoIndexArray(:)
- type(imatrix8), allocatable :: fourIndexArray(:)
- type(imatrix), allocatable :: strings(:) !! species, conf, occupations
- type(imatrix1), allocatable :: orbitals(:) !! species, conf, occupations
- integer, allocatable :: sumstrings(:) !! species
- type(ivector), allocatable :: auxstring(:,:) !! species, occupations
- type(ivector8), allocatable :: numberOfStrings(:) !! species, excitation level, number of strings
- type(ivector8), allocatable :: numberOfStrings2(:) !! species, excitation level, number of strings
-
- !! species, threads
- type(imatrix), allocatable :: couplingMatrix(:,:)
- type(Vector), allocatable :: couplingMatrixEnergyOne(:,:)
-! type(matrix), allocatable :: couplingMatrixEnergyTwo(:)
- type(ivector), allocatable :: couplingMatrixFactorOne(:,:)
- type(ivector), allocatable :: couplingMatrixOrbOne(:,:)
- type(imatrix), allocatable :: nCouplingOneTwo(:,:)
- type(imatrix), allocatable :: nCouplingSize(:,:)
-
- type(ivector1), allocatable :: couplingOrderList(:,:)
- type(ivector1), allocatable :: couplingOrderIndex(:,:)
-
- integer, allocatable :: ciOrderList(:,:)
- integer, allocatable :: auxciOrderList(:)
- integer :: sizeCiOrderList
- integer(8), allocatable :: ciOrderSize1(:,:)
- integer(8), allocatable :: ciOrderSize2(:,:)
- integer(4), allocatable :: allIndexConf(:,:) !! species, total number of configurations
-
- integer :: ncouplingOrderOne
- integer :: ncouplingOrderTwo
- integer :: ncouplingOrderTwoDiff
-
- type(imatrix) :: auxConfigurations !! species, configurations for initial hamiltonian
- type(configuration), allocatable :: configurations(:)
- integer(2), allocatable :: auxconfs(:,:,:) ! nconf, species, occupation
- type (Vector8) :: diagonalHamiltonianMatrix
- type (Vector8) :: diagonalHamiltonianMatrix2
- real(8) :: totalEnergy
- integer, allocatable :: totalNumberOfContractions(:)
- integer, allocatable :: occupationNumber(:)
- integer, allocatable :: recursionVector1(:)
- integer, allocatable :: recursionVector2(:)
- integer, allocatable :: CILevel(:)
- integer, allocatable :: pindexConf(:,:)
- integer :: maxCILevel
- type (Matrix) :: initialHamiltonianMatrix
- type (Matrix) :: initialHamiltonianMatrix2
- character(20) :: level
- real(8) :: timeA(7)
- real(8) :: timeB(7)
-
- end type ConfigurationInteraction
-
- type, public :: HartreeFock
- real(8) :: totalEnergy
- real(8) :: puntualInteractionEnergy
- type(matrix) :: coefficientsofcombination
- type(matrix) :: HcoreMatrix
- end type HartreeFock
-
- integer, allocatable :: Conf_occupationNumber(:)
- type(ConfigurationInteraction) :: ConfigurationInteraction_instance
- type(HartreeFock) :: HartreeFock_instance
-
- public :: &
- ConfigurationInteraction_constructor, &
- ConfigurationInteraction_destructor, &
- ConfigurationInteraction_getTotalEnergy, &
- ConfigurationInteraction_run, &
- ConfigurationInteraction_showEigenVectors, &
- ConfigurationInteraction_densityMatrices, &
- ConfigurationInteraction_show
-
- private
-
-contains
-
-
- !>
- !! @brief Constructor por omision
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_constructor(level)
- implicit none
- character(*) :: level
-
- integer :: numberOfSpecies
- integer :: i,j,k,l,m,n,p,q,cc,r,s,el, nproc
- integer(8) :: c
- integer :: ma,mb,mc,md,me,pa,pb,pc,pd,pe
- integer :: isLambdaEqual1,lambda,otherlambda
- type(vector) :: occupiedCode
- type(vector) :: unoccupiedCode
- real(8) :: totalEnergy
-
- character(50) :: wfnFile
- integer :: wfnUnit
- character(50) :: nameOfSpecie
- integer :: numberOfContractions
- character(50) :: arguments(2)
-
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
-
- !! Open file for wavefunction
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- !! Load results...
- call Vector_getFromFile(unit=wfnUnit, binary=.true., value=HartreeFock_instance%totalEnergy, &
- arguments=["TOTALENERGY"])
- call Vector_getFromFile(unit=wfnUnit, binary=.true., value=HartreeFock_instance%puntualInteractionEnergy, &
- arguments=["PUNTUALINTERACTIONENERGY"])
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- ConfigurationInteraction_instance%numberOfSpecies = numberOfSpecies
-
-
- do i=1, numberOfSpecies
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) )
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i )
-
- arguments(2) = nameOfSpecie
- arguments(1) = "HCORE"
- HartreeFock_instance%HcoreMatrix = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- arguments(1) = "COEFFICIENTS"
- HartreeFock_instance%coefficientsofcombination = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
- end do
-
- ConfigurationInteraction_instance%isInstanced=.true.
- ConfigurationInteraction_instance%level=level
- ConfigurationInteraction_instance%numberOfConfigurations=0
-
- call Vector_constructorInteger (ConfigurationInteraction_instance%numberOfCoreOrbitals, numberOfSpecies)
- call Vector_constructorInteger (ConfigurationInteraction_instance%numberOfOccupiedOrbitals, numberOfSpecies)
- call Vector_constructorInteger (ConfigurationInteraction_instance%numberOfOrbitals, numberOfSpecies)
- call Vector_constructor (ConfigurationInteraction_instance%lambda, numberOfSpecies)
- call Vector_constructor (ConfigurationInteraction_instance%numberOfSpatialOrbitals2, numberOfSpecies)
-
- ConfigurationInteraction_instance%nproc = omp_get_max_threads()
-
- if ( allocated (ConfigurationInteraction_instance%strings ) ) &
- deallocate ( ConfigurationInteraction_instance%strings )
- allocate ( ConfigurationInteraction_instance%strings ( numberOfSpecies ) )
-
- if ( allocated (ConfigurationInteraction_instance%orbitals ) ) &
- deallocate ( ConfigurationInteraction_instance%orbitals )
- allocate ( ConfigurationInteraction_instance%orbitals ( numberOfSpecies ) )
-
- if ( allocated (ConfigurationInteraction_instance%auxstring ) ) &
- deallocate ( ConfigurationInteraction_instance%auxstring )
- allocate ( ConfigurationInteraction_instance%auxstring ( ConfigurationInteraction_instance%nproc, numberOfSpecies ) )
-
- if ( allocated (ConfigurationInteraction_instance%couplingMatrix ) ) &
- deallocate ( ConfigurationInteraction_instance%couplingMatrix )
- allocate ( ConfigurationInteraction_instance%couplingMatrix ( numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated (ConfigurationInteraction_instance%couplingMatrixEnergyOne ) ) &
- deallocate ( ConfigurationInteraction_instance%couplingMatrixEnergyOne )
- allocate ( ConfigurationInteraction_instance%couplingMatrixEnergyOne ( numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated (ConfigurationInteraction_instance%couplingMatrixFactorOne ) ) &
- deallocate ( ConfigurationInteraction_instance%couplingMatrixFactorOne )
- allocate ( ConfigurationInteraction_instance%couplingMatrixFactorOne ( numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated (ConfigurationInteraction_instance%couplingMatrixOrbOne ) ) &
- deallocate ( ConfigurationInteraction_instance%couplingMatrixOrbOne )
- allocate ( ConfigurationInteraction_instance%couplingMatrixOrbOne ( numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated (ConfigurationInteraction_instance%nCouplingOneTwo ) ) &
- deallocate ( ConfigurationInteraction_instance%nCouplingOneTwo )
- allocate ( ConfigurationInteraction_instance%nCouplingOneTwo ( numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated (ConfigurationInteraction_instance%nCouplingSize ) ) &
- deallocate ( ConfigurationInteraction_instance%nCouplingSize )
- allocate ( ConfigurationInteraction_instance%nCouplingSize ( numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated (ConfigurationInteraction_instance%numberOfStrings ) ) &
- deallocate ( ConfigurationInteraction_instance%numberOfStrings )
- allocate ( ConfigurationInteraction_instance%numberOfStrings ( numberOfSpecies ) )
-
- if ( allocated (ConfigurationInteraction_instance%numberOfStrings2 ) ) &
- deallocate ( ConfigurationInteraction_instance%numberOfStrings2 )
- allocate ( ConfigurationInteraction_instance%numberOfStrings2 ( numberOfSpecies ) )
-
- if ( allocated (ConfigurationInteraction_instance%sumstrings ) ) &
- deallocate ( ConfigurationInteraction_instance%sumstrings )
- allocate ( ConfigurationInteraction_instance%sumstrings ( numberOfSpecies ) )
-
- if ( allocated ( ConfigurationInteraction_instance%totalNumberOfContractions ) ) &
- deallocate ( ConfigurationInteraction_instance%totalNumberOfContractions )
- allocate ( ConfigurationInteraction_instance%totalNumberOfContractions (numberOfSpecies ) )
-
- if ( allocated ( ConfigurationInteraction_instance%occupationNumber ) ) &
- deallocate ( ConfigurationInteraction_instance%occupationNumber )
- allocate ( ConfigurationInteraction_instance%occupationNumber (numberOfSpecies ) )
-
- if ( allocated ( ConfigurationInteraction_instance%recursionVector1 ) ) &
- deallocate ( ConfigurationInteraction_instance%recursionVector1 )
- allocate ( ConfigurationInteraction_instance%recursionVector1 (numberOfSpecies ) )
-
- if ( allocated ( ConfigurationInteraction_instance%recursionVector2 ) ) &
- deallocate ( ConfigurationInteraction_instance%recursionVector2 )
- allocate ( ConfigurationInteraction_instance%recursionVector2 (numberOfSpecies ) )
-
- if ( allocated ( ConfigurationInteraction_instance%CILevel) ) &
- deallocate ( ConfigurationInteraction_instance%CILevel )
- allocate ( ConfigurationInteraction_instance%CILevel (numberOfSpecies ) )
-
- if ( allocated ( ConfigurationInteraction_instance%pindexConf) ) &
- deallocate ( ConfigurationInteraction_instance%pindexConf )
- allocate ( ConfigurationInteraction_instance%pindexConf (numberOfSpecies, ConfigurationInteraction_instance%nproc ) )
-
- if ( allocated ( Conf_occupationNumber ) ) &
- deallocate ( Conf_occupationNumber )
- allocate ( Conf_occupationNumber (numberOfSpecies ) )
-
-
- ConfigurationInteraction_instance%recursionVector1 = 1
- ConfigurationInteraction_instance%recursionVector2 = 0
-
- ConfigurationInteraction_instance%recursionVector1(numberOfSpecies) = 0
- ConfigurationInteraction_instance%recursionVector2(numberOfSpecies) = 1
-
- ConfigurationInteraction_instance%pindexConf = 0
-
- do i=1, numberOfSpecies
- !! We are working in spin orbitals not in spatial orbitals!
- ConfigurationInteraction_instance%lambda%values(i) = MolecularSystem_getLambda( i )
- ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i) = 0
- ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) = int (MolecularSystem_getOcupationNumber( i )* &
- ConfigurationInteraction_instance%lambda%values(i))
- ConfigurationInteraction_instance%numberOfOrbitals%values(i) = MolecularSystem_getTotalNumberOfContractions( i )* &
- ConfigurationInteraction_instance%lambda%values(i)
- ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(i) = MolecularSystem_getTotalNumberOfContractions( i )
- ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(i) = &
- ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(i) * ( &
- ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(i) + 1 ) / 2
-
-
- ConfigurationInteraction_instance%totalNumberOfContractions( i ) = MolecularSystem_getTotalNumberOfContractions( i )
- ConfigurationInteraction_instance%occupationNumber( i ) = int( MolecularSystem_instance%species(i)%ocupationNumber )
- Conf_occupationNumber( i ) = MolecularSystem_instance%species(i)%ocupationNumber
-
-
- !! Take the active space from input
- if ( InputCI_Instance(i)%coreOrbitals /= 0 ) then
- ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i) = InputCI_Instance(i)%coreOrbitals
- end if
- if ( InputCI_Instance(i)%activeOrbitals /= 0 ) then
- ConfigurationInteraction_instance%numberOfOrbitals%values(i) = InputCI_Instance(i)%activeOrbitals * &
- ConfigurationInteraction_instance%lambda%values(i) + &
- ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i)
- end if
-
- !!Uneven occupation number = alpha
- !!Even occupation number = beta
- end do
-
-
- call Configuration_globalConstructor()
-
- close(wfnUnit)
-
- end subroutine ConfigurationInteraction_constructor
-
- subroutine ConfigurationInteraction_buildStrings()
- implicit none
-
- integer(8) :: a,b,c,c1,c2,aa,d
- integer :: ci, oci, cilevel,maxcilevel
- integer :: u,uu,vv, p, nn,z
- integer :: i,j
- integer :: numberOfSpecies, auxnumberOfSpecies,s
- type(ivector) :: order
- integer(8) :: ssize
- real(8) :: timeA, timeB
- type(vector), allocatable :: occupiedCode(:)
- type(vector), allocatable :: unoccupiedCode(:)
-
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- if ( allocated( occupiedCode ) ) deallocate( occupiedCode )
- allocate (occupiedCode ( numberOfSpecies ) )
- if ( allocated( unoccupiedCode ) ) deallocate( unoccupiedCode )
- allocate (unoccupiedCode ( numberOfSpecies ) )
-
- call Vector_constructorInteger (order, numberOfSpecies, 0 )
- order%values = 0
-
- s = 0
- do i = 1, numberOfSpecies
-
- call Vector_constructorInteger8 (ConfigurationInteraction_instance%numberOfStrings(i), &
- int(ConfigurationInteraction_instance%CILevel(i) + 1,8), 0_8)
-
- ConfigurationInteraction_instance%numberOfStrings(i)%values(1) = 1 !! ground
-
- write (*,"(A,A)") " ", MolecularSystem_getNameOfSpecie(i)
-
- do cilevel = 1,ConfigurationInteraction_instance%CILevel(i)
-
- call Vector_constructor (occupiedCode(i), cilevel, real(ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i),8) )
- call Vector_constructor (unoccupiedCode(i), cilevel, 0.0_8)
-
- unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ! it's also a lower bound in a for loop
-
- if ( cilevel <= ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ) then
-
- !! just get the number of strings...
- ci = 0
- oci = ConfigurationInteraction_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel)
-
- write (*,"(A,I4,I8)") " ", cilevel, ConfigurationInteraction_instance%numberOfStrings(i)%values(cilevel+1)
-
- end if
- end do
- write (*,"(A,I8)") " Total:", sum(ConfigurationInteraction_instance%numberOfStrings(i)%values)
- write (*,"(A)") ""
-
- !! allocate the strings arrays
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) > 0 ) then
- call Matrix_constructorInteger( ConfigurationInteraction_instance%strings(i), &
- int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i),8), &
- sum(ConfigurationInteraction_instance%numberOfStrings(i)%values), int(0,4))
-
- call Matrix_constructorInteger1( ConfigurationInteraction_instance%orbitals(i), &
- int(ConfigurationInteraction_instance%numberOfOrbitals%values(i),8), &
- sum(ConfigurationInteraction_instance%numberOfStrings(i)%values), 0_1)
-
- else
- call Matrix_constructorInteger( ConfigurationInteraction_instance%strings(i), &
- 1_8, 1_8, int(0,4))
- call Matrix_constructorInteger1( ConfigurationInteraction_instance%orbitals(i), &
- 1_8, 1_8, 0_1)
-
- end if
-
- !! zero, build the reference
- call Vector_constructorInteger (order, numberOfSpecies, 0 )
-
- call Vector_constructor (occupiedCode(i), 1, 0.0_8) !! initialize in zero
- call Vector_constructor (unoccupiedCode(i), 1, 0.0_8)
-
- c = 0
- c = c + 1
- call Configuration_constructorB(ConfigurationInteraction_instance%strings(i), ConfigurationInteraction_instance%orbitals(i), &
- occupiedCode, unoccupiedCode, i, c, order)
-
- !! now build the strings
- do cilevel = 1,ConfigurationInteraction_instance%CILevel(i)
-
- call Vector_constructorInteger (order, numberOfSpecies, 0 )
- order%values(i) = cilevel
-
- call Vector_constructor (occupiedCode(i), cilevel, real(ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i),8) )
- call Vector_constructor (unoccupiedCode(i), cilevel, 0.0_8)
-
- unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ! it's also a lower bound in a for loop
-
- if ( cilevel <= ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ) then
-
- !! recursion to build the strings
- ci = 0
- oci = ConfigurationInteraction_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel, order, c)
-
- end if
- end do
-
- end do
-
- !! useful array
- do i = 1, numberOfSpecies
- ConfigurationInteraction_instance%sumstrings(i) = sum(ConfigurationInteraction_instance%numberOfStrings(i)%values)
- end do
-
- !! useful array, save the total number of string for a previous CI level.
- do i = 1, numberOfSpecies
- call Vector_constructorInteger8 (ConfigurationInteraction_instance%numberOfStrings2(i), &
- int(size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1) + 1,8), 0_8)
-
- ssize = 0
- do j = 1, size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1) !
- ssize = ssize + ConfigurationInteraction_instance%numberOfStrings(i)%values(j)
- ConfigurationInteraction_instance%numberOfStrings2(i)%values(j+1) = ssize
- end do
- ConfigurationInteraction_instance%numberOfStrings2(i)%values(1) = 0
- end do
-
-
- end subroutine ConfigurationInteraction_buildStrings
-
-!! This is just to get the total number of strings...
-
-recursive function ConfigurationInteraction_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ici, cilevel ) result (oci)
- implicit none
-
- integer :: i, numberOfSpecies
- integer :: ci, ici, oci, cilevel
- integer :: m, a
- type(vector), allocatable :: occupiedCode(:)
- type(vector), allocatable :: unoccupiedCode(:)
-
- ci = ici + 1
-
- if ( ci == 1 .and. ci < cilevel ) then ! first
- do m = int(occupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- oci = ConfigurationInteraction_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel )
- end do
- unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- else if ( ci > 1 .and. ci < cilevel ) then ! mid
- do m = int(occupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- oci = ConfigurationInteraction_buildStringsRecursion( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel )
- end do
- end do
-
- else if ( ci == 1 .and. ci == cilevel ) then ! mid
- do m = int(occupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- ConfigurationInteraction_instance%numberOfStrings(i)%values(ci+1) = &
- ConfigurationInteraction_instance%numberOfStrings(i)%values(ci+1) + 1
- end do
- if ( ci == 1 ) unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
-
- else !final
-
- do m = int(occupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- ConfigurationInteraction_instance%numberOfStrings(i)%values(ci+1) = &
- ConfigurationInteraction_instance%numberOfStrings(i)%values(ci+1) + 1
- end do
- if ( ci == 1 ) unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- end if
-
- end function ConfigurationInteraction_buildStringsRecursion
-
-!! and this is for building the strings
-recursive function ConfigurationInteraction_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, &
- ici, cilevel, order, c ) result (oci)
- implicit none
-
- integer :: i, numberOfSpecies
- integer :: ci, ici, oci, cilevel
- integer(8) :: c
- integer :: m, a
- type(ivector) :: order
- type(vector), allocatable :: occupiedCode(:)
- type(vector), allocatable :: unoccupiedCode(:)
-
- ci = ici + 1
-
- if ( ci == 1 .and. ci < cilevel ) then ! first
- do m = int(occupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- oci = ConfigurationInteraction_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel, order, c )
- end do
- unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- else if ( ci > 1 .and. ci < cilevel ) then ! mid
- do m = int(occupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- oci = ConfigurationInteraction_buildStringsRecursion2( i, numberOfSpecies, occupiedCode, unoccupiedCode, ci, cilevel, order, c )
- end do
- end do
-
- else if ( ci == 1 .and. ci == cilevel ) then ! mid
- do m = int(occupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
-
- c = c + 1
- call Configuration_constructorB(ConfigurationInteraction_instance%strings(i), ConfigurationInteraction_instance%orbitals(i), &
- occupiedCode, unoccupiedCode, i, c, order)
- end do
- if ( ci == 1 ) unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
-
- else !final
-
- do m = int(occupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i))
- do a = int(unoccupiedCode(i)%values(ci-1)) + 1, int(ConfigurationInteraction_instance%numberOfOrbitals%values(i) )
- occupiedCode(i)%values(ci) = m
- unoccupiedCode(i)%values(ci) = a
- c = c + 1
- call Configuration_constructorB(ConfigurationInteraction_instance%strings(i), ConfigurationInteraction_instance%orbitals(i), &
- occupiedCode, unoccupiedCode, i, c, order)
- end do
- if ( ci == 1 ) unoccupiedCode(i)%values = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- end if
-
-
- end function ConfigurationInteraction_buildStringsRecursion2
-
-!! Build the CI table with all combinations of excitations between quantum species.
-
- subroutine ConfigurationInteraction_buildCIOrderList()
- implicit none
-
- integer :: c
- integer :: i,j, u,v
- integer :: ci, ii, jj
- integer(8) :: output, auxsize
- integer :: numberOfSpecies, auxnumberOfSpecies,s
- integer(1) :: coupling
- real(8) :: timeA, timeB
- integer :: ncouplingOrderOne
- integer :: ncouplingOrderTwo
- logical :: includecilevel, same
- integer(8) :: ssize, auxssize
- integer, allocatable :: cilevel(:), auxcilevel(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- !! Allocate size considering all possible combinations, FCI.
- ssize = 1
- do i = 1, numberOfSpecies
- ssize = ssize * (ConfigurationInteraction_instance%CILevel(i) + 1)
- end do
-
- allocate ( ConfigurationInteraction_instance%ciOrderList( ssize, numberOfSpecies ) )
- allocate ( ConfigurationInteraction_instance%ciOrderSize1( ssize, numberOfSpecies ) )
- allocate ( ConfigurationInteraction_instance%ciOrderSize2( ssize, numberOfSpecies ) )
- allocate ( ConfigurationInteraction_instance%auxciOrderList( ssize ) )
-
- ConfigurationInteraction_instance%ciOrderList = 0
- ConfigurationInteraction_instance%auxciOrderList = 0
-
- ConfigurationInteraction_instance%ciOrderSize1 = -1 !! I have reasons... -1 for all species except the last one
- ConfigurationInteraction_instance%ciOrderSize2 = 1 !! and 1 for the last species
-
- ConfigurationInteraction_instance%sizeCiOrderList = 0
-
- allocate ( ciLevel ( numberOfSpecies ) )
- allocate ( auxciLevel ( numberOfSpecies ) )
- ciLevel = 0
- auxciLevel = 0
- s = 0
- c = 0
- !! Search which combinations of excitations satifies the desired CI level.
- auxnumberOfSpecies = ConfigurationInteraction_buildCIOrderRecursion( s, numberOfSpecies, c, cilevel )
-
-
- !! Print list
- write (6,"(T2,A)") "--------------------------"
- write (6,"(T2,A)") "CI level \ Species"
- write (6,"(T2,A)") "--------------------------"
- do u = 1, ConfigurationInteraction_instance%sizeCiOrderList
- do i = 1, numberOfSpecies
- write (6,"(T2,I4)",advance="no") ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(u), i)
- end do
- write (6,"(A)") ""
- end do
- write (6,"(T2,A)") "--------------------------"
-
- !! Calculates the three required factors in order to get the position of any given configuration.
- !! position = S1 + (indexConf(i,u) - numberOfStrings2(i) -1 )*S2(i,u)
- !! i: speciesID, u: cilevelID
-
- !! Factor S1
- ssize = 0
- do u = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(u), :)
-
- ssize = 0
- do v = 1, u-1
-
- auxcilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(v), :)
- auxnumberOfSpecies = ConfigurationInteraction_getIndexSize(0, ssize, auxcilevel)
-
- end do
-
- ConfigurationInteraction_instance%ciOrderSize1(ConfigurationInteraction_instance%auxciOrderList(u),:) = -1
- ConfigurationInteraction_instance%ciOrderSize1(ConfigurationInteraction_instance%auxciOrderList(u),numberOfSpecies) = ssize !!just the last
-
- end do
-
- !! Factor S2
- do i = 1, numberOfSpecies-1
- do u = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(u), :)
- ssize = 1
- do j = i+1, numberOfSpecies
- ssize = ssize * ConfigurationInteraction_instance%numberOfStrings(j)%values(cilevel(j)+1)
- end do
-
- ConfigurationInteraction_instance%ciOrderSize2(ConfigurationInteraction_instance%auxciOrderList(u),i) = ssize
-
- end do
- end do
-
- ConfigurationInteraction_instance%ciOrderSize2(:,numberOfSpecies) = 1
-
- deallocate ( auxcilevel )
- deallocate ( cilevel )
-
- end subroutine ConfigurationInteraction_buildCIOrderList
-
- !! Search which combinations of excitations satifies the desired CI level.
-recursive function ConfigurationInteraction_buildCIOrderRecursion( s, numberOfSpecies, c, cilevel ) result (os)
- implicit none
-
- integer :: u,v,c
- integer :: i, j, ii, jj, nn, k, l
- integer :: s, numberOfSpecies
- integer :: os,is,auxis, auxos
- integer :: cilevel(:)
- integer :: plusOne(3,3) , plusTwo(4,6)
-
- is = s + 1
- if ( is < numberOfSpecies ) then
- do i = 1, size(ConfigurationInteraction_instance%numberOfStrings(is)%values, dim = 1)
- cilevel(is) = i - 1
- os = ConfigurationInteraction_buildCIOrderRecursion( is, numberOfSpecies, c, cilevel )
- end do
- cilevel(is) = 0
- else
- do i = 1, size(ConfigurationInteraction_instance%numberOfStrings(is)%values, dim = 1)
- cilevel(is) = i - 1
- c = c + 1
-
- ConfigurationInteraction_instance%ciOrderList( c, : ) = cilevel(:)
- if ( sum(cilevel) <= ConfigurationInteraction_instance%maxCIlevel ) then
- ConfigurationInteraction_instance%sizeCiOrderList = ConfigurationInteraction_instance%sizeCiOrderList + 1
- ConfigurationInteraction_instance%auxciOrderList( ConfigurationInteraction_instance%sizeCiOrderList ) = c
- end if
-
- if ( trim(ConfigurationInteraction_instance%level) == "CISD+" ) then !!special case.
- plusOne(:,1) = (/1,1,1/)
- plusOne(:,2) = (/2,0,1/)
- plusOne(:,3) = (/0,2,1/)
-
- do k = 1, 3
- if ( sum( abs(cilevel(:) - plusOne(:,k)) ) == 0 ) then
- ConfigurationInteraction_instance%sizeCiOrderList = ConfigurationInteraction_instance%sizeCiOrderList + 1
- ConfigurationInteraction_instance%auxciOrderList( ConfigurationInteraction_instance%sizeCiOrderList ) = c
- end if
- end do
-
- end if
-
- if ( trim(ConfigurationInteraction_instance%level) == "CISD+2" ) then !!special case.
- plusTwo(:,1) = (/1,1,1,0/)
- plusTwo(:,2) = (/1,1,0,1/)
- plusTwo(:,3) = (/2,0,1,0/)
- plusTwo(:,4) = (/2,0,0,1/)
- plusTwo(:,5) = (/0,2,1,0/)
- plusTwo(:,6) = (/0,2,0,1/)
-
- do k = 1, 6
- if ( sum( abs(cilevel(:) - plusTwo(:,k)) ) == 0 ) then
- ConfigurationInteraction_instance%sizeCiOrderList = ConfigurationInteraction_instance%sizeCiOrderList + 1
- ConfigurationInteraction_instance%auxciOrderList( ConfigurationInteraction_instance%sizeCiOrderList ) = c
- end if
- end do
-
- end if
-
- end do
- cilevel(is) = 0
- end if
-
- end function ConfigurationInteraction_buildCIOrderRecursion
-
-!! Build a list with all possible combinations of number of different orbitals from all quantum species, coupling (0,1,2)
-
- subroutine ConfigurationInteraction_buildCouplingOrderList()
- implicit none
-
- integer(8) :: a,b,c,c1,c2,aa,d
- integer :: u,uu,vv, p, nn,z
- integer :: i
- integer :: numberOfSpecies, auxnumberOfSpecies,s
- integer(1), allocatable :: couplingOrder(:)
- integer(1) :: coupling
- real(8) :: timeA, timeB
- integer :: ncouplingOrderOne
- integer :: ncouplingOrderTwo
- integer :: ssize
- integer, allocatable :: cilevel(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- ssize = 1
- do i = 1, numberOfSpecies
- ssize = ssize * 3 !! ( 0,1,2) different orbitals
- end do
-
- allocate ( ConfigurationInteraction_instance%couplingOrderList( 3, ssize ) ) !! one, two same, two diff
- allocate ( ConfigurationInteraction_instance%couplingOrderIndex( 3, ssize ) ) !! one, two same, two diff
-
- do a = 1, 3
- do b = 1, ssize
- call Vector_constructorInteger1( ConfigurationInteraction_instance%couplingOrderList(a,b), &
- int( numberOfSpecies,8), int(0,1) )
-
- end do
- end do
-
- !! same species
- do b = 1, ssize
- call Vector_constructorInteger1( ConfigurationInteraction_instance%couplingOrderIndex(1,b), 1_8, int(0,1) )
- call Vector_constructorInteger1( ConfigurationInteraction_instance%couplingOrderIndex(2,b), 1_8, int(0,1) )
- end do
-
- !! diff species
- do b = 1, ssize
- call Vector_constructorInteger1( ConfigurationInteraction_instance%couplingOrderIndex(3,b), 2_8, int(0,1) )
- end do
-
-
- allocate ( couplingOrder ( numberOfSpecies )) !! 0, 1, 2
- couplingOrder = 0
-
- !! call recursion
- s = 0
- ConfigurationInteraction_instance%ncouplingOrderOne = 0
- ConfigurationInteraction_instance%ncouplingOrderTwo = 0
- ConfigurationInteraction_instance%ncouplingOrderTwoDiff = 0
-
- allocate ( ciLevel ( numberOfSpecies ) )
- ciLevel = 0
-
- !! get all combinations
- auxnumberOfSpecies = ConfigurationInteraction_buildCouplingOrderRecursion( s, numberOfSpecies, couplingOrder, cilevel )
-
- !! save the index for species (speciesID) just to avoid a lot of conditionals later!
-
- do u = 1, ConfigurationInteraction_instance%ncouplingOrderOne
- do i = 1, numberOfSpecies
- if ( ConfigurationInteraction_instance%couplingOrderList(1,u)%values(i) == 1 ) then
- ConfigurationInteraction_instance%couplingOrderIndex(1,u)%values(1) = i
- end if
- end do
- end do
-
- do u = 1, ConfigurationInteraction_instance%ncouplingOrderTwo
- do i = 1, numberOfSpecies
- if ( ConfigurationInteraction_instance%couplingOrderList(2,u)%values(i) == 2 ) then
- ConfigurationInteraction_instance%couplingOrderIndex(2,u)%values(1) = i
- end if
- end do
- end do
-
- do u = 1, ConfigurationInteraction_instance%ncouplingOrderTwoDiff
- z = 0
- do i = 1, numberOfSpecies
- if ( ConfigurationInteraction_instance%couplingOrderList(3,u)%values(i) == 1 ) then
- z = z + 1
- ConfigurationInteraction_instance%couplingOrderIndex(3,u)%values(z) = i
- end if
- end do
- end do
-
-
- deallocate ( ciLevel )
- deallocate ( couplingOrder )
-
- end subroutine ConfigurationInteraction_buildCouplingOrderList
-
-!! Get all possible combinations of number of different orbitals from all quantum species.
-recursive function ConfigurationInteraction_buildCouplingOrderRecursion( s, numberOfSpecies, couplingOrder, cilevel ) result (os)
- implicit none
-
- integer(8) :: a,b,c,d
- integer :: u,v
- integer :: i, j, ii, jj, nn
- integer :: s, numberOfSpecies
- integer :: os,is,auxis, auxos
- integer(1) :: couplingOrder(:)
- logical :: same
- integer :: cilevel(:)
-
- is = s + 1
- if ( is < numberOfSpecies ) then
- if ( sum ( couplingOrder) <= 2 ) then
- do i = 1, 3 - sum ( couplingOrder ) !! 0,1,2
- couplingOrder(is) = i-1
- couplingOrder(is+1:) = 0
- os = ConfigurationInteraction_buildCouplingOrderRecursion( is, numberOfSpecies, couplingOrder, cilevel )
- end do
- end if
- else
- if ( sum ( couplingOrder) <= 2 ) then
- do i = 1, 3 - sum ( couplingOrder ) !! 0,1,2
- couplingOrder(is) = i-1
- couplingOrder(is+1:) = 0
- os = is
- if ( sum ( couplingOrder ) == 1 ) then
-
- auxis = 0
- ConfigurationInteraction_instance%ncouplingOrderOne = ConfigurationInteraction_instance%ncouplingOrderOne + 1
- b = ConfigurationInteraction_instance%ncouplingOrderOne
- ConfigurationInteraction_instance%couplingOrderList(1,b)%values = couplingOrder
-
- else if ( sum ( couplingOrder ) == 2 ) then
-
- same = .false.
-
- do j = 1, numberOfSpecies
- if ( couplingOrder(j) == 2 ) same = .true.
- end do
-
- if ( same ) then
- auxis = 0
- ConfigurationInteraction_instance%ncouplingOrderTwo = ConfigurationInteraction_instance%ncouplingOrderTwo + 1
- b = ConfigurationInteraction_instance%ncouplingOrderTwo
- ConfigurationInteraction_instance%couplingOrderList(2,b)%values = couplingOrder
- else
- auxis = 0
- ConfigurationInteraction_instance%ncouplingOrderTwoDiff = ConfigurationInteraction_instance%ncouplingOrderTwoDiff + 1
- b = ConfigurationInteraction_instance%ncouplingOrderTwoDiff
- ConfigurationInteraction_instance%couplingOrderList(3,b)%values = couplingOrder
- end if
-
- end if
- end do
- end if
- end if
-
- end function ConfigurationInteraction_buildCouplingOrderRecursion
-
-
- !>
- !! @brief Destructor por omision
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_destructor()
- implicit none
- integer i,j,m,n,p,q,c
- integer numberOfSpecies
- integer :: isLambdaEqual1
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- !!Destroy configurations
- !!Ground State
- if (allocated(ConfigurationInteraction_instance%configurations)) then
- c=1
- call Configuration_destructor(ConfigurationInteraction_instance%configurations(c) )
-
- do c=2, ConfigurationInteraction_instance%numberOfConfigurations
- call Configuration_destructor(ConfigurationInteraction_instance%configurations(c) )
- end do
-
- if (allocated(ConfigurationInteraction_instance%configurations)) deallocate(ConfigurationInteraction_instance%configurations)
- end if
-
- call Matrix_destructor(ConfigurationInteraction_instance%hamiltonianMatrix)
- call Vector_destructorInteger (ConfigurationInteraction_instance%numberOfOccupiedOrbitals)
- call Vector_destructorInteger (ConfigurationInteraction_instance%numberOfOrbitals)
- call Vector_destructor (ConfigurationInteraction_instance%lambda)
-
- ConfigurationInteraction_instance%isInstanced=.false.
-
- end subroutine ConfigurationInteraction_destructor
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_show()
- implicit none
- type(ConfigurationInteraction) :: this
- integer :: i
- real(8) :: davidsonCorrection, HFcoefficient, CIcorrection
- integer numberOfSpecies
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- if ( ConfigurationInteraction_instance%isInstanced ) then
-
- write(*,"(A)") ""
- write(*,"(A)") " POST HARTREE-FOCK CALCULATION"
- write(*,"(A)") " CONFIGURATION INTERACTION THEORY:"
- write(*,"(A)") "=============================="
- write(*,"(A)") ""
- write (6,"(T8,A30, A5)") "LEVEL = ", ConfigurationInteraction_instance%level
- write (6,"(T8,A30, I8)") "NUMBER OF CONFIGURATIONS = ", ConfigurationInteraction_instance%numberOfConfigurations
- do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- write (6,"(T8,A17,I3,A10, F25.12)") "STATE: ", i, " ENERGY = ", ConfigurationInteraction_instance%eigenvalues%values(i)
- end do
- write(*,"(A)") ""
- CIcorrection = ConfigurationInteraction_instance%eigenvalues%values(1) - &
- HartreeFock_instance%totalEnergy
-
- write (6,"(T4,A34, F25.12)") "GROUND STATE CORRELATION ENERGY = ", CIcorrection
-
- if ( ConfigurationInteraction_instance%level == "CISD" ) then
- write(*,"(A)") ""
- write (6,"(T2,A34)") "RENORMALIZED DAVIDSON CORRECTION:"
- write(*,"(A)") ""
- write (6,"(T8,A54)") "E(CISDTQ) \approx E(CISD) + \delta E(Q) "
- write (6,"(T8,A54)") "\delta E(Q) = (1 - c_0^2) * \delta E(CISD) / c_0^2 "
- write (*,*) ""
- HFcoefficient = ConfigurationInteraction_instance%eigenVectors%values(1,1)
- davidsonCorrection = ( 1 - HFcoefficient*HFcoefficient) * CIcorrection / (HFcoefficient*HFcoefficient)
-
-
- write (6,"(T8,A19, F25.12)") "HF COEFFICIENT = ", HFcoefficient
- write (6,"(T8,A19, F25.12)") "\delta E(Q) = ", davidsonCorrection
- write (6,"(T8,A19, F25.12)") "E(CISDTQ) ESTIMATE ", HartreeFock_instance%totalEnergy +&
- CIcorrection + davidsonCorrection
- else
-
- write(*,"(A)") ""
- HFcoefficient = ConfigurationInteraction_instance%eigenVectors%values(1,1)
- write (6,"(T8,A19, F25.12)") "HF COEFFICIENT = ", HFcoefficient
-
- end if
-
- else
-
- end if
-
- end subroutine ConfigurationInteraction_show
-
- subroutine ConfigurationInteraction_showEigenVectors()
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v,p
- integer :: ci
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies, auxnumberOfSpecies
- integer :: size1, size2
- real(8) :: timeA, timeB
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- real(8) :: CIenergy
- integer(8), allocatable :: indexConf(:)
- integer, allocatable :: cilevel(:), auxcilevel(:), dd(:)
-
-
- if ( CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT == "NONE" ) return
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- numberOfConfigurations = ConfigurationInteraction_instance%numberOfConfigurations
-
- allocate ( ConfigurationInteraction_instance%allIndexConf( numberOfSpecies, numberOfConfigurations ) )
- allocate ( ciLevel ( numberOfSpecies ) )
- allocate ( indexConf ( numberOfSpecies ) )
- ciLevel = 0
- ConfigurationInteraction_instance%allIndexConf = 0
- indexConf = 0
-
- !! gather all configurations
- s = 0
- c = 0
- ciLevel = 0
-
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- s = 0
- auxnumberOfSpecies = ConfigurationInteraction_gatherConfRecursion( s, numberOfSpecies, indexConf, c, cilevel )
- end do
- !stop
-
- deallocate ( ciLevel )
-
- if ( CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT == "ORBITALS" ) then
- write (*,*) ""
- write (*, "(T1,A)") "Eigenvectors"
- write (*,*) ""
-
- do c = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- write (*, "(T1,A,I4,A,F25.12)") "State: ", c, " Energy: ", ConfigurationInteraction_instance%eigenValues%values(c)
- write (*, "(T1,A)") "Conf, orbital occupation per species, coefficient"
- write (*,*) ""
- do a = 1, numberOfConfigurations
- if ( abs(ConfigurationInteraction_instance%eigenVectors%values(a,c)) > CONTROL_instance%CI_PRINT_THRESHOLD ) then
- indexConf(:) = ConfigurationInteraction_instance%allIndexConf(:,a)
-
- write (*, "(T1,I8,A1)", advance="no") a, " "
- do i = 1, numberOfSpecies
- do p = 1, ConfigurationInteraction_instance%numberOfOrbitals%values(i)
- write (*, "(I1)", advance="no") ConfigurationInteraction_instance%orbitals(i)%values(p,indexConf(i))
- end do
- write (*, "(A1)", advance="no") " "
- end do
- write (*, "(F11.8)") ConfigurationInteraction_instance%eigenVectors%values(a,c)
- end if
- end do
- write (*,*) ""
- end do
-
-
- else if ( CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT == "OCCUPIED" ) then
- write (*,*) ""
- write (*, "(T1,A)") "Eigenvectors"
- write (*,*) ""
-
- do c = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- write (*, "(T1,A,I4,A,F25.12)") "State: ", c, " Energy: ", ConfigurationInteraction_instance%eigenValues%values(c)
- write (*, "(T1,A)") "Conf, occupied orbitals per species, coefficient"
- write (*,*) ""
- do a = 1, numberOfConfigurations
- if ( abs(ConfigurationInteraction_instance%eigenVectors%values(a,c)) > CONTROL_instance%CI_PRINT_THRESHOLD ) then
- indexConf(:) = ConfigurationInteraction_instance%allIndexConf(:,a)
-
- write (*, "(T1,I8,A1)", advance="no") a, " "
- do i = 1, numberOfSpecies
- do p = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- write (*, "(I3,A1)", advance="no") ConfigurationInteraction_instance%strings(i)%values(p,indexConf(i) ), " "
- end do
- write (*, "(A1)", advance="no") "|"
- end do
- write (*, "(A,F11.8)") " ", ConfigurationInteraction_instance%eigenVectors%values(a,c)
- end if
- end do
- write (*,*) ""
- end do
-
- end if
-
- deallocate ( indexConf )
- deallocate ( ConfigurationInteraction_instance%allIndexConf )
-
- end subroutine ConfigurationInteraction_showEigenVectors
-
-
- !FELIX IS HERE
- subroutine ConfigurationInteraction_densityMatrices()
- implicit none
- type(ConfigurationInteraction) :: this
- type(Configuration) :: auxthisA, auxthisB
- integer :: i, j, k, l, mu, nu, n
- integer :: factor
- integer :: unit, wfnunit
- integer :: numberOfOrbitals, numberOfContractions, numberOfOccupiedOrbitals
- integer :: state, species, orbital, orbitalA, orbitalB
- character(50) :: file, wfnfile, speciesName, auxstring
- character(50) :: arguments(2)
- type(matrix), allocatable :: coefficients(:), atomicDensityMatrix(:,:), ciDensityMatrix(:,:), auxDensMatrix(:,:)
- type(matrix), allocatable :: kineticMatrix(:), attractionMatrix(:), externalPotMatrix(:)
- integer numberOfSpecies
-
- type(matrix) :: auxdensityEigenVectors
- type(matrix) :: densityEigenVectors
- type(vector) :: auxdensityEigenValues
- type(vector) :: densityEigenValues
- integer, allocatable :: cilevel(:), cilevelA(:)
- integer(8) :: numberOfConfigurations, c
- integer(8), allocatable :: indexConf(:)
- type(ivector), allocatable :: stringAinB(:)
- integer :: s, ss, ci, auxnumberOfSpecies
- integer, allocatable :: coupling(:)
- integer :: a, b, AA, BB, bj
- integer :: u, uu, ssize
- integer(8), allocatable :: indexConfA(:)
- integer(8), allocatable :: indexConfB(:)
- integer(8), allocatable :: jj(:)
- real(8) :: timeDA
- real(8) :: timeDB
-
-
- ! type(Vector) :: eigenValues
- ! type(Matrix) :: eigenVectors, auxMatrix
- ! real(8) :: sumaPrueba
-
- !!Iterators: i,j - Configurations .... k,l - molecular orbitals .... mu,nu - atomic orbitals ... n - threads
- if ( ConfigurationInteraction_instance%isInstanced .and. CONTROL_instance%CI_STATES_TO_PRINT .gt. 0 ) then
- !$ timeDA = omp_get_wtime()
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- numberOfConfigurations = ConfigurationInteraction_instance%numberOfConfigurations
-
- allocate (stringAinB ( numberOfSpecies ))
-
- do i = 1, numberOfSpecies
- call Vector_constructorInteger (stringAinB(i), ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i), 0)
- end do
-
- allocate ( ConfigurationInteraction_instance%allIndexConf( numberOfSpecies, numberOfConfigurations ) )
- allocate ( ciLevelA ( numberOfSpecies ) )
- allocate ( ciLevel ( numberOfSpecies ) )
- allocate ( indexConf ( numberOfSpecies ) )
- ciLevelA = 0
- ciLevel = 0
- ConfigurationInteraction_instance%allIndexConf = 0
- indexConf = 0
-
- !! gather all configurations
- s = 0
- c = 0
- ciLevel = 0
-
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- s = 0
- auxnumberOfSpecies = ConfigurationInteraction_gatherConfRecursion( s, numberOfSpecies, indexConf, c, cilevel )
- end do
- !stop
-
- deallocate ( indexConf )
- allocate ( coupling ( numberOfSpecies ) )
-
-
- write (*,*) ""
- write (*,*) "=============================="
- write (*,*) "BUILDING CI DENSITY MATRICES"
- write (*,*) "=============================="
- write (*,*) ""
-
- allocate( coefficients(numberOfSpecies), &
- kineticMatrix(numberOfSpecies), &
- attractionMatrix(numberOfSpecies), &
- externalPotMatrix(numberOfSpecies), &
- atomicDensityMatrix(numberOfSpecies,CONTROL_instance%CI_STATES_TO_PRINT), &
- ciDensityMatrix(numberOfSpecies,CONTROL_instance%CI_STATES_TO_PRINT), &
- auxDensMatrix(numberOfSpecies,ConfigurationInteraction_instance%nproc) )
-
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- !Inicializando las matrices
- do species=1, numberOfSpecies
- speciesName = MolecularSystem_getNameOfSpecie(species)
-
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species )
- ! numberOfOrbitals = ConfigurationInteraction_instance%numberOfOrbitals%values(species)
- numberOfOccupiedOrbitals = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(species)
-
- arguments(2) = speciesName
- ! print *, "trolo", numberOfOrbitals, numberOfContractions, numberOfOccupiedOrbitals
-
- arguments(1) = "COEFFICIENTS"
- coefficients(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- arguments(1) = "KINETIC"
- kineticMatrix(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- arguments(1) = "ATTRACTION"
- attractionMatrix(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- arguments(1) = "EXTERNAL_POTENTIAL"
- if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- externalPotMatrix(species) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
- ! print *, "trololo"
-
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
-
- call Matrix_constructor ( ciDensityMatrix(species,state) , &
- int(numberOfContractions,8), &
- int(numberOfContractions,8), 0.0_8 )
-
- do k=1, numberOfOccupiedOrbitals
- ciDensityMatrix(species,state)%values( k, k)=1.0_8
- end do
-
- end do
-
- do n=1, ConfigurationInteraction_instance%nproc
-
- call Matrix_constructor ( auxDensMatrix(species,n) , &
- int(numberOfContractions,8), &
- int(numberOfContractions,8), 0.0_8 )
- end do
- end do
-
- close(wfnUnit)
-
- allocate ( indexConfA ( numberOfSpecies ) )
- allocate ( indexConfB ( numberOfSpecies ) )
- allocate ( jj ( numberOfSpecies ) )
-
- indexConfA = 0
- indexConfB = 0
- jj = 0
-
- !! Building the CI reduced density matrix in the molecular orbital representation in parallel
- ! call Matrix_show (ConfigurationInteraction_instance%eigenVectors)
-
- !!print *, " State, Progress"
-
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
-
- !$omp parallel &
- !$omp& firstprivate (stringAinB,indexConfA,indexConfB, jj) &
- !$omp& private(i,j, species, s, numberOfOccupiedOrbitals, k, coupling, orbital, orbitalA, orbitalB, AA, BB, a, b, factor, n, cilevelA, ss, ssize, cilevel, ci, u, uu, bj),&
- !$omp& shared(ConfigurationInteraction_instance, auxDensMatrix )
- n = omp_get_thread_num() + 1
- !$omp do schedule (dynamic)
- do i=1, ConfigurationInteraction_instance%numberOfConfigurations
-
- !!if( mod( i , 50000 ) .eq. 0 ) print *, state, floor(real(100*i/ConfigurationInteraction_instance%numberOfConfigurations)), "%"
- !!Filter very small coefficients
- if( abs(ConfigurationInteraction_instance%eigenVectors%values(i,state)) .ge. 1E-10) then
-
- indexConfA(:) = ConfigurationInteraction_instance%allIndexConf(:,i)
-
- !print *, "==", indexConfA , "|", i
-
-
- !!Diagonal contributions
- do species=1, numberOfSpecies
- numberOfOccupiedOrbitals = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(species)
-
- do k=1, numberOfOccupiedOrbitals
-
- !!Occupied orbitals
- auxDensMatrix(species,n)%values(k,k)=auxDensMatrix(species,n)%values(k,k) - ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
- ! ciDensityMatrix(species,state)%values( k, k) = ciDensityMatrix(species,state)%values( k, k) - &
- ! ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
-
- !print *, i, j, k, species
- !orbital = ConfigurationInteraction_instance%configurations(i)%occupations(k,species)
- orbital = ConfigurationInteraction_instance%strings(species)%values(k,indexConfA(species))
- !!Unoccupied orbitals
-
- auxDensMatrix(species,n)%values(orbital,orbital)=auxDensMatrix(species,n)%values(orbital,orbital) + ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
- ! ciDensityMatrix(species,state)%values( orbital, orbital)= ciDensityMatrix(species,state)%values( orbital, orbital) + &
- ! ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
-
- end do
- end do
-
- !!Off Diagonal contributions
- cilevelA = 0
- do ss = 1, numberOfSpecies
- stringAinB(ss)%values = 0
- do k = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(ss)
-
- stringAinB(ss)%values(k) = ConfigurationInteraction_instance%orbitals(ss)%values( &
- ConfigurationInteraction_instance%strings(ss)%values(k, ConfigurationInteraction_instance%allIndexConf(ss,1)), indexConfA(ss))
- end do
- cilevelA(ss) = configurationinteraction_instance%numberOfOccupiedOrbitals%values(ss) - sum ( stringAinB(ss)%values )
- end do
-
- jj = 0
- coupling = 0
- do ss = 1, numberOfSpecies
- ssize = 0
-
- indexConfB(:) = indexConfA(:)
- cilevel = cilevelA
-
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(ss)%values, dim = 1)
- cilevel(ss) = ci - 1
- do u = 1, ConfigurationInteraction_instance%sizeCiOrderList
- if ( sum(abs(cilevel - &
- ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(u), :))) == 0 ) then
- uu = ConfigurationInteraction_instance%auxciOrderList(u)
- do bj = 1 + ssize , ConfigurationInteraction_instance%numberOfStrings(ss)%values(ci) + ssize
- indexConfB(ss) = bj
-
- do s=1, numberOfSpecies
- jj(s) = (indexConfB(s) - ConfigurationInteraction_instance%numberOfStrings2(s)%values(cilevel(s)+1) + &
- ConfigurationInteraction_instance%ciOrderSize1(uu,s) )* ConfigurationInteraction_instance%ciOrderSize2(uu,s)
- end do
-
- j = sum(jj)
- !print *, " ", indexConfB , "|", j, ConfigurationInteraction_instance%eigenVectors%values(j,state)
- if ( j > i ) then
- if( abs(ConfigurationInteraction_instance%eigenVectors%values(j,state)) .ge. 1E-10) then
-
- coupling = 0
- do s=1, numberOfSpecies
- stringAinB(s)%values = 0
- do k = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s)
- stringAinB(s)%values(k) = ConfigurationInteraction_instance%orbitals(s)%values( &
- ConfigurationInteraction_instance%strings(s)%values(k,indexConfA(s) ), indexConfB(s) )
- end do
- coupling(s) = configurationinteraction_instance%numberOfOccupiedOrbitals%values(s) - sum ( stringAinB(s)%values )
- end do
- if (sum(coupling) == 1) then
-
- do s = 1, numberOfSpecies
-
- if ( coupling(s) == 1) then !!hmm
-
- !print *, " ", coupling
- orbitalA = 0
- orbitalB = 0
- AA = 0
- BB = 0
- a = indexConfA(s)
- b = indexConfB(s)
-
- do k = 1, ConfigurationInteraction_instance%occupationNumber(s)
- if ( ConfigurationInteraction_instance%orbitals(s)%values( &
- ConfigurationInteraction_instance%strings(s)%values(k,a),b) == 0 ) then
- orbitalA = ConfigurationInteraction_instance%strings(s)%values(k,a)
- AA = k
- exit
- end if
- end do
- do k = 1, ConfigurationInteraction_instance%occupationNumber(s)
- if ( ConfigurationInteraction_instance%orbitals(s)%values( &
- ConfigurationInteraction_instance%strings(s)%values(k,b),a) == 0 ) then
- orbitalB = ConfigurationInteraction_instance%strings(s)%values(k,b)
- BB = k
- exit
- end if
- end do
-
- factor = (-1)**(AA-BB)
-
- numberOfOccupiedOrbitals = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s)
-
- ! print *, i, j, ConfigurationInteraction_instance%configurations(i)%occupations(:,specie), ConfigurationInteraction_instance%configurations(j)%occupations(:,specie)
- ! print *, i, j, auxthisA%occupations(:,specie), auxthisB%occupations(:,specie)
- ! print *, i, j, orbitalA, orbitalB, factor*ConfigurationInteraction_instance%eigenVectors%values(i,1)*ConfigurationInteraction_instance%eigenVectors%values(j,1)
-
- auxDensMatrix(s,n)%values( orbitalA,orbitalB)= auxDensMatrix(s,n)%values( orbitalA, orbitalB) + &
- factor*ConfigurationInteraction_instance%eigenVectors%values(i,state)* &
- ConfigurationInteraction_instance%eigenVectors%values(j,state)
- auxDensMatrix(s,n)%values( orbitalB,orbitalA)= auxDensMatrix(s,n)%values( orbitalB, orbitalA) + &
- factor*ConfigurationInteraction_instance%eigenVectors%values(i,state)* &
- ConfigurationInteraction_instance%eigenVectors%values(j,state)
- end if
- end do
- end if
- end if
- end if
- !! here
- end do
- ssize = ssize + ConfigurationInteraction_instance%numberOfStrings(ss)%values(ci)
- !exit
- end if
-
- end do
- end do
-
- end do
-
-! do j=i+1, ConfigurationInteraction_instance%numberOfConfigurations
-! if( abs(ConfigurationInteraction_instance%eigenVectors%values(j,state)) .ge. 1E-12) then
-
-! indexConfB(:) = ConfigurationInteraction_instance%allIndexConf(:,j)
-
-! coupling = 0
-! do s=1, numberOfSpecies
-! stringAinB(s)%values = 0
-! do k = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s)
-! stringAinB(s)%values(k) = ConfigurationInteraction_instance%orbitals(s)%values( &
-! ConfigurationInteraction_instance%strings(s)%values(k,indexConfA(s) ), indexConfB(s) )
-! end do
-! coupling(s) = configurationinteraction_instance%numberOfOccupiedOrbitals%values(s) - sum ( stringAinB(s)%values )
-! end do
-!
-! if (sum(coupling) == 1) then
-!
-! do s = 1, numberOfSpecies
-!
-! if ( coupling(s) == 1) then
-! orbitalA = 0
-! orbitalB = 0
-! AA = 0
-! BB = 0
-! a = indexConfA(s)
-! b = indexConfB(s)
-!
-! do k = 1, ConfigurationInteraction_instance%occupationNumber(s)
-! if ( ConfigurationInteraction_instance%orbitals(s)%values( &
-! ConfigurationInteraction_instance%strings(s)%values(k,a),b) == 0 ) then
-! orbitalA = ConfigurationInteraction_instance%strings(s)%values(k,a)
-! AA = k
-! exit
-! end if
-! end do
-! do k = 1, ConfigurationInteraction_instance%occupationNumber(s)
-! if ( ConfigurationInteraction_instance%orbitals(s)%values( &
-! ConfigurationInteraction_instance%strings(s)%values(k,b),a) == 0 ) then
-! orbitalB = ConfigurationInteraction_instance%strings(s)%values(k,b)
-! BB = k
-! exit
-! end if
-! end do
-!
-! factor = (-1)**(AA-BB)
-!
-! numberOfOccupiedOrbitals = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s)
-!
-! ! print *, i, j, ConfigurationInteraction_instance%configurations(i)%occupations(:,specie), ConfigurationInteraction_instance%configurations(j)%occupations(:,specie)
-! ! print *, i, j, auxthisA%occupations(:,specie), auxthisB%occupations(:,specie)
-!
-! ! print *, i, j, orbitalA, orbitalB, factor*ConfigurationInteraction_instance%eigenVectors%values(i,1)*ConfigurationInteraction_instance%eigenVectors%values(j,1)
-!
-! auxDensMatrix(s,n)%values( orbitalA,orbitalB)= auxDensMatrix(s,n)%values( orbitalA, orbitalB) + &
-! factor*ConfigurationInteraction_instance%eigenVectors%values(i,state)* &
-! ConfigurationInteraction_instance%eigenVectors%values(j,state)
-! ! ciDensityMatrix(s,state)%values( orbitalA,orbitalB)= ciDensityMatrix(s,state)%values( orbitalA, orbitalB) + &
-! ! factor*ConfigurationInteraction_instance%eigenVectors%values(i,state)* &
-! ! ConfigurationInteraction_instance%eigenVectors%values(j,state)
-!
-! auxDensMatrix(s,n)%values( orbitalB,orbitalA)= auxDensMatrix(s,n)%values( orbitalB, orbitalA) + &
-! factor*ConfigurationInteraction_instance%eigenVectors%values(i,state)* &
-! ConfigurationInteraction_instance%eigenVectors%values(j,state)
-!
-! ! ciDensityMatrix(s,state)%values( orbitalB, orbitalA)= ciDensityMatrix(s,state)%values( orbitalB, orbitalA) + &
-! ! factor*ConfigurationInteraction_instance%eigenVectors%values(i,state)* &
-! ! ConfigurationInteraction_instance%eigenVectors%values(j,state)
-!
-! end if
-! end do
-! end if
-! end if
-! end do
-
- end if
- end do
- !$omp end do nowait
- !$omp end parallel
-
- !! Gather the parallel results
- do species=1, numberOfSpecies
- do n=1, ConfigurationInteraction_instance%nproc
- ciDensityMatrix(species,state)%values = ciDensityMatrix(species,state)%values + auxDensMatrix(species,n)%values
- auxDensMatrix(species,n)%values=0.0
- end do
- end do
-
- end do
-
-
- !! Open file - to write density matrices
- unit = 29
-
- file = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- open(unit = unit, file=trim(file), status="new", form="formatted")
-
- !! Building the CI reduced density matrix in the atomic orbital representation
- do species=1, numberOfSpecies
- speciesName = MolecularSystem_getNameOfSpecie(species)
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species )
-
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
-
- ! print *, "CI density matrix ", trim(speciesName), state
- ! call Matrix_show ( ciDensityMatrix(species,state))
-
- call Matrix_constructor ( atomicDensityMatrix(species,state) , &
- int(numberOfContractions,8), &
- int(numberOfContractions,8), 0.0_8 )
-
- do mu=1, numberOfContractions
- do nu=1, numberOfContractions
- do k=1, numberOfContractions
- atomicDensityMatrix(species,state)%values(mu,nu) = &
- atomicDensityMatrix(species,state)%values(mu,nu) + &
- ciDensityMatrix(species,state)%values(k,k) *&
- coefficients(species)%values(mu,k)*coefficients(species)%values(nu,k)
-
- do l=k+1, numberOfContractions
-
- atomicDensityMatrix(species,state)%values(mu,nu) = &
- atomicDensityMatrix(species,state)%values(mu,nu) + &
- ciDensityMatrix(species,state)%values(k,l) *&
- (coefficients(species)%values(mu,k)*coefficients(species)%values(nu,l) + &
- coefficients(species)%values(mu,l)*coefficients(species)%values(nu,k))
-
- end do
- end do
- end do
- end do
-
- ! print *, "atomic density matrix ", trim(speciesName), state
- ! call Matrix_show ( atomicDensityMatrix(species,state))
-
- write(auxstring,*) state
- arguments(2) = speciesName
- arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
-
- call Matrix_writeToFile ( atomicDensityMatrix(species,state), unit , arguments=arguments(1:2) )
-
- end do
- end do
-
- write(*,*) ""
- write(*,*) "==============================="
- write(*,*) " ONE BODY ENERGY CONTRIBUTIONS:"
- write(*,*) ""
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- write(*,*) " STATE: ", state
- do species=1, molecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(species)%name ) // &
- " Kinetic energy = ", sum(transpose(atomicDensityMatrix(species,state)%values)*kineticMatrix(species)%values)
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(species)%name ) // &
- "/Fixed interact. energy = ", sum(transpose(atomicDensityMatrix(species,state)%values)*attractionMatrix(species)%values)
- if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(species)%name) // &
- " Ext Pot energy = ", sum(transpose(atomicDensityMatrix(species,state)%values)*externalPotMatrix(species)%values)
- print *, ""
- end do
- print *, ""
- end do
-
- !! Natural orbitals
-
- if (CONTROL_instance%CI_NATURAL_ORBITALS) then
-
- write(*,*) ""
- write(*,*) "=============================="
- write(*,*) " NATURAL ORBITALS: "
- write(*,*) ""
-
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
-
- write(*,*) " STATE: ", state
-
- do species=1, numberOfSpecies
-
- write(*,*) ""
- write(*,*) " Natural Orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(species)%name )
- write(*,*) "-----------------"
-
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species )
- speciesName = MolecularSystem_getNameOfSpecie(species)
-
-
- call Vector_constructor ( auxdensityEigenValues, &
- int(numberOfContractions,4), 0.0_8 )
-
- call Matrix_constructor ( auxdensityEigenVectors, &
- int(numberOfContractions,8), &
- int(numberOfContractions,8), 0.0_8 )
-
- call Vector_constructor ( densityEigenValues, &
- int(numberOfContractions,4), 0.0_8 )
-
- call Matrix_constructor ( densityEigenVectors, &
- int(numberOfContractions,8), &
- int(numberOfContractions,8), 0.0_8 )
-
- call Matrix_eigen ( ciDensityMatrix(species,state), auxdensityEigenValues, auxdensityEigenVectors, SYMMETRIC )
-
- ! reorder and count significant occupations
- k=0
- do u = 1, numberOfContractions
- densityEigenValues%values(u) = auxdensityEigenValues%values(numberOfContractions - u + 1)
- densityEigenVectors%values(:,u) = auxdensityEigenVectors%values(:,numberOfContractions - u + 1)
- if(densityEigenValues%values(u) .ge. 5.0E-5 ) k=k+1
- end do
-
- !! Transform to atomic basis
- densityEigenVectors%values = matmul( coefficients(species)%values, densityEigenVectors%values )
-
- ! Print eigenvectors with occupation larger than 5.0E-5
- call Matrix_constructor(auxdensityEigenVectors,int(numberOfContractions,8),int(k,8),0.0_8)
- do u=1, numberOfContractions
- do j=1, k
- auxdensityEigenVectors%values(u,j)=densityEigenVectors%values(u,j)
- end do
- end do
- call Matrix_show( auxdensityEigenVectors, &
- rowkeys = MolecularSystem_getlabelsofcontractions( species ), &
- columnkeys = string_convertvectorofrealstostring( densityEigenValues ),&
- flags=WITH_BOTH_KEYS)
-
- write(auxstring,*) state
- arguments(2) = speciesName
- arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring))
-
- call Matrix_writeToFile ( densityEigenVectors, unit , arguments=arguments(1:2) )
- arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring))
-
- call Vector_writeToFile( densityEigenValues, unit, arguments=arguments(1:2) )
- !! it's the same
- !!auxdensityEigenVectors%values = 0
-
- !!do mu=1, numberOfContractions
- !! do nu=1, numberOfContractions
- !! do k=1, numberOfContractions
- !! auxdensityEigenVectors%values(mu,nu) = auxdensityEigenVectors%values(mu,nu) + &
- !! densityEigenVectors%values(mu,k) * densityEigenVectors%values(nu,k)*densityEigenValues%values(k)
- !! end do
- !! end do
- !!end do
- !!print *, "atomic density matrix from natural orbitals"
- !!call Matrix_show ( auxdensityEigenVectors)
- write(*,"(A10,A10,A40,F17.12)") "sum of ", trim(speciesName) , "natural orbital occupations", sum(densityEigenValues%values)
-
- write(*,*) " End of natural orbitals in state: ", state, " for: ", trim(speciesName)
- end do
- end do
-
-
-
- write(*,*) ""
- write(*,*) " END OF NATURAL ORBITALS"
- write(*,*) "=============================="
- write(*,*) ""
-
- end if
-
- close(unit)
-
- deallocate ( jj )
- deallocate ( indexConfB )
- deallocate ( indexConfA )
- deallocate ( coupling )
- deallocate ( cilevel )
- deallocate ( cilevelA )
- deallocate ( ConfigurationInteraction_instance%allIndexConf )
- deallocate ( stringAinB )
-
- deallocate( coefficients, atomicDensityMatrix, ciDensityMatrix )
-
- !$ timeDB = omp_get_wtime()
- !$ write(*,"(A,F10.4,A4)") "** TOTAL Elapsed Time for Building density matrices: ", timeDB - timeDA ," (s)"
-
-
- end if
-
- ! print *, i, i, orbital, orbital, ConfigurationInteraction_instance%eigenVectors%values(i,1)**2
-
- ! do mu = 1 , numberOfOrbitals
- ! do nu = 1 , numberOfOrbitals
-
- ! densityMatrix%values(mu,nu) = &
- ! densityMatrix%values(mu,nu) + &
- ! ConfigurationInteraction_instance%eigenVectors%values(i,state)**2 *&
- ! coefficients%values(mu,orbital)*coefficients%values(nu,orbital)
- ! end do
- ! end do
-
- !!off-Diagonal ground state
-
- ! do mu = 1 , numberOfOrbitals
- ! do nu = 1 , numberOfOrbitals
-
- ! densityMatrix%values(mu,nu) = &
- ! densityMatrix%values(mu,nu) + &
- ! factor *&
- ! ConfigurationInteraction_instance%eigenVectors%values(i,state) *&
- ! ConfigurationInteraction_instance%eigenVectors%values(j,state) *&
- ! (coefficients%values(mu,orbitalA)*coefficients%values(nu,orbitalB) + coefficients%values(mu,orbitalB)*coefficients%values(nu,orbitalA))
- ! end do
- ! end do
-
- ! call Vector_constructor(eigenValues, numberOfOrbitals)
- ! call Matrix_constructor(eigenVectors, int(numberOfOrbitals,8), int(numberOfOrbitals,8))
- ! call Matrix_eigen(ciOccupationMatrix, eigenValues, eigenVectors, SYMMETRIC)
-
- ! print *, "Diagonal sum", sum(eigenValues%values)
- ! call Vector_show(eigenValues)
-
- ! call Matrix_show(eigenVectors)
- ! print *, arguments(1:2)
- ! call Matrix_show ( densityMatrix )
-
- ! call Matrix_constructor ( ciOccupationNumbers , int(numberOfOrbitals,8) , &
- ! int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8 )
-
- ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- ! sumaPrueba=0
- ! do j=1, numberOfOccupiedOrbitals
- ! ciOccupationNumbers%values(j,state) = 1.0
- ! end do
-
- ! ! !Get occupation numbers from each configuration contribution
-
- ! do i=1, ConfigurationInteraction_instance%numberOfConfigurations
- ! do j=1, numberOfOccupiedOrbitals
-
- ! !! Occupied orbitals
- ! ciOccupationNumbers%values( j, state)= ciOccupationNumbers%values( j, state) - &
- ! ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
- ! !! Unoccupied orbitals
- ! orbital = ConfigurationInteraction_instance%configurations(i)%occupations(j,specie)
-
- ! ciOccupationNumbers%values( orbital, state)= ciOccupationNumbers%values( orbital, state) + &
- ! ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
-
- ! ! print *, j, orbital, ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
- ! ! sumaPrueba=sumaPrueba+ConfigurationInteraction_instance%eigenVectors%values(i,state)**2
- ! end do
- ! ! end if
-
- ! end do
-
- ! ! print *, "suma", sumaPrueba
- ! !Build a new density matrix (P) in atomic orbitals
-
- ! call Matrix_constructor ( densityMatrix , &
- ! int(numberOfOrbitals,8), &
- ! int(numberOfOrbitals,8), 0.0_8 )
-
- ! wfnFile = "lowdin.wfn"
- ! wfnUnit = 20
-
- ! open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- ! arguments(2) = speciesName
- ! arguments(1) = "COEFFICIENTS"
-
- ! coefficients = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfOrbitals,4), &
- ! columns= int(numberOfOrbitals,4), binary=.true., arguments=arguments(1:2))
-
- ! close(wfnUnit)
-
- ! do mu = 1 , numberOfOrbitals
- ! do nu = 1 , numberOfOrbitals
- ! do k = 1 , numberOfOrbitals
-
- ! densityMatrix%values(mu,nu) = &
- ! densityMatrix%values(mu,nu) + &
- ! ciOccupationNumbers%values(k, state)**2* &
- ! coefficients%values(mu,k)*coefficients%values(nu,k)
- ! end do
- ! end do
- ! end do
-
- ! write(auxstring,*) state
- ! arguments(2) = speciesName
- ! arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
-
- ! call Matrix_writeToFile ( densityMatrix, unit , arguments=arguments(1:2) )
-
- ! print *, arguments(1:2)
- ! call Matrix_show ( densityMatrix )
-
- ! call Matrix_destructor(coefficients)
- ! call Matrix_destructor(densityMatrix)
-
-
- ! end do
-
- ! !Write occupation numbers to file
- ! write (6,"(T8,A10,A20)") trim(MolecularSystem_getNameOfSpecie(specie)),"OCCUPATIONS:"
-
- ! call Matrix_show ( ciOccupationNumbers )
-
- ! arguments(2) = speciesName
- ! arguments(1) = "OCCUPATIONS"
-
- ! call Matrix_writeToFile ( ciOccupationNumbers, unit , arguments=arguments(1:2) )
-
- ! call Matrix_destructor(ciOccupationNumbers)
-
-
-
- end subroutine ConfigurationInteraction_densityMatrices
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_run()
- implicit none
- integer :: i,j,m, numberOfSpecies
- real(8), allocatable :: eigenValues(:)
-
-! select case ( trim(ConfigurationInteraction_instance%level) )
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- write (*,*) ""
- write (*,*) "==============================================="
- write (*,*) " BEGIN ", trim(ConfigurationInteraction_instance%level)," CALCULATION"
- write (*,*) " J. Charry, F. Moncada "
- write (*,*) "-----------------------------------------------"
- write (*,*) ""
-
- write (*,"(A32)",advance="no") "Number of orbitals for species: "
- do i = 1, numberOfSpecies-1
- write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecie(i))//", "
- end do
- write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecie(numberOfSpecies))
- write (*,*) ""
-
- write (*,"(A28)",advance="no") " occupied orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)", advance="no") ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- write (*,*) ""
-
- write (*,"(A28)",advance="no") " virtual orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)",advance="no") int(MolecularSystem_getTotalNumberOfContractions( i )* &
- ConfigurationInteraction_instance%lambda%values(i) - &
- ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) )
- end do
- write (*,*) ""
-
- write (*,"(A28)",advance="no") " total number of orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)",advance="no") int(MolecularSystem_getTotalNumberOfContractions( i )* &
- ConfigurationInteraction_instance%lambda%values(i) )
- end do
- write (*,*) ""
-
-
- write (*,"(A28)",advance="no") " frozen core orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)",advance="no") ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i)
- end do
- write (*,*) ""
-
- write (*,"(A28)",advance="no") " active occupied orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)",advance="no") ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) - &
- ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i)
- end do
- write (*,*) ""
-
- write (*,"(A28)",advance="no") " active virtual orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)",advance="no") ConfigurationInteraction_instance%numberOfOrbitals%values(i) - &
- ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- write (*,*) ""
-
- write (*,"(A28)",advance="no") " total active orbitals: "
- do i = 1, numberOfSpecies
- write (*,"(I5)",advance="no") ConfigurationInteraction_instance%numberOfOrbitals%values(i) - &
- ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i)
- end do
- write (*,*) ""
- write (*,*) " "
-
- write (*,*) "Getting transformed integrals..."
- call ConfigurationInteraction_getTransformedIntegrals()
- write (*,*) " "
-
- !write (*,*) ConfigurationInteraction_instance%fourCenterIntegrals(1,1)%values(171, 1) a bug...
- write (*,*) "Setting CI level..."
-
- call ConfigurationInteraction_settingCILevel()
-
- !! write (*,*) "Total number of configurations", ConfigurationInteraction_instance%numberOfConfigurations
- write (*,*) ""
- call Vector_constructor8 ( ConfigurationInteraction_instance%eigenvalues, &
- int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8 )
-
- select case (trim(String_getUppercase(CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
-
- ! case ("ARPACK")
-
- ! write (*,*) "This method was removed"
-
- case ("JADAMILU")
-
- write (*,*) "Building Strings..."
- call ConfigurationInteraction_buildStrings()
-
- write (*,*) "Building CI level table..."
- call ConfigurationInteraction_buildCIOrderList()
-
- call ConfigurationInteraction_buildCouplingMatrix()
- call ConfigurationInteraction_buildCouplingOrderList()
-
- write (*,*) "Building diagonal..."
- call ConfigurationInteraction_buildDiagonal()
-
- write (*,*) "Building initial hamiltonian..."
- call ConfigurationInteraction_buildInitialCIMatrix2()
- !!call ConfigurationInteraction_buildHamiltonianMatrix() This should be modified to build the CI matrix in memory
-
- call Matrix_constructor (ConfigurationInteraction_instance%eigenVectors, &
- int(ConfigurationInteraction_instance%numberOfConfigurations,8), &
- int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
-
- if ( CONTROL_instance%CI_LOAD_EIGENVECTOR ) then
- call ConfigurationInteraction_loadEigenVector (ConfigurationInteraction_instance%eigenvalues, &
- ConfigurationInteraction_instance%eigenVectors)
- end if
-
- if ( CONTROL_instance%CI_BUILD_FULL_MATRIX ) then
- write (*,*) "Building and saving hamiltonian..."
- call ConfigurationInteraction_buildAndSaveCIMatrix()
- end if
-
- write(*,*) ""
- write(*,*) "Diagonalizing hamiltonian..."
- write(*,*) " Using : ", trim(String_getUppercase((CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
- write(*,*) "============================================================="
- write(*,*) "M. BOLLHÖFER AND Y. NOTAY, JADAMILU:"
- write(*,*) " a software code for computing selected eigenvalues of "
- write(*,*) " large sparse symmetric matrices, "
- write(*,*) "Computer Physics Communications, vol. 177, pp. 951-964, 2007."
- write(*,*) "============================================================="
-
-
- call ConfigurationInteraction_jadamiluInterface(ConfigurationInteraction_instance%numberOfConfigurations, &
- int(CONTROL_instance%NUMBER_OF_CI_STATES,8), &
- ConfigurationInteraction_instance%eigenvalues, &
- ConfigurationInteraction_instance%eigenVectors )
-
- if ( CONTROL_instance%CI_SAVE_EIGENVECTOR ) then
- call ConfigurationInteraction_saveEigenVector ()
- end if
- case ("DSYEVX")
-
- write (*,*) "Building Strings..."
- call ConfigurationInteraction_buildStrings()
-
- write (*,*) "Building CI level table..."
- call ConfigurationInteraction_buildCIOrderList()
-
- write (*,*) "Building diagonal..."
- call ConfigurationInteraction_buildDiagonal()
-
- write (*,*) "Building Hamiltonian..."
- call ConfigurationInteraction_buildHamiltonianMatrix()
-
- call Matrix_constructor (ConfigurationInteraction_instance%eigenVectors, &
- int(ConfigurationInteraction_instance%numberOfConfigurations,8), &
- int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
-
- !! deallocate transformed integrals
- deallocate(ConfigurationInteraction_instance%twoCenterIntegrals)
- deallocate(ConfigurationInteraction_instance%fourCenterIntegrals)
-
- write(*,*) ""
- write(*,*) "Diagonalizing hamiltonian..."
- write(*,*) " Using : ", trim(String_getUppercase((CONTROL_instance%CI_DIAGONALIZATION_METHOD)))
-
- call Matrix_eigen_select (ConfigurationInteraction_instance%hamiltonianMatrix, ConfigurationInteraction_instance%eigenvalues, &
- int(1), int(CONTROL_instance%NUMBER_OF_CI_STATES), &
- eigenVectors = ConfigurationInteraction_instance%eigenVectors, &
- flags = int(SYMMETRIC,4))
-
-! call Matrix_eigen_select (ConfigurationInteraction_instance%hamiltonianMatrix, ConfigurationInteraction_instance%eigenvalues, &
-! 1, CONTROL_instance%NUMBER_OF_CI_STATES, &
-! flags = SYMMETRIC, dm = ConfigurationInteraction_instance%numberOfConfigurations )
-
-
- case ("DSYEVR")
-
- write (*,*) "Building Strings..."
- call ConfigurationInteraction_buildStrings()
-
- write (*,*) "Building CI level table..."
- call ConfigurationInteraction_buildCIOrderList()
-
- write (*,*) "Building diagonal..."
- call ConfigurationInteraction_buildDiagonal()
-
- write (*,*) "Building Hamiltonian..."
- call ConfigurationInteraction_buildHamiltonianMatrix()
-
- call Matrix_constructor (ConfigurationInteraction_instance%eigenVectors, &
- int(ConfigurationInteraction_instance%numberOfConfigurations,8), &
- int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
-
- !! deallocate transformed integrals
- deallocate(ConfigurationInteraction_instance%twoCenterIntegrals)
- deallocate(ConfigurationInteraction_instance%fourCenterIntegrals)
-
- call Matrix_eigen_dsyevr (ConfigurationInteraction_instance%hamiltonianMatrix, ConfigurationInteraction_instance%eigenvalues, &
- 1, CONTROL_instance%NUMBER_OF_CI_STATES, &
- eigenVectors = ConfigurationInteraction_instance%eigenVectors, &
- flags = SYMMETRIC)
-
-! call Matrix_eigen_dsyevr (ConfigurationInteraction_instance%hamiltonianMatrix, ConfigurationInteraction_instance%eigenvalues, &
-! 1, CONTROL_instance%NUMBER_OF_CI_STATES, &
-! flags = SYMMETRIC, dm = ConfigurationInteraction_instance%numberOfConfigurations )
-
- case default
-
- call ConfigurationInteraction_exception( ERROR, "Configuration interactor constructor", "Diagonalization method not implemented")
-
-
- end select
-
- write(*,*) ""
- write(*,*) "-----------------------------------------------"
- write(*,*) " END ", trim(ConfigurationInteraction_instance%level)," CALCULATION"
- write(*,*) "==============================================="
- write(*,*) ""
-
-! case ( "FCI-oneSpecie" )
-!
-! print *, ""
-! print *, ""
-! print *, "==============================================="
-! print *, "| Full CI for one specie calculation |"
-! print *, "| Use fci program to perform the calculation |"
-! print *, "-----------------------------------------------"
-! print *, ""
-! ! call ConfigurationInteraction_getTransformedIntegrals()
-! !call ConfigurationInteraction_printTransformedIntegralsToFile()
-!
-
- end subroutine ConfigurationInteraction_run
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_settingCILevel()
- implicit none
-
- integer :: numberOfSpecies
- integer :: i,ii,j,k,l,m,n,p,q,a,b,d,r,s
- integer(8) :: c, cc
- integer :: ma,mb,mc,md,me,pa,pb,pc,pd,pe
- integer :: isLambdaEqual1
- type(ivector) :: order
- type(vector), allocatable :: occupiedCode(:)
- type(vector), allocatable :: unoccupiedCode(:)
- integer, allocatable :: auxArray(:,:), auxvector(:),auxvectorA(:)
- integer :: lambda, otherlambda
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- if ( allocated( occupiedCode ) ) deallocate( occupiedCode )
- allocate (occupiedCode ( numberOfSpecies ) )
- if ( allocated( unoccupiedCode ) ) deallocate( unoccupiedCode )
- allocate (unoccupiedCode ( numberOfSpecies ) )
-
- !1 auxiliary string for omp paralelization
- do n = 1, ConfigurationInteraction_instance%nproc
- do i = 1, numberOfSpecies
- call Vector_constructorInteger( ConfigurationInteraction_instance%auxstring(n,i), &
- int(ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i),4), int(0,4))
- end do
- end do
-
- select case ( trim(ConfigurationInteraction_instance%level) )
-
- case ( "FCI" )
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
-
- ConfigurationInteraction_instance%maxCILevel = sum(ConfigurationInteraction_instance%CILevel)
-
- case ( "CIS" )
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 1
- end do
- ConfigurationInteraction_instance%maxCILevel = 1
-
- case ( "CISD" )
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 2
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) < 2 ) &
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- ConfigurationInteraction_instance%maxCILevel = 2
-
- case ( "CISD+" )
-
- if ( .not. numberOfSpecies == 3 ) call ConfigurationInteraction_exception( ERROR, "Configuration interactor constructor", "CISD+ is specific for three quantum species")
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 2
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) < 2 ) &
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- ConfigurationInteraction_instance%maxCILevel = 2
-
- case ( "CISD+2" )
-
- if ( .not. numberOfSpecies == 4 ) call ConfigurationInteraction_exception( ERROR, "Configuration interactor constructor", "CISD+2 is specific for three quantum species")
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 2
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) < 2 ) &
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- ConfigurationInteraction_instance%maxCILevel = 2
-
- case ("CISDT")
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 3
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) < 3 ) &
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- ConfigurationInteraction_instance%maxCILevel = 3
-
- case ("CISDTQ")
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 4
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) < 4 ) &
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- ConfigurationInteraction_instance%maxCILevel = 4
-
- case ("CISDTQQ")
-
- do i=1, numberOfSpecies
- ConfigurationInteraction_instance%CILevel(i) = 5
- if ( ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) < 5 ) &
- ConfigurationInteraction_instance%CILevel(i) = ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- end do
- ConfigurationInteraction_instance%maxCILevel = 5
-
- case default
-
- call ConfigurationInteraction_exception( ERROR, "Configuration interactor constructor", "Correction level not implemented")
-
- end select
-
-
- end subroutine ConfigurationInteraction_settingCILevel
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_buildCouplingMatrix()
- implicit none
-
- integer(8) :: a,b,c1,c2
- integer :: u,v,p
- integer :: i,n
- integer :: auxis,auxos
- integer :: numberOfSpecies
- real(8) :: timeA, timeB
- integer(1) :: coupling
- integer(1), allocatable :: orbitalsA(:), orbitalsB(:)
- integer(8), allocatable :: indexConfA(:)
- integer(8), allocatable :: indexConfB(:)
- integer(1), allocatable :: couplingOrder(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- coupling = 0
-
- !! allocate arrays
- do n = 1, ConfigurationInteraction_instance%nproc
- do i = 1, numberOfSpecies
-
- call Matrix_constructorInteger ( ConfigurationInteraction_instance%couplingMatrix(i,n), &
- sum(ConfigurationInteraction_instance%numberOfStrings(i)%values), 3_8 , 0)
-
- call Matrix_constructorInteger(ConfigurationInteraction_instance%nCouplingOneTwo(i,n), &
- 3_8, int(size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim=1),8), 0 )
-
- call Matrix_constructorInteger(ConfigurationInteraction_instance%nCouplingSize(i,n), &
- 3_8, int(size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim=1) + 1 ,8), 0 )
-
- call Vector_constructor(ConfigurationInteraction_instance%couplingMatrixEnergyOne(i,n), &
- int(sum(ConfigurationInteraction_instance%numberOfStrings(i)%values),4), 0.0_8 )
-
- call Vector_constructorInteger(ConfigurationInteraction_instance%couplingMatrixFactorOne(i,n), &
- int(sum(ConfigurationInteraction_instance%numberOfStrings(i)%values),4), 2 )
-
- call Vector_constructorInteger( ConfigurationInteraction_instance%couplingMatrixOrbOne(i,n), &
- int(sum(ConfigurationInteraction_instance%numberOfStrings(i)%values),4), 0 )
-
- end do
- end do
-
- end subroutine ConfigurationInteraction_buildCouplingMatrix
-
- function ConfigurationInteraction_calculateEnergyOneSame( n, ii, thisA, thisB ) result (auxCIenergy)
- implicit none
- integer(8) :: thisA(:), thisB(:)
- integer(8) :: a, b
- integer :: i,j,s,n, nn,ii
- integer :: l,k,z,kk,ll
- integer :: factor, factor2, auxOcc, AA, BB
- logical(1) :: equalA, equalB
- integer :: auxnumberOfOtherSpecieSpatialOrbitals
- integer(8) :: auxIndex1, auxIndex2, auxIndex
- integer :: diffOrb(2), otherdiffOrb(2) !! to avoid confusions
- real(8) :: auxCIenergy
-
- auxCIenergy = 0.0_8
- factor = 1
-
- !! copy a
- a = thisA(ii)
- b = thisB(ii)
-
- diffOrb = 0
-
- do kk = 1, ConfigurationInteraction_instance%occupationNumber(ii)
- if ( ConfigurationInteraction_instance%orbitals(ii)%values( &
- ConfigurationInteraction_instance%strings(ii)%values(kk,a),b) == 0 ) then
- diffOrb(1) = ConfigurationInteraction_instance%strings(ii)%values(kk,a)
- AA = kk
- exit
- end if
- end do
-
- do kk = 1, ConfigurationInteraction_instance%occupationNumber(ii)
- if ( ConfigurationInteraction_instance%orbitals(ii)%values( &
- ConfigurationInteraction_instance%strings(ii)%values(kk,b),a) == 0 ) then
- diffOrb(2) = ConfigurationInteraction_instance%strings(ii)%values(kk,b)
- BB = kk
- exit
- end if
- end do
-
- factor = (-1)**(AA-BB)
-
- configurationInteraction_instance%couplingMatrixFactorOne(ii,n)%values(b) = factor
-
- !One particle terms
-
- auxCIenergy= auxCIenergy + ConfigurationInteraction_instance%twoCenterIntegrals(ii)%values( diffOrb(1), diffOrb(2) )
-
- !! save the different orbitals
-
- auxIndex1= ConfigurationInteraction_instance%twoIndexArray(ii)%values( diffOrb(1), diffOrb(2))
- ConfigurationInteraction_instance%couplingMatrixOrbOne(ii,n)%values(b) = auxIndex1
-
- do ll=1, ConfigurationInteraction_instance%occupationNumber( ii ) !! the same orbitals pair are excluded by the exchange
-
- l = ConfigurationInteraction_instance%strings(ii)%values(ll,b) !! or a
-
- auxIndex2 = ConfigurationInteraction_instance%twoIndexArray(ii)%values( l,l)
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(ii)%values( auxIndex1, auxIndex2 )
-
- auxCIenergy = auxCIenergy + ConfigurationInteraction_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
-
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(ii)%values( &
- ConfigurationInteraction_instance%twoIndexArray(ii)%values(diffOrb(1),l), &
- ConfigurationInteraction_instance%twoIndexArray(ii)%values(l,diffOrb(2)) )
-
- auxCIenergy = auxCIenergy + &
- MolecularSystem_instance%species(ii)%kappa*ConfigurationInteraction_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
-
- end do
-
- !end if
-
- auxCIenergy= auxCIenergy * factor
-
- end function ConfigurationInteraction_calculateEnergyOneSame
-
- function ConfigurationInteraction_calculateEnergyOneDiff( ii, thisB, nn ) result (auxCIenergy)
- implicit none
- integer(8) :: thisB(:)
- integer(8) :: b
- integer :: i,j,ii, nn
- integer :: l,ll
- integer :: factor
- integer :: auxnumberOfOtherSpecieSpatialOrbitals
- integer :: auxIndex1, auxIndex11, auxIndex
- real(8) :: auxCIenergy
-
- auxCIenergy = 0.0_8
-
- b = thisB(ii)
-
- auxIndex1 = ConfigurationInteraction_instance%couplingMatrixOrbOne(ii,nn)%values(b)
- factor = ConfigurationInteraction_instance%couplingMatrixFactorOne(ii,nn)%values(b)
-
- do j=1, ii - 1 !! avoid ii, same species
-
- b = thisB(j)
-
- auxnumberOfOtherSpecieSpatialOrbitals = ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(j)
- auxIndex11 = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 )
-
- do ll=1, ConfigurationInteraction_instance%occupationNumber( j )
-
- l = ConfigurationInteraction_instance%strings(j)%values(ll,b)
-
- auxIndex = auxIndex11 + ConfigurationInteraction_instance%twoIndexArray(j)%values( l,l)
-
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(ii,j)%values(auxIndex, 1)
-
- end do
-
- end do
-
- do j= ii + 1, MolecularSystem_instance%numberOfQuantumSpecies!! avoid ii, same species
-
- b = thisB(j)
-
- auxnumberOfOtherSpecieSpatialOrbitals = ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(j)
-
- auxIndex11 = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 )
-
- do ll=1, ConfigurationInteraction_instance%occupationNumber( j )
-
- l = ConfigurationInteraction_instance%strings(j)%values(ll,b)
-
- auxIndex = auxIndex11 + ConfigurationInteraction_instance%twoIndexArray(j)%values( l,l)
-
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(ii,j)%values(auxIndex, 1)
- end do
-
- end do
-
- auxCIenergy= auxCIenergy * factor
-
- end function ConfigurationInteraction_calculateEnergyOneDiff
-
-
- function ConfigurationInteraction_calculateEnergyTwoSame( ii, a, b ) result (auxCIenergy)
- implicit none
- integer(8) :: a, b
- integer :: ii
- integer :: kk,z
- integer :: factor, AA(2), BB(2)
- integer(8) :: auxIndex
- integer :: diffOrbA(2), diffOrbB(2) !! to avoid confusions
- real(8) :: auxCIenergy
-
- !diffOrbA = 0
- !diffOrbB = 0
- z = 0
-
- do kk = 1, ConfigurationInteraction_instance%occupationNumber(ii)
- if ( configurationinteraction_instance%orbitals(ii)%values( &
- configurationinteraction_instance%strings(ii)%values(kk,a),b) == 0 ) then
- z = z + 1
- diffOrbA(z) = ConfigurationInteraction_instance%strings(ii)%values(kk,a)
- AA(z) = kk
- if ( z == 2 ) exit
- end if
- end do
-
- z = 0
- do kk = 1, ConfigurationInteraction_instance%occupationNumber(ii)
- if ( ConfigurationInteraction_instance%orbitals(ii)%values( &
- ConfigurationInteraction_instance%strings(ii)%values(kk,b),a) == 0 ) then
- z = z + 1
- diffOrbB(z) = ConfigurationInteraction_instance%strings(ii)%values(kk,b)
- BB(z) = kk
- if ( z == 2 ) exit
- end if
- end do
-
- factor = (-1)**(AA(1)-BB(1) + AA(2) - BB(2) )
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(ii)%values( &
- ConfigurationInteraction_instance%twoIndexArray(ii)%values(&
- diffOrbA(1),diffOrbB(1)),&
- ConfigurationInteraction_instance%twoIndexArray(ii)%values(&
- diffOrbA(2),diffOrbB(2)) )
-
- auxCIenergy = ConfigurationInteraction_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
-
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(ii)%values( &
- ConfigurationInteraction_instance%twoIndexArray(ii)%values(&
- diffOrbA(1),diffOrbB(2)),&
- ConfigurationInteraction_instance%twoIndexArray(ii)%values(&
- diffOrbA(2),diffOrbB(1)) )
- auxCIenergy = auxCIenergy + &
- MolecularSystem_instance%species(ii)%kappa*ConfigurationInteraction_instance%fourCenterIntegrals(ii,ii)%values(auxIndex, 1)
-
- auxCIenergy= auxCIenergy * factor
-
- end function ConfigurationInteraction_calculateEnergyTwoSame
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_buildDiagonal()
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v
- integer :: ci
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies, auxnumberOfSpecies
- integer :: size1, size2
- real(8) :: timeA, timeB
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- real(8) :: CIenergy
- integer(8), allocatable :: indexConf(:)
- integer, allocatable :: cilevel(:), auxcilevel(:), dd(:)
-
-!$ timeA = omp_get_wtime()
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- coupling = 0
- CIenergy = 0
- s = 0
- c = 0
- numberOfConfigurations = 0
-
- allocate ( ciLevel ( numberOfSpecies ) )
- allocate ( auxciLevel ( numberOfSpecies ) )
- allocate ( dd ( numberOfSpecies ) )
-
- ciLevel = 0
- auxciLevel = 0
-
- !!auxnumberOfSpecies = ConfigurationInteraction_numberOfConfigurationsRecursion2(s, numberOfSpecies, numberOfConfigurations, ciLevel)
-
- numberOfConfigurations = 0
- ciLevel = 0
-
- !! call recursion to get the number of configurations...
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- s = 0
- auxnumberOfSpecies = ConfigurationInteraction_numberOfConfigurationsRecursion(s, numberOfSpecies, numberOfConfigurations, ciLevel)
-
- end do
-
- call Vector_constructor8 ( ConfigurationInteraction_instance%diagonalHamiltonianMatrix2, &
- numberOfConfigurations, 0.0_8 )
-
- ConfigurationInteraction_instance%numberOfConfigurations = numberOfConfigurations
-
- write (*,*) "Number Of Configurations: ", numberOfConfigurations
-
- allocate ( indexConf ( numberOfSpecies ) )
- indexConf = 0
-
- !! calculate the diagonal
- s = 0
- c = 0
- ciLevel = 0
-
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- s = 0
- dd = 0
-
- u = ConfigurationInteraction_instance%auxciOrderList(ci)
- auxnumberOfSpecies = ConfigurationInteraction_buildDiagonalRecursion( s, numberOfSpecies, indexConf, c, dd, u, cilevel, auxcilevel )
- end do
- !stop
-
- deallocate ( dd )
- deallocate ( indexConf )
- deallocate ( ciLevel )
- deallocate ( auxciLevel )
-
-!$ timeB = omp_get_wtime()
-!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for Building diagonal of CI matrix : ", timeB - timeA ," (s)"
-
- write (*,*) "Reference energy, H_0: ", ConfigurationInteraction_instance%diagonalHamiltonianMatrix2%values(1)
-
- end subroutine ConfigurationInteraction_buildDiagonal
-
-recursive function ConfigurationInteraction_numberOfConfigurationsRecursion(s, numberOfSpecies, c, cilevel) result (os)
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies
- integer :: os,is
- integer :: cilevel(:)
-
- is = s + 1
- if ( is < numberOfSpecies ) then
- i = cilevel(is) + 1
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- os = ConfigurationInteraction_numberOfConfigurationsRecursion( is, numberOfSpecies, c, cilevel )
- end do
- else
- os = is
-
- i = cilevel(is) + 1
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- c = c + 1
- end do
- end if
-
- end function ConfigurationInteraction_numberOfConfigurationsRecursion
-
-recursive function ConfigurationInteraction_buildDiagonalRecursion(s, numberOfSpecies, indexConf, c, dd, u, cilevel, auxcilevel) result (os)
- implicit none
-
- integer(8) :: a,b,c,cc,d
- integer :: u,v
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies
- integer :: os,is
- integer :: size1, size2
- integer(8) :: indexConf(:)
- real(8) :: timeA, timeB
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- real(8) :: CIenergy
- integer :: ssize
- integer :: cilevel(:), auxcilevel(:), dd(:)
-
- is = s + 1
- if ( is < numberOfSpecies ) then
- i = cilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- indexConf(is) = ssize + a
-
- dd(is) =(a + ConfigurationInteraction_instance%ciOrderSize1(u,is))* ConfigurationInteraction_instance%ciOrderSize2(u,is)
- os = ConfigurationInteraction_buildDiagonalRecursion( is, numberOfSpecies, indexConf, c, dd, u, cilevel, auxcilevel )
- end do
- else
- os = is
- i = cilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- c = c + 1
- indexConf(is) = ssize + a
- !print *, indexConf
- dd(is) =(a + ConfigurationInteraction_instance%ciOrderSize1(u,is))* ConfigurationInteraction_instance%ciOrderSize2(u,is)
- d = sum(dd)
-
- ConfigurationInteraction_instance%diagonalHamiltonianMatrix2%values(c) = &
- ConfigurationInteraction_calculateEnergyZero ( indexConf )
-
- end do
- end if
-
- end function ConfigurationInteraction_buildDiagonalRecursion
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
-
- !! Map the indexes of initial CI matrix to the complete matrix.
- subroutine ConfigurationInteraction_getInitialIndexes()
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v
- integer :: ci
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies, auxnumberOfSpecies
- integer :: size1, size2
- real(8) :: timeA, timeB
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- real(8) :: CIenergy
- integer(8), allocatable :: indexConf(:)
- integer, allocatable :: cilevel(:)
-
-!$ timeA = omp_get_wtime()
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- s = 0
- c = 0
-
- call Matrix_constructorInteger ( ConfigurationInteraction_instance%auxConfigurations, int( numberOfSpecies,8), &
- int(CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX,8), 0 )
-
- !! call recursion
-
- allocate ( cilevel ( numberOfSpecies ) )
- allocate ( indexConf ( numberOfSpecies ) )
-
- s = 0
- c = 0
- indexConf = 0
- cilevel = 0
-
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- s = 0
- auxnumberOfSpecies = ConfigurationInteraction_getIndexesRecursion( s, numberOfSpecies, indexConf, c, cilevel )
- end do
-
- deallocate ( indexConf )
- deallocate ( cilevel )
-
-!$ timeB = omp_get_wtime()
-
-!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for getting initial indexes : ", timeB - timeA ," (s)"
-
- end subroutine ConfigurationInteraction_getInitialIndexes
-
-recursive function ConfigurationInteraction_getIndexesRecursion(s, numberOfSpecies, indexConf, c, cilevel) result (os)
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v
- integer :: i, j, ii, jj
- integer :: s, ss, numberOfSpecies
- integer :: os,is
- integer :: size1, size2
- integer(8) :: indexConf(:)
- integer(1) :: coupling
- integer :: ssize
- integer :: cilevel(:)
-
- is = s + 1
- if ( is < numberOfSpecies ) then
- i = cilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
-
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- indexConf(is) = ssize + a
- os = ConfigurationInteraction_getIndexesRecursion( is, numberOfSpecies, indexConf, c, cilevel)
- end do
- else
- os = is
- i = cilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
-
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- c = c + 1
- indexConf(is) = ssize + a
- do u = 1, CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
- if ( c == ConfigurationInteraction_instance%auxIndexCIMatrix%values(u) ) then
- do ss = 1, numberOfSpecies
- ConfigurationInteraction_instance%auxConfigurations%values(ss,u) = indexConf(ss)
- end do
- end if
- end do
- end do
- end if
-
- end function ConfigurationInteraction_getIndexesRecursion
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_calculateInitialCIMatrix()
- implicit none
-
- integer(8) :: a,b,aa,bb
- integer :: u,v
- integer :: i
- integer :: numberOfSpecies
- real(8) :: timeA1, timeB1
- integer(1) :: coupling
- integer(1), allocatable :: orbitalsA(:), orbitalsB(:)
- integer :: initialCIMatrixSize
- integer :: nproc
- integer(8), allocatable :: indexConfA(:)
- integer(8), allocatable :: indexConfB(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- initialCIMatrixSize = CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
-
- allocate ( indexConfA ( numberOfSpecies ) )
- allocate ( indexConfB ( numberOfSpecies ) )
-
-!$ timeA1 = omp_get_wtime()
-
- do a = 1, initialCIMatrixSize
- aa = ConfigurationInteraction_instance%auxIndexCIMatrix%values(a)
- do b = a, initialCIMatrixSize
- bb = ConfigurationInteraction_instance%auxIndexCIMatrix%values(b)
- coupling = 0
-
- indexConfA = 0
- indexConfB = 0
-
- do i = 1, numberOfSpecies
-
- allocate (orbitalsA ( ConfigurationInteraction_instance%numberOfOrbitals%values(i) ))
- allocate (orbitalsB ( ConfigurationInteraction_instance%numberOfOrbitals%values(i) ))
- orbitalsA = 0
- orbitalsB = 0
-
- indexConfA(i) = ConfigurationInteraction_instance%auxConfigurations%values(i,a)
- indexConfB(i) = ConfigurationInteraction_instance%auxConfigurations%values(i,b)
-
- do u = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- orbitalsA( ConfigurationInteraction_instance%strings(i)%values(u,indexConfA(i) ) ) = 1
- end do
- do v = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- orbitalsB( ConfigurationInteraction_instance%strings(i)%values(v,indexConfB(i) ) ) = 1
- end do
- coupling = coupling + &
- ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) - sum ( orbitalsA * orbitalsB )
-
- deallocate (orbitalsA )
- deallocate (orbitalsB )
-
- end do
- if ( coupling == 0 ) then
- ConfigurationInteraction_instance%initialHamiltonianMatrix%values(a,b) = &
- ConfigurationInteraction_instance%diagonalHamiltonianMatrix2%values(a)
-
- else if ( coupling == 1 ) then
-
- ConfigurationInteraction_instance%initialHamiltonianMatrix%values(a,b) = &
- ConfigurationInteraction_calculateEnergyOne ( 1, indexConfA, indexConfB )
-
- else if ( coupling == 2 ) then
-
- ConfigurationInteraction_instance%initialHamiltonianMatrix%values(a,b) = &
- ConfigurationInteraction_calculateEnergyTwo ( 1, indexConfA, indexConfB )
-
- end if
-
-
- end do
-
-
- end do
-
- deallocate ( indexConfB )
- deallocate ( indexConfA )
-
-!$ timeB1 = omp_get_wtime()
- !! symmetrize
- do a = 1, initialCIMatrixSize
- do b = a, initialCIMatrixSize
-
- ConfigurationInteraction_instance%initialHamiltonianMatrix%values(b,a) = &
- ConfigurationInteraction_instance%initialHamiltonianMatrix%values(a,b)
- end do
- end do
-
- !!open(unit=318, file="cimatrix.dat", action = "write", form="formatted")
- !!do a = 1, initialCIMatrixSize
- !! do b = 1, initialCIMatrixSize
- !! write (318,*) a,b, ConfigurationInteraction_instance%initialHamiltonianMatrix%values(a,b)
- !! end do
- !! write (318,*) " "
- !!end do
- !!close(318)
-!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for Calculating initial CI matrix : ", timeB1 - timeA1 ," (s)"
-
- end subroutine ConfigurationInteraction_calculateInitialCIMatrix
-
-
- subroutine ConfigurationInteraction_buildInitialCIMatrix2()
- implicit none
-
- type(Configuration) :: auxConfigurationA, auxConfigurationB
- type (Vector8) :: diagonalHamiltonianMatrix
- integer :: a,b,c,aa,bb,i
- real(8) :: timeA, timeB
- real(8) :: CIenergy
- integer :: initialCIMatrixSize
- integer :: nproc
-
- !$ timeA = omp_get_wtime()
- initialCIMatrixSize = CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
- if ( ConfigurationInteraction_instance%numberOfConfigurations < CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX ) then
- CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX = ConfigurationInteraction_instance%numberOfConfigurations !! assign to an internal variable
- end if
-
- call Vector_constructorInteger8 ( ConfigurationInteraction_instance%auxIndexCIMatrix, &
- ConfigurationInteraction_instance%numberOfConfigurations, 0_8 ) !hmm
-
- do a = 1, ConfigurationInteraction_instance%numberOfConfigurations
- ConfigurationInteraction_instance%auxIndexCIMatrix%values(a)= a
- end do
-
- !! save the unsorted diagonal Matrix
- call Vector_constructor8 ( ConfigurationInteraction_instance%diagonalHamiltonianMatrix, &
- ConfigurationInteraction_instance%numberOfConfigurations, 0.0_8 )
-
-
- ConfigurationInteraction_instance%diagonalHamiltonianMatrix%values = ConfigurationInteraction_instance%diagonalHamiltonianMatrix2%values
-
- !! To get only the lowest 300 values.
- call Vector_reverseSortElements8( ConfigurationInteraction_instance%diagonalHamiltonianMatrix2, &
- ConfigurationInteraction_instance%auxIndexCIMatrix, int(initialCIMatrixSize,8))
-
- call Matrix_constructor ( ConfigurationInteraction_instance%initialHamiltonianMatrix, int(initialCIMatrixSize,8) , &
- int(initialCIMatrixSize,8) , 0.0_8 )
-
- !! get the configurations for the initial hamiltonian matrix
- call ConfigurationInteraction_getInitialIndexes()
-
- call ConfigurationInteraction_calculateInitialCIMatrix()
-
- !! diagonalize the initial matrix
- call Vector_constructor8 ( ConfigurationInteraction_instance%initialEigenValues, int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
-
- call Matrix_constructor (ConfigurationInteraction_instance%initialEigenVectors, &
- int(initialCIMatrixSize,8), &
- int(CONTROL_instance%NUMBER_OF_CI_STATES,8), 0.0_8)
-
- call Matrix_eigen_select ( ConfigurationInteraction_instance%initialHamiltonianMatrix, &
- ConfigurationInteraction_instance%initialEigenValues, &
- 1, int(CONTROL_instance%NUMBER_OF_CI_STATES,4), &
- eigenVectors = ConfigurationInteraction_instance%initialEigenVectors, &
- flags = int(SYMMETRIC,4))
-
- write(*,*) "Initial eigenValues"
- do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- write (*,*) i, ConfigurationInteraction_instance%initialEigenValues%values(i)
- end do
-
- call Vector_destructor8 ( ConfigurationInteraction_instance%diagonalHamiltonianMatrix2 )
-
-!$ timeB = omp_get_wtime()
-!$ write(*,"(A,F10.3,A4)") "** TOTAL Elapsed Time for Solving Initial CI : ", timeB - timeA ," (s)"
-
- end subroutine ConfigurationInteraction_buildInitialCIMatrix2
-
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_buildHamiltonianMatrix()
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v,p
- integer :: ci
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies, auxnumberOfSpecies
- integer :: size1, size2
- real(8) :: timeA, timeB
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- real(8) :: CIenergy
- integer(8), allocatable :: indexConf(:)
- integer(8), allocatable :: pindexConf(:,:)
- integer, allocatable :: cilevel(:), auxcilevel(:), dd(:)
- integer(8), allocatable :: indexConfA(:,:)
- integer(8), allocatable :: indexConfB(:,:)
- integer, allocatable :: stringAinB(:)
- integer(1), allocatable :: couplingSpecies(:,:)
- integer :: n,nproc
-
-
-!$ timeA = omp_get_wtime()
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- numberOfConfigurations = ConfigurationInteraction_instance%numberOfConfigurations
-
- allocate ( ConfigurationInteraction_instance%allIndexConf( numberOfSpecies, numberOfConfigurations ) )
- allocate ( ciLevel ( numberOfSpecies ) )
- allocate ( indexConf ( numberOfSpecies ) )
- ciLevel = 0
- ConfigurationInteraction_instance%allIndexConf = 0
- indexConf = 0
-
- !! gather all configurations
- s = 0
- c = 0
- ciLevel = 0
-
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
-
- cilevel(:) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- s = 0
- auxnumberOfSpecies = ConfigurationInteraction_gatherConfRecursion( s, numberOfSpecies, indexConf, c, cilevel )
- end do
- !stop
-
- deallocate ( indexConf )
- deallocate ( ciLevel )
-
- !! allocate the hamiltonian matrix
- call Matrix_constructor ( ConfigurationInteraction_instance%hamiltonianMatrix, &
- int(ConfigurationInteraction_instance%numberOfConfigurations,8), &
- int(ConfigurationInteraction_instance%numberOfConfigurations,8), 0.0_8)
-
-
- nproc = omp_get_max_threads()
- !! calculate the matrix elements
- allocate ( indexConfA ( numberOfSpecies, nproc ) )
- allocate ( indexConfB ( numberOfSpecies, nproc ) )
- allocate ( pindexConf ( numberOfSpecies, nproc ) )
- allocate ( couplingSpecies ( numberOfSpecies, nproc ) )
-
- indexConfA = 0
- indexConfB = 0
- pindexConf = 0
- couplingSpecies = 0
-
-!$omp parallel &
-!$omp& private(a,b,coupling,i,p,stringAinB,n),&
-!$omp& shared(ConfigurationInteraction_instance, HartreeFock_instance)
- n = omp_get_thread_num() + 1
-!$omp do schedule (dynamic)
- do a = 1, numberOfConfigurations
- indexConfA(:,n) = ConfigurationInteraction_instance%allIndexConf(:,a)
- do b = a, numberOfConfigurations
-
- indexConfB(:,n) = ConfigurationInteraction_instance%allIndexConf(:,b)
-
- do i = 1, numberOfSpecies
- if ( pindexConf(i,n) /= indexConfB(i,n) ) then
- allocate (stringAinB (ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ))
- stringAinB = 0
- do p = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- stringAinB(p) = ConfigurationInteraction_instance%orbitals(i)%values( &
- ConfigurationInteraction_instance%strings(i)%values(p,indexConfA(i,n) ), indexConfB(i,n) )
- end do
- couplingSpecies(i,n) = configurationinteraction_instance%numberOfOccupiedOrbitals%values(i) - sum ( stringAinB )
- deallocate (stringAinB )
- end if
- end do
- coupling = sum(couplingSpecies(:,n))
-
- if ( coupling == 0 ) then
- ConfigurationInteraction_instance%hamiltonianMatrix%values(a,b) = &
- ConfigurationInteraction_instance%diagonalHamiltonianMatrix2%values(a)
-
- else if ( coupling == 1 ) then
-
- ConfigurationInteraction_instance%hamiltonianMatrix%values(a,b) = &
- ConfigurationInteraction_calculateEnergyOne ( n, indexConfA(:,n), indexConfB(:,n) )
-
- else if ( coupling == 2 ) then
-
- ConfigurationInteraction_instance%hamiltonianMatrix%values(a,b) = &
- ConfigurationInteraction_calculateEnergyTwo ( n, indexConfA(:,n), indexConfB(:,n) )
-
- end if
-
- pindexConf(:,n) = indexConfB(:,n)
-
- end do
- pindexConf(:,n) = 0
- end do
- !$omp end do nowait
- !$omp end parallel
-
- deallocate ( pindexConf )
- deallocate ( couplingSpecies )
- deallocate ( indexConfB )
- deallocate ( indexConfA )
-
- !! symmetrize
- do a = 1, numberOfConfigurations
- do b = a, numberOfConfigurations
- ConfigurationInteraction_instance%hamiltonianMatrix%values(b,a) = &
- ConfigurationInteraction_instance%hamiltonianMatrix%values(a,b)
- end do
- end do
-
- deallocate ( ConfigurationInteraction_instance%allIndexConf )
-
-!$ timeB = omp_get_wtime()
-!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for building Hamiltonian Matrix : ", timeB - timeA ," (s)"
-
- end subroutine ConfigurationInteraction_buildHamiltonianMatrix
-
-recursive function ConfigurationInteraction_gatherConfRecursion(s, numberOfSpecies, indexConf, c, cilevel ) result (os)
- implicit none
-
- integer(8) :: a,b,c,cc,d
- integer :: i, j, ii, jj
- integer :: s, numberOfSpecies
- integer :: os,is
- integer :: size1, size2
- integer(8) :: indexConf(:)
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- real(8) :: CIenergy
- integer :: ssize
- integer :: cilevel(:)
-
- is = s + 1
- if ( is < numberOfSpecies ) then
- i = cilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- indexConf(is) = ssize + a
- os = ConfigurationInteraction_gatherConfRecursion( is, numberOfSpecies, indexConf, c, cilevel )
- end do
- else
- os = is
- i = cilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- c = c + 1
- indexConf(is) = ssize + a
- ConfigurationInteraction_instance%allIndexConf(:,c) = indexConf
-
- end do
- end if
-
- end function ConfigurationInteraction_gatherConfRecursion
-
-recursive function ConfigurationInteraction_buildMatrixRecursion(nproc, s, indexConf, auxindexConf, cc, c, n, v, w, &
- cilevel, auxcilevel) result (os)
- implicit none
-
- integer(8) :: a,c,aa
- integer :: i, n, nn, nproc
- integer :: s, numberOfSpecies
- integer :: os,is,ss,ssize
- integer(8) :: cc(:)
- integer(8) :: indexConf(:,:)
- integer(8) :: auxindexConf(:,:)
- real(8) :: v(:)
- real(8) :: w(:)
- integer :: cilevel(:,:)
- integer :: auxcilevel(:,:)
-
- is = s + 1
- !if ( is < numberOfSpecies ) then
- do ss = 1, ConfigurationInteraction_instance%recursionVector1(is)
- i = cilevel(is,n) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
-
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- indexConf(is,n:) = ssize + a
- os = ConfigurationInteraction_buildMatrixRecursion( nproc, is, indexConf, auxindexConf, cc, c, n, v, w, cilevel, auxcilevel )
- end do
- end do
- !else
- do ss = 1, ConfigurationInteraction_instance%recursionVector2(is)
- os = is
- i = cilevel(is,n) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
-
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- c = c + 1
-
- if ( abs(v(c)) > CONTROL_instance%CI_MATVEC_TOLERANCE ) then
- cc(n) = c
- indexConf(is,n:) = ssize + a
-
- auxindexConf = indexConf
- auxcilevel = cilevel
-
- if ( n == nproc ) then
-
- !$omp parallel &
- !$omp& private(nn),&
- !$omp& shared(v,w, indexConf, cc, nproc, cilevel)
- !$omp do schedule (static)
- do nn = 1, nproc
- call ConfigurationInteraction_buildRow( nn, indexConf(:,nn), cc(nn), w, v(cc(nn)), cilevel(:,nn))
- end do
- !$omp end do nowait
- !$omp end parallel
- n = 0
-
- do nn = 1, nproc
- indexConf(:,nn) = indexConf(:,nproc)
- cilevel(:,nn) = cilevel(:,nproc)
- end do
- end if
-
- n = n + 1
-
- end if
-
- end do
- end do
- !end if
-
-
- end function ConfigurationInteraction_buildMatrixRecursion
-
- !! Alternative option to the recursion with the same computational cost... However, it may be helpul some day.
-
- function ConfigurationInteraction_buildMatrixRecursion2(nproc, s, indexConf, auxindexConf, cc, c, n, v, w, &
- cilevel, auxcilevel) result (os)
- implicit none
-
- integer(8) :: a,c,aa, x
- integer :: i, j, n, nn, nproc, ci
- integer :: s, numberOfSpecies
- integer :: os,is,ss,ssize
- integer(8) :: cc(:)
- integer(8) :: indexConf(:,:)
- integer(8) :: auxindexConf(:,:)
- real(8) :: v(:)
- real(8) :: w(:)
- integer :: cilevel(:,:)
- integer(8) :: totalsize, auxtotalsize
- integer :: auxcilevel(:,:)
- integer, allocatable :: counter(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- allocate (counter(numberOfSpecies))
- counter = 0
-
- totalsize = 1
- do i = 1 , numberOfSpecies
- totalsize = totalsize * ConfigurationInteraction_instance%numberOfStrings(i)%values(cilevel(i,n) + 1)
- end do
-
- do i = 1 , numberOfSpecies
- ci = cilevel(i,n) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(i)%values(ci)
- indexConf(i,n:) = ssize + 1
- end do
-
- indexConf(numberOfSpecies,n:) = indexConf(numberOfSpecies,n:) -1
-
- do x = 1, totalsize
-
- indexConf(numberOfSpecies,n:) = indexConf(numberOfSpecies,n:) + 1
-
- do i = numberOfSpecies, 1 + 1, -1
- auxtotalsize = 1
- do j = i, numberOfSpecies
- auxtotalsize = auxtotalsize * ConfigurationInteraction_instance%numberOfStrings(j)%values(cilevel(j,n) + 1)
- end do
- if (counter(i) == auxtotalsize) then
- do j = i, numberOfSpecies
- ci = cilevel(j,n) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(j)%values(ci)
- indexConf(j,n:) = ssize + 1
- end do
- counter(i) = 0
- indexConf(i-1,n:) = indexConf(i-1,n:) + 1
- end if
- counter(i) = counter(i) + 1
-
- end do
- !print *, indexConf(:,1)
- end do
-
- deallocate (counter)
-
- end function ConfigurationInteraction_buildMatrixRecursion2
-
-
- subroutine ConfigurationInteraction_buildRow( nn, indexConfA, c, w, vc, cilevelA)
- implicit none
-
- integer(8) :: a,b,c,bb,ci,d,cj
- integer :: u,v,uu,vv, p, nn
- integer :: i, j, auxis,auxos,is, ii, aa
- integer :: numberOfSpecies, s
- integer, allocatable :: stringAinB(:)
- integer(4) :: coupling
- integer(4) :: ssize,auxcoupling(3) !! 0,1,2
- integer(8) :: indexConfA(:)
- integer(8), allocatable :: indexConfB(:)
- integer(8), allocatable :: dd(:)
- real(8) :: vc, CIenergy
- real(8) :: w(:)
- integer :: cilevelA(:)
- integer, allocatable :: cilevel(:)
-
-
- !ConfigurationInteraction_instance%pindexConf = 0
-
- !!$ ConfigurationInteraction_instance%timeA(1) = omp_get_wtime()
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- do i = 1, numberOfSpecies
-
- if ( ConfigurationInteraction_instance%pindexConf(i,nn) /= indexConfA(i) ) then
-
- ConfigurationInteraction_instance%nCouplingOneTwo(i,nn)%values = 0
- auxcoupling = 0
-
- !allocate (stringBinA (ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ))
- allocate (stringAinB (ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i) ))
-
- stringAinB = 0
- !stringBinA = 0
-
- a = indexConfA(i)
-
- !!$ ConfigurationInteraction_instance%timeA(2) = omp_get_wtime()
-
- ssize = 0
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1)
- do b = 1 + ssize , ConfigurationInteraction_instance%numberOfStrings(i)%values(ci) + ssize
-
- !b = ssize + bb
- do p = ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i)+1, &
- ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
- !do p = 1, &
- ! ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
-
- stringAinB(p) = ConfigurationInteraction_instance%orbitals(i)%values( &
- ConfigurationInteraction_instance%strings(i)%values(p,a),b)
-
- !stringBinA(p) = ConfigurationInteraction_instance%orbitals(i)%values( &
- ! ConfigurationInteraction_instance%strings(i)%values(p,b),a)
- end do
-
- coupling = configurationinteraction_instance%numberOfOccupiedOrbitals%values(i) - sum ( stringAinB ) - &
- ConfigurationInteraction_instance%numberOfCoreOrbitals%values(i)
-
- ! coupling = configurationinteraction_instance%numberOfOccupiedOrbitals%values(i) - sum ( stringAinB )
-
- if ( coupling <= 2 ) then
-
- coupling = coupling + 1
-
- auxcoupling(coupling) = auxcoupling(coupling) + 1
-
- ConfigurationInteraction_instance%nCouplingOneTwo(i,nn)%values( coupling, ci) = &
- ConfigurationInteraction_instance%nCouplingOneTwo(i,nn)%values( coupling, ci) + 1
-
- ConfigurationInteraction_instance%couplingMatrix(i,nn)%values( auxcoupling(coupling), coupling ) = b
- end if
-
- end do
-
- ssize = ssize + ConfigurationInteraction_instance%numberOfStrings(i)%values(ci)
-
- end do
-
- deallocate (stringAinB)
- !deallocate (stringBinA)
- end if
-
- end do
-
- !!$ ConfigurationInteraction_instance%timeB(1) = omp_get_wtime()
-
- do is = 1, numberOfSpecies
- do i = 1, 3 !! 0,1,2
- ssize = 0
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(is)%values, dim = 1) !! 1 is always zero
- ssize = ssize + ConfigurationInteraction_instance%nCouplingOneTwo(is,nn)%values( i,ci )
- ConfigurationInteraction_instance%nCouplingSize(is,nn)%values( i,ci+1 ) = ssize
- end do
- ConfigurationInteraction_instance%nCouplingSize(is,nn)%values( i,1 ) = 0 !0?
- end do
- end do
-
-
- !!$ ConfigurationInteraction_instance%timeA(2) = omp_get_wtime()
- allocate ( indexConfB ( numberOfSpecies ) )
- allocate ( cilevel ( numberOfSpecies ) )
- allocate ( dd ( numberOfSpecies ) )
- indexConfB = 0
-
- !!$ ConfigurationInteraction_instance%timeB(2) = omp_get_wtime()
- !!$ ConfigurationInteraction_instance%timeA(3) = omp_get_wtime()
-
- !!one diff same species
- do i = 1, numberOfSpecies
-
- if ( ConfigurationInteraction_instance%pindexConf(i,nn) /= indexConfA(i) ) then
- cilevel(:) = 0
- indexConfB = indexConfA
-
- cilevel = cilevelA
-
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
- cilevel(i) = ci - 1
-
- auxos = ConfigurationInteraction_buildRowRecursionFirstOne( i, indexConfA, indexConfB, nn, cilevel )
-
- end do
- end if
- end do
-
- !!$ ConfigurationInteraction_instance%timeB(3) = omp_get_wtime()
-
- !!$ ConfigurationInteraction_instance%timeA(4) = omp_get_wtime()
-
- !$omp atomic
- w(c) = w(c) + vc*ConfigurationInteraction_instance%diagonalHamiltonianMatrix%values(c)
- !$omp end atomic
-
- !!$ ConfigurationInteraction_instance%timeB(4) = omp_get_wtime()
-
- !!$ ConfigurationInteraction_instance%timeA(5) = omp_get_wtime()
- !! one diff
- do i = 1, numberOfSpecies
- cilevel(:) = 0
- indexConfB = indexConfA
-
- cilevel = cilevelA
-
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
- cilevel(i) = ci - 1
-
- do u = 1, configurationinteraction_instance%sizeciorderlist
- if ( sum(abs(cilevel - &
- configurationinteraction_instance%ciorderlist( configurationinteraction_instance%auxciorderlist(u), :))) == 0 ) then
-
- uu = configurationinteraction_instance%auxciorderlist(u)
- dd = 0
-
- auxos = ConfigurationInteraction_buildRowRecursionSecondOne( i, indexConfB, w, vc, dd, nn, cilevel, uu )
- exit
-
- end if
- end do
- end do
- end do
-
- !!$ ConfigurationInteraction_instance%timeB(5) = omp_get_wtime()
- !!$ ConfigurationInteraction_instance%timeA(6) = omp_get_wtime()
-
- !! two diff same species
- do i = 1, numberOfSpecies
-
- cilevel(:) = 0
- indexConfB = indexConfA
- cilevel = cilevelA
-
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
- cilevel(i) = ci - 1
-
- do u = 1, ConfigurationInteraction_instance%sizeCiOrderList
- if ( sum(abs(cilevel - &
- ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(u), :))) == 0 ) then
- uu = ConfigurationInteraction_instance%auxciOrderList(u)
- dd = 0
-
- if ( ConfigurationInteraction_instance%pindexConf(i,nn) /= indexConfA(i) ) then
- auxos = ConfigurationInteraction_buildRowRecursionSecondTwoCal( i, indexConfA, indexConfB, w, vc, dd, nn, cilevel, uu )
- else
- auxos = ConfigurationInteraction_buildRowRecursionSecondTwoGet( i, indexConfA, indexConfB, w, vc, dd, nn, cilevel, uu )
- end if
-
- exit
-
- end if
- end do
- end do
- end do
-
- !!$ ConfigurationInteraction_instance%timeB(6) = omp_get_wtime()
- !!$ ConfigurationInteraction_instance%timeA(7) = omp_get_wtime()
-
- !! two diff diff species
- do v = 1, ConfigurationInteraction_instance%ncouplingOrderTwoDiff
-
- i = ConfigurationInteraction_instance%couplingOrderIndex(3,v)%values(1)
- j = ConfigurationInteraction_instance%couplingOrderIndex(3,v)%values(2)
-
- indexConfB = indexConfA
- cilevel = cilevelA
-
- do ci = 1, size(ConfigurationInteraction_instance%numberOfStrings(i)%values, dim = 1) !! 1 is always zero
- cilevel(i) = ci - 1
- do cj = 1, size(ConfigurationInteraction_instance%numberOfStrings(j)%values, dim = 1) !! 1 is always zero
- cilevel(j) = cj - 1
- do u = 1, ConfigurationInteraction_instance%sizeCiOrderList
- if ( sum(abs(cilevel - &
- ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(u), :))) == 0 ) then
-
- uu = ConfigurationInteraction_instance%auxciOrderList(u)
- dd = 0
- auxos = ConfigurationInteraction_buildRowRecursionSecondTwoDiff( i, j, indexConfB, w, vc, dd, nn, cilevel, uu )
- exit
- end if
- end do
- end do
- end do
- end do
-
- !!$ ConfigurationInteraction_instance%timeB(7) = omp_get_wtime()
-
- !!$ print *, "omptime"
- !!$ print *, "1", ConfigurationInteraction_instance%timeB(1) - ConfigurationInteraction_instance%timeA(1)
- !!$ print *, "2", ConfigurationInteraction_instance%timeB(2) - ConfigurationInteraction_instance%timeA(2)
- !!$ print *, "3", ConfigurationInteraction_instance%timeB(3) - ConfigurationInteraction_instance%timeA(3)
- !!$ print *, "4", ConfigurationInteraction_instance%timeB(4) - ConfigurationInteraction_instance%timeA(4)
- !!$ print *, "5", ConfigurationInteraction_instance%timeB(5) - ConfigurationInteraction_instance%timeA(5)
- !!$ print *, "6", ConfigurationInteraction_instance%timeB(6) - ConfigurationInteraction_instance%timeA(6)
- !!$ print *, "7", ConfigurationInteraction_instance%timeB(7) - ConfigurationInteraction_instance%timeA(7)
-
- ConfigurationInteraction_instance%pindexConf(:,nn) = indexConfA(:)
-
- deallocate ( dd )
- deallocate ( cilevel )
- deallocate ( indexConfB )
-
- end subroutine ConfigurationInteraction_buildRow
-
-recursive function ConfigurationInteraction_buildRowRecursionFirstOne( ii, indexConfA, indexConfB, nn, cilevel ) result (os)
- implicit none
-
- integer(8) :: a, aa
- integer :: ii, nn, ci
- integer :: os, ssize
- integer(8) :: indexConfA(:)
- integer(8) :: indexConfB(:)
- real(8) :: CIenergy
- integer :: cilevel(:)
-
- ci = cilevel(ii) + 1
- ssize = ConfigurationInteraction_instance%nCouplingSize(ii,nn)%values( 2,ci )
- do aa = 1, ConfigurationInteraction_instance%nCouplingOneTwo(ii,nn)%values( 2,ci )
- a = ssize + aa
-
- indexConfB(ii) = ConfigurationInteraction_instance%couplingMatrix(ii,nn)%values(a, 2)
- CIenergy = ConfigurationInteraction_calculateEnergyOneSame ( nn, ii, indexConfA, indexConfB )
- ConfigurationInteraction_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii)) = CIenergy
-
- end do
-
- end function ConfigurationInteraction_buildRowRecursionFirstOne
-
-recursive function ConfigurationInteraction_buildRowRecursionSecondOne( ii, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
- implicit none
-
- integer(8) :: a,d, aa
- integer :: ii, nn, ci, u, j
- integer :: ssize
- integer :: os,numberOfSpecies
- integer(8) :: indexConfB(:)
- integer(8) :: dd(:)
- real(8) :: vc
- real(8) :: w(:)
- real(8) :: CIenergy
- integer :: cilevel(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- ci = cilevel(ii) + 1
- ssize = ConfigurationInteraction_instance%nCouplingSize(ii,nn)%values( 2,ci )
-
- do j = 1, numberOfSpecies
- dd(j) = (indexConfB(j) - ConfigurationInteraction_instance%numberOfStrings2(j)%values(cilevel(j)+1) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,j) )* ConfigurationInteraction_instance%ciOrderSize2(u,j)
- end do
-
- do aa = 1, ConfigurationInteraction_instance%nCouplingOneTwo(ii,nn)%values( 2,ci )
- a = ssize + aa
-
- indexConfB(ii) = ConfigurationInteraction_instance%couplingMatrix(ii,nn)%values(a, 2)
-
- dd(ii) = (indexConfB(ii) - ConfigurationInteraction_instance%numberOfStrings2(ii)%values(ci) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,ii) )* ConfigurationInteraction_instance%ciOrderSize2(u,ii)
-
- d = sum(dd)
-
- CIenergy = ConfigurationInteraction_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii))
- CIenergy = CIenergy + ConfigurationInteraction_calculateEnergyOneDiff ( ii, indexConfB, nn )
- CIenergy = vc*CIenergy
-
- !$omp atomic
- w(d) = w(d) + CIenergy
- !$omp end atomic
- end do
-
- end function ConfigurationInteraction_buildRowRecursionSecondOne
-
- function ConfigurationInteraction_buildRowRecursionSecondTwoCal( ii, indexConfA, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
- implicit none
-
- integer(8) :: a,d, aa
- integer :: i, ii, nn, ci, u, j
- integer :: s, ssize
- integer :: os,numberOfSpecies
- integer(8) :: indexConfA(:)
- integer(8) :: indexConfB(:)
- integer(8) :: dd(:)
- real(8) :: vc
- real(8) :: w(:)
- real(8) :: CIenergy
- integer :: cilevel(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- ci = cilevel(ii) + 1
- ssize = ConfigurationInteraction_instance%nCouplingSize(ii,nn)%values( 3,ci )
-
- do j = 1, numberOfSpecies
- dd(j) = (indexConfB(j) - ConfigurationInteraction_instance%numberOfStrings2(j)%values(cilevel(j)+1) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,j) )* ConfigurationInteraction_instance%ciOrderSize2(u,j)
- end do
-
- do aa = 1, ConfigurationInteraction_instance%nCouplingOneTwo(ii,nn)%values( 3,ci )
- a = ssize + aa
-
- indexConfB(ii) = ConfigurationInteraction_instance%couplingMatrix(ii,nn)%values(a, 3)
- dd(ii) = (indexConfB(ii) - ConfigurationInteraction_instance%numberOfStrings2(ii)%values(ci) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,ii) )* ConfigurationInteraction_instance%ciOrderSize2(u,ii)
-
- d = sum(dd)
-
- !CIenergy = ConfigurationInteraction_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii))
- CIenergy = ConfigurationInteraction_calculateEnergyTwoSame ( ii, indexConfA(ii), indexConfB(ii) )
- ConfigurationInteraction_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii)) = CIenergy
- CIenergy = vc*CIenergy
-
- !$omp atomic
- w(d) = w(d) + CIenergy
- !$omp end atomic
- end do
-
- end function ConfigurationInteraction_buildRowRecursionSecondTwoCal
-
- function ConfigurationInteraction_buildRowRecursionSecondTwoGet( ii, indexConfA, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
- implicit none
-
- integer(8) :: a,d, aa
- integer :: i, ii, nn, ci, u, j
- integer :: s, ssize
- integer :: os,numberOfSpecies
- integer(8) :: indexConfA(:)
- integer(8) :: indexConfB(:)
- integer(8) :: dd(:)
- real(8) :: vc
- real(8) :: w(:)
- real(8) :: CIenergy
- integer :: cilevel(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- ci = cilevel(ii) + 1
- ssize = ConfigurationInteraction_instance%nCouplingSize(ii,nn)%values( 3,ci )
-
- do j = 1, numberOfSpecies
- dd(j) = (indexConfB(j) - ConfigurationInteraction_instance%numberOfStrings2(j)%values(cilevel(j)+1) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,j) )* ConfigurationInteraction_instance%ciOrderSize2(u,j)
- end do
-
- do aa = 1, ConfigurationInteraction_instance%nCouplingOneTwo(ii,nn)%values( 3,ci )
- a = ssize + aa
-
- indexConfB(ii) = ConfigurationInteraction_instance%couplingMatrix(ii,nn)%values(a, 3)
- dd(ii) = (indexConfB(ii) - ConfigurationInteraction_instance%numberOfStrings2(ii)%values(ci) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,ii) )* ConfigurationInteraction_instance%ciOrderSize2(u,ii)
-
- d = sum(dd)
-
- CIenergy = ConfigurationInteraction_instance%couplingMatrixEnergyOne(ii,nn)%values(indexConfB(ii))
- !CIenergy = ConfigurationInteraction_calculateEnergyTwoSame ( ii, indexConfA(ii), indexConfB(ii) )
- CIenergy = vc*CIenergy
-
- !$omp atomic
- w(d) = w(d) + CIenergy
- !$omp end atomic
- end do
-
- end function ConfigurationInteraction_buildRowRecursionSecondTwoGet
-
- function ConfigurationInteraction_buildRowRecursionSecondTwoDiff( ii, jj, indexConfB, w, vc, dd, nn, cilevel, u ) result (os)
- implicit none
-
- integer(8) :: ai,aj,d, aai, aaj
- integer :: ii, nn, ci, u, k, jj, cj
- integer :: ssizei, ssizej
- integer :: bi, bj, factor, factori
- integer :: auxIndex1, auxIndex2, auxIndex
- integer :: os,numberOfSpecies
- integer(8) :: indexConfB(:)
- integer(8) :: dd(:)
- real(8) :: vc
- real(8) :: w(:)
- real(8) :: CIenergy
- integer :: cilevel(:)
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- ci = cilevel(ii) + 1
- cj = cilevel(jj) + 1
- ssizei = ConfigurationInteraction_instance%nCouplingSize(ii,nn)%values( 2,ci )
- ssizej = ConfigurationInteraction_instance%nCouplingSize(jj,nn)%values( 2,cj )
-
- do k = 1, numberOfSpecies
- dd(k) = (indexConfB(k) - ConfigurationInteraction_instance%numberOfStrings2(k)%values(cilevel(k)+1) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,k) )* ConfigurationInteraction_instance%ciOrderSize2(u,k)
- end do
-
- do aai = 1, ConfigurationInteraction_instance%nCouplingOneTwo(ii,nn)%values( 2,ci )
- ai = ssizei + aai
- indexConfB(ii) = ConfigurationInteraction_instance%couplingMatrix(ii,nn)%values(ai, 2)
- dd(ii) = (indexConfB(ii) - ConfigurationInteraction_instance%numberOfStrings2(ii)%values(ci) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,ii) )* ConfigurationInteraction_instance%ciOrderSize2(u,ii)
-
- bi = indexConfB(ii)
- factori = ConfigurationInteraction_instance%couplingMatrixFactorOne(ii,nn)%values(bi)
- auxIndex1 = ConfigurationInteraction_instance%couplingMatrixOrbOne(ii,nn)%values(bi)
- auxIndex1 = ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(jj) * (auxIndex1 - 1 )
-
- do aaj = 1, ConfigurationInteraction_instance%nCouplingOneTwo(jj,nn)%values( 2,cj )
- aj = ssizej + aaj
- indexConfB(jj) = ConfigurationInteraction_instance%couplingMatrix(jj,nn)%values(aj, 2)
-
- dd(jj) = (indexConfB(jj) - ConfigurationInteraction_instance%numberOfStrings2(jj)%values(cj) + &
- ConfigurationInteraction_instance%ciOrderSize1(u,jj) )* ConfigurationInteraction_instance%ciOrderSize2(u,jj)
-
- d = sum(dd)
- !CIenergy = vc*ConfigurationInteraction_calculateEnergyTwoDiff ( ii, jj, indexConfB, nn )
-
- bj = indexConfB(jj)
- factor = factori * ConfigurationInteraction_instance%couplingMatrixFactorOne(jj,nn)%values(bj)
- auxIndex2 = ConfigurationInteraction_instance%couplingMatrixOrbOne(jj,nn)%values(bj)
- auxIndex = auxIndex1 + auxIndex2
-
- CIenergy = vc * factor *ConfigurationInteraction_instance%fourCenterIntegrals(ii,jj)%values(auxIndex, 1)
- !CIenergy = vc*CIenergy
-
- !$omp atomic
- w(d) = w(d) + CIenergy
- !$omp end atomic
- end do
- end do
-
- end function ConfigurationInteraction_buildRowRecursionSecondTwoDiff
-
-
-
- function ConfigurationInteraction_getIndex ( indexConf ) result ( output )
- implicit none
- integer(8) :: indexConf(:)
- integer(8) :: output, ssize
- integer :: i,j, numberOfSpecies
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- output = 0
- !! simplify!!
- do i = 1, numberOfSpecies
- ssize = 1
- do j = i + 1, numberOfSpecies
- ssize = ssize * ConfigurationInteraction_instance%sumstrings(j)
- !ssize = ssize * sum(ConfigurationInteraction_instance%numberOfStrings(j)%values(1:2))
- end do
- output = output + ( indexConf(i) - 1 ) * ssize
- end do
- output = output + 1
-
- end function ConfigurationInteraction_getIndex
-
-recursive function ConfigurationInteraction_getIndexSize(s, c, auxcilevel) result (os)
- implicit none
-
- integer(8) :: a,b,c
- integer :: u,v
- integer :: i, j, ii, jj, ss
- integer :: s, numberOfSpecies
- integer :: os,is,cc, ssize
- integer :: auxcilevel(:)
-
- is = s + 1
- do ss = 1, ConfigurationInteraction_instance%recursionVector1(is)
- i = auxcilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
- do a = 1, ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- os = ConfigurationInteraction_getIndexSize( is, c, auxcilevel )
- end do
- end do
- do ss = 1, ConfigurationInteraction_instance%recursionVector2(is)
- os = is
- i = auxcilevel(is) + 1
- ssize = ConfigurationInteraction_instance%numberOfStrings2(is)%values(i)
- c = c + ConfigurationInteraction_instance%numberOfStrings(is)%values(i)
- end do
-
- end function ConfigurationInteraction_getIndexSize
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_buildAndSaveCIMatrix()
- implicit none
- type(Configuration) :: auxConfigurationA, auxConfigurationB
- integer(8) :: a,b,c,d,n, nproc,cc
- real(8) :: timeA, timeB
- character(50) :: CIFile
- integer :: CIUnit
- real(8) :: CIenergy
- integer, allocatable :: indexArray(:),auxIndexArray(:)
- real(8), allocatable :: energyArray(:),auxEnergyArray(:)
- integer :: starting, ending, step, maxConfigurations
- character(50) :: fileNumberA, fileNumberB
- integer :: cmax
- integer :: maxStackSize, i, ia, ib, ssize, ci,cj, size1, size2
- integer :: nblocks
-
- size1 = size(ConfigurationInteraction_instance%configurations(1)%occupations, dim=1)
- size2 = size(ConfigurationInteraction_instance%configurations(1)%occupations, dim=2)
-
- maxStackSize = CONTROL_instance%CI_STACK_SIZE
-
- allocate (ConfigurationInteraction_instance%auxconfs (size1,size2, ConfigurationInteraction_instance%numberOfConfigurations ))
-
- do a=1, ConfigurationInteraction_instance%numberOfConfigurations
- ConfigurationInteraction_instance%auxconfs(:,:,a) = ConfigurationInteraction_instance%configurations(a)%occupations
- end do
-
-
- timeA = omp_get_wtime()
-
- CIFile = "lowdin.ci"
- CIUnit = 4
-
-#ifdef intel
- open(unit=CIUnit, file=trim(CIFile), action = "write", form="unformatted", BUFFERED="YES")
-#else
- open(unit=CIUnit, file=trim(CIFile), action = "write", form="unformatted")
-#endif
-
- print *, " OMP Number of threads: " , omp_get_max_threads()
- nproc = omp_get_max_threads()
-
- !call omp_set_num_threads(omp_get_max_threads())
- !call omp_set_num_threads(nproc)
-
- !if (allocated(cmax)) deallocate(cmax)
- !allocate(cmax(nproc))
- cmax = 0
-
- maxConfigurations = ConfigurationInteraction_instance%numberOfConfigurations
- if (allocated(indexArray )) deallocate(indexArray)
- allocate (indexArray(maxConfigurations))
- indexArray = 0
- if (allocated(energyArray )) deallocate(energyArray)
- allocate (energyArray(maxConfigurations))
- energyArray = 0
-
- do a=1, ConfigurationInteraction_instance%numberOfConfigurations
-
- !indexArray = 0
- energyArray = 0
- c = 0
-
-!$omp parallel &
-!$omp& private(b,CIenergy),&
-!$omp& shared(indexArray,energyArray, HartreeFock_instance),&
-!$omp& shared(ConfigurationInteraction_instance) reduction (+:c)
-!$omp do schedule(guided)
- do b= a, ConfigurationInteraction_instance%numberOfConfigurations
-! CIenergy = ConfigurationInteraction_calculateCoupling( a, b, size1, size2 )
-
- if ( abs(CIenergy) > 1E-9 ) then
- c = c +1
- !indexArray(b) = b
- energyArray(b) = CIenergy
- end if
- end do
-!$omp end do nowait
-!$omp end parallel
-
-
- cmax = cmax + c
-
- write(CIUnit) c
- write(CIUnit) a
-
- allocate (auxEnergyArray(c))
- allocate (auxIndexArray(c))
-
- cj = 0
- do ci = a, ConfigurationInteraction_instance%numberOfConfigurations
- !if ( indexArray(ci) > 0 ) then
- if ( abs(energyArray(ci)) > 1E-9 ) then
- cj = cj + 1
- auxIndexArray(cj) =(ci)
- auxEnergyArray(cj) = energyArray(ci)
- end if
- end do
- nblocks = ceiling(real(c) / real(maxStackSize) )
-
- do i = 1, nblocks - 1
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- write(CIUnit) auxIndexArray(ia:ib)
- end do
-
- ia = maxStackSize * (nblocks - 1) + 1
- write(CIUnit) auxIndexArray(ia:c)
-
- deallocate(auxIndexArray)
-
- do i = 1, nblocks - 1
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- write(CIUnit) auxEnergyArray(ia:ib)
- end do
-
- ia = maxStackSize * (nblocks - 1) + 1
- write(CIUnit) auxEnergyArray(ia:c)
-
- deallocate (auxEnergyArray)
-
- end do
-
- write(CIUnit) -1
-
- close(CIUnit)
-
- deallocate(indexArray)
- deallocate(energyArray)
-
- timeB = omp_get_wtime()
- write(*,"(A,F10.3,A4)") "** TOTAL Elapsed Time for Building CI matrix : ", timeB - timeA ," (s)"
- print *, "Nonzero elements", cmax
-
- end subroutine ConfigurationInteraction_buildAndSaveCIMatrix
-
- function ConfigurationInteraction_calculateEnergyZero( this ) result (auxCIenergy)
- implicit none
-
- integer(8) :: this(:)
- integer(8) :: a, b
- integer :: i,j,s
- integer :: l,k,z,kk,ll
- integer :: factor
- integer(2) :: numberOfDiffOrbitals
- integer :: auxnumberOfOtherSpecieSpatialOrbitals
- integer(8) :: auxIndex1, auxIndex2, auxIndex
- real(8) :: auxCIenergy
-
- auxCIenergy = 0.0_8
-
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
- a = this(i)
- do kk=1, ConfigurationInteraction_instance%occupationNumber( i ) !! 1 is from a and 2 from b
-
- k = ConfigurationInteraction_instance%strings(i)%values(kk,a)
-
- !One particle terms
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%twoCenterIntegrals(i)%values( k, k )
-
- !Two particles, same specie
- auxIndex1 = ConfigurationInteraction_instance%twoIndexArray(i)%values(k,k)
-
- do ll = kk + 1, ConfigurationInteraction_instance%occupationNumber( i ) !! 1 is from a and 2 from b
-
- l = ConfigurationInteraction_instance%strings(i)%values(ll,a)
- auxIndex2 = ConfigurationInteraction_instance%twoIndexArray(i)%values(l,l)
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(i)%values(auxIndex1,auxIndex2)
-
- !Coulomb
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
-
- !Exchange, depends on spin
-
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(i)%values( &
- ConfigurationInteraction_instance%twoIndexArray(i)%values(k,l), &
- ConfigurationInteraction_instance%twoIndexArray(i)%values(l,k) )
-
- auxCIenergy = auxCIenergy + &
- MolecularSystem_instance%species(i)%kappa*ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
- end do
-
- !!Two particles, different species
- do j = i + 1, MolecularSystem_instance%numberOfQuantumSpecies
- b = this(j)
- auxnumberOfOtherSpecieSpatialOrbitals = ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(j)
-
- do ll = 1, ConfigurationInteraction_instance%occupationNumber( j ) !! 1 is from a and 2 from b
- l = ConfigurationInteraction_instance%strings(j)%values(ll,b)
-
- auxIndex2= ConfigurationInteraction_instance%twoIndexArray(j)%values(l,l)
- auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
-
- auxCIenergy = auxCIenergy + &!couplingEnergy
- ConfigurationInteraction_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
-
- end do
-
- end do
-
- end do
- end do
-
- auxCIenergy= auxCIenergy + HartreeFock_instance%puntualInteractionEnergy
-
- end function ConfigurationInteraction_calculateEnergyZero
-
- function ConfigurationInteraction_calculateEnergyOne( n, thisA, thisB ) result (auxCIenergy)
- implicit none
- integer(8) :: thisA(:), thisB(:)
- integer(8) :: a, b
- integer :: i,j,s,n, nn
- integer :: l,k,z,kk,ll
- integer :: factor
- integer :: auxnumberOfOtherSpecieSpatialOrbitals
- integer(8) :: auxIndex1, auxIndex2, auxIndex
- integer :: diffOrb(2), otherdiffOrb(2) !! to avoid confusions
- real(8) :: auxCIenergy
- integer :: auxOcc
-
- auxCIenergy = 0.0_8
-
- factor = 1
-
- !! copy a
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
- a = thisA(i)
-
- ConfigurationInteraction_instance%auxstring(n,i)%values(:) = ConfigurationInteraction_instance%strings(i)%values(:,a)
- end do
-
- !! set at maximum coincidence
-
- do s = 1, MolecularSystem_instance%numberOfQuantumSpecies
- a = thisA(s)
- b = thisB(s)
-
- do i = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s) !b
- do j = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s) !a
- if ( ConfigurationInteraction_instance%auxstring(n,s)%values(j) == &
- ConfigurationInteraction_instance%strings(s)%values(i,b) ) then
-
- auxOcc = ConfigurationInteraction_instance%auxstring(n,s)%values(i)
- ConfigurationInteraction_instance%auxstring(n,s)%values(i) = ConfigurationInteraction_instance%strings(s)%values(i,b)
- ConfigurationInteraction_instance%auxstring(n,s)%values(j) = auxOcc
- if ( i /= j ) factor = -1*factor
- exit
- end if
- end do
- end do
- end do
-
- !! calculate
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
-
- a = thisA(i)
- b = thisB(i)
- diffOrb = 0
-
- do kk = 1, ConfigurationInteraction_instance%occupationNumber( i) !! 1 is from a and 2 from b
-
- if ( ConfigurationInteraction_instance%auxstring(n,i)%values(kk) .ne. &
- ConfigurationInteraction_instance%strings(i)%values(kk,b) ) then
- diffOrb(1) = ConfigurationInteraction_instance%auxstring(n,i)%values(kk)
- diffOrb(2) = ConfigurationInteraction_instance%strings(i)%values(kk,b)
- exit
- end if
-
- end do
- if ( diffOrb(2) > 0 ) then
-
- !One particle terms
- auxCIenergy= auxCIenergy + ConfigurationInteraction_instance%twoCenterIntegrals(i)%values( &
- diffOrb(1), diffOrb(2) )
-
- auxIndex1= ConfigurationInteraction_instance%twoIndexArray(i)%values( &
- diffOrb(1), diffOrb(2))
-
- do ll = 1, ConfigurationInteraction_instance%occupationNumber( i ) !! 1 is from a and 2 from b
-
- if ( ConfigurationInteraction_instance%auxstring(n,i)%values(ll) .eq. &
- ConfigurationInteraction_instance%strings(i)%values(ll,b) ) then
-
- l = ConfigurationInteraction_instance%auxstring(n,i)%values(ll) !! or b
-
- auxIndex2 = ConfigurationInteraction_instance%twoIndexArray(i)%values( l,l)
-
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(i)%values( auxIndex1, auxIndex2 )
-
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
-
-
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(i)%values( &
- ConfigurationInteraction_instance%twoIndexArray(i)%values(diffOrb(1),l), &
- ConfigurationInteraction_instance%twoIndexArray(i)%values(l,diffOrb(2)) )
-
- auxCIenergy = auxCIenergy + &
- MolecularSystem_instance%species(i)%kappa*ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
-
- end if
- end do
- if (MolecularSystem_instance%numberOfQuantumSpecies .gt. 1 ) then !.and. spin(1) .eq. spin(2) ) then
- do j=1, MolecularSystem_instance%numberOfQuantumSpecies
-
- if (i .ne. j) then
-
- auxnumberOfOtherSpecieSpatialOrbitals = ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(j)
-
- do ll=1, ConfigurationInteraction_instance%occupationNumber( j ) !! 1 is from a and 2 from b
- l = ConfigurationInteraction_instance%auxstring(n,j)%values(ll) !! or b?
-
- auxIndex2 = ConfigurationInteraction_instance%twoIndexArray(j)%values( l,l)
- auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
-
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
- end do
- end if
- end do
- end if
- end if
- end do
-
- auxCIenergy= auxCIenergy * factor
-
-
- end function ConfigurationInteraction_calculateEnergyOne
-
-
- function ConfigurationInteraction_calculateEnergyTwo( n, thisA, thisB ) result (auxCIenergy)
- implicit none
- integer(8) :: thisA(:), thisB(:)
- integer(8) :: a, b
- integer :: i,j,s,n
- integer :: l,k,z,kk,ll
- integer :: factor
- integer :: auxnumberOfOtherSpecieSpatialOrbitals
- integer(8) :: auxIndex1, auxIndex2, auxIndex
- integer :: diffOrb(4), otherdiffOrb(4) !! to avoid confusions
- real(8) :: auxCIenergy
- integer :: auxOcc
-
- auxCIenergy = 0.0_8
- factor = 1
-
- !! copy a
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
- a = thisA(i)
- ConfigurationInteraction_instance%auxstring(n,i)%values(:) = ConfigurationInteraction_instance%strings(i)%values(:,a)
- end do
-
- !! set at maximum coincidence
-
- do s = 1, MolecularSystem_instance%numberOfQuantumSpecies
- a = thisA(s)
- b = thisB(s)
-
- do i = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s) !b
- do j = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(s) !a
- if ( ConfigurationInteraction_instance%auxstring(n,s)%values(j) == &
- ConfigurationInteraction_instance%strings(s)%values(i,b) ) then
-
- auxOcc = ConfigurationInteraction_instance%auxstring(n,s)%values(i)
- ConfigurationInteraction_instance%auxstring(n,s)%values(i) = ConfigurationInteraction_instance%strings(s)%values(i,b)
- ConfigurationInteraction_instance%auxstring(n,s)%values(j) = auxOcc
- if ( i /= j ) factor = -1*factor
- exit
- end if
- end do
- end do
- end do
-
- !!calculate
- do i=1, MolecularSystem_instance%numberOfQuantumSpecies
-
- a = thisA(i)
- b = thisB(i)
- diffOrb = 0
- z = 1
- do k = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(i)
-
- if ( ConfigurationInteraction_instance%auxstring(n,i)%values(k) .ne. &
- ConfigurationInteraction_instance%strings(i)%values(k,b) ) then
- diffOrb(z) = ConfigurationInteraction_instance%auxstring(n,i)%values(k)
- diffOrb(z+2) = ConfigurationInteraction_instance%strings(i)%values(k,b)
- z = z + 1
- cycle
- end if
- end do
- if ( diffOrb(2) > 0 ) then
-
- !Coulomb
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(i)%values( &
- ConfigurationInteraction_instance%twoIndexArray(i)%values(&
- diffOrb(1),diffOrb(3)),&
- ConfigurationInteraction_instance%twoIndexArray(i)%values(&
- diffOrb(2),diffOrb(4)) )
-
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
-
- auxIndex = ConfigurationInteraction_instance%fourIndexArray(i)%values( &
- ConfigurationInteraction_instance%twoIndexArray(i)%values(&
- diffOrb(1),diffOrb(4)),&
- ConfigurationInteraction_instance%twoIndexArray(i)%values(&
- diffOrb(2),diffOrb(3)) )
-
- auxCIenergy = auxCIenergy + &
- MolecularSystem_instance%species(i)%kappa*ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1)
-
- end if
- !! different species
- do j = i + 1, MolecularSystem_instance%numberOfQuantumSpecies
- auxnumberOfOtherSpecieSpatialOrbitals = ConfigurationInteraction_instance%numberOfSpatialOrbitals2%values(j)
- otherdiffOrb = 0
- a = thisA(j)
- b = thisB(j)
-
- do k = 1, ConfigurationInteraction_instance%numberOfOccupiedOrbitals%values(j)
- if ( ConfigurationInteraction_instance%auxstring(n,j)%values(k) .ne. &
- ConfigurationInteraction_instance%strings(j)%values(k,b) ) then
- otherdiffOrb(1) = ConfigurationInteraction_instance%auxstring(n,j)%values(k)
- otherdiffOrb(3) = ConfigurationInteraction_instance%strings(j)%values(k,b)
- exit
- end if
-
- end do
-
- if ( diffOrb(3) .gt. 0 .and. otherdiffOrb(3) .gt. 0 ) then
- auxIndex1 = ConfigurationInteraction_instance%twoIndexArray(i)%values(&
- diffOrb(1),diffOrb(3) )
- auxIndex2 = ConfigurationInteraction_instance%twoIndexArray(j)%values(&
- otherdiffOrb(1),otherdiffOrb(3) )
- auxIndex = auxnumberOfOtherSpecieSpatialOrbitals * (auxIndex1 - 1 ) + auxIndex2
-
- auxCIenergy = auxCIenergy + &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,j)%values(auxIndex, 1)
-
- end if
- end do
- end do
-
- auxCIenergy= auxCIenergy * factor
-
- end function ConfigurationInteraction_calculateEnergyTwo
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine ConfigurationInteraction_getTransformedIntegrals()
- implicit none
-
- integer :: numberOfSpecies
- integer :: i,j,m,n,mu,nu,a,b
- integer(8) :: c
- integer :: specieID
- integer :: otherSpecieID
- character(10) :: nameOfSpecie
- character(10) :: nameOfOtherSpecie
- integer :: ocupationNumber
- integer :: ocupationNumberOfOtherSpecie
- integer :: numberOfContractions
- integer :: numberOfContractionsOfOtherSpecie
- type(Matrix) :: hcoreMatrix
- type(Matrix) :: coefficients
- real(8) :: charge
- real(8) :: otherSpecieCharge
-
- integer :: ssize1, ssize2
- type(Matrix) :: externalPotential
-
- character(50) :: wfnFile
- character(50) :: arguments(20)
- integer :: wfnUnit
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
- allocate(ConfigurationInteraction_instance%twoCenterIntegrals(numberOfSpecies))
- allocate(ConfigurationInteraction_instance%fourCenterIntegrals(numberOfSpecies,numberOfSpecies))
-
- allocate(ConfigurationInteraction_instance%twoIndexArray(numberOfSpecies))
- allocate(ConfigurationInteraction_instance%fourIndexArray(numberOfSpecies))
-
-! print *,""
-! print *,"BEGIN INTEGRALS TRANFORMATION:"
-! print *,"========================================"
-! print *,""
-! print *,"--------------------------------------------------"
-! print *," Algorithm Four-index integral tranformation"
-! print *," Yamamoto, Shigeyoshi; Nagashima, Umpei. "
-! print *," Computer Physics Communications, 2005, 166, 58-65"
-! print *,"--------------------------------------------------"
-! print *,""
-!
-! call TransformIntegrals_constructor( repulsionTransformer )
-
- do i=1, numberOfSpecies
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) )
- specieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfSpecie )
- ocupationNumber = MolecularSystem_getOcupationNumber( i )
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i )
- charge=MolecularSystem_getCharge(i)
-
-! write (6,"(T10,A)")"ONE PARTICLE INTEGRALS TRANSFORMATION FOR: "//trim(nameOfSpecie)
- call Matrix_constructor (ConfigurationInteraction_instance%twoCenterIntegrals(i), &
- int(numberOfContractions,8), int(numberOfContractions,8), 0.0_8 )
-
- call Matrix_constructor (hcoreMatrix,int(numberOfContractions,8), int(numberOfContractions,8), 0.0_8)
-
- !! Open file for wavefunction
-
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
-
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- arguments(2) = MolecularSystem_getNameOfSpecie(i)
- arguments(1) = "COEFFICIENTS"
-
- coefficients = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- arguments(1) = "HCORE"
-
- hcoreMatrix = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- !arguments(1) = "FOCK"
- !ConfigurationInteraction_instance%FockMatrix(i) = &
- ! Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- ! columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- !arguments(1) = "ORBITALS"
- !call Vector_getFromFile( elementsNum = numberOfContractions, &
- ! unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
- ! output =ConfigurationInteraction_instance%energyofmolecularorbitals(i) )
-
- !do m=1,numberOfContractions
- ! ConfigurationInteraction_instance%fockMatrix(i)%values(m,m) = &
- ! ConfigurationInteraction_instance%energyofmolecularorbitals(i)%values(m)
- !end do
-
- ! Already saved in hcore
- ! if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
- ! arguments(1) = "EXTERNAL_POTENTIAL"
-
- ! externalPotential = &
- ! Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- ! columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- ! hcoreMatrix%values = hcoreMatrix%values + externalPotential%values
- ! end if
- !print *, "fock matrix for species", i
- !call matrix_show ( ConfigurationInteraction_instance%fockMatrix(i) )
-
- do m=1,numberOfContractions
- do n=m, numberOfContractions
- do mu=1, numberOfContractions
- do nu=1, numberOfContractions
- ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(m,n) = &
- ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(m,n) + &
- coefficients%values(mu,m)* &
- coefficients%values(nu,n)* &
- hcoreMatrix%values(mu,nu)
- end do
- end do
- end do
- end do
-
-!! Not implemented yet
-!! if( WaveFunction_HF_instance( specieID )%isThereExternalPotential ) then
-!! do m=1,numberOfContractions
-!! do n=m, numberOfContractions
-!! do mu=1, numberOfContractions
-!! do nu=1, numberOfContractions
-!! ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(m,n) = &
-!! ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(m,n) + &
-!! WaveFunction_HF_instance( specieID )%waveFunctionCoefficients%values(mu,m)* &
-!! WaveFunction_HF_instance( specieID )%waveFunctionCoefficients%values(nu,n) * &
-!! WaveFunction_HF_instance( specieID )%ExternalPotentialMatrix%values(mu,nu)
-!! end do
-!! end do
-!! end do
-!! end do
-!! end if
-
- do m = 1,numberOfContractions
- do n = m, numberOfContractions
- ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(n,m)=&
- ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(m,n)
- end do
- end do
-
- call Matrix_constructorInteger8(ConfigurationInteraction_instance%twoIndexArray(i), &
- int( numberOfContractions,8), int( numberOfContractions,8) , 0_8 )
-
- c = 0
- do a=1,numberOfContractions
- do b = a, numberOfContractions
- c = c + 1
- ConfigurationInteraction_instance%twoIndexArray(i)%values(a,b) = c !IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
- ConfigurationInteraction_instance%twoIndexArray(i)%values(b,a) = ConfigurationInteraction_instance%twoIndexArray(i)%values(a,b)
- end do
- end do
-
-
- ssize1 = MolecularSystem_getTotalNumberOfContractions( i )
- ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2
-
- call Matrix_constructorInteger8(ConfigurationInteraction_instance%fourIndexArray(i), &
- int( ssize1,8), int( ssize1,8) , 0_8 )
- c = 0
- do a = 1, ssize1
- do b = a, ssize1
- c = c + 1
- ConfigurationInteraction_instance%fourIndexArray(i)%values(a,b) = c! IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
- ConfigurationInteraction_instance%fourIndexArray(i)%values(b,a) = &
- ConfigurationInteraction_instance%fourIndexArray(i)%values(a,b)
- end do
- end do
-
-
- call ReadTransformedIntegrals_readOneSpecies( specieID, ConfigurationInteraction_instance%fourCenterIntegrals(i,i) )
- ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values = &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values * charge * charge
-
- if ( numberOfSpecies > 1 ) then
- do j = 1 , numberOfSpecies
- if ( i .ne. j) then
- nameOfOtherSpecie = trim( MolecularSystem_getNameOfSpecie( j ) )
- otherSpecieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie )
- ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( j )
- numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( j )
- otherSpecieCharge = MolecularSystem_getCharge(j)
-
- call ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,j) )
- ConfigurationInteraction_instance%fourCenterIntegrals(i,j)%values = &
- ConfigurationInteraction_instance%fourCenterIntegrals(i,j)%values * charge * otherSpeciecharge
-
-
- end if
- end do
- end if
- end do
- close (wfnUnit)
- call Matrix_destructor (hcoreMatrix)
-
- end subroutine ConfigurationInteraction_getTransformedIntegrals
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
-! subroutine ConfigurationInteraction_printTransformedIntegralsToFile()
-! implicit none
-!
-!! type(TransformIntegrals) :: repulsionTransformer
-! integer :: numberOfSpecies
-! integer :: i,j,m,n,mu,nu
-! integer :: a,b,r,s,u, auxIndex
-! integer :: z
-! integer :: stats, recNum
-! character(10) :: nameOfSpecie, auxNameOfSpecie
-! character(10) :: nameOfOtherSpecie
-! integer :: ocupationNumber
-! integer :: ocupationNumberOfOtherSpecie
-! integer :: numberOfContractions
-! integer :: numberOfContractionsOfOtherSpecie
-! type(Matrix) :: auxMatrix
-! type(Matrix) :: molecularCouplingMatrix
-! type(Matrix) :: molecularExtPotentialMatrix
-!
-! integer :: spin
-!
-! real(8) :: totalCoupEnergy
-! real(8) :: fixedPotEnergy
-! real(8) :: fixedIntEnergy
-! real(8) :: KineticEnergy
-! real(8) :: RepulsionEnergy
-! real(8) :: couplingEnergy
-
-
-! numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-!
-! print *,""
-! print *,"BEGIN INTEGRALS TRANFORMATION:"
-! print *,"========================================"
-! print *,""
-! print *,"--------------------------------------------------"
-! print *," Algorithm Four-index integral tranformation"
-! print *," Yamamoto, Shigeyoshi; Nagashima, Umpei. "
-! print *," Computer Physics Communications, 2005, 166, 58-65"
-! print *,"--------------------------------------------------"
-! print *,""
-!
-! totalCoupEnergy = 0.0_8
-! fixedPotEnergy = 0.0_8
-! fixedIntEnergy = 0.0_8
-! KineticEnergy = 0.0_8
-! RepulsionEnergy = 0.0_8
-! couplingEnergy = 0.0_8
-! spin = 0
-!
-! do i=1, numberOfSpecies
-! nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) )
-! numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i )
-! spin = MolecularSystem_getMultiplicity(i) - 1
-!
-! if(trim(nameOfSpecie) /= "E-BETA" ) then
-!
-! if(trim(nameOfSpecie) /= "U-" ) then
-!
-! open(unit=35, file="FCIDUMP-"//trim(nameOfSpecie)//".com", form="formatted", status="replace")
-!
-! write(35,"(A)")"gprint basis"
-! write(35,"(A)")"memory 1000 M"
-! write(35,"(A)")"cartesian"
-! write(35,"(A)")"gthresh twoint=1e-12 prefac=1e-14 energy=1e-10 edens=1e-10 zero=1e-12"
-! write(35,"(A)")"basis={"
-! call ConfigurationInteraction_printBasisSetToFile(35)
-! write(35,"(A)")"}"
-!
-! write(35,"(A)")"symmetry nosym"
-! write(35,"(A)")"angstrom"
-! write(35,"(A)")"geometry={"
-! call ConfigurationInteraction_printGeometryToFile(35)
-! write(35,"(A)")"}"
-!
-! write(35,"(A)")"import 21500.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"jcoup")
-! write(35,"(A)")"import 21510.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"icoup")
-! write(35,"(A)")"import 21520.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"kin")
-! write(35,"(A)")"import 21530.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"coeff")
-!
-! if(trim(nameOfSpecie) == "E-ALPHA") then
-!
-! write(35,"(A)")"import 21550.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//"E-BETA"//"."//"coeff")
-!
-! end if
-!
-! write(35,"(A)")"import 21540.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"dens")
-! !write(35,"(A)")"import 21560.2 "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"pot")
-!
-! write(35,"(A)")"{matrop"
-! write(35,"(A)")"load Jcoup, SQUARE 21500.2"
-! write(35,"(A)")"load Icoup, SQUARE 21510.2"
-! write(35,"(A)")"load K, SQUARE 21520.2"
-! !write(35,"(A)")"load Pot, SQUARE 21560.2"
-! write(35,"(A)")"add H01, K Icoup Jcoup"! Pot"
-! write(35,"(A)")"save H01, 21511.2 H0"
-! write(35,"(A)")"}"
-!
-! if(trim(nameOfSpecie) == "E-ALPHA") then
-! write(35,"(A)")"{matrop"
-! write(35,"(A)")"load Ca, SQUARE 21530.2"
-! write(35,"(A)")"load Cb, SQUARE 21550.2"
-! write(35,"(A)")"save Ca, 2100.1 ORBITALS alpha"
-! write(35,"(A)")"save Cb, 2100.1 ORBITALS beta"
-! write(35,"(A)")"}"
-! else
-! write(35,"(A)")"{matrop"
-! write(35,"(A)")"load C, SQUARE 21530.2"
-! write(35,"(A)")"save C, 2100.1 ORBITALS"
-! write(35,"(A)")"}"
-! end if
-!
-! write(35,"(A)")"{matrop"
-! write(35,"(A)")"load D, SQUARE 21540.2"
-! write(35,"(A)")"save D, 21400.1 DENSITY"
-! write(35,"(A)")"}"
-!
-!
-! ! write(35,"(A,I3,A,I3,A,I3,A1)")"$FCI NORB=",numberOfContractions, ",NELEC=", MolecularSystem_getNumberOfParticles(i)-spin, ", MS2=", spin,","
-! !
-! ! write(35,"(A)",advance="no") "ORBSYM="
-! ! do z=1, numberOfContractions
-! ! write(35,"(I1,A1)",advance="no") 1,","
-! ! end do
-! ! write(35,"(A)") ""
-! !
-! ! write(35, "(A,I3,A,I9)") "ISYM=",1, ",MEMORY=", 200000000
-! !
-! ! write(35, "(A)") "$"
-! !
-! ! print *, "FOUR CENTER INTEGRALS FOR SPECIE: ", trim(nameOfSpecie)
-! !
-! ! recNum = 0
-! ! do a = 1, numberOfContractions
-! ! n = a
-! ! do b=a, numberOfContractions
-! ! u = b
-! ! do r = n, numberOfContractions
-! ! do s = u, numberOfContractions
-! !
-! ! auxIndex = IndexMap_tensorR4ToVector( a, b, r, s, numberOfContractions )
-! ! write(35,"(F20.10,4I3)") ConfigurationInteraction_instance%fourCenterIntegrals(i,i)%values(auxIndex, 1), a, b, r, s
-! !
-! ! end do
-! ! u=r+1
-! ! end do
-! ! end do
-! ! end do
-! !
-! !
-! ! print *, "TWO CENTER TRANSFORMED INTEGRALS FOR SPECIE: ", trim(nameOfSpecie)
-! !
-! ! do m=1,numberOfContractions
-! ! do n=1, m
-! ! write(35,"(F20.10,4I3)") ConfigurationInteraction_instance%twoCenterIntegrals(i)%values(m,n), m, n, 0, 0
-! ! end do
-! ! end do
-!
-! !!Calculating the core energy....
-!
-!
-!
-! totalCoupEnergy = MolecularSystem_instance%totalCouplingEnergy
-! fixedPotEnergy = MolecularSystem_instance%puntualInteractionEnergy
-!
-! do j = 1, numberOfSpecies
-!
-! auxNameOfSpecie= trim( MolecularSystem_getNameOfSpecie( j ) )
-!
-! if(trim(auxNameOfSpecie) == "E-ALPHA" .or. trim(auxNameOfSpecie) == "E-BETA" .or. trim(auxNameOfSpecie) == "e-") cycle
-!
-! fixedIntEnergy = fixedIntEnergy + MolecularSystem_instance%quantumPuntualInteractionEnergy(j)
-! KineticEnergy = KineticEnergy + MolecularSystem_instance%kineticEnergy(j)
-! RepulsionEnergy = RepulsionEnergy + MolecularSystem_instance%repulsionEnergy(j)
-! couplingEnergy = couplingEnergy + MolecularSystem_instance%couplingEnergy(j)
-!
-! end do
-!
-! !!COMO SEA QUE SE META LA ENERGIA DE CORE
-! !write(35,"(F20.10,4I3)") (couplingEnergy-totalCoupEnergy+fixedPotEnergy+fixedIntEnergy+KineticEnergy+RepulsionEnergy), 0, 0, 0, 0
-!
-! print*, "COREENERGY ", (couplingEnergy-totalCoupEnergy+fixedPotEnergy+fixedIntEnergy+KineticEnergy+RepulsionEnergy)
-!
-! write(35,"(A)")"{hf"
-! write(35,"(A)")"maxit 250"
-! write(35,"(A10,I2,A1,A6,I2,A1,A6,I3)")"wf spin=", spin, ",", "charge=",0, ",", "elec=", MolecularSystem_getNumberOfParticles(i)-spin
-! write(35,"(A)")"start 2100.1"
-! write(35,"(A)")"}"
-!
-!
-! write(35,"(A)")"{fci"
-! write(35,"(A)")"maxit 250"
-! write(35,"(A)")"dm 21400.1, IGNORE_ERROR"
-! write(35,"(A)")"orbit 2100.1, IGNORE_ERROR"
-! write(35,"(A10,I2,A1,A6,I2,A1,A6,I3)")"wf spin=", spin, ",", "charge=",0, ",", "elec=", MolecularSystem_getNumberOfParticles(i)-spin
-! ! write(35,"(A)")"print, orbital=2 integral = 2"
-! ! write(35,"(A)")"CORE"
-! write(35,"(A)")"}"
-!
-! write(35,"(A)")"{matrop"
-! write(35,"(A)")"load D, DEN, 21400.1"
-! ! write(35,"(A)")"print D"
-! write(35,"(A)")"natorb Norb, D"
-! write(35,"(A)")"save Norb, 21570.2"
-! ! write(35,"(A)")"print Norb"
-! write(35,"(A)")"}"
-!
-! write(35,"(A)")"put molden "//trim(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//"."//"molden")//"; orb, 21570.2"
-!
-! close(35)
-!
-! print*, ""
-!
-! stats = system("molpro "//"FCIDUMP-"//trim(nameOfSpecie)//".com ")
-! stats = system("cat "//"FCIDUMP-"//trim(nameOfSpecie)//".out ")
-!
-! print*, ""
-!
-! print *,"END"
-!
-! end if
-!
-! end if
-!
-! end do
-
-! end subroutine ConfigurationInteraction_printTransformedIntegralsToFile
-
-! subroutine ConfigurationInteraction_printGeometryToFile(unit)
-! implicit none
-! integer :: unit
-!
-! integer :: i
-! integer :: from, to
-! real(8) :: origin(3)
-! character(50) :: auxString
-!
-!
-! do i = 1, MolecularSystem_getTotalNumberOfParticles()
-!
-! origin = MolecularSystem_getOrigin( iterator = i ) * AMSTRONG
-! auxString = trim( MolecularSystem_getNickName( iterator = i ) )
-!
-! if( String_findSubstring( trim( auxString ), "e-") == 1 ) then
-! if( String_findSubstring( trim( auxString ), "BETA") > 1 ) then
-! cycle
-! end if
-!
-! from =String_findSubstring( trim(auxString), "[")
-! to = String_findSubstring( trim(auxString), "]")
-! auxString = auxString(from+1:to-1)
-!
-! else if( String_findSubstring( trim( auxString ), "_") /= 0 ) then
-! cycle
-! end if
-!
-!
-! write (unit,"(A10,3F20.10)") trim( auxString ), origin(1), origin(2), origin(3)
-!
-! end do
-
-! end subroutine ConfigurationInteraction_printGeometryToFile
-
-
-! subroutine ConfigurationInteraction_printBasisSetToFile(unit)
-! implicit none
-!
-! integer :: unit
-!
-! integer :: i, j
-! character(16) :: auxString
-!
-!
-! do i =1, MolecularSystem_instance%numberOfQuantumSpecies
-!
-! auxString=trim( Map_getKey( MolecularSystem_instance%speciesID, iterator=i ) )
-!
-! if( String_findSubstring( trim(auxString), "e-") == 1 ) then
-!
-! if( String_findSubstring( trim(auxString), "BETA") > 1 ) then
-!
-! cycle
-!
-! end if
-!
-!
-! end if
-!
-! if(trim(auxString)=="U-") cycle
-!
-! do j =1, size(MolecularSystem_instance%particlesPtr)
-!
-! if ( trim(MolecularSystem_instance%particlesPtr(j)%symbol) == trim( Map_getKey( MolecularSystem_instance%speciesID, iterator=i ) ) &
-! .and. MolecularSystem_instance%particlesPtr(j)%isQuantum ) then
-!
-! call BasisSet_showInMolproForm( MolecularSystem_instance%particlesPtr(j)%basis, trim(MolecularSystem_instance%particlesPtr(j)%nickname), unit=unit )
-!
-! end if
-!
-! end do
-!
-! end do
-
-! end subroutine ConfigurationInteraction_printBasisSetToFile
-
-
- !**
- ! @ Retorna la energia final com correccion Moller-Plesset de orrden dado
- !**
- function ConfigurationInteraction_getTotalEnergy() result(output)
- implicit none
- real(8) :: output
-
- output = ConfigurationInteraction_instance%totalEnergy
-
- end function ConfigurationInteraction_getTotalEnergy
-
-
- !>
- !! @brief Maneja excepciones de la clase
- !<
- subroutine ConfigurationInteraction_exception( typeMessage, description, debugDescription)
- implicit none
- integer :: typeMessage
- character(*) :: description
- character(*) :: debugDescription
-
- type(Exception) :: ex
-
- call Exception_constructor( ex , typeMessage )
- call Exception_setDebugDescription( ex, debugDescription )
- call Exception_setDescription( ex, description )
- call Exception_show( ex )
- call Exception_destructor( ex )
-
- end subroutine ConfigurationInteraction_exception
-
- subroutine ConfigurationInteraction_saveEigenVector ()
- implicit none
- character(50) :: nameFile
- integer :: unitFile
- integer(8) :: i, ia
- integer :: ib, nonzero
- integer, allocatable :: auxIndexArray(:)
- real(8), allocatable :: auxArray(:)
- integer :: maxStackSize
-
- maxStackSize = CONTROL_instance%CI_STACK_SIZE
- nameFile = "lowdin.civec"
- unitFile = 20
-
- nonzero = 0
- do i = 1, ConfigurationInteraction_instance%numberOfConfigurations
- if ( abs(ConfigurationInteraction_instance%eigenVectors%values(i,1) ) >= 1E-12 ) nonzero = nonzero + 1
- end do
-
- write (*,*) "nonzero", nonzero
-
- allocate(auxArray(nonzero))
- allocate(auxIndexArray(nonzero))
-
- ia = 0
- do i = 1, ConfigurationInteraction_instance%numberOfConfigurations
- if ( abs(ConfigurationInteraction_instance%eigenVectors%values(i,1) ) >= 1E-12 ) then
- ia = ia + 1
- auxIndexArray(ia) = i
- auxArray(ia) = ConfigurationInteraction_instance%eigenVectors%values(i,1)
- end if
- end do
-
- open(unit=unitFile, file=trim(nameFile), status="replace", form="unformatted")
-
- write(unitFile) ConfigurationInteraction_instance%eigenValues%values(1)
- write(unitFile) nonzero
-
- do i = 1, ceiling(real(nonzero) / real(maxStackSize) )
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- if ( ib > nonzero ) ib = nonzero
- write(unitFile) auxIndexArray(ia:ib)
- end do
- deallocate(auxIndexArray)
-
- do i = 1, ceiling(real(nonzero) / real(maxStackSize) )
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- if ( ib > nonzero ) ib = nonzero
- write(unitFile) auxArray(ia:ib)
- end do
- deallocate(auxArray)
-
- close(unitFile)
-
- end subroutine ConfigurationInteraction_saveEigenVector
-
- subroutine ConfigurationInteraction_loadEigenVector (eigenValues,eigenVectors)
- implicit none
- type(Vector8) :: eigenValues
- type(Matrix) :: eigenVectors
- character(50) :: nameFile
- integer :: unitFile
- integer :: i, ia, ib, nonzero
- real(8) :: eigenValue
- integer, allocatable :: auxIndexArray(:)
- real(8), allocatable :: auxArray(:)
- integer :: maxStackSize
-
- maxStackSize = CONTROL_instance%CI_STACK_SIZE
-
-
- nameFile = "lowdin.civec"
- unitFile = 20
-
-
- open(unit=unitFile, file=trim(nameFile), status="old", action="read", form="unformatted")
-
- readvectors : do
- read (unitFile) eigenValue
- read (unitFile) nonzero
- write (*,*) "eigenValue", eigenValue
- write (*,*) "nonzero", nonzero
-
- allocate (auxIndexArray(nonzero))
- auxIndexArray = 0
-
- do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- if ( ib > nonZero ) ib = nonZero
- read (unitFile) auxIndexArray(ia:ib)
- end do
-
- allocate (auxArray(nonzero))
- auxArray = 0
-
- do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- if ( ib > nonZero ) ib = nonZero
- read (unitFile) auxArray(ia:ib)
- end do
- exit readvectors
- end do readvectors
-
- eigenValues%values(1) = eigenValue
- do i = 1, nonzero
- eigenVectors%values(auxIndexArray(i),1) = auxArray(i)
- end do
-
- deallocate (auxIndexArray )
- deallocate (auxArray )
-
-
- close(unitFile)
-
- end subroutine ConfigurationInteraction_loadEigenVector
-
- subroutine av ( nx, v, w)
-
- !*******************************************************************************
- !! AV computes w <- A * V where A is a discretized Laplacian.
- ! Parameters:
- ! Input, integer NX, the length of the vectors.
- ! Input, real V(NX), the vector to be operated on by A.
- ! Output, real W(NX), the result of A*V.
- !
- implicit none
-
- integer(8) nx
- real(8) v(nx)
- real(8) w(nx)
- character(50) :: CIFile
- integer :: CIUnit
- integer, allocatable :: jj(:)
- real(8), allocatable :: CIEnergy(:)
- integer :: nonzero,ii, kk
- integer :: maxStackSize, i, ia, ib
-
- CIFile = "lowdin.ci"
- CIUnit = 20
- nonzero = 0
- maxStackSize = CONTROL_instance%CI_STACK_SIZE
-
- w = 0
-#ifdef intel
- open(unit=CIUnit, file=trim(CIFile), action = "read", form="unformatted", BUFFERED="YES")
-#else
- open(unit=CIUnit, file=trim(CIFile), action = "read", form="unformatted")
-#endif
-
- readmatrix : do
- read (CIUnit) nonzero
- if (nonzero > 0 ) then
-
- read (CIUnit) ii
-
- if ( allocated(jj)) deallocate (jj)
- allocate (jj(nonzero))
- jj = 0
-
- if ( allocated(CIEnergy)) deallocate (CIEnergy)
- allocate (CIEnergy(nonzero))
- CIEnergy = 0
-
- do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
-
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- if ( ib > nonZero ) ib = nonZero
- read (CIUnit) jj(ia:ib)
-
- end do
-
- do i = 1, ceiling(real(nonZero) / real(maxStackSize) )
-
- ib = maxStackSize * i
- ia = ib - maxStackSize + 1
- if ( ib > nonZero ) ib = nonZero
- read (CIUnit) CIEnergy(ia:ib)
-
- end do
-
- w(ii) = w(ii) + CIEnergy(1)*v(jj(1)) !! disk
- do kk = 2, nonzero
- !w(ii) = w(ii) + ConfigurationInteraction_calculateCIenergy(ii,jj(kk))*v(jj(kk)) !! direct
- w(ii) = w(ii) + CIEnergy(kk)*v(jj(kk)) !! disk
- w(jj(kk)) = w(jj(kk)) + CIEnergy(kk)*v(ii) !! disk
- end do
-
- else if ( nonzero == -1 ) then
- exit readmatrix
- end if
- end do readmatrix
-
-!! memory
-! do i = 1, nx
-! w(:) = w(:) + ConfigurationInteraction_instance%hamiltonianMatrix%values(:,i)*v(i)
-! end do
-
- close(CIUnit)
-
- return
- end subroutine av
-
-
- subroutine ConfigurationInteraction_jadamiluInterface(n, maxeig, eigenValues, eigenVectors)
- implicit none
- external DPJDREVCOM
- integer(8) :: maxnev
- real(8) :: CIenergy
- integer(8) :: nproc
- type(Vector8), intent(inout) :: eigenValues
- type(Matrix), intent(inout) :: eigenVectors
-
-! N: size of the problem
-! MAXEIG: max. number of wanteg eig (NEIG<=MAXEIG)
-! MAXSP: max. value of MADSPACE
- integer(8) :: n, maxeig, MAXSP
- integer(8) :: LX
- real(8), allocatable :: EIGS(:), RES(:), X(:)!, D(:)
-! arguments to pass to the routines
- integer(8) :: NEIG, MADSPACE, ISEARCH, NINIT
- integer(8) :: JA(1), IA(1)
- integer(8) :: ICNTL(5)
- integer(8) :: ITER, IPRINT, INFO
- real(8) :: SIGMA, TOL, GAP, MEM, DROPTOL, SHIFT
- integer(8) :: NDX1, NDX2, NDX3
- integer(8) :: IJOB! some local variables
- integer(8) :: auxSize
- integer(4) :: size1,size2
- integer(8) :: I,J,K,ii,jj,jjj
- integer(4) :: iiter
- logical :: fullMatrix
-
- maxsp = CONTROL_instance%CI_MADSPACE
- !!if ( CONTROL_instance%CI_JACOBI ) then
-
- LX = N*(3*MAXSP+MAXEIG+1)+4*MAXSP*MAXSP
-
- if ( allocated ( eigs ) ) deallocate ( eigs )
- allocate ( eigs ( maxeig ) )
- eigs = 0.0_8
- if ( allocated ( res ) ) deallocate ( res )
- allocate ( res ( maxeig ) )
- res = 0.0_8
- if ( allocated ( x ) ) deallocate ( x )
- allocate ( x ( lx ) )
- x = 0.0_8
-
-
-! set input variables
-! the matrix is already in the required format
-
- IPRINT = 0 ! standard report on standard output
- ISEARCH = 1 ! we want the smallest eigenvalues
- NEIG = maxeig ! number of wanted eigenvalues
- !NINIT = 0 ! no initial approximate eigenvectors
- NINIT = NEIG ! initial approximate eigenvectors
- MADSPACE = maxsp ! desired size of the search space
- ITER = 1000*NEIG ! maximum number of iteration steps
- TOL = CONTROL_instance%CI_CONVERGENCE !1.0d-4 ! tolerance for the eigenvector residual
-
- NDX1 = 0
- NDX2 = 0
- MEM = 0
-
-! additional parameters set to default
- ICNTL(1)=0
- ICNTL(2)=0
- ICNTL(3)=0
- ICNTL(4)=0
- ICNTL(5)=1
-
- IJOB=0
-
- JA(1) = -1
- IA(1) = -1
-
- ! set initial eigenpairs
- if ( CONTROL_instance%CI_LOAD_EIGENVECTOR ) then
- print *, "Loading the eigenvector to the initial guess"
- do j = 1, n
- X(j) = eigenVectors%values(j,1)
- end do
-
- do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- EIGS(i) = eigenValues%values(i)
- end do
- else
- jj = 0
- do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- jj = (i - 1) * n
- do j = 1, CONTROL_instance%CI_SIZE_OF_GUESS_MATRIX
- X(jj + ConfigurationInteraction_instance%auxIndexCIMatrix%values(j)) = ConfigurationInteraction_instance%initialEigenVectors%values(j,i)
- end do
- end do
-
- do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- EIGS(i) = ConfigurationInteraction_instance%initialEigenValues%values(i)
- end do
- end if
-
- DROPTOL = 0
-
- SIGMA = EIGS(1)
- gap = 0
- SHIFT = EIGS(1)
-
- do i = 1, CONTROL_instance%NUMBER_OF_CI_STATES
- write(6,"(T2,A5,I4,2X,A10,F20.10,2X,A11,F20.10)") "State", i, "Eigenvalue", eigs( i ), "Eigenvector", x((i-1)*n + i)
- end do
-
- iiter = 0
-
-!10 CALL DPJDREVCOM( N, A, JA, IA,EIGS, RES, X, LX, NEIG, &
-! SIGMA, ISEARCH, NINIT, MADSPACE, ITER, TOL, &
-! SHIFT, DROPTOL, MEM, ICNTL, &
-! IJOB, NDX1, NDX2, IPRINT, INFO, GAP)
-10 CALL DPJDREVCOM( N, ConfigurationInteraction_instance%diagonalHamiltonianMatrix%values , JA, IA, EIGS, RES, X, LX, NEIG, &
- SIGMA, ISEARCH, NINIT, MADSPACE, ITER, TOL, &
- SHIFT, DROPTOL, MEM, ICNTL, &
- IJOB, NDX1, NDX2, IPRINT, INFO, GAP)
- if (CONTROL_instance%CI_JACOBI ) then
- fullMatrix = .false.
- else
- fullMatrix = .true.
- end if
-!! your private matrix-vector multiplication
-
- iiter = iiter +1
- IF (IJOB.EQ.1) THEN
- if ( CONTROL_instance%CI_BUILD_FULL_MATRIX ) then
- call av ( n, x(ndx1), x(ndx2))
- else
- call matvec2 ( N, X(NDX1), X(NDX2), iiter)
- end if
-
- GOTO 10
- END IF
-
- !! saving the eigenvalues
- eigenValues%values = EIGS
-
- !! saving the eigenvectors
- k = 0
- do j = 1, maxeig
- do i = 1, N
- k = k + 1
- eigenVectors%values(i,j) = X(k)
- end do
- end do
-
-! release internal memory and discard preconditioner
- CALL PJDCLEANUP
- if ( allocated ( x ) ) deallocate ( x )
-
- end subroutine ConfigurationInteraction_jadamiluInterface
-
- subroutine matvec2 ( nx, v, w, iter)
-
- !*******************************************************************************
- !! AV computes w <- A * V where A is a discretized Laplacian.
- ! Parameters:
- ! Input, integer NX, the length of the vectors.
- ! Input, real V(NX), the vector to be operated on by A.
- ! Output, real W(NX), the result of A*V.
- !
- implicit none
-
- integer(8) nx
- real(8) v(nx)
- real(8) w(nx)
- real(8) :: CIEnergy
- integer(8) :: nonzero
- integer(8) :: i, j, ia, ib, ii, jj, iii, jjj
- integer(4) :: nproc, n, nn
- real(8) :: wi
- real(8) :: timeA, timeB
- real(8) :: tol
- integer(4) :: iter, size1, size2
- !integer(8), allocatable :: indexArray(:)
- logical :: fullMatrix
- integer :: ci
- integer :: auxSize
- integer(8) :: a,b,c
- integer :: s, numberOfSpecies, auxnumberOfSpecies
- integer(1) :: coupling
- integer(8) :: numberOfConfigurations
- integer(8), allocatable :: cc(:) !! ncore
- integer(8), allocatable :: indexConf(:,:) !! ncore, species
- integer(8), allocatable :: auxindexConf(:,:) !! ncore, species
- integer, allocatable :: cilevel(:,:), auxcilevel(:,:)
-
- call omp_set_num_threads(omp_get_max_threads())
- nproc = omp_get_max_threads()
-
-
- allocate( cc ( nproc ) )
- cc = 0
-
- nonzero = 0
- w = 0
- tol = CONTROL_instance%CI_MATVEC_TOLERANCE
-
- do i = 1 , nx
- if ( abs(v(i) ) >= tol) nonzero = nonzero + 1
- end do
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- allocate ( indexConf ( numberOfSpecies, nproc ) )
- allocate ( auxindexConf ( numberOfSpecies, nproc ) )
- allocate ( cilevel ( numberOfSpecies, nproc ) )
- allocate ( auxcilevel ( numberOfSpecies, nproc ) )
-
- cilevel = 0
- auxcilevel = 0
- indexConf = 0
- auxindexConf = 0
- !! call recursion
- s = 0
- c = 0
- n = 1
-!$ timeA = omp_get_wtime()
- do ci = 1, ConfigurationInteraction_instance%sizeCiOrderList
- do nn = n, nproc
- cilevel(:,nn) = ConfigurationInteraction_instance%ciOrderList( ConfigurationInteraction_instance%auxciOrderList(ci), :)
- end do
- s = 0
- auxnumberOfSpecies = ConfigurationInteraction_buildMatrixRecursion(nproc, s, indexConf, auxindexConf,cc, c, n, v, w, &
- cilevel, auxcilevel )
-
- end do
-
- if ( n > 1 ) then
- do nn = 1, n-1
-
- call ConfigurationInteraction_buildRow( nn, auxindexConf(:,nn), cc(nn), w, v(cc(nn)), auxcilevel(:,nn))
- end do
- end if
-
- ConfigurationInteraction_instance%pindexConf = 0
-
-!$ timeB = omp_get_wtime()
- deallocate ( cilevel )
- deallocate ( auxindexConf )
- deallocate ( indexConf )
- deallocate ( cc )
-!$ write(*,"(A,I2,A,E10.3,A2,I12)") " ", iter, " ", timeB -timeA ," ", nonzero
-! stop
-
-
- return
-
- end subroutine matvec2
-
-end module ConfigurationInteraction_
-
diff --git a/src/CalcProp/CalculateProperties.f90 b/src/CalcProp/CalculateProperties.f90
index 2994f1ba..bce2dbdd 100755
--- a/src/CalcProp/CalculateProperties.f90
+++ b/src/CalcProp/CalculateProperties.f90
@@ -91,7 +91,7 @@ module CalculateProperties_
CalculateProperties_getPopulation, &
CalculateProperties_showContributionsToElectrostaticMoment, &
CalculateProperties_getDipoleOfPuntualCharges, &
- CalculateProperties_getDipoleOfQuantumSpecie
+ CalculateProperties_getDipoleOfQuantumSpecies
! CalculateProperties_expectedR2, &
! CalculateProperties_polarizability, &
! CalculateProperties_showExpectedR2, &
@@ -146,10 +146,10 @@ subroutine CalculateProperties_constructor( this,fileName )
open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
do speciesID=1, numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions (speciesID )
- print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecie(speciesID)), &
+ print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecies(speciesID)), &
" in the CI ground state"
auxstring="1" !ground state
- arguments(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ arguments(2) = MolecularSystem_getNameOfSpecies(speciesID)
arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
this%densityMatrix(speciesID)= Matrix_getFromFile(unit=occupationsUnit, rows= int(numberOfcontractions,4), &
columns= int(numberOfcontractions,4), binary=.false., arguments=arguments(1:2))
@@ -159,9 +159,9 @@ subroutine CalculateProperties_constructor( this,fileName )
open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
do speciesID=1, numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions (speciesID )
- print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecie(speciesID)), &
+ print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecies(speciesID)), &
" in the HF/KS ground state"
- arguments(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ arguments(2) = MolecularSystem_getNameOfSpecies(speciesID)
arguments(1) = "DENSITY"
this%densityMatrix(speciesID) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
@@ -180,7 +180,7 @@ subroutine CalculateProperties_constructor( this,fileName )
do speciesID=1, numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions (speciesID )
! Overlap matrix
- arguments(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ arguments(2) = MolecularSystem_getNameOfSpecies(speciesID)
arguments(1) = "OVERLAP"
this%overlapMatrix(speciesID) = Matrix_getFromFile(unit=integralsUnit, rows= int(numberOfContractions,4), &
columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
@@ -294,7 +294,7 @@ subroutine CalculateProperties_showPopulationAnalyses(this)
do type= 1, size(analysis)
- speciesName = trim(MolecularSystem_getNameOfSpecie( speciesID ))
+ speciesName = trim(MolecularSystem_getNameOfSpecies( speciesID ))
if(trim(speciesName) .eq. "E-ALPHA") then
speciesNickname="E-"
@@ -366,7 +366,7 @@ subroutine CalculateProperties_showPopulationAnalyses(this)
! search_specie: do i = 1, MolecularSystem_getNumberOfQuantumSpecies()
! speciesName=""
- ! speciesName = trim(MolecularSystem_getNameOfSpecie(i))
+ ! speciesName = trim(MolecularSystem_getNameOfSpecies(i))
! if( scan(trim(speciesName),"E")==1 ) then
! if( scan(trim(speciesName),"-")>1 ) then
@@ -408,7 +408,7 @@ function CalculateProperties_getPopulation( this, typeOfPopulation, speciesID, t
call Matrix_constructor( auxMatrix, int( numberOfcontractions, 8), int( numberOfcontractions, 8) )
- speciesName=trim(MolecularSystem_getNameOfSpecie( speciesID ))
+ speciesName=trim(MolecularSystem_getNameOfSpecies( speciesID ))
if(trim(speciesName) .eq. "E-ALPHA") then
call Matrix_constructor( output, int( numberOfcontractions, 8), 2_8 )
otherSpeciesID=speciesID+1
@@ -485,7 +485,7 @@ subroutine CalculateProperties_showExpectedPositions(this)
print *,""
write (6,"(T19,4A9)") "","", "", ""
do i=1, numberOfSpecies
- write (6,"(T5,A15,3F9.4)") trim(MolecularSystem_getNameOfSpecie( i )), CalculateProperties_getExpectedPosition(this, i)
+ write (6,"(T5,A15,3F9.4)") trim(MolecularSystem_getNameOfSpecies( i )), CalculateProperties_getExpectedPosition(this, i)
end do
print *,""
print *,"END EXPECTED POSITIONS"
@@ -538,9 +538,9 @@ subroutine CalculateProperties_showContributionsToElectrostaticMoment(this)
write (6,"(T19,4A13)") "","", ""," |D|"
do i=1, numberOfSpecies
- dipole(i,:)=CalculateProperties_getDipoleOfQuantumSpecie(this, i)
+ dipole(i,:)=CalculateProperties_getDipoleOfQuantumSpecies(this, i)
totalDipole(:)=totalDipole(:)+dipole(i,:)
- write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecie( i )), dipole(i,:)
+ write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecies( i )), dipole(i,:)
end do
dipole(numberOfSpecies+1,:)=CalculateProperties_getDipoleOfPuntualCharges()
totalDipole(:)=totalDipole(:)+dipole(numberOfSpecies+1,:)
@@ -556,9 +556,9 @@ subroutine CalculateProperties_showContributionsToElectrostaticMoment(this)
totalDipole=0.0_8
do i=1, numberOfSpecies
- dipole(i,:)=CalculateProperties_getDipoleOfQuantumSpecie(this, i)*2.54174619
+ dipole(i,:)=CalculateProperties_getDipoleOfQuantumSpecies(this, i)*2.54174619
totalDipole(:)=totalDipole(:)+dipole(i,:)
- write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecie( i )), dipole(i,:)
+ write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecies( i )), dipole(i,:)
end do
dipole(numberOfSpecies+1,:)=CalculateProperties_getDipoleOfPuntualCharges()*2.54174619
@@ -577,9 +577,9 @@ subroutine CalculateProperties_showContributionsToElectrostaticMoment(this)
write (6,"(T19,6A13)") "","", "", "","",""
do i=1, numberOfSpecies
- quadrupole(i,:)=CalculateProperties_getQuadrupoleOfQuantumSpecie(this, i)*2.54174619*0.52917720859
+ quadrupole(i,:)=CalculateProperties_getQuadrupoleOfQuantumSpecies(this, i)*2.54174619*0.52917720859
totalQuadrupole(:)=totalQuadrupole(:)+quadrupole(i,:)
- write (6,"(T5,A15,6F14.8)") trim(MolecularSystem_getNameOfSpecie( i )), quadrupole(i,:)
+ write (6,"(T5,A15,6F14.8)") trim(MolecularSystem_getNameOfSpecies( i )), quadrupole(i,:)
end do
quadrupole(numberOfSpecies+1,:)=CalculateProperties_getQuadrupoleOfPuntualCharges()*2.54174619*0.52917720859
@@ -648,7 +648,7 @@ end function CalculateProperties_getQuadrupoleOfPuntualCharges
!<
!! @brief calcula el aporte al dipolo debido a particulas no fijas
!>
- function calculateproperties_getdipoleofquantumspecie( this, i ) result( output )
+ function CalculateProperties_getDipoleOfQuantumSpecies( this, i ) result( output )
implicit none
type(calculateproperties) :: this
integer :: i !specieid
@@ -660,13 +660,13 @@ function calculateproperties_getdipoleofquantumspecie( this, i ) result( output
output = output * molecularsystem_getcharge( i )
- end function calculateproperties_getdipoleofquantumspecie
+ end function CalculateProperties_getDipoleOfQuantumSpecies
!<
!! @brief calcula el aporte al dipolo debido a particulas no fijas
!>
- function calculateproperties_getquadrupoleofquantumspecie( this, i ) result( output )
+ function CalculateProperties_getQuadrupoleOfQuantumSpecies( this, i ) result( output )
implicit none
type(calculateproperties) :: this
integer :: i !specieid
@@ -681,7 +681,7 @@ function calculateproperties_getquadrupoleofquantumspecie( this, i ) result( out
output = output * molecularsystem_getcharge( i )
- end function calculateproperties_getquadrupoleofquantumspecie
+ end function CalculateProperties_getQuadrupoleOfQuantumSpecies
subroutine CalculateProperties_exception( typeMessage, description, debugDescription)
implicit none
@@ -755,7 +755,7 @@ end module CalculateProperties_
!
!
! do i=1, numberOfSpecies
-! nameOfSpecieSelected = trim( Particle_Manager_getNameOfSpecie( i ) )
+! nameOfSpecieSelected = trim( Particle_Manager_getNameOfSpecies( i ) )
! numberOfContractions = Particle_Manager_getTotalNumberOfContractions( i )
! call Matrix_constructor (densityMatrix, int(numberOfContractions,8), int(numberOfContractions,8))
! densityMatrix = MolecularSystem_getDensityMatrix( trim(nameOfSpecieSelected) )
@@ -796,7 +796,7 @@ end module CalculateProperties_
! print *,""
! write (6,"(T19,A9)") ""
! do i=1, numberOfSpecies
-! write (6,"(T5,A15,F9.4)") trim(Particle_Manager_getNameOfSpecie( i )), (this%expectedR2%values(i))
+! write (6,"(T5,A15,F9.4)") trim(Particle_Manager_getNameOfSpecies( i )), (this%expectedR2%values(i))
! end do
! print *,""
! print *,"END EXPECTED "
diff --git a/src/DFT/DFT.f90 b/src/DFT/DFT.f90
index 218a14bc..bb100e7b 100644
--- a/src/DFT/DFT.f90
+++ b/src/DFT/DFT.f90
@@ -28,6 +28,7 @@ program DFT
use MolecularSystem_
use DensityFunctionalTheory_
use GridManager_
+ use Functional_
use String_
use Matrix_
use Exception_
@@ -36,6 +37,7 @@ program DFT
character(50) :: job
character(100) :: densFile
+ type(Grid), allocatable :: grids(:), gridsCommonPoints(:,:)
type(Matrix), allocatable :: densityMatrix(:)
type(Matrix), allocatable :: exchangeCorrelationMatrix(:)
type(Matrix) :: exchangeCorrelationEnergy
@@ -62,21 +64,30 @@ program DFT
!!Load the system in lowdin.sys format
call MolecularSystem_loadFromFile( "LOWDIN.SYS" )
- call Functional_createFunctionals( )
+ numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+
+ !! Allocate memory.
+ if(allocated(grids)) deallocate(grids)
+ allocate(grids(numberOfSpecies))
+
+ if (allocated(gridsCommonPoints)) deallocate(gridsCommonPoints)
+ allocate(gridsCommonPoints(numberOfSpecies,numberOfSpecies))
+
+ do speciesID = 1 , numberOfSpecies
+ grids(speciesID)%molSys => MolecularSystem_instance
+ end do
!!!Building grids jobs
select case ( job )
case ("BUILD_SCF_GRID")
- call DensityFunctionalTheory_buildSCFGrid()
+ call DensityFunctionalTheory_buildSCFGrid(grids,gridsCommonPoints)
STOP
case ("BUILD_FINAL_GRID" )
- call DensityFunctionalTheory_buildFinalGrid()
+ call DensityFunctionalTheory_buildFinalGrid(grids,gridsCommonPoints)
STOP
end select
- !!!Computing energy and potential jobs
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
-
+ !!!Computing energy and potential jobs
allocate( densityMatrix(numberOfSpecies) , numberOfParticles(numberOfSpecies), &
exchangeCorrelationMatrix(numberOfSpecies))
@@ -99,7 +110,7 @@ program DFT
select case ( job )
case ("SCF_DFT")
- call DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
+ call DensityFunctionalTheory_SCFDFT(grids,gridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
case ("FINAL_DFT")
!read scf information for comparison
do speciesID = 1 , numberOfSpecies
@@ -124,7 +135,7 @@ program DFT
close(unit=excUnit)
end do
- call DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
+ call DensityFunctionalTheory_finalDFT(grids,gridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
! case default
! write(*,*) "USAGE: lowdin-DFT.x job "
! write(*,*) "Where job can be: "
diff --git a/src/DFT/DensityFunctionalTheory.f90 b/src/DFT/DensityFunctionalTheory.f90
index 97f0197b..70b05299 100644
--- a/src/DFT/DensityFunctionalTheory.f90
+++ b/src/DFT/DensityFunctionalTheory.f90
@@ -25,6 +25,7 @@ module DensityFunctionalTheory_
use CONTROL_
use MolecularSystem_
use GridManager_
+ use Functional_
use String_
use Exception_
use omp_lib
@@ -39,15 +40,28 @@ module DensityFunctionalTheory_
!! @brief Builds a grid for each species - Different sizes are possible, all points in memory
! Felix Moncada, 2017
! Roberto Flores-Moreno, 2009
- subroutine DensityFunctionalTheory_buildSCFGrid(exactExchangeFractions)
+ subroutine DensityFunctionalTheory_buildSCFGrid(scfGrids,scfGridsCommonPoints,exactExchangeFractions,system)
implicit none
+ type(Grid) :: scfGrids(:), scfGridsCommonPoints(:,:)
real(8), optional :: exactExchangeFractions(*)
- integer :: speciesID
+ type(MolecularSystem), optional, target :: system
+
+ type(Functional), allocatable :: Functionals(:,:)
+ type(MolecularSystem), pointer :: molSys
+ integer :: speciesID,numberOfSpecies
!!Start time
! call Stopwatch_constructor(lowdin_stopwatch)
! call Stopwatch_start(lowdin_stopwatch)
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(molSys)
+
if(CONTROL_instance%PRINT_LEVEL .gt. 0) then
print *, ""
print *, "--------------------------------------------------------------------------------------"
@@ -57,19 +71,22 @@ subroutine DensityFunctionalTheory_buildSCFGrid(exactExchangeFractions)
print *, ""
end if
- call GridManager_buildGrids( "INITIAL" )
- if(CONTROL_instance%GRID_STORAGE .ne. "DISK") call Functional_createFunctionals( )
- if(CONTROL_instance%PRINT_LEVEL .gt. 0) call Functional_show( )
+ call GridManager_buildGrids(scfGrids,scfGridsCommonPoints,"INITIAL",molSys )
+
+ allocate(Functionals(numberOfSpecies,numberOfSpecies))
+ call Functional_createFunctionals(Functionals,numberOfSpecies,molSys)
+
+ if(CONTROL_instance%PRINT_LEVEL .gt. 0) call Functional_show(Functionals)
if(CONTROL_instance%GRID_STORAGE .eq. "DISK") then
- call GridManager_writeGrids( "INITIAL" )
- call GridManager_atomicOrbitals( "WRITE","INITIAL" )
+ call GridManager_writeGrids(scfGrids,scfGridsCommonPoints,Functionals,"INITIAL")
+ call GridManager_atomicOrbitals(scfGrids,scfGridsCommonPoints,"WRITE","INITIAL" )
else
- call GridManager_atomicOrbitals( "COMPUTE","INITIAL" )
+ call GridManager_atomicOrbitals(scfGrids,scfGridsCommonPoints,"COMPUTE","INITIAL" )
end if
if(present(exactExchangeFractions)) then
- do speciesID=1, MolecularSystem_getNumberOfQuantumSpecies()
- exactExchangeFractions(speciesID)=Functional_getExchangeFraction(speciesID)
+ do speciesID=1, MolecularSystem_getNumberOfQuantumSpecies(molSys)
+ exactExchangeFractions(speciesID)=Functional_getExchangeFraction(Functionals,speciesID)
end do
end if
! call Stopwatch_stop(lowdin_stopwatch)
@@ -77,8 +94,23 @@ subroutine DensityFunctionalTheory_buildSCFGrid(exactExchangeFractions)
end subroutine DensityFunctionalTheory_buildSCFGrid
- subroutine DensityFunctionalTheory_buildFinalGrid()
+ subroutine DensityFunctionalTheory_buildFinalGrid(finalGrids,finalGridsCommonPoints,system)
implicit none
+ type(Grid) :: finalGrids(:), finalGridsCommonPoints(:,:)
+ type(MolecularSystem), optional, target :: system
+
+ type(Functional), allocatable :: Functionals(:,:)
+ type(MolecularSystem), pointer :: molSys
+ integer :: numberOfSpecies
+
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(molSys)
+
if(CONTROL_instance%PRINT_LEVEL .gt. 0) then
print *, ""
print *, "--------------------------------------------------------------------------------------"
@@ -87,24 +119,29 @@ subroutine DensityFunctionalTheory_buildFinalGrid()
print *, "Euler-Maclaurin radial grids - Lebedev angular grids"
print *, ""
end if
- call GridManager_buildGrids( "FINAL" )
- if(CONTROL_instance%GRID_STORAGE .ne. "DISK") call Functional_createFunctionals( )
+ call GridManager_buildGrids(finalGrids,finalGridsCommonPoints,"FINAL",molSys)
+
+ allocate(Functionals(numberOfSpecies,numberOfSpecies))
+ call Functional_createFunctionals(Functionals,numberOfSpecies,molSys)
+
if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then
- call GridManager_writeGrids( "FINAL" )
- call GridManager_atomicOrbitals( "WRITE","FINAL" )
+ call GridManager_writeGrids(finalGrids,finalGridsCommonPoints,Functionals,"FINAL" )
+ call GridManager_atomicOrbitals(finalGrids,finalGridsCommonPoints,"WRITE","FINAL" )
else
- call GridManager_atomicOrbitals( "COMPUTE","FINAL" )
+ call GridManager_atomicOrbitals(finalGrids,finalGridsCommonPoints,"COMPUTE","FINAL" )
end if
end subroutine DensityFunctionalTheory_buildFinalGrid
- subroutine DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
+ subroutine DensityFunctionalTheory_SCFDFT(scfGrids,scfGridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
implicit none
+ type(Grid) :: scfGrids(:), scfGridsCommonPoints(:,:)
type(Matrix), intent(in) :: densityMatrix(*) !IN
type(Matrix) :: exchangeCorrelationMatrix(*) !OUT
type(Matrix) :: exchangeCorrelationEnergy !OUT
real(8) :: numberOfParticles(*) !OUT
+ type(Functional), allocatable :: Functionals(:,:)
type(Matrix), allocatable :: overlapMatrix(:)
character(50) :: labels(2)
integer :: densUnit, excUnit
@@ -118,17 +155,19 @@ subroutine DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatr
real(8) :: sumCheck, auxEnergy, otherAuxEnergy, otherElectronAuxEnergy
real(8) :: time1, time2, time3
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies=size(scfGrids(:))
if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then
- call GridManager_readGrids( "INITIAL")
- call GridManager_atomicOrbitals( "READ", "INITIAL" )
+ call GridManager_readGrids(scfGrids,scfGridsCommonPoints,"INITIAL")
+ call GridManager_atomicOrbitals(scfGrids,scfGridsCommonPoints,"READ", "INITIAL" )
end if
!!Start time
! call Stopwatch_constructor(lowdin_stopwatch)
! call Stopwatch_start(lowdin_stopwatch)
+ allocate(Functionals(numberOfSpecies,numberOfSpecies))
+ call Functional_createFunctionals(Functionals,numberOfSpecies,scfGrids(1)%molSys)
- call DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,numberOfParticles)
+ call DensityFunctionalTheory_calculateDensityAndGradients(scfGrids,scfGridsCommonPoints,densityMatrix,numberOfParticles)
! call Stopwatch_stop(lowdin_stopwatch)
! write(*,"(A,F10.3,A4)") "** Calculating density and gradient:", lowdin_stopwatch%enlapsetTime ," (s)"
@@ -136,26 +175,28 @@ subroutine DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatr
! call Stopwatch_constructor(lowdin_stopwatch)
! call Stopwatch_start(lowdin_stopwatch)
- call DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEnergy)
+ call DensityFunctionalTheory_calculateEnergyDensity(scfGrids,scfGridsCommonPoints,Functionals,exchangeCorrelationEnergy)
!!In the final iteration we don't update the exchange correlation matrix to save time
do speciesID = 1 , numberOfSpecies
- numberOfContractions=MolecularSystem_getTotalNumberOfContractions( speciesID )
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions( speciesID, scfGrids(speciesID)%molSys )
call Matrix_constructor(exchangeCorrelationMatrix(speciesID), int(numberOfContractions,8), int(numberOfContractions,8), 0.0_8 )
- call GridManager_buildExchangeCorrelationMatrix(speciesID, exchangeCorrelationMatrix(speciesID))
+ call GridManager_buildExchangeCorrelationMatrix(scfGrids,scfGridsCommonPoints,speciesID, exchangeCorrelationMatrix(speciesID))
end do
! call Stopwatch_stop(lowdin_stopwatch)
! write(*,"(A,F10.3,A4)") "** Calculating energy and potential:", lowdin_stopwatch%enlapsetTime ," (s)"
end subroutine DensityFunctionalTheory_SCFDFT
- subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
+ subroutine DensityFunctionalTheory_finalDFT(finalGrids,finalGridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles)
implicit none
+ type(Grid) :: finalGrids(:), finalGridsCommonPoints(:,:)
type(Matrix) :: densityMatrix(*) !IN
type(Matrix) :: exchangeCorrelationMatrix(*) !OUT
type(Matrix) :: exchangeCorrelationEnergy !OUT
real(8) :: numberOfParticles(*) !OUT
+ type(Functional), allocatable :: Functionals(:,:)
type(Matrix), allocatable :: overlapMatrix(:)
character(100) :: excFile
character(50) :: labels(2)
@@ -170,12 +211,12 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa
real(8) :: sumCheck, auxEnergy, otherAuxEnergy, otherElectronAuxEnergy
real(8) :: time1, time2, time3
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies=size(finalGrids(:))
!print scf grid information for comparison
if(CONTROL_instance%PRINT_LEVEL .gt. 0 ) then
do speciesID = 1 , numberOfSpecies
- write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecie(speciesID))//" particles in the SCF grid: ", numberOfParticles(speciesID)
+ write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecies(speciesID, finalGrids(speciesID)%molSys))//" particles in the SCF grid: ", numberOfParticles(speciesID)
end do
print *, ""
write (*,"(A50, F15.8)") "Exchange-correlation energy with the SCF grid: ", sum(exchangeCorrelationEnergy%values)
@@ -183,11 +224,14 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa
end if
if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then
- call GridManager_readGrids( "FINAL" )
- call GridManager_atomicOrbitals( "READ", "FINAL" )
+ call GridManager_readGrids(finalGrids,finalGridsCommonPoints,"FINAL" )
+ call GridManager_atomicOrbitals(finalGrids,finalGridsCommonPoints,"READ", "FINAL" )
end if
- call DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,numberOfParticles)
+ allocate(Functionals(numberOfSpecies,numberOfSpecies))
+ call Functional_createFunctionals(Functionals,numberOfSpecies,finalGrids(1)%molSys)
+
+ call DensityFunctionalTheory_calculateDensityAndGradients(finalGrids,finalGridsCommonPoints,densityMatrix,numberOfParticles)
!!Start time
! call Stopwatch_constructor(lowdin_stopwatch)
@@ -205,35 +249,35 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa
! call Stopwatch_constructor(lowdin_stopwatch)
! call Stopwatch_start(lowdin_stopwatch)
- call DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEnergy)
+ call DensityFunctionalTheory_calculateEnergyDensity(finalGrids,finalGridsCommonPoints,Functionals,exchangeCorrelationEnergy)
!print scf grid information for comparison
if(CONTROL_instance%PRINT_LEVEL .gt. 0 ) then
do speciesID = 1 , numberOfSpecies
- write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecie(speciesID))//" particles in the final grid: ", numberOfParticles(speciesID)
+ write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecies(speciesID, finalGrids(speciesID)%molSys))//" particles in the final grid: ", numberOfParticles(speciesID)
end do
print *, ""
write (*,"(A50, F15.8)") "Exchange-correlation energy with the final grid: ", sum(exchangeCorrelationEnergy%values)
print *, ""
end if
do speciesID = 1 , numberOfSpecies-1
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=finalGrids(speciesID)%nameOfSpecies
do otherSpeciesID = speciesID+1 , numberOfSpecies
- nameOfOtherSpecies=MolecularSystem_getNameOfSpecie(otherSpeciesID)
+ nameOfOtherSpecies=finalGrids(otherSpeciesID)%nameOfSpecies
if ( nameOfSpecies .eq. "E-" ) then
! if ( nameOfSpecies .eq. "E-" .and. nameOfOtherSpecies .eq. "POSITRON" ) then
!Closed shell electron and other species terms
- call GridManager_getContactDensity( speciesID, otherSpeciesID )
+ call GridManager_getContactDensity(finalGrids,finalGridsCommonPoints,speciesID, otherSpeciesID )
elseif ( nameOfSpecies .eq. "E-ALPHA" ) then
! elseif ( nameOfSpecies .eq. "E-ALPHA" .and. nameOfOtherSpecies .eq. "POSITRON" ) then
!Open shell Electron and other species terms
- otherElectronID=MolecularSystem_getSpecieID("E-BETA")
+ otherElectronID=MolecularSystem_getSpecieID("E-BETA",finalGrids(speciesID)%molSys)
- call GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectronID )
+ call GridManager_getContactDensity(finalGrids,finalGridsCommonPoints,speciesID, otherSpeciesID, otherElectronID )
end if
@@ -255,15 +299,17 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa
end subroutine DensityFunctionalTheory_finalDFT
- subroutine DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,numberOfParticles)
+ subroutine DensityFunctionalTheory_calculateDensityAndGradients(Grid_instance,GridCommonPoints,densityMatrix,numberOfParticles)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridCommonPoints(:,:)
type(Matrix) :: densityMatrix(*) !IN
real(8) :: numberOfParticles(*) !OUT
integer :: numberOfSpecies
integer :: speciesID
integer :: i,dir
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies=size(Grid_instance(:))
do speciesID = 1 , numberOfSpecies
! Calculate density and gradients
@@ -276,7 +322,7 @@ subroutine DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,nu
call Vector_Constructor( Grid_instance(speciesID)%densityGradient(dir), Grid_instance(speciesID)%totalSize, 0.0_8)
end do
- call GridManager_getDensityGradientAtGrid( speciesID, densityMatrix(speciesID), Grid_instance(speciesID)%density, Grid_instance(speciesID)%densityGradient)
+ call GridManager_getDensityGradientAtGrid(Grid_instance,GridCommonPoints, speciesID, densityMatrix(speciesID), Grid_instance(speciesID)%density, Grid_instance(speciesID)%densityGradient)
! Check density and gradient in z
numberOfParticles(speciesID)=0.0_8
@@ -290,24 +336,27 @@ subroutine DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,nu
end subroutine DensityFunctionalTheory_calculateDensityAndGradients
- subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEnergy)
+ subroutine DensityFunctionalTheory_calculateEnergyDensity(Grid_instance,GridCommonPoints,Functionals,exchangeCorrelationEnergy)
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridCommonPoints(:,:)
+ type(Functional) :: Functionals(:,:)
type(Matrix) :: exchangeCorrelationEnergy !OUT
integer :: numberOfSpecies
integer :: speciesID, otherSpeciesID, otherElectronID
character(50) :: nameOfSpecies, nameOfOtherSpecies
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies=size(Grid_instance(:))
exchangeCorrelationEnergy%values(:,:)=0.0_8
! Calculate energy density and potential for one species
do speciesID = 1 , numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=Grid_instance(speciesID)%nameOfSpecies
if( nameOfSpecies .eq. "E-" ) then
- call GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID))
+ call GridManager_getElectronicEnergyAndPotentialAtGrid(Grid_instance,GridCommonPoints,Functionals, speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID))
elseif( nameOfSpecies .eq. "E-ALPHA" ) then !El potencial de BETA se calcula simultaneamente con ALPHA
- otherSpeciesID = MolecularSystem_getSpecieID( nameOfSpecie="E-BETA" )
- call GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID), &
+ otherSpeciesID = MolecularSystem_getSpecieID( "E-BETA", Grid_instance(speciesID)%molSys )
+ call GridManager_getElectronicEnergyAndPotentialAtGrid(Grid_instance,GridCommonPoints,Functionals, speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID), &
otherSpeciesID, exchangeCorrelationEnergy%values(otherSpeciesID,otherSpeciesID) )
elseif (nameOfSpecies .eq. "E-BETA") then
@@ -317,16 +366,16 @@ subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEne
!There aren't more same species functionals implemented so far
end if
- ! write (*,"(A50, F15.8)") trim(MolecularSystem_getNameOfSpecie(speciesID))//" Exchange-correlation contribution: ", exchangeCorrelationEnergy(speciesID,speciesID)
+ ! write (*,"(A50, F15.8)") trim(MolecularSystem_getNameOfSpecies(speciesID))//" Exchange-correlation contribution: ", exchangeCorrelationEnergy(speciesID,speciesID)
end do
! Calculate energy density and potential for two species
do speciesID = 1 , numberOfSpecies-1
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=Grid_instance(speciesID)%nameOfSpecies
do otherSpeciesID = speciesID+1 , numberOfSpecies
- nameOfOtherSpecies=MolecularSystem_getNameOfSpecie(otherSpeciesID)
+ nameOfOtherSpecies=Grid_instance(otherSpeciesID)%nameOfSpecies
if (nameOfSpecies .eq. "E-ALPHA" .and. nameOfSpecies .eq. "E-BETA") then
!Nada, todo se hace como si fuera una sola especie
@@ -337,7 +386,7 @@ subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEne
(nameOfOtherSpecies .ne. "E-" .and. nameOfOtherSpecies .ne. "E-ALPHA" .and. nameOfOtherSpecies .ne. "E-BETA") ) then
!Closed shell electron and other species terms
- call GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID) )
+ call GridManager_getInterspeciesEnergyAndPotentialAtGrid(Grid_instance, GridCommonPoints,Functionals, speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID) )
! write (*,"(A50, F15.8)") trim(nameOfSpecies)//"/"//trim(nameOfOtherSpecies)//" Correlation contribution: ", exchangeCorrelationEnergy(speciesID,otherSpeciesID)
@@ -345,9 +394,9 @@ subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEne
elseif ( nameOfSpecies .eq. "E-ALPHA" .and. &
(nameOfOtherSpecies .ne. "E-" .and. nameOfOtherSpecies .ne. "E-ALPHA" .and. nameOfOtherSpecies .ne. "E-BETA") ) then
- otherElectronID=MolecularSystem_getSpecieID("E-BETA")
+ otherElectronID=MolecularSystem_getSpecieID("E-BETA",Grid_instance(speciesID)%molSys)
- call GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID), &
+ call GridManager_getInterspeciesEnergyAndPotentialAtGrid(Grid_instance, GridCommonPoints,Functionals, speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID), &
otherElectronID, exchangeCorrelationEnergy%values(otherElectronID,otherSpeciesID) )
! write (*,"(A50, F15.8)") trim(nameOfSpecies)//"/"//trim(nameOfOtherSpecies)//" Correlation contribution: ", exchangeCorrelationEnergy(speciesID,otherSpeciesID)
diff --git a/src/DFT/Functional.f90 b/src/DFT/Functional.f90
index 8b5c7b16..2baec6cc 100644
--- a/src/DFT/Functional.f90
+++ b/src/DFT/Functional.f90
@@ -39,13 +39,10 @@ module Functional_
TYPE(xc_f03_func_info_t) :: info2
end type Functional
- type(Functional), public, allocatable :: Functionals(:)
-
public :: &
Functional_createFunctionals, &
Functional_constructor, &
Functional_show, &
- Functional_getIndex, &
Functional_getExchangeFraction, &
Functional_libxcEvaluate, &
Functional_LDAEvaluate, &
@@ -84,48 +81,45 @@ module Functional_
contains
- subroutine Functional_createFunctionals()
+ subroutine Functional_createFunctionals(these,numberOfSpecies,molSys)
implicit none
-
+ type(Functional) :: these(:,:)
integer :: numberOfSpecies
- integer :: speciesID, otherSpeciesID, i
+ type(MolecularSystem) :: molSys
+
+ integer :: speciesID, otherSpeciesID
character(50) :: labels(2), dftFile
integer :: dftUnit
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- if(.not.allocated(Functionals) )allocate(Functionals(numberOfSpecies+numberOfSpecies*(numberOfSpecies-1)/2))
- i=1
do speciesID=1, numberOfSpecies
- call Functional_constructor(Functionals(i), speciesID, speciesID)
- i=i+1
+ call Functional_constructor(these(speciesID,speciesID), speciesID, speciesID, molSys)
end do
do speciesID=1, numberOfSpecies-1
do otherSpeciesID=speciesID+1, numberOfSpecies
- call Functional_constructor(Functionals(i), speciesID, otherSpeciesID)
- i=i+1
+ call Functional_constructor(these(speciesID,otherSpeciesID), speciesID, otherSpeciesID, molSys)
end do
end do
end subroutine Functional_createFunctionals
- subroutine Functional_constructor(this, speciesID, otherSpeciesID)
+ subroutine Functional_constructor(this, speciesID, otherSpeciesID, molSys)
implicit none
type(Functional) :: this
integer :: speciesID
integer :: otherSpeciesID
character(50) :: auxstring
+ type(MolecularSystem) :: molSys
this%name="NONE"
this%correlationName="NONE"
this%exchangeName="NONE"
- this%species1=MolecularSystem_getNameOfSpecie(speciesID)
- this%species2=MolecularSystem_getNameOfSpecie(otherSpeciesID)
+ this%species1=MolecularSystem_getNameOfSpecies(speciesID,molSys)
+ this%species2=MolecularSystem_getNameOfSpecies(otherSpeciesID,molSys)
this%exactExchangeFraction=1.0_8
- this%mass1=MolecularSystem_getMass(speciesID)
- this%mass2=MolecularSystem_getMass(otherSpeciesID)
+ this%mass1=MolecularSystem_getMass(speciesID,molSys)
+ this%mass2=MolecularSystem_getMass(otherSpeciesID,molSys)
if((this%species1 == "E-" .and. this%species2 == "E-") .or. &
@@ -307,12 +301,13 @@ subroutine Functional_constructor(this, speciesID, otherSpeciesID)
end subroutine Functional_constructor
- subroutine Functional_show()
+ subroutine Functional_show(these)
implicit none
- type(Functional) :: this
- integer :: i
+ type(Functional) :: these(:,:)
+ type(Functional) :: this
+ integer :: i,j
real(8) :: p,qe,qn,qen,q2en,q3en,Eab,Ea2b,Eab2,a0,q0,q2,q4
-
+
if( CONTROL_instance%CALL_LIBXC) then
print *, "--------------------------------------------------------------------------------------"
print *, "LIBXC library, Fermann, Miguel A. L. Marques, Micael J. T. Oliveira, and Tobias Burnus"
@@ -325,127 +320,129 @@ subroutine Functional_show()
print *, "--------------------------------------------------------------------------------------"
print *, ""
- do i=1, size(Functionals)
- this=Functionals(i)
+ do i=1, size(these(:,:),DIM=1)
+ do j=i, size(these(:,:),DIM=2)
+ this=these(i,j)
- if ((this%species1 == "E-" .and. this%species2 == "E-") .or. &
- (this%species1 == "E-ALPHA" .and. this%species2 == "E-ALPHA") .or. &
- (this%species1 == "E-ALPHA" .and. this%species2 == "E-BETA") .or. &
- (this%species1 == "E-BETA" .and. this%species2 == "E-BETA") .or. &
- (this%species1 == "E-BETA" .and. this%species2 == "E-ALPHA") ) then
+ if ((this%species1 == "E-" .and. this%species2 == "E-") .or. &
+ (this%species1 == "E-ALPHA" .and. this%species2 == "E-ALPHA") .or. &
+ (this%species1 == "E-ALPHA" .and. this%species2 == "E-BETA") .or. &
+ (this%species1 == "E-BETA" .and. this%species2 == "E-BETA") .or. &
+ (this%species1 == "E-BETA" .and. this%species2 == "E-ALPHA") ) then
- if( CONTROL_instance%CALL_LIBXC) then
+ if( CONTROL_instance%CALL_LIBXC) then
- if( this%correlationName .ne. "NONE" ) then
+ if( this%correlationName .ne. "NONE" ) then
- write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","exchange:", xc_f03_func_info_get_name(this%info1)
- ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell
+ write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","exchange:", xc_f03_func_info_get_name(this%info1)
+ ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell
- write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","correlation:", xc_f03_func_info_get_name(this%info2)
- ! print *, "family", xc_f03_func_info_get_family(this%info2), "shell", this%shell
+ write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","correlation:", xc_f03_func_info_get_name(this%info2)
+ ! print *, "family", xc_f03_func_info_get_family(this%info2), "shell", this%shell
- else
+ else
- write(*, "(T5,A10,A10,A5,A21,A)") trim(this%species1), trim(this%species2), "", "exchange-correlation:", xc_f03_func_info_get_name(this%info1)
+ write(*, "(T5,A10,A10,A5,A21,A)") trim(this%species1), trim(this%species2), "", "exchange-correlation:", xc_f03_func_info_get_name(this%info1)
- ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell
+ ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell
- end if
+ end if
- else
- write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name
-
- end if
- else
- write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name
-
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3") print *, "Using as correlation length: beta=q*rhoE^(1/3)"
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE6RHON6") print *, "Using as correlation length: beta=q*rhoE^(1/6)*rhoN^(1/6)"
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON") print *, "Using as correlation length: beta=1/(q*rhoE^(-1/3)+r*rhoN^(-1))"
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3AS") print *, "Using as correlation length: beta=qe*rhoE^(1/3)+qn*rhoN^(1/3)"
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3RHOEN6") print *, "Using as correlation length: beta=q*rhoE^(1/3)+p*rhoN^(1/3)+r*rhoE^(1/6)*rhoN^(1/6)"
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") print *, "beta=(qe*rhoE(i)+qn*rhoN(i)+q2en*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3en*(rhoE(i)-rhoN(i))**3/(rhoE(i)+rhoN(i))**2)**(1.0/3.0)"
-
- if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") print *, "beta=(q0*(rhoE(i)+rhoN(i))+q2*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3*(rhoE(i)-rhoN(i))**4/(rhoE(i)+rhoN(i))**3)**(1.0/3.0)"
-
- if(CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") then
-
- if(this%mass2 .gt. 2.0) then !hydrogen
- print *, "electron-hydrogen correlation parameters"
- a0=4.5839773752240566113
- Ea2b=0.527444
- Eab2=0.597139
- else !positron
- print *, "electron-positron correlation parameters"
- a0=2.2919886876120283056
- Ea2b=0.262005
- Eab2=0.262005
- end if
-
- p=1.0
-
- if(CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) then
- Ea2b=CONTROL_instance%DUMMY_REAL(1)
- Eab2=CONTROL_instance%DUMMY_REAL(2)
- p=CONTROL_instance%DUMMY_REAL(3)
- end if
-
- print *, "Ea2b=", Ea2b
- print *, "Eab2=", Eab2
- qe=a0*(11.0/8.0/Ea2b-3.0/4.0/Eab2)
- qn=a0*(11.0/8.0/Eab2-3.0/4.0/Ea2b)
- q2en=a0*3.0/16.0*(1.0/Ea2b+1.0/Eab2)
- q3en=a0*9.0/16.0*(1.0/Eab2-1.0/Ea2b)
- print *, "qe=", qe
- print *, "qn=", qn
- print *, "q2en=", q2en
- print *, "q3en=", q3en
-
- print *, "p", CONTROL_instance%DUMMY_REAL(3)
-
- else if(CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") then
-
- if(this%mass2 .gt. 2.0) then !hydrogen
- STOP "this beta function only works for electron-positron"
- else !positron
- a0=2.2919886876120283056
- Eab=0.25
- Eab2=0.2620050702329801
- end if
-
-
- if (this%name .eq. "correlation:EXPCS-GGA-NOA") a0=4.5839773752240566113
-
- p=1.0
+ else
+ write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name
- if(CONTROL_instance%BETA_PARAMETER_A .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_B .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_C .ne. 0) then
- Eab=CONTROL_instance%BETA_PARAMETER_A
- Eab2=CONTROL_instance%BETA_PARAMETER_B
- p=CONTROL_instance%BETA_PARAMETER_C
end if
-
- print *, "Eab=", Eab
- print *, "Eab2=", Eab2
- q0=a0/2/Eab
- q2=a0*(-5/Eab+53/Eab2/8)
- q4=a0*(9/Eab/2-45/Eab2/8)
- print *, "q0=", q0
- print *, "q2=", q2
- print *, "q4=", q4
-
- print *, "p", CONTROL_instance%DUMMY_REAL(3)
+ else
+ write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3") print *, "Using as correlation length: beta=q*rhoE^(1/3)"
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE6RHON6") print *, "Using as correlation length: beta=q*rhoE^(1/6)*rhoN^(1/6)"
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON") print *, "Using as correlation length: beta=1/(q*rhoE^(-1/3)+r*rhoN^(-1))"
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3AS") print *, "Using as correlation length: beta=qe*rhoE^(1/3)+qn*rhoN^(1/3)"
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3RHOEN6") print *, "Using as correlation length: beta=q*rhoE^(1/3)+p*rhoN^(1/3)+r*rhoE^(1/6)*rhoN^(1/6)"
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") print *, "beta=(qe*rhoE(i)+qn*rhoN(i)+q2en*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3en*(rhoE(i)-rhoN(i))**3/(rhoE(i)+rhoN(i))**2)**(1.0/3.0)"
+
+ if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") print *, "beta=(q0*(rhoE(i)+rhoN(i))+q2*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3*(rhoE(i)-rhoN(i))**4/(rhoE(i)+rhoN(i))**3)**(1.0/3.0)"
+
+ if(CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") then
+
+ if(this%mass2 .gt. 2.0) then !hydrogen
+ print *, "electron-hydrogen correlation parameters"
+ a0=4.5839773752240566113
+ Ea2b=0.527444
+ Eab2=0.597139
+ else !positron
+ print *, "electron-positron correlation parameters"
+ a0=2.2919886876120283056
+ Ea2b=0.262005
+ Eab2=0.262005
+ end if
+
+ p=1.0
+
+ if(CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) then
+ Ea2b=CONTROL_instance%DUMMY_REAL(1)
+ Eab2=CONTROL_instance%DUMMY_REAL(2)
+ p=CONTROL_instance%DUMMY_REAL(3)
+ end if
+
+ print *, "Ea2b=", Ea2b
+ print *, "Eab2=", Eab2
+ qe=a0*(11.0/8.0/Ea2b-3.0/4.0/Eab2)
+ qn=a0*(11.0/8.0/Eab2-3.0/4.0/Ea2b)
+ q2en=a0*3.0/16.0*(1.0/Ea2b+1.0/Eab2)
+ q3en=a0*9.0/16.0*(1.0/Eab2-1.0/Ea2b)
+ print *, "qe=", qe
+ print *, "qn=", qn
+ print *, "q2en=", q2en
+ print *, "q3en=", q3en
+
+ print *, "p", CONTROL_instance%DUMMY_REAL(3)
+
+ else if(CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") then
+
+ if(this%mass2 .gt. 2.0) then !hydrogen
+ STOP "this beta function only works for electron-positron"
+ else !positron
+ a0=2.2919886876120283056
+ Eab=0.25
+ Eab2=0.2620050702329801
+ end if
+
+
+ if (this%name .eq. "correlation:EXPCS-GGA-NOA") a0=4.5839773752240566113
+
+ p=1.0
+
+ if(CONTROL_instance%BETA_PARAMETER_A .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_B .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_C .ne. 0) then
+ Eab=CONTROL_instance%BETA_PARAMETER_A
+ Eab2=CONTROL_instance%BETA_PARAMETER_B
+ p=CONTROL_instance%BETA_PARAMETER_C
+ end if
+
+ print *, "Eab=", Eab
+ print *, "Eab2=", Eab2
+ q0=a0/2/Eab
+ q2=a0*(-5/Eab+53/Eab2/8)
+ q4=a0*(9/Eab/2-45/Eab2/8)
+ print *, "q0=", q0
+ print *, "q2=", q2
+ print *, "q4=", q4
+
+ print *, "p", CONTROL_instance%DUMMY_REAL(3)
+
+
+ else
+ if(this%name .ne. "NONE" .and. (CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) ) then
+ print *, "q", CONTROL_instance%DUMMY_REAL(1)
+ print *, "p", CONTROL_instance%DUMMY_REAL(2)
+ print *, "r", CONTROL_instance%DUMMY_REAL(3)
+ end if
- else
- if(this%name .ne. "NONE" .and. (CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) ) then
- print *, "q", CONTROL_instance%DUMMY_REAL(1)
- print *, "p", CONTROL_instance%DUMMY_REAL(2)
- print *, "r", CONTROL_instance%DUMMY_REAL(3)
end if
end if
-
- end if
+ end do
end do
print *, ""
@@ -453,39 +450,14 @@ subroutine Functional_show()
end subroutine Functional_show
- function Functional_getIndex(speciesID, otherSpeciesID) result( output)
- implicit none
- integer :: speciesID
- integer, optional :: otherSpeciesID
- integer :: output
- character(50) :: nameOfSpecies, otherNameOfSpecies
- integer i
-
- nameOfSpecies = MolecularSystem_getNameOfSpecie( speciesID )
- if( present(otherSpeciesID) ) then
- otherNameOfSpecies = MolecularSystem_getNameOfSpecie( otherSpeciesID )
- else
- otherNameOfSpecies = nameOfSpecies
- end if
-
- do i=1, size(Functionals(:))
- if (Functionals(i)%species1 == nameOfSpecies .and. Functionals(i)%species2 == otherNameOfSpecies) then
- output=i
- return
- end if
- end do
-
- end function Functional_getIndex
-
- function Functional_getExchangeFraction(speciesID) result( output)
+ function Functional_getExchangeFraction(these,speciesID) result( output)
implicit none
+ type(Functional) :: these(:,:)
integer :: speciesID
real(8) :: output
integer :: index
- index=Functional_getIndex(speciesID)
-
- output=Functionals(index)%exactExchangeFraction
+ output=these(speciesID,speciesID)%exactExchangeFraction
end function Functional_getExchangeFraction
@@ -567,7 +539,7 @@ subroutine Functional_EPCEvaluate( this, mass, n, rhoE, rhoN, ec, vcE, vcN )
real(8) :: ec(*) !! Energy density - output
real(8) :: vcE(*), vcN(*) !! Potentials - output
- real(8) :: a,b,c, q
+ real(8) :: a,b,c, prodRho
real(8) :: denominator, densityThreshold
real(8) :: v_exchange(n),va_correlation(n),vb_correlation(n)
integer :: i
@@ -588,35 +560,27 @@ subroutine Functional_EPCEvaluate( this, mass, n, rhoE, rhoN, ec, vcE, vcN )
STOP "The nuclear electron functional chosen is not implemented"
end if
- !$omp parallel private(denominator)
+ ec(1:n)=0.0
+ vcE(1:n)=0.0
+ vcN(1:n)=0.0
+
+ ! print *, "i, rhoE, rhoN, denominator, energy density, potentialE, potentialN"
+ !$omp parallel private(denominator,prodRho)
!$omp do schedule (dynamic)
do i = 1, n
-
- denominator=a-b*sqrt(rhoE(i)*rhoN(i))+c*rhoE(i)*rhoN(i)
-
+ if( rhoE(i)+rhoN(i) .lt. densityThreshold ) cycle
+ prodRho=rhoE(i)*rhoN(i)
+ denominator=a-b*sqrt(prodRho)+c*prodRho
!!!Energy density
- ! ec(i)= -rhoE(1:n)*rhoN(1:n)/denominator(1:n)
ec(i)= -rhoN(i)/denominator
-
!!!Potential
-
- if( rhoE(i)+rhoN(i) .gt. densityThreshold ) then !
- vcE(i)= (rhoE(i)*rhoN(i)*(c*rhoN(i)-b*rhoN(i)/(2*sqrt(rhoE(i)*rhoN(i))))-rhoN(i)*denominator)/denominator**2
- vcN(i)= (rhoN(i)*rhoE(i)*(c*rhoE(i)-b*rhoE(i)/(2*sqrt(rhoE(i)*rhoN(i))))-rhoE(i)*denominator)/denominator**2
- else
- vcE(i)=0.0
- vcN(i)=0.0
- end if
-
+ vcE(i)= rhoN(i)*(prodRho*c-sqrt(prodRho)*b/2.0-denominator)/denominator**2
+ vcN(i)= rhoE(i)*(prodRho*c-sqrt(prodRho)*b/2.0-denominator)/denominator**2
+ ! write(*,"(I0.1,5ES16.6)") i, rhoE(i), rhoN(i), ec(i), vcE(i), vcN(i)
end do
!$omp end do
!$omp end parallel
- ! print *, "i, rhoE, rhoN, denominator, energy density, potentialE, potentialN"
- ! do i = 1, n
- ! write(*,"(I0.1,5F16.6)") i, rhoE(i), rhoN(i), ec(i), vcE(i), vcN(i)
- ! end do
-
end subroutine Functional_EPCEvaluate
subroutine Functional_IKNEvaluate( this, mass, n, rhoE, rhoN, ec, vcE, vcN )
diff --git a/src/DFT/Grid.f90 b/src/DFT/Grid.f90
index b0f70bd5..b2226307 100644
--- a/src/DFT/Grid.f90
+++ b/src/DFT/Grid.f90
@@ -28,6 +28,8 @@ module Grid_
type, public :: Grid
+ type(MolecularSystem), pointer :: molSys
+
character(30) :: nameOfSpecies
integer :: totalSize
type(Matrix) :: points !! x,y,z,weight
@@ -39,9 +41,6 @@ module Grid_
end type Grid
- type(Grid), public, allocatable :: Grid_instance(:)
- type(Grid), public, allocatable :: GridsCommonPoints(:,:)
-
public :: &
Grid_constructor, &
Grid_buildAtomic, &
@@ -56,11 +55,12 @@ module Grid_
!! @brief Builds a grid for each species - Different sizes are possible, all points in memory
! Felix Moncada, 2017
! Roberto Flores-Moreno, 2009
- subroutine Grid_constructor( this, speciesID, type )
+ subroutine Grid_constructor( this, speciesID, type, molSys )
implicit none
type(Grid) :: this
integer :: speciesID
character(*) :: type
+ type(MolecularSystem), target :: molSys
type(Matrix) :: atomicGrid, molecularGrid
integer :: numberOfSpecies, numberOfCenters
@@ -70,7 +70,9 @@ subroutine Grid_constructor( this, speciesID, type )
real(8), allocatable :: origins(:,:), distance(:),factor(:)
integer, allocatable :: atomicGridSize(:)
- this%nameOfSpecies=trim(MolecularSystem_getNameOfSpecie(speciesID))
+ this%molSys=>molSys
+
+ this%nameOfSpecies=trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys))
if (trim(type) .eq. "INITIAL") then
radialSize=CONTROL_instance%GRID_RADIAL_POINTS
@@ -87,7 +89,7 @@ subroutine Grid_constructor( this, speciesID, type )
if(CONTROL_instance%PRINT_LEVEL .gt. 0) &
write (*,"(A,I4,A,I2,A,A)") " Building an atomic grid with", radialSize, " radial points in ", numberOfShells, " shells for ", trim(this%nameOfSpecies)
- numberOfCenters=size(MolecularSystem_instance%species(speciesID)%particles)
+ numberOfCenters=size(this%molSys%species(speciesID)%particles)
allocate(origins(numberOfCenters,3), atomicGridSize(numberOfCenters))
!Get Atomic Grid
@@ -98,7 +100,7 @@ subroutine Grid_constructor( this, speciesID, type )
!We are screening the points with delocalized orbital values lower than 1E-6
molecularGridSize=0
do particleID = 1, numberOfCenters
- call Grid_radialCutoff( atomicGrid, initialGridSize, speciesID, particleID, atomicGridSize(particleID))
+ call Grid_radialCutoff( atomicGrid, initialGridSize, speciesID, particleID, atomicGridSize(particleID), this%molSys)
molecularGridSize=molecularGridSize + atomicGridSize(particleID)
end do
@@ -106,7 +108,7 @@ subroutine Grid_constructor( this, speciesID, type )
i=1
do particleID = 1, numberOfCenters
- origins(particleID,1:3) = MolecularSystem_instance%species(speciesID)%particles(particleID)%origin(1:3)
+ origins(particleID,1:3) = this%molSys%species(speciesID)%particles(particleID)%origin(1:3)
do point = 1, atomicGridSize(particleID)
molecularGrid%values(i,1)=atomicGrid%values(point,1)+origins(particleID,1)
molecularGrid%values(i,2)=atomicGrid%values(point,2)+origins(particleID,2)
@@ -115,7 +117,7 @@ subroutine Grid_constructor( this, speciesID, type )
i=i+1
end do
end do
-
+
! call Matrix_show(molecularGrid)
!Calculate adecuate weights with Becke's
@@ -170,7 +172,7 @@ subroutine Grid_constructor( this, speciesID, type )
if(CONTROL_instance%PRINT_LEVEL .gt. 0) then
write(*,"(A,ES9.3,A,ES9.3,A)") "Screening delocalized orbital(<", CONTROL_instance%ELECTRON_DENSITY_THRESHOLD,&
") and low weight(<",CONTROL_instance%GRID_WEIGHT_THRESHOLD,") points ..."
- print *, "Final molecular grid size for: ", trim(this%nameOfSpecies), Grid_instance(speciesID)%totalSize ," points"
+ print *, "Final molecular grid size for: ", trim(this%nameOfSpecies), this%totalSize ," points"
print *, " "
end if
@@ -200,13 +202,14 @@ subroutine Grid_exception( typeMessage, description, debugDescription)
end subroutine Grid_exception
- subroutine Grid_radialCutoff(atomicGrid, gridSize, speciesID, particleID, relevantPoints)
+ subroutine Grid_radialCutoff(atomicGrid, gridSize, speciesID, particleID, relevantPoints, molSys)
! Gets the radial point where basis sets take negligible values
! Felix Moncada, 2017
implicit none
type(matrix) :: atomicGrid
- integer :: gridSize, speciesID, particleID
+ integer :: gridSize, speciesID, particleID
integer :: relevantPoints !output
+ type(molecularSystem) :: molSys
integer :: numberOfContractions
integer :: numberOfPrimitives
@@ -216,12 +219,12 @@ subroutine Grid_radialCutoff(atomicGrid, gridSize, speciesID, particleID, releva
! Search for the lowest exponent in the atomic basis set
minExp=1E12
- numberOfContractions = size(MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction)
+ numberOfContractions = size(molSys%species(speciesID)%particles(particleID)%basis%contraction)
do mu = 1, numberOfContractions
- numberOfPrimitives = size(MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents)
+ numberOfPrimitives = size(molSys%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents)
do i = 1, numberOfPrimitives
- if (MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i) .lt. minExp) then
- minExp=MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i)
+ if (molSys%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i) .lt. minExp) then
+ minExp=molSys%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i)
end if
end do
end do
diff --git a/src/DFT/GridManager.f90 b/src/DFT/GridManager.f90
index 16f8c530..007ff91f 100644
--- a/src/DFT/GridManager.f90
+++ b/src/DFT/GridManager.f90
@@ -50,26 +50,25 @@ module GridManager_
!! @brief Builds a grid for each species - Different sizes are possible, all points in memory
! Felix Moncada, 2017
! Roberto Flores-Moreno, 2009
- subroutine GridManager_buildGrids( type )
+ subroutine GridManager_buildGrids(Grid_instance, GridsCommonPoints, type, molSys )
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
character(*) :: type
+ type(MolecularSystem), target :: molSys
+
integer :: numberOfSpecies
integer :: speciesID,otherSpeciesID
character(50) :: labels(2)
character(100) :: dftFile
integer :: dftUnit
-
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- !! Allocate memory.
- if (.not. allocated(Grid_instance)) allocate(Grid_instance(numberOfSpecies))
- if (.not. allocated(GridsCommonPoints)) allocate(GridsCommonPoints(numberOfSpecies,numberOfSpecies))
+ numberOfSpecies = size(Grid_instance(:))
!! Build and write species grids
do speciesID = 1, numberOfSpecies
- call Grid_constructor(Grid_instance(speciesID), speciesID , type )
+ call Grid_constructor(Grid_instance(speciesID), speciesID , type, molSys)
end do
@@ -87,8 +86,11 @@ end subroutine GridManager_buildGrids
!! @brief Writes a grid for each species - Different sizes are possible, all points in memory
! Felix Moncada, 2017
! Roberto Flores-Moreno, 2009
- subroutine GridManager_writeGrids( type )
+ subroutine GridManager_writeGrids(Grid_instance, GridsCommonPoints, Functionals, type )
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
+ type(Functional) :: Functionals(:,:)
character(*) :: type
integer :: numberOfSpecies
integer :: speciesID,otherSpeciesID
@@ -96,7 +98,7 @@ subroutine GridManager_writeGrids( type )
character(100) :: dftFile
integer :: dftUnit
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies = size(Grid_instance(:))
!! Build and write species grids
do speciesID = 1, numberOfSpecies
@@ -121,7 +123,7 @@ subroutine GridManager_writeGrids( type )
!! This goes here for convenience only
labels(1) = "EXACT-EXCHANGE-FRACTION"
- call Vector_writeToFile(unit=dftUnit, binary=.true., value=Functional_getExchangeFraction(speciesID), arguments= labels )
+ call Vector_writeToFile(unit=dftUnit, binary=.true., value=Functional_getExchangeFraction(Functionals,speciesID), arguments= labels )
labels(1) = "INTEGRATION-GRID"
call Matrix_writeToFile(Grid_instance(speciesID)%points, unit=dftUnit, binary=.true., arguments = labels(1:2) )
@@ -166,8 +168,10 @@ end subroutine GridManager_writeGrids
!! @brief Reads a grid for each species - Different sizes are possible, all points in memory
! Felix Moncada, 2017
! Roberto Flores-Moreno, 2009
- subroutine GridManager_readGrids( type )
+ subroutine GridManager_readGrids(Grid_instance, GridsCommonPoints, type )
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
character(*) :: type
integer :: numberOfSpecies
integer :: speciesID,otherSpeciesID
@@ -176,16 +180,12 @@ subroutine GridManager_readGrids( type )
integer :: dftUnit
real(8) :: auxVal
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
-
- !! Allocate memory.
- if (.not. allocated(Grid_instance)) allocate(Grid_instance(numberOfSpecies))
- if (.not. allocated(GridsCommonPoints)) allocate(GridsCommonPoints(numberOfSpecies,numberOfSpecies))
+ numberOfSpecies = size(Grid_instance(:))
!! Build and write species grids
do speciesID = 1, numberOfSpecies
- Grid_instance(speciesID)%nameOfSpecies=trim(MolecularSystem_getNameOfSpecie(speciesID))
+ Grid_instance(speciesID)%nameOfSpecies=trim(MolecularSystem_getNameOfSpecies(speciesID,Grid_instance(speciesID)%molSys))
!! Open file for dft
dftUnit = 77
if( trim(type) .eq. "INITIAL" ) then
@@ -250,8 +250,10 @@ end subroutine GridManager_readGrids
!! @brief Writes the values of all the atomic orbitals and their gradients in a set of coordinates to a file
!!! Felix Moncada, 2017
!<
- subroutine GridManager_atomicOrbitals( action, type )
+ subroutine GridManager_atomicOrbitals(Grid_instance, GridsCommonPoints, action, type )
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
character(*) action !read, compute or write
character(*) type
@@ -259,7 +261,7 @@ subroutine GridManager_atomicOrbitals( action, type )
integer :: totalNumberOfContractions
integer :: speciesID
integer :: gridSize
- integer :: mu,nu, point, index
+ integer :: mu,nu, point
character(50) :: labels(2)
character(100) :: orbsFile
@@ -269,11 +271,12 @@ subroutine GridManager_atomicOrbitals( action, type )
integer :: i, j, k, g, u
integer :: numberOfCartesiansOrbitals
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies = size(Grid_instance(:))
do speciesID = 1 , numberOfSpecies
gridSize = Grid_instance(speciesID)%totalSize
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID )
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,Grid_instance(speciesID)%molSys)
+
orbsUnit = 78
if( trim(type) .eq. "INITIAL" ) then
write( orbsFile, "(A,I0.4)") "lowdin."//trim(Grid_instance(speciesID)%nameOfSpecies)//".orbitals"
@@ -283,8 +286,13 @@ subroutine GridManager_atomicOrbitals( action, type )
STOP "ERROR At DFT program, requested an unknown grid type to orbitals at GridManager"
end if
- if (.not. allocated(Grid_instance(speciesID)%orbitalsWithGradient)) &
- allocate(Grid_instance(speciesID)%orbitalsWithGradient(totalNumberOfContractions))
+ if (allocated(Grid_instance(speciesID)%orbitalsWithGradient)) then
+ do u=1, size(Grid_instance(speciesID)%orbitalsWithGradient(:))
+ call Matrix_destructor(Grid_instance(speciesID)%orbitalsWithGradient(u))
+ end do
+ deallocate(Grid_instance(speciesID)%orbitalsWithGradient)
+ end if
+ allocate(Grid_instance(speciesID)%orbitalsWithGradient(totalNumberOfContractions))
do u=1, totalNumberOfContractions
call Matrix_Constructor( Grid_instance(speciesID)%orbitalsWithGradient(u), int(gridSize,8), int(4,8), 0.0_8)
@@ -306,16 +314,16 @@ subroutine GridManager_atomicOrbitals( action, type )
if(trim(action) .eq. "WRITE") open(unit = orbsUnit, file=trim(orbsFile), status="replace", form="unformatted")
k=0
- do g = 1, size(MolecularSystem_instance%species(speciesID)%particles)
- do i = 1, size(MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction)
- numberOfCartesiansOrbitals = MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(i)%numCartesianOrbital
+ do g = 1, size(Grid_instance(speciesID)%molSys%species(speciesID)%particles)
+ do i = 1, size(Grid_instance(speciesID)%molSys%species(speciesID)%particles(g)%basis%contraction)
+ numberOfCartesiansOrbitals = Grid_instance(speciesID)%molSys%species(speciesID)%particles(g)%basis%contraction(i)%numCartesianOrbital
call Matrix_constructor( auxMatrix(1), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !orbital
call Matrix_constructor( auxMatrix(2), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !d orbital/dx
call Matrix_constructor( auxMatrix(3), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !d orbital/dy
call Matrix_constructor( auxMatrix(4), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !d orbital/dz
-
- call ContractedGaussian_getGradientAtGrid( MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(i), &
+
+ call ContractedGaussian_getGradientAtGrid( Grid_instance(speciesID)%molSys%species(speciesID)%particles(g)%basis%contraction(i), &
Grid_instance(speciesID)%points, gridSize, auxMatrix(1), auxMatrix(2), auxMatrix(3), auxMatrix(4))
! call Matrix_show(auxMatrix(1))
@@ -361,8 +369,10 @@ end subroutine GridManager_atomicOrbitals
!! @brief Returns the values of the density in a set of coordinates
!!! Felix Moncada, 2017
!<
- subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densityInGrid, gradientInGrid)
+ subroutine GridManager_getDensityGradientAtGrid(Grid_instance, GridsCommonPoints, speciesID, densityMatrix, densityInGrid, gradientInGrid)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
integer :: speciesID
type(Matrix) :: densityMatrix
type(Vector) :: densityInGrid
@@ -375,8 +385,8 @@ subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densi
integer :: i, j, u, g
integer :: ii, jj, v, gg
integer :: s, ss
- real(8) :: sum
integer :: numberOfContractions
+ real(8) :: auxreal
integer :: n, nproc
real :: time1,time2
@@ -385,7 +395,8 @@ subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densi
gridSize = Grid_instance(speciesID)%totalSize
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID )
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID,Grid_instance(speciesID)%molSys)
+
nproc=omp_get_max_threads()
if(.not. allocated(nodeDensityInGrid) ) allocate( nodeDensityInGrid(nproc),nodeGradientInGrid(nproc,3) )
@@ -451,6 +462,15 @@ subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densi
call Vector_Destructor( nodeGradientInGrid(n,3))
end do
+ !!Check for negative values, which should be numerical mistakes
+ auxreal=1.0E8
+ do point = 1 , gridSize
+ if(densityInGrid%values(point).lt.auxreal) auxreal=densityInGrid%values(point)
+ if(densityInGrid%values(point).lt.0.0) densityInGrid%values(point)=0.0
+ end do
+ if(-auxreal.gt.CONTROL_instance%NUCLEAR_ELECTRON_DENSITY_THRESHOLD) print *, "found significative negative density, up to", auxreal, ", for species", speciesID
+
+
time2=omp_get_wtime()
! write(*,"(A,F10.3,A4)") "**getDensityGradientAtGrid:", time2-time1 ," (s)"
@@ -464,9 +484,12 @@ end subroutine GridManager_getDensityGradientAtGrid
!! @brief Returns the values of the exchange correlation potential for a specie in a set of coordinates
!!! Felix Moncada, 2017
!<
- subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchangeCorrelationEnergy, &
+ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid(Grid_instance, GridsCommonPoints, Functionals, speciesID, exchangeCorrelationEnergy, &
otherSpeciesID, otherExchangeCorrelationEnergy)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
+ type(Functional) :: Functionals(:,:)
integer :: speciesID
real(8) :: exchangeCorrelationEnergy
integer, optional :: otherSpeciesID
@@ -477,11 +500,11 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang
type(Vector) :: energyDensity
type(Vector) :: sigma, sigmaPotential
type(Vector) :: densityAB, potentialAB, sigmaAB, sigmaPotentialAB
- integer :: i, index, dir
+ integer :: i, dir
- nameOfSpecies = MolecularSystem_getNameOfSpecie( speciesID )
- if( present(otherSpeciesID) ) otherNameOfSpecies = MolecularSystem_getNameOfSpecie( otherSpeciesID )
+ nameOfSpecies = MolecularSystem_getNameOfSpecies( speciesID,Grid_instance(speciesID)%molSys)
+ if( present(otherSpeciesID) ) otherNameOfSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,Grid_instance(otherSpeciesID)%molSys)
gridSize = Grid_instance(speciesID)%totalSize
@@ -491,8 +514,6 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang
!Closed Shell
if (nameOfSpecies=="E-" .and. .not. present(otherSpeciesID) ) then
- index=Functional_getIndex(speciesID)
-
call Vector_Constructor(sigma, gridSize, 0.0_8)
call Vector_Constructor(sigmaPotential, gridSize, 0.0_8)
!$omp parallel private(i)
@@ -506,7 +527,7 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang
+Grid_instance(speciesID)%densityGradient(3)%values(i)**2)
!evaluates energy density, potential and sigma potential
- call Functional_libxcEvaluate(Functionals(index), 1, Grid_instance(speciesID)%density%values(i), &
+ call Functional_libxcEvaluate(Functionals(speciesID,speciesID), 1, Grid_instance(speciesID)%density%values(i), &
sigma%values(i), energyDensity%values(i) , &
Grid_instance(speciesID)%potential%values(i), sigmaPotential%values(i) )
end if
@@ -540,8 +561,6 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang
call Vector_Constructor(potentialAB, 2*gridSize, 0.0_8)
call Vector_Constructor(sigmaPotentialAB, 3*gridSize, 0.0_8)
- index=Functional_getIndex(speciesID)
-
!$omp parallel private(i)
!$omp do schedule (dynamic)
do i=1, gridSize
@@ -565,7 +584,7 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang
!evaluates energy density, potential and sigma potential
- call Functional_libxcEvaluate(Functionals(index), 1, densityAB%values(2*i-1:2*i), sigmaAB%values(3*i-2:3*i), &
+ call Functional_libxcEvaluate(Functionals(speciesID,otherSpeciesID), 1, densityAB%values(2*i-1:2*i), sigmaAB%values(3*i-2:3*i), &
energyDensity%values(i) , potentialAB%values(2*i-1:2*i), sigmaPotentialAB%values(3*i-2:3*i) )
!potential assignment
@@ -619,8 +638,7 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang
end if
else
- index=Functional_getIndex(speciesID)
- if ( Functionals(index)%name .eq. "exchange:Slater-correlation:VWN5") then
+ if ( Functionals(speciesID,speciesID)%name .eq. "exchange:Slater-correlation:VWN5") then
if (nameOfSpecies=="E-" .and. .not. present(otherSpeciesID) ) then
@@ -659,10 +677,13 @@ end subroutine GridManager_getElectronicEnergyAndPotentialAtGrid
!! @brief Returns the values of the exchange correlation potential for a specie in a set of coordinates
!!! Felix Moncada, 2017
!<
- subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, otherSpeciesID, exchangeCorrelationEnergy, &
+ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid(Grid_instance, GridsCommonPoints, Functionals, speciesID, otherSpeciesID, exchangeCorrelationEnergy, &
otherElectronID, otherElectronExchangeCorrelationEnergy)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
+ type(Functional) :: Functionals(:,:)
integer :: speciesID
integer :: otherSpeciesID
real(8) :: exchangeCorrelationEnergy
@@ -675,18 +696,16 @@ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, other
type(Vector) :: sigma
type(Vector) :: densityAB, potentialAB, sigmaAB, sigmaPotentialAB
type(Vector) :: electronicDensityAtOtherGrid, electronicGradientAtOtherGrid(3), electronicPotentialAtOtherGrid, electronicGradientPotentialAtOtherGrid(3)
- integer :: i, j, k, index, dir
+ integer :: i, j, k, dir
- nameOfSpecies = MolecularSystem_getNameOfSpecie( speciesID )
- otherNameOfSpecies = MolecularSystem_getNameOfSpecie( otherSpeciesID )
+ nameOfSpecies = MolecularSystem_getNameOfSpecies( speciesID,Grid_instance(speciesID)%molSys)
+ otherNameOfSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,Grid_instance(otherSpeciesID)%molSys)
if ( (nameOfSpecies.ne."E-" .and. nameOfSpecies.ne."E-ALPHA") ) return
gridSize = Grid_instance(speciesID)%totalSize
otherGridSize = Grid_instance(otherSpeciesID)%totalSize
- index=Functional_getIndex(speciesID, otherSpeciesID)
-
!Nuclear electron correlation
!"E-BETA" is treated at the same time as E-ALPHA
@@ -699,7 +718,7 @@ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, other
end do
!!This adds E-BETA density and gradient
- call GridManager_getElectronicDensityInOtherGrid(speciesID, otherSpeciesID, &
+ call GridManager_getElectronicDensityInOtherGrid(Grid_instance, GridsCommonPoints, speciesID, otherSpeciesID, &
GridsCommonPoints(speciesID,otherSpeciesID)%totalSize, int(GridsCommonPoints(speciesID,otherSpeciesID)%points%values), &
electronicDensityAtOtherGrid, electronicGradientAtOtherGrid)
@@ -714,86 +733,86 @@ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, other
select case (trim(auxstring) )
case ("EXPCS-GGA")
- call Functional_expCSGGAEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_expCSGGAEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid, electronicGradientAtOtherGrid, &
Grid_instance(otherSpeciesID)%density, Grid_instance(otherSpeciesID)%densityGradient, &
energyDensity, electronicPotentialAtOtherGrid, electronicGradientPotentialAtOtherGrid, &
Grid_instance(otherSpeciesID)%potential, Grid_instance(otherSpeciesID)%gradientPotential )
case ("EXPCS-GGA-NOA")
- call Functional_expCSGGAEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_expCSGGAEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid, electronicGradientAtOtherGrid, &
Grid_instance(otherSpeciesID)%density, Grid_instance(otherSpeciesID)%densityGradient, &
energyDensity, electronicPotentialAtOtherGrid, electronicGradientPotentialAtOtherGrid, &
Grid_instance(otherSpeciesID)%potential, Grid_instance(otherSpeciesID)%gradientPotential )
case ("EPC17-1")
- call Functional_EPCEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_EPCEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("EPC17-2")
- call Functional_EPCEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_EPCEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("IKN-NSF")
- call Functional_IKNEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_IKNEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("MLCS-FIT")
- call Functional_MLCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_MLCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("MLCS-A")
- call Functional_MLCSAEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_MLCSAEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("MLCS-AN")
- call Functional_MLCSANEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_MLCSANEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("CS-MYFIT")
- call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("IMAMURA-MYFIT")
- call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("MEJIA-MYFIT")
- call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("MEJIAA-MYFIT")
- call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("EXPCS-A")
- call Functional_expCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_expCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("EXPCS-NOA")
- call Functional_expCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_expCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("PSN")
- call Functional_PSNEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_PSNEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
case ("PSNAP")
- call Functional_PSNAPEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, &
+ call Functional_PSNAPEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, &
electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, &
energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values )
@@ -857,8 +876,10 @@ end subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid
!>
!! @brief Builds the exchange correlation for a species
! Felix Moncada, 2017
- subroutine GridManager_buildExchangeCorrelationMatrix( speciesID, exchangeCorrelationMatrix)
+ subroutine GridManager_buildExchangeCorrelationMatrix(Grid_instance, GridsCommonPoints, speciesID, exchangeCorrelationMatrix)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
integer :: speciesID
type(Matrix) :: exchangeCorrelationMatrix
@@ -874,7 +895,7 @@ subroutine GridManager_buildExchangeCorrelationMatrix( speciesID, exchangeCorrel
type(Matrix),allocatable :: nodeExchangeCorrelationMatrix(:)
gridSize = Grid_instance(speciesID)%totalSize
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID )
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID,Grid_instance(speciesID)%molSys)
nproc=omp_get_max_threads()
@@ -953,7 +974,10 @@ end subroutine GridManager_buildExchangeCorrelationMatrix
- subroutine GridManager_getElectronicDensityInOtherGrid(electronicID,otherSpeciesID, commonGridSize, commonPoints, electronicDensityAtOtherGrid, electronicGradientAtOtherGrid )
+ subroutine GridManager_getElectronicDensityInOtherGrid(Grid_instance, GridsCommonPoints,electronicID,otherSpeciesID, commonGridSize, commonPoints, electronicDensityAtOtherGrid, electronicGradientAtOtherGrid )
+ implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
integer :: electronicID, otherSpeciesID
integer :: commonGridSize
integer :: commonPoints(commonGridSize,2)
@@ -969,14 +993,19 @@ subroutine GridManager_getElectronicDensityInOtherGrid(electronicID,otherSpecies
electronicGridSize=Grid_instance(electronicID)%totalSize
otherGridSize=Grid_instance(otherSpeciesID)%totalSize
- nameOfElectron=MolecularSystem_getNameOfSpecie(electronicID)
- if (nameOfElectron .eq. "E-ALPHA") otherElectronicID=MolecularSystem_getSpecieID( "E-BETA" )
- if (nameOfElectron .eq. "E-BETA") otherElectronicID=MolecularSystem_getSpecieID( "E-ALPHA" )
+ nameOfElectron=MolecularSystem_getNameOfSpecies(electronicID,Grid_instance(electronicID)%molSys)
+
+ if (nameOfElectron .eq. "E-ALPHA") otherElectronicID=MolecularSystem_getSpecieID( "E-BETA",Grid_instance(electronicID)%molSys)
+ if (nameOfElectron .eq. "E-BETA") otherElectronicID=MolecularSystem_getSpecieID( "E-ALPHA",Grid_instance(electronicID)%molSys)
call Vector_constructor(electronicDensityAtOtherGrid, otherGridSize, 1.0E-12_8)
+
time1=omp_get_wtime()
+
+ !check if both have common points
+ if(commonGridSize .lt. 0) print *, "WARNING! trying to evaluate the correlation between species ", electronicID, " and " ,otherSpeciesID, " but there are no common points. Are the GTF centers equal?"
do k=1, commonGridSize
!here we are assuming that the electron came in the first position
i=commonPoints(k,1)
@@ -993,12 +1022,14 @@ subroutine GridManager_getElectronicDensityInOtherGrid(electronicID,otherSpecies
electronicGradientAtOtherGrid(3)%values(j)=Grid_instance(electronicID)%densityGradient(3)%values(i)
end if
end do
+
time2=omp_get_wtime()
! write(*,"(A,F10.3,A4)") "**getElectronicDensityInOtherGrid:", time2-time1 ," (s)"
end subroutine GridManager_getElectronicDensityInOtherGrid
subroutine GridManager_findCommonPoints(grid,gridSize,otherGrid,otherGridSize,commonPoints,commonSize)
+ implicit none
type(Matrix) :: grid,otherGrid
integer :: gridSize,otherGridSize,commonSize
type(Matrix) :: commonPoints
@@ -1052,8 +1083,10 @@ end subroutine GridManager_FindCommonPoints
!>
!! @brief Builds the exchange correlation for a species
! Felix Moncada, 2017
- subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectronID)
+ subroutine GridManager_getContactDensity(Grid_instance, GridsCommonPoints, speciesID, otherSpeciesID, otherElectronID)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
integer :: speciesID, otherSpeciesID
integer, optional :: otherElectronID
@@ -1076,7 +1109,7 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr
call Vector_constructor(electronicGradientAtOtherGrid(3), gridSize, 0.0_8)
!electrons go on the first position
- call GridManager_getElectronicDensityInOtherGrid(speciesID, otherSpeciesID, &
+ call GridManager_getElectronicDensityInOtherGrid(Grid_instance, GridsCommonPoints, speciesID, otherSpeciesID, &
GridsCommonPoints(speciesID,otherSpeciesID)%totalSize, int(GridsCommonPoints(speciesID,otherSpeciesID)%points%values), electronicDensityAtOtherGrid, electronicGradientAtOtherGrid )
call Vector_constructor(gfactor, gridSize, 0.0_8)
@@ -1099,7 +1132,7 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr
end if
- if(MolecularSystem_getMass(otherSpeciesID) .lt. 2.0 .and. (auxstring.eq."expCS-A" .or. auxstring.eq."expCS-GGA")) then !positron
+ if(MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys) .lt. 2.0 .and. (auxstring.eq."expCS-A" .or. auxstring.eq."expCS-GGA")) then !positron
kf=2.2919886876120283056
a0n=0.3647813291441602
@@ -1120,7 +1153,7 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr
rhoE=electronicDensityAtOtherGrid%values(point)
rhoP=Grid_instance(otherSpeciesID)%density%values(point)
- call Functional_getBeta( rhoE, rhoP, MolecularSystem_getMass(otherSpeciesID), kf, beta, dBdE, dBdP, d2BdE2, d2BdP2, d2BdEP)
+ call Functional_getBeta( rhoE, rhoP, MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys), kf, beta, dBdE, dBdP, d2BdE2, d2BdP2, d2BdEP)
if( rhoE .gt. densityThreshold .and. rhoP .gt. densityThreshold ) then !
gfactor%values(point)=(a0n+a1n*beta+a2n*beta**2+a3n*beta**3+a4n*beta**4)/(a0d*beta**3+a1d*beta**4+a2d*beta**5)
@@ -1151,8 +1184,8 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr
if(CONTROL_instance%PRINT_LEVEL .gt. 0) then
print *, ""
- print *, "Contact density between ", trim(MolecularSystem_getNameOfSpecie(speciesID)),"-", trim(MolecularSystem_getNameOfSpecie(otherSpeciesID))
- if(present(otherElectronID) ) print *, "Including contact density between ", trim(MolecularSystem_getNameOfSpecie(otherElectronID)),"-", trim(MolecularSystem_getNameOfSpecie(otherSpeciesID))
+ print *, "Contact density between ", trim(Grid_instance(speciesID)%nameOfSpecies),"-", trim(Grid_instance(otherSpeciesID)%nameOfSpecies)
+ if(present(otherElectronID) ) print *, "Including contact density between ", trim(Grid_instance(otherElectronID)%nameOfSpecies),"-", trim(Grid_instance(otherSpeciesID)%nameOfSpecies)
if(auxstring.eq."expCS-A" .or. auxstring.eq."expCS-GGA" ) then
print *, "As the integral of rhoA*rhoB(1+g[beta])"
@@ -1178,8 +1211,10 @@ end subroutine GridManager_getContactDensity
!>
!! @brief Builds the exchange correlation for a species
! Felix Moncada, 2017
- subroutine GridManager_getExpectedDistances( speciesID)
+ subroutine GridManager_getExpectedDistances(Grid_instance, GridsCommonPoints, speciesID)
implicit none
+ type(Grid) :: Grid_instance(:)
+ type(Grid) :: GridsCommonPoints(:,:)
integer :: speciesID
integer :: point,gridSize
@@ -1188,7 +1223,7 @@ subroutine GridManager_getExpectedDistances( speciesID)
gridSize =Grid_instance(speciesID)%totalSize
- numberOfCenters=MolecularSystem_instance%numberOfPointCharges
+ numberOfCenters=Grid_instance(speciesID)%molSys%numberOfPointCharges
if(.not. allocated(distances))allocate(distances(numberOfCenters))
@@ -1199,14 +1234,14 @@ subroutine GridManager_getExpectedDistances( speciesID)
distances(center)=distances(center) + &
Grid_instance(speciesID)%density%values(point)* &
- sqrt((MolecularSystem_instance%pointCharges(center)%origin(1)-Grid_instance(speciesID)%points%values(point,1) )**2+ &
- (MolecularSystem_instance%pointCharges(center)%origin(2)-Grid_instance(speciesID)%points%values(point,2) )**2+ &
- (MolecularSystem_instance%pointCharges(center)%origin(3)-Grid_instance(speciesID)%points%values(point,3) )**2 ) * &
+ sqrt((Grid_instance(speciesID)%molSys%pointCharges(center)%origin(1)-Grid_instance(speciesID)%points%values(point,1) )**2+ &
+ (Grid_instance(speciesID)%molSys%pointCharges(center)%origin(2)-Grid_instance(speciesID)%points%values(point,2) )**2+ &
+ (Grid_instance(speciesID)%molSys%pointCharges(center)%origin(3)-Grid_instance(speciesID)%points%values(point,3) )**2 ) * &
Grid_instance(speciesID)%points%values(point,4)
end do
- write (*,"(A10,A10,F20.10)") trim(Grid_instance(speciesID)%nameOfSpecies), trim(MolecularSystem_instance%pointCharges(center)%nickname), distances(center)
+ write (*,"(A10,A10,F20.10)") trim(Grid_instance(speciesID)%nameOfSpecies), trim(Grid_instance(speciesID)%molSys%pointCharges(center)%nickname), distances(center)
end do
diff --git a/src/MBPT/ENFunctions.f90 b/src/MBPT/ENFunctions.f90
index af4c4627..1d16d935 100644
--- a/src/MBPT/ENFunctions.f90
+++ b/src/MBPT/ENFunctions.f90
@@ -178,7 +178,7 @@ subroutine EpsteinNesbet_show()
print *,""
do i=1, EpsteinNesbet_instance%numberOfSpecies
- write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) )//"} = ", &
+ write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) )//"} = ", &
EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,1)
end do
@@ -187,7 +187,7 @@ subroutine EpsteinNesbet_show()
do i=1, EpsteinNesbet_instance%numberOfSpecies
do j=i+1,EpsteinNesbet_instance%numberOfSpecies
k=k+1
- write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecie( j ) )//" } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecies( j ) )//" } = ", &
EpsteinNesbet_instance%energyOfCouplingCorrectionOfSecondOrder%values(k,1)
end do
end do
@@ -208,7 +208,7 @@ subroutine EpsteinNesbet_show()
print *,""
do i=1, EpsteinNesbet_instance%numberOfSpecies
- write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) )//" } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) )//" } = ", &
EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,2)
end do
@@ -217,7 +217,7 @@ subroutine EpsteinNesbet_show()
do i=1, EpsteinNesbet_instance%numberOfSpecies
do j=i+1,EpsteinNesbet_instance%numberOfSpecies
k=k+1
- write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecie( j ) ) //" } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecies( j ) ) //" } = ", &
EpsteinNesbet_instance%energyOfCouplingCorrectionOfSecondOrder%values(k,2)
end do
end do
@@ -238,7 +238,7 @@ subroutine EpsteinNesbet_show()
print *,""
do i=1, EpsteinNesbet_instance%numberOfSpecies
- write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecie( i ) )//" } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecies( i ) )//" } = ", &
EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,3)
end do
@@ -247,7 +247,7 @@ subroutine EpsteinNesbet_show()
do i=1, EpsteinNesbet_instance%numberOfSpecies
do j=i+1,EpsteinNesbet_instance%numberOfSpecies
k=k+1
- write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecie( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecie( j ) ) // " } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecies( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecies( j ) ) // " } = ", &
EpsteinNesbet_instance%energyOfCouplingCorrectionOfSecondOrder%values(k,3)
end do
end do
@@ -359,7 +359,7 @@ function EpsteinNesbet_getSpecieCorrection( specieName) result( output)
do i=1, EpsteinNesbet_instance%numberOfSpecies
- if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecie( i ) ) ) then
+ if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecies( i ) ) ) then
output = EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,1) !!MP2
return
@@ -473,14 +473,14 @@ subroutine EpsteinNesbet_secondOrderCorrection()
do is=1, EpsteinNesbet_instance%numberOfSpecies
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) )
independentEnergyCorrection = 0.0_8
if( trim(nameOfSpecie)=="E-" .or. .not.CONTROL_instance%MP_ONLY_ELECTRONIC_CORRECTION ) then
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is)
- arguments(2) = MolecularSystem_getNameOfSpecie(is)
+ arguments(2) = MolecularSystem_getNameOfSpecies(is)
arguments(1) = "COEFFICIENTS"
eigenVec= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
@@ -743,7 +743,7 @@ subroutine EpsteinNesbet_secondOrderCorrection()
do is = 1 , EpsteinNesbet_instance%numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is)
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(is))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(is))
arguments(1) = "COEFFICIENTS"
eigenVec = &
@@ -755,7 +755,7 @@ subroutine EpsteinNesbet_secondOrderCorrection()
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
output = eigenValues )
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) )
specieID =MolecularSystem_getSpecieID( nameOfSpecie=trim(nameOfSpecie) )
ocupationNumber = MolecularSystem_getOcupationNumber( is )
lambda = MolecularSystem_getEta( is )
@@ -766,7 +766,7 @@ subroutine EpsteinNesbet_secondOrderCorrection()
numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( js )
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(js))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(js))
arguments(1) = "COEFFICIENTS"
eigenVecOtherSpecie = &
@@ -779,7 +779,7 @@ subroutine EpsteinNesbet_secondOrderCorrection()
output = eigenValuesOfOtherSpecie )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( js ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( js ) )
otherSpecieID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie )
ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( js )
diff --git a/src/MBPT/MPFunctions.f90 b/src/MBPT/MPFunctions.f90
index 1f8e9c7f..de27319a 100644
--- a/src/MBPT/MPFunctions.f90
+++ b/src/MBPT/MPFunctions.f90
@@ -188,7 +188,7 @@ subroutine MollerPlesset_show()
print *,""
do i=1, MollerPlesset_instance%numberOfSpecies
- write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecie(i))//" } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecies(i))//" } = ", &
MollerPlesset_instance%energyCorrectionOfSecondOrder%values(i)
end do
@@ -197,7 +197,7 @@ subroutine MollerPlesset_show()
do i=1, MollerPlesset_instance%numberOfSpecies
do j=i+1,MollerPlesset_instance%numberOfSpecies
k=k+1
- write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecie(i))//"/"//trim(MolecularSystem_getNameOfSpecie(j))//" } = ", &
+ write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecies(i))//"/"//trim(MolecularSystem_getNameOfSpecies(j))//" } = ", &
MollerPlesset_instance%energyOfCouplingCorrectionOfSecondOrder%values(k)
end do
end do
@@ -302,7 +302,7 @@ function MollerPlesset_getSpecieCorrection( specieName) result( output)
do i=1, MollerPlesset_instance%numberOfSpecies
- if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecie( i ) ) ) then
+ if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecies( i ) ) ) then
output = MollerPlesset_instance%energyCorrectionOfSecondOrder%values(i)
return
@@ -412,14 +412,14 @@ subroutine MollerPlesset_secondOrderCorrection()
do is=1, MollerPlesset_instance%numberOfSpecies
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) )
independentEnergyCorrection = 0.0_8
if( trim(nameOfSpecie)=="E-" .or. .not.CONTROL_instance%MP_ONLY_ELECTRONIC_CORRECTION ) then
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is)
- arguments(2) = MolecularSystem_getNameOfSpecie(is)
+ arguments(2) = MolecularSystem_getNameOfSpecies(is)
arguments(1) = "COEFFICIENTS"
eigenVec= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
@@ -687,7 +687,7 @@ subroutine MollerPlesset_secondOrderCorrection()
do is = 1 , MollerPlesset_instance%numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is)
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(is))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(is))
arguments(1) = "COEFFICIENTS"
eigenVec = &
@@ -699,7 +699,7 @@ subroutine MollerPlesset_secondOrderCorrection()
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
output = eigenValues )
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) )
specieID =MolecularSystem_getSpecieID( nameOfSpecie=trim(nameOfSpecie) )
ocupationNumber = MolecularSystem_getOcupationNumber( is )
lambda = MolecularSystem_getEta( is )
@@ -710,7 +710,7 @@ subroutine MollerPlesset_secondOrderCorrection()
numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( js )
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(js))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(js))
arguments(1) = "COEFFICIENTS"
eigenVecOtherSpecie = &
@@ -723,7 +723,7 @@ subroutine MollerPlesset_secondOrderCorrection()
output = eigenValuesOfOtherSpecie )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( js ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( js ) )
otherSpecieID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie )
ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( js )
@@ -797,8 +797,8 @@ subroutine MollerPlesset_secondOrderCorrection()
select case (order)
case ("AB")
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)
@@ -835,8 +835,8 @@ subroutine MollerPlesset_secondOrderCorrection()
case ("BA")
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie)
diff --git a/src/NOCI/NOCI.f90 b/src/NOCI/NOCI.f90
index 531caa8b..9d5911c9 100644
--- a/src/NOCI/NOCI.f90
+++ b/src/NOCI/NOCI.f90
@@ -27,13 +27,16 @@
!! @warning This programs only works linked to lowdincore library, provided by LOWDIN quantum chemistry package
!!
program NOCI
+ use NOCIBuild_
+ use NOCIRunSCF_
+ use NOCIMatrices_
+ use NOCISuperposed_
+ use NOCIFranckCondon_
+ use NOCIRotFormula_
use CONTROL_
use InputManager_
use MolecularSystem_
- use Exception_
- use NonOrthogonalCI_
use String_
- use InputCI_
use Stopwatch_
use MecanicProperties_
implicit none
@@ -63,23 +66,25 @@ program NOCI
!!Load the system in lowdin.sys format
call MolecularSystem_loadFromFile( "LOWDIN.SYS" )
- call NonOrthogonalCI_constructor(NonOrthogonalCI_instance)
+ call NOCIBuild_constructor(NOCI_instance)
if(CONTROL_instance%READ_NOCI_GEOMETRIES) then
- call NonOrthogonalCI_readGeometries(NonOrthogonalCI_instance)
+ call NOCIBuild_readGeometries(NOCI_instance)
else
- call NonOrthogonalCI_displaceGeometries(NonOrthogonalCI_instance)
+ call NOCIBuild_displaceGeometries(NOCI_instance)
end if
- call NonOrthogonalCI_runHFs(NonOrthogonalCI_instance)
- call NonOrthogonalCI_buildOverlapAndHamiltonianMatrix(NonOrthogonalCI_instance)
-
- if(.not. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
- call NonOrthogonalCI_diagonalizeCImatrix(NonOrthogonalCI_instance)
- call NonOrthogonalCI_generateSuperposedSystem(NonOrthogonalCI_instance)
- call NonOrthogonalCI_buildDensityMatrix(NonOrthogonalCI_instance)
- call NonOrthogonalCI_getNaturalOrbitals(NonOrthogonalCI_instance)
- call NonOrthogonalCI_computeFranckCondon(NonOrthogonalCI_instance)
- call NonOrthogonalCI_saveToFile(NonOrthogonalCI_instance)
- else
+ call NOCIRunSCF_runHFs(NOCI_instance)
+ call NOCIMatrices_buildOverlapAndHamiltonian(NOCI_instance)
+
+ if (.not.(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS .or. CONTROL_instance%COMPUTE_ROCI_FORMULA)) then
+ call NOCIMatrices_diagonalize(NOCI_instance)
+ call NOCISuperposed_generateSuperposedSystem(NOCI_instance)
+ call NOCISuperposed_buildDensityMatrix(NOCI_instance)
+ call NOCISuperposed_getNaturalOrbitals(NOCI_instance)
+ call NOCIFranckCondon_computeFranckCondon(NOCI_instance)
+ call NOCISuperposed_saveToFile(NOCI_instance)
+ else if (CONTROL_instance%COMPUTE_ROCI_FORMULA) then
+ call NOCIRotFormula_compute(NOCI_instance)
+ else if (CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
write (*,"(T10,A)") "COMPUTED NOCI ELEMENTS ONLY WITH RESPECT TO THE FIRST GEOMETRY - YOU HAVE TO SOLVE THE CI EQUATION MANUALLY!"
end if
@@ -204,18 +209,25 @@ program NOCI
! end if
if ( CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION ) then
- call NonOrthogonalCI_constructor(NonOrthogonalCI_instance)
- call NonOrthogonalCI_displaceGeometries(NonOrthogonalCI_instance)
- call NonOrthogonalCI_runHFs(NonOrthogonalCI_instance)
- call NonOrthogonalCI_buildOverlapAndHamiltonianMatrix(NonOrthogonalCI_instance)
- if(.not. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
- call NonOrthogonalCI_diagonalizeCImatrix(NonOrthogonalCI_instance)
- call NonOrthogonalCI_generateSuperposedSystem(NonOrthogonalCI_instance)
- call NonOrthogonalCI_buildDensityMatrix(NonOrthogonalCI_instance)
- call NonOrthogonalCI_getNaturalOrbitals(NonOrthogonalCI_instance)
- call NonOrthogonalCI_computeFranckCondon(NonOrthogonalCI_instance)
- call NonOrthogonalCI_saveToFile(NonOrthogonalCI_instance)
+ call NOCIBuild_constructor(NOCI_instance)
+ if(CONTROL_instance%READ_NOCI_GEOMETRIES) then
+ call NOCIBuild_readGeometries(NOCI_instance)
else
+ call NOCIBuild_displaceGeometries(NOCI_instance)
+ end if
+ call NOCIRunSCF_runHFs(NOCI_instance)
+ call NOCIMatrices_buildOverlapAndHamiltonian(NOCI_instance)
+
+ if (.not.(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS .or. CONTROL_instance%COMPUTE_ROCI_FORMULA)) then
+ call NOCIMatrices_diagonalize(NOCI_instance)
+ call NOCISuperposed_generateSuperposedSystem(NOCI_instance)
+ call NOCISuperposed_buildDensityMatrix(NOCI_instance)
+ call NOCISuperposed_getNaturalOrbitals(NOCI_instance)
+ call NOCIFranckCondon_computeFranckCondon(NOCI_instance)
+ call NOCISuperposed_saveToFile(NOCI_instance)
+ else if (CONTROL_instance%COMPUTE_ROCI_FORMULA) then
+ call NOCIRotFormula_compute(NOCI_instance)
+ else if (CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
write (*,"(T10,A)") "COMPUTED NOCI ELEMENTS ONLY WITH RESPECT TO THE FIRST GEOMETRY - YOU HAVE TO SOLVE THE CI EQUATION MANUALLY!"
end if
end if
@@ -223,7 +235,7 @@ program NOCI
call MolecularSystem_saveToFile()
!!calculate CI density properties
- call system ("lowdin-CalcProp.x")
+ if ( .not. (CONTROL_instance%COMPUTE_ROCI_FORMULA .or. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS)) call system ("lowdin-CalcProp.x")
if ( CONTROL_instance%IS_THERE_OUTPUT ) then
write(strAuxNumber,"(I10)") Input_instance%numberOfOutputs
diff --git a/src/NOCI/NOCIBuild.f90 b/src/NOCI/NOCIBuild.f90
new file mode 100644
index 00000000..229ce491
--- /dev/null
+++ b/src/NOCI/NOCIBuild.f90
@@ -0,0 +1,981 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module NOCIBuild_
+ use Math_
+ use MolecularSystem_
+ use ParticleManager_
+ use Lebedev_
+ use Matrix_
+ use Vector_
+ use String_
+ use omp_lib
+ implicit none
+
+ !>
+ !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
+ !!
+ !! @author Felix
+ !!
+ !! Creation data : 02-22
+ !!
+ !! History change:
+ !!
+ !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# Creation of the module.
+ !!
+ !<
+
+ type, public :: NonOrthogonalCI
+ logical :: isInstanced
+ integer :: numberOfDisplacedSystems
+ integer :: numberOfEnergyRejectedSystems
+ integer :: numberOfEllipsoidRejectedSystems
+ integer :: numberOfPPdistanceRejectedSystems
+ integer :: numberOfNPdistanceRejectedSystems
+ integer :: numberOfEquivalentSystems
+ integer :: numberOfTransformedCenters
+ integer :: numberOfIndividualTransformations
+ integer :: printMatrixThreshold
+ integer, allocatable :: rotationCenterList(:,:)
+ type(Matrix) :: configurationOverlapMatrix, configurationHamiltonianMatrix, configurationCoefficients
+ type(Matrix), allocatable :: configurationKineticMatrix(:), configurationPuntualMatrix(:), configurationExternalMatrix(:), configurationExchangeMatrix(:)
+ type(Matrix), allocatable :: configurationHartreeMatrix(:,:), configurationDFTcorrelationMatrix(:,:)
+ type(Vector) :: configurationCorrelationEnergies, statesEigenvalues
+ type(IVector), allocatable :: sysBasisList(:,:)
+ type(Matrix), allocatable :: HFCoefficients(:,:)
+ type(Matrix), allocatable :: mergedCoefficients(:)
+ type(Matrix), allocatable :: mergedOverlapMatrix(:)
+ type(Matrix), allocatable :: mergedDensityMatrix(:,:)
+ type(MolecularSystem), allocatable :: molecularSystems(:)
+ type(MolecularSystem) :: mergedMolecularSystem
+ character(50) :: transformationType
+ character(15),allocatable :: systemLabels(:)
+ real(8) :: refEnergy
+ real(8), allocatable :: exactExchangeFraction(:)
+ ! integer :: numberOfUniqueSystems !sort of symmetry
+ ! integer :: numberOfUniquePairs !sort of symmetry
+ ! type(IVector) :: systemTypes !sort of symmetry
+ ! type(IMatrix) :: configurationPairTypes !, uniqueOverlapElements, uniqueHamiltonianElements
+ ! type(MolecularSystem), allocatable :: uniqueMolecularSystems(:)
+ end type NonOrthogonalCI
+
+ type(NonOrthogonalCI), public :: NOCI_instance
+
+ public :: &
+ NOCIBuild_constructor,&
+ NOCIBuild_displaceGeometries,&
+ NOCIBuild_readGeometries
+
+ private
+
+contains
+
+ !>
+ !! @brief Allocates memory and run HF calculations to be used in the construction of the NOCI matrix
+ !!
+ !! @param this
+ !<
+ subroutine NOCIBuild_constructor(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ integer :: numberOfRotationCenters, numberOfTranslationCenters
+ integer :: p,q,r
+
+ print *, "-------------------------------------------------------------"
+ print *, "STARTING NON ORTHOGONAL CONFIGURATION INTERACTION CALCULATION"
+ print *, "-------------------------------------------------------------"
+ print *, ""
+ this%isInstanced=.true.
+ this%numberOfDisplacedSystems=0
+ this%numberOfEnergyRejectedSystems=0
+ this%numberOfEllipsoidRejectedSystems=0
+ this%numberOfPPdistanceRejectedSystems=0
+ this%numberOfNPdistanceRejectedSystems=0
+ ! this%numberOfUniqueSystems=0
+ ! this%numberOfUniquePairs=0
+ this%printMatrixThreshold=30
+ numberOfTranslationCenters=0
+ numberOfRotationCenters=0
+
+ allocate(this%rotationCenterList(size(MolecularSystem_instance%allParticles),2))
+ !For rotations, 0,0: leave alone, N,M: rotation center number to be rotated around point M
+ this%rotationCenterList=0
+
+ !!Translation count
+ do p = 1, size(MolecularSystem_instance%allParticles)
+
+ if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.gt.numberOfTranslationCenters) &
+ numberOfTranslationCenters=MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter
+
+ if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.ne.0) &
+ write (*,"(A,A10,A,3F9.5,A)") "Particle ", trim(ParticleManager_getSymbol(p)), &
+ " basis functions at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), &
+ " are going to be displaced"
+ end do
+
+ !!Rotation count
+ do p = 1, size(MolecularSystem_instance%allParticles)
+ if(MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint.eq.0) cycle
+ write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(p)), &
+ " located at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), &
+ " is center of rotation number", MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint
+
+ do q = 1, size(MolecularSystem_instance%allParticles)
+ if(MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround .eq. &
+ MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint) then
+ write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(q)), &
+ " basis functions at ", MolecularSystem_instance%allParticles(q)%particlePtr%origin(1:3), &
+ " are going to be rotated around center ", MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround
+
+ if(q .eq. MolecularSystem_instance%allParticles(q)%particlePtr%owner) then
+ !in the case of several species with the same center, rotate them as one
+ numberOfRotationCenters=numberOfRotationCenters+1
+ this%rotationCenterList(q,1)=numberOfRotationCenters
+ !find childs
+ if ( allocated(MolecularSystem_instance%allParticles(q)%particlePtr%childs) ) then
+ do r=1,size(MolecularSystem_instance%allParticles(q)%particlePtr%childs)
+ this%rotationCenterList( MolecularSystem_instance%allParticles(q)%particlePtr%childs(r),1)=numberOfRotationCenters
+ end do
+ end if
+ end if
+ this%rotationCenterList(q,2)=p
+ end if
+ end do
+ end do
+
+ ! print *, "this%rotationCenterList"
+ ! do p=1, size(MolecularSystem_instance%allParticles)
+ ! print *, "Particle ", trim(ParticleManager_getSymbol(p)),this%rotationCenterList(p,1), this%rotationCenterList(p,2)
+ ! end do
+
+ if(numberOfTranslationCenters.ne.0) then
+
+ this%transformationType="TRANSLATION"
+ this%numberOfTransformedCenters=numberOfTranslationCenters
+ this%numberOfIndividualTransformations=&
+ CONTROL_instance%TRANSLATION_SCAN_GRID(1)*CONTROL_instance%TRANSLATION_SCAN_GRID(2)*CONTROL_instance%TRANSLATION_SCAN_GRID(3)&
+ +(CONTROL_instance%TRANSLATION_SCAN_GRID(1)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(2)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(3)-1)
+
+ print *, ""
+ write (*,"(A,I5,A,I10,A)") "Displacing coordinates of ", numberOfTranslationCenters, " centers", &
+ this%numberOfIndividualTransformations," times"
+ print *, ""
+
+ else if(numberOfRotationCenters.ne.0) then
+ print *, ""
+ write (*,"(A,I5,A,I5,A,I5,A)") "Rotating coordinates of ", numberOfRotationCenters, " centers", CONTROL_instance%ROTATIONAL_SCAN_GRID, &
+ " times in ", CONTROL_instance%NESTED_ROTATIONAL_GRIDS, " nested grids"
+ print *, ""
+
+ this%transformationType="ROTATION"
+ this%numberOfTransformedCenters=numberOfRotationCenters
+ this%numberOfIndividualTransformations=CONTROL_instance%ROTATIONAL_SCAN_GRID*CONTROL_instance%NESTED_ROTATIONAL_GRIDS
+ else if(CONTROL_instance%ROTATION_AROUND_Z_STEP.ne.0) then
+ print *, ""
+ write (*,"(A)") "Rotating around the z axis the basis centers of the quantum particles "
+
+ if(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE .eq. 360 ) then
+ this%numberOfIndividualTransformations=int(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE/CONTROL_instance%ROTATION_AROUND_Z_STEP)
+ else
+ this%numberOfIndividualTransformations=int(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE/CONTROL_instance%ROTATION_AROUND_Z_STEP)+1
+ end if
+
+ write (*,"(A,I5,A,I5,A)") "From 0 to ", CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE ," degrees in ", this%numberOfIndividualTransformations, " steps"
+ print *, ""
+
+ this%transformationType="ROTATION_AROUND_Z"
+ this%numberOfTransformedCenters=1
+ else if(CONTROL_instance%READ_NOCI_GEOMETRIES) then
+ this%transformationType="READ_GEOMETRIES"
+ write (*,"(A)") "Reading input geometries from "//trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords file"
+ else
+ STOP "To perform a NOCI calculation, please provide either instructions for a geometry transformation or a NOCI.coords file"
+ end if
+
+ ! call Vector_constructorInteger(this%systemTypes,this%numberOfIndividualTransformations**this%numberOfTransformedCenters,0)
+
+
+ allocate(this%mergedDensityMatrix(CONTROL_instance%CI_STATES_TO_PRINT,molecularSystem_instance%numberOfQuantumSpecies),&
+ this%mergedOverlapMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
+ this%mergedCoefficients(molecularSystem_instance%numberOfQuantumSpecies),&
+ this%configurationKineticMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
+ this%configurationPuntualMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
+ this%configurationExternalMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
+ this%configurationExchangeMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
+ this%configurationHartreeMatrix(molecularSystem_instance%numberOfQuantumSpecies,molecularSystem_instance%numberOfQuantumSpecies),&
+ this%configurationDFTcorrelationMatrix(molecularSystem_instance%numberOfQuantumSpecies,molecularSystem_instance%numberOfQuantumSpecies),&
+ this%exactExchangeFraction(molecularSystem_instance%numberOfQuantumSpecies))
+
+ this%exactExchangeFraction(molecularSystem_instance%numberOfQuantumSpecies)=1.0_8
+
+ end subroutine NOCIBuild_constructor
+ !>
+ !! @brief Generates different geometries and runs HF calculations at each
+ !!
+ !! @param this
+ !<
+ subroutine NOCIBuild_displaceGeometries(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+
+ type(MolecularSystem) :: originalMolecularSystem
+ type(MolecularSystem) :: displacedMolecularSystem
+ real(8) :: displacement
+ character(100) :: coordsFile
+ integer, allocatable :: transformationCounter(:)
+ integer :: coordsUnit
+ integer :: i,j
+ integer :: closestSystem
+ logical :: skip
+ real(8) :: timeA
+
+ !$ timeA = omp_get_wtime()
+
+ call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance)
+
+ !!Dynamically allocated through the displacement routine
+ allocate(this%molecularSystems(0))
+
+ allocate(transformationCounter(this%numberOfTransformedCenters))
+
+ transformationCounter(1:this%numberOfTransformedCenters)=1
+ transformationCounter(1)=0
+
+ this%numberOfDisplacedSystems=0
+
+ coordsUnit=333
+ coordsFile=trim(CONTROL_instance%INPUT_FILE)//"trial.coords"
+
+ print *, "generating NOCI displaced geometries and HF wavefunctions... saving coords to ", trim(coordsFile)
+
+ open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted")
+
+!!!!! clock type iterations to form all the possible combination of modified geometries
+ do while (.true.)
+
+ !Determine the next movement like a clock iteration
+ transformationCounter(1)=transformationCounter(1)+1
+ do i=1,this%numberOfTransformedCenters-1
+ if(transformationCounter(i) .gt. this%numberOfIndividualTransformations) then
+ j=i+1
+ transformationCounter(j)=transformationCounter(j)+1
+ transformationCounter(1:i)=1
+ end if
+ end do
+
+ if(transformationCounter(this%numberOfTransformedCenters) .gt. this%numberOfIndividualTransformations) exit
+
+ write (coordsUnit,"(A)",advance="no") "Transformation counter: "
+ do i=1,this%numberOfTransformedCenters
+ write (coordsUnit,"(I10)",advance="no") transformationCounter(i)
+ end do
+ write (coordsUnit,*) ""
+
+ skip=.false.
+ !Apply the transformation given by transformationCounter to each center, the result is saved in molecularSystemInstance
+ call NOCIBuild_transformCoordinates(this,transformationCounter(1:this%numberOfTransformedCenters),originalMolecularSystem,displacedMolecularSystem,skip)
+
+ call MolecularSystem_showCartesianMatrix(displacedMolecularSystem,unit=coordsUnit)
+
+ !Classify the system according to its distance matrix (symmetry)
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) &
+ ! call NOCIBuild_classifyNewSystem(this,systemType, newSystemFlag)
+
+ !Check if the new system is not beyond the max displacement
+ if(skip) then
+ write (coordsUnit,"(A)") "Skipping system beyond the ellipsoids boundaries"
+ this%numberOfEllipsoidRejectedSystems=this%numberOfEllipsoidRejectedSystems+1
+ cycle
+ end if
+
+ !Check if the separation between particles of the same charge is not too small
+ call NOCIBuild_checkSameChargesDistance(displacedMolecularSystem,displacement,skip)
+
+ if(skip) then
+ write (coordsUnit,"(A,F20.12)") "Skipping system with same charge particle separation", displacement
+ this%numberOfPPdistanceRejectedSystems=this%numberOfPPdistanceRejectedSystems+1
+ cycle
+ end if
+
+ !Check if the separation between positive and negative particles is not too big
+ call NOCIBuild_checkOppositeChargesDistance(displacedMolecularSystem,displacement,skip)
+
+ if(skip) then
+ write (coordsUnit,"(A,F20.12)") "Skipping system with positive and negative particle separation", displacement
+ this%numberOfNPdistanceRejectedSystems=this%numberOfNPdistanceRejectedSystems+1
+ cycle
+ end if
+
+ !Check if the new system is not to close to previous calculated systems - duplicate protection
+ call NOCIBuild_checkNewSystemDisplacement(this,displacedMolecularSystem,closestSystem,displacement)
+
+ if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
+ write (coordsUnit,"(A,F20.12,A,I10)") "Skipping system with distance ", displacement , "a.u. from system ", closestSystem
+ skip=.true.
+ this%numberOfEquivalentSystems=this%numberOfEquivalentSystems+1
+ cycle
+ end if
+
+ !!Copy the molecular system to the NonOrthogonalCI object
+ ! if(newSystemFlag) then
+ ! this%numberOfUniqueSystems=this%numberOfUniqueSystems+1
+ ! this%systemTypes%values(this%numberOfDisplacedSystems)=this%numberOfUniqueSystems
+ ! else
+ ! this%systemTypes%values(this%numberOfDisplacedSystems)=systemType
+ ! end if
+
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
+ ! write (coordsUnit,"(A,I5,A,I10,A,F20.12)") "Saving system of type ", this%systemTypes%values(this%numberOfDisplacedSystems) , &
+ ! " with ID ", this%numberOfDisplacedSystems, " and energy", testEnergy
+ ! else<
+ if(skip .eqv. .false.) then
+ call NOCIBuild_saveSystem(this,displacedMolecularSystem)
+ write (coordsUnit,"(A,I10)") "Saving system with ID ", this%numberOfDisplacedSystems
+ end if
+ end do
+
+ close(coordsUnit)
+
+ print *, ""
+ write (*,'(A10,I10,A)') "Mixing ", this%numberOfDisplacedSystems, " HF calculations at different geometries"
+
+ if(this%numberOfEllipsoidRejectedSystems .gt. 0) &
+ write (*,'(A10,I10,A)') "Rejected ", this%numberOfEllipsoidRejectedSystems, &
+ " geometries outside the ellipsoids area"
+
+ if(this%numberOfPPdistanceRejectedSystems .gt. 0) &
+ write (*,'(A10,I10,A,ES18.8,A,ES18.8)') "Rejected ", this%numberOfPPdistanceRejectedSystems, &
+ " geometries with separation between same charge basis sets smaller than", CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE, &
+ " or larger than", CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE
+
+ if(this%numberOfNPdistanceRejectedSystems .gt. 0) &
+ write (*,'(A10,I10,A,ES18.8)') "Rejected ", this%numberOfNPdistanceRejectedSystems, &
+ " geometries with separation between positive and negative basis sets larger than", CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE
+
+ if(this%numberOfEquivalentSystems .gt. 0) &
+ write (*,'(A10,I10,A)') "Rejected ", this%numberOfEquivalentSystems, &
+ " duplicated geometries after permutations"
+
+ print *, ""
+
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) &
+ ! call Matrix_constructorInteger(this%configurationPairTypes,int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0)
+ ! minEnergy=0.0
+
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time displacing coordinates : ", omp_get_wtime() - timeA ," (s)"
+ print *, ""
+
+ end subroutine NOCIBuild_displaceGeometries
+
+ !>
+ !! @brief Read different geometries
+ !!
+ !! @param this
+ !<
+ subroutine NOCIBuild_readGeometries(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+
+ type(MolecularSystem) :: originalMolecularSystem
+ real(8) :: origin(3)
+ character(100) :: string,coordsFile
+ integer :: coordsUnit
+ integer :: sysI,i,ii,j,mu
+ real(8) :: timeA
+ logical :: readSuccess
+
+ !$ timeA = omp_get_wtime()
+
+ call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance)
+
+ coordsUnit=333
+ coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords"
+ readSuccess=.false.
+
+ inquire(FILE = coordsFile, EXIST = readSuccess )
+ if(.not. readSuccess) then
+ print *, "Didn't find the file ", trim(coordsFile)
+ STOP "Please provide one or turn the readNOCIGeometries flag off!"
+ end if
+
+ open(unit=coordsUnit, file=trim(coordsFile), status="old", form="formatted")
+
+ read(coordsUnit,*) string, this%numberOfDisplacedSystems
+ print *, "reading ", this%numberOfDisplacedSystems, " systems"
+
+ allocate(this%molecularSystems(this%numberOfDisplacedSystems))
+
+ do sysI = 1, this%numberOfDisplacedSystems
+ call MolecularSystem_copyConstructor(molecularSystem_instance, originalMolecularSystem)
+ write(molecularSystem_instance%description,"(I10)") sysI
+ read(coordsUnit,*) string !skip line
+ read(coordsUnit,*) string !skip line
+
+ !! Print quatum species information
+ do i = 1, molecularSystem_instance%numberOfQuantumSpecies
+
+ !! Copy origins in open-shell case
+ if(trim(molecularSystem_instance%species(i)%name) .eq. "E-BETA" ) then
+ do ii = 1, i-1
+ if(trim(molecularSystem_instance%species(ii)%name) .ne. "E-ALPHA" ) cycle
+ do j = 1, size(molecularSystem_instance%species(i)%particles)
+ molecularSystem_instance%species(i)%particles(j)%origin = &
+ molecularSystem_instance%species(ii)%particles(j)%origin
+ do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length
+ molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = &
+ molecularSystem_instance%species(i)%particles(j)%origin
+ end do
+ end do
+ end do
+ cycle !skip the rest of the read
+ end if
+
+ do j = 1, size(molecularSystem_instance%species(i)%particles)
+ read(coordsUnit,*) string, origin(1), origin(2), origin(3)
+
+ molecularSystem_instance%species(i)%particles(j)%origin = origin/AMSTRONG
+ do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length
+ molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = &
+ molecularSystem_instance%species(i)%particles(j)%origin
+ end do
+ end do
+ end do
+
+ !! Point charges information
+ do i = 1, molecularSystem_instance%numberOfPointCharges
+ read(coordsUnit,*) string, origin(1), origin(2), origin(3)
+
+ molecularSystem_instance%pointCharges(i)%origin = origin/AMSTRONG
+ end do
+ call MolecularSystem_copyConstructor(this%molecularSystems(sysI), molecularSystem_instance)
+
+ end do
+
+ close(unit=coordsUnit)
+
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time reading coordinates : ", omp_get_wtime() - timeA ," (s)"
+ end subroutine NOCIBuild_readGeometries
+
+
+ !>
+ !! @brief Apply the transformation (translation or rotation) given by transformationCounter to each center, based in the originalMolecularSystemPositions the result is saved in molecularSystemInstance
+ !! @param this,transformationCounter,originalMolecularSystem
+ !<
+ subroutine NOCIBuild_transformCoordinates(this,transformationCounter,originalMolecularSystem,displacedMolecularSystem,skip)
+ type(NonOrthogonalCI) :: this
+ integer :: transformationCounter(*)
+ type(MolecularSystem) :: originalMolecularSystem
+ type(MolecularSystem), target :: displacedMolecularSystem
+ logical, intent(out) :: skip
+
+ real(8) :: centerX, centerY, centerZ, displacedOrigin(3), distanceCheck, distanceToCenter, angle, maxAngle
+ integer :: center, displacementId
+ real(8),allocatable :: X(:), Y(:), Z(:), W(:)
+ integer :: i,j,k,p,q,s,mu, nsteps
+ character(200) :: description
+
+ skip=.false.
+
+ call MolecularSystem_copyConstructor(displacedMolecularSystem, originalMolecularSystem)
+
+ write(displacedMolecularSystem%description, '(I10)') transformationCounter(1)
+ do i=2,this%numberOfTransformedCenters
+ write(description, '(A)') adjustl(adjustr(displacedMolecularSystem%description)//"-"//adjustl(String_convertIntegerToString(transformationCounter(i))))
+ displacedMolecularSystem%description=trim(description)
+ end do
+
+ particleManager_instance => displacedMolecularSystem%allParticles
+
+ if(trim(this%transformationType).eq."TRANSLATION") then
+
+ do center=1, this%numberOfTransformedCenters
+ do p=1, size(originalMolecularSystem%allParticles)
+ if(center.eq.originalMolecularSystem%allParticles(p)%particlePtr%translationCenter) then
+ centerX=originalMolecularSystem%allParticles(p)%particlePtr%origin(1)
+ centerY=originalMolecularSystem%allParticles(p)%particlePtr%origin(2)
+ centerZ=originalMolecularSystem%allParticles(p)%particlePtr%origin(3)
+ end if
+ end do
+
+ !!These loops update the molecular system file for each displaced geometry
+ !!ADD DIFFERENT AXIS DISPLACEMENTS!
+ displacementId=0
+ !Body centered cube
+ do i=1,CONTROL_instance%TRANSLATION_SCAN_GRID(1)*2-1
+ do j=1,CONTROL_instance%TRANSLATION_SCAN_GRID(2)*2-1
+ do k=1,CONTROL_instance%TRANSLATION_SCAN_GRID(3)*2-1
+
+ if( (mod(i,2) .eq. mod(j,2)) .and. (mod(i,2) .eq. mod(k,2)) ) then
+ displacementId=displacementId+1
+
+ if(displacementId .eq. transformationCounter(center) ) then
+
+ distanceCheck= &
+ (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/&
+ CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(1)**2+&
+ (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/&
+ CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(2)**2+&
+ (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/&
+ CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(3)**2
+
+ if(distanceCheck .gt. 1.0) then
+ skip=.true.
+ ! return
+ end if
+
+ distanceCheck= &
+ (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/&
+ CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(1)**2+&
+ (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/&
+ CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(2)**2+&
+ (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/&
+ CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(3)**2
+
+ if(distanceCheck .lt. 1.0) then
+ skip=.true.
+ ! return
+ end if
+
+ displacedOrigin(1)=centerX+CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0)
+ displacedOrigin(2)=centerY+CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0)
+ displacedOrigin(3)=centerZ+CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0)
+
+ do p=1, size(displacedMolecularSystem%allParticles)
+ if(center.eq.displacedMolecularSystem%allParticles(p)%particlePtr%translationCenter) then
+ ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin )
+ displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin
+ do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length
+ displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin
+ end do
+ end if
+ end do
+
+ ! write(*, '(3I5,F4.1,A,F4.1,A,F4.1)') i,j,k, &
+ ! (i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0," ", &
+ ! (j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0," ", &
+ ! (k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0
+ end if
+ end if
+ end do
+ end do
+ end do
+
+ end do
+
+ else if(trim(this%transformationType).eq."ROTATION") then
+
+ allocate(X(CONTROL_instance%ROTATIONAL_SCAN_GRID),&
+ Y(CONTROL_instance%ROTATIONAL_SCAN_GRID),&
+ Z(CONTROL_instance%ROTATIONAL_SCAN_GRID),&
+ W(CONTROL_instance%ROTATIONAL_SCAN_GRID))
+
+ call Lebedev_angularGrid(X(:),Y(:),Z(:),W(:),CONTROL_instance%ROTATIONAL_SCAN_GRID)
+
+ do center=1, this%numberOfTransformedCenters
+ displacementId=0
+
+ do i=1,CONTROL_instance%ROTATIONAL_SCAN_GRID
+ do j=1,CONTROL_instance%NESTED_ROTATIONAL_GRIDS
+ displacementId=displacementId+1
+ if(displacementId .eq. transformationCounter(center) ) then
+ do p=1, size(displacedMolecularSystem%allParticles)
+ if(this%rotationCenterList(p,1).eq. center ) then
+
+ do q=1, size(originalMolecularSystem%allParticles)
+ if(this%rotationCenterList(q,1) .eq. center ) then
+ centerX=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(1)
+ centerY=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(2)
+ centerZ=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(3)
+ end if
+ end do
+
+ distanceToCenter=sqrt((originalMolecularSystem%allParticles(p)%particlePtr%origin(1)-centerX)**2 &
+ +(originalMolecularSystem%allParticles(p)%particlePtr%origin(2)-centerY)**2 &
+ +(originalMolecularSystem%allParticles(p)%particlePtr%origin(3)-centerZ)**2)
+
+ distanceToCenter=distanceToCenter+&
+ CONTROL_instance%NESTED_GRIDS_DISPLACEMENT*(j-(CONTROL_instance%NESTED_ROTATIONAL_GRIDS+1)/2.0)
+
+ displacedOrigin(1)=centerX+X(i)*distanceToCenter
+ displacedOrigin(2)=centerY+Y(i)*distanceToCenter
+ displacedOrigin(3)=centerZ+Z(i)*distanceToCenter
+
+ ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin )
+ displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin
+ do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length
+ displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin
+ end do
+ end if
+ end do
+ end if
+ end do
+ end do
+ end do
+ else if(trim(this%transformationType).eq."ROTATION_AROUND_Z") then
+
+ do center=1, this%numberOfTransformedCenters
+ displacementId=0
+
+ maxAngle=CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE
+ nsteps=this%numberOfIndividualTransformations
+
+ do i=1, nsteps
+ ! do j=1,CONTROL_instance%NESTED_ROTATIONAL_GRIDS
+ displacementId=displacementId+1
+ if(displacementId .eq. transformationCounter(center) ) then
+ angle=(i-1)*CONTROL_instance%ROTATION_AROUND_Z_STEP*Math_PI/180
+ do s = 1, originalMolecularSystem%numberOfQuantumSpecies
+ do p = 1, size(originalMolecularSystem%species(s)%particles)
+
+ centerX=originalMolecularSystem%species(s)%particles(p)%origin(1)
+ centerY=originalMolecularSystem%species(s)%particles(p)%origin(2)
+ centerZ=originalMolecularSystem%species(s)%particles(p)%origin(3)
+
+ ! distanceToCenter=sqrt((originalMolecularSystem%allParticles(p)%particlePtr%origin(1)-centerX)**2 &
+ ! +(originalMolecularSystem%allParticles(p)%particlePtr%origin(2)-centerY)**2)
+
+ displacedOrigin(1)=centerX*cos(angle) - centerY*sin(angle)
+ displacedOrigin(2)=centerX*sin(angle) + centerY*cos(angle)
+ displacedOrigin(3)=centerZ
+
+ ! distanceToCenter=distanceToCenter+&
+ ! CONTROL_instance%NESTED_GRIDS_DISPLACEMENT*(j-(CONTROL_instance%NESTED_ROTATIONAL_GRIDS+1)/2.0)
+
+ ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin )
+ displacedMolecularSystem%species(s)%particles(p)%origin=displacedOrigin
+ do mu = 1, displacedMolecularSystem%species(s)%particles(p)%basis%length
+ displacedMolecularSystem%species(s)%particles(p)%basis%contraction(mu)%origin = displacedOrigin
+ end do
+ end do
+ end do
+ end if
+ ! end do
+ end do
+ end do
+ end if
+
+ end subroutine NOCIBuild_transformCoordinates
+
+ !>
+ !! @brief Computes the distance between the particles of latest generated molecular system with all the previous saved ones
+ !!
+ !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles
+ !<
+ subroutine NOCIBuild_checkNewSystemDisplacement(this,newMolecularSystem,closestSystem,displacement)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ type(MolecularSystem) :: newMolecularSystem
+ integer :: closestSystem
+ real(8) :: displacement
+
+ integer :: sysI, i
+ type(Vector), allocatable :: displacementVector(:)
+ real(8) :: dispSum
+
+ displacement=1.0E8
+
+ allocate(displacementVector(newMolecularSystem%numberOfQuantumSpecies))
+
+ do sysI=1, this%numberOfDisplacedSystems
+
+ call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), newMolecularSystem, displacementVector)
+
+ dispSum=0.0
+ do i=1, newMolecularSystem%numberOfQuantumSpecies
+ dispSum=dispSum+sum(displacementVector(i)%values(:))
+ end do
+ if(dispSum .lt. displacement ) then
+ displacement=dispSum
+ closestSystem=sysI
+ if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) exit
+ end if
+ end do
+
+ deallocate(displacementVector)
+
+ end subroutine NOCIBuild_checkNewSystemDisplacement
+
+
+ !>
+ !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with opposite charge
+ !!
+ !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles
+ !<
+ subroutine NOCIBuild_checkOppositeChargesDistance(molSys,minNPDistance,skip)
+ implicit none
+ type(MolecularSystem) :: molSys
+ real(8) :: minNPDistance
+ logical :: skip
+
+ integer :: p,q
+ real(8) :: npDistance
+
+
+ minNPDistance=1E8
+ do p=1, size(molSys%allParticles)-1
+ if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. &
+ molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle
+ do q=p+1, size(molSys%allParticles)
+ if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. &
+ molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle
+ if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .gt. 0.0 ) cycle
+ npDistance=sqrt(&
+ (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+&
+ (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+&
+ (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2)
+ if(npDistance .lt. minNPDistance) minNPDistance=npDistance
+ end do
+ end do
+
+ if(minNPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE) skip=.true.
+
+ end subroutine NOCIBuild_checkOppositeChargesDistance
+
+ !>
+ !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with the same charge
+ !!
+ !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles
+ !<
+ subroutine NOCIBuild_checkSameChargesDistance(molSys,distance,skip)
+ implicit none
+ type(MolecularSystem) :: molSys
+ real(8) :: distance
+ logical :: skip
+
+ real(8) :: minPPDistance
+
+ integer :: p,q
+ real(8) :: ppDistance
+
+
+ minPPDistance=1.0E8
+ do p=1, size(molSys%allParticles)-1
+ if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. &
+ molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle
+ do q=p+1, size(molSys%allParticles)
+ if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. &
+ molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle
+ if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .lt. 0.0 ) cycle
+
+ ppDistance=sqrt(&
+ (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+&
+ (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+&
+ (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2)
+ if(ppDistance .lt. minPPDistance) minPPDistance=ppDistance
+
+ end do
+ end do
+
+ if(minPPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE) skip=.true.
+ if(minPPDistance .lt. CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE) skip=.true.
+
+ end subroutine NOCIBuild_checkSameChargesDistance
+
+ !>
+ !! @brief Classify the new system by comparing its distance matrix to previosly saved systems
+ !!
+ !! @param this, systemType: integer defining system equivalence type, newSystemFlag: returns if the system is new or not
+ !<
+ ! subroutine NOCIBuild_classifyNewSystem(this, systemType, newSystemFlag)
+ ! implicit none
+ ! type(NonOrthogonalCI) :: this
+ ! integer :: systemType
+ ! logical :: newSystemFlag
+
+ ! type(MolecularSystem) :: currentMolecularSystem
+ ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix
+
+ ! integer :: sysI, i, checkingType
+ ! logical :: match
+
+ ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance)
+ ! systemType=0
+ ! newSystemFlag=.true.
+ ! currentDistanceMatrix=ParticleManager_getDistanceMatrix()
+
+ ! ! print *, "Current distance matrix"
+ ! ! call Matrix_show(currentDistanceMatrix)
+
+ ! types: do checkingType=1, this%numberOfUniqueSystems
+ ! ! print *, "checkingType", checkingType
+ ! systems: do sysI=1, this%numberOfDisplacedSystems
+
+ ! if(this%systemTypes%values(sysI) .eq. checkingType) then
+ ! call MolecularSystem_copyConstructor(molecularSystem_instance, this%molecularSystems(sysI))
+
+ ! previousDistanceMatrix=ParticleManager_getDistanceMatrix()
+
+ ! ! print *, "Comparing with previous distance matrix", checkingType
+ ! ! call Matrix_show(previousDistanceMatrix)
+
+ ! match=.true.
+ ! do i=1, size(currentDistanceMatrix%values(:,1))
+ ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. &
+ ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
+ ! match=.false.
+ ! exit
+ ! end if
+ ! end do
+
+ ! ! print *, "match?", match
+
+ ! if(match) then
+ ! systemType=this%systemTypes%values(sysI)
+ ! newSystemFlag=.false.
+ ! exit types
+ ! else
+ ! cycle types
+ ! end if
+ ! end if
+ ! end do systems
+ ! end do types
+
+ ! ! print *, "newSystemFlag", newSystemFlag
+
+ ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem)
+
+ ! end subroutine NOCIBuild_classifyNewSystem
+
+
+ ! >
+ ! @brief Saves molecular system and wfn files for a displaced system
+
+ ! @param systemID
+ ! <
+ subroutine NOCIBuild_saveSystem(this, newSystem)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ type(MolecularSystem) :: newSystem
+
+ type(MolecularSystem), allocatable :: tempMolecularSystems(:)
+ integer :: i
+
+ !!Increase the size of the molecular systems array by 1
+ this%numberOfDisplacedSystems=this%numberOfDisplacedSystems+1
+
+ allocate(tempMolecularSystems(size(this%MolecularSystems)))
+
+ do i=1, size(this%MolecularSystems)
+ call MolecularSystem_copyConstructor(tempMolecularSystems(i),this%MolecularSystems(i))
+ end do
+
+ deallocate(this%MolecularSystems)
+ allocate(this%MolecularSystems(this%numberOfDisplacedSystems))
+
+ do i=1, size(tempMolecularSystems)
+ call MolecularSystem_copyConstructor(this%MolecularSystems(i),tempMolecularSystems(i))
+ end do
+
+ deallocate(tempMolecularSystems)
+ !!Copy the molecular system to the NonOrthogonalCI object
+
+ call MolecularSystem_copyConstructor(this%MolecularSystems(this%numberOfDisplacedSystems), newSystem)
+
+ end subroutine NOCIBuild_saveSystem
+
+ !>
+ !! @brief Classify the sysI and sysII pair according to their distance matrix
+ !!
+ !! @param sysI and sysII: molecular system indices.
+ !<
+ ! subroutine NOCIBuild_classifyConfigurationPair(this,currentSysI,currentSysII,newPairFlag)
+ ! implicit none
+ ! type(NonOrthogonalCI) :: this
+ ! integer :: currentSysI, currentSysII !Indices of the systems to classify
+ ! logical :: newPairFlag
+
+ ! type(MolecularSystem) :: currentMolecularSystem
+ ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix
+
+ ! integer :: sysI, sysII, i, checkingType
+ ! logical :: match
+
+ ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance)
+ ! newPairFlag=.true.
+ ! currentDistanceMatrix=ParticleManager_getDistanceMatrix()
+
+ ! ! print *, "Current distance matrix"
+ ! ! call Matrix_show(currentDistanceMatrix)
+
+ ! types: do checkingType=1, this%numberOfUniquePairs
+ ! ! print *, "checkingType", checkingType
+ ! systemI: do sysI=1, currentSysI
+ ! systemII: do sysII=sysI+1, currentSysII
+
+ ! if(sysI .eq. currentSysI .and. sysII .eq. currentSysII ) cycle types
+
+ ! if((this%configurationPairTypes%values(sysI,sysII) .eq. checkingType) .and. &
+ ! (this%systemTypes%values(sysI) .eq. this%systemTypes%values(currentSysI)) .and. &
+ ! (this%systemTypes%values(sysII) .eq. this%systemTypes%values(currentSysII))) then
+
+ ! ! call MolecularSystem_mergeTwoSystems(molecularSystem_instance, this%MolecularSystems(sysI), this%MolecularSystems(sysII))
+
+ ! previousDistanceMatrix=ParticleManager_getDistanceMatrix()
+
+ ! ! print *, "Comparing with previous distance matrix", checkingType
+ ! ! call Matrix_show(previousDistanceMatrix)
+
+ ! match=.true.
+ ! do i=1, size(currentDistanceMatrix%values(:,1))
+ ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. &
+ ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
+ ! match=.false.
+ ! exit
+ ! end if
+ ! end do
+
+ ! if(match) then
+ ! newPairFlag=.false.
+ ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%configurationPairTypes%values(sysI,sysII)
+ ! exit types
+ ! else
+ ! cycle types
+ ! end if
+ ! end if
+ ! end do systemII
+ ! end do systemI
+ ! end do types
+
+ ! if(newPairFlag) then
+ ! this%numberOfUniquePairs=this%numberOfUniquePairs+1
+ ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%numberOfUniquePairs
+ ! end if
+
+ ! if(this%configurationPairTypes%values(currentSysI,currentSysII).eq.0) then
+ ! print *, "newPairFlag", newPairFlag
+ ! print *, currentSysI, currentSysII, this%configurationPairTypes%values(currentSysI,currentSysII)
+ ! STOP "I found a type zero"
+ ! end if
+ ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem)
+
+ ! end subroutine NOCIBuild_classifyConfigurationPair
+
+end module NOCIBuild_
+
diff --git a/src/NOCI/NOCIFranckCondon.f90 b/src/NOCI/NOCIFranckCondon.f90
new file mode 100644
index 00000000..a0a923d7
--- /dev/null
+++ b/src/NOCI/NOCIFranckCondon.f90
@@ -0,0 +1,503 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module NOCIFranckCondon_
+ use NOCIBuild_
+ use NOCIMatrices_
+ use MolecularSystem_
+ use Matrix_
+ use Vector_
+ use DirectIntegralManager_
+ use omp_lib
+ implicit none
+
+ !>
+ !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
+ !!
+ !! @author Felix
+ !!
+ !! Creation data : 02-22
+ !!
+ !! History change:
+ !!
+ !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# Creation of the module.
+ !!
+ !<
+
+ public :: &
+ NOCIFranckCondon_computeFranckCondon
+
+ private
+
+contains
+
+ !>
+ !! @brief Compute Franck-Condon factors from the current NOCI calculations and previous results read from file
+ !!
+ !! @param
+ !<
+ subroutine NOCIFranckCondon_computeFranckCondon(this)
+ type(NonOrthogonalCI) :: this
+ integer :: nociUnit, numberOfSpecies, occupationNumber,numberOfDisplacedSystems, numberOfContractions, dim2
+ character(100) :: nociFile
+ type(Matrix) :: ciCoefficients
+ type(Vector) :: ciEnergies
+ type(Matrix), allocatable :: auxCoefficients(:), superMergedCoefficients(:)
+ type(IVector), allocatable :: sysListCur(:,:), sysListRef(:,:), orbListI(:), orbListII(:)
+ type(IVector) :: auxIVector
+ type(MolecularSystem) :: superMergedMolecularSystem
+ logical :: existFile
+ type(Matrix) :: molecularOverlapMatrix
+ type(Matrix), allocatable :: superOverlapMatrix(:), superMomentMatrix(:,:), inverseOverlapMatrix(:), molecularMomentMatrix(:,:) !,attractionMatrix(:), externalPotMatrix(:)
+ integer :: stateI, stateII
+ integer :: i,ii,j,jj,k,mu,nu,mumu,nunu,sysI, sysII, speciesID, otherSpeciesID
+ integer :: particlesPerOrbital
+ real(8) :: overlapDeterminant, trololo, trolololo(3), pointchargesdipole(3)
+
+ integer :: densUnit
+ character(100) :: densFile
+ character(50) :: arguments(2), auxString
+ type(Matrix), allocatable :: franckCondonMatrix(:), transitionDipoleMatrix(:,:), refCurOverlapMatrix(:), refCurMomentMatrix(:,:)
+ type(Matrix) :: refCurTotalOverlap
+ real(8) :: timeA
+
+ !$ timeA = omp_get_wtime()
+
+ existFile=.false.
+
+ nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI"
+ inquire( FILE = trim(nociFile)//".sys", EXIST = existFile )
+
+ if(.not. existFile) return
+ print *, "Found a reference molecular system for NOCI calculations ", trim(nociFile)//".sys"
+
+ pointchargesdipole=0.0
+ do i=1, size( MolecularSystem_instance%pointCharges )
+ pointchargesdipole = pointchargesdipole + MolecularSystem_instance%pointCharges(i)%origin(:) * MolecularSystem_instance%pointCharges(i)%charge
+ end do
+
+
+ call MolecularSystem_loadFromFile("LOWDIN.SYS",nociFile)
+ call MolecularSystem_showInformation()
+ call MolecularSystem_showParticlesInformation()
+ call MolecularSystem_showCartesianMatrix()
+
+ nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI.states"
+ inquire( FILE = trim(nociFile), EXIST = existFile )
+
+ if(.not. existFile) then
+ print *, "Did not find reference states for NOCI calculations ", nociFile
+ return
+ end if
+ print *, "Found reference states for NOCI calculations ", nociFile
+ print *, "Computing the Franck-Condon factors with respect to that system"
+
+ nociUnit=123
+ open(unit = nociUnit, file=trim(nociFile), status="old", form="unformatted")
+
+ arguments(1) = "NOCI-NUMBEROFSPECIES"
+ call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) )
+
+ arguments(1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS"
+ call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfDisplacedSystems, arguments=arguments(1:1) )
+
+ allocate(auxCoefficients(numberOfSpecies))
+ allocate(sysListCur(numberOfDisplacedSystems,numberOfSpecies),sysListRef(numberOfDisplacedSystems,numberOfSpecies))
+ allocate(orbListI(numberOfDisplacedSystems),orbListII(numberOfDisplacedSystems))
+ allocate(superMergedCoefficients(numberOfSpecies))
+ allocate(superOverlapMatrix(numberOfSpecies), superMomentMatrix(numberOfSpecies,3),inverseOverlapMatrix(numberOfSpecies),molecularMomentMatrix(numberOfSpecies,3))
+ allocate(franckCondonMatrix(numberOfSpecies),transitionDipoleMatrix(numberOfSpecies+1,3),refCurOverlapMatrix(numberOfSpecies),refCurMomentMatrix(numberOfSpecies,3))
+
+ arguments(1) = "NOCI-CONFIGURATIONCOEFFICIENTS"
+ ciCoefficients = Matrix_getFromFile(numberOfDisplacedSystems,numberOfDisplacedSystems,nociUnit,binary=.true.,arguments=arguments(1:1) )
+
+ arguments(1:1) = "NOCI-CONFIGURATIONENERGIES"
+ call Vector_getFromFile(numberOfDisplacedSystems, nociUnit, output=ciEnergies, binary=.true., arguments=arguments(1:1) )
+
+ arguments(1) = "MERGEDCOEFFICIENTS"
+ do speciesID=1, numberOfSpecies
+ numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID)
+ dim2=max(MolecularSystem_getTotalNumberOfContractions(speciesID),MolecularSystem_getOcupationNumber(speciesID))
+ arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
+ auxCoefficients(speciesID) = Matrix_getFromFile(numberOfContractions,dim2,nociUnit,binary=.true.,arguments=arguments(1:2) )
+ end do
+
+ do sysI=1, numberOfDisplacedSystems
+ do speciesID=1, numberOfSpecies
+ numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID)
+ write(auxString,*) sysI
+ arguments(1) = "SYSBASISLIST"//trim(auxString)
+ arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
+ call Vector_getFromFileInteger(numberOfContractions, nociUnit, output=sysListRef(sysI,speciesID), binary=.true., arguments=arguments(1:2) )
+ end do
+ end do
+
+ close(nociUnit)
+
+ !Create a super-mega molecular system
+ !Merge coefficients from NOCI calculation and reference system
+
+ print *, "super-mega molecular system"
+ call MolecularSystem_mergeTwoSystems(superMergedMolecularSystem, this%mergedMolecularSystem, MolecularSystem_instance, &
+ orbListI(:),orbListII(:), reorder=.false.)
+ call MolecularSystem_showInformation(superMergedMolecularSystem)
+ call MolecularSystem_showParticlesInformation(superMergedMolecularSystem)
+ call MolecularSystem_showCartesianMatrix(superMergedMolecularSystem)
+
+ call NOCIMatrices_mergeCoefficients(this%mergedCoefficients(:),auxCoefficients(:),&
+ this%mergedMolecularSystem,MolecularSystem_instance,superMergedMolecularSystem,&
+ orbListI(:),orbListII(:),superMergedCoefficients(:))
+
+ ! do speciesID=1, numberOfSpecies
+ ! print *, "superMergedCoefficients", speciesID
+ ! call Matrix_show(superMergedCoefficients(speciesID))
+ ! end do
+
+ !Fix basis list size
+ do speciesID=1, numberOfSpecies
+ ! print *, "orbListI", "speciesID", speciesID
+ ! call Vector_showInteger(orbListI(speciesID))
+ do sysI=1, this%numberOfDisplacedSystems
+ call Vector_copyConstructorInteger(auxIVector,this%sysBasisList(sysI,speciesID))
+ call Vector_constructorInteger(sysListCur(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0)
+ do i=1, size(auxIVector%values)
+ if(orbListI(speciesID)%values(i) .eq. 0) cycle
+ sysListCur(sysI,speciesID)%values(i)=auxIVector%values(orbListI(speciesID)%values(i))
+ end do
+ ! print *, "sysListCur", "sysI", sysI, "speciesID", speciesID
+ ! call Vector_showInteger(sysListCur(sysI,speciesID))
+ end do
+ end do
+
+ do speciesID=1, numberOfSpecies
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems
+ ! print *, "orbListII", "speciesID", speciesID
+ ! call Vector_showInteger(orbListII(speciesID))
+ do sysII=1, numberOfDisplacedSystems
+ call Vector_copyConstructorInteger(auxIVector,sysListRef(sysII,speciesID))
+ call Vector_constructorInteger(sysListRef(sysII,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0)
+ do i=1, size(orbListII(speciesID)%values)
+ if(orbListII(speciesID)%values(i) .eq. 0) cycle
+ sysListRef(sysII,speciesID)%values(i)=auxIVector%values(orbListII(speciesID)%values(i))
+ end do
+ ! print *, "sysListRef", "sysII", sysII, "speciesID", speciesID
+ ! call Vector_showInteger(sysListRef(sysII,speciesID))
+ end do
+ end do
+
+ ! if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
+
+ ! numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
+
+
+ print *, ""
+ print *, "Computing overlap and moment integrals for the super-mega system..."
+ print *, ""
+ do speciesID = 1, numberOfSpecies
+ call DirectIntegralManager_getOverlapIntegrals(superMergedMolecularSystem,speciesID,superOverlapMatrix(speciesID))
+ call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,1,superMomentMatrix(speciesID,1))
+ call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,2,superMomentMatrix(speciesID,2))
+ call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,3,superMomentMatrix(speciesID,3))
+ end do
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)"
+ !$ timeA = omp_get_wtime()
+
+ print *, ""
+ print *, "Self overlap matrices for the supermegaposed systems..."
+ print *, ""
+
+ do speciesID=1, numberOfSpecies
+ call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), &
+ int(numberOfDisplacedSystems,8), 1.0_8)
+ end do
+ !!Fill the merged density matrix
+ !!"Non Diagonal" terms - system pairs
+ do sysI=1, numberOfDisplacedSystems !computed
+ do sysII=1, numberOfDisplacedSystems !reference
+ ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle
+ !!Compute molecular overlap matrix and its inverse
+ do speciesID=1, numberOfSpecies
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
+ call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+ ! call Matrix_constructor(inverseOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+
+ do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI
+ if(sysListRef(sysI,speciesID)%values(mu) .eq. 0) cycle
+ do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII
+ if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle
+ do i = 1 , occupationNumber
+ ii=occupationNumber*(sysI-1)+i+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2
+ do j = 1 , occupationNumber
+ jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2
+ ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),&
+ ! superMergedCoefficients(speciesID)%values(nu,jj),&
+ ! superOverlapMatrix(speciesID)%values(mu,nu)
+ molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+&
+ superMergedCoefficients(speciesID)%values(mu,ii)*&
+ superMergedCoefficients(speciesID)%values(nu,jj)*&
+ superOverlapMatrix(speciesID)%values(mu,nu)
+ end do
+ end do
+ end do
+ end do
+ if(occupationNumber .ne. 0) then
+ ! inverseOverlapMatrix=Matrix_inverse(molecularOverlapMatrix)
+ ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII
+ ! call Matrix_show(inverseOverlapMatrices(speciesID))
+ call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU")
+ ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant
+ else
+ overlapDeterminant=1.0
+ end if
+ refCurOverlapMatrix(speciesID)%values(sysI,sysII)=refCurOverlapMatrix(speciesID)%values(sysI,sysII)*overlapDeterminant**particlesPerOrbital
+ end do
+
+ end do
+ end do
+
+ do speciesID=1, numberOfSpecies
+ print *, "Reference Overlap Matrix for", speciesID
+ call Matrix_show(refCurOverlapMatrix(speciesID))
+ end do
+
+ print *, ""
+ print *, "Building Franck-Condon matrices for the superposed systems..."
+ print *, ""
+
+ do speciesID=1, numberOfSpecies
+ call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), &
+ int(numberOfDisplacedSystems,8), 1.0_8)
+ do k=1,3
+ call Matrix_constructor(refCurMomentMatrix(speciesID,k), int(this%numberOfDisplacedSystems,8), &
+ int(numberOfDisplacedSystems,8), 0.0_8)
+ end do
+ end do
+ call Matrix_constructor(refCurTotalOverlap, int(this%numberOfDisplacedSystems,8), &
+ int(numberOfDisplacedSystems,8), 1.0_8)
+
+ !!Fill the merged density matrix
+ !!"Non Diagonal" terms - system pairs
+ do sysI=1, this%numberOfDisplacedSystems !computed
+ do sysII=1, numberOfDisplacedSystems !reference
+ ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle
+ !!Compute molecular overlap matrix and its inverse
+ do speciesID=1, numberOfSpecies
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
+ call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+ do k=1,3
+ call Matrix_constructor(molecularMomentMatrix(speciesID,k), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+ end do
+
+ do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI
+ if(sysListCur(sysI,speciesID)%values(mu) .eq. 0) cycle
+ do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII
+ if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle
+ do i = 1 , occupationNumber
+ ii=occupationNumber*(sysI-1)+i
+ do j = 1 , occupationNumber
+ jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2
+ ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),&
+ ! superMergedCoefficients(speciesID)%values(nu,jj),&
+ ! superOverlapMatrix(speciesID)%values(mu,nu)
+ molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+&
+ superMergedCoefficients(speciesID)%values(mu,ii)*&
+ superMergedCoefficients(speciesID)%values(nu,jj)*&
+ superOverlapMatrix(speciesID)%values(mu,nu)
+ do k=1,3
+ molecularMomentMatrix(speciesID,k)%values(i,j)=molecularMomentMatrix(speciesID,k)%values(i,j)+&
+ superMergedCoefficients(speciesID)%values(mu,ii)*&
+ superMergedCoefficients(speciesID)%values(nu,jj)*&
+ superMomentMatrix(speciesID,k)%values(mu,nu)
+ end do
+ end do
+ end do
+ end do
+ end do
+ if(occupationNumber .ne. 0) then
+ inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix)
+ ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII
+ ! call Matrix_show(inverseOverlapMatrices(speciesID))
+ call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU")
+ ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant
+ refCurOverlapMatrix(speciesID)%values(sysI,sysII)=overlapDeterminant**particlesPerOrbital
+ else
+ overlapDeterminant=1.0
+ end if
+ refCurTotalOverlap%values(sysI,sysII)=refCurTotalOverlap%values(sysI,sysII)*refCurOverlapMatrix(speciesID)%values(sysI,sysII)
+ end do
+
+ do speciesID=1, numberOfSpecies
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
+ do i = 1 , occupationNumber
+ do j = 1 , occupationNumber
+ do k=1,3
+ refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)+&
+ molecularMomentMatrix(speciesID,k)%values(i,j)*&
+ inverseOverlapMatrix(speciesID)%values(j,i)
+ end do
+ end do
+ end do
+ do k=1,3
+ refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)*refCurTotalOverlap%values(sysI,sysII)*particlesPerOrbital
+ end do
+ end do
+ end do
+ end do
+
+ do speciesID=1, numberOfSpecies
+ print *, "refCurOverlapMatrix(speciesID)", speciesID
+ call Matrix_show(refCurOverlapMatrix(speciesID))
+ call Matrix_constructor(franckCondonMatrix(speciesID), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8)
+ end do
+
+ !+1 For point charges
+ do speciesID=1, numberOfSpecies+1
+ do k=1,3
+ call Matrix_constructor(transitionDipoleMatrix(speciesID,k), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8)
+ end do
+ end do
+
+ do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT
+ print *, "Reference state:", stateII
+ do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT
+ print *, " current state:", stateI
+ do speciesID=1, numberOfSpecies
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems
+ print *, "occupationNumber", occupationNumber
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(1))
+ trololo=0
+ do sysI=1, this%numberOfDisplacedSystems !computed
+ do sysII=1, numberOfDisplacedSystems !reference
+ do i = 1 , occupationNumber
+ do j = 1 , occupationNumber
+ trololo = trololo + &
+ inverseOverlapMatrix(speciesID)%values(j,i)*&
+ this%configurationCoefficients%values(sysI,stateI)*&
+ ciCoefficients%values(sysII,stateII)*& !!reference
+ refCurOverlapMatrix(speciesID)%values(sysI,sysII)*&
+ particlesPerOrbital
+ end do
+ end do
+ ! refCurTotalOverlap%values(sysI,sysII)*&
+ ! franckCondonMatrix(speciesID)%values(stateI,stateII)+&
+
+ do k=1,3
+ transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) = transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) + &
+ molecularsystem_getcharge( speciesID )*&
+ this%configurationCoefficients%values(sysI,stateI)*&
+ ciCoefficients%values(sysII,stateII)*& !!reference
+ refCurMomentMatrix(speciesID,k)%values(sysI,sysII)
+ end do
+
+ end do
+ end do
+ print *, "speciesID", speciesID, "trololo", trololo
+ franckCondonMatrix(speciesID)%values(stateI,stateII)=trololo
+ franckCondonMatrix(speciesID)%values(stateI,stateII)=franckCondonMatrix(speciesID)%values(stateI,stateII)/(occupationNumber*particlesPerOrbital)
+ print *, " F.C. factor for ", molecularSystem_getNameOfSpecies(speciesID),&
+ franckCondonMatrix(speciesID)%values(stateI,stateII)
+ end do
+ do sysI=1, this%numberOfDisplacedSystems !computed
+ do sysII=1, numberOfDisplacedSystems !reference
+ do k=1,3
+ transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) = transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) + &
+ pointchargesdipole(k)*&
+ this%configurationCoefficients%values(sysI,stateI)*&
+ ciCoefficients%values(sysII,stateII)*& !!reference
+ refCurTotalOverlap%values(sysI,sysII)
+ end do
+ end do
+ end do
+ ! trololo=1
+ ! do speciesID=1, numberOfSpecies
+ ! trololo=trololo*franckCondonMatrix(speciesID)%values(stateI,stateII)
+ ! end do
+ ! print *, " F.C. factor product ", trololo
+ ! trololo=0
+ ! do speciesID=1, numberOfSpecies
+ ! trololo=trololo+franckCondonMatrix(speciesID)%values(stateI,stateII)
+ ! end do
+ ! print *, " F.C. factor sum ", trololo
+ ! trololo=0
+ ! do sysI=1, this%numberOfDisplacedSystems !computed
+ ! do sysII=1, numberOfDisplacedSystems !reference
+ ! trololo = trololo + &
+ ! this%configurationCoefficients%values(sysI,stateI)*&
+ ! ciCoefficients%values(sysII,stateII)*& !!reference
+ ! refCurTotalOverlap%values(sysI,sysII)
+ ! end do
+ ! end do
+ ! print *, " total overlap ", trololo
+ end do
+ end do
+
+ print *, "Dipole approximation spectrum"
+ do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT
+ print *, "Reference state:", stateII
+ do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT
+ trolololo=0
+ print *, "current state:", stateI
+ do speciesID=1, numberOfSpecies
+ do k=1,3
+ trolololo(k)=trolololo(k)+transitionDipoleMatrix(speciesID,k)%values(stateI,stateII)
+ end do
+ print *, " T.D. integrals for ", molecularSystem_getNameOfSpecies(speciesID),&
+ transitionDipoleMatrix(speciesID,1)%values(stateI,stateII),&
+ transitionDipoleMatrix(speciesID,2)%values(stateI,stateII),&
+ transitionDipoleMatrix(speciesID,3)%values(stateI,stateII)
+ end do
+ do k=1,3
+ trolololo(k)=trolololo(k)+transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII)
+ end do
+ print *, " T.D. integrals point charges ", &
+ transitionDipoleMatrix(numberOfSpecies+1,1)%values(stateI,stateII),&
+ transitionDipoleMatrix(numberOfSpecies+1,2)%values(stateI,stateII),&
+ transitionDipoleMatrix(numberOfSpecies+1,3)%values(stateI,stateII)
+ print *, "energy dif", ciEnergies%values(stateII)-this%statesEigenvalues%values(stateI), "total components", trolololo(1:3) ,"intensity", sqrt(sum(trolololo(1:3)**2))
+ end do
+ end do
+
+ close(densUnit)
+
+ deallocate(auxCoefficients,&
+ sysListCur,sysListRef,&
+ orbListI,orbListII,&
+ superMergedCoefficients,&
+ superOverlapMatrix,&
+ franckCondonMatrix)
+
+ end subroutine NOCIFranckCondon_computeFranckCondon
+
+
+end module NOCIFranckCondon_
+
diff --git a/src/NOCI/NOCIMatrices.f90 b/src/NOCI/NOCIMatrices.f90
new file mode 100644
index 00000000..83d424d0
--- /dev/null
+++ b/src/NOCI/NOCIMatrices.f90
@@ -0,0 +1,1625 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module NOCIMatrices_
+ use NOCIBuild_
+ use MolecularSystem_
+ use Matrix_
+ use Vector_
+ use DirectIntegralManager_
+ use Libint2Interface_
+ use omp_lib
+ implicit none
+
+ !>
+ !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
+ !!
+ !! @author Felix
+ !!
+ !! Creation data : 02-22
+ !!
+ !! History change:
+ !!
+ !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# Creation of the module.
+ !!
+ !<
+
+ public :: &
+ NOCIMatrices_buildOverlapAndHamiltonian,&
+ NOCIMatrices_diagonalize,&
+ NOCIMatrices_mergeCoefficients
+
+ private
+
+contains
+
+ !>
+ !! @brief Computes overlap and hamiltonian non orthogonal CI matrices for previously calculated molecular systems at different geometries
+ !!
+ !! @param this
+ !<
+ subroutine NOCIMatrices_buildOverlapAndHamiltonian(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ type(MolecularSystem), allocatable :: mergedMolecularSystem(:)
+ type(Libint2Interface), allocatable :: Libint2ParallelInstance(:,:)
+ integer, allocatable :: sysIbatch(:), sysIIbatch(:)
+ integer :: sysI,sysII,me,mySysI,mySysII
+ type(Matrix), allocatable :: mergedCoefficients(:), inverseOverlapMatrices(:)
+ type(IVector), allocatable :: sysIbasisList(:,:),sysIIbasisList(:,:)
+ real(8) :: overlapUpperBound
+ integer :: prescreenedElements, overlapScreenedElements
+
+ integer :: speciesID, otherSpeciesID
+ integer :: nspecies
+ integer :: ncores, batchSize, upperBound
+
+ integer :: matrixUnit
+ character(100) :: matrixFile
+ real(8) :: empiricalScaleFactor
+
+ real(8) :: timeMerging, timePrescreen, timeOverlap, timeTwoIntegrals
+ real(8) :: timeA
+ real(8) :: timeB
+
+ timePrescreen=0.0
+ timeOverlap=0.0
+ timeTwoIntegrals=0.0
+
+ print *, ""
+ print *, "A prescreening of the overlap matrix elements is performed for the heavy species"
+ write (*,'(A,ES8.1)') "Overlap and Hamiltonian matrix elements are saved for pairs with overlap higher than",&
+ CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD
+ print *, "For pairs with lower overlap, setting H(I,II)=0, S(I,II)=0"
+ print *, ""
+
+ prescreenedElements=0
+ overlapScreenedElements=0
+
+ matrixUnit=290
+ matrixFile= trim(CONTROL_instance%INPUT_FILE)//"NOCI-Matrix.ci"
+
+ print *, "computing NOCI overlap and hamiltonian matrices... saving them to ", trim(matrixFile)
+
+ open(unit=matrixUnit, file=trim(matrixFile), status="replace", form="formatted")
+
+ write (matrixUnit,'(A20,I20)') "MatrixSize", this%numberOfDisplacedSystems
+ write (matrixUnit,'(A10,A10,A20,A20)') "Conf. ", "Conf. ", "Overlap ","Hamiltonian "
+ !Save diagonal elements
+ do sysI=1,this%numberOfDisplacedSystems
+ this%configurationOverlapMatrix%values(sysI,sysI)=1.0
+ write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') sysI, sysI, &
+ this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI)
+ end do
+
+ !Allocate objets to distribute in parallel
+ nspecies=this%molecularSystems(1)%numberOfQuantumSpecies
+ ncores=CONTROL_instance%NUMBER_OF_CORES
+ batchSize=this%numberOfDisplacedSystems
+ print *, "ncores", ncores, "batchsize", batchSize
+
+ allocate(mergedMolecularSystem(batchSize),&
+ mergedCoefficients(nspecies),&
+ inverseOverlapMatrices(nspecies),&
+ Libint2ParallelInstance(nspecies,batchSize),&
+ sysIbatch(batchSize),&
+ sysIIbatch(batchSize),&
+ sysIbasisList(nspecies,batchSize),&
+ sysIIbasisList(nspecies,batchSize))
+
+ if(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
+ upperBound=1
+ this%printMatrixThreshold=this%numberOfDisplacedSystems
+ else
+ upperBound=this%numberOfDisplacedSystems
+ end if
+ ! print *, "upperBound", upperBound
+
+ sysI=1
+ sysII=1
+
+ systemLoop: do while((sysI.le.upperBound .and. sysII.le.this%numberOfDisplacedSystems))
+ ! print *, "distributing sysI ", sysI, " sysII ", sysII, " into", batchSize, " batches"
+ !In serial, prepare systems
+ sysIbatch(:)=0
+ sysIIbatch(:)=0
+ me=0
+ mySysI=sysI
+ mySysII=sysII
+
+ do while(me.lt.batchSize)
+ mySysII=mySysII+1
+ if(mySysII .gt. this%numberOfDisplacedSystems) then
+ mySysI=mySysI+1
+ mySysII=mySysI+1
+ if(mySysI .gt. upperBound .or. mySysII .gt. this%numberOfDisplacedSystems) exit
+ end if
+
+ ! print *, "checking prescreening of elements", mySysI, mySysII
+ !$ timeA = omp_get_wtime()
+ !Estimates overlap with a 1s-1s integral approximation
+ call NOCIMatrices_prescreenOverlap(this,mySysI,mySysII,overlapUpperBound)
+
+ if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. &
+ overlapUpperBound .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then
+ ! print *, "preskipping elements", mySysI, mySysII, "with overlap estimated as", overlapUpperBound
+ prescreenedElements=prescreenedElements+1
+ else
+ !$ timeB = omp_get_wtime()
+ !$ timePrescreen=timePrescreen+(timeB - timeA)
+ me=me+1
+ sysIbatch(me)=mySysI
+ sysIIbatch(me)=mySysII
+ !$ timeA = omp_get_wtime()
+ !This generates a new molecular system
+ ! print *, "Merging systems from geometries ", mySysI, mySysII
+ call MolecularSystem_mergeTwoSystems(mergedMolecularSystem(me), &
+ this%molecularSystems(mySysI), this%molecularSystems(mySysII),sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me))
+ ! call MolecularSystem_showInformation()
+ ! call MolecularSystem_showParticlesInformation()
+ ! call MolecularSystem_showCartesianMatrix(mergedMolecularSystem)
+ call DirectIntegralManager_constructor(Libint2ParallelInstance(1:nspecies,me),mergedMolecularSystem(me))
+ !$ timeB = omp_get_wtime()
+ !$ timeMerging=timeMerging+(timeB - timeA)
+
+ end if
+ end do
+
+ !In parallel, fill matrices
+
+ call OMP_set_num_threads(ncores)
+ !$omp parallel &
+ !$omp& private(mySysI,mySysII,mergedCoefficients,inverseOverlapMatrices),&
+ !$omp& shared(this,sysI,sysII,matrixUnit,prescreenedElements,overlapScreenedElements,sysIbasisList,sysIIbasisList,mergedMolecularSystem,Libint2ParallelInstance,nspecies,batchSize)
+ !$omp do schedule(dynamic,10)
+ procs: do me=1, batchSize
+ mySysI=sysIbatch(me)
+ mySysII=sysIIbatch(me)
+ if(mySysI .eq. 0 .or. mySysII .eq. 0) cycle procs
+
+ ! print *, "evaluating S and H elements for", mySysI, mySysII
+
+ !! Merge occupied coefficients into a single matrix
+ call NOCIMatrices_mergeCoefficients(this%HFCoefficients(mySysI,:),this%HFCoefficients(mySysII,:),&
+ this%molecularSystems(mySysI),this%molecularSystems(mySysII),mergedMolecularSystem(me),&
+ sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),mergedCoefficients)
+ !$ timeA = omp_get_wtime()
+
+ call NOCIMatrices_computeOverlapAndHCoreElements(this,mySysI,mySysII,mergedMolecularSystem(me),mergedCoefficients,&
+ sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),inverseOverlapMatrices)
+ !$ timeB = omp_get_wtime()
+ !$ timeOverlap=timeOverlap+(timeB - timeA)
+
+ !! SKIP ENERGY EVALUATION IF OVERLAP IS TOO LOW
+
+ if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. &
+ abs(this%configurationOverlapMatrix%values(mySysI,mySysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then
+ ! print *, "screening elements", mySysI, mySysII, "with overlap", this%configurationOverlapMatrix%values(mySysI,mySysII)
+ this%configurationOverlapMatrix%values(mySysI,mySysII)=0.0
+ this%configurationHamiltonianMatrix%values(mySysI,mySysII)=0.0
+ !$OMP ATOMIC
+ overlapScreenedElements=overlapScreenedElements+1
+ else
+
+ !$ timeA = omp_get_wtime()
+ ! print *, "evaluating twoParticlesContributions for", mySysI, mySysII
+ call NOCIMatrices_twoParticlesContributions(this,mySysI,mySysII,mergedMolecularSystem(me),&
+ inverseOverlapMatrices,mergedCoefficients,Libint2ParallelInstance(1:nspecies,me))
+
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ ! !DFT energy correction for off diagonal elements following Gao2016 - scaled average of the diagonal elements
+
+ do speciesID = 1, nspecies
+ this%configurationHamiltonianMatrix%values(mySysI,mySysII)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)-&
+ this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*&
+ (1/this%exactExchangeFraction(speciesID)-1)*&
+ (this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysI)+&
+ this%configurationExchangeMatrix(speciesID)%values(mySysII,mySysII))
+
+ this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)=this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)-&
+ this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*&
+ (1/this%exactExchangeFraction(speciesID)-1)*&
+ (this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysI)+&
+ this%configurationExchangeMatrix(speciesID)%values(mySysII,mySysII))
+
+ do otherSpeciesID = speciesID, nspecies
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)=this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)+&
+ this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*&
+ (this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysI)+&
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysII,mySysII))
+ this%configurationHamiltonianMatrix%values(mySysI,mySysII)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)+&
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)
+ end do
+ end do
+
+ ! this%configurationHamiltonianMatrix%values(mySysI,mySysII)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)+&
+ ! this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*&
+ ! (this%configurationCorrelationEnergies%values(mySysI)+&
+ ! this%configurationCorrelationEnergies%values(mySysII))
+ ! !DFT energy correction for off diagonal elements
+ ! call NOCIMatrices_getOffDiagonalDensityMatrix(this,mySysI,mySysII,mergedCoefficients,mergedMolecularSystem(me),this%configurationOverlapMatrix%values(mySysI,mySysII),&
+ ! inverseOverlapMatrices,sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me))
+ end if
+
+ !$ timeB = omp_get_wtime()
+ !$ timeTwoIntegrals=timeTwoIntegrals+(timeB - timeA)
+ end if
+
+ ! print *, "thread", omp_get_thread_num()+1,"me", me, "mySysI", " mySysII", mySysI, mySysII, "S", this%configurationOverlapMatrix%values(mySysI,mySysII), "H", this%configurationHamiltonianMatrix%values(mySysI,mySysII)
+ end do procs
+ !$omp end do nowait
+ !$omp end parallel
+
+ !In serial, symmetrize, free memory and print
+ do me=1, batchSize
+ mySysI=sysIbatch(me)
+ mySysII=sysIIbatch(me)
+
+ if(mySysI .eq. 0 .or. mySysII .eq. 0) exit systemLoop
+
+ !Yu2020 magical empirical correction
+ if(CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION .and. &
+ abs(this%configurationOverlapMatrix%values(mySysI,mySysII)) .gt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then
+ empiricalScaleFactor=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A*&
+ abs(this%configurationOverlapMatrix%values(mySysI,mySysII))**CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B/&
+ abs(this%configurationOverlapMatrix%values(mySysI,mySysII))
+ this%configurationOverlapMatrix%values(mySysI,mySysII)=&
+ this%configurationOverlapMatrix%values(mySysI,mySysII)*empiricalScaleFactor
+ this%configurationHamiltonianMatrix%values(mySysI,mySysII)=&
+ this%configurationHamiltonianMatrix%values(mySysI,mySysII)*empiricalScaleFactor
+ do speciesID=1, nspecies
+ this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII)=&
+ this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor
+ this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII)=&
+ this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor
+ this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII)=&
+ this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor
+ this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)=&
+ this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor
+ do otherSpeciesID=speciesID, nspecies
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)=&
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)*empiricalScaleFactor
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)=&
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)*empiricalScaleFactor
+ end do
+ end do
+ end if
+
+ !Symmetrize
+ this%configurationOverlapMatrix%values(mySysII,mySysI)=this%configurationOverlapMatrix%values(mySysI,mySysII)
+ this%configurationHamiltonianMatrix%values(mySysII,mySysI)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)
+
+ do speciesID=1, nspecies
+ this%configurationKineticMatrix(speciesID)%values(mySysII,mySysI)=this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII)
+ this%configurationPuntualMatrix(speciesID)%values(mySysII,mySysI)=this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII)
+ this%configurationExternalMatrix(speciesID)%values(mySysII,mySysI)=this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII)
+ this%configurationExchangeMatrix(speciesID)%values(mySysII,mySysI)=this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)
+ do otherSpeciesID=speciesID, nspecies
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysII,mySysI)=&
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysII,mySysI)=&
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)
+ end do
+ end do
+
+ write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') mySysI, mySysII, &
+ this%configurationOverlapMatrix%values(mySysI,mySysII), this%configurationHamiltonianMatrix%values(mySysI,mySysII)
+
+ if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, "Overlap element = ", this%configurationOverlapMatrix%values(mySysI,mySysII)
+ do speciesID = 1, nspecies
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ " Kinetic element = ", this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII)
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ " Puntual element = ", this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII)
+ if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ " External element = ", this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII)
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ " Hartree element = ", this%configurationHartreeMatrix(speciesID,speciesID)%values(mySysI,mySysII)
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ " Exchange element = ", this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)
+ end do
+ do speciesID=1, nspecies-1
+ do otherSpeciesID=speciesID+1, nspecies
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(mySysI)%species(otherSpeciesID)%name ) // &
+ " Hartree element = ", this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)
+ end do
+ end do
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ do speciesID=1, nspecies
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ " DFTcorrelation element = ", this%configurationDFTcorrelationMatrix(speciesID,speciesID)%values(mySysI,mySysII)
+ end do
+ do speciesID=1, nspecies
+ do otherSpeciesID=speciesID+1, nspecies-1
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(mySysI)%species(otherSpeciesID)%name ) // &
+ " DFTcorrelation element = ", this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)
+ end do
+ end do
+
+ ! write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, "Total DFT Correlation element = ", this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*&
+ ! (this%configurationCorrelationEnergies%values(mySysI)+&
+ ! this%configurationCorrelationEnergies%values(mySysII))
+ end if
+ write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, "Hamiltonian element = ", this%configurationHamiltonianMatrix%values(mySysI,mySysII)
+ print *, ""
+
+ end if
+
+ call DirectIntegralManager_destructor(Libint2ParallelInstance(1:nspecies,me))
+
+ sysI=mySysI
+ sysII=mySysII
+
+ end do
+
+ end do systemLoop
+
+ close(matrixUnit)
+
+ print *, ""
+ print *, "Configuration pairs skipped by overlap prescreening: ", prescreenedElements
+ print *, "Configuration pairs skipped by overlap screening: ", overlapScreenedElements
+ if( .not. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
+ print *, "Overlap integrals computed for ", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2&
+ -prescreenedElements, "configuration pairs"
+ print *, "Four center integrals computed for", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2&
+ -prescreenedElements-overlapScreenedElements, "configuration pairs"
+ else
+ print *, "Overlap integrals computed for ", this%numberOfDisplacedSystems&
+ -prescreenedElements, "configuration pairs"
+ print *, "Four center integrals computed for", this%numberOfDisplacedSystems&
+ -prescreenedElements-overlapScreenedElements, "configuration pairs"
+ end if
+ print *, ""
+
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for overlap prescreening : ", timePrescreen ," (s)"
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging systems : ", timeMerging ," (s)"
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for two index integrals : ", timeOverlap ," (s)"
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for four index integrals : ", timeTwoIntegrals ," (s)"
+
+ print *, ""
+
+ deallocate(mergedMolecularSystem,&
+ mergedCoefficients,&
+ inverseOverlapMatrices,&
+ Libint2ParallelInstance,&
+ sysIbatch,&
+ sysIIbatch,&
+ sysIbasisList,&
+ sysIIbasisList)
+
+ ! integer :: symmetryEquivalentElements
+ ! timeSymmetry=0.0
+ ! symmetryEquivalentElements=0
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
+ ! write (matrixUnit,'(A10,A10,A10,A20,A20)') "Conf. ", "Conf. ", "Type ", "Overlap ","Hamiltonian "
+ ! else
+ ! end if
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
+ ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysI, this%configurationPairTypes%values(sysI,sysI), &
+ ! this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI)
+ ! else
+ ! end if
+ ! write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for element symmetry : ", timeSymmetry ," (s)"
+ ! !$ timeA = omp_get_wtime()
+ ! !!Check symmetry of the element
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
+ ! call NOCIMatrices_classifyConfigurationPair(this,sysI,sysII,newPairFlag)
+ ! !$ timeB = omp_get_wtime()
+ ! !$ timeSymmetry=timeSymmetry+(timeB - timeA)
+
+ ! !!Copy results from previously computed equivalent elements
+ ! if (newPairFlag .eqv. .false.) then
+ ! do preSysI=1, sysI
+ ! do preSysII=preSysI+1, sysII
+ ! if(this%configurationPairTypes%values(preSysI,preSysII) .eq. this%configurationPairTypes%values(sysI,sysII)) then
+ ! this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(preSysI,preSysII)
+ ! this%configurationOverlapMatrix%values(sysII,sysI)=this%configurationOverlapMatrix%values(sysI,sysII)
+ ! this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(preSysI,preSysII)
+ ! this%configurationHamiltonianMatrix%values(sysII,sysI)=this%configurationHamiltonianMatrix%values(sysI,sysII)
+ ! symmetryEquivalentElements=symmetryEquivalentElements+1
+
+ ! if( this%configurationOverlapMatrix%values(sysI,sysII) .ne. 0.0) &
+ ! write (*,'(A,I10,I10,A,I10,A,ES20.12,ES20.12)') "Pair ",sysI, sysII," is type ", &
+ ! this%configurationPairTypes%values(sysI,sysII), " Overlap and Hamiltonian elements", &
+ ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII)
+
+ ! cycle systemII
+ ! end if
+ ! end do
+ ! end do
+ ! end if
+ ! end if
+ !!This is a symmetry test, assume positive phase
+ ! if( this%configurationOverlapMatrix%values(sysI,sysII) .lt. 0.0) then
+ ! this%configurationOverlapMatrix%values(sysI,sysII)=-this%configurationOverlapMatrix%values(sysI,sysII)
+ ! this%configurationOverlapMatrix%values(sysII,sysI)=-this%configurationOverlapMatrix%values(sysII,sysI)
+ ! this%configurationHamiltonianMatrix%values(sysI,sysII)=-this%configurationHamiltonianMatrix%values(sysI,sysII)
+ ! this%configurationHamiltonianMatrix%values(sysII,sysI)=-this%configurationHamiltonianMatrix%values(sysII,sysI)
+ ! end if
+
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
+ ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysII, this%configurationPairTypes%values(sysI,sysII), &
+ ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII)
+ ! else
+ ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) &
+ ! print *, "Configuration pairs skipped by symmetry equivalence: ", symmetryEquivalentElements
+
+ end subroutine NOCIMatrices_buildOverlapAndHamiltonian
+
+
+ !>
+ !! @brief Merges the occupied orbitals coefficients from two systems
+ !! @param occupationI and occupationII: Number of orbitals to merge from each matrix.
+ !! sysBasisList: array indicating which basis functions of the merged molecular system belong to sysI and sysII Merged Coefficients: Matrices for output.
+ !<
+ subroutine NOCIMatrices_mergeCoefficients(coefficientsI,coefficientsII,molecularSystemI,molecularSystemII,mergedMolecularSystem,&
+ sysIbasisList,sysIIbasisList,mergedCoefficients)
+ type(Matrix), intent(in) :: coefficientsI(*), coefficientsII(*)
+ type(MolecularSystem), intent(in) :: molecularSystemI, molecularSystemII, mergedMolecularSystem
+ type(IVector), intent(in) :: sysIbasisList(*), sysIIbasisList(*)
+ type(Matrix), intent(out) :: mergedCoefficients(*)
+
+ ! character(100) :: wfnFile
+ ! character(50) :: arguments(2)
+ ! integer :: wfnUnit
+ integer :: speciesID, i, j, mu
+
+ !! Mix coefficients of occupied orbitals of both systems
+ !!Create a dummy density matrix to lowdin.wfn file
+ ! wfnUnit = 500
+ ! wfnFile = "lowdin.wfn"
+ ! open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted")
+ do speciesID = 1, mergedMolecularSystem%numberOfQuantumSpecies
+
+ ! arguments(2) = mergedMolecularSystem%species(speciesID)%name
+
+ ! arguments(1) = "COEFFICIENTS"
+
+ ! !Max: to make the matrix square for the integral calculations for configuration pairs, and rectangular for the merged coefficients of all systems
+ call Matrix_constructor(mergedCoefficients(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), &
+ int(max(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)),8), 0.0_8 )
+
+ ! print *, "sysI coefficients for ", speciesID
+ ! call Matrix_show(coefficientsI(speciesID))
+ ! print *, "sysII coefficients for ", speciesID
+ ! call Matrix_show(coefficientsII(speciesID))
+
+ !sysI orbitals on the left columns, sysII on the right columns
+ !sysI coefficients
+ do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ if((sysIbasisList(speciesID)%values(mu) .ne. 0) ) then
+ do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)!sysI
+ mergedCoefficients(speciesID)%values(mu,i)=coefficientsI(speciesID)%values(sysIbasisList(speciesID)%values(mu),i)
+ ! print *, "sys I", mu, i, mergedCoefficients(speciesID)%values(mu,i)
+ end do
+ end if
+ end do
+
+ ! !sysII coefficients
+ do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ if((sysIIbasisList(speciesID)%values(mu) .ne. 0) ) then
+ do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemII)!sysII
+ j=MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)+i !column
+ mergedCoefficients(speciesID)%values(mu,j)=coefficientsII(speciesID)%values(sysIIbasisList(speciesID)%values(mu),i)
+ ! print *, "sys II", mu, j, mergedCoefficients(speciesID)%values(mu,j)
+ end do
+ end if
+ end do
+
+ ! print *, "Merged coefficients matrix for ", speciesID
+ ! call Matrix_show(mergedCoefficients(speciesID))
+
+ ! call Matrix_writeToFile(mergedCoefficients(speciesID), unit=wfnUnit, binary=.true., arguments = arguments
+ ! call Matrix_writeToFile(auxMatrix, unit=wfnUnit, binary=.true., arguments = arguments )
+
+ ! arguments(1) = "ORBITALS"
+ ! call Vector_constructor(auxVector, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), 0.0_8 )
+
+ ! call Vector_writeToFile(auxVector, unit=wfnUnit, binary=.true., arguments = arguments )
+
+ ! Only occupied orbitals are going to be transformed - handled in integral transformation program
+ ! print *, "removed", MolecularSystem_getTotalNumberOfContractions(speciesID)-MolecularSystem_getOcupationNumber(speciesID)
+ ! arguments(1) = "REMOVED-ORBITALS"
+ ! call Vector_writeToFile(unit=wfnUnit, binary=.true., &
+ ! value=real(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)-MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem),8),&
+ ! arguments= arguments )
+
+ end do
+ ! close(wfnUnit)
+
+ end subroutine NOCIMatrices_mergeCoefficients
+
+ !>
+ !! @brief Merges the occupied orbitals coefficients from two systems
+ !! @param occupationI and occupationII: Number of orbitals to merge from each matrix.
+ !! sysBasisList: array indicating which basis functions of the merged molecular system belong to sysI and sysII Merged Coefficients: Matrices for output.
+ !<
+ subroutine NOCIMatrices_getOffDiagonalDensityMatrix(this,sysI,sysII,mergedCoefficients,mergedMolecularSystem,overlapElement,inverseOverlapMatrices,&
+ sysIbasisList,sysIIbasisList)
+ type(NonOrthogonalCI), intent(inout) :: this
+ integer, intent(in) :: sysI, sysII
+ type(Matrix), intent(in) :: mergedCoefficients(*), inverseOverlapMatrices(*)
+ type(MolecularSystem), intent(in) :: mergedMolecularSystem
+ real(8), intent(in) :: overlapElement
+ type(IVector), intent(in) :: sysIbasisList(*), sysIIbasisList(*)
+
+ type(Matrix), allocatable :: mergedDensityMatrix(:)
+ type(Matrix), allocatable :: exchangeCorrelationMatrices(:)
+ type(Matrix) :: dftEnergyMatrix
+ real(8), allocatable :: particlesInGrid(:)
+
+ integer :: speciesID, otherSpeciesID, i, j, ii, jj, mu, nu
+ integer :: numberOfSpecies, particlesPerOrbital, occupationNumber, numberOfContractions
+
+ !!"Non Diagonal" terms - system pairs
+ if( abs(overlapElement) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) return
+
+ numberOfSpecies=mergedMolecularSystem%numberOfQuantumSpecies
+ allocate(mergedDensityMatrix(numberOfSpecies))
+
+ call MolecularSystem_copyConstructor(MolecularSystem_instance,mergedMolecularSystem)
+
+ ! Compute density contributions
+ do speciesID=1, numberOfSpecies
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem)
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)/2
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ call Matrix_constructor(mergedDensityMatrix(speciesID),int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
+ do mu = 1 , numberOfContractions
+ if(sysIbasisList(speciesID)%values(mu) .eq. 0) cycle
+ do nu = 1 , numberOfContractions
+ if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle
+ do i = 1 , occupationNumber
+ ii= i
+ do j = 1 , occupationNumber
+ jj=occupationNumber + j
+ mergedDensityMatrix(speciesID)%values(mu,nu) = mergedDensityMatrix(speciesID)%values(mu,nu) + &
+ inverseOverlapMatrices(speciesID)%values(j,i)*&
+ mergedCoefficients(speciesID)%values(mu,ii)*&
+ mergedCoefficients(speciesID)%values(nu,jj)
+ mergedDensityMatrix(speciesID)%values(nu,mu) = mergedDensityMatrix(speciesID)%values(nu,mu) + &
+ inverseOverlapMatrices(speciesID)%values(j,i)*&
+ mergedCoefficients(speciesID)%values(mu,ii)*&
+ mergedCoefficients(speciesID)%values(nu,jj)
+ end do
+ end do
+ end do
+ end do
+ mergedDensityMatrix(speciesID)%values=0.5*particlesPerOrbital*mergedDensityMatrix(speciesID)%values
+ ! print *, "off diagonal matrix for", speciesID
+ ! call Matrix_show(mergedDensityMatrix(speciesID))
+ end do
+
+
+ ! if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ ! print *, "Superposed DFT energies:"
+
+ ! allocate(exchangeCorrelationMatrices(numberOfSpecies), &
+ ! particlesInGrid(numberOfSpecies))
+ ! call DensityFunctionalTheory_buildFinalGrid()
+ ! call Matrix_constructor(dftEnergyMatrix, int(numberOfSpecies,8), &
+ ! int(numberOfSpecies,8), 0.0_8 )
+ ! do speciesID=1, numberOfSpecies
+ ! numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ ! call Matrix_constructor(exchangeCorrelationMatrices(speciesID), int(numberOfContractions,8), &
+ ! int(numberOfContractions,8), 0.0_8)
+ ! end do
+ ! call DensityFunctionalTheory_finalDFT(mergedDensityMatrix(1:numberOfSpecies), &
+ ! exchangeCorrelationMatrices, &
+ ! dftEnergyMatrix, &
+ ! particlesInGrid)
+
+ ! do speciesID = 1, numberOfSpecies
+ ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ ! " Particles in grid = ", particlesInGrid(speciesID)
+ ! end do
+
+ ! do speciesID = 1, numberOfSpecies
+ ! do otherSpeciesID = speciesID, numberOfSpecies
+ ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ ! "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
+ ! " DFT Corr. energy = ", dftEnergyMatrix%values(speciesID,otherSpeciesID)
+ ! this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(sysI,sysII)=dftEnergyMatrix%values(speciesID,otherSpeciesID)*overlapElement
+ ! end do
+ ! end do
+ ! end if
+
+
+ do speciesID=1, numberOfSpecies
+ call Matrix_destructor(mergedDensityMatrix(speciesID))
+ end do
+
+ deallocate(mergedDensityMatrix)
+
+ end subroutine NOCIMatrices_getOffDiagonalDensityMatrix
+
+
+ !>
+ !! @brief Computes an upper bound of the overlap between two configurations, based on the max distance between particles of the same species and the lowest exponent of the basis set functions. Assumes a localized hartree product for the heaviest species
+ !!
+ !! @param sysI and sysII: molecular system indices. estimatedOverlap: output value
+ !<
+ subroutine NOCIMatrices_prescreenOverlap(this,sysI,sysII,estimatedOverlap)
+ type(NonOrthogonalCI) :: this
+ integer :: sysI, sysII !Indices of the systems to screen
+ real(8) :: estimatedOverlap
+
+ type(Vector), allocatable :: displacementVector(:)
+ integer :: speciesID, k, l, m
+ real(8) :: massThreshold, minExponent, speciesOverlap
+
+ !displacement vectors contains the max distance between equivalent basis function centers
+ allocate(displacementVector(this%molecularSystems(sysI)%numberOfQuantumSpecies))
+
+ call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), this%molecularSystems(sysII),displacementVector(:))
+
+ estimatedOverlap=1.0
+
+ !only compute for heavy particles, maybe should be a control parameter
+ massThreshold=10.0
+
+ do speciesID = 1, this%molecularSystems(sysI)%numberOfQuantumSpecies
+ if(this%molecularSystems(sysI)%species(speciesID)%mass .lt. massThreshold) cycle
+ speciesOverlap=1.0
+ !!get smallest exponent of the basis set
+ do k = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles)
+ minExponent=1.0E8
+ do l = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction)
+ do m = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents)
+ if(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m).lt.minExponent) &
+ minExponent=this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m)
+ !Assume a 1S GTF
+ ! normCoefficients(speciesID)=(2.0*minExponents(speciesID)/Math_PI)**(3.0/4.0)
+ end do
+ end do
+ !!Compute an hipothetical overlap between two 1S functions with the lowest orbital exponent separated at the distance between systems
+ speciesOverlap=speciesOverlap*exp(-minExponent*displacementVector(speciesID)%values(k)**2/2.0)
+ end do
+
+ ! print *, "sysI", sysI, "sysII", sysII, "species", speciesID,"overlap approx", speciesOverlap
+ estimatedOverlap=estimatedOverlap*speciesOverlap
+ end do
+
+ deallocate(displacementVector)
+
+ end subroutine NOCIMatrices_prescreenOverlap
+
+ !>
+ !! @brief Classify the sysI and sysII pair according to their distance matrix
+ !!
+ !! @param sysI and sysII: molecular system indices.
+ !<
+ ! subroutine NOCIMatrices_classifyConfigurationPair(this,currentSysI,currentSysII,newPairFlag)
+ ! implicit none
+ ! type(NonOrthogonalCI) :: this
+ ! integer :: currentSysI, currentSysII !Indices of the systems to classify
+ ! logical :: newPairFlag
+
+ ! type(MolecularSystem) :: currentMolecularSystem
+ ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix
+
+ ! integer :: sysI, sysII, i, checkingType
+ ! logical :: match
+
+ ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance)
+ ! newPairFlag=.true.
+ ! currentDistanceMatrix=ParticleManager_getDistanceMatrix()
+
+ ! ! print *, "Current distance matrix"
+ ! ! call Matrix_show(currentDistanceMatrix)
+
+ ! types: do checkingType=1, this%numberOfUniquePairs
+ ! ! print *, "checkingType", checkingType
+ ! systemI: do sysI=1, currentSysI
+ ! systemII: do sysII=sysI+1, currentSysII
+
+ ! if(sysI .eq. currentSysI .and. sysII .eq. currentSysII ) cycle types
+
+ ! if((this%configurationPairTypes%values(sysI,sysII) .eq. checkingType) .and. &
+ ! (this%systemTypes%values(sysI) .eq. this%systemTypes%values(currentSysI)) .and. &
+ ! (this%systemTypes%values(sysII) .eq. this%systemTypes%values(currentSysII))) then
+
+ ! ! call MolecularSystem_mergeTwoSystems(molecularSystem_instance, this%MolecularSystems(sysI), this%MolecularSystems(sysII))
+
+ ! previousDistanceMatrix=ParticleManager_getDistanceMatrix()
+
+ ! ! print *, "Comparing with previous distance matrix", checkingType
+ ! ! call Matrix_show(previousDistanceMatrix)
+
+ ! match=.true.
+ ! do i=1, size(currentDistanceMatrix%values(:,1))
+ ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. &
+ ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
+ ! match=.false.
+ ! exit
+ ! end if
+ ! end do
+
+ ! if(match) then
+ ! newPairFlag=.false.
+ ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%configurationPairTypes%values(sysI,sysII)
+ ! exit types
+ ! else
+ ! cycle types
+ ! end if
+ ! end if
+ ! end do systemII
+ ! end do systemI
+ ! end do types
+
+ ! if(newPairFlag) then
+ ! this%numberOfUniquePairs=this%numberOfUniquePairs+1
+ ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%numberOfUniquePairs
+ ! end if
+
+ ! if(this%configurationPairTypes%values(currentSysI,currentSysII).eq.0) then
+ ! print *, "newPairFlag", newPairFlag
+ ! print *, currentSysI, currentSysII, this%configurationPairTypes%values(currentSysI,currentSysII)
+ ! STOP "I found a type zero"
+ ! end if
+ ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem)
+
+ ! end subroutine NOCIMatrices_classifyConfigurationPair
+
+
+ !>
+ !! @brief Computes overlap matrix element between two configurations along with one particle energy contributions
+ !!
+ !! @param sysI and sysII: molecular system indices. Merged Molecular System: Union of objects from sysI and sysII. Merged Coefficients: Mixed molecular system coefficients. Sys basis list indicate the basis functions of each sysI and sysII in the merged molecular system. inverseOverlapMatrices: output required for two particle contributions
+ !<
+ subroutine NOCIMatrices_computeOverlapAndHCoreElements(this,sysI,sysII,mergedMolecularSystem,mergedCoefficients, &
+ sysIbasisList, sysIIbasisList,inverseOverlapMatrices)
+
+ type(NonOrthogonalCI) :: this
+ type(MolecularSystem) :: mergedMolecularSystem
+ integer :: sysI, sysII
+ type(Matrix) :: mergedCoefficients(*), inverseOverlapMatrices(*)
+ type(IVector) :: sysIbasisList(*), sysIIbasisList(*)
+
+ integer :: speciesID
+ integer :: a,b,bb,mu,nu
+ integer :: numberOfContractions,occupationNumber,particlesPerOrbital
+ type(Matrix) :: molecularOverlapMatrix
+ type(Matrix), allocatable :: auxOverlapMatrix(:), auxKineticMatrix(:), auxAttractionMatrix(:), auxExternalPotMatrix(:)
+ type(Matrix), allocatable :: molecularKineticMatrix(:), molecularAttractionMatrix(:), molecularExternalMatrix(:)
+ type(Vector) :: overlapDeterminant
+ real(8) :: oneParticleKineticEnergy,oneParticleAttractionEnergy,oneParticleExternalEnergy
+
+ allocate(auxOverlapMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
+ auxKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
+ auxAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
+ auxExternalPotMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
+ molecularKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
+ molecularAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
+ molecularExternalMatrix(mergedMolecularSystem%numberOfQuantumSpecies))
+
+ !!Initialize overlap
+ this%configurationOverlapMatrix%values(sysI,sysII)=1.0
+
+ call Vector_constructor(overlapDeterminant, mergedMolecularSystem%numberOfQuantumSpecies, 0.0_8)
+
+!!!!Overlap first
+ do speciesID = 1, this%MolecularSystems(sysI)%numberOfQuantumSpecies
+
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem)
+ !! Calculate one- particle integrals
+ call DirectIntegralManager_getOverlapIntegrals(mergedMolecularSystem,speciesID,&
+ auxOverlapMatrix(speciesID))
+
+ !!Test
+
+ ! print *, "auxOverlapMatrix", speciesID
+ ! call Matrix_show(auxOverlapMatrix(speciesID))
+
+ call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), &
+ int(occupationNumber,8), 0.0_8 )
+
+ do mu=1, numberOfContractions!sysI
+ if(sysIbasisList(speciesID)%values(mu) .eq. 0 ) cycle
+ do nu=1, numberOfContractions !sysII
+ if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle
+ do a=1, occupationNumber !sysI
+ do b=occupationNumber+1, 2*occupationNumber
+ bb=b-occupationNumber
+ ! print *, "a, b, mu, nu, coefI, coefII", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b),auxOverlapMatrix(speciesID)%values(mu,nu)
+
+ molecularOverlapMatrix%values(a,bb)=molecularOverlapMatrix%values(a,bb)+&
+ mergedCoefficients(speciesID)%values(mu,a)*&
+ mergedCoefficients(speciesID)%values(nu,b)*&
+ auxOverlapMatrix(speciesID)%values(mu,nu)
+ end do
+ end do
+ end do
+ end do
+
+ ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID
+ ! call Matrix_show(molecularOverlapMatrix)
+
+ !Sometimes we run calculations for systems with ghost species
+ if(occupationNumber .ne. 0) then
+ inverseOverlapMatrices(speciesID)=Matrix_inverse(molecularOverlapMatrix)
+ ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII
+ ! call Matrix_show(inverseOverlapMatrices(speciesID))
+ call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant%values(speciesID),method="LU")
+ ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant%values(speciesID)
+ else
+ overlapDeterminant%values(speciesID)=1.0
+ end if
+
+ this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(sysI,sysII)*overlapDeterminant%values(speciesID)**particlesPerOrbital
+
+
+ end do
+
+ ! print *, "total overlap", this%configurationOverlapMatrix%values(sysI,sysII)
+
+ !!Skip the rest of the evaluation if the overlap is smaller than the threshold
+ if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. &
+ abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) return
+
+ !!Point charge-Point charge repulsion
+ this%configurationHamiltonianMatrix%values(sysI,sysII)=MolecularSystem_getPointChargesEnergy(this%molecularSystems(sysI))*&
+ this%configurationOverlapMatrix%values(sysI,sysII)
+ ! print *, "Point charge-Point charge repulsion", MolecularSystem_getPointChargesEnergy()
+
+ !!Compute hcore if overlap is significant
+ do speciesID = 1, this%molecularSystems(sysI)%numberOfQuantumSpecies
+
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem)
+
+ call Matrix_constructor(auxKineticMatrix(speciesID),&
+ int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
+ call Matrix_constructor(auxAttractionMatrix(speciesID),&
+ int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
+ call Matrix_constructor(auxExternalPotMatrix(speciesID),&
+ int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
+
+ call DirectIntegralManager_getKineticIntegrals(mergedMolecularSystem,speciesID,auxKineticMatrix(speciesID))
+ call DirectIntegralManager_getAttractionIntegrals(mergedMolecularSystem,speciesID,auxAttractionMatrix(speciesID))
+ if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ call DirectIntegralManager_getExternalPotentialIntegrals(mergedMolecularSystem,speciesID,auxExternalPotMatrix(speciesID))
+
+ !! Incluiding mass effect
+ if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then
+ auxKineticMatrix(speciesID)%values = &
+ auxKineticMatrix(speciesID)%values * &
+ ( 1.0_8/MolecularSystem_getMass( speciesID,this%molecularSystems(sysI) ) -1.0_8 / MolecularSystem_getTotalMass(this%molecularSystems(sysI)) )
+ else
+ auxKineticMatrix(speciesID)%values = &
+ auxKineticMatrix(speciesID)%values / &
+ MolecularSystem_getMass( speciesID,this%molecularSystems(sysI) )
+ end if
+
+ !! Including charge
+ auxAttractionMatrix(speciesID)%values=auxAttractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID,this%molecularSystems(sysI)))
+
+ call Matrix_constructor(molecularKineticMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+ call Matrix_constructor(molecularAttractionMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+ call Matrix_constructor(molecularExternalMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
+
+ !!Test
+ ! print *, "auxKineticMatrix", speciesID
+ ! call Matrix_show(auxKineticMatrix(speciesID))
+ ! print *, "auxAttractionMatrix", speciesID
+ ! call Matrix_show(auxAttractionMatrix(speciesID))
+
+ do mu=1, numberOfContractions !sysI
+ if(sysIbasisList(speciesID)%values(mu) .eq. 0) cycle
+ do nu=1, numberOfContractions !sysII
+ if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle
+ do a=1, occupationNumber !sysI
+ do b=occupationNumber+1, 2*occupationNumber
+ bb=b-occupationNumber
+
+ ! print *, "hcore", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b), &
+ ! auxKineticMatrix%values(mu,nu)/MolecularSystem_getMass(speciesID)+&
+ ! auxAttractionMatrix%values(mu,nu)*(-MolecularSystem_getCharge(speciesID))
+
+ molecularKineticMatrix(speciesID)%values(a,bb)=molecularKineticMatrix(speciesID)%values(a,bb)+&
+ mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*&
+ auxKineticMatrix(speciesID)%values(mu,nu)
+
+ molecularAttractionMatrix(speciesID)%values(a,bb)=molecularAttractionMatrix(speciesID)%values(a,bb)+&
+ mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*&
+ auxAttractionMatrix(speciesID)%values(mu,nu)
+
+ if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ molecularExternalMatrix(speciesID)%values(a,bb)=molecularExternalMatrix(speciesID)%values(a,bb)+&
+ mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*&
+ auxExternalPotMatrix(speciesID)%values(mu,nu)
+ end do
+ end do
+ end do
+ end do
+ molecularKineticMatrix(speciesID)%values=particlesPerOrbital*molecularKineticMatrix(speciesID)%values
+ molecularAttractionMatrix(speciesID)%values=particlesPerOrbital*molecularAttractionMatrix(speciesID)%values
+ molecularExternalMatrix(speciesID)%values=particlesPerOrbital*molecularExternalMatrix(speciesID)%values
+ !!End test
+ end do
+
+ !!One Particle Terms
+ do speciesID=1, this%molecularSystems(sysI)%numberOfQuantumSpecies
+ oneParticleKineticEnergy=0.0
+ oneParticleAttractionEnergy=0.0
+ oneParticleExternalEnergy=0.0
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
+ do a=1, occupationNumber !sysI
+ do b=1, occupationNumber !sysII
+ oneParticleKineticEnergy=oneParticleKineticEnergy+ molecularKineticMatrix(speciesID)%values(a,b)*&
+ inverseOverlapMatrices(speciesID)%values(b,a)
+ oneParticleAttractionEnergy=oneParticleAttractionEnergy+ molecularAttractionMatrix(speciesID)%values(a,b)*&
+ inverseOverlapMatrices(speciesID)%values(b,a)
+ oneParticleExternalEnergy=oneParticleExternalEnergy+ molecularExternalMatrix(speciesID)%values(a,b)*&
+ inverseOverlapMatrices(speciesID)%values(b,a)
+ end do
+ end do
+ this%configurationKineticMatrix(speciesID)%values(sysI,sysII)=oneParticleKineticEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+ this%configurationPuntualMatrix(speciesID)%values(sysI,sysII)=oneParticleAttractionEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+ this%configurationExternalMatrix(speciesID)%values(sysI,sysII)=oneParticleExternalEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+
+ this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+&
+ (oneParticleKineticEnergy+oneParticleAttractionEnergy+oneParticleExternalEnergy)*this%configurationOverlapMatrix%values(sysI,sysII)
+ ! print *, "sysI, sysII", sysI, sysII, "oneParticleEnergy for species", speciesID, oneParticleEnergy
+ end do
+
+ deallocate(auxOverlapMatrix, auxKineticMatrix, auxAttractionMatrix, auxExternalPotMatrix, &
+ molecularKineticMatrix, molecularAttractionMatrix, molecularExternalMatrix)
+
+ end subroutine NOCIMatrices_computeOverlapAndHCoreElements
+ !>
+ !! @brief Computes the two particles contributions to the non diagonal elements of the hamiltonian matrix
+ !!
+ !! @param this, sysI,sysII: system indexes, inverseOverlapMatrices, mergedCoefficients are required to evaluate the elements
+ !<
+ subroutine NOCIMatrices_twoParticlesContributions(this,sysI,sysII,mergedMolecularSystem,inverseOverlapMatrices,mergedCoefficients,Libint2LocalInstance)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ integer :: sysI, sysII
+ type(MolecularSystem) :: mergedMolecularSystem
+ type(Matrix) :: inverseOverlapMatrices(*)
+ type(Matrix) :: mergedCoefficients(*)
+ type(Libint2Interface) :: Libint2LocalInstance(*)
+
+ type(matrix), allocatable :: fourCenterIntegrals(:,:)
+ type(imatrix), allocatable :: twoIndexArray(:),fourIndexArray(:)
+ integer :: numberOfContractions,occupationNumber,particlesPerOrbital
+ integer :: otherNumberOfContractions,otherOccupationNumber,otherParticlesPerOrbital
+ integer :: ssize1, auxIndex, auxIndex1
+ integer :: a,b,bb,c,d,dd,i,j
+ real(8) :: hartreeEnergy, exchangeEnergy
+
+ allocate(fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies), &
+ twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies), &
+ fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies))
+
+ !!Fill indexes arrays
+ do i=1, mergedMolecularSystem%numberOfQuantumSpecies
+ ! print *, "reading integrals species", i
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem)
+ occupationNumber=MolecularSystem_getOcupationNumber(i,mergedMolecularSystem)
+ !!Two particle integrals indexes
+ call Matrix_constructorInteger(twoIndexArray(i), &
+ int(max(numberOfContractions,occupationNumber),8), &
+ int(max(numberOfContractions,occupationNumber),8), 0 )
+
+ c = 0
+ do a=1,max(numberOfContractions,occupationNumber)
+ do b=a, max(numberOfContractions,occupationNumber)
+ c = c + 1
+ twoIndexArray(i)%values(a,b) = c !IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
+ twoIndexArray(i)%values(b,a) = twoIndexArray(i)%values(a,b)
+ end do
+ end do
+
+ ssize1 = max(numberOfContractions,occupationNumber)
+ ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2
+
+ call Matrix_constructorInteger(fourIndexArray(i), int( ssize1,8), int( ssize1,8) , 0 )
+
+ c = 0
+ do a = 1, ssize1
+ do b = a, ssize1
+ c = c + 1
+ fourIndexArray(i)%values(a,b) = c! IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
+ fourIndexArray(i)%values(b,a) = fourIndexArray(i)%values(a,b)
+ end do
+ end do
+ end do
+
+ !! Calculate two- particle integrals
+ call NOCIMatrices_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, &
+ twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance)
+
+!!!Add charges
+ if ( .not. InterPotential_instance%isInstanced) then
+ do i=1, mergedMolecularSystem%numberOfQuantumSpecies
+ fourCenterIntegrals(i,i)%values = &
+ fourCenterIntegrals(i,i)%values * mergedMolecularSystem%species(i)%charge**2.0
+
+ do j = i+1 , mergedMolecularSystem%numberOfQuantumSpecies
+ fourCenterIntegrals(i,j)%values = &
+ fourCenterIntegrals(i,j)%values * mergedMolecularSystem%species(i)%charge * mergedMolecularSystem%species(j)%charge
+ end do
+ end do
+ end if
+!!!Compute Hamiltonian Matrix element between displaced geometries
+
+ ! !!Point charge-Point charge repulsion
+ ! !!One Particle Terms
+ ! !!Have already been computed
+
+ !!Same species repulsion
+ do i=1, mergedMolecularSystem%numberOfQuantumSpecies
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem)
+ occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI))
+ particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem)
+ hartreeEnergy=0.0
+ exchangeEnergy=0.0
+ do a=1,occupationNumber !sysI
+ do b=occupationNumber+1, 2*occupationNumber !sysII
+ bb=b-occupationNumber
+ do c=1, occupationNumber !sysI
+ do d=occupationNumber+1, 2*occupationNumber !sysII
+ dd=d-occupationNumber
+ auxIndex = fourIndexArray(i)%values(twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d) )
+ hartreeEnergy=hartreeEnergy+0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*&
+ inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(i)%values(dd,c)*particlesPerOrbital**2 !coulomb
+ exchangeEnergy=exchangeEnergy-0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*&
+ inverseOverlapMatrices(i)%values(dd,a)*inverseOverlapMatrices(i)%values(bb,c)*particlesPerOrbital !exchange
+ ! print *, a, b, c, d, twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d), fourIndexArray(i)%values( &
+ ! twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d)),
+ end do
+ end do
+ end do
+ end do
+ this%configurationHartreeMatrix(i,i)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+ this%configurationExchangeMatrix(i)%values(sysI,sysII)=exchangeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+ this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+&
+ (hartreeEnergy+exchangeEnergy)*this%configurationOverlapMatrix%values(sysI,sysII)
+ ! print *, "same species interactionEnergy for species", i, hartreeEnergy, exchangeEnergy
+ end do
+
+ !!Interspecies repulsion
+ do i=1, mergedMolecularSystem%numberOfQuantumSpecies-1
+ numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem)
+ occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI))
+ particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem)
+ do j=i+1, mergedMolecularSystem%numberOfQuantumSpecies
+ otherNumberOfContractions=MolecularSystem_getTotalNumberOfContractions(j,mergedMolecularSystem)
+ otherOccupationNumber=MolecularSystem_getOcupationNumber(j,mergedMolecularSystem)
+ otherParticlesPerOrbital=MolecularSystem_getEta(j,mergedMolecularSystem)
+ hartreeEnergy=0.0
+ ssize1 = max(otherNumberOfContractions,otherOccupationNumber)
+ ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2
+ otherOccupationNumber=MolecularSystem_getOcupationNumber(j,this%molecularSystems(sysI))
+ do a=1, occupationNumber !sysI
+ do b=occupationNumber+1, 2*occupationNumber !sysII
+ bb=b-MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI))
+ auxIndex1 = ssize1 * (twoIndexArray(i)%values(a,b) - 1 )
+ do c=1, otherOccupationNumber !sysI
+ do d=otherOccupationNumber+1,2*otherOccupationNumber !sysII
+ dd=d-otherOccupationNumber
+ auxIndex = auxIndex1 + twoIndexArray(j)%values(c,d)
+ hartreeEnergy=hartreeEnergy+fourCenterIntegrals(i,j)%values(auxIndex, 1)*&
+ inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(j)%values(dd,c)*&
+ particlesPerOrbital*otherParticlesPerOrbital
+ ! print *, a, b, c, d, fourCenterIntegrals(i,j)%values(auxIndex, 1), inverseOverlapMatrices(i)%values(bb,a), inverseOverlapMatrices(j)%values(dd,c)
+ end do
+ end do
+ end do
+ end do
+ this%configurationHartreeMatrix(i,j)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+ this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+&
+ hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
+ ! print *, "interspecies hartreeEnergy for species", i, j, hartreeEnergy
+ end do
+ end do
+
+ deallocate(fourCenterIntegrals,twoIndexArray,fourIndexArray)
+
+ end subroutine NOCIMatrices_twoParticlesContributions
+
+ !>
+ !! @brief Solves the NOCI matrix equation
+ !!
+ !! @param this
+ !<
+ subroutine NOCIMatrices_diagonalize(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ type(Matrix) :: transformationMatrix,transformedHamiltonianMatrix,eigenVectors,auxMatrix
+ type(Vector) :: eigenValues
+ integer :: removedStates
+ integer :: speciesID,otherSpeciesID,sysI,sysII,state,i,j
+ real(8) :: auxEnergy
+ real(8) :: timeA
+
+ !$ timeA = omp_get_wtime()
+
+ call Matrix_constructor(this%configurationCoefficients, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Vector_constructor(this%statesEigenvalues, this%numberOfDisplacedSystems, 0.0_8)
+
+ ! print *, "non orthogonal CI overlap Matrix "
+ ! call Matrix_show(this%configurationOverlapMatrix)
+
+ ! print *, "non orthogonal CI Hamiltionian Matrix "
+ ! call Matrix_show(this%configurationHamiltonianMatrix)
+ !
+ print *, ""
+ print *, "Transforming non orthogonal CI Hamiltonian Matrix..."
+
+ call Matrix_constructor(transformationMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8)
+ call Matrix_constructor(transformedHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8)
+
+ call Vector_constructor( eigenValues, this%numberOfDisplacedSystems )
+ call Matrix_constructor( eigenVectors,int(this%numberOfDisplacedSystems,8),int(this%numberOfDisplacedSystems,8))
+
+ !!****************************************************************
+ !! diagonaliza la matriz de overlap obteniendo una matriz unitaria
+ !!
+ call Matrix_eigen( this%configurationOverlapMatrix, eigenValues, eigenVectors, SYMMETRIC )
+
+ ! print *,"Overlap eigenvectors "
+ ! call Matrix_show( eigenVectors )
+
+ ! print *,"Overlap eigenvalues "
+ ! call Vector_show( eigenValues )
+
+ !! Remove states from configurations with linear dependencies
+ do i = 1 , this%numberOfDisplacedSystems
+ do j = 1 , this%numberOfDisplacedSystems
+ if ( abs(eigenValues%values(j)) >= CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) then
+ transformationMatrix%values(i,j) = &
+ eigenVectors%values(i,j)/sqrt( eigenvalues%values(j) )
+ else
+ transformationMatrix%values(i,j) = 0
+ end if
+ end do
+ end do
+
+ removedStates=0
+ do i = 1 , this%numberOfDisplacedSystems
+ if ( abs(eigenValues%values(i)) .lt. CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) &
+ removedStates=removedStates+1
+ end do
+
+ if (removedStates .gt. 0) &
+ write(*,"(A,I5,A,ES9.3)") "Removed ", removedStates , &
+ " states from the CI transformation Matrix with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD
+
+
+ !!Ortogonalizacion simetrica
+ transformationMatrix%values = &
+ matmul(transformationMatrix%values, transpose(eigenVectors%values))
+
+ ! print *,"Matriz de transformacion "
+ ! call Matrix_show( transformationMatrix )
+
+ !!**********************************************************************************************
+ !! Transform configuration hamiltonian matrix
+ !!
+ transformedHamiltonianMatrix%values = &
+ matmul( matmul( transpose( transformationMatrix%values ) , &
+ this%configurationHamiltonianMatrix%values), transformationMatrix%values )
+
+ ! print *,"transformed Hamiltonian Matrix "
+ ! call Matrix_show( this%configurationHamiltonianMatrix )
+
+ print *, "Diagonalizing non orthogonal CI Hamiltonian Matrix..."
+ !! Calcula valores y vectores propios de matriz de CI transformada.
+ call Matrix_eigen( transformedHamiltonianMatrix, this%statesEigenvalues, this%configurationCoefficients, SYMMETRIC )
+
+ !! Calcula los vectores propios para matriz de CI
+ this%configurationCoefficients%values = matmul( transformationMatrix%values, this%configurationCoefficients%values )
+
+ ! print *,"non orthogonal CI eigenvalues "
+ ! call Vector_show( this%statesEigenvalues )
+
+ ! print *,"configuration Coefficients"
+ ! call Matrix_show( this%configurationCoefficients )
+
+ write(*,"(A)") ""
+ write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION"
+ write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION"
+ write(*,"(A)") " EIGENVALUES AND EIGENVECTORS: "
+ write(*,"(A)") "========================================="
+ write(*,"(A)") ""
+ do state = 1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems)
+ write (*,"(A)") ""
+ write (*,"(T9,A17,I3,A10, F25.12)") "STATE: ", state, " ENERGY = ", this%statesEigenvalues%values(state)
+ write (*,"(A38)") "Components: "
+ write(*,"(A38,F25.12)") " Point charges energy = ", MolecularSystem_getPointChargesEnergy(this%molecularSystems(1))
+ do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergy=0
+ do sysI=1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ this%configurationCoefficients%values(sysI,state)**2*&
+ this%configurationKineticMatrix(speciesID)%values(sysI,sysI)
+ do sysII=sysI+1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ 2.0_8*this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationKineticMatrix(speciesID)%values(sysI,sysII)
+ end do
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Kinetic energy = ", auxEnergy
+ end do
+ do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergy=0
+ do sysI=1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ this%configurationCoefficients%values(sysI,state)**2*&
+ this%configurationPuntualMatrix(speciesID)%values(sysI,sysI)
+ do sysII=sysI+1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ 2.0_8*this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationPuntualMatrix(speciesID)%values(sysI,sysII)
+ end do
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Puntual energy = ", auxEnergy
+ end do
+ if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
+ do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergy=0
+ do sysI=1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ this%configurationCoefficients%values(sysI,state)**2*&
+ this%configurationExternalMatrix(speciesID)%values(sysI,sysI)
+ do sysII=sysI+1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ 2.0_8*this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationExternalMatrix(speciesID)%values(sysI,sysII)
+ end do
+ end do
+ write(*,"(A38,F25.12)") trim(this%molecularSystems(1)%species(speciesID)%name ) // &
+ " External energy = ", auxEnergy
+ end do
+ end if
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergy=0
+ do sysI=1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ this%configurationCoefficients%values(sysI,state)**2*&
+ this%configurationExchangeMatrix(speciesID)%values(sysI,sysI)
+ do sysII=sysI+1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ 2.0_8*this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationExchangeMatrix(speciesID)%values(sysI,sysII)
+ end do
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Exchange energy = ", auxEnergy
+
+ do otherSpeciesID=speciesID, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergy=0
+ do sysI=1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ this%configurationCoefficients%values(sysI,state)**2*&
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysI)
+ do sysII=sysI+1, this%numberOfDisplacedSystems
+ auxEnergy= auxEnergy+ &
+ 2.0_8*this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysII)
+ end do
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // &
+ " Hartree energy = ", auxEnergy
+ end do
+ end do
+ end do
+ write(*,"(A)") ""
+
+ call Matrix_constructor(auxMatrix,int(this%numberOfDisplacedSystems,8),&
+ int(CONTROL_instance%CI_STATES_TO_PRINT,8),0.0_8)
+ do i=1, this%numberOfDisplacedSystems
+ do j=1, CONTROL_instance%CI_STATES_TO_PRINT
+ auxMatrix%values(i,j)=this%configurationCoefficients%values(i,j)
+ end do
+ end do
+
+
+ write(*,"(I5,A)") CONTROL_instance%CI_STATES_TO_PRINT, " LOWEST LYING STATES CONFIGURATION COEFFICIENTS"
+ write(*,"(A)") ""
+ call Matrix_show(auxMatrix , &
+ rowkeys = this%systemLabels, &
+ columnkeys = string_convertvectorofrealstostring( this%statesEigenvalues ),&
+ flags=WITH_BOTH_KEYS)
+ write(*,"(A)") ""
+
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI matrix diagonalization : ", omp_get_wtime() - timeA ," (s)"
+
+ end subroutine NOCIMatrices_diagonalize
+
+ !>
+ !! @brief Calculate and Transform the four center integrals in one sweep without writing anything to disk
+ !!
+ !! @param molecularSystem, HFCoefficients: species array with the atomic coefficients, fourCenterIntegrals: species*species array to save integrals
+ !<
+ subroutine NOCIMatrices_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance)
+ implicit none
+ type(MolecularSystem), intent(in) :: mergedMolecularSystem
+ type(Matrix), intent(in) :: mergedCoefficients(mergedMolecularSystem%numberOfQuantumSpecies)
+ type(iMatrix), intent(in) :: twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies)
+ type(iMatrix), intent(in) :: fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies)
+ type(Matrix), intent(out) :: fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies)
+ type(Libint2Interface) :: Libint2LocalInstance(mergedMolecularSystem%numberOfQuantumSpecies)
+
+ real(8), allocatable, target :: ints(:,:,:,:)
+ real(8), allocatable :: tempA(:,:,:)
+ real(8), allocatable :: tempB(:,:)
+ real(8), allocatable :: tempC(:)
+
+ integer :: p, p_l, p_u
+ integer :: q, q_l, q_u
+ integer :: r, r_l, r_u
+ integer :: s, s_l, s_u
+ integer :: ssize, ssizeb, auxIndex, auxIndexA
+ integer :: n,u, mu,nu, lambda,sigma
+ real(8) :: auxTransformedTwoParticlesIntegral
+
+ type(Matrix) :: densityMatrix
+ integer :: speciesID, otherSpeciesID
+ integer :: numberOfOrbitals, otherNumberOfOrbitals
+ integer(8) :: numberOfIntegrals
+
+ do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies
+ numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), &
+ MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ))
+ numberOfIntegrals= int( ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8 ) / 4.0_8 ) * &
+ ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8) / 2.0_8 ) + 1.0_8) ), 8 )
+
+ call Matrix_constructor( fourCenterIntegrals(speciesID,speciesID), numberOfIntegrals, 1_8, 0.0_8 )
+
+ p_l = 1
+ p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2
+ q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1
+ q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )
+
+ r_l = 1
+ r_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2
+ s_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1
+ s_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )
+
+ ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later
+
+ ! Prepare matrix
+ if(allocated(ints)) deallocate(ints)
+ if(allocated(tempA)) deallocate (tempA)
+ if(allocated(tempB)) deallocate (tempB)
+ if(allocated(tempC)) deallocate (tempC)
+ allocate (ints ( ssize, ssize, ssize, ssize ), &
+ tempA ( ssize, ssize, ssize ), &
+ tempB ( ssize, ssize ), &
+ tempC ( ssize ))
+ ints = 0
+
+ call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(&
+ speciesID, &
+ densityMatrix, &
+ ints, mergedMolecularSystem, Libint2LocalInstance(speciesID) )
+
+
+ do p = p_l, p_u
+ tempA = 0
+ n = p
+
+ ! !First quarter transformation happens here
+ do mu = 1, ssize
+ !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
+ tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* &
+ ints(:,:,:,mu)
+ end do
+
+ do q = p, q_u
+ u = q
+ tempB = 0
+
+ if ( q < q_l ) cycle
+ !! second quarter
+ do nu = 1, ssize
+ !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
+ tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* &
+ tempA(:,:,nu)
+ end do
+
+ do r = n, r_u
+
+ tempC = 0
+
+ !Why??
+ !if ( r < this%r_l ) cycle
+
+ !! third quarter
+ do lambda = 1, ssize
+ !if ( abs(coefficientsOfAtomicOrbitals%values( lambda, r )) < 1E-10 ) cycle
+ tempC(:) = tempC(:) + mergedCoefficients(speciesID)%values( lambda, r )* &
+ tempB(:,lambda)
+ end do
+
+ do s = u, s_u
+ auxTransformedTwoParticlesIntegral = 0
+
+ if ( s < s_l ) cycle
+ !! fourth quarter
+ do sigma = 1, ssize
+ auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + &
+ mergedCoefficients(speciesID)%values( sigma, s )* &
+ tempC(sigma)
+
+ end do
+ auxIndex = fourIndexArray(speciesID)%values(twoIndexArray(speciesID)%values(p,q), twoIndexArray(speciesID)%values(r,s) )
+ fourCenterIntegrals(speciesID,speciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral
+ ! print *, speciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral
+ end do
+ u = r + 1
+ end do
+ end do
+ end do
+ end do
+
+ do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies-1
+ do otherSpeciesID=speciesID+1, mergedMolecularSystem%numberOfQuantumSpecies
+
+ numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), &
+ MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem))
+ otherNumberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem), &
+ MolecularSystem_getOcupationNumber(otherSpeciesID,mergedMolecularSystem))
+
+ numberOfIntegrals = int((numberOfOrbitals*((numberOfOrbitals+1.0_8)/2.0_8)) * &
+ (otherNumberOfOrbitals*(otherNumberOfOrbitals+1.0_8)/2.0_8),8)
+
+ call Matrix_constructor( fourCenterIntegrals(speciesID,otherSpeciesID), numberOfIntegrals, 1_8, 0.0_8 )
+
+ ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
+ ssizeb = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem)
+
+ call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later
+
+ p_l = 1
+ p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2
+ q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1
+ q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )
+
+ r_l = 1
+ r_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2
+ s_l = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2+1
+ s_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )
+
+ ! Prepare matrix
+ ! Prepare matrix
+ if(allocated(ints)) deallocate(ints)
+ if(allocated(tempA)) deallocate (tempA)
+ if(allocated(tempB)) deallocate (tempB)
+ if(allocated(tempC)) deallocate (tempC)
+ allocate (ints ( ssizeb, ssizeb, ssize, ssize ), &
+ tempA ( ssizeb, ssizeb, ssize ), &
+ tempB ( ssizeb, ssizeb ), &
+ tempC ( ssizeb ))
+ ints = 0
+
+ call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(&
+ speciesID, otherSpeciesID, &
+ densityMatrix, &
+ ints, mergedMolecularSystem, Libint2LocalInstance(speciesID), Libint2LocalInstance(otherSpeciesID) )
+
+ ! do mu = 1, ssize
+ ! do nu = 1, ssize
+ ! do lambda = 1, ssizeb
+ ! do sigma = 1, ssizeb
+ ! print *, mu, nu, lambda, sigma, ints(lambda,sigma,nu,mu)
+ ! end do
+ ! end do
+ ! end do
+ ! end do
+ do p = p_l, p_u
+ tempA = 0
+ !First quarter transformation happens here
+ do mu = 1, ssize
+ !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
+ tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* &
+ ints(:,:,:,mu)
+ end do
+
+ do q = q_l, q_u
+ tempB = 0
+
+ ! if ( q < p ) cycle
+ !! second quarter
+ do nu = 1, ssize
+ !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
+
+ tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* &
+ tempA(:,:,nu)
+ end do
+
+ auxIndexA = (otherNumberOfOrbitals*(otherNumberOfOrbitals+1))/2 * (twoIndexArray(speciesID)%values(p,q) - 1 )
+
+ do r = r_l , r_u
+
+ tempC = 0
+
+ !! third quarter
+ do lambda = 1, ssizeb
+
+ tempC(:) = tempC(:) + mergedCoefficients(otherSpeciesID)%values( lambda, r )* &
+ tempB(:,lambda)
+
+ end do
+ do s = s_l, s_u
+ auxTransformedTwoParticlesIntegral = 0
+
+ ! if ( s < r ) cycle
+ !! fourth quarter
+ do sigma = 1, ssizeb
+ auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + &
+ mergedCoefficients(otherSpeciesID)%values( sigma, s )* &
+ tempC(sigma)
+
+ end do
+
+ auxIndex = auxIndexA + twoIndexArray(otherSpeciesID)%values(r,s)
+
+ fourCenterIntegrals(speciesID,otherSpeciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral
+
+ ! print *, speciesID,otherSpeciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral
+
+ end do
+ end do
+ end do
+ end do
+
+ end do
+ end do
+
+ ! call DirectIntegralManager_destructor(Libint2LocalInstance)
+
+ end subroutine NOCIMatrices_transformIntegralsMemory
+
+end module NOCIMatrices_
+
diff --git a/src/NOCI/NOCIRotFormula.f90 b/src/NOCI/NOCIRotFormula.f90
new file mode 100644
index 00000000..baca5776
--- /dev/null
+++ b/src/NOCI/NOCIRotFormula.f90
@@ -0,0 +1,396 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module NOCIRotFormula_
+ use NOCIBuild_
+ use MolecularSystem_
+ use Matrix_
+ use Vector_
+ use Math_
+ use DirectIntegralManager_
+ use Libint2Interface_
+ use omp_lib
+ implicit none
+
+ !>
+ !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
+ !!
+ !! @author Felix
+ !!
+ !! Creation data : 02-22
+ !!
+ !! History change:
+ !!
+ !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# Creation of the module.
+ !!
+ !<
+
+ public :: &
+ NOCIRotFormula_compute
+
+ private
+
+contains
+
+ !>
+ !! @brief Computes the rotational CI energies from previously computed overlap and hamiltonian non orthogonal CI elements
+ !!
+ !! @param this
+ !<
+ subroutine NOCIRotFormula_compute(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ type(Vector) :: angles, signs
+ type(Matrix) :: weights
+ integer :: i,state,sysI,npoints,nstates,speciesID,otherSpeciesID
+ real(8) :: overlapIntegral, auxEnergyIntegral, auxEnergy, e0, sc
+
+ ! real(8) :: timeMerging, timePrescreen, timeOverlap, timeTwoIntegrals
+ ! real(8) :: timeA
+ ! real(8) :: timeB
+
+ if((this%transformationType).ne."ROTATION_AROUND_Z") then
+ print *, "The Rotational Configuration Interaction formula for the rotational states energy is only available for molecular systems rotated around the z-axis"
+ print *, "Please set rotationalScanGridAroundZ=N in the input and restart the calculation"
+ end if
+
+ nstates=min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems)
+ if(nstates .lt. 2) nstates=2
+ npoints=this%numberOfIndividualTransformations
+
+ call Vector_constructor(angles,npoints,0.0_8)
+ call Matrix_constructor(weights,int(npoints,8),int(nstates,8),1.0_8)
+ call Vector_constructor(signs,this%numberOfDisplacedSystems,1.0_8)
+ call Vector_constructor(this%statesEigenvalues, this%numberOfDisplacedSystems, 0.0_8)
+
+ do i=1,npoints
+ angles%values(i)=(i-1)*CONTROL_instance%ROTATION_AROUND_Z_STEP*Math_PI/180
+ end do
+
+ if(this%molecularSystems(1)%numberOfPointCharges .gt. 1) then
+ print *, "Using 1D formula: cos(m gamma) as weights, with trapezoid integration rule"
+ weights%values(1,:)=0.5_8
+ do state=1,nstates
+ weights%values(2:npoints,state)=cos((state-1)*angles%values(2:npoints))
+ end do
+ weights%values(npoints,:)=0.5_8*weights%values(npoints,:)
+ else
+ print *, "Using 2D formula: sin(gamma) P_l(cos(gamma)) as weights, with trapezoid integration rule"
+ ! weights%values(1,:)=0.5_8
+ call Math_p_polynomial_value (npoints , nstates-1, cos(angles%values), weights%values)
+ call flush()
+ do i=1,npoints
+ weights%values(i,:)=sin(angles%values(i))*weights%values(i,:)
+ end do
+ weights%values(npoints,:)=0.5_8*weights%values(npoints,:)
+ end if
+
+ write(*,"(A)") ""
+ write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION"
+ write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION"
+ write(*,"(A)") " ROTATIONAL CI FORMULA UNSCALED ENERGIES: "
+ write(*,"(A)") "========================================="
+ write(*,"(A)") ""
+
+ do state=1,nstates
+ overlapIntegral=0
+
+ do sysI=1,this%numberOfDisplacedSystems
+ signs%values(sysI)=this%configurationOverlapMatrix%values(1,sysI)/abs(this%configurationOverlapMatrix%values(1,sysI))
+ overlapIntegral=overlapIntegral+signs%values(sysI)*this%configurationOverlapMatrix%values(1,sysI)*weights%values(sysI,state)
+ end do
+
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHamiltonianMatrix%values(1,sysI)*weights%values(sysI,state)
+ end do
+ this%statesEigenvalues%values(state)=auxEnergyIntegral/overlapIntegral
+ ! print *, "state", state, "overlapIntegral", overlapIntegral, "energyIntegral", auxEnergyIntegral, "energy", auxEnergyIntegral/overlapIntegral
+ write (*,"(A)") ""
+ write (*,"(T9,A17,I3,A10, F25.12)") "STATE: ", state, " ENERGY = ", this%statesEigenvalues%values(state)
+
+ write (*,"(A38)") "Components: "
+ write(*,"(A38,F25.12)") " Point charges energy = ", MolecularSystem_getPointChargesEnergy(this%molecularSystems(1))
+
+ do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationKineticMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Kinetic energy = ", auxEnergyIntegral/overlapIntegral
+ end do
+
+ do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationPuntualMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Puntual energy = ", auxEnergyIntegral/overlapIntegral
+ end do
+
+ if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
+ do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationExternalMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " External energy = ", auxEnergyIntegral/overlapIntegral
+ end do
+ end if
+
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHartreeMatrix(speciesID,speciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Hartree energy = ", auxEnergyIntegral/overlapIntegral
+ end do
+
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationExchangeMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ " Exchange energy = ", auxEnergyIntegral/overlapIntegral
+
+ end do
+
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies-1
+ do otherSpeciesID=speciesID+1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // &
+ " Hartree energy = ", auxEnergyIntegral/overlapIntegral
+ end do
+ end do
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies
+ do otherSpeciesID=speciesID, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // &
+ " DFTcorrelation energy = ", auxEnergyIntegral/overlapIntegral
+ end do
+ end do
+ end if
+
+ write(*,"(A)") ""
+
+ end do
+
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ write(*,"(A)") ""
+ write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION"
+ write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION"
+ write(*,"(A)") " ROTATIONAL CI FORMULA SCALED ENERGIES: "
+ write(*,"(A)") "========================================="
+ write(*,"(A)") ""
+
+ print *, "Using a sigmoid function, e0+(1+e0)exp(-(1-|S|)^4/sc^4), to scale down the interspecies correlation functional energy"
+ print *, "All the other energy contributions remain equal"
+ print *, ""
+
+ if(CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0 .ne. 0.0_8 .or. CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC .ne. 0.0_8 ) then
+ sc=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC
+ e0=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0
+ write (*,'(A63)') "Employing sigmoid parameters provided in the input"
+ write (*,'(A48,F15.8)') "sc =", sc
+ write (*,'(A48,F15.8)') "e0 =", e0
+ print *, ""
+ else
+ call NOCIRotFormula_getScalingParameters(this,sc,e0)
+ end if
+
+ do state=1,nstates
+ overlapIntegral=0
+ auxEnergy=0
+ do sysI=1,this%numberOfDisplacedSystems
+ overlapIntegral=overlapIntegral+signs%values(sysI)*this%configurationOverlapMatrix%values(1,sysI)*weights%values(sysI,state)
+ end do
+
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies
+ do otherSpeciesID=speciesID+1, this%molecularSystems(1)%numberOfQuantumSpecies
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(1,sysI)*weights%values(sysI,state)*&
+ ((e0+(1-e0)*exp(-(1-abs(this%configurationOverlapMatrix%values(1,sysI)))**4/sc**4))-1)
+
+ end do
+ write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // &
+ "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // &
+ " DFTcorrection energy = ", auxEnergyIntegral/overlapIntegral
+ auxEnergy=auxEnergy+auxEnergyIntegral/overlapIntegral
+ end do
+ end do
+
+ auxEnergyIntegral=0
+ do sysI=1,this%numberOfDisplacedSystems
+ auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHamiltonianMatrix%values(1,sysI)*weights%values(sysI,state)
+ end do
+ write (*,"(T9,A10,I3,A17, F25.12)") "STATE: ", state, "SCALED ENERGY = ", auxEnergyIntegral/overlapIntegral+auxEnergy
+ write (*,"(A)") ""
+ end do
+
+ end if
+
+ end subroutine NOCIRotFormula_compute
+
+ !>
+ !! @brief Get the empirical scaling parameters from the multilinear regression
+ !!
+ !! @param this
+ !<
+ subroutine NOCIRotFormula_getScalingParameters(this,sc,e0)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ real(8), intent(out) :: sc,e0
+
+ type(Matrix) :: momentMatrices(1:3), densityMatrix
+ integer :: i,j,k,speciesID,otherSpeciesID
+ real(8) :: b(0:6,1:2) !1 for sc, 2 for e0
+ real(8) :: x(1:6)
+
+!Regression parameters
+! Intercept
+! $x_1$: dim
+! $x_2$: DFT $T_p$
+! $x_3$: $\langle r_p \rangle$
+! $x_4$: $-E^c_{ep}$
+! $x_5$: E$_{0\ \mathrm{RoDFT}}-$E$_\mathrm{DFT}$
+! $x_6$: $\Delta E_{0-1 \mathrm{RoDFT}}$
+ b(0,1)=0.3881
+ b(1,1)=-0.0802
+ b(2,1)=17.22
+ b(3,1)=0.00948
+ b(4,1)=-7.41
+ b(5,1)=16.21
+ b(6,1)=122.3
+
+ b(0,2)=-0.6042
+ b(1,2)=0.5374
+ b(2,2)=-34.29
+ b(3,2)=-0.02577
+ b(4,2)=37.33
+ b(5,2)=-65.85
+ b(6,2)=-256.5
+
+ x(:)=0.0
+
+ x(1)=2
+ if(this%molecularSystems(1)%numberOfPointCharges .gt. 1) x(1)=1
+
+ do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies
+ !find proton kinetic energy
+ if(this%molecularSystems(1)%species(speciesID)%mass .ge. 1500_8 .and. this%molecularSystems(1)%species(speciesID)%mass .lt. 2500_8 .and. this%molecularSystems(1)%species(speciesID)%charge .eq. 1.0_8) then
+ x(2)=this%configurationKineticMatrix(speciesID)%values(1,1)
+
+ call DirectIntegralManager_getMomentIntegrals(this%molecularSystems(1),speciesID,1,momentMatrices(1))
+ call DirectIntegralManager_getMomentIntegrals(this%molecularSystems(1),speciesID,2,momentMatrices(2))
+ call DirectIntegralManager_getMomentIntegrals(this%molecularSystems(1),speciesID,3,momentMatrices(3))
+
+ call Matrix_constructor(densityMatrix,int(size( this%HFCoefficients(1,speciesID)%values, DIM = 1),8),int(size( this%HFCoefficients(1,speciesID)%values, DIM = 1),8),0.0_8)
+
+ do i = 1 , size( this%HFCoefficients(1,speciesID)%values, DIM = 1 )
+ do j = 1 , size( this%HFCoefficients(1,speciesID)%values, DIM = 1 )
+ do k = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1))
+
+ densityMatrix%values(i,j) = &
+ densityMatrix%values( i,j ) + &
+ ( this%HFCoefficients(1,speciesID)%values(i,k) &
+ * this%HFCoefficients(1,speciesID)%values(j,k) )
+ end do
+ end do
+ end do
+ densityMatrix%values = MolecularSystem_getEta(speciesID,this%molecularSystems(1)) * densityMatrix%values
+
+ if(this%molecularSystems(1)%numberOfPointCharges .gt. 1) then
+ x(3)=sqrt(sum( densityMatrix%values * momentMatrices(1)%values ) **2 +&
+ sum( densityMatrix%values * momentMatrices(2)%values ) **2)
+
+ else
+ x(3)=sqrt(sum( densityMatrix%values * momentMatrices(1)%values ) **2 +&
+ sum( densityMatrix%values * momentMatrices(2)%values ) **2 +&
+ sum( densityMatrix%values * momentMatrices(3)%values ) **2)
+ end if
+
+ do otherSpeciesID=1,speciesID-1
+ x(4)=x(4)+this%configurationDFTcorrelationMatrix(otherSpeciesID,speciesID)%values(1,1)
+ end do
+ do otherSpeciesID=speciesID+1,this%molecularSystems(1)%numberOfQuantumSpecies
+ x(4)=x(4)+this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(1,1)
+ end do
+ x(4)=-x(4)
+ exit
+ end if
+ end do
+
+ x(5)=this%configurationHamiltonianMatrix%values(1,1)-this%statesEigenvalues%values(1)
+ x(6)=this%statesEigenvalues%values(2)-this%statesEigenvalues%values(1)
+
+ sc=b(0,1)
+ e0=b(0,2)
+
+ do i=1,6
+ sc=sc+b(i,1)*x(i)
+ e0=e0+b(i,2)*x(i)
+ end do
+
+ if(sc<1.0E-8) sc=1.0E-8
+ if(e0<0.0) e0=0.0
+ if(e0>1.0) e0=1.0
+
+ write (*,'(A63)') "The sigmoid parameters"
+ write (*,'(A48,F15.8)') "e0 =", e0
+ write (*,'(A48,F15.8)') "sc =", sc
+ write (*,'(A63)') "were obtained from the regression parameters:"
+ write (*,'(A48,I6)') "rotational dimensions =", int(x(1))
+ write (*,'(A48,F15.8)') "proton kinetic energy =", x(2)
+ write (*,'(A48,F15.8)') "proton rotation radius =", x(3)
+ write (*,'(A48,F15.8)') "-proton/electron correlation energy =", x(4)
+ write (*,'(A48,F15.8)') "-Unscaled rotational ground state correction =", x(5)
+ write (*,'(A48,F15.8)') "Unscaled rotational first transition energy =", x(6)
+ write (*,'(A63)') ""
+
+ end subroutine NOCIRotFormula_getScalingParameters
+
+end module NOCIRotFormula_
+
diff --git a/src/NOCI/NOCIRunSCF.f90 b/src/NOCI/NOCIRunSCF.f90
new file mode 100644
index 00000000..2742d1d0
--- /dev/null
+++ b/src/NOCI/NOCIRunSCF.f90
@@ -0,0 +1,279 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module NOCIRunSCF_
+ use NOCIBuild_
+ use MolecularSystem_
+ use Matrix_
+ use Vector_
+ use DirectIntegralManager_
+ use MultiSCF_
+ use WaveFunction_
+ use omp_lib
+ implicit none
+
+ !>
+ !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
+ !!
+ !! @author Felix
+ !!
+ !! Creation data : 02-22
+ !!
+ !! History change:
+ !!
+ !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# Creation of the module.
+ !!
+ !<
+
+ public :: &
+ NOCIRunSCF_runHFs
+
+ private
+
+contains
+
+ !>
+ !! @brief Run a Hartree-Fock calculation at displaced geometries and fill CI matrix diagonals
+ !!
+ !! @param this -> NOCI instance
+ !<
+ subroutine NOCIRunSCF_runHFs(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+
+ integer, allocatable :: sysIbatch(:)
+ type(MultiSCF), allocatable :: MultiSCFParallelInstance(:)
+ type(WaveFunction), allocatable :: WaveFunctionParallelInstance(:,:)
+ type(Libint2Interface), allocatable :: Libint2ParallelInstance(:,:)
+ integer :: speciesID, otherSpeciesID, nspecies
+ integer :: sysI,me,mySysI
+ integer :: ncores, batchSize
+ integer :: coordsUnit
+ real(8) :: timeA
+ character(100) :: coordsFile
+ character(50) :: auxmethod
+
+ !$ timeA = omp_get_wtime()
+ !!Read HF energy of the non displaced SCF calculation
+ ! print *, "HF reference energy is ", hfEnergy
+ nspecies=molecularSystem_instance%numberOfQuantumSpecies
+
+ allocate(this%HFCoefficients(this%numberOfDisplacedSystems,nspecies))
+ allocate(this%systemLabels(this%numberOfDisplacedSystems))
+
+ call Matrix_constructor(this%configurationHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Matrix_constructor(this%configurationOverlapMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Vector_constructor(this%configurationCorrelationEnergies, this%numberOfDisplacedSystems, 0.0_8)
+ do speciesID=1, nspecies
+ call Matrix_constructor(this%configurationKineticMatrix(speciesID), &
+ int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Matrix_constructor(this%configurationPuntualMatrix(speciesID), &
+ int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Matrix_constructor(this%configurationExternalMatrix(speciesID), &
+ int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Matrix_constructor(this%configurationExchangeMatrix(speciesID), &
+ int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ do otherSpeciesID=speciesID, nspecies
+ call Matrix_constructor(this%configurationHartreeMatrix(speciesID,otherSpeciesID), &
+ int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ call Matrix_constructor(this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID), &
+ int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
+ end do
+ end do
+
+ coordsUnit=333
+ coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords"
+ open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted")
+
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ print *, "running KS calculations at the displaced geometries ... saving results on file ", coordsFile
+ else
+ print *, "running HF calculations at the displaced geometries ... saving results on file ", coordsFile
+ end if
+
+
+ write (coordsUnit,'(A25,I20)') "numberOfDisplacedSystems ", this%numberOfDisplacedSystems
+
+ !Allocate objets to distribute in parallel
+ ncores=CONTROL_instance%NUMBER_OF_CORES
+ batchSize=min(ncores,this%numberOfDisplacedSystems)
+ print *, "ncores", ncores, "batchsize", batchSize
+
+ call MolecularSystem_destroy()
+
+ !Skip priting scf iterations
+ CONTROL_instance%PRINT_LEVEL=0
+ CONTROL_instance%NUMBER_OF_CORES=1
+
+ allocate(sysIbatch(batchSize),&
+ MultiSCFParallelInstance(batchSize),&
+ WaveFunctionParallelInstance(nspecies,batchSize),&
+ Libint2ParallelInstance(nspecies,batchSize))
+
+ sysI=0
+ systemLoop: do while(sysI.le.this%numberOfDisplacedSystems)
+ !In serial, prepare systems
+ sysIbatch(:)=0
+ me=0
+ mySysI=sysI
+
+ do while(me.lt.batchSize)
+ mySysI=mySysI+1
+ if(mySysI .gt. this%numberOfDisplacedSystems) exit
+ me=me+1
+ sysIbatch(me)=mySysI
+
+ write(this%systemLabels(mySysI), '(A)') trim(this%molecularSystems(mySysI)%description)
+ call MultiSCF_constructor(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me),CONTROL_instance%ITERATION_SCHEME,this%molecularSystems(mySysI))
+ call MultiSCF_buildHcore(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me))
+ call MultiSCF_getInitialGuess(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me))
+ call DirectIntegralManager_constructor(Libint2ParallelInstance(1:nspecies,me),this%molecularSystems(mySysI))
+
+ end do
+ ! STOP "NOCI runs only work with CONTROL_instance%INTEGRAL_STORAGE == MEMORY"
+
+ !In parallel, run SCF calculations without calling lowdin-scf.x
+ call OMP_set_num_threads(ncores)
+ !$omp parallel&
+ !$omp& private(mySysI,auxmethod,speciesID,otherSpeciesID)
+ !$omp do schedule(dynamic)
+ procs: do me=1, batchSize
+ mySysI=sysIbatch(me)
+ if(mySysI .eq. 0) cycle procs
+
+ if (CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then
+ do speciesID=1, nspecies
+ call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(&
+ speciesID, &
+ WaveFunctionParallelInstance(speciesID,me)%densityMatrix, &
+ WaveFunctionParallelInstance(speciesID,me)%fourCenterIntegrals(speciesID)%values, &
+ this%molecularSystems(mySysI),Libint2ParallelInstance(speciesID,me))
+ end do
+
+ do speciesID=1, nspecies-1
+ do otherSpeciesID=speciesID+1,nspecies
+ call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(&
+ speciesID, otherSpeciesID, &
+ WaveFunctionParallelInstance(speciesID,me)%densityMatrix, &
+ WaveFunctionParallelInstance(speciesID,me)%fourCenterIntegrals(otherSpeciesID)%values, &
+ this%molecularSystems(mySysI),Libint2ParallelInstance(speciesID,me),Libint2ParallelInstance(otherSpeciesID,me))
+ end do
+ end do
+ end if
+
+ call MultiSCF_solveHartreeFockRoothan(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me),Libint2ParallelInstance(1:nspecies,me))
+
+ !Save HF results
+ ! call MultiSCF_saveWfn(MultiSCF_instance,WaveFunction_instance)
+ ! call MolecularSystem_copyConstructor(this%molecularSystems(sysI),molecularSystem_instance)
+ this%configurationHamiltonianMatrix%values(mySysI,mySysI)=MultiSCFParallelInstance(me)%totalEnergy
+
+ do speciesID = 1, nspecies
+ this%HFCoefficients(mySysI,speciesID) = WaveFunctionParallelInstance(speciesID,me)%waveFunctionCoefficients
+ this%configurationKineticMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%kineticEnergy
+ this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%puntualInteractionEnergy
+ this%configurationExternalMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%externalPotentialEnergy
+ this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%exchangeHFEnergy
+ do otherSpeciesID = speciesID, this%molecularSystems(mySysI)%numberOfQuantumSpecies
+ this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysI)=&
+ WaveFunctionParallelInstance(speciesID,me)%hartreeEnergy(otherSpeciesID)
+ this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysI)=&
+ WaveFunctionParallelInstance(speciesID,me)%exchangeCorrelationEnergy(otherSpeciesID)
+ end do
+ end do
+
+ ! Compute HF energy with KS determinants
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ if(CONTROL_instance%METHOD.eq."RKS") then
+ auxmethod="RHF"
+ else
+ auxmethod="UHF"
+ end if
+
+ do speciesID = 1, nspecies
+ WaveFunctionParallelInstance(speciesID,me)%exchangeCorrelationEnergy=0.0_8
+ WaveFunctionParallelInstance(speciesID,me)%exchangeCorrelationMatrix%values=0.0_8
+ this%exactExchangeFraction(speciesID)=WaveFunctionParallelInstance(speciesID,me)%exactExchangeFraction
+ WaveFunctionParallelInstance(speciesID,me)%exactExchangeFraction=1.0_8
+ end do
+ call MultiSCF_obtainFinalEnergy(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me),Libint2ParallelInstance(1:nspecies,me),auxmethod)
+ !Difference between HF and KS energies
+ this%configurationCorrelationEnergies%values(mySysI)=this%configurationHamiltonianMatrix%values(mySysI,mySysI)-MultiSCFParallelInstance(me)%totalEnergy
+ end if
+ end do procs
+ !$omp end do nowait
+ !$omp end parallel
+
+ !In serial, free memory and print
+ do me=1, batchSize
+ mySysI=sysIbatch(me)
+ if(mySysI .eq. 0) exit systemLoop
+
+ write (coordsUnit,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", mySysI, "Energy", this%configurationHamiltonianMatrix%values(mySysI,mySysI), &
+ "Correlation energy", this%configurationCorrelationEnergies%values(mySysI)
+ call MolecularSystem_showCartesianMatrix(this%molecularSystems(mySysI),unit=coordsUnit)
+
+ if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then
+ write (*,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", mySysI, "Energy", this%configurationHamiltonianMatrix%values(mySysI,mySysI), &
+ "Correlation energy", this%configurationCorrelationEnergies%values(mySysI)
+ call MolecularSystem_showCartesianMatrix(this%molecularSystems(mySysI))
+ ! do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ ! print *, "sysI", sysI, "speciesID", speciesID, "occupation number", MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(mySysI))
+ ! end do
+ end if
+
+ call DirectIntegralManager_destructor(Libint2ParallelInstance(1:nspecies,me))
+ call MultiSCF_destructor(MultiSCFParallelInstance(me))
+
+ sysI=mySysI
+
+ end do
+
+ CONTROL_instance%NUMBER_OF_CORES=ncores
+
+ !!Screen geometries with high energies
+ ! if( CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD .ne. 0.0 .and. &
+ ! testEnergy .gt. this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD) then
+ ! write (coordsUnit,"(A,F20.12)") "Skipping system with high energy", testEnergy
+ ! this%numberOfEnergyRejectedSystems=this%numberOfEnergyRejectedSystems+1
+ ! else
+ ! if(this%numberOfEnergyRejectedSystems .gt. 0) &
+ ! write (*,'(A10,I10,A,F18.12)') "Rejected ", this%numberOfEnergyRejectedSystems, &
+ ! " geometries with energy higher than", this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD
+
+ end do systemLoop
+
+ close(coordsUnit)
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for HF calculations at displaced geometries : ", omp_get_wtime() - timeA ," (s)"
+
+ end subroutine NOCIRunSCF_runHFs
+
+end module NOCIRunSCF_
+
diff --git a/src/NOCI/NOCISuperposed.f90 b/src/NOCI/NOCISuperposed.f90
new file mode 100644
index 00000000..eae2bba7
--- /dev/null
+++ b/src/NOCI/NOCISuperposed.f90
@@ -0,0 +1,639 @@
+!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! UNIVERSIDAD NACIONAL DE COLOMBIA"
+!! PROF. ANDRES REYES GROUP"
+!! http://www.qcc.unal.edu.co"
+!!
+!! UNIVERSIDAD DE GUADALAJARA"
+!! PROF. ROBERTO FLORES GROUP"
+!! http://www.cucei.udg.mx/~robertof"
+!!
+!! AUTHORS
+!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!! CONTRIBUTORS
+!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
+!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
+!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
+!!
+!!
+!! Todos los derechos reservados, 2011
+!!
+!!******************************************************************************
+
+module NOCISuperposed_
+ use NOCIBuild_
+ use NOCIMatrices_
+ use MolecularSystem_
+ use ParticleManager_
+ use Matrix_
+ use Vector_
+ use DirectIntegralManager_
+ use omp_lib
+ implicit none
+
+ !>
+ !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
+ !!
+ !! @author Felix
+ !!
+ !! Creation data : 02-22
+ !!
+ !! History change:
+ !!
+ !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
+ !! -# Creation of the module.
+ !!
+ !<
+
+ public :: &
+ NOCISuperposed_generateSuperposedSystem,&
+ NOCISuperposed_buildDensityMatrix,&
+ NOCISuperposed_getNaturalOrbitals,&
+ NOCISuperposed_saveToFile
+
+ private
+
+contains
+
+ !>
+ !! @brief Generates one molecular system combining all the displaced geometries and coefficients
+ !!
+ !! @param this
+ !<
+ subroutine NOCISuperposed_generateSuperposedSystem(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+ type(MolecularSystem) :: auxMolecularSystem
+ type(Matrix), allocatable :: auxCoefficients(:)
+ type(IVector), allocatable :: auxBasisList(:)
+
+ integer :: i, sysI, speciesID
+ integer :: numberOfSpecies
+
+ real(8) :: timeA
+
+ !$ timeA = omp_get_wtime()
+
+ if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
+
+ numberOfSpecies=this%molecularSystems(1)%numberOfQuantumSpecies
+
+ allocate(this%sysBasisList(this%numberOfDisplacedSystems,numberOfSpecies),&
+ auxCoefficients(numberOfSpecies),&
+ auxBasisList(numberOfSpecies))
+
+ !Create a super molecular system
+ !!!Merge coefficients from system 1 and system 2
+ call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, this%molecularSystems(1), this%molecularSystems(2), &
+ this%sysBasisList(1,:),this%sysBasisList(2,:))
+
+ call NOCIMatrices_mergeCoefficients(this%HFCoefficients(1,:),this%HFCoefficients(2,:),&
+ this%molecularSystems(1),this%molecularSystems(2),this%mergedMolecularSystem,&
+ this%sysBasisList(1,:),this%sysBasisList(2,:),this%mergedCoefficients(:))
+
+ ! do speciesID=1, numberOfSpecies
+ ! print *, "2", speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem)
+ ! print *, "2", speciesID, "mergedCoefficients"
+ ! call Matrix_show(this%mergedCoefficients(speciesID))
+ ! end do
+ !
+ !! Loop other systems expanding the merged coefficients matrix
+ do sysI=3, this%numberOfDisplacedSystems
+ call MolecularSystem_copyConstructor(auxMolecularSystem,this%mergedMolecularSystem)
+ do speciesID=1, numberOfSpecies
+ call Matrix_copyConstructor(auxCoefficients(speciesID), this%mergedCoefficients(speciesID))
+ end do
+ call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, auxMolecularSystem, this%molecularSystems(sysI), &
+ auxBasisList,this%sysBasisList(sysI,:),reorder=.false.)
+ call NOCIMatrices_mergeCoefficients(auxCoefficients,this%HFCoefficients(sysI,:),&
+ auxMolecularSystem,this%molecularSystems(sysI),this%mergedMolecularSystem,&
+ auxBasisList,this%sysBasisList(sysI,:),this%mergedCoefficients(:))
+ ! do speciesID=1, numberOfSpecies
+ ! print *, sysI, speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem)
+ ! print *, sysI, speciesID, "mergedCoefficients"
+ ! call Matrix_show(this%mergedCoefficients(speciesID))
+ ! end do
+ end do
+
+ !!!Fix basis list size
+ do sysI=1, this%numberOfDisplacedSystems
+ do speciesID=1, numberOfSpecies
+ call Vector_copyConstructorInteger(auxBasisList(speciesID),this%sysBasisList(sysI,speciesID))
+ call Vector_constructorInteger(this%sysBasisList(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,this%mergedMolecularSystem), 0)
+ do i=1, size(auxBasisList(speciesID)%values)
+ this%sysBasisList(sysI,speciesID)%values(i)=auxBasisList(speciesID)%values(i)
+ end do
+ ! print *, "sysI", sysI, "speciesID", speciesID, "after list"
+ ! call Vector_showInteger(this%sysBasisList(sysI,speciesID))
+ end do
+ end do
+
+ write(*,*) ""
+ print *, "Superposed molecular system geometry"
+ write(*,*) "---------------------------------- "
+ ! call MolecularSystem_showInformation()
+ ! call MolecularSystem_showParticlesInformation()
+ call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem)
+ call MolecularSystem_showCartesianMatrix(molecularSystem_instance)
+ particleManager_instance => molecularSystem_instance%allParticles
+ call ParticleManager_setOwner()
+ call MolecularSystem_saveToFile()
+
+ ! do speciesID=1, numberOfSpecies
+ ! write(*,*) ""
+ ! write(*,*) " Merged Occupied Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name )
+ ! write(*,*) "---------------------------------- "
+ ! write(*,*) ""
+ ! print *, "contractions", speciesID, int(MolecularSystem_getTotalNumberOfContractions(speciesID),8)
+ ! print *, "ocupation", speciesID, int(MolecularSystem_getOcupationNumber(speciesID),8)
+ ! call Matrix_constructor(auxCoefficients(speciesID),int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),&
+ ! int(MolecularSystem_getOcupationNumber(speciesID),8),0.0_8)
+ ! do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ ! do j=1, MolecularSystem_getOcupationNumber(speciesID)
+ ! auxCoefficients(speciesID)%values(i,j)=mergedCoefficients(speciesID)%values(i,j)
+ ! end do
+ ! end do
+ ! call Matrix_show(auxCoefficients(speciesID))
+ ! end do
+
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time creating supermolecular system : ", omp_get_wtime() - timeA ," (s)"
+ !$ timeA = omp_get_wtime()
+
+ deallocate(auxCoefficients,&
+ auxBasisList)
+
+ return
+
+ end subroutine NOCISuperposed_generateSuperposedSystem
+
+ !>
+ !! @brief Generates the NOCI density matrix in the superposed molecular system
+ !!
+ !! @param this
+ !<
+ subroutine NOCISuperposed_buildDensityMatrix(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+
+ type(Matrix) :: molecularOverlapMatrix
+ type(Matrix), allocatable :: inverseOverlapMatrix(:) !,kineticMatrix(:), attractionMatrix(:), externalPotMatrix(:)
+ integer :: state
+ integer :: i,ii,j,jj,mu,nu, sysI, sysII, speciesID, otherSpeciesID
+ integer :: particlesPerOrbital
+ integer :: numberOfSpecies
+
+ integer :: densUnit
+ character(100) :: densFile
+ character(50) :: arguments(2), auxString
+ type(Matrix), allocatable :: exchangeCorrelationMatrices(:)
+ type(Matrix) :: dftEnergyMatrix
+ real(8), allocatable :: particlesInGrid(:)
+ real(8) :: timeA
+
+ !$ timeA = omp_get_wtime()
+
+ if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
+
+ numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
+
+ allocate(InverseOverlapMatrix(numberOfSpecies))
+
+ print *, ""
+ print *, "Computing overlap integrals for the superposed systems..."
+ print *, ""
+ do speciesID = 1, numberOfSpecies
+ call DirectIntegralManager_getOverlapIntegrals(molecularSystem_instance,speciesID,this%mergedOverlapMatrix(speciesID))
+ end do
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)"
+ !$ timeA = omp_get_wtime()
+
+ print *, ""
+ print *, "Building merged density matrices for the superposed systems..."
+ print *, ""
+ !!Build the merged density matrix
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ do speciesID=1, numberOfSpecies
+ call Matrix_constructor(this%mergedDensityMatrix(state,speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8)
+ end do
+ end do
+ !!Fill the merged density matrix
+ ! "Diagonal" terms - same system
+ do sysI=1, this%numberOfDisplacedSystems
+ do speciesID=1, numberOfSpecies
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
+ do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
+ if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle
+ do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
+ if(this%sysBasisList(sysI,speciesID)%values(nu) .eq. 0) cycle
+ do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
+ ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + &
+ this%configurationCoefficients%values(sysI,state)**2*&
+ this%mergedCoefficients(speciesID)%values(mu,ii)*&
+ this%mergedCoefficients(speciesID)%values(nu,ii)*&
+ particlesPerOrbital
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ !!"Non Diagonal" terms - system pairs
+ do sysI=1, this%numberOfDisplacedSystems
+ do sysII=sysI+1, this%numberOfDisplacedSystems
+ if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle
+ !!Compute molecular overlap matrix and its inverse
+ do speciesID=1, numberOfSpecies
+ call Matrix_constructor(molecularOverlapMatrix, &
+ int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), &
+ int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 )
+ call Matrix_constructor(inverseOverlapMatrix(speciesID), &
+ int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), &
+ int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 )
+
+ do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysI
+ if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle
+ do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysII
+ if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle
+ do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
+ ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i
+ do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))
+ jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j
+ ! print *, "i, j, mu, nu, coefI, coefII", i,j,mu,nu,mergedCoefficients(speciesID)%values(mu,ii),mergedCoefficients(speciesID)%values(nu,jj)
+ molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+&
+ this%mergedCoefficients(speciesID)%values(mu,ii)*&
+ this%mergedCoefficients(speciesID)%values(nu,jj)*&
+ this%mergedOverlapMatrix(speciesID)%values(mu,nu)
+ end do
+ end do
+ end do
+ end do
+ ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID
+ ! call Matrix_show(molecularOverlapMatrix)
+ if(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) .ne. 0) &
+ inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix)
+ end do
+
+ ! Compute density contributions
+ do speciesID=1, numberOfSpecies
+ particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
+ do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
+ if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle
+ do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
+ if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
+ ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i
+ do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))
+ jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j
+ this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + &
+ this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationOverlapMatrix%values(sysI,sysII)*&
+ inverseOverlapMatrix(speciesID)%values(j,i)*&
+ this%mergedCoefficients(speciesID)%values(mu,ii)*&
+ this%mergedCoefficients(speciesID)%values(nu,jj)*&
+ particlesPerOrbital
+ this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(nu,mu) + &
+ this%configurationCoefficients%values(sysI,state)*&
+ this%configurationCoefficients%values(sysII,state)*&
+ this%configurationOverlapMatrix%values(sysI,sysII)*&
+ inverseOverlapMatrix(speciesID)%values(j,i)*&
+ this%mergedCoefficients(speciesID)%values(mu,ii)*&
+ this%mergedCoefficients(speciesID)%values(nu,jj)*&
+ particlesPerOrbital
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ !!symmetrize
+ ! do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
+ ! do nu = mu+1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
+ ! this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu)
+ ! end do
+ ! end do
+ end do
+ end do
+
+ !! Open file - to write density matrices
+ densUnit = 29
+
+ densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
+ open(unit = densUnit, file=trim(densFile), status="replace", form="formatted")
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ do speciesID=1, numberOfSpecies
+ ! print *, "this%mergedDensityMatrix", state, trim( MolecularSystem_instance%species(speciesID)%name )
+ ! call Matrix_show(this%mergedDensityMatrix(state,speciesID))
+ write(auxString,*) state
+ arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
+ arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxString))
+ call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) )
+ end do
+ end do
+
+ ! if(CONTROL_instance%ELECTRON_EXCHANGE_CORRELATION_FUNCTIONAL.ne."NONE" .or. &
+ ! CONTROL_instance%NUCLEAR_ELECTRON_CORRELATION_FUNCTIONAL.ne."NONE") then
+ ! print *, "Superposed DFT energies:"
+
+ ! allocate(exchangeCorrelationMatrices(numberOfSpecies), &
+ ! particlesInGrid(numberOfSpecies))
+ ! call DensityFunctionalTheory_buildFinalGrid()
+ ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ ! call Matrix_constructor(dftEnergyMatrix, int(numberOfSpecies,8), &
+ ! int(numberOfSpecies,8), 0.0_8 )
+ ! do speciesID=1, numberOfSpecies
+ ! call Matrix_constructor(exchangeCorrelationMatrices(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
+ ! int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8)
+ ! end do
+ ! call DensityFunctionalTheory_finalDFT(this%mergedDensityMatrix(state,1:numberOfSpecies), &
+ ! exchangeCorrelationMatrices, &
+ ! dftEnergyMatrix, &
+ ! particlesInGrid)
+
+ ! do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ ! do otherSpeciesID = speciesID, MolecularSystem_instance%numberOfQuantumSpecies
+ ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ ! "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
+ ! " DFT Corr. energy = ", dftEnergyMatrix%values(speciesID,otherSpeciesID)
+ ! end do
+ ! end do
+ ! end do
+ ! end if
+
+ close(densUnit)
+
+ deallocate(inverseOverlapMatrix)
+
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging density matrices : ", omp_get_wtime() - timeA ," (s)"
+
+ return
+
+ ! allocate(kineticMatrix(numberOfSpecies),&
+ ! attractionMatrix(numberOfSpecies),&
+ ! externalPotMatrix(numberOfSpecies))
+ ! do speciesID = 1, numberOfSpecies
+ ! call DirectIntegralManager_getKineticIntegrals(molecularSystem_instance,speciesID,kineticMatrix(speciesID))
+ ! if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then
+ ! kineticMatrix(speciesID)%values = &
+ ! kineticMatrix(speciesID)%values * &
+ ! ( 1.0_8/MolecularSystem_getMass( speciesID ) -1.0_8 / MolecularSystem_getTotalMass() )
+ ! else
+ ! kineticMatrix(speciesID)%values = &
+ ! kineticMatrix(speciesID)%values / &
+ ! MolecularSystem_getMass( speciesID )
+ ! end if
+
+ ! call DirectIntegralManager_getAttractionIntegrals(molecularSystem_instance,speciesID,attractionMatrix(speciesID))
+ ! attractionMatrix(speciesID)%values=attractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID))
+
+ ! if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ ! call DirectIntegralManager_getExternalPotentialIntegrals(molecularSystem_instance,speciesID,externalPotMatrix(speciesID))
+ ! end do
+ ! write(*,*) ""
+ ! write(*,*) "=========================================================="
+ ! write(*,*) " ONE BODY ENERGY CONTRIBUTIONS OF THE SUPERPOSED SYSTEMS: "
+ ! write(*,*) ""
+ ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ ! write(*,*) " STATE: ", state
+ ! do speciesID=1, numberOfSpecies
+ ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ ! " Kinetic energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*kineticMatrix(speciesID)%values)
+ ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ ! "/Fixed interact. energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*attractionMatrix(speciesID)%values)
+ ! if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
+ ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name) // &
+ ! " Ext Pot energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*externalPotMatrix(speciesID)%values)
+ ! print *, ""
+ ! end do
+ ! print *, ""
+ ! end do
+ ! deallocate(kineticMatrix,&
+ ! attractionMatrix,&
+ ! externalPotMatrix)
+
+ end subroutine NOCISuperposed_buildDensityMatrix
+
+ !>
+ !! @brief Generates the NOCI natural orbitals from the NOCI density matrix in the superposed molecular system
+ !!
+ !! @param this
+ !<
+ subroutine NOCISuperposed_getNaturalOrbitals(this)
+ implicit none
+ type(NonOrthogonalCI) :: this
+
+ type(Matrix) :: auxMatrix, densityEigenVectors, auxdensityEigenVectors
+ type(Vector) :: auxVector, densityEigenValues, auxdensityEigenValues
+
+ integer :: state
+ integer :: i,j,k,speciesID
+ integer :: numberOfSpecies
+
+ integer :: densUnit
+ character(100) :: densFile
+ character(50) :: arguments(2), auxString
+ real(8) :: timeA
+
+ !$ timeA = omp_get_wtime()
+ if(.not. CONTROL_instance%CI_NATURAL_ORBITALS) return
+ if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
+
+ numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
+
+ write(*,*) ""
+ write(*,*) "============================================="
+ write(*,*) " NATURAL ORBITALS OF THE SUPERPOSED SYSTEMS: "
+ write(*,*) ""
+ !! Open file - to write density matrices
+ densUnit = 29
+
+ densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
+ open(unit = densUnit, file=trim(densFile), status="old", form="formatted", position="append")
+
+ do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+
+ write(*,*) " STATE: ", state
+
+ do speciesID=1, numberOfSpecies
+
+ write(*,*) ""
+ write(*,*) " Natural Orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name )
+ write(*,*) "--------------------------------------------------------------"
+
+ call Vector_constructor ( densityEigenValues, &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 )
+ call Matrix_constructor ( densityEigenVectors, &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 )
+
+ call Vector_constructor ( auxdensityEigenValues, &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 )
+ call Matrix_constructor ( auxdensityEigenVectors, &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
+ int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 )
+
+ !! Lowdin orthogonalization of the density matrix
+ auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), 0.5_8, method="SVD" )
+
+ auxMatrix%values=matmul(matmul(auxMatrix%values,this%mergedDensityMatrix(state,speciesID)%values),auxMatrix%values)
+
+ ! print *, "Diagonalizing non orthogonal CI density Matrix..."
+
+ !! Calcula valores y vectores propios de matriz de densidad CI ortogonal.
+ call Matrix_eigen(auxMatrix , auxdensityEigenValues, auxdensityEigenVectors, SYMMETRIC )
+
+ !! Transform back to the atomic basis
+ auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), -0.5_8, method="SVD" )
+
+ auxdensityEigenVectors%values=matmul(auxMatrix%values,auxdensityEigenVectors%values)
+
+ ! reorder and count significant occupations
+ k=0
+ do i = 1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ densityEigenValues%values(i) = auxdensityEigenValues%values(MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1)
+ densityEigenVectors%values(:,i) = auxdensityEigenVectors%values(:,MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1)
+ if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) k=k+1
+ end do
+ if(k .eq. 0) k=1
+ ! Print eigenvectors with occupation larger than 0.01
+ call Vector_constructor(auxVector,k,0.0_8)
+ call Matrix_constructor(auxMatrix,int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),int(k,8),0.0_8)
+ k=0
+ do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) then
+ k=k+1
+ auxVector%values(k)=densityEigenValues%values(i)
+ do j=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ auxMatrix%values(j,k)=densityEigenVectors%values(j,i)
+ end do
+ end if
+ end do
+ !densityEigenVectors
+ call Matrix_show( auxMatrix , &
+ rowkeys = MolecularSystem_getlabelsofcontractions( speciesID ), &
+ columnkeys = string_convertvectorofrealstostring( auxVector ),&
+ flags=WITH_BOTH_KEYS)
+
+ write(*,"(A10,A10,A20,I5,A15,F17.12)") "number of ", trim(MolecularSystem_getNameOfSpecies( speciesID )) ," particles in state", state , &
+ " density matrix: ", sum( transpose(this%mergedDensityMatrix(state,speciesID)%values)*this%mergedOverlapMatrix(speciesID)%values)
+ write(*,"(A10,A10,A40,F17.12)") "sum of ", trim(MolecularSystem_getNameOfSpecies( speciesID )) , "natural orbital occupations", sum(densityEigenValues%values)
+
+ ! density matrix check
+ ! auxMatrix%values=0.0
+ ! do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ ! do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ ! do k=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
+ ! auxMatrix%values(mu,nu)=auxMatrix%values(mu,nu)+densityEigenValues%values(k)*&
+ ! densityEigenVectors%values(mu,k)*densityEigenVectors%values(nu,k)
+ ! end do
+ ! end do
+ ! end do
+ ! print *, "atomicDensityMatrix again"
+ ! call Matrix_show(auxMatrix)
+
+ write(auxString,*) state
+
+ arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name )
+ arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring))
+
+ call Matrix_writeToFile ( densityEigenVectors, densUnit , arguments=arguments(1:2) )
+
+ arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name )
+ arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring))
+
+ call Vector_writeToFile( densityEigenValues, densUnit, arguments=arguments(1:2) )
+
+ write(*,*) " End of natural orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name )
+ end do
+ end do
+
+ write(*,*) ""
+ write(*,*) " END OF NATURAL ORBITALS"
+ write(*,*) "=============================="
+ write(*,*) ""
+
+ close(densUnit)
+
+ !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI natural orbitals : ", omp_get_wtime() - timeA ," (s)"
+
+ return
+
+ end subroutine NOCISuperposed_getNaturalOrbitals
+
+ !>
+ !! @brief Save NOCI results to file
+ !!
+ !! @param
+ !<
+ subroutine NOCISuperposed_saveToFile(this)
+ type(NonOrthogonalCI) :: this
+ integer :: nociUnit, speciesID, numberOfSpecies, sysI
+ character(100) :: prefix, nociFile
+ character(50) :: arguments(2), auxString
+
+ !Save merged molecular system
+ call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem)
+
+ prefix=trim(CONTROL_instance%INPUT_FILE)//"NOCI"
+ call MolecularSystem_saveToFile(prefix)
+
+ numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
+
+ nociUnit=123
+ nociFile=trim(prefix)//".states"
+ open(unit = nociUnit, file=trim(nociFile), status="replace", form="unformatted")
+
+ arguments(1:1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS"
+ call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=this%numberOfDisplacedSystems, arguments=arguments(1:1) )
+
+ arguments(1:1) = "NOCI-NUMBEROFSPECIES"
+ call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) )
+
+ arguments(1:1) = "NOCI-CONFIGURATIONCOEFFICIENTS"
+ call Matrix_writeToFile ( this%configurationCoefficients, nociUnit , binary=.true., arguments=arguments(1:1) )
+
+ arguments(1:1) = "NOCI-CONFIGURATIONENERGIES"
+ call Vector_writeToFile ( this%statesEigenvalues, nociUnit , binary=.true., arguments=arguments(1:1) )
+
+ arguments(1) = "MERGEDCOEFFICIENTS"
+ do speciesID=1, numberOfSpecies
+ arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
+ call Matrix_writeToFile ( this%mergedCoefficients(speciesID), nociUnit, binary=.true. , arguments=arguments(1:2) )
+ end do
+
+ do sysI=1, this%numberOfDisplacedSystems
+ do speciesID=1, numberOfSpecies
+ write(auxString,*) sysI
+ arguments(1) = "SYSBASISLIST"//trim(auxString)
+ arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
+ call Vector_writeToFileInteger(this%sysBasisList(sysI,speciesID), nociUnit, binary=.true., arguments=arguments(1:2) )
+ end do
+ end do
+
+ ! do state=1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems)
+ ! end do
+
+ ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
+ ! write(auxString,*) state
+ ! call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) )
+ ! end do
+ ! end do
+
+ close(nociUnit)
+
+ end subroutine NOCISuperposed_saveToFile
+
+
+end module NOCISuperposed_
+
diff --git a/src/NOCI/NonOrthogonalCI.f90 b/src/NOCI/NonOrthogonalCI.f90
deleted file mode 100644
index 756d2f01..00000000
--- a/src/NOCI/NonOrthogonalCI.f90
+++ /dev/null
@@ -1,3450 +0,0 @@
-!******************************************************************************
-!! This code is part of LOWDIN Quantum chemistry package
-!!
-!! this program has been developed under direction of:
-!!
-!! UNIVERSIDAD NACIONAL DE COLOMBIA"
-!! PROF. ANDRES REYES GROUP"
-!! http://www.qcc.unal.edu.co"
-!!
-!! UNIVERSIDAD DE GUADALAJARA"
-!! PROF. ROBERTO FLORES GROUP"
-!! http://www.cucei.udg.mx/~robertof"
-!!
-!! AUTHORS
-!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA
-!!
-!! CONTRIBUTORS
-!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA
-!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO
-!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA
-!!
-!!
-!! Todos los derechos reservados, 2011
-!!
-!!******************************************************************************
-
-module NonOrthogonalCI_
- use Math_
- use Exception_
- use MolecularSystem_
- use ParticleManager_
- use Matrix_
- use ReadTransformedIntegrals_
- use Lebedev_
- use Matrix_
- use Vector_
- use Solver_
- use DirectIntegralManager_
- use Libint2Interface_
- use MultiSCF_
- use WaveFunction_
- use String_
- use omp_lib
- implicit none
-
- !>
- !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727
- !!
- !! @author Felix
- !!
- !! Creation data : 02-22
- !!
- !! History change:
- !!
- !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co )
- !! -# Creation of the module.
- !!
- !<
-
- type, public :: NonOrthogonalCI
- logical :: isInstanced
- integer :: numberOfDisplacedSystems
- integer :: numberOfEnergyRejectedSystems
- integer :: numberOfEllipsoidRejectedSystems
- integer :: numberOfPPdistanceRejectedSystems
- integer :: numberOfNPdistanceRejectedSystems
- integer :: numberOfEquivalentSystems
- integer :: numberOfTransformedCenters
- integer :: numberOfIndividualTransformations
- integer :: printMatrixThreshold
- integer, allocatable :: rotationCenterList(:,:)
- type(Matrix) :: configurationOverlapMatrix, configurationHamiltonianMatrix, configurationCoefficients
- type(Matrix), allocatable :: configurationKineticMatrix(:), configurationPuntualMatrix(:), configurationExternalMatrix(:), configurationExchangeMatrix(:)
- type(Matrix), allocatable :: configurationHartreeMatrix(:,:)
- type(Vector) :: configurationCorrelationEnergies, statesEigenvalues
- type(IVector), allocatable :: sysBasisList(:,:)
- type(Matrix), allocatable :: HFCoefficients(:,:)
- type(Matrix), allocatable :: mergedCoefficients(:)
- type(Matrix), allocatable :: mergedOverlapMatrix(:)
- type(Matrix), allocatable :: mergedDensityMatrix(:,:)
- type(MolecularSystem), allocatable :: molecularSystems(:)
- type(MolecularSystem) :: mergedMolecularSystem
- character(50) :: transformationType
- character(15),allocatable :: systemLabels(:)
- real(8) :: refEnergy
- ! integer :: numberOfUniqueSystems !sort of symmetry
- ! integer :: numberOfUniquePairs !sort of symmetry
- ! type(IVector) :: systemTypes !sort of symmetry
- ! type(IMatrix) :: configurationPairTypes !, uniqueOverlapElements, uniqueHamiltonianElements
- ! type(MolecularSystem), allocatable :: uniqueMolecularSystems(:)
- end type NonOrthogonalCI
-
- type(NonOrthogonalCI), public :: NonOrthogonalCI_instance
-
- public :: &
- NonOrthogonalCI_constructor,&
- NonOrthogonalCI_displaceGeometries,&
- NonOrthogonalCI_readGeometries,&
- NonOrthogonalCI_runHFs,&
- NonOrthogonalCI_buildOverlapAndHamiltonianMatrix,&
- NonOrthogonalCI_diagonalizeCImatrix,&
- NonOrthogonalCI_generateSuperposedSystem,&
- NonOrthogonalCI_buildDensityMatrix,&
- NonOrthogonalCI_getNaturalOrbitals,&
- NonOrthogonalCI_saveToFile,&
- NonOrthogonalCI_computeFranckCondon
-
- private
-
-contains
-
- !>
- !! @brief Allocates memory and run HF calculations to be used in the construction of the NOCI matrix
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_constructor(this)
- implicit none
- type(NonOrthogonalCI) :: this
- integer :: numberOfRotationCenters, numberOfTranslationCenters
- integer :: p,q,r
-
- print *, "-------------------------------------------------------------"
- print *, "STARTING NON ORTHOGONAL CONFIGURATION INTERACTION CALCULATION"
- print *, "-------------------------------------------------------------"
- print *, ""
- this%isInstanced=.true.
- this%numberOfDisplacedSystems=0
- this%numberOfEnergyRejectedSystems=0
- this%numberOfEllipsoidRejectedSystems=0
- this%numberOfPPdistanceRejectedSystems=0
- this%numberOfNPdistanceRejectedSystems=0
- ! this%numberOfUniqueSystems=0
- ! this%numberOfUniquePairs=0
- this%printMatrixThreshold=30
- numberOfTranslationCenters=0
- numberOfRotationCenters=0
-
- allocate(this%rotationCenterList(size(MolecularSystem_instance%allParticles),2))
- !For rotations, 0,0: leave alone, N,M: rotation center number to be rotated around point M
- this%rotationCenterList=0
-
- !!Translation count
- do p = 1, size(MolecularSystem_instance%allParticles)
-
- if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.gt.numberOfTranslationCenters) &
- numberOfTranslationCenters=MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter
-
- if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.ne.0) &
- write (*,"(A,A10,A,3F9.5,A)") "Particle ", trim(ParticleManager_getSymbol(p)), &
- " basis functions at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), &
- " are going to be displaced"
- end do
-
- !!Rotation count
- do p = 1, size(MolecularSystem_instance%allParticles)
- if(MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint.eq.0) cycle
- write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(p)), &
- " located at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), &
- " is center of rotation number", MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint
-
- do q = 1, size(MolecularSystem_instance%allParticles)
- if(MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround .eq. &
- MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint) then
- write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(q)), &
- " basis functions at ", MolecularSystem_instance%allParticles(q)%particlePtr%origin(1:3), &
- " are going to be rotated around center ", MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround
-
- if(q .eq. MolecularSystem_instance%allParticles(q)%particlePtr%owner) then
- !in the case of several species with the same center, rotate them as one
- numberOfRotationCenters=numberOfRotationCenters+1
- this%rotationCenterList(q,1)=numberOfRotationCenters
- !find childs
- if ( allocated(MolecularSystem_instance%allParticles(q)%particlePtr%childs) ) then
- do r=1,size(MolecularSystem_instance%allParticles(q)%particlePtr%childs)
- this%rotationCenterList( MolecularSystem_instance%allParticles(q)%particlePtr%childs(r),1)=numberOfRotationCenters
- end do
- end if
- end if
- this%rotationCenterList(q,2)=p
- end if
- end do
- end do
- print *, ""
-
- ! print *, "this%rotationCenterList"
- ! do p=1, size(MolecularSystem_instance%allParticles)
- ! print *, "Particle ", trim(ParticleManager_getSymbol(p)),this%rotationCenterList(p,1), this%rotationCenterList(p,2)
- ! end do
-
- if(numberOfTranslationCenters.ne.0) then
-
- this%transformationType="TRANSLATION"
- this%numberOfTransformedCenters=numberOfTranslationCenters
- this%numberOfIndividualTransformations=&
- CONTROL_instance%TRANSLATION_SCAN_GRID(1)*CONTROL_instance%TRANSLATION_SCAN_GRID(2)*CONTROL_instance%TRANSLATION_SCAN_GRID(3)&
- +(CONTROL_instance%TRANSLATION_SCAN_GRID(1)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(2)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(3)-1)
-
- print *, ""
- write (*,"(A,I5,A,I10,A)") "Displacing coordinates of ", numberOfTranslationCenters, " centers", &
- this%numberOfIndividualTransformations," times"
- print *, ""
-
- else if(numberOfRotationCenters.ne.0) then
- print *, ""
- write (*,"(A,I5,A,I5,A,I5,A)") "Rotating coordinates of ", numberOfRotationCenters, " centers", CONTROL_instance%ROTATIONAL_SCAN_GRID, &
- " times in ", CONTROL_instance%NESTED_ROTATIONAL_GRIDS, " nested grids"
-
- print *, ""
-
- this%transformationType="ROTATION"
- this%numberOfTransformedCenters=numberOfRotationCenters
- this%numberOfIndividualTransformations=CONTROL_instance%ROTATIONAL_SCAN_GRID*CONTROL_instance%NESTED_ROTATIONAL_GRIDS
- else if(CONTROL_instance%READ_NOCI_GEOMETRIES) then
- this%transformationType="READ_GEOMETRIES"
- write (*,"(A)") "Reading input geometries from "//trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords file"
- end if
-
- ! call Vector_constructorInteger(this%systemTypes,this%numberOfIndividualTransformations**this%numberOfTransformedCenters,0)
-
-
- allocate(this%mergedDensityMatrix(CONTROL_instance%CI_STATES_TO_PRINT,molecularSystem_instance%numberOfQuantumSpecies),&
- this%mergedOverlapMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
- this%mergedCoefficients(molecularSystem_instance%numberOfQuantumSpecies),&
- this%configurationKineticMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
- this%configurationPuntualMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
- this%configurationExternalMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
- this%configurationExchangeMatrix(molecularSystem_instance%numberOfQuantumSpecies),&
- this%configurationHartreeMatrix(molecularSystem_instance%numberOfQuantumSpecies,molecularSystem_instance%numberOfQuantumSpecies))
-
- end subroutine NonOrthogonalCI_constructor
- !>
- !! @brief Generates different geometries and runs HF calculations at each
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_displaceGeometries(this)
- implicit none
- type(NonOrthogonalCI) :: this
-
- type(MolecularSystem) :: originalMolecularSystem
- type(MolecularSystem) :: displacedMolecularSystem
- real(8) :: displacement
- character(100) :: coordsFile
- integer, allocatable :: transformationCounter(:)
- integer :: coordsUnit
- integer :: i,j
- integer :: closestSystem
- logical :: skip
- real(8) :: timeA
-
- !$ timeA = omp_get_wtime()
-
- call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance)
-
- !!Dynamically allocated through the displacement routine
- allocate(this%molecularSystems(0))
-
- allocate(transformationCounter(this%numberOfTransformedCenters))
-
- transformationCounter(1:this%numberOfTransformedCenters)=1
- transformationCounter(1)=0
-
- this%numberOfDisplacedSystems=0
-
- coordsUnit=333
- coordsFile=trim(CONTROL_instance%INPUT_FILE)//"trial.coords"
-
- print *, "generating NOCI displaced geometries and HF wavefunctions... saving coords to ", trim(coordsFile)
-
- open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted")
-
-!!!!! clock type iterations to form all the possible combination of modified geometries
- do while (.true.)
-
- !Determine the next movement like a clock iteration
- transformationCounter(1)=transformationCounter(1)+1
- do i=1,this%numberOfTransformedCenters-1
- if(transformationCounter(i) .gt. this%numberOfIndividualTransformations) then
- j=i+1
- transformationCounter(j)=transformationCounter(j)+1
- transformationCounter(1:i)=1
- end if
- end do
-
- if(transformationCounter(this%numberOfTransformedCenters) .gt. this%numberOfIndividualTransformations) exit
-
- write (coordsUnit,"(A)",advance="no") "Transformation counter: "
- do i=1,this%numberOfTransformedCenters
- write (coordsUnit,"(I10)",advance="no") transformationCounter(i)
- end do
- write (coordsUnit,*) ""
-
- skip=.false.
- !Apply the transformation given by transformationCounter to each center, the result is saved in molecularSystemInstance
- call NonOrthogonalCI_transformCoordinates(this,transformationCounter(1:this%numberOfTransformedCenters),originalMolecularSystem,displacedMolecularSystem,skip)
-
- call MolecularSystem_showCartesianMatrix(displacedMolecularSystem,unit=coordsUnit)
-
- !Classify the system according to its distance matrix (symmetry)
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) &
- ! call NonOrthogonalCI_classifyNewSystem(this,systemType, newSystemFlag)
-
- !Check if the new system is not beyond the max displacement
- if(skip) then
- write (coordsUnit,"(A)") "Skipping system beyond the ellipsoids boundaries"
- this%numberOfEllipsoidRejectedSystems=this%numberOfEllipsoidRejectedSystems+1
- cycle
- end if
-
- !Check if the separation between particles of the same charge is not too small
- call NonOrthogonalCI_checkSameChargesDistance(displacedMolecularSystem,displacement,skip)
-
- if(skip) then
- write (coordsUnit,"(A,F20.12)") "Skipping system with same charge particle separation", displacement
- this%numberOfPPdistanceRejectedSystems=this%numberOfPPdistanceRejectedSystems+1
- cycle
- end if
-
- !Check if the separation between positive and negative particles is not too big
- call NonOrthogonalCI_checkOppositeChargesDistance(displacedMolecularSystem,displacement,skip)
-
- if(skip) then
- write (coordsUnit,"(A,F20.12)") "Skipping system with positive and negative particle separation", displacement
- this%numberOfNPdistanceRejectedSystems=this%numberOfNPdistanceRejectedSystems+1
- cycle
- end if
-
- !Check if the new system is not to close to previous calculated systems - duplicate protection
- call NonOrthogonalCI_checkNewSystemDisplacement(this,displacedMolecularSystem,closestSystem,displacement)
-
- if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
- write (coordsUnit,"(A,F20.12,A,I10)") "Skipping system with distance ", displacement , "a.u. from system ", closestSystem
- skip=.true.
- this%numberOfEquivalentSystems=this%numberOfEquivalentSystems+1
- cycle
- end if
-
- !!Copy the molecular system to the NonOrthogonalCI object
- ! if(newSystemFlag) then
- ! this%numberOfUniqueSystems=this%numberOfUniqueSystems+1
- ! this%systemTypes%values(this%numberOfDisplacedSystems)=this%numberOfUniqueSystems
- ! else
- ! this%systemTypes%values(this%numberOfDisplacedSystems)=systemType
- ! end if
-
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
- ! write (coordsUnit,"(A,I5,A,I10,A,F20.12)") "Saving system of type ", this%systemTypes%values(this%numberOfDisplacedSystems) , &
- ! " with ID ", this%numberOfDisplacedSystems, " and energy", testEnergy
- ! else<
- if(skip .eqv. .false.) then
- call NonOrthogonalCI_saveSystem(this,displacedMolecularSystem)
- write (coordsUnit,"(A,I10)") "Saving system with ID ", this%numberOfDisplacedSystems
- end if
- end do
-
- close(coordsUnit)
-
- print *, ""
- write (*,'(A10,I10,A)') "Mixing ", this%numberOfDisplacedSystems, " HF calculations at different geometries"
-
- if(this%numberOfEllipsoidRejectedSystems .gt. 0) &
- write (*,'(A10,I10,A)') "Rejected ", this%numberOfEllipsoidRejectedSystems, &
- " geometries outside the ellipsoids area"
-
- if(this%numberOfPPdistanceRejectedSystems .gt. 0) &
- write (*,'(A10,I10,A,ES18.8,A,ES18.8)') "Rejected ", this%numberOfPPdistanceRejectedSystems, &
- " geometries with separation between same charge basis sets smaller than", CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE, &
- " or larger than", CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE
-
- if(this%numberOfNPdistanceRejectedSystems .gt. 0) &
- write (*,'(A10,I10,A,ES18.8)') "Rejected ", this%numberOfNPdistanceRejectedSystems, &
- " geometries with separation between positive and negative basis sets larger than", CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE
-
- if(this%numberOfEquivalentSystems .gt. 0) &
- write (*,'(A10,I10,A)') "Rejected ", this%numberOfEquivalentSystems, &
- " duplicated geometries after permutations"
-
- print *, ""
-
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) &
- ! call Matrix_constructorInteger(this%configurationPairTypes,int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0)
- ! minEnergy=0.0
-
-!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time displacing coordinates : ", omp_get_wtime() - timeA ," (s)"
- print *, ""
-
- end subroutine NonOrthogonalCI_displaceGeometries
-
- !>
- !! @brief Read different geometries
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_readGeometries(this)
- implicit none
- type(NonOrthogonalCI) :: this
-
- type(MolecularSystem) :: originalMolecularSystem
- real(8) :: origin(3)
- character(100) :: string,coordsFile
- integer :: coordsUnit
- integer :: sysI,i,ii,j,mu
- real(8) :: timeA
- logical :: readSuccess
-
- !$ timeA = omp_get_wtime()
-
- call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance)
-
- coordsUnit=333
- coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords"
- readSuccess=.false.
-
- inquire(FILE = coordsFile, EXIST = readSuccess )
- if(.not. readSuccess) then
- print *, "Didn't find the file ", trim(coordsFile)
- STOP "Please provide one or turn the readNOCIGeometries flag off!"
- end if
-
- open(unit=coordsUnit, file=trim(coordsFile), status="old", form="formatted")
-
- read(coordsUnit,*) string, this%numberOfDisplacedSystems
- print *, "reading ", this%numberOfDisplacedSystems, " systems"
-
- allocate(this%molecularSystems(this%numberOfDisplacedSystems))
-
- do sysI = 1, this%numberOfDisplacedSystems
- call MolecularSystem_copyConstructor(molecularSystem_instance, originalMolecularSystem)
- write(molecularSystem_instance%description,"(I10)") sysI
- read(coordsUnit,*) string !skip line
- read(coordsUnit,*) string !skip line
-
- !! Print quatum species information
- do i = 1, molecularSystem_instance%numberOfQuantumSpecies
-
- !! Copy origins in open-shell case
- if(trim(molecularSystem_instance%species(i)%name) .eq. "E-BETA" ) then
- do ii = 1, i-1
- if(trim(molecularSystem_instance%species(ii)%name) .ne. "E-ALPHA" ) cycle
- do j = 1, size(molecularSystem_instance%species(i)%particles)
- molecularSystem_instance%species(i)%particles(j)%origin = &
- molecularSystem_instance%species(ii)%particles(j)%origin
- do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length
- molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = &
- molecularSystem_instance%species(i)%particles(j)%origin
- end do
- end do
- end do
- cycle !skip the rest of the read
- end if
-
- do j = 1, size(molecularSystem_instance%species(i)%particles)
- read(coordsUnit,*) string, origin(1), origin(2), origin(3)
-
- molecularSystem_instance%species(i)%particles(j)%origin = origin/AMSTRONG
- do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length
- molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = &
- molecularSystem_instance%species(i)%particles(j)%origin
- end do
- end do
- end do
-
- !! Point charges information
- do i = 1, molecularSystem_instance%numberOfPointCharges
- read(coordsUnit,*) string, origin(1), origin(2), origin(3)
-
- molecularSystem_instance%pointCharges(i)%origin = origin/AMSTRONG
- end do
- call MolecularSystem_copyConstructor(this%molecularSystems(sysI), molecularSystem_instance)
-
- end do
-
- close(unit=coordsUnit)
-
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time reading coordinates : ", omp_get_wtime() - timeA ," (s)"
- end subroutine NonOrthogonalCI_readGeometries
-
-
- !>
- !! @brief Apply the transformation (translation or rotation) given by transformationCounter to each center, based in the originalMolecularSystemPositions the result is saved in molecularSystemInstance
- !! @param this,transformationCounter,originalMolecularSystem
- !<
- subroutine NonOrthogonalCI_transformCoordinates(this,transformationCounter,originalMolecularSystem,displacedMolecularSystem,skip)
- type(NonOrthogonalCI) :: this
- integer :: transformationCounter(*)
- type(MolecularSystem) :: originalMolecularSystem
- type(MolecularSystem), target :: displacedMolecularSystem
- logical, intent(out) :: skip
-
- real(8) :: centerX, centerY, centerZ, displacedOrigin(3), distanceCheck, distanceToCenter
- integer :: center, displacementId
- real(8),allocatable :: X(:), Y(:), Z(:), W(:)
- integer :: i,j,k,p,q,mu
- character(200) :: description
-
- skip=.false.
-
- call MolecularSystem_copyConstructor(displacedMolecularSystem, originalMolecularSystem)
-
- write(displacedMolecularSystem%description, '(I10)') transformationCounter(1)
- do i=2,this%numberOfTransformedCenters
- write(description, '(A)') adjustl(adjustr(displacedMolecularSystem%description)//"-"//adjustl(String_convertIntegerToString(transformationCounter(i))))
- displacedMolecularSystem%description=trim(description)
- end do
-
- particleManager_instance => displacedMolecularSystem%allParticles
-
- if(trim(this%transformationType).eq."TRANSLATION") then
-
- do center=1, this%numberOfTransformedCenters
- do p=1, size(originalMolecularSystem%allParticles)
- if(center.eq.originalMolecularSystem%allParticles(p)%particlePtr%translationCenter) then
- centerX=originalMolecularSystem%allParticles(p)%particlePtr%origin(1)
- centerY=originalMolecularSystem%allParticles(p)%particlePtr%origin(2)
- centerZ=originalMolecularSystem%allParticles(p)%particlePtr%origin(3)
- end if
- end do
-
- !!These loops update the molecular system file for each displaced geometry
- !!ADD DIFFERENT AXIS DISPLACEMENTS!
- displacementId=0
- !Body centered cube
- do i=1,CONTROL_instance%TRANSLATION_SCAN_GRID(1)*2-1
- do j=1,CONTROL_instance%TRANSLATION_SCAN_GRID(2)*2-1
- do k=1,CONTROL_instance%TRANSLATION_SCAN_GRID(3)*2-1
-
- if( (mod(i,2) .eq. mod(j,2)) .and. (mod(i,2) .eq. mod(k,2)) ) then
- displacementId=displacementId+1
-
- if(displacementId .eq. transformationCounter(center) ) then
-
- distanceCheck= &
- (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/&
- CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(1)**2+&
- (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/&
- CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(2)**2+&
- (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/&
- CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(3)**2
-
- if(distanceCheck .gt. 1.0) then
- skip=.true.
- ! return
- end if
-
- distanceCheck= &
- (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/&
- CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(1)**2+&
- (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/&
- CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(2)**2+&
- (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/&
- CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(3)**2
-
- if(distanceCheck .lt. 1.0) then
- skip=.true.
- ! return
- end if
-
- displacedOrigin(1)=centerX+CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0)
- displacedOrigin(2)=centerY+CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0)
- displacedOrigin(3)=centerZ+CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0)
-
- do p=1, size(displacedMolecularSystem%allParticles)
- if(center.eq.displacedMolecularSystem%allParticles(p)%particlePtr%translationCenter) then
- ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin )
- displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin
- do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length
- displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin
- end do
- end if
- end do
-
- ! write(*, '(3I5,F4.1,A,F4.1,A,F4.1)') i,j,k, &
- ! (i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0," ", &
- ! (j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0," ", &
- ! (k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0
- end if
- end if
- end do
- end do
- end do
-
- end do
-
- else if(trim(this%transformationType).eq."ROTATION") then
-
- allocate(X(CONTROL_instance%ROTATIONAL_SCAN_GRID),&
- Y(CONTROL_instance%ROTATIONAL_SCAN_GRID),&
- Z(CONTROL_instance%ROTATIONAL_SCAN_GRID),&
- W(CONTROL_instance%ROTATIONAL_SCAN_GRID))
-
- call Lebedev_angularGrid(X(:),Y(:),Z(:),W(:),CONTROL_instance%ROTATIONAL_SCAN_GRID)
-
- do center=1, this%numberOfTransformedCenters
- displacementId=0
-
- do i=1,CONTROL_instance%ROTATIONAL_SCAN_GRID
- do j=1,CONTROL_instance%NESTED_ROTATIONAL_GRIDS
- displacementId=displacementId+1
- if(displacementId .eq. transformationCounter(center) ) then
- do p=1, size(displacedMolecularSystem%allParticles)
- if(this%rotationCenterList(p,1).eq. center ) then
-
- do q=1, size(originalMolecularSystem%allParticles)
- if(this%rotationCenterList(q,1) .eq. center ) then
- centerX=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(1)
- centerY=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(2)
- centerZ=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(3)
- end if
- end do
-
- distanceToCenter=sqrt((originalMolecularSystem%allParticles(p)%particlePtr%origin(1)-centerX)**2 &
- +(originalMolecularSystem%allParticles(p)%particlePtr%origin(2)-centerY)**2 &
- +(originalMolecularSystem%allParticles(p)%particlePtr%origin(3)-centerZ)**2)
-
- distanceToCenter=distanceToCenter+&
- CONTROL_instance%NESTED_GRIDS_DISPLACEMENT*(j-(CONTROL_instance%NESTED_ROTATIONAL_GRIDS+1)/2.0)
-
- displacedOrigin(1)=centerX+X(i)*distanceToCenter
- displacedOrigin(2)=centerY+Y(i)*distanceToCenter
- displacedOrigin(3)=centerZ+Z(i)*distanceToCenter
-
- ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin )
- displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin
- do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length
- displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin
- end do
- end if
- end do
- end if
- end do
- end do
- end do
- end if
-
- end subroutine NonOrthogonalCI_transformCoordinates
-
- !>
- !! @brief Computes the distance between the particles of latest generated molecular system with all the previous saved ones
- !!
- !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles
- !<
- subroutine NonOrthogonalCI_checkNewSystemDisplacement(this,newMolecularSystem,closestSystem,displacement)
- implicit none
- type(NonOrthogonalCI) :: this
- type(MolecularSystem) :: newMolecularSystem
- integer :: closestSystem
- real(8) :: displacement
-
- integer :: sysI, i
- type(Vector), allocatable :: displacementVector(:)
- real(8) :: dispSum
-
- displacement=1.0E8
-
- allocate(displacementVector(newMolecularSystem%numberOfQuantumSpecies))
-
- do sysI=1, this%numberOfDisplacedSystems
-
- call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), newMolecularSystem, displacementVector)
-
- dispSum=0.0
- do i=1, newMolecularSystem%numberOfQuantumSpecies
- dispSum=dispSum+sum(displacementVector(i)%values(:))
- end do
- if(dispSum .lt. displacement ) then
- displacement=dispSum
- closestSystem=sysI
- if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) exit
- end if
- end do
-
- deallocate(displacementVector)
-
- end subroutine NonOrthogonalCI_checkNewSystemDisplacement
-
-
- !>
- !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with opposite charge
- !!
- !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles
- !<
- subroutine NonOrthogonalCI_checkOppositeChargesDistance(molSys,minNPDistance,skip)
- implicit none
- type(MolecularSystem) :: molSys
- real(8) :: minNPDistance
- logical :: skip
-
- integer :: p,q
- real(8) :: npDistance
-
-
- minNPDistance=1E8
- do p=1, size(molSys%allParticles)-1
- if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. &
- molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle
- do q=p+1, size(molSys%allParticles)
- if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. &
- molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle
- if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .gt. 0.0 ) cycle
- npDistance=sqrt(&
- (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+&
- (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+&
- (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2)
- if(npDistance .lt. minNPDistance) minNPDistance=npDistance
- end do
- end do
-
- if(minNPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE) skip=.true.
-
- end subroutine NonOrthogonalCI_checkOppositeChargesDistance
-
- !>
- !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with the same charge
- !!
- !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles
- !<
- subroutine NonOrthogonalCI_checkSameChargesDistance(molSys,distance,skip)
- implicit none
- type(MolecularSystem) :: molSys
- real(8) :: distance
- logical :: skip
-
- real(8) :: minPPDistance
-
- integer :: p,q
- real(8) :: ppDistance
-
-
- minPPDistance=1.0E8
- do p=1, size(molSys%allParticles)-1
- if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. &
- molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle
- do q=p+1, size(molSys%allParticles)
- if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. &
- molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle
- if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .lt. 0.0 ) cycle
-
- ppDistance=sqrt(&
- (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+&
- (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+&
- (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2)
- if(ppDistance .lt. minPPDistance) minPPDistance=ppDistance
-
- end do
- end do
-
- if(minPPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE) skip=.true.
- if(minPPDistance .lt. CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE) skip=.true.
-
- end subroutine NonOrthogonalCI_checkSameChargesDistance
-
- !>
- !! @brief Classify the new system by comparing its distance matrix to previosly saved systems
- !!
- !! @param this, systemType: integer defining system equivalence type, newSystemFlag: returns if the system is new or not
- !<
- ! subroutine NonOrthogonalCI_classifyNewSystem(this, systemType, newSystemFlag)
- ! implicit none
- ! type(NonOrthogonalCI) :: this
- ! integer :: systemType
- ! logical :: newSystemFlag
-
- ! type(MolecularSystem) :: currentMolecularSystem
- ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix
-
- ! integer :: sysI, i, checkingType
- ! logical :: match
-
- ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance)
- ! systemType=0
- ! newSystemFlag=.true.
- ! currentDistanceMatrix=ParticleManager_getDistanceMatrix()
-
- ! ! print *, "Current distance matrix"
- ! ! call Matrix_show(currentDistanceMatrix)
-
- ! types: do checkingType=1, this%numberOfUniqueSystems
- ! ! print *, "checkingType", checkingType
- ! systems: do sysI=1, this%numberOfDisplacedSystems
-
- ! if(this%systemTypes%values(sysI) .eq. checkingType) then
- ! call MolecularSystem_copyConstructor(molecularSystem_instance, this%molecularSystems(sysI))
-
- ! previousDistanceMatrix=ParticleManager_getDistanceMatrix()
-
- ! ! print *, "Comparing with previous distance matrix", checkingType
- ! ! call Matrix_show(previousDistanceMatrix)
-
- ! match=.true.
- ! do i=1, size(currentDistanceMatrix%values(:,1))
- ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. &
- ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
- ! match=.false.
- ! exit
- ! end if
- ! end do
-
- ! ! print *, "match?", match
-
- ! if(match) then
- ! systemType=this%systemTypes%values(sysI)
- ! newSystemFlag=.false.
- ! exit types
- ! else
- ! cycle types
- ! end if
- ! end if
- ! end do systems
- ! end do types
-
- ! ! print *, "newSystemFlag", newSystemFlag
-
- ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem)
-
- ! end subroutine NonOrthogonalCI_classifyNewSystem
-
- !>
- !! @brief Run a Hartree-Fock calculation at displaced geometries and fill CI matrix diagonals
- !!
- !! @param this -> NOCI instance
- !<
- subroutine NonOrthogonalCI_runHFs(this)
- implicit none
- type(NonOrthogonalCI) :: this
-
- integer :: sysI, speciesID, otherSpeciesID
- integer :: coordsUnit
- real(8) :: timeA
- character(100) :: coordsFile
-
- !$ timeA = omp_get_wtime()
- !!Read HF energy of the non displaced SCF calculation
- ! print *, "HF reference energy is ", hfEnergy
-
- allocate(this%HFCoefficients(this%numberOfDisplacedSystems,molecularSystem_instance%numberOfQuantumSpecies))
- allocate(this%systemLabels(this%numberOfDisplacedSystems))
-
- call Matrix_constructor(this%configurationHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- call Matrix_constructor(this%configurationOverlapMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- call Vector_constructor(this%configurationCorrelationEnergies, this%numberOfDisplacedSystems, 0.0_8)
- do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies
- call Matrix_constructor(this%configurationKineticMatrix(speciesID), &
- int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- call Matrix_constructor(this%configurationPuntualMatrix(speciesID), &
- int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- call Matrix_constructor(this%configurationExternalMatrix(speciesID), &
- int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- call Matrix_constructor(this%configurationExchangeMatrix(speciesID), &
- int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- do otherSpeciesID=speciesID, MolecularSystem_instance%numberOfQuantumSpecies
- call Matrix_constructor(this%configurationHartreeMatrix(speciesID,otherSpeciesID), &
- int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- end do
- end do
-
- coordsUnit=333
- coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords"
- open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted")
-
- if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
- print *, "running KS calculations at the displaced geometries ... saving results on file ", coordsFile
- else
- print *, "running HF calculations at the displaced geometries ... saving results on file ", coordsFile
- end if
-
-
- write (coordsUnit,'(A25,I20)') "numberOfDisplacedSystems ", this%numberOfDisplacedSystems
-
- do sysI=1, this%numberOfDisplacedSystems
- write(this%systemLabels(sysI), '(A)') trim(this%molecularSystems(sysI)%description)
-
- !!Do SCF without calling lowdin-scf.x
- call MolecularSystem_copyConstructor(molecularSystem_instance, this%molecularSystems(sysI))
- CONTROL_instance%PRINT_LEVEL=0
-
- if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) &
- call MolecularSystem_saveToFile()
-
- if(allocated(WaveFunction_instance)) deallocate(WaveFunction_instance)
- allocate(WaveFunction_instance(molecularSystem_instance%numberOfQuantumSpecies))
-
- call MultiSCF_constructor(MultiSCF_instance,WaveFunction_instance,CONTROL_instance%ITERATION_SCHEME)
-
- call MultiSCF_buildHcore(MultiSCF_instance,WaveFunction_instance)
-
- call MultiSCF_getInitialGuess(MultiSCF_instance,WaveFunction_instance)
-
- if (CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then
- if(allocated(Libint2Instance)) deallocate(Libint2Instance)
- allocate(Libint2Instance(MolecularSystem_instance%numberOfQuantumSpecies))
- call DirectIntegralManager_constructor(Libint2Instance,MolecularSystem_instance)
- do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies
- call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(&
- speciesID, &
- WaveFunction_instance(speciesID)%densityMatrix, &
- WaveFunction_instance(speciesID)%fourCenterIntegrals(speciesID)%values, &
- MolecularSystem_instance,Libint2Instance(speciesID))
- end do
-
- do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies-1
- do otherSpeciesID=speciesID+1, MolecularSystem_instance%numberOfQuantumSpecies
- call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(&
- speciesID, otherSpeciesID, &
- WaveFunction_instance(speciesID)%densityMatrix, &
- WaveFunction_instance(speciesID)%fourCenterIntegrals(otherSpeciesID)%values, &
- MolecularSystem_instance,Libint2Instance(speciesID),Libint2Instance(otherSpeciesID))
- end do
- end do
- end if
-
- call MultiSCF_solveHartreeFockRoothan(MultiSCF_instance,WaveFunction_instance,Libint2Instance)
-
- !Save HF results
- ! call MultiSCF_saveWfn(MultiSCF_instance,WaveFunction_instance)
- call MolecularSystem_copyConstructor(this%molecularSystems(sysI),molecularSystem_instance)
- this%configurationHamiltonianMatrix%values(sysI,sysI)=MultiSCF_instance%totalEnergy
-
- do speciesID = 1, molecularSystem_instance%numberOfQuantumSpecies
- this%HFCoefficients(sysI,speciesID) = WaveFunction_instance(speciesID)%waveFunctionCoefficients
-
- this%configurationKineticMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%kineticEnergy
- this%configurationPuntualMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%puntualInteractionEnergy
- this%configurationExternalMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%externalPotentialEnergy
- this%configurationExchangeMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%exchangeHFEnergy
- do otherSpeciesID = speciesID, molecularSystem_instance%numberOfQuantumSpecies
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysI)=&
- WaveFunction_instance(speciesID)%hartreeEnergy(otherSpeciesID)
- end do
- end do
-
- ! Compute HF energy with KS determinants
- if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
- if(CONTROL_instance%METHOD.eq."RKS") then
- CONTROL_instance%METHOD="RHF"
- else
- CONTROL_instance%METHOD="UHF"
- end if
-
- do speciesID = 1, molecularSystem_instance%numberOfQuantumSpecies
- WaveFunction_instance(speciesID)%exchangeCorrelationEnergy=0.0_8
- WaveFunction_instance(speciesID)%exchangeCorrelationMatrix%values=0.0_8
- WaveFunction_instance(speciesID)%exactExchangeFraction=1.0_8
- end do
- call MultiSCF_obtainFinalEnergy(MultiSCF_instance,WaveFunction_instance,Libint2Instance)
- !Difference between HF and KS energies
- this%configurationCorrelationEnergies%values(sysI)=this%configurationHamiltonianMatrix%values(sysI,sysI)-MultiSCF_instance%totalEnergy
-
- if(CONTROL_instance%METHOD.eq."RHF") then
- CONTROL_instance%METHOD="RKS"
- else
- CONTROL_instance%METHOD="UKS"
- end if
- end if
-
- write (coordsUnit,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", sysI, "Energy", this%configurationHamiltonianMatrix%values(sysI,sysI), &
- "Correlation energy", this%configurationCorrelationEnergies%values(sysI)
- call MolecularSystem_showCartesianMatrix(MolecularSystem_instance,unit=coordsUnit)
-
- if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then
- write (*,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", sysI, "Energy", this%configurationHamiltonianMatrix%values(sysI,sysI), &
- "Correlation energy", this%configurationCorrelationEnergies%values(sysI)
- call MolecularSystem_showCartesianMatrix(MolecularSystem_instance)
- ! do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- ! print *, "sysI", sysI, "speciesID", speciesID, "occupation number", MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- ! end do
- end if
-
- call DirectIntegralManager_destructor(Libint2Instance)
- call MultiSCF_destructor(MultiSCF_instance)
-
- !!Screen geometries with high energies
- ! if( CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD .ne. 0.0 .and. &
- ! testEnergy .gt. this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD) then
- ! write (coordsUnit,"(A,F20.12)") "Skipping system with high energy", testEnergy
- ! this%numberOfEnergyRejectedSystems=this%numberOfEnergyRejectedSystems+1
- ! else
- ! if(this%numberOfEnergyRejectedSystems .gt. 0) &
- ! write (*,'(A10,I10,A,F18.12)') "Rejected ", this%numberOfEnergyRejectedSystems, &
- ! " geometries with energy higher than", this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD
-
- end do
-
- close(coordsUnit)
-!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for HF calculations at displaced geometries : ", omp_get_wtime() - timeA ," (s)"
-
- end subroutine NonOrthogonalCI_runHFs
-
- ! >
- ! @brief Saves molecular system and wfn files for a displaced system
-
- ! @param systemID
- ! <
- subroutine NonOrthogonalCI_saveSystem(this, newSystem)
- implicit none
- type(NonOrthogonalCI) :: this
- type(MolecularSystem) :: newSystem
-
- type(MolecularSystem), allocatable :: tempMolecularSystems(:)
- integer :: i
-
- !!Increase the size of the molecular systems array by 1
- this%numberOfDisplacedSystems=this%numberOfDisplacedSystems+1
-
- allocate(tempMolecularSystems(size(this%MolecularSystems)))
-
- do i=1, size(this%MolecularSystems)
- call MolecularSystem_copyConstructor(tempMolecularSystems(i),this%MolecularSystems(i))
- end do
-
- deallocate(this%MolecularSystems)
- allocate(this%MolecularSystems(this%numberOfDisplacedSystems))
-
- do i=1, size(tempMolecularSystems)
- call MolecularSystem_copyConstructor(this%MolecularSystems(i),tempMolecularSystems(i))
- end do
-
- deallocate(tempMolecularSystems)
- !!Copy the molecular system to the NonOrthogonalCI object
-
- call MolecularSystem_copyConstructor(this%MolecularSystems(this%numberOfDisplacedSystems), newSystem)
-
- end subroutine NonOrthogonalCI_saveSystem
-
- !>
- !! @brief Computes overlap and hamiltonian non orthogonal CI matrices for previously calculated molecular systems at different geometries
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_buildOverlapAndHamiltonianMatrix(this)
- implicit none
- type(NonOrthogonalCI) :: this
- type(MolecularSystem), allocatable :: mergedMolecularSystem(:)
- type(Libint2Interface), allocatable :: Libint2ParallelInstance(:,:)
- integer, allocatable :: sysIbatch(:), sysIIbatch(:)
- integer :: sysI,sysII,me,mySysII
- type(Matrix), allocatable :: mergedCoefficients(:), inverseOverlapMatrices(:)
- type(IVector), allocatable :: sysIbasisList(:,:),sysIIbasisList(:,:)
- real(8) :: overlapUpperBound
- integer :: prescreenedElements, overlapScreenedElements
-
- integer :: speciesID, otherSpeciesID
- integer :: nspecies
- integer :: ncores, batchSize, upperBound
-
- integer :: matrixUnit
- character(100) :: matrixFile
- real(8) :: empiricalScaleFactor
-
- real(8) :: timeMerging, timePrescreen, timeOverlap, timeTwoIntegrals
- real(8) :: timeA
- real(8) :: timeB
-
- timePrescreen=0.0
- timeOverlap=0.0
- timeTwoIntegrals=0.0
-
- print *, ""
- print *, "A prescreening of the overlap matrix elements is performed for the heavy species"
- write (*,'(A,ES8.1)') "Overlap and Hamiltonian matrix elements are saved for pairs with overlap higher than",&
- CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD
- print *, "For pairs with lower overlap, setting H(I,II)=0, S(I,II)=0"
- print *, ""
-
- prescreenedElements=0
- overlapScreenedElements=0
-
- matrixUnit=290
- matrixFile= trim(CONTROL_instance%INPUT_FILE)//"NOCI-Matrix.ci"
-
- print *, "computing NOCI overlap and hamiltonian matrices... saving them to ", trim(matrixFile)
-
- open(unit=matrixUnit, file=trim(matrixFile), status="replace", form="formatted")
-
- write (matrixUnit,'(A20,I20)') "MatrixSize", this%numberOfDisplacedSystems
- write (matrixUnit,'(A10,A10,A20,A20)') "Conf. ", "Conf. ", "Overlap ","Hamiltonian "
-
- !Allocate objets to distribute in parallel
- nspecies=molecularSystem_instance%numberOfQuantumSpecies
- ncores=CONTROL_instance%NUMBER_OF_CORES
- batchSize=this%numberOfDisplacedSystems
- print *, "ncores", ncores, "batchsize", batchSize
-
- allocate(mergedMolecularSystem(batchSize),&
- mergedCoefficients(nspecies),&
- inverseOverlapMatrices(nspecies),&
- Libint2ParallelInstance(nspecies,batchSize),&
- sysIbatch(batchSize),&
- sysIIbatch(batchSize),&
- sysIbasisList(nspecies,batchSize),&
- sysIIbasisList(nspecies,batchSize))
-
- if(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then
- upperBound=1
- this%printMatrixThreshold=this%numberOfDisplacedSystems
- else
- upperBound=this%numberOfDisplacedSystems
- end if
- ! print *, "upperBound", upperBound
-
- systemI: do sysI=1, upperBound
-
- this%configurationOverlapMatrix%values(sysI,sysI)=1.0
- !Save diagonal elements
- write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') sysI, sysI, &
- this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI)
-
- sysII=sysI
- systemII: do while(sysII.lt.this%numberOfDisplacedSystems)
-
- ! print *, "distributing sysII", sysII, "into", batchSize, "batches"
- !In serial, prepare systems
- sysIIbatch(:)=0
- me=0
- mySysII=sysII
-
- do while(me.lt.batchSize)
- mySysII=mySysII+1
- if(mySysII .gt. this%numberOfDisplacedSystems) exit
-
- !$ timeA = omp_get_wtime()
- !Estimates overlap with a 1s-1s integral approximation
- call NonOrthogonalCI_prescreenOverlap(this,sysI,mySysII,overlapUpperBound)
-
- if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. &
- overlapUpperBound .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then
- ! print *, "preskipping elements", sysI, mySysII, "with overlap estimated as", overlapUpperBound
- prescreenedElements=prescreenedElements+1
- else
- !$ timeB = omp_get_wtime()
- !$ timePrescreen=timePrescreen+(timeB - timeA)
- me=me+1
- sysIIbatch(me)=mySysII
- !$ timeA = omp_get_wtime()
- !This generates a new molecular system
- ! print *, "Merging systems from geometries ", sysI, mySysII
- call MolecularSystem_mergeTwoSystems(mergedMolecularSystem(me), &
- this%molecularSystems(sysI), this%molecularSystems(mySysII),sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me))
- ! call MolecularSystem_showInformation()
- ! call MolecularSystem_showParticlesInformation()
- ! call MolecularSystem_showCartesianMatrix(mergedMolecularSystem)
- call DirectIntegralManager_constructor(Libint2ParallelInstance(1:nspecies,me),mergedMolecularSystem(me))
- !$ timeB = omp_get_wtime()
- !$ timeMerging=timeMerging+(timeB - timeA)
- end if
- end do
-
- !In parallel, fill matrices
-
- call OMP_set_num_threads(ncores)
- !$omp parallel &
- !$omp& private(mySysII,mergedCoefficients,inverseOverlapMatrices),&
- !$omp& shared(this,sysI,sysII,matrixUnit,prescreenedElements,overlapScreenedElements,sysIbasisList,sysIIbasisList,mergedMolecularSystem,Libint2ParallelInstance,nspecies,batchSize)
- !$omp do schedule(dynamic,10)
- procs: do me=1, batchSize
- mySysII=sysIIbatch(me)
-
- if(mySysII .eq. 0) cycle procs
-
- ! print *, "evaluating S and H elements for", sysI, mySysII
-
- ! cycle systemII
- !! Merge occupied coefficients into a single matrix
- call NonOrthogonalCI_mergeCoefficients(this%HFCoefficients(sysI,:),this%HFCoefficients(mySysII,:),&
- this%molecularSystems(sysI),this%molecularSystems(mySysII),mergedMolecularSystem(me),&
- sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),mergedCoefficients)
- !$ timeA = omp_get_wtime()
-
- call NonOrthogonalCI_computeOverlapAndHCoreElements(this,sysI,mySysII,mergedMolecularSystem(me),mergedCoefficients,&
- sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),inverseOverlapMatrices)
- !$ timeB = omp_get_wtime()
- !$ timeOverlap=timeOverlap+(timeB - timeA)
-
- !! SKIP ENERGY EVALUATION IF OVERLAP IS TOO LOW
-
- if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. &
- abs(this%configurationOverlapMatrix%values(sysI,mySysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then
- ! print *, "screening elements", sysI, mySysII, "with overlap", this%configurationOverlapMatrix%values(sysI,mySysII)
- this%configurationOverlapMatrix%values(sysI,mySysII)=0.0
- this%configurationHamiltonianMatrix%values(sysI,mySysII)=0.0
- !$OMP ATOMIC
- overlapScreenedElements=overlapScreenedElements+1
- ! cycle systemII
- else
- !$ timeA = omp_get_wtime()
- call NonOrthogonalCI_twoParticlesContributions(this,sysI,mySysII,mergedMolecularSystem(me),&
- inverseOverlapMatrices,mergedCoefficients,Libint2ParallelInstance(1:nspecies,me))
- !$ timeB = omp_get_wtime()
- !$ timeTwoIntegrals=timeTwoIntegrals+(timeB - timeA)
- end if
-
- ! print *, "thread", omp_get_thread_num()+1,"me", me, "sysI", " mySysII", sysI, mySysII, "S", this%configurationOverlapMatrix%values(sysI,mySysII), "H", this%configurationHamiltonianMatrix%values(sysI,mySysII)
- end do procs
- !$omp end do nowait
- !$omp end parallel
-
- !In serial, symmetrize, free memory and print
- do me=1, batchSize
- mySysII=sysIIbatch(me)
-
- if(mySysII .eq. 0) exit systemII
-
- !DFT energy correction for off diagonal elements
- if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
- this%configurationHamiltonianMatrix%values(sysI,mySysII)=this%configurationHamiltonianMatrix%values(sysI,mySysII)+&
- this%configurationOverlapMatrix%values(sysI,mySysII)/2.0*&
- (this%configurationCorrelationEnergies%values(sysI)+&
- this%configurationCorrelationEnergies%values(mySysII))
- end if
-
- !Yu2020 magical empirical correction
- if(CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION .and. &
- abs(this%configurationOverlapMatrix%values(sysI,mySysII)) .gt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then
- empiricalScaleFactor=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A*&
- abs(this%configurationOverlapMatrix%values(sysI,mySysII))**CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B/&
- abs(this%configurationOverlapMatrix%values(sysI,mySysII))
- this%configurationOverlapMatrix%values(sysI,mySysII)=&
- this%configurationOverlapMatrix%values(sysI,mySysII)*empiricalScaleFactor
- this%configurationHamiltonianMatrix%values(sysI,mySysII)=&
- this%configurationHamiltonianMatrix%values(sysI,mySysII)*empiricalScaleFactor
- do speciesID=1, nspecies
- this%configurationKineticMatrix(speciesID)%values(sysI,mySysII)=&
- this%configurationKineticMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor
- this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII)=&
- this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor
- this%configurationExternalMatrix(speciesID)%values(sysI,mySysII)=&
- this%configurationExternalMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor
- this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII)=&
- this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor
- do otherSpeciesID=speciesID, nspecies
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII)=&
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII)*empiricalScaleFactor
- end do
- end do
- end if
-
- !Symmetrize
- this%configurationOverlapMatrix%values(mySysII,sysI)=this%configurationOverlapMatrix%values(sysI,mySysII)
- this%configurationHamiltonianMatrix%values(mySysII,sysI)=this%configurationHamiltonianMatrix%values(sysI,mySysII)
-
- do speciesID=1, nspecies
- this%configurationKineticMatrix(speciesID)%values(mySysII,sysI)=this%configurationKineticMatrix(speciesID)%values(sysI,mySysII)
- this%configurationPuntualMatrix(speciesID)%values(mySysII,sysI)=this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII)
- this%configurationExternalMatrix(speciesID)%values(mySysII,sysI)=this%configurationExternalMatrix(speciesID)%values(sysI,mySysII)
- this%configurationExchangeMatrix(speciesID)%values(mySysII,sysI)=this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII)
- do otherSpeciesID=speciesID, nspecies
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysII,sysI)=&
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII)
- end do
- end do
-
- write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') sysI, mySysII, &
- this%configurationOverlapMatrix%values(sysI,mySysII), this%configurationHamiltonianMatrix%values(sysI,mySysII)
-
- if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, "Overlap element = ", this%configurationOverlapMatrix%values(sysI,mySysII)
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, "Hamiltonian element = ", this%configurationHamiltonianMatrix%values(sysI,mySysII)
-
- do speciesID = 1, nspecies
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // &
- " Kinetic element = ", this%configurationKineticMatrix(speciesID)%values(sysI,mySysII)
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // &
- " Puntual element = ", this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII)
- if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // &
- " External element = ", this%configurationExternalMatrix(speciesID)%values(sysI,mySysII)
- end do
- do speciesID=1, nspecies
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // &
- " Exchange element = ", this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII)
- do otherSpeciesID=speciesID, nspecies
- write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( MolecularSystem_instance%species(speciesID)%name ) // &
- "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
- " Hartree element = ", this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII)
- end do
- end do
- print *, ""
-
- end if
-
- call DirectIntegralManager_destructor(Libint2ParallelInstance(1:nspecies,me))
- end do
- sysII=mySysII
-
- end do systemII
-
- end do systemI
-
- close(matrixUnit)
-
- print *, ""
- print *, "Configuration pairs skipped by overlap prescreening: ", prescreenedElements
- print *, "Configuration pairs skipped by overlap screening: ", overlapScreenedElements
- print *, "Overlap integrals computed for ", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2&
- -prescreenedElements, "configuration pairs"
- print *, "Four center integrals computed for", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2&
- -prescreenedElements-overlapScreenedElements, "configuration pairs"
- print *, ""
-
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for overlap prescreening : ", timePrescreen ," (s)"
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging systems : ", timeMerging ," (s)"
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for two index integrals : ", timeOverlap ," (s)"
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for four index integrals : ", timeTwoIntegrals ," (s)"
-
- print *, ""
-
- deallocate(mergedMolecularSystem,&
- mergedCoefficients,&
- inverseOverlapMatrices,&
- Libint2ParallelInstance,&
- sysIbatch,&
- sysIIbatch,&
- sysIbasisList,&
- sysIIbasisList)
-
- ! integer :: symmetryEquivalentElements
- ! timeSymmetry=0.0
- ! symmetryEquivalentElements=0
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
- ! write (matrixUnit,'(A10,A10,A10,A20,A20)') "Conf. ", "Conf. ", "Type ", "Overlap ","Hamiltonian "
- ! else
- ! end if
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
- ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysI, this%configurationPairTypes%values(sysI,sysI), &
- ! this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI)
- ! else
- ! end if
- ! write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for element symmetry : ", timeSymmetry ," (s)"
- ! !$ timeA = omp_get_wtime()
- ! !!Check symmetry of the element
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
- ! call NonOrthogonalCI_classifyConfigurationPair(this,sysI,sysII,newPairFlag)
- ! !$ timeB = omp_get_wtime()
- ! !$ timeSymmetry=timeSymmetry+(timeB - timeA)
-
- ! !!Copy results from previously computed equivalent elements
- ! if (newPairFlag .eqv. .false.) then
- ! do preSysI=1, sysI
- ! do preSysII=preSysI+1, sysII
- ! if(this%configurationPairTypes%values(preSysI,preSysII) .eq. this%configurationPairTypes%values(sysI,sysII)) then
- ! this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(preSysI,preSysII)
- ! this%configurationOverlapMatrix%values(sysII,sysI)=this%configurationOverlapMatrix%values(sysI,sysII)
- ! this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(preSysI,preSysII)
- ! this%configurationHamiltonianMatrix%values(sysII,sysI)=this%configurationHamiltonianMatrix%values(sysI,sysII)
- ! symmetryEquivalentElements=symmetryEquivalentElements+1
-
- ! if( this%configurationOverlapMatrix%values(sysI,sysII) .ne. 0.0) &
- ! write (*,'(A,I10,I10,A,I10,A,ES20.12,ES20.12)') "Pair ",sysI, sysII," is type ", &
- ! this%configurationPairTypes%values(sysI,sysII), " Overlap and Hamiltonian elements", &
- ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII)
-
- ! cycle systemII
- ! end if
- ! end do
- ! end do
- ! end if
- ! end if
- !!This is a symmetry test, assume positive phase
- ! if( this%configurationOverlapMatrix%values(sysI,sysII) .lt. 0.0) then
- ! this%configurationOverlapMatrix%values(sysI,sysII)=-this%configurationOverlapMatrix%values(sysI,sysII)
- ! this%configurationOverlapMatrix%values(sysII,sysI)=-this%configurationOverlapMatrix%values(sysII,sysI)
- ! this%configurationHamiltonianMatrix%values(sysI,sysII)=-this%configurationHamiltonianMatrix%values(sysI,sysII)
- ! this%configurationHamiltonianMatrix%values(sysII,sysI)=-this%configurationHamiltonianMatrix%values(sysII,sysI)
- ! end if
-
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then
- ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysII, this%configurationPairTypes%values(sysI,sysII), &
- ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII)
- ! else
- ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) &
- ! print *, "Configuration pairs skipped by symmetry equivalence: ", symmetryEquivalentElements
-
- end subroutine NonOrthogonalCI_buildOverlapAndHamiltonianMatrix
-
-
- !>
- !! @brief Merges the occupied orbitals coefficients from two systems
- !! @param occupationI and occupationII: Number of orbitals to merge from each matrix.
- !! sysBasisList: array indicating which basis functions of the merged molecular system belong to sysI and sysII Merged Coefficients: Matrices for output.
- !<
- subroutine NonOrthogonalCI_mergeCoefficients(coefficientsI,coefficientsII,molecularSystemI,molecularSystemII,mergedMolecularSystem,&
- sysIbasisList,sysIIbasisList,mergedCoefficients)
- type(Matrix), intent(in) :: coefficientsI(*), coefficientsII(*)
- type(MolecularSystem), intent(in) :: molecularSystemI, molecularSystemII, mergedMolecularSystem
- type(IVector), intent(in) :: sysIbasisList(*), sysIIbasisList(*)
- type(Matrix), intent(out) :: mergedCoefficients(*)
-
- ! character(100) :: wfnFile
- ! character(50) :: arguments(2)
- ! integer :: wfnUnit
- integer :: speciesID, i, j, mu
-
- !! Mix coefficients of occupied orbitals of both systems
- !!Create a dummy density matrix to lowdin.wfn file
- ! wfnUnit = 500
- ! wfnFile = "lowdin.wfn"
- ! open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted")
- do speciesID = 1, mergedMolecularSystem%numberOfQuantumSpecies
-
- ! arguments(2) = mergedMolecularSystem%species(speciesID)%name
-
- ! arguments(1) = "COEFFICIENTS"
-
- ! !Max: to make the matrix square for the integral calculations for configuration pairs, and rectangular for the merged coefficients of all systems
- call Matrix_constructor(mergedCoefficients(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), &
- int(max(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)),8), 0.0_8 )
-
- ! print *, "sysI coefficients for ", speciesID
- ! call Matrix_show(coefficientsI(speciesID))
- ! print *, "sysII coefficients for ", speciesID
- ! call Matrix_show(coefficientsII(speciesID))
-
- !sysI orbitals on the left columns, sysII on the right columns
-
- !sysI coefficients
- do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
- if((sysIbasisList(speciesID)%values(mu) .ne. 0) ) then
- do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)!sysI
- mergedCoefficients(speciesID)%values(mu,i)=coefficientsI(speciesID)%values(sysIbasisList(speciesID)%values(mu),i)
- ! print *, "sys I", mu, i, mergedCoefficients(speciesID)%values(mu,i)
- end do
- end if
- end do
-
- ! !sysII coefficients
- do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
- if((sysIIbasisList(speciesID)%values(mu) .ne. 0) ) then
- do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemII)!sysII
- j=MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)+i !column
- mergedCoefficients(speciesID)%values(mu,j)=coefficientsII(speciesID)%values(sysIIbasisList(speciesID)%values(mu),i)
- ! print *, "sys II", mu, j, mergedCoefficients(speciesID)%values(mu,j)
- end do
- end if
- end do
-
- ! print *, "Merged coefficients matrix for ", speciesID
- ! call Matrix_show(mergedCoefficients(speciesID))
-
- ! call Matrix_writeToFile(mergedCoefficients(speciesID), unit=wfnUnit, binary=.true., arguments = arguments )
-
- ! arguments(1) = "DENSITY"
- ! call Matrix_constructor(auxMatrix, int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), &
- ! int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), 0.0_8 )
-
- ! auxMatrix%values=1.0
-
- ! do i = 1 , MolecularSystem_getOcupationNumber(speciesID)*2 !!double size A+B
- ! do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! auxMatrix%values(mu,nu)=auxMatrix%values(mu,nu)&
- ! +MolecularSystem_getEta(speciesID)*mergedCoefficients(speciesID)%values(mu,i)*mergedCoefficients(speciesID)%values(nu,i)
- ! end do
- ! end do
- ! end do
-
- ! print *, "auxDensity", speciesID
- ! call Matrix_show(auxMatrix)
-
- ! call Matrix_writeToFile(auxMatrix, unit=wfnUnit, binary=.true., arguments = arguments )
-
- ! arguments(1) = "ORBITALS"
- ! call Vector_constructor(auxVector, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), 0.0_8 )
-
- ! call Vector_writeToFile(auxVector, unit=wfnUnit, binary=.true., arguments = arguments )
-
- ! Only occupied orbitals are going to be transformed - handled in integral transformation program
- ! print *, "removed", MolecularSystem_getTotalNumberOfContractions(speciesID)-MolecularSystem_getOcupationNumber(speciesID)
- ! arguments(1) = "REMOVED-ORBITALS"
- ! call Vector_writeToFile(unit=wfnUnit, binary=.true., &
- ! value=real(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)-MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem),8),&
- ! arguments= arguments )
-
- end do
- ! close(wfnUnit)
-
- end subroutine NonOrthogonalCI_mergeCoefficients
-
-
- !>
- !! @brief Computes an upper bound of the overlap between two configurations, based on the max distance between particles of the same species and the lowest exponent of the basis set functions. Assumes a localized hartree product for the heaviest species
- !!
- !! @param sysI and sysII: molecular system indices. estimatedOverlap: output value
- !<
- subroutine NonOrthogonalCI_prescreenOverlap(this,sysI,sysII,estimatedOverlap)
- type(NonOrthogonalCI) :: this
- integer :: sysI, sysII !Indices of the systems to screen
- real(8) :: estimatedOverlap
-
- type(Vector), allocatable :: displacementVector(:)
- integer :: speciesID, k, l, m
- real(8) :: massThreshold, minExponent, speciesOverlap
-
- !displacement vectors contains the max distance between equivalent basis function centers
- allocate(displacementVector(this%molecularSystems(sysI)%numberOfQuantumSpecies))
-
- call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), this%molecularSystems(sysII),displacementVector(:))
-
- estimatedOverlap=1.0
-
- !only compute for heavy particles, maybe should be a control parameter
- massThreshold=10.0
-
- do speciesID = 1, this%molecularSystems(sysI)%numberOfQuantumSpecies
- if(this%molecularSystems(sysI)%species(speciesID)%mass .lt. massThreshold) cycle
- speciesOverlap=1.0
- !!get smallest exponent of the basis set
- do k = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles)
- minExponent=1.0E8
- do l = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction)
- do m = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents)
- if(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m).lt.minExponent) &
- minExponent=this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m)
- !Assume a 1S GTF
- ! normCoefficients(speciesID)=(2.0*minExponents(speciesID)/Math_PI)**(3.0/4.0)
- end do
- end do
- !!Compute an hipothetical overlap between two 1S functions with the lowest orbital exponent separated at the distance between systems
- speciesOverlap=speciesOverlap*exp(-minExponent*displacementVector(speciesID)%values(k)**2/2.0)
- end do
-
- ! print *, "sysI", sysI, "sysII", sysII, "species", speciesID,"overlap approx", speciesOverlap
- estimatedOverlap=estimatedOverlap*speciesOverlap
- end do
-
- deallocate(displacementVector)
-
- end subroutine NonOrthogonalCI_prescreenOverlap
-
- !>
- !! @brief Classify the sysI and sysII pair according to their distance matrix
- !!
- !! @param sysI and sysII: molecular system indices.
- !<
- ! subroutine NonOrthogonalCI_classifyConfigurationPair(this,currentSysI,currentSysII,newPairFlag)
- ! implicit none
- ! type(NonOrthogonalCI) :: this
- ! integer :: currentSysI, currentSysII !Indices of the systems to classify
- ! logical :: newPairFlag
-
- ! type(MolecularSystem) :: currentMolecularSystem
- ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix
-
- ! integer :: sysI, sysII, i, checkingType
- ! logical :: match
-
- ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance)
- ! newPairFlag=.true.
- ! currentDistanceMatrix=ParticleManager_getDistanceMatrix()
-
- ! ! print *, "Current distance matrix"
- ! ! call Matrix_show(currentDistanceMatrix)
-
- ! types: do checkingType=1, this%numberOfUniquePairs
- ! ! print *, "checkingType", checkingType
- ! systemI: do sysI=1, currentSysI
- ! systemII: do sysII=sysI+1, currentSysII
-
- ! if(sysI .eq. currentSysI .and. sysII .eq. currentSysII ) cycle types
-
- ! if((this%configurationPairTypes%values(sysI,sysII) .eq. checkingType) .and. &
- ! (this%systemTypes%values(sysI) .eq. this%systemTypes%values(currentSysI)) .and. &
- ! (this%systemTypes%values(sysII) .eq. this%systemTypes%values(currentSysII))) then
-
- ! ! call MolecularSystem_mergeTwoSystems(molecularSystem_instance, this%MolecularSystems(sysI), this%MolecularSystems(sysII))
-
- ! previousDistanceMatrix=ParticleManager_getDistanceMatrix()
-
- ! ! print *, "Comparing with previous distance matrix", checkingType
- ! ! call Matrix_show(previousDistanceMatrix)
-
- ! match=.true.
- ! do i=1, size(currentDistanceMatrix%values(:,1))
- ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. &
- ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then
- ! match=.false.
- ! exit
- ! end if
- ! end do
-
- ! if(match) then
- ! newPairFlag=.false.
- ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%configurationPairTypes%values(sysI,sysII)
- ! exit types
- ! else
- ! cycle types
- ! end if
- ! end if
- ! end do systemII
- ! end do systemI
- ! end do types
-
- ! if(newPairFlag) then
- ! this%numberOfUniquePairs=this%numberOfUniquePairs+1
- ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%numberOfUniquePairs
- ! end if
-
- ! if(this%configurationPairTypes%values(currentSysI,currentSysII).eq.0) then
- ! print *, "newPairFlag", newPairFlag
- ! print *, currentSysI, currentSysII, this%configurationPairTypes%values(currentSysI,currentSysII)
- ! STOP "I found a type zero"
- ! end if
- ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem)
-
- ! end subroutine NonOrthogonalCI_classifyConfigurationPair
-
-
- !>
- !! @brief Computes overlap matrix element between two configurations along with one particle energy contributions
- !!
- !! @param sysI and sysII: molecular system indices. Merged Molecular System: Union of objects from sysI and sysII. Merged Coefficients: Mixed molecular system coefficients. Sys basis list indicate the basis functions of each sysI and sysII in the merged molecular system. inverseOverlapMatrices: output required for two particle contributions
- !<
- subroutine NonOrthogonalCI_computeOverlapAndHCoreElements(this,sysI,sysII,mergedMolecularSystem,mergedCoefficients, &
- sysIbasisList, sysIIbasisList,inverseOverlapMatrices)
-
- type(NonOrthogonalCI) :: this
- type(MolecularSystem) :: mergedMolecularSystem
- integer :: sysI, sysII
- type(Matrix) :: mergedCoefficients(*), inverseOverlapMatrices(*)
- type(IVector) :: sysIbasisList(*), sysIIbasisList(*)
-
- integer :: speciesID
- integer :: a,b,bb,mu,nu
- integer :: numberOfContractions,occupationNumber,particlesPerOrbital
- type(Matrix) :: molecularOverlapMatrix
- type(Matrix), allocatable :: auxOverlapMatrix(:), auxKineticMatrix(:), auxAttractionMatrix(:), auxExternalPotMatrix(:)
- type(Matrix), allocatable :: molecularKineticMatrix(:), molecularAttractionMatrix(:), molecularExternalMatrix(:)
- type(Vector) :: overlapDeterminant
- real(8) :: oneParticleKineticEnergy,oneParticleAttractionEnergy,oneParticleExternalEnergy
-
- allocate(auxOverlapMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
- auxKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
- auxAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
- auxExternalPotMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
- molecularKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
- molecularAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), &
- molecularExternalMatrix(mergedMolecularSystem%numberOfQuantumSpecies))
-
- !!Initialize overlap
- this%configurationOverlapMatrix%values(sysI,sysII)=1.0
-
- call Vector_constructor(overlapDeterminant, mergedMolecularSystem%numberOfQuantumSpecies, 0.0_8)
-
-!!!!Overlap first
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
-
- numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem)
- !! Calculate one- particle integrals
- call DirectIntegralManager_getOverlapIntegrals(mergedMolecularSystem,speciesID,&
- auxOverlapMatrix(speciesID))
-
- !!Test
-
- ! print *, "auxOverlapMatrix", speciesID
- ! call Matrix_show(auxOverlapMatrix(speciesID))
-
- call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), &
- int(occupationNumber,8), 0.0_8 )
-
- do mu=1, numberOfContractions!sysI
- if(sysIbasisList(speciesID)%values(mu) .eq. 0 ) cycle
- do nu=1, numberOfContractions !sysII
- if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle
- do a=1, occupationNumber !sysI
- do b=occupationNumber+1, 2*occupationNumber
- bb=b-occupationNumber
- ! print *, "a, b, mu, nu, coefI, coefII", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b),auxOverlapMatrix(speciesID)%values(mu,nu)
-
- molecularOverlapMatrix%values(a,bb)=molecularOverlapMatrix%values(a,bb)+&
- mergedCoefficients(speciesID)%values(mu,a)*&
- mergedCoefficients(speciesID)%values(nu,b)*&
- auxOverlapMatrix(speciesID)%values(mu,nu)
- end do
- end do
- end do
- end do
-
- ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID
- ! call Matrix_show(molecularOverlapMatrix)
-
- !Sometimes we run calculations for systems with ghost species
- if(occupationNumber .ne. 0) then
- inverseOverlapMatrices(speciesID)=Matrix_inverse(molecularOverlapMatrix)
- ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII
- ! call Matrix_show(inverseOverlapMatrices(speciesID))
- call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant%values(speciesID),method="LU")
- ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant%values(speciesID)
- else
- overlapDeterminant%values(speciesID)=1.0
- end if
-
- this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(sysI,sysII)*overlapDeterminant%values(speciesID)**particlesPerOrbital
-
-
- end do
-
- ! print *, "total overlap", this%configurationOverlapMatrix%values(sysI,sysII)
-
- !!Skip the rest of the evaluation if the overlap is smaller than the threshold
- if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. &
- abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) return
-
- !!Point charge-Point charge repulsion
- this%configurationHamiltonianMatrix%values(sysI,sysII)=MolecularSystem_getPointChargesEnergy()*&
- this%configurationOverlapMatrix%values(sysI,sysII)
- ! print *, "Point charge-Point charge repulsion", MolecularSystem_getPointChargesEnergy()
-
- !!Compute hcore if overlap is significant
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
-
- numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem)
-
- call Matrix_constructor(auxKineticMatrix(speciesID),&
- int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
- call Matrix_constructor(auxAttractionMatrix(speciesID),&
- int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
- call Matrix_constructor(auxExternalPotMatrix(speciesID),&
- int(numberOfContractions,8),int(numberOfContractions,8),0.0_8)
-
- call DirectIntegralManager_getKineticIntegrals(mergedMolecularSystem,speciesID,auxKineticMatrix(speciesID))
- call DirectIntegralManager_getAttractionIntegrals(mergedMolecularSystem,speciesID,auxAttractionMatrix(speciesID))
- if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- call DirectIntegralManager_getExternalPotentialIntegrals(mergedMolecularSystem,speciesID,auxExternalPotMatrix(speciesID))
-
- !! Incluiding mass effect
- if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then
- auxKineticMatrix(speciesID)%values = &
- auxKineticMatrix(speciesID)%values * &
- ( 1.0_8/MolecularSystem_getMass( speciesID ) -1.0_8 / MolecularSystem_getTotalMass() )
- else
- auxKineticMatrix(speciesID)%values = &
- auxKineticMatrix(speciesID)%values / &
- MolecularSystem_getMass( speciesID )
- end if
-
- !! Including charge
- auxAttractionMatrix(speciesID)%values=auxAttractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID))
-
- call Matrix_constructor(molecularKineticMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
- call Matrix_constructor(molecularAttractionMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
- call Matrix_constructor(molecularExternalMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
-
- !!Test
- ! print *, "auxKineticMatrix", speciesID
- ! call Matrix_show(auxKineticMatrix(speciesID))
- ! print *, "auxAttractionMatrix", speciesID
- ! call Matrix_show(auxAttractionMatrix(speciesID))
-
- do mu=1, numberOfContractions !sysI
- if(sysIbasisList(speciesID)%values(mu) .eq. 0) cycle
- do nu=1, numberOfContractions !sysII
- if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle
- do a=1, occupationNumber !sysI
- do b=occupationNumber+1, 2*occupationNumber
- bb=b-occupationNumber
-
- ! print *, "hcore", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b), &
- ! auxKineticMatrix%values(mu,nu)/MolecularSystem_getMass(speciesID)+&
- ! auxAttractionMatrix%values(mu,nu)*(-MolecularSystem_getCharge(speciesID))
-
- molecularKineticMatrix(speciesID)%values(a,bb)=molecularKineticMatrix(speciesID)%values(a,bb)+&
- mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*&
- auxKineticMatrix(speciesID)%values(mu,nu)
-
- molecularAttractionMatrix(speciesID)%values(a,bb)=molecularAttractionMatrix(speciesID)%values(a,bb)+&
- mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*&
- auxAttractionMatrix(speciesID)%values(mu,nu)
-
- if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- molecularExternalMatrix(speciesID)%values(a,bb)=molecularExternalMatrix(speciesID)%values(a,bb)+&
- mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*&
- auxExternalPotMatrix(speciesID)%values(mu,nu)
- end do
- end do
- end do
- end do
- molecularKineticMatrix(speciesID)%values=particlesPerOrbital*molecularKineticMatrix(speciesID)%values
- molecularAttractionMatrix(speciesID)%values=particlesPerOrbital*molecularAttractionMatrix(speciesID)%values
- molecularExternalMatrix(speciesID)%values=particlesPerOrbital*molecularExternalMatrix(speciesID)%values
- !!End test
- end do
-
- !!One Particle Terms
- do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies
- oneParticleKineticEnergy=0.0
- oneParticleAttractionEnergy=0.0
- oneParticleExternalEnergy=0.0
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- do a=1, occupationNumber !sysI
- do b=1, occupationNumber !sysII
- oneParticleKineticEnergy=oneParticleKineticEnergy+ molecularKineticMatrix(speciesID)%values(a,b)*&
- inverseOverlapMatrices(speciesID)%values(b,a)
- oneParticleAttractionEnergy=oneParticleAttractionEnergy+ molecularAttractionMatrix(speciesID)%values(a,b)*&
- inverseOverlapMatrices(speciesID)%values(b,a)
- oneParticleExternalEnergy=oneParticleExternalEnergy+ molecularExternalMatrix(speciesID)%values(a,b)*&
- inverseOverlapMatrices(speciesID)%values(b,a)
- end do
- end do
- this%configurationKineticMatrix(speciesID)%values(sysI,sysII)=oneParticleKineticEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
- this%configurationPuntualMatrix(speciesID)%values(sysI,sysII)=oneParticleAttractionEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
- this%configurationExternalMatrix(speciesID)%values(sysI,sysII)=oneParticleExternalEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
-
- this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+&
- (oneParticleKineticEnergy+oneParticleAttractionEnergy+oneParticleExternalEnergy)*this%configurationOverlapMatrix%values(sysI,sysII)
- ! print *, "sysI, sysII", sysI, sysII, "oneParticleEnergy for species", speciesID, oneParticleEnergy
- end do
-
- deallocate(auxOverlapMatrix, auxKineticMatrix, auxAttractionMatrix, auxExternalPotMatrix, &
- molecularKineticMatrix, molecularAttractionMatrix, molecularExternalMatrix)
-
- end subroutine NonOrthogonalCI_computeOverlapAndHCoreElements
- !>
- !! @brief Computes the two particles contributions to the non diagonal elements of the hamiltonian matrix
- !!
- !! @param this, sysI,sysII: system indexes, inverseOverlapMatrices, mergedCoefficients are required to evaluate the elements
- !<
- subroutine NonOrthogonalCI_twoParticlesContributions(this,sysI,sysII,mergedMolecularSystem,inverseOverlapMatrices,mergedCoefficients,Libint2LocalInstance)
- implicit none
- type(NonOrthogonalCI) :: this
- integer :: sysI, sysII
- type(MolecularSystem) :: mergedMolecularSystem
- type(Matrix) :: inverseOverlapMatrices(*)
- type(Matrix) :: mergedCoefficients(*)
- type(Libint2Interface) :: Libint2LocalInstance(*)
-
- type(matrix), allocatable :: fourCenterIntegrals(:,:)
- type(imatrix), allocatable :: twoIndexArray(:),fourIndexArray(:)
- integer :: numberOfContractions,occupationNumber,particlesPerOrbital
- integer :: otherNumberOfContractions,otherOccupationNumber,otherParticlesPerOrbital
- integer :: ssize1, auxIndex, auxIndex1
- integer :: a,b,bb,c,d,dd,i,j
- real(8) :: hartreeEnergy, exchangeEnergy
-
- allocate(fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies), &
- twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies), &
- fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies))
-
- !!Fill indexes arrays
- do i=1, mergedMolecularSystem%numberOfQuantumSpecies
- ! print *, "reading integrals species", i
- numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem)
- occupationNumber=MolecularSystem_getOcupationNumber(i,mergedMolecularSystem)
- !!Two particle integrals indexes
- call Matrix_constructorInteger(twoIndexArray(i), &
- int(max(numberOfContractions,occupationNumber),8), &
- int(max(numberOfContractions,occupationNumber),8), 0 )
-
- c = 0
- do a=1,max(numberOfContractions,occupationNumber)
- do b=a, max(numberOfContractions,occupationNumber)
- c = c + 1
- twoIndexArray(i)%values(a,b) = c !IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
- twoIndexArray(i)%values(b,a) = twoIndexArray(i)%values(a,b)
- end do
- end do
-
- ssize1 = max(numberOfContractions,occupationNumber)
- ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2
-
- call Matrix_constructorInteger(fourIndexArray(i), int( ssize1,8), int( ssize1,8) , 0 )
-
- c = 0
- do a = 1, ssize1
- do b = a, ssize1
- c = c + 1
- fourIndexArray(i)%values(a,b) = c! IndexMap_tensorR2ToVectorC( a, b, numberOfContractions )
- fourIndexArray(i)%values(b,a) = fourIndexArray(i)%values(a,b)
- end do
- end do
- end do
-
- !! Calculate two- particle integrals
- call NonOrthogonalCI_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, &
- twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance)
-
-!!!Add charges
- if ( .not. InterPotential_instance%isInstanced) then
- do i=1, mergedMolecularSystem%numberOfQuantumSpecies
- fourCenterIntegrals(i,i)%values = &
- fourCenterIntegrals(i,i)%values * mergedMolecularSystem%species(i)%charge**2.0
-
- do j = i+1 , MolecularSystem_instance%numberOfQuantumSpecies
- fourCenterIntegrals(i,j)%values = &
- fourCenterIntegrals(i,j)%values * mergedMolecularSystem%species(i)%charge * mergedMolecularSystem%species(j)%charge
- end do
- end do
- end if
-!!!Compute Hamiltonian Matrix element between displaced geometries
-
- ! !!Point charge-Point charge repulsion
- ! !!One Particle Terms
- ! !!Have already been computed
-
- !!Same species repulsion
- do i=1, mergedMolecularSystem%numberOfQuantumSpecies
- numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem)
- occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI))
- particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem)
- hartreeEnergy=0.0
- exchangeEnergy=0.0
- do a=1,occupationNumber !sysI
- do b=occupationNumber+1, 2*occupationNumber !sysII
- bb=b-occupationNumber
- do c=1, occupationNumber !sysI
- do d=occupationNumber+1, 2*occupationNumber !sysII
- dd=d-occupationNumber
- auxIndex = fourIndexArray(i)%values(twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d) )
- hartreeEnergy=hartreeEnergy+0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*&
- inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(i)%values(dd,c)*particlesPerOrbital**2 !coulomb
- exchangeEnergy=exchangeEnergy-0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*&
- inverseOverlapMatrices(i)%values(dd,a)*inverseOverlapMatrices(i)%values(bb,c)*particlesPerOrbital !exchange
- ! print *, a, b, c, d, twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d), fourIndexArray(i)%values( &
- ! twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d)),
- end do
- end do
- end do
- end do
- this%configurationHartreeMatrix(i,i)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
- this%configurationExchangeMatrix(i)%values(sysI,sysII)=exchangeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
- this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+&
- (hartreeEnergy+exchangeEnergy)*this%configurationOverlapMatrix%values(sysI,sysII)
- ! print *, "same species interactionEnergy for species", i, hartreeEnergy, exchangeEnergy
- end do
-
- !!Interspecies repulsion
- do i=1, mergedMolecularSystem%numberOfQuantumSpecies-1
- numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem)
- occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI))
- particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem)
- do j=i+1, mergedMolecularSystem%numberOfQuantumSpecies
- otherNumberOfContractions=MolecularSystem_getTotalNumberOfContractions(j,mergedMolecularSystem)
- otherOccupationNumber=MolecularSystem_getOcupationNumber(j,mergedMolecularSystem)
- otherParticlesPerOrbital=MolecularSystem_getEta(j,mergedMolecularSystem)
- hartreeEnergy=0.0
- ssize1 = max(otherNumberOfContractions,otherOccupationNumber)
- ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2
- otherOccupationNumber=MolecularSystem_getOcupationNumber(j,this%molecularSystems(sysI))
- do a=1, occupationNumber !sysI
- do b=occupationNumber+1, 2*occupationNumber !sysII
- bb=b-MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI))
- auxIndex1 = ssize1 * (twoIndexArray(i)%values(a,b) - 1 )
- do c=1, otherOccupationNumber !sysI
- do d=otherOccupationNumber+1,2*otherOccupationNumber !sysII
- dd=d-otherOccupationNumber
- auxIndex = auxIndex1 + twoIndexArray(j)%values(c,d)
- hartreeEnergy=hartreeEnergy+fourCenterIntegrals(i,j)%values(auxIndex, 1)*&
- inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(j)%values(dd,c)*&
- particlesPerOrbital*otherParticlesPerOrbital
- ! print *, a, b, c, d, fourCenterIntegrals(i,j)%values(auxIndex, 1), inverseOverlapMatrices(i)%values(bb,a), inverseOverlapMatrices(j)%values(dd,c)
- end do
- end do
- end do
- end do
- this%configurationHartreeMatrix(i,j)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
- this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+&
- hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII)
- ! print *, "interspecies hartreeEnergy for species", i, j, hartreeEnergy
- end do
- end do
-
- deallocate(fourCenterIntegrals,twoIndexArray,fourIndexArray)
-
- end subroutine NonOrthogonalCI_twoParticlesContributions
-
- !>
- !! @brief Solves the NOCI matrix equation
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_diagonalizeCImatrix(this)
- implicit none
- type(NonOrthogonalCI) :: this
- type(Matrix) :: transformationMatrix,transformedHamiltonianMatrix,eigenVectors,auxMatrix
- type(Vector) :: eigenValues
- integer :: removedStates
- integer :: speciesID,otherSpeciesID,sysI,sysII,state,i,j
- real(8) :: auxEnergy
- real(8) :: timeA
-
- !$ timeA = omp_get_wtime()
-
- call Matrix_constructor(this%configurationCoefficients, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8)
- call Vector_constructor(this%statesEigenvalues, this%numberOfDisplacedSystems, 0.0_8)
-
- ! print *, "non orthogonal CI overlap Matrix "
- ! call Matrix_show(this%configurationOverlapMatrix)
-
- ! print *, "non orthogonal CI Hamiltionian Matrix "
- ! call Matrix_show(this%configurationHamiltonianMatrix)
- !
- print *, ""
- print *, "Transforming non orthogonal CI Hamiltonian Matrix..."
-
- call Matrix_constructor(transformationMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8)
- call Matrix_constructor(transformedHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8)
-
- call Vector_constructor( eigenValues, this%numberOfDisplacedSystems )
- call Matrix_constructor( eigenVectors,int(this%numberOfDisplacedSystems,8),int(this%numberOfDisplacedSystems,8))
-
- !!****************************************************************
- !! diagonaliza la matriz de overlap obteniendo una matriz unitaria
- !!
- call Matrix_eigen( this%configurationOverlapMatrix, eigenValues, eigenVectors, SYMMETRIC )
-
- ! print *,"Overlap eigenvectors "
- ! call Matrix_show( eigenVectors )
-
- ! print *,"Overlap eigenvalues "
- ! call Vector_show( eigenValues )
-
- !! Remove states from configurations with linear dependencies
- do i = 1 , this%numberOfDisplacedSystems
- do j = 1 , this%numberOfDisplacedSystems
- if ( abs(eigenValues%values(j)) >= CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) then
- transformationMatrix%values(i,j) = &
- eigenVectors%values(i,j)/sqrt( eigenvalues%values(j) )
- else
- transformationMatrix%values(i,j) = 0
- end if
- end do
- end do
-
- removedStates=0
- do i = 1 , this%numberOfDisplacedSystems
- if ( abs(eigenValues%values(i)) .lt. CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) &
- removedStates=removedStates+1
- end do
-
- if (removedStates .gt. 0) &
- write(*,"(A,I5,A,ES9.3)") "Removed ", removedStates , &
- " states from the CI transformation Matrix with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD
-
-
- !!Ortogonalizacion simetrica
- transformationMatrix%values = &
- matmul(transformationMatrix%values, transpose(eigenVectors%values))
-
- ! print *,"Matriz de transformacion "
- ! call Matrix_show( transformationMatrix )
-
- !!**********************************************************************************************
- !! Transform configuration hamiltonian matrix
- !!
- transformedHamiltonianMatrix%values = &
- matmul( matmul( transpose( transformationMatrix%values ) , &
- this%configurationHamiltonianMatrix%values), transformationMatrix%values )
-
- ! print *,"transformed Hamiltonian Matrix "
- ! call Matrix_show( this%configurationHamiltonianMatrix )
-
- print *, "Diagonalizing non orthogonal CI Hamiltonian Matrix..."
- !! Calcula valores y vectores propios de matriz de CI transformada.
- call Matrix_eigen( transformedHamiltonianMatrix, this%statesEigenvalues, this%configurationCoefficients, SYMMETRIC )
-
- !! Calcula los vectores propios para matriz de CI
- this%configurationCoefficients%values = matmul( transformationMatrix%values, this%configurationCoefficients%values )
-
- ! print *,"non orthogonal CI eigenvalues "
- ! call Vector_show( this%statesEigenvalues )
-
- ! print *,"configuration Coefficients"
- ! call Matrix_show( this%configurationCoefficients )
-
- write(*,"(A)") ""
- write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION"
- write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION"
- write(*,"(A)") " EIGENVALUES AND EIGENVECTORS: "
- write(*,"(A)") "========================================="
- write(*,"(A)") ""
- do state = 1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems)
- write (*,"(A)") ""
- write (*,"(T9,A17,I3,A10, F25.12)") "STATE: ", state, " ENERGY = ", this%statesEigenvalues%values(state)
- write (*,"(A38)") "Components: "
- write(*,"(A38,F25.12)") " Point charges energy = ", MolecularSystem_getPointChargesEnergy()
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- auxEnergy=0
- do sysI=1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- this%configurationCoefficients%values(sysI,state)**2*&
- this%configurationKineticMatrix(speciesID)%values(sysI,sysI)
- do sysII=sysI+1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- 2.0_8*this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationKineticMatrix(speciesID)%values(sysI,sysII)
- end do
- end do
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- " Kinetic energy = ", auxEnergy
- end do
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- auxEnergy=0
- do sysI=1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- this%configurationCoefficients%values(sysI,state)**2*&
- this%configurationPuntualMatrix(speciesID)%values(sysI,sysI)
- do sysII=sysI+1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- 2.0_8*this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationPuntualMatrix(speciesID)%values(sysI,sysII)
- end do
- end do
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- " Puntual energy = ", auxEnergy
- end do
- if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- auxEnergy=0
- do sysI=1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- this%configurationCoefficients%values(sysI,state)**2*&
- this%configurationExternalMatrix(speciesID)%values(sysI,sysI)
- do sysII=sysI+1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- 2.0_8*this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationExternalMatrix(speciesID)%values(sysI,sysII)
- end do
- end do
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- " External energy = ", auxEnergy
- end do
- end if
- do speciesID=1, molecularSystem_instance%numberOfQuantumSpecies
- auxEnergy=0
- do sysI=1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- this%configurationCoefficients%values(sysI,state)**2*&
- this%configurationExchangeMatrix(speciesID)%values(sysI,sysI)
- do sysII=sysI+1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- 2.0_8*this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationExchangeMatrix(speciesID)%values(sysI,sysII)
- end do
- end do
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- " Exchange energy = ", auxEnergy
-
- do otherSpeciesID=speciesID, molecularSystem_instance%numberOfQuantumSpecies
- auxEnergy=0
- do sysI=1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- this%configurationCoefficients%values(sysI,state)**2*&
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysI)
- do sysII=sysI+1, this%numberOfDisplacedSystems
- auxEnergy= auxEnergy+ &
- 2.0_8*this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysII)
- end do
- end do
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
- " Hartree energy = ", auxEnergy
- end do
- end do
- end do
- write(*,"(A)") ""
-
- call Matrix_constructor(auxMatrix,int(this%numberOfDisplacedSystems,8),&
- int(CONTROL_instance%CI_STATES_TO_PRINT,8),0.0_8)
- do i=1, this%numberOfDisplacedSystems
- do j=1, CONTROL_instance%CI_STATES_TO_PRINT
- auxMatrix%values(i,j)=this%configurationCoefficients%values(i,j)
- end do
- end do
-
-
- write(*,"(I5,A)") CONTROL_instance%CI_STATES_TO_PRINT, " LOWEST LYING STATES CONFIGURATION COEFFICIENTS"
- write(*,"(A)") ""
- call Matrix_show(auxMatrix , &
- rowkeys = this%systemLabels, &
- columnkeys = string_convertvectorofrealstostring( this%statesEigenvalues ),&
- flags=WITH_BOTH_KEYS)
- write(*,"(A)") ""
-
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI matrix diagonalization : ", omp_get_wtime() - timeA ," (s)"
-
- end subroutine NonOrthogonalCI_diagonalizeCImatrix
-
- !>
- !! @brief Generates one molecular system combining all the displaced geometries and coefficients
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_generateSuperposedSystem(this)
- implicit none
- type(NonOrthogonalCI) :: this
- type(MolecularSystem) :: auxMolecularSystem
- type(Matrix), allocatable :: auxCoefficients(:)
- type(IVector), allocatable :: auxBasisList(:)
-
- integer :: i, sysI, speciesID
- integer :: numberOfSpecies
-
- real(8) :: timeA
-
- !$ timeA = omp_get_wtime()
-
- if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
-
- numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
-
- allocate(this%sysBasisList(this%numberOfDisplacedSystems,numberOfSpecies),&
- auxCoefficients(numberOfSpecies),&
- auxBasisList(numberOfSpecies))
-
- !Create a super molecular system
- !!!Merge coefficients from system 1 and system 2
- call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, this%molecularSystems(1), this%molecularSystems(2), &
- this%sysBasisList(1,:),this%sysBasisList(2,:))
-
- call NonOrthogonalCI_mergeCoefficients(this%HFCoefficients(1,:),this%HFCoefficients(2,:),&
- this%molecularSystems(1),this%molecularSystems(2),this%mergedMolecularSystem,&
- this%sysBasisList(1,:),this%sysBasisList(2,:),this%mergedCoefficients(:))
-
- ! do speciesID=1, numberOfSpecies
- ! print *, "2", speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem)
- ! print *, "2", speciesID, "mergedCoefficients"
- ! call Matrix_show(this%mergedCoefficients(speciesID))
- ! end do
- !
- !! Loop other systems expanding the merged coefficients matrix
- do sysI=3, this%numberOfDisplacedSystems
- call MolecularSystem_copyConstructor(auxMolecularSystem,this%mergedMolecularSystem)
- do speciesID=1, numberOfSpecies
- call Matrix_copyConstructor(auxCoefficients(speciesID), this%mergedCoefficients(speciesID))
- end do
- call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, auxMolecularSystem, this%molecularSystems(sysI), &
- auxBasisList,this%sysBasisList(sysI,:),reorder=.false.)
- call NonOrthogonalCI_mergeCoefficients(auxCoefficients,this%HFCoefficients(sysI,:),&
- auxMolecularSystem,this%molecularSystems(sysI),this%mergedMolecularSystem,&
- auxBasisList,this%sysBasisList(sysI,:),this%mergedCoefficients(:))
- ! do speciesID=1, numberOfSpecies
- ! print *, sysI, speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem)
- ! print *, sysI, speciesID, "mergedCoefficients"
- ! call Matrix_show(this%mergedCoefficients(speciesID))
- ! end do
- end do
-
- !!!Fix basis list size
- do sysI=1, this%numberOfDisplacedSystems
- do speciesID=1, numberOfSpecies
- call Vector_copyConstructorInteger(auxBasisList(speciesID),this%sysBasisList(sysI,speciesID))
- call Vector_constructorInteger(this%sysBasisList(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,this%mergedMolecularSystem), 0)
- do i=1, size(auxBasisList(speciesID)%values)
- this%sysBasisList(sysI,speciesID)%values(i)=auxBasisList(speciesID)%values(i)
- end do
- ! print *, "sysI", sysI, "speciesID", speciesID, "after list"
- ! call Vector_showInteger(this%sysBasisList(sysI,speciesID))
- end do
- end do
-
- write(*,*) ""
- print *, "Superposed molecular system geometry"
- write(*,*) "---------------------------------- "
- ! call MolecularSystem_showInformation()
- ! call MolecularSystem_showParticlesInformation()
- call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem)
- call MolecularSystem_showCartesianMatrix(molecularSystem_instance)
- particleManager_instance => molecularSystem_instance%allParticles
- call ParticleManager_setOwner()
- call MolecularSystem_saveToFile()
-
- ! do speciesID=1, numberOfSpecies
- ! write(*,*) ""
- ! write(*,*) " Merged Occupied Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name )
- ! write(*,*) "---------------------------------- "
- ! write(*,*) ""
- ! print *, "contractions", speciesID, int(MolecularSystem_getTotalNumberOfContractions(speciesID),8)
- ! print *, "ocupation", speciesID, int(MolecularSystem_getOcupationNumber(speciesID),8)
- ! call Matrix_constructor(auxCoefficients(speciesID),int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),&
- ! int(MolecularSystem_getOcupationNumber(speciesID),8),0.0_8)
- ! do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! do j=1, MolecularSystem_getOcupationNumber(speciesID)
- ! auxCoefficients(speciesID)%values(i,j)=mergedCoefficients(speciesID)%values(i,j)
- ! end do
- ! end do
- ! call Matrix_show(auxCoefficients(speciesID))
- ! end do
-
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time creating supermolecular system : ", omp_get_wtime() - timeA ," (s)"
- !$ timeA = omp_get_wtime()
-
- deallocate(auxCoefficients,&
- auxBasisList)
-
- return
-
- end subroutine NonOrthogonalCI_generateSuperposedSystem
-
- !>
- !! @brief Generates the NOCI density matrix in the superposed molecular system
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_buildDensityMatrix(this)
- implicit none
- type(NonOrthogonalCI) :: this
-
- type(Matrix) :: molecularOverlapMatrix
- type(Matrix), allocatable :: inverseOverlapMatrix(:) !,kineticMatrix(:), attractionMatrix(:), externalPotMatrix(:)
- integer :: state
- integer :: i,ii,j,jj,mu,nu, sysI, sysII, speciesID, otherSpeciesID
- integer :: particlesPerOrbital
- integer :: numberOfSpecies
-
- integer :: densUnit
- character(100) :: densFile
- character(50) :: arguments(2), auxString
- type(Matrix), allocatable :: exchangeCorrelationMatrices(:)
- type(Matrix) :: dftEnergyMatrix
- real(8), allocatable :: particlesInGrid(:)
- real(8) :: timeA
-
- !$ timeA = omp_get_wtime()
-
- if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
-
- numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
-
- allocate(InverseOverlapMatrix(numberOfSpecies))
-
- print *, ""
- print *, "Computing overlap integrals for the superposed systems..."
- print *, ""
- do speciesID = 1, numberOfSpecies
- call DirectIntegralManager_getOverlapIntegrals(molecularSystem_instance,speciesID,this%mergedOverlapMatrix(speciesID))
- end do
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)"
- !$ timeA = omp_get_wtime()
-
- print *, ""
- print *, "Building merged density matrices for the superposed systems..."
- print *, ""
- !!Build the merged density matrix
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- do speciesID=1, numberOfSpecies
- call Matrix_constructor(this%mergedDensityMatrix(state,speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8)
- end do
- end do
- !!Fill the merged density matrix
- ! "Diagonal" terms - same system
- do sysI=1, this%numberOfDisplacedSystems
- do speciesID=1, numberOfSpecies
- particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
- do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle
- do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- if(this%sysBasisList(sysI,speciesID)%values(nu) .eq. 0) cycle
- do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + &
- this%configurationCoefficients%values(sysI,state)**2*&
- this%mergedCoefficients(speciesID)%values(mu,ii)*&
- this%mergedCoefficients(speciesID)%values(nu,ii)*&
- particlesPerOrbital
- end do
- end do
- end do
- end do
- end do
- end do
- !!"Non Diagonal" terms - system pairs
- do sysI=1, this%numberOfDisplacedSystems
- do sysII=sysI+1, this%numberOfDisplacedSystems
- if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle
- !!Compute molecular overlap matrix and its inverse
- do speciesID=1, numberOfSpecies
- call Matrix_constructor(molecularOverlapMatrix, &
- int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), &
- int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 )
- call Matrix_constructor(inverseOverlapMatrix(speciesID), &
- int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), &
- int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 )
-
- do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysI
- if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle
- do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysII
- if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle
- do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i
- do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))
- jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j
- ! print *, "i, j, mu, nu, coefI, coefII", i,j,mu,nu,mergedCoefficients(speciesID)%values(mu,ii),mergedCoefficients(speciesID)%values(nu,jj)
- molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+&
- this%mergedCoefficients(speciesID)%values(mu,ii)*&
- this%mergedCoefficients(speciesID)%values(nu,jj)*&
- this%mergedOverlapMatrix(speciesID)%values(mu,nu)
- end do
- end do
- end do
- end do
- ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID
- ! call Matrix_show(molecularOverlapMatrix)
- if(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) .ne. 0) &
- inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix)
- end do
-
- ! Compute density contributions
- do speciesID=1, numberOfSpecies
- particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
- do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle
- do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))
- ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i
- do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))
- jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j
- this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + &
- this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationOverlapMatrix%values(sysI,sysII)*&
- inverseOverlapMatrix(speciesID)%values(j,i)*&
- this%mergedCoefficients(speciesID)%values(mu,ii)*&
- this%mergedCoefficients(speciesID)%values(nu,jj)*&
- particlesPerOrbital
- this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(nu,mu) + &
- this%configurationCoefficients%values(sysI,state)*&
- this%configurationCoefficients%values(sysII,state)*&
- this%configurationOverlapMatrix%values(sysI,sysII)*&
- inverseOverlapMatrix(speciesID)%values(j,i)*&
- this%mergedCoefficients(speciesID)%values(mu,ii)*&
- this%mergedCoefficients(speciesID)%values(nu,jj)*&
- particlesPerOrbital
- end do
- end do
- end do
- end do
- end do
- end do
- !!symmetrize
- ! do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! do nu = mu+1 , MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu)
- ! end do
- ! end do
- end do
- end do
-
- !! Open file - to write density matrices
- densUnit = 29
-
- densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- open(unit = densUnit, file=trim(densFile), status="replace", form="formatted")
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- do speciesID=1, numberOfSpecies
- ! print *, "this%mergedDensityMatrix", state, trim( MolecularSystem_instance%species(speciesID)%name )
- ! call Matrix_show(this%mergedDensityMatrix(state,speciesID))
- write(auxString,*) state
- arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
- arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxString))
- call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) )
- end do
- end do
-
- if(CONTROL_instance%ELECTRON_EXCHANGE_CORRELATION_FUNCTIONAL.ne."NONE" .or. &
- CONTROL_instance%NUCLEAR_ELECTRON_CORRELATION_FUNCTIONAL.ne."NONE") then
- print *, "Superposed DFT energies:"
-
- allocate(exchangeCorrelationMatrices(numberOfSpecies), &
- particlesInGrid(numberOfSpecies))
- call DensityFunctionalTheory_buildFinalGrid()
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- call Matrix_constructor(dftEnergyMatrix, int(numberOfSpecies,8), &
- int(numberOfSpecies,8), 0.0_8 )
- do speciesID=1, numberOfSpecies
- call Matrix_constructor(exchangeCorrelationMatrices(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8)
- end do
- call DensityFunctionalTheory_finalDFT(this%mergedDensityMatrix(state,1:numberOfSpecies), &
- exchangeCorrelationMatrices, &
- dftEnergyMatrix, &
- particlesInGrid)
-
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- do otherSpeciesID = speciesID, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
- " DFT Corr. energy = ", dftEnergyMatrix%values(speciesID,otherSpeciesID)
- end do
- end do
- end do
- end if
-
- close(densUnit)
-
- deallocate(inverseOverlapMatrix)
-
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging density matrices : ", omp_get_wtime() - timeA ," (s)"
-
- return
-
- ! allocate(kineticMatrix(numberOfSpecies),&
- ! attractionMatrix(numberOfSpecies),&
- ! externalPotMatrix(numberOfSpecies))
- ! do speciesID = 1, numberOfSpecies
- ! call DirectIntegralManager_getKineticIntegrals(molecularSystem_instance,speciesID,kineticMatrix(speciesID))
- ! if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then
- ! kineticMatrix(speciesID)%values = &
- ! kineticMatrix(speciesID)%values * &
- ! ( 1.0_8/MolecularSystem_getMass( speciesID ) -1.0_8 / MolecularSystem_getTotalMass() )
- ! else
- ! kineticMatrix(speciesID)%values = &
- ! kineticMatrix(speciesID)%values / &
- ! MolecularSystem_getMass( speciesID )
- ! end if
-
- ! call DirectIntegralManager_getAttractionIntegrals(molecularSystem_instance,speciesID,attractionMatrix(speciesID))
- ! attractionMatrix(speciesID)%values=attractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID))
-
- ! if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- ! call DirectIntegralManager_getExternalPotentialIntegrals(molecularSystem_instance,speciesID,externalPotMatrix(speciesID))
- ! end do
- ! write(*,*) ""
- ! write(*,*) "=========================================================="
- ! write(*,*) " ONE BODY ENERGY CONTRIBUTIONS OF THE SUPERPOSED SYSTEMS: "
- ! write(*,*) ""
- ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- ! write(*,*) " STATE: ", state
- ! do speciesID=1, numberOfSpecies
- ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- ! " Kinetic energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*kineticMatrix(speciesID)%values)
- ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- ! "/Fixed interact. energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*attractionMatrix(speciesID)%values)
- ! if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) &
- ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name) // &
- ! " Ext Pot energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*externalPotMatrix(speciesID)%values)
- ! print *, ""
- ! end do
- ! print *, ""
- ! end do
- ! deallocate(kineticMatrix,&
- ! attractionMatrix,&
- ! externalPotMatrix)
-
- end subroutine NonOrthogonalCI_buildDensityMatrix
-
- !>
- !! @brief Generates the NOCI natural orbitals from the NOCI density matrix in the superposed molecular system
- !!
- !! @param this
- !<
- subroutine NonOrthogonalCI_getNaturalOrbitals(this)
- implicit none
- type(NonOrthogonalCI) :: this
-
- type(Matrix) :: auxMatrix, densityEigenVectors, auxdensityEigenVectors
- type(Vector) :: auxVector, densityEigenValues, auxdensityEigenValues
-
- integer :: state
- integer :: i,j,k,speciesID
- integer :: numberOfSpecies
-
- integer :: densUnit
- character(100) :: densFile
- character(50) :: arguments(2), auxString
- real(8) :: timeA
-
- !$ timeA = omp_get_wtime()
- if(.not. CONTROL_instance%CI_NATURAL_ORBITALS) return
- if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
-
- numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
-
- write(*,*) ""
- write(*,*) "============================================="
- write(*,*) " NATURAL ORBITALS OF THE SUPERPOSED SYSTEMS: "
- write(*,*) ""
- !! Open file - to write density matrices
- densUnit = 29
-
- densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- open(unit = densUnit, file=trim(densFile), status="old", form="formatted", position="append")
-
- do state=1, CONTROL_instance%CI_STATES_TO_PRINT
-
- write(*,*) " STATE: ", state
-
- do speciesID=1, numberOfSpecies
-
- write(*,*) ""
- write(*,*) " Natural Orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name )
- write(*,*) "--------------------------------------------------------------"
-
- call Vector_constructor ( densityEigenValues, &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 )
- call Matrix_constructor ( densityEigenVectors, &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 )
-
- call Vector_constructor ( auxdensityEigenValues, &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 )
- call Matrix_constructor ( auxdensityEigenVectors, &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), &
- int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 )
-
- !! Lowdin orthogonalization of the density matrix
- auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), 0.5_8, method="SVD" )
-
- auxMatrix%values=matmul(matmul(auxMatrix%values,this%mergedDensityMatrix(state,speciesID)%values),auxMatrix%values)
-
- ! print *, "Diagonalizing non orthogonal CI density Matrix..."
-
- !! Calcula valores y vectores propios de matriz de densidad CI ortogonal.
- call Matrix_eigen(auxMatrix , auxdensityEigenValues, auxdensityEigenVectors, SYMMETRIC )
-
- !! Transform back to the atomic basis
- auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), -0.5_8, method="SVD" )
-
- auxdensityEigenVectors%values=matmul(auxMatrix%values,auxdensityEigenVectors%values)
-
- ! reorder and count significant occupations
- k=0
- do i = 1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- densityEigenValues%values(i) = auxdensityEigenValues%values(MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1)
- densityEigenVectors%values(:,i) = auxdensityEigenVectors%values(:,MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1)
- if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) k=k+1
- end do
- if(k .eq. 0) k=1
- ! Print eigenvectors with occupation larger than 0.01
- call Vector_constructor(auxVector,k,0.0_8)
- call Matrix_constructor(auxMatrix,int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),int(k,8),0.0_8)
- k=0
- do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) then
- k=k+1
- auxVector%values(k)=densityEigenValues%values(i)
- do j=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- auxMatrix%values(j,k)=densityEigenVectors%values(j,i)
- end do
- end if
- end do
- !densityEigenVectors
- call Matrix_show( auxMatrix , &
- rowkeys = MolecularSystem_getlabelsofcontractions( speciesID ), &
- columnkeys = string_convertvectorofrealstostring( auxVector ),&
- flags=WITH_BOTH_KEYS)
-
- write(*,"(A10,A10,A20,I5,A15,F17.12)") "number of ", trim(MolecularSystem_getNameOfSpecie( speciesID )) ," particles in state", state , &
- " density matrix: ", sum( transpose(this%mergedDensityMatrix(state,speciesID)%values)*this%mergedOverlapMatrix(speciesID)%values)
- write(*,"(A10,A10,A40,F17.12)") "sum of ", trim(MolecularSystem_getNameOfSpecie( speciesID )) , "natural orbital occupations", sum(densityEigenValues%values)
-
- ! density matrix check
- ! auxMatrix%values=0.0
- ! do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! do k=1, MolecularSystem_getTotalNumberOfContractions(speciesID)
- ! auxMatrix%values(mu,nu)=auxMatrix%values(mu,nu)+densityEigenValues%values(k)*&
- ! densityEigenVectors%values(mu,k)*densityEigenVectors%values(nu,k)
- ! end do
- ! end do
- ! end do
- ! print *, "atomicDensityMatrix again"
- ! call Matrix_show(auxMatrix)
-
- write(auxString,*) state
-
- arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name )
- arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring))
-
- call Matrix_writeToFile ( densityEigenVectors, densUnit , arguments=arguments(1:2) )
-
- arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name )
- arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring))
-
- call Vector_writeToFile( densityEigenValues, densUnit, arguments=arguments(1:2) )
-
- write(*,*) " End of natural orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name )
- end do
- end do
-
- write(*,*) ""
- write(*,*) " END OF NATURAL ORBITALS"
- write(*,*) "=============================="
- write(*,*) ""
-
- close(densUnit)
-
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI natural orbitals : ", omp_get_wtime() - timeA ," (s)"
-
- return
-
- end subroutine NonOrthogonalCI_getNaturalOrbitals
-
- !>
- !! @brief Calculate and Transform the four center integrals in one sweep without writing anything to disk
- !!
- !! @param molecularSystem, HFCoefficients: species array with the atomic coefficients, fourCenterIntegrals: species*species array to save integrals
- !<
- subroutine NonOrthogonalCI_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance)
- implicit none
- type(MolecularSystem), intent(in) :: mergedMolecularSystem
- type(Matrix), intent(in) :: mergedCoefficients(mergedMolecularSystem%numberOfQuantumSpecies)
- type(iMatrix), intent(in) :: twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies)
- type(iMatrix), intent(in) :: fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies)
- type(Matrix), intent(out) :: fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies)
- type(Libint2Interface) :: Libint2LocalInstance(mergedMolecularSystem%numberOfQuantumSpecies)
-
- real(8), allocatable, target :: ints(:,:,:,:)
- real(8), allocatable :: tempA(:,:,:)
- real(8), allocatable :: tempB(:,:)
- real(8), allocatable :: tempC(:)
-
- integer :: p, p_l, p_u
- integer :: q, q_l, q_u
- integer :: r, r_l, r_u
- integer :: s, s_l, s_u
- integer :: ssize, ssizeb, auxIndex, auxIndexA
- integer :: n,u, mu,nu, lambda,sigma
- real(8) :: auxTransformedTwoParticlesIntegral
-
- type(Matrix) :: densityMatrix
- integer :: speciesID, otherSpeciesID
- integer :: numberOfOrbitals, otherNumberOfOrbitals
- integer(8) :: numberOfIntegrals
-
- do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies
- numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), &
- MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ))
- numberOfIntegrals= int( ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8 ) / 4.0_8 ) * &
- ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8) / 2.0_8 ) + 1.0_8) ), 8 )
-
- call Matrix_constructor( fourCenterIntegrals(speciesID,speciesID), numberOfIntegrals, 1_8, 0.0_8 )
-
- p_l = 1
- p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2
- q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1
- q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )
-
- r_l = 1
- r_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2
- s_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1
- s_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )
-
- ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
- call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later
-
- ! Prepare matrix
- if(allocated(ints)) deallocate(ints)
- if(allocated(tempA)) deallocate (tempA)
- if(allocated(tempB)) deallocate (tempB)
- if(allocated(tempC)) deallocate (tempC)
- allocate (ints ( ssize, ssize, ssize, ssize ), &
- tempA ( ssize, ssize, ssize ), &
- tempB ( ssize, ssize ), &
- tempC ( ssize ))
- ints = 0
-
- call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(&
- speciesID, &
- densityMatrix, &
- ints, mergedMolecularSystem, Libint2LocalInstance(speciesID) )
-
-
- do p = p_l, p_u
- tempA = 0
- n = p
-
- ! !First quarter transformation happens here
- do mu = 1, ssize
- !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
- tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* &
- ints(:,:,:,mu)
- end do
-
- do q = p, q_u
- u = q
- tempB = 0
-
- if ( q < q_l ) cycle
- !! second quarter
- do nu = 1, ssize
- !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
- tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* &
- tempA(:,:,nu)
- end do
-
- do r = n, r_u
-
- tempC = 0
-
- !Why??
- !if ( r < this%r_l ) cycle
-
- !! third quarter
- do lambda = 1, ssize
- !if ( abs(coefficientsOfAtomicOrbitals%values( lambda, r )) < 1E-10 ) cycle
- tempC(:) = tempC(:) + mergedCoefficients(speciesID)%values( lambda, r )* &
- tempB(:,lambda)
- end do
-
- do s = u, s_u
- auxTransformedTwoParticlesIntegral = 0
-
- if ( s < s_l ) cycle
- !! fourth quarter
- do sigma = 1, ssize
- auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + &
- mergedCoefficients(speciesID)%values( sigma, s )* &
- tempC(sigma)
-
- end do
- auxIndex = fourIndexArray(speciesID)%values(twoIndexArray(speciesID)%values(p,q), twoIndexArray(speciesID)%values(r,s) )
- fourCenterIntegrals(speciesID,speciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral
- ! print *, speciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral
- end do
- u = r + 1
- end do
- end do
- end do
- end do
-
- do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies-1
- do otherSpeciesID=speciesID+1, mergedMolecularSystem%numberOfQuantumSpecies
-
- numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), &
- MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem))
- otherNumberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem), &
- MolecularSystem_getOcupationNumber(otherSpeciesID,mergedMolecularSystem))
-
- numberOfIntegrals = int((numberOfOrbitals*((numberOfOrbitals+1.0_8)/2.0_8)) * &
- (otherNumberOfOrbitals*(otherNumberOfOrbitals+1.0_8)/2.0_8),8)
-
- call Matrix_constructor( fourCenterIntegrals(speciesID,otherSpeciesID), numberOfIntegrals, 1_8, 0.0_8 )
-
- ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)
- ssizeb = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem)
-
- call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later
-
- p_l = 1
- p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2
- q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1
- q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )
-
- r_l = 1
- r_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2
- s_l = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2+1
- s_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )
-
- ! Prepare matrix
- ! Prepare matrix
- if(allocated(ints)) deallocate(ints)
- if(allocated(tempA)) deallocate (tempA)
- if(allocated(tempB)) deallocate (tempB)
- if(allocated(tempC)) deallocate (tempC)
- allocate (ints ( ssizeb, ssizeb, ssize, ssize ), &
- tempA ( ssizeb, ssizeb, ssize ), &
- tempB ( ssizeb, ssizeb ), &
- tempC ( ssizeb ))
- ints = 0
-
- call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(&
- speciesID, otherSpeciesID, &
- densityMatrix, &
- ints, mergedMolecularSystem, Libint2LocalInstance(speciesID), Libint2LocalInstance(otherSpeciesID) )
-
- ! do mu = 1, ssize
- ! do nu = 1, ssize
- ! do lambda = 1, ssizeb
- ! do sigma = 1, ssizeb
- ! print *, mu, nu, lambda, sigma, ints(lambda,sigma,nu,mu)
- ! end do
- ! end do
- ! end do
- ! end do
- do p = p_l, p_u
- tempA = 0
- !First quarter transformation happens here
- do mu = 1, ssize
- !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
- tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* &
- ints(:,:,:,mu)
- end do
-
- do q = q_l, q_u
- tempB = 0
-
- ! if ( q < p ) cycle
- !! second quarter
- do nu = 1, ssize
- !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle
-
- tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* &
- tempA(:,:,nu)
- end do
-
- auxIndexA = (otherNumberOfOrbitals*(otherNumberOfOrbitals+1))/2 * (twoIndexArray(speciesID)%values(p,q) - 1 )
-
- do r = r_l , r_u
-
- tempC = 0
-
- !! third quarter
- do lambda = 1, ssizeb
-
- tempC(:) = tempC(:) + mergedCoefficients(otherSpeciesID)%values( lambda, r )* &
- tempB(:,lambda)
-
- end do
- do s = s_l, s_u
- auxTransformedTwoParticlesIntegral = 0
-
- ! if ( s < r ) cycle
- !! fourth quarter
- do sigma = 1, ssizeb
- auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + &
- mergedCoefficients(otherSpeciesID)%values( sigma, s )* &
- tempC(sigma)
-
- end do
-
- auxIndex = auxIndexA + twoIndexArray(otherSpeciesID)%values(r,s)
-
- fourCenterIntegrals(speciesID,otherSpeciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral
-
- ! print *, speciesID,otherSpeciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral
-
- end do
- end do
- end do
- end do
-
- end do
- end do
-
- ! call DirectIntegralManager_destructor(Libint2LocalInstance)
-
- end subroutine NonOrthogonalCI_transformIntegralsMemory
-
-
- !>
- !! @brief Save NOCI results to file
- !!
- !! @param
- !<
- subroutine NonOrthogonalCI_saveToFile(this)
- type(NonOrthogonalCI) :: this
- integer :: nociUnit, speciesID, numberOfSpecies, sysI
- character(100) :: prefix, nociFile
- character(50) :: arguments(2), auxString
-
- !Save merged molecular system
- call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem)
-
- prefix=trim(CONTROL_instance%INPUT_FILE)//"NOCI"
- call MolecularSystem_saveToFile(prefix)
-
- numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
-
- nociUnit=123
- nociFile=trim(prefix)//".states"
- open(unit = nociUnit, file=trim(nociFile), status="replace", form="unformatted")
-
- arguments(1:1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS"
- call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=this%numberOfDisplacedSystems, arguments=arguments(1:1) )
-
- arguments(1:1) = "NOCI-NUMBEROFSPECIES"
- call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) )
-
- arguments(1:1) = "NOCI-CONFIGURATIONCOEFFICIENTS"
- call Matrix_writeToFile ( this%configurationCoefficients, nociUnit , binary=.true., arguments=arguments(1:1) )
-
- arguments(1:1) = "NOCI-CONFIGURATIONENERGIES"
- call Vector_writeToFile ( this%statesEigenvalues, nociUnit , binary=.true., arguments=arguments(1:1) )
-
- arguments(1) = "MERGEDCOEFFICIENTS"
- do speciesID=1, numberOfSpecies
- arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
- call Matrix_writeToFile ( this%mergedCoefficients(speciesID), nociUnit, binary=.true. , arguments=arguments(1:2) )
- end do
-
- do sysI=1, this%numberOfDisplacedSystems
- do speciesID=1, numberOfSpecies
- write(auxString,*) sysI
- arguments(1) = "SYSBASISLIST"//trim(auxString)
- arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
- call Vector_writeToFileInteger(this%sysBasisList(sysI,speciesID), nociUnit, binary=.true., arguments=arguments(1:2) )
- end do
- end do
-
- ! do state=1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems)
- ! end do
-
- ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT
- ! write(auxString,*) state
- ! call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) )
- ! end do
- ! end do
-
- close(nociUnit)
-
- end subroutine NonOrthogonalCI_saveToFile
-
- !>
- !! @brief Compute Franck-Condon factors from the current NOCI calculations and previous results read from file
- !!
- !! @param
- !<
- subroutine NonOrthogonalCI_computeFranckCondon(this)
- type(NonOrthogonalCI) :: this
- integer :: nociUnit, numberOfSpecies, occupationNumber,numberOfDisplacedSystems, numberOfContractions, dim2
- character(100) :: nociFile
- type(Matrix) :: ciCoefficients
- type(Vector) :: ciEnergies
- type(Matrix), allocatable :: auxCoefficients(:), superMergedCoefficients(:)
- type(IVector), allocatable :: sysListCur(:,:), sysListRef(:,:), orbListI(:), orbListII(:)
- type(IVector) :: auxIVector
- type(MolecularSystem) :: superMergedMolecularSystem
- logical :: existFile
- type(Matrix) :: molecularOverlapMatrix
- type(Matrix), allocatable :: superOverlapMatrix(:), superMomentMatrix(:,:), inverseOverlapMatrix(:), molecularMomentMatrix(:,:) !,attractionMatrix(:), externalPotMatrix(:)
- integer :: stateI, stateII
- integer :: i,ii,j,jj,k,mu,nu,mumu,nunu,sysI, sysII, speciesID, otherSpeciesID
- integer :: particlesPerOrbital
- real(8) :: overlapDeterminant, trololo, trolololo(3), pointchargesdipole(3)
-
- integer :: densUnit
- character(100) :: densFile
- character(50) :: arguments(2), auxString
- type(Matrix), allocatable :: franckCondonMatrix(:), transitionDipoleMatrix(:,:), refCurOverlapMatrix(:), refCurMomentMatrix(:,:)
- type(Matrix) :: refCurTotalOverlap
- real(8) :: timeA
-
- !$ timeA = omp_get_wtime()
-
- existFile=.false.
-
- nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI"
- inquire( FILE = trim(nociFile)//".sys", EXIST = existFile )
-
- if(.not. existFile) return
- print *, "Found a reference molecular system for NOCI calculations ", trim(nociFile)//".sys"
-
- pointchargesdipole=0.0
- do i=1, size( MolecularSystem_instance%pointCharges )
- pointchargesdipole = pointchargesdipole + MolecularSystem_instance%pointCharges(i)%origin(:) * MolecularSystem_instance%pointCharges(i)%charge
- end do
-
-
- call MolecularSystem_loadFromFile("LOWDIN.SYS",nociFile)
- call MolecularSystem_showInformation()
- call MolecularSystem_showParticlesInformation()
- call MolecularSystem_showCartesianMatrix()
-
- nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI.states"
- inquire( FILE = trim(nociFile), EXIST = existFile )
-
- if(.not. existFile) then
- print *, "Did not find reference states for NOCI calculations ", nociFile
- return
- end if
- print *, "Found reference states for NOCI calculations ", nociFile
- print *, "Computing the Franck-Condon factors with respect to that system"
-
- nociUnit=123
- open(unit = nociUnit, file=trim(nociFile), status="old", form="unformatted")
-
- arguments(1) = "NOCI-NUMBEROFSPECIES"
- call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) )
-
- arguments(1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS"
- call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfDisplacedSystems, arguments=arguments(1:1) )
-
- allocate(auxCoefficients(numberOfSpecies))
- allocate(sysListCur(numberOfDisplacedSystems,numberOfSpecies),sysListRef(numberOfDisplacedSystems,numberOfSpecies))
- allocate(orbListI(numberOfDisplacedSystems),orbListII(numberOfDisplacedSystems))
- allocate(superMergedCoefficients(numberOfSpecies))
- allocate(superOverlapMatrix(numberOfSpecies), superMomentMatrix(numberOfSpecies,3),inverseOverlapMatrix(numberOfSpecies),molecularMomentMatrix(numberOfSpecies,3))
- allocate(franckCondonMatrix(numberOfSpecies),transitionDipoleMatrix(numberOfSpecies+1,3),refCurOverlapMatrix(numberOfSpecies),refCurMomentMatrix(numberOfSpecies,3))
-
- arguments(1) = "NOCI-CONFIGURATIONCOEFFICIENTS"
- ciCoefficients = Matrix_getFromFile(numberOfDisplacedSystems,numberOfDisplacedSystems,nociUnit,binary=.true.,arguments=arguments(1:1) )
-
- arguments(1:1) = "NOCI-CONFIGURATIONENERGIES"
- call Vector_getFromFile(numberOfDisplacedSystems, nociUnit, output=ciEnergies, binary=.true., arguments=arguments(1:1) )
-
- arguments(1) = "MERGEDCOEFFICIENTS"
- do speciesID=1, numberOfSpecies
- numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID)
- dim2=max(MolecularSystem_getTotalNumberOfContractions(speciesID),MolecularSystem_getOcupationNumber(speciesID))
- arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
- auxCoefficients(speciesID) = Matrix_getFromFile(numberOfContractions,dim2,nociUnit,binary=.true.,arguments=arguments(1:2) )
- end do
-
- do sysI=1, numberOfDisplacedSystems
- do speciesID=1, numberOfSpecies
- numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID)
- write(auxString,*) sysI
- arguments(1) = "SYSBASISLIST"//trim(auxString)
- arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name)
- call Vector_getFromFileInteger(numberOfContractions, nociUnit, output=sysListRef(sysI,speciesID), binary=.true., arguments=arguments(1:2) )
- end do
- end do
-
- close(nociUnit)
-
- !Create a super-mega molecular system
- !Merge coefficients from NOCI calculation and reference system
-
- print *, "super-mega molecular system"
- call MolecularSystem_mergeTwoSystems(superMergedMolecularSystem, this%mergedMolecularSystem, MolecularSystem_instance, &
- orbListI(:),orbListII(:), reorder=.false.)
- call MolecularSystem_showInformation(superMergedMolecularSystem)
- call MolecularSystem_showParticlesInformation(superMergedMolecularSystem)
- call MolecularSystem_showCartesianMatrix(superMergedMolecularSystem)
-
- call NonOrthogonalCI_mergeCoefficients(this%mergedCoefficients(:),auxCoefficients(:),&
- this%mergedMolecularSystem,MolecularSystem_instance,superMergedMolecularSystem,&
- orbListI(:),orbListII(:),superMergedCoefficients(:))
-
- ! do speciesID=1, numberOfSpecies
- ! print *, "superMergedCoefficients", speciesID
- ! call Matrix_show(superMergedCoefficients(speciesID))
- ! end do
-
- !Fix basis list size
- do speciesID=1, numberOfSpecies
- ! print *, "orbListI", "speciesID", speciesID
- ! call Vector_showInteger(orbListI(speciesID))
- do sysI=1, this%numberOfDisplacedSystems
- call Vector_copyConstructorInteger(auxIVector,this%sysBasisList(sysI,speciesID))
- call Vector_constructorInteger(sysListCur(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0)
- do i=1, size(auxIVector%values)
- if(orbListI(speciesID)%values(i) .eq. 0) cycle
- sysListCur(sysI,speciesID)%values(i)=auxIVector%values(orbListI(speciesID)%values(i))
- end do
- ! print *, "sysListCur", "sysI", sysI, "speciesID", speciesID
- ! call Vector_showInteger(sysListCur(sysI,speciesID))
- end do
- end do
-
- do speciesID=1, numberOfSpecies
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems
- ! print *, "orbListII", "speciesID", speciesID
- ! call Vector_showInteger(orbListII(speciesID))
- do sysII=1, numberOfDisplacedSystems
- call Vector_copyConstructorInteger(auxIVector,sysListRef(sysII,speciesID))
- call Vector_constructorInteger(sysListRef(sysII,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0)
- do i=1, size(orbListII(speciesID)%values)
- if(orbListII(speciesID)%values(i) .eq. 0) cycle
- sysListRef(sysII,speciesID)%values(i)=auxIVector%values(orbListII(speciesID)%values(i))
- end do
- ! print *, "sysListRef", "sysII", sysII, "speciesID", speciesID
- ! call Vector_showInteger(sysListRef(sysII,speciesID))
- end do
- end do
-
- ! if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return
-
- ! numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies
-
-
- print *, ""
- print *, "Computing overlap and moment integrals for the super-mega system..."
- print *, ""
- do speciesID = 1, numberOfSpecies
- call DirectIntegralManager_getOverlapIntegrals(superMergedMolecularSystem,speciesID,superOverlapMatrix(speciesID))
- call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,1,superMomentMatrix(speciesID,1))
- call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,2,superMomentMatrix(speciesID,2))
- call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,3,superMomentMatrix(speciesID,3))
- end do
- !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)"
- !$ timeA = omp_get_wtime()
-
- print *, ""
- print *, "Self overlap matrices for the supermegaposed systems..."
- print *, ""
-
- do speciesID=1, numberOfSpecies
- call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), &
- int(numberOfDisplacedSystems,8), 1.0_8)
- end do
- !!Fill the merged density matrix
- !!"Non Diagonal" terms - system pairs
- do sysI=1, numberOfDisplacedSystems !computed
- do sysII=1, numberOfDisplacedSystems !reference
- ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle
- !!Compute molecular overlap matrix and its inverse
- do speciesID=1, numberOfSpecies
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems
- particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
- call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
- ! call Matrix_constructor(inverseOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
-
- do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI
- if(sysListRef(sysI,speciesID)%values(mu) .eq. 0) cycle
- do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII
- if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle
- do i = 1 , occupationNumber
- ii=occupationNumber*(sysI-1)+i+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2
- do j = 1 , occupationNumber
- jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2
- ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),&
- ! superMergedCoefficients(speciesID)%values(nu,jj),&
- ! superOverlapMatrix(speciesID)%values(mu,nu)
- molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+&
- superMergedCoefficients(speciesID)%values(mu,ii)*&
- superMergedCoefficients(speciesID)%values(nu,jj)*&
- superOverlapMatrix(speciesID)%values(mu,nu)
- end do
- end do
- end do
- end do
- if(occupationNumber .ne. 0) then
- ! inverseOverlapMatrix=Matrix_inverse(molecularOverlapMatrix)
- ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII
- ! call Matrix_show(inverseOverlapMatrices(speciesID))
- call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU")
- ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant
- else
- overlapDeterminant=1.0
- end if
- refCurOverlapMatrix(speciesID)%values(sysI,sysII)=refCurOverlapMatrix(speciesID)%values(sysI,sysII)*overlapDeterminant**particlesPerOrbital
- end do
-
- end do
- end do
-
- do speciesID=1, numberOfSpecies
- print *, "Reference Overlap Matrix for", speciesID
- call Matrix_show(refCurOverlapMatrix(speciesID))
- end do
-
- print *, ""
- print *, "Building Franck-Condon matrices for the superposed systems..."
- print *, ""
-
- do speciesID=1, numberOfSpecies
- call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), &
- int(numberOfDisplacedSystems,8), 1.0_8)
- do k=1,3
- call Matrix_constructor(refCurMomentMatrix(speciesID,k), int(this%numberOfDisplacedSystems,8), &
- int(numberOfDisplacedSystems,8), 0.0_8)
- end do
- end do
- call Matrix_constructor(refCurTotalOverlap, int(this%numberOfDisplacedSystems,8), &
- int(numberOfDisplacedSystems,8), 1.0_8)
-
- !!Fill the merged density matrix
- !!"Non Diagonal" terms - system pairs
- do sysI=1, this%numberOfDisplacedSystems !computed
- do sysII=1, numberOfDisplacedSystems !reference
- ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle
- !!Compute molecular overlap matrix and its inverse
- do speciesID=1, numberOfSpecies
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems
- particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
- call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
- do k=1,3
- call Matrix_constructor(molecularMomentMatrix(speciesID,k), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 )
- end do
-
- do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI
- if(sysListCur(sysI,speciesID)%values(mu) .eq. 0) cycle
- do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII
- if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle
- do i = 1 , occupationNumber
- ii=occupationNumber*(sysI-1)+i
- do j = 1 , occupationNumber
- jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2
- ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),&
- ! superMergedCoefficients(speciesID)%values(nu,jj),&
- ! superOverlapMatrix(speciesID)%values(mu,nu)
- molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+&
- superMergedCoefficients(speciesID)%values(mu,ii)*&
- superMergedCoefficients(speciesID)%values(nu,jj)*&
- superOverlapMatrix(speciesID)%values(mu,nu)
- do k=1,3
- molecularMomentMatrix(speciesID,k)%values(i,j)=molecularMomentMatrix(speciesID,k)%values(i,j)+&
- superMergedCoefficients(speciesID)%values(mu,ii)*&
- superMergedCoefficients(speciesID)%values(nu,jj)*&
- superMomentMatrix(speciesID,k)%values(mu,nu)
- end do
- end do
- end do
- end do
- end do
- if(occupationNumber .ne. 0) then
- inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix)
- ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII
- ! call Matrix_show(inverseOverlapMatrices(speciesID))
- call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU")
- ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant
- refCurOverlapMatrix(speciesID)%values(sysI,sysII)=overlapDeterminant**particlesPerOrbital
- else
- overlapDeterminant=1.0
- end if
- refCurTotalOverlap%values(sysI,sysII)=refCurTotalOverlap%values(sysI,sysII)*refCurOverlapMatrix(speciesID)%values(sysI,sysII)
- end do
-
- do speciesID=1, numberOfSpecies
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems
- particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI))
- do i = 1 , occupationNumber
- do j = 1 , occupationNumber
- do k=1,3
- refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)+&
- molecularMomentMatrix(speciesID,k)%values(i,j)*&
- inverseOverlapMatrix(speciesID)%values(j,i)
- end do
- end do
- end do
- do k=1,3
- refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)*refCurTotalOverlap%values(sysI,sysII)*particlesPerOrbital
- end do
- end do
- end do
- end do
-
- do speciesID=1, numberOfSpecies
- print *, "refCurOverlapMatrix(speciesID)", speciesID
- call Matrix_show(refCurOverlapMatrix(speciesID))
- call Matrix_constructor(franckCondonMatrix(speciesID), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8)
- end do
-
- !+1 For point charges
- do speciesID=1, numberOfSpecies+1
- do k=1,3
- call Matrix_constructor(transitionDipoleMatrix(speciesID,k), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8)
- end do
- end do
-
- do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT
- print *, "Reference state:", stateII
- do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT
- print *, " current state:", stateI
- do speciesID=1, numberOfSpecies
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems
- print *, "occupationNumber", occupationNumber
- particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(1))
- trololo=0
- do sysI=1, this%numberOfDisplacedSystems !computed
- do sysII=1, numberOfDisplacedSystems !reference
- do i = 1 , occupationNumber
- do j = 1 , occupationNumber
- trololo = trololo + &
- inverseOverlapMatrix(speciesID)%values(j,i)*&
- this%configurationCoefficients%values(sysI,stateI)*&
- ciCoefficients%values(sysII,stateII)*& !!reference
- refCurOverlapMatrix(speciesID)%values(sysI,sysII)*&
- particlesPerOrbital
- end do
- end do
- ! refCurTotalOverlap%values(sysI,sysII)*&
- ! franckCondonMatrix(speciesID)%values(stateI,stateII)+&
-
- do k=1,3
- transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) = transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) + &
- molecularsystem_getcharge( speciesID )*&
- this%configurationCoefficients%values(sysI,stateI)*&
- ciCoefficients%values(sysII,stateII)*& !!reference
- refCurMomentMatrix(speciesID,k)%values(sysI,sysII)
- end do
-
- end do
- end do
- print *, "speciesID", speciesID, "trololo", trololo
- franckCondonMatrix(speciesID)%values(stateI,stateII)=trololo
- franckCondonMatrix(speciesID)%values(stateI,stateII)=franckCondonMatrix(speciesID)%values(stateI,stateII)/(occupationNumber*particlesPerOrbital)
- print *, " F.C. factor for ", molecularSystem_getNameOfSpecies(speciesID),&
- franckCondonMatrix(speciesID)%values(stateI,stateII)
- end do
- do sysI=1, this%numberOfDisplacedSystems !computed
- do sysII=1, numberOfDisplacedSystems !reference
- do k=1,3
- transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) = transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) + &
- pointchargesdipole(k)*&
- this%configurationCoefficients%values(sysI,stateI)*&
- ciCoefficients%values(sysII,stateII)*& !!reference
- refCurTotalOverlap%values(sysI,sysII)
- end do
- end do
- end do
- ! trololo=1
- ! do speciesID=1, numberOfSpecies
- ! trololo=trololo*franckCondonMatrix(speciesID)%values(stateI,stateII)
- ! end do
- ! print *, " F.C. factor product ", trololo
- ! trololo=0
- ! do speciesID=1, numberOfSpecies
- ! trololo=trololo+franckCondonMatrix(speciesID)%values(stateI,stateII)
- ! end do
- ! print *, " F.C. factor sum ", trololo
- ! trololo=0
- ! do sysI=1, this%numberOfDisplacedSystems !computed
- ! do sysII=1, numberOfDisplacedSystems !reference
- ! trololo = trololo + &
- ! this%configurationCoefficients%values(sysI,stateI)*&
- ! ciCoefficients%values(sysII,stateII)*& !!reference
- ! refCurTotalOverlap%values(sysI,sysII)
- ! end do
- ! end do
- ! print *, " total overlap ", trololo
- end do
- end do
-
- print *, "Dipole approximation spectrum"
- do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT
- print *, "Reference state:", stateII
- do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT
- trolololo=0
- print *, "current state:", stateI
- do speciesID=1, numberOfSpecies
- do k=1,3
- trolololo(k)=trolololo(k)+transitionDipoleMatrix(speciesID,k)%values(stateI,stateII)
- end do
- print *, " T.D. integrals for ", molecularSystem_getNameOfSpecies(speciesID),&
- transitionDipoleMatrix(speciesID,1)%values(stateI,stateII),&
- transitionDipoleMatrix(speciesID,2)%values(stateI,stateII),&
- transitionDipoleMatrix(speciesID,3)%values(stateI,stateII)
- end do
- do k=1,3
- trolololo(k)=trolololo(k)+transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII)
- end do
- print *, " T.D. integrals point charges ", &
- transitionDipoleMatrix(numberOfSpecies+1,1)%values(stateI,stateII),&
- transitionDipoleMatrix(numberOfSpecies+1,2)%values(stateI,stateII),&
- transitionDipoleMatrix(numberOfSpecies+1,3)%values(stateI,stateII)
- print *, "energy dif", ciEnergies%values(stateII)-this%statesEigenvalues%values(stateI), "total components", trolololo(1:3) ,"intensity", sqrt(sum(trolololo(1:3)**2))
- end do
- end do
-
- close(densUnit)
-
- deallocate(auxCoefficients,&
- sysListCur,sysListRef,&
- orbListI,orbListII,&
- superMergedCoefficients,&
- superOverlapMatrix,&
- franckCondonMatrix)
-
- end subroutine NonOrthogonalCI_computeFranckCondon
-
-
-end module NonOrthogonalCI_
-
diff --git a/src/PT/PropagatorTheory.f90 b/src/PT/PropagatorTheory.f90
index f7616aa8..34eb7dad 100644
--- a/src/PT/PropagatorTheory.f90
+++ b/src/PT/PropagatorTheory.f90
@@ -294,7 +294,7 @@ subroutine PropagatorTheory_show()
n=size(PropagatorTheory_instance%secondOrderCorrections(i)%values,DIM=1)
- nameOfSpecies=trim(MolecularSystem_getNameOfSpecie( q ))
+ nameOfSpecies=trim(MolecularSystem_getNameOfSpecies( q ))
write (6,"(T10,A8,A10)") "SPECIES: ",nameOfSpecies
@@ -404,7 +404,7 @@ subroutine PropagatorTheory_show()
! i = i + 1
!
! n=size(PropagatorTheory_instance%thirdOrderCorrections(i)%values,DIM=1)
-! write (6,"(T10,A8,A10)")"SPECIE: ",trim(MolecularSystem_getNameOfSpecie( q ))
+! write (6,"(T10,A8,A10)")"SPECIE: ",trim(MolecularSystem_getNameOfSpecies( q ))
! write ( 6,'(T10,A85)') "--------------------------------------------------------------------------------------------"
! write ( 6,'(T10,A10,A10,A10,A10,A10,A10,A10,A10)') " Orbital "," KT (eV) "," EP2 (eV)"," P.S "," P3 (eV)"&
! ," P.S "," OVGF (eV)"," P.S "
@@ -590,7 +590,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
q = q + 1
- nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) )
+ nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) )
chargeOfSpeciesA = MolecularSystem_getCharge( i )
! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i )
occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i )
@@ -649,7 +649,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
! call TransformIntegrals_constructor( repulsionTransformer )
- arguments(2) = MolecularSystem_getNameOfSpecie(i)
+ arguments(2) = MolecularSystem_getNameOfSpecies(i)
arguments(1) = "ORBITALS"
@@ -662,7 +662,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
activeOrbitalsOfSpeciesB = MolecularSystem_getTotalNumberOfContractions( p )
if ( InputCI_Instance(p)%activeOrbitals /= 0 ) activeOrbitalsOfSpeciesB = InputCI_Instance(p)%activeOrbitals
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(p))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(p))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( p ), &
@@ -721,7 +721,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
activeOrbitalsOfSpeciesB = MolecularSystem_getTotalNumberOfContractions( j )
if ( InputCI_Instance(j)%activeOrbitals /= 0 ) activeOrbitalsOfSpeciesB = InputCI_Instance(j)%activeOrbitals
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(j))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(j))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), &
@@ -845,7 +845,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
else ! interspecies
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
chargeOfSpeciesB = MolecularSystem_getCharge( j )
! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -990,7 +990,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
do j = 1 , PropagatorTheory_instance%numberOfSpecies
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
E2hp = 0.0_8
E2ph= 0.0_8
@@ -1090,7 +1090,7 @@ subroutine PropagatorTheory_secondOrderCorrection()
do j = 1 , PropagatorTheory_instance%numberOfSpecies
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
E2hp = 0.0_8
E2ph= 0.0_8
@@ -1489,7 +1489,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
do p = 1 , PropagatorTheory_instance%numberOfSpecies
- nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( p ) )
+ nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( p ) )
if (nameOfSpeciesA=="E-ALPHA".or.nameOfSpeciesA=="E-BETA") then
@@ -1514,7 +1514,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
else
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( n ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( n ) )
!JC call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, &
! MolecularSystem_getEigenVectors(p), MolecularSystem_getEigenVectors(n), &
@@ -1540,7 +1540,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
q = q + 1
- nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) )
+ nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) )
chargeOfSpeciesA = MolecularSystem_getCharge( i )
!JC eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i )
occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i )
@@ -1549,7 +1549,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesA = MolecularSystem_getLambda( i )
virtualNumberOfSpeciesA = activeOrbitalsOfSpeciesA - occupationNumberOfSpeciesA
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(i))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(i))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( i ), &
@@ -1774,7 +1774,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
!JC print *,"entro al else"
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) )
chargeOfSpeciesB = MolecularSystem_getCharge( p )
!JC eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p )
occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p )
@@ -1783,7 +1783,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesB = MolecularSystem_getLambda( p )
virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(p))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(p))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( p ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -2191,7 +2191,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
!JC print *,"entro a r diferente de p"
- nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( r ) )
+ nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( r ) )
chargeOfSpeciesC = MolecularSystem_getCharge( r )
! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( r )
occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( r )
@@ -2200,7 +2200,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesC = MolecularSystem_getLambda( r )
virtualNumberOfSpeciesC = activeOrbitalsOfSpeciesC - occupationNumberOfSpeciesC
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(r))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(r))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( r ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -2646,7 +2646,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
else ! interspecies
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
chargeOfSpeciesB = MolecularSystem_getCharge( j )
! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -2655,7 +2655,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesB = MolecularSystem_getLambda( j )
virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(j))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(j))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -3061,7 +3061,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
else ! Interspecies term
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
chargeOfSpeciesB = MolecularSystem_getCharge( j )
! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -3070,7 +3070,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesB = MolecularSystem_getLambda( j )
virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(j))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(j))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -3501,7 +3501,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
id1=0
id2=0
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
chargeOfSpeciesB = MolecularSystem_getCharge( k )
! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -3510,7 +3510,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesB = MolecularSystem_getLambda( k )
virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(k))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(k))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( k ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -3756,7 +3756,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
else ! Interspecies term
- nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
chargeOfSpeciesB = MolecularSystem_getCharge( j )
! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -3765,7 +3765,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesB = MolecularSystem_getLambda( j )
virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(j))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(j))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -4130,7 +4130,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
! print *,"ENTRO AL TERMINO DE TRES PARTICULAS:",i,j,k
- nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) )
+ nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) )
chargeOfSpeciesC = MolecularSystem_getCharge( k )
! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k )
occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k )
@@ -4139,7 +4139,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5()
lambdaOfSpeciesC = MolecularSystem_getLambda( k )
virtualNumberOfSpeciesC = activeOrbitalsOfSpeciesC - occupationNumberOfSpeciesC
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(k))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(k))
arguments(1) = "ORBITALS"
call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( k ), &
unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
@@ -4870,7 +4870,7 @@ end module PropagatorTheory_
! do i = specie1ID , specie2ID
- ! nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) )
+ ! nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( i ) )
! specieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfSpecie )
! charge = MolecularSystem_getCharge( specieID )
@@ -5034,7 +5034,7 @@ end module PropagatorTheory_
! do j = 1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.i) then
- ! nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( j ) )
+ ! nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpecieID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie )
! eigenValuesOfOtherSpecie = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( j )
@@ -5300,7 +5300,7 @@ end module PropagatorTheory_
! speciesID = MolecularSystem_getSpecieID( nameOfSpecie=CONTROL_instance%IONIZE_SPECIES )
- ! nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) )
+ ! nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) )
! chargeOfSpecies = MolecularSystem_getCharge( speciesID )
@@ -5409,7 +5409,7 @@ end module PropagatorTheory_
! do j = 1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.speciesID) then
- ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) )
+ ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j )
@@ -5503,7 +5503,7 @@ end module PropagatorTheory_
! do j = 1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.speciesID) then
- ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) )
+ ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j )
@@ -5801,7 +5801,7 @@ end module PropagatorTheory_
! print *,"BEGINNING OF SECOND ORDER ELECTRON-NUCLEAR PROPAGATOR CALCULATIONS"
! speciesID = MolecularSystem_getSpecieID( nameOfSpecie=CONTROL_instance%IONIZE_SPECIES )
-! nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) )
+! nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) )
! chargeOfSpecies = MolecularSystem_getCharge( speciesID )
! eigenValuesOfSpecies = MolecularSystem_getEigenValues( speciesID )
! occupationNumberOfSpecies = MolecularSystem_getOcupationNumber( speciesID )
@@ -6034,7 +6034,7 @@ end module PropagatorTheory_
! do j = 1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.speciesID) then
-! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j )
@@ -6248,7 +6248,7 @@ end module PropagatorTheory_
! do j = 1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.speciesID) then
-! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j )
@@ -6391,7 +6391,7 @@ end module PropagatorTheory_
! do j = 1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.speciesID) then
-! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j )
@@ -6477,7 +6477,7 @@ end module PropagatorTheory_
! do i = 1 , PropagatorTheory_instance%numberOfSpecies - 1
! if (i.ne.speciesID) then
-! nameOfOtherSpecies1= trim( MolecularSystem_getNameOfSpecie( i ) )
+! nameOfOtherSpecies1= trim( MolecularSystem_getNameOfSpecies( i ) )
! otherSpeciesID1 =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies1 = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies1 = MolecularSystem_getOcupationNumber( i )
@@ -6495,7 +6495,7 @@ end module PropagatorTheory_
! do j = i+1 , PropagatorTheory_instance%numberOfSpecies
! if (j.ne.speciesID) then
-! nameOfOtherSpecies2= trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfOtherSpecies2= trim( MolecularSystem_getNameOfSpecies( j ) )
! otherSpeciesID2 =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies )
! eigenValuesOfOtherSpecies2 = MolecularSystem_getEigenValues(j)
! occupationNumberOfOtherSpecies2 = MolecularSystem_getOcupationNumber( j )
@@ -6972,7 +6972,7 @@ end module PropagatorTheory_
!
! q = q + 1
!
-! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) )
+! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) )
! chargeOfSpeciesA = MolecularSystem_getCharge( i )
!! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i )
! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i )
@@ -7017,7 +7017,7 @@ end module PropagatorTheory_
!
! else
!
-! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecies( p ) )
!
!! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, &
!! MolecularSystem_getEigenVectors(i), MolecularSystem_getEigenVectors(p), &
@@ -7136,7 +7136,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -7257,7 +7257,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -7303,7 +7303,7 @@ end module PropagatorTheory_
!
! else ! interspecies
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -7593,7 +7593,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -7778,7 +7778,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -7914,7 +7914,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -7975,7 +7975,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -8180,7 +8180,7 @@ end module PropagatorTheory_
!
! print *,"entro al manolito",k
!
-! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesC = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k )
@@ -8415,7 +8415,7 @@ end module PropagatorTheory_
!
! q = q + 1
!
-! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) )
+! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) )
! chargeOfSpeciesA = MolecularSystem_getCharge( i )
!! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i )
! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i )
@@ -8461,7 +8461,7 @@ end module PropagatorTheory_
!
! else
!
-! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecies( p ) )
!
!! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, &
!! MolecularSystem_getEigenVectors(i), MolecularSystem_getEigenVectors(p), &
@@ -8595,7 +8595,7 @@ end module PropagatorTheory_
!
! else
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( p )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p )
@@ -8808,7 +8808,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -8927,7 +8927,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -8973,7 +8973,7 @@ end module PropagatorTheory_
!
! else ! interspecies
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -9447,7 +9447,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -9687,7 +9687,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -9841,7 +9841,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -9910,7 +9910,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -10163,7 +10163,7 @@ end module PropagatorTheory_
!
! print *,"entro al manolito",k
!
-! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesC = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k )
@@ -10565,7 +10565,7 @@ end module PropagatorTheory_
!
! do p = 1 , PropagatorTheory_instance%numberOfSpecies
!
-! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( p ) )
!
! do n = 1 , PropagatorTheory_instance%numberOfSpecies
!
@@ -10579,7 +10579,7 @@ end module PropagatorTheory_
!
! else
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( n ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( n ) )
!
!! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, &
!! MolecularSystem_getEigenVectors(p), MolecularSystem_getEigenVectors(n), &
@@ -10602,7 +10602,7 @@ end module PropagatorTheory_
!
! q = q + 1
!
-! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) )
+! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) )
! chargeOfSpeciesA = MolecularSystem_getCharge( i )
!! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i )
! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i )
@@ -10796,7 +10796,7 @@ end module PropagatorTheory_
!
! print *,"entro al else"
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( p )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p )
@@ -11070,7 +11070,7 @@ end module PropagatorTheory_
!
! print *,"entro a r diferente de p"
!
-! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( r ) )
+! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( r ) )
! chargeOfSpeciesC = MolecularSystem_getCharge( r )
!! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( r )
! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( r )
@@ -11295,7 +11295,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -11414,7 +11414,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -11460,7 +11460,7 @@ end module PropagatorTheory_
!
! else ! interspecies
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -11734,7 +11734,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -11957,7 +11957,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -12112,7 +12112,7 @@ end module PropagatorTheory_
!
! if (k .ne. i) then
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -12182,7 +12182,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -12412,7 +12412,7 @@ end module PropagatorTheory_
!
! print *,"entro al manolito",k
!
-! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesC = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k )
@@ -12747,7 +12747,7 @@ end module PropagatorTheory_
!
! do p = 1 , PropagatorTheory_instance%numberOfSpecies
!
-! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( p ) )
!
! if (nameOfSpeciesA=="e-ALPHA".or.nameOfSpeciesA=="e-BETA") then
!
@@ -12769,7 +12769,7 @@ end module PropagatorTheory_
!
! else
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( n ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( n ) )
!
!! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, &
!! MolecularSystem_getEigenVectors(p), MolecularSystem_getEigenVectors(n), &
@@ -12792,7 +12792,7 @@ end module PropagatorTheory_
!
! q = q + 1
!
-! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) )
+! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) )
! chargeOfSpeciesA = MolecularSystem_getCharge( i )
!! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i )
! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i )
@@ -12986,7 +12986,7 @@ end module PropagatorTheory_
!
! print *,"entro al else"
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( p )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p )
@@ -13331,7 +13331,7 @@ end module PropagatorTheory_
!
! print *,"entro a r diferente de p"
!
-! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( r ) )
+! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( r ) )
! chargeOfSpeciesC = MolecularSystem_getCharge( r )
!! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( r )
! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( r )
@@ -13711,7 +13711,7 @@ end module PropagatorTheory_
!
! else ! interspecies
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -14081,7 +14081,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -14444,7 +14444,7 @@ end module PropagatorTheory_
! id1=0
! id2=0
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k )
@@ -14678,7 +14678,7 @@ end module PropagatorTheory_
!
! else ! Interspecies term
!
-! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) )
+! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) )
! chargeOfSpeciesB = MolecularSystem_getCharge( j )
!! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j )
! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j )
@@ -14988,7 +14988,7 @@ end module PropagatorTheory_
!
! print *,"ENTRO AL TERMINO DE TRES PARTICULAS:",i,j,k
!
-! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) )
+! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) )
! chargeOfSpeciesC = MolecularSystem_getCharge( k )
!! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k )
! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k )
diff --git a/src/core/BasisSet.f90 b/src/core/BasisSet.f90
index 0c9d2c9a..4189e143 100644
--- a/src/core/BasisSet.f90
+++ b/src/core/BasisSet.f90
@@ -116,140 +116,140 @@ subroutine BasisSet_load(this, formatType, basisName, ParticleName, origin, unit
!! Open BasisSet file from library
inquire(file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%BASIS_SET_DATABASE)//trim(basisName), exist = existFile)
-
if(existFile) then
-
- !! Open File
open(unit=30, file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%BASIS_SET_DATABASE)//trim(basisName), status="old",form="formatted")
- rewind(30)
-
- found = .false.
-
- !! Open element and Find Element Basis set
- do while(found .eqv. .false.)
-
- read(30,*, iostat=status) token, symbol
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.")
-
- end if
-
- if (status == -1 ) then
-
- call BasisSet_exception(ERROR, "The basisSet: "//trim(this%name)//" for: "//trim(particleSelected)//" was not found!","BasisSet module at Load function.")
-
- end if
-
- if(trim(token(1:2)) == "O-") then
-
- if(trim(symbol) == trim(particleSelected)) then
-
- found = .true.
-
- end if
-
+ else
+ !! Open BasisSet file from directory
+ inquire(file=trim(basisName), exist = existFile)
+ if(existFile) then
+ open(unit=30, file=trim(basisName), status="old",form="formatted")
+ else
+ !! File not found
+ call BasisSet_exception(ERROR, "The basisSet file: "//trim(basisName)//" was not found!","BasisSet module at Load function.")
+ end if
+ end if
+
+ rewind(30)
+ found = .false.
+
+ !! Open element and Find Element Basis set
+ do while(found .eqv. .false.)
+
+ read(30,*, iostat=status) token, symbol
+
+ !! Some debug information in case of error!
+ if (status > 0 ) then
+
+ call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.")
+
+ end if
+
+ if (status == -1 ) then
+
+ call BasisSet_exception(ERROR, "The basisSet: "//trim(this%name)//" for: "//trim(particleSelected)//" was not found!","BasisSet module at Load function.")
+
+ end if
+
+ if(trim(token(1:2)) == "O-") then
+
+ if(trim(symbol) == trim(particleSelected)) then
+
+ found = .true.
+
end if
-
- end do
-
- !! Neglect any coment
- token = "#"
- do while(trim(token(1:1)) == "#")
-
- read(30,*) token
-
- end do
-
- !! Start reading basis set
- backspace(30)
-
- read(30,*, iostat=status) this%length
-
+
+ end if
+
+ end do
+
+ !! Neglect any coment
+ token = "#"
+ do while(trim(token(1:1)) == "#")
+
+ read(30,*) token
+
+ end do
+
+ !! Start reading basis set
+ backspace(30)
+
+ read(30,*, iostat=status) this%length
+
+ !! Some debug information in case of error!
+ if (status > 0 ) then
+
+ call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.")
+
+ end if
+
+ allocate(this%contraction(this%length))
+
+ do i = 1, this%length
+
+ read(30,*,iostat=status) this%contraction(i)%id, &
+ this%contraction(i)%angularMoment, &
+ this%contraction(i)%length
+
!! Some debug information in case of error!
if (status > 0 ) then
-
+
call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.")
-
+
end if
-
- allocate(this%contraction(this%length))
-
- do i = 1, this%length
-
- read(30,*,iostat=status) this%contraction(i)%id, &
- this%contraction(i)%angularMoment, &
- this%contraction(i)%length
-
+
+ allocate(this%contraction(i)%orbitalExponents(this%contraction(i)%length))
+ allocate(this%contraction(i)%contractionCoefficients(this%contraction(i)%length))
+
+ do j = 1, this%contraction(i)%length
+
+ read(30,*,iostat=status) this%contraction(i)%orbitalExponents(j), &
+ this%contraction(i)%contractionCoefficients(j)
+
!! Some debug information in case of error!
if (status > 0 ) then
-
+
call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.")
-
+
end if
-
- allocate(this%contraction(i)%orbitalExponents(this%contraction(i)%length))
- allocate(this%contraction(i)%contractionCoefficients(this%contraction(i)%length))
-
- do j = 1, this%contraction(i)%length
-
- read(30,*,iostat=status) this%contraction(i)%orbitalExponents(j), &
- this%contraction(i)%contractionCoefficients(j)
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.")
-
- end if
-
- end do
-
- !! Ajust and normalize contractions
- this%contraction(i)%origin = this%origin
-
- !! Calculates the number of cartesian orbitals, by dimensionality
- select case(CONTROL_instance%DIMENSIONALITY)
-
- case(3)
- this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 )*( this%contraction(i)%angularMoment + 2_8 ) ) / 2_8
- case(2)
- this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 ) )
- case(1)
- this%contraction(i)%numCartesianOrbital = 1
- case default
- call BasisSet_exception( ERROR, "Class object Basis set in load function",&
- "This Dimensionality is not avaliable")
- end select
-
- !! Normalize
- allocate(this%contraction(i)%contNormalization(this%contraction(i)%numCartesianOrbital))
- allocate(this%contraction(i)%primNormalization(this%contraction(i)%length, &
- this%contraction(i)%length*this%contraction(i)%numCartesianOrbital))
-
- this%contraction(i)%contNormalization = 1.0_8
- this%contraction(i)%primNormalization = 1.0_8
- call ContractedGaussian_normalizePrimitive(this%contraction(i))
- call ContractedGaussian_normalizeContraction(this%contraction(i))
-
- !! DEBUG
- !! call ContractedGaussian_showInCompactForm(this%contraction(i))
-
end do
-
- close(30)
-
- !!DONE
-
- else
-
- call BasisSet_exception(ERROR, "The basisSet file: "//trim(basisName)//" was not found!","BasisSet module at Load function.")
-
- end if
-
+
+ !! Ajust and normalize contractions
+ this%contraction(i)%origin = this%origin
+
+ !! Calculates the number of cartesian orbitals, by dimensionality
+ select case(CONTROL_instance%DIMENSIONALITY)
+
+ case(3)
+ this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 )*( this%contraction(i)%angularMoment + 2_8 ) ) / 2_8
+ case(2)
+ this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 ) )
+ case(1)
+ this%contraction(i)%numCartesianOrbital = 1
+ case default
+ call BasisSet_exception( ERROR, "Class object Basis set in load function",&
+ "This Dimensionality is not avaliable")
+ end select
+
+ !! Normalize
+ allocate(this%contraction(i)%contNormalization(this%contraction(i)%numCartesianOrbital))
+ allocate(this%contraction(i)%primNormalization(this%contraction(i)%length, &
+ this%contraction(i)%length*this%contraction(i)%numCartesianOrbital))
+
+ this%contraction(i)%contNormalization = 1.0_8
+ this%contraction(i)%primNormalization = 1.0_8
+
+ call ContractedGaussian_normalizePrimitive(this%contraction(i))
+ call ContractedGaussian_normalizeContraction(this%contraction(i))
+
+ !! DEBUG
+ !! call ContractedGaussian_showInCompactForm(this%contraction(i))
+
+ end do
+
+ close(30)
+
+ !!DONE
end select
end subroutine BasisSet_load
diff --git a/src/core/CONTROL.f90 b/src/core/CONTROL.f90
index 2d857e48..e5b0240f 100644
--- a/src/core/CONTROL.f90
+++ b/src/core/CONTROL.f90
@@ -101,7 +101,7 @@ module CONTROL_
logical :: HF_PRINT_EIGENVALUES
character(20) :: HF_PRINT_EIGENVECTORS
real(8) :: OVERLAP_EIGEN_THRESHOLD
- real(8) :: ELECTRIC_FIELD(6)
+ real(8) :: ELECTRIC_FIELD(3)
integer :: MULTIPOLE_ORDER
!!***************************************************************************
@@ -190,6 +190,7 @@ module CONTROL_
integer :: NUMBER_OF_CI_STATES
character(20) :: CI_DIAGONALIZATION_METHOD
character(20) :: CI_PRINT_EIGENVECTORS_FORMAT
+ character(20) :: CI_DIAGONAL_DRESSED_SHIFT
real(8) :: CI_PRINT_THRESHOLD
integer :: CI_STATES_TO_PRINT
integer :: CI_ACTIVE_SPACE
@@ -204,6 +205,8 @@ module CONTROL_
logical :: CI_BUILD_FULL_MATRIX
integer :: CI_MADSPACE
logical :: CI_NATURAL_ORBITALS
+ integer :: CI_SCI_CORE_SPACE
+ integer :: CI_SCI_TARGET_SPACE
!!***************************************************************************
!! Non-orthogonal CI
@@ -212,6 +215,8 @@ module CONTROL_
integer :: TRANSLATION_SCAN_GRID(3)
integer :: ROTATIONAL_SCAN_GRID
integer :: NESTED_ROTATIONAL_GRIDS
+ integer :: ROTATION_AROUND_Z_MAX_ANGLE
+ real(8) :: ROTATION_AROUND_Z_STEP
real(8) :: TRANSLATION_STEP
real(8) :: NESTED_GRIDS_DISPLACEMENT
real(8) :: CONFIGURATION_ENERGY_THRESHOLD
@@ -224,10 +229,13 @@ module CONTROL_
real(8) :: CONFIGURATION_EQUIVALENCE_DISTANCE
real(8) :: EMPIRICAL_OVERLAP_PARAMETER_A
real(8) :: EMPIRICAL_OVERLAP_PARAMETER_B
+ real(8) :: EMPIRICAL_OVERLAP_PARAMETER_E0
+ real(8) :: EMPIRICAL_OVERLAP_PARAMETER_SC
logical :: CONFIGURATION_USE_SYMMETRY
logical :: READ_NOCI_GEOMETRIES
logical :: EMPIRICAL_OVERLAP_CORRECTION
logical :: ONLY_FIRST_NOCI_ELEMENTS
+ logical :: COMPUTE_ROCI_FORMULA
!!***************************************************************************
!! CCSD Parameters
@@ -442,7 +450,7 @@ module CONTROL_
logical :: LowdinParameters_HFprintEigenvalues
character(20) :: LowdinParameters_HFprintEigenvectors
real(8) :: LowdinParameters_overlapEigenThreshold
- real(8) :: LowdinParameters_electricField(6)
+ real(8) :: LowdinParameters_electricField(3)
integer :: LowdinParameters_multipoleOrder
!!***************************************************************************
@@ -529,6 +537,7 @@ module CONTROL_
integer :: LowdinParameters_numberOfCIStates
character(20) :: LowdinParameters_CIdiagonalizationMethod
character(20) :: LowdinParameters_CIPrintEigenVectorsFormat
+ character(20) :: LowdinParameters_CIdiagonalDressedShift
real(8) :: LowdinParameters_CIPrintThreshold
integer :: LowdinParameters_CIactiveSpace
integer :: LowdinParameters_CIstatesToPrint
@@ -543,6 +552,8 @@ module CONTROL_
logical :: LowdinParameters_CIBuildFullMatrix
integer :: LowdinParameters_CIMadSpace
logical :: LowdinParameters_CINaturalOrbitals
+ integer :: LowdinParameters_CISCICoreSpace
+ integer :: LowdinParameters_CISCITargetSpace
!!***************************************************************************
!! Non-orthogonal CI
@@ -551,6 +562,8 @@ module CONTROL_
integer :: LowdinParameters_translationScanGrid(3)
integer :: LowdinParameters_rotationalScanGrid
integer :: LowdinParameters_nestedRotationalGrids
+ integer :: LowdinParameters_rotationAroundZMaxAngle
+ real(8) :: LowdinParameters_rotationAroundZStep
real(8) :: LowdinParameters_translationStep
real(8) :: LowdinParameters_nestedGridsDisplacement
real(8) :: LowdinParameters_configurationEnergyThreshold
@@ -563,10 +576,13 @@ module CONTROL_
real(8) :: LowdinParameters_configurationEquivalenceDistance
real(8) :: LowdinParameters_empiricalOverlapParameterA
real(8) :: LowdinParameters_empiricalOverlapParameterB
+ real(8) :: LowdinParameters_empiricalOverlapParameterE0
+ real(8) :: LowdinParameters_empiricalOverlapParameterSc
logical :: LowdinParameters_configurationUseSymmetry
logical :: LowdinParameters_readNOCIGeometries
logical :: LowdinParameters_empiricalOverlapCorrection
logical :: LowdinParameters_onlyFirstNOCIelements
+ logical :: LowdinParameters_computeROCIformula
!!***************************************************************************
!! CCSD
@@ -866,6 +882,7 @@ module CONTROL_
LowdinParameters_configurationInteractionLevel,&
LowdinParameters_numberOfCIStates, &
LowdinParameters_CIdiagonalizationMethod, &
+ LowdinParameters_CIdiagonalDressedShift, &
LowdinParameters_CIactiveSpace, &
LowdinParameters_CIstatesToPrint, &
LowdinParameters_CImaxNCV, &
@@ -881,6 +898,10 @@ module CONTROL_
LowdinParameters_CINaturalOrbitals, &
LowdinParameters_CIPrintEigenVectorsFormat, &
LowdinParameters_CIPrintThreshold, &
+ LowdinParameters_CISCICoreSpace, &
+ LowdinParameters_CISCITargetSpace, &
+
+
!!***************************************************************************
!! Non-orthogonal CI
@@ -888,6 +909,8 @@ module CONTROL_
LowdinParameters_nonOrthogonalConfigurationInteraction,&
LowdinParameters_translationScanGrid,&
LowdinParameters_rotationalScanGrid,&
+ LowdinParameters_rotationAroundZMaxAngle,&
+ LowdinParameters_rotationAroundZStep,&
LowdinParameters_nestedRotationalGrids,&
LowdinParameters_translationStep,&
LowdinParameters_nestedGridsDisplacement,&
@@ -901,10 +924,13 @@ module CONTROL_
LowdinParameters_configurationEquivalenceDistance,&
LowdinParameters_empiricalOverlapParameterA,&
LowdinParameters_empiricalOverlapParameterB,&
+ LowdinParameters_empiricalOverlapParameterE0,&
+ LowdinParameters_empiricalOverlapParameterSc,&
LowdinParameters_configurationUseSymmetry,&
LowdinParameters_readNOCIGeometries,&
LowdinParameters_empiricalOverlapCorrection,&
LowdinParameters_onlyFirstNOCIelements,&
+ LowdinParameters_computeROCIformula,&
!!***************************************************************************
!! CCSD
!!
@@ -1228,6 +1254,7 @@ subroutine CONTROL_start()
LowdinParameters_configurationInteractionLevel = "NONE"
LowdinParameters_numberOfCIStates = 1
LowdinParameters_CIdiagonalizationMethod = "DSYEVR"
+ LowdinParameters_CIdiagonalDressedShift = "NONE"
LowdinParameters_CIactiveSpace = 0 !! Full
LowdinParameters_CIstatesToPrint = 1
LowdinParameters_CImaxNCV = 30
@@ -1250,6 +1277,8 @@ subroutine CONTROL_start()
LowdinParameters_nonOrthogonalConfigurationInteraction=.false.
LowdinParameters_translationScanGrid(:)=0
LowdinParameters_rotationalScanGrid=0
+ LowdinParameters_rotationAroundZMaxAngle=360
+ LowdinParameters_rotationAroundZStep=0
LowdinParameters_nestedRotationalGrids=1
LowdinParameters_translationStep=0.0
LowdinParameters_nestedGridsDisplacement=0.0
@@ -1263,10 +1292,13 @@ subroutine CONTROL_start()
LowdinParameters_configurationEquivalenceDistance=1.0E-8
LowdinParameters_empiricalOverlapParameterA=0.0604
LowdinParameters_empiricalOverlapParameterB=0.492
+ LowdinParameters_empiricalOverlapParameterE0=0.0
+ LowdinParameters_empiricalOverlapParameterSc=0.0
LowdinParameters_configurationUseSymmetry=.false.
LowdinParameters_readNOCIgeometries=.false.
LowdinParameters_empiricalOverlapCorrection=.false.
LowdinParameters_onlyFirstNOCIelements=.false.
+ LowdinParameters_computeROCIformula=.false.
!!***************************************************************************
!! CCSD
!!
@@ -1565,6 +1597,7 @@ subroutine CONTROL_start()
CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL = "NONE"
CONTROL_instance%NUMBER_OF_CI_STATES= 1
CONTROL_instance%CI_DIAGONALIZATION_METHOD = "DSYEVR"
+ CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT = "NONE"
CONTROL_instance%CI_ACTIVE_SPACE = 0 !! Full
CONTROL_instance%CI_STATES_TO_PRINT = 1
CONTROL_instance%CI_MAX_NCV = 30
@@ -1580,6 +1613,8 @@ subroutine CONTROL_start()
CONTROL_instance%CI_NATURAL_ORBITALS=.FALSE.
CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT = "OCCUPIED"
CONTROL_instance%CI_PRINT_THRESHOLD = 1E-1
+ CONTROL_instance%CI_SCI_CORE_SPACE = 100
+ CONTROL_instance%CI_SCI_TARGET_SPACE = 10000
!!***************************************************************************
!! Non-orthogonal CI
@@ -1587,6 +1622,8 @@ subroutine CONTROL_start()
CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION=.FALSE.
CONTROL_instance%TRANSLATION_SCAN_GRID(:)=0
CONTROL_instance%ROTATIONAL_SCAN_GRID=0
+ CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE=360
+ CONTROL_instance%ROTATION_AROUND_Z_STEP=0
CONTROL_instance%NESTED_ROTATIONAL_GRIDS=1
CONTROL_instance%TRANSLATION_STEP=0.0
CONTROL_instance%NESTED_GRIDS_DISPLACEMENT=0.0
@@ -1600,10 +1637,13 @@ subroutine CONTROL_start()
CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE=1.0E-8
CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A=0.0604
CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B=0.492
+ CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0=0.0
+ CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_Sc=0.0
CONTROL_instance%CONFIGURATION_USE_SYMMETRY=.false.
CONTROL_instance%READ_NOCI_GEOMETRIES=.false.
CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION=.false.
CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS=.false.
+ CONTROL_instance%COMPUTE_ROCI_FORMULA=.false.
!!***************************************************************************
!! CCSD
!!
@@ -1951,6 +1991,7 @@ subroutine CONTROL_load(unit)
CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL = LowdinParameters_configurationInteractionLevel
CONTROL_instance%NUMBER_OF_CI_STATES = LowdinParameters_numberOfCIStates
CONTROL_instance%CI_DIAGONALIZATION_METHOD = LowdinParameters_CIdiagonalizationMethod
+ CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT = LowdinParameters_CIdiagonalDressedShift
CONTROL_instance%CI_ACTIVE_SPACE = LowdinParameters_CIactiveSpace
CONTROL_instance%CI_STATES_TO_PRINT = LowdinParameters_CIstatesToPrint
if(CONTROL_instance%CI_STATES_TO_PRINT .gt. CONTROL_instance%NUMBER_OF_CI_STATES) &
@@ -1968,6 +2009,10 @@ subroutine CONTROL_load(unit)
CONTROL_instance%CI_NATURAL_ORBITALS= LowdinParameters_CINaturalOrbitals
CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT = LowdinParameters_CIPrintEigenVectorsFormat
CONTROL_instance%CI_PRINT_THRESHOLD = LowdinParameters_CIPrintThreshold
+ CONTROL_instance%CI_SCI_CORE_SPACE = LowdinParameters_CISCICoreSpace
+ CONTROL_instance%CI_SCI_TARGET_SPACE = LowdinParameters_CISCITargetSpace
+
+
!!***************************************************************************
!! Non-orthogonal CI
@@ -1975,6 +2020,8 @@ subroutine CONTROL_load(unit)
CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION=LowdinParameters_nonOrthogonalConfigurationInteraction
CONTROL_instance%TRANSLATION_SCAN_GRID=LowdinParameters_translationScanGrid
CONTROL_instance%ROTATIONAL_SCAN_GRID=LowdinParameters_rotationalScanGrid
+ CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE=LowdinParameters_rotationAroundZMaxAngle
+ CONTROL_instance%ROTATION_AROUND_Z_STEP=LowdinParameters_rotationAroundZStep
CONTROL_instance%NESTED_ROTATIONAL_GRIDS=LowdinParameters_nestedRotationalGrids
CONTROL_instance%TRANSLATION_STEP=LowdinParameters_translationStep
CONTROL_instance%NESTED_GRIDS_DISPLACEMENT=LowdinParameters_nestedGridsDisplacement
@@ -1992,10 +2039,13 @@ subroutine CONTROL_load(unit)
CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE=LowdinParameters_configurationEquivalenceDistance
CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A=LowdinParameters_empiricalOverlapParameterA
CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B=LowdinParameters_empiricalOverlapParameterB
+ CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0=LowdinParameters_empiricalOverlapParameterE0
+ CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC=LowdinParameters_empiricalOverlapParameterSc
CONTROL_instance%CONFIGURATION_USE_SYMMETRY=LowdinParameters_configurationUseSymmetry
CONTROL_instance%READ_NOCI_GEOMETRIES=LowdinParameters_readNOCIGeometries
CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION=LowdinParameters_empiricalOverlapCorrection
CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS=LowdinParameters_onlyFirstNOCIelements
+ CONTROL_instance%COMPUTE_ROCI_FORMULA=LowdinParameters_computeROCIformula
!!***************************************************************************
@@ -2319,6 +2369,7 @@ subroutine CONTROL_save( unit, lastStep, firstStep )
LowdinParameters_configurationInteractionLevel = CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL
LowdinParameters_numberOfCIStates = CONTROL_instance%NUMBER_OF_CI_STATES
LowdinParameters_CIdiagonalizationMethod = CONTROL_instance%CI_DIAGONALIZATION_METHOD
+ LowdinParameters_CIdiagonalDressedShift = CONTROL_instance%CI_DIAGONAL_DRESSED_SHIFT
LowdinParameters_CIactiveSpace = CONTROL_instance%CI_ACTIVE_SPACE
LowdinParameters_CIstatesToPrint = CONTROL_instance%CI_STATES_TO_PRINT
@@ -2329,9 +2380,10 @@ subroutine CONTROL_save( unit, lastStep, firstStep )
LowdinParameters_CIBuildFullMatrix = CONTROL_instance%CI_BUILD_FULL_MATRIX
LowdinParameters_CIMadSpace = CONTROL_instance%CI_MADSPACE
LowdinParameters_CINaturalOrbitals = CONTROL_instance%CI_NATURAL_ORBITALS
-
LowdinParameters_CIPrintEigenVectorsFormat = CONTROL_instance%CI_PRINT_EIGENVECTORS_FORMAT
LowdinParameters_CIPrintThreshold = CONTROL_instance%CI_PRINT_THRESHOLD
+ LowdinParameters_CISCICoreSpace = CONTROL_instance%CI_SCI_CORE_SPACE
+ LowdinParameters_CISCITargetSpace = CONTROL_instance%CI_SCI_TARGET_SPACE
!!***************************************************************************
!! Non-orthogonal CI
@@ -2339,6 +2391,8 @@ subroutine CONTROL_save( unit, lastStep, firstStep )
LowdinParameters_nonOrthogonalConfigurationInteraction=CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION
LowdinParameters_translationScanGrid=CONTROL_instance%TRANSLATION_SCAN_GRID
LowdinParameters_rotationalScanGrid=CONTROL_instance%ROTATIONAL_SCAN_GRID
+ LowdinParameters_rotationAroundZMaxAngle=CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE
+ LowdinParameters_rotationAroundZStep=CONTROL_instance%ROTATION_AROUND_Z_STEP
LowdinParameters_nestedRotationalGrids=CONTROL_instance%NESTED_ROTATIONAL_GRIDS
LowdinParameters_translationStep=CONTROL_instance%TRANSLATION_STEP
LowdinParameters_nestedGridsDisplacement=CONTROL_instance%NESTED_GRIDS_DISPLACEMENT
@@ -2352,10 +2406,13 @@ subroutine CONTROL_save( unit, lastStep, firstStep )
LowdinParameters_configurationEquivalenceDistance=CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE
LowdinParameters_empiricalOverlapParameterA=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A
LowdinParameters_empiricalOverlapParameterB=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B
+ LowdinParameters_empiricalOverlapParameterE0=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0
+ LowdinParameters_empiricalOverlapParameterSc=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC
LowdinParameters_configurationUseSymmetry=CONTROL_instance%CONFIGURATION_USE_SYMMETRY
LowdinParameters_readNOCIGeometries=CONTROL_instance%READ_NOCI_GEOMETRIES
LowdinParameters_empiricalOverlapCorrection=CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION
LowdinParameters_onlyFirstNOCIelements=CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS
+ LowdinParameters_computeROCIformula=CONTROL_instance%COMPUTE_ROCI_FORMULA
!!***************************************************************************
!! CCSD
@@ -2650,6 +2707,7 @@ subroutine CONTROL_copy(this, otherThis)
otherThis%CONFIGURATION_INTERACTION_LEVEL = this%CONFIGURATION_INTERACTION_LEVEL
otherThis%NUMBER_OF_CI_STATES = this%NUMBER_OF_CI_STATES
otherThis%CI_DIAGONALIZATION_METHOD = this%CI_DIAGONALIZATION_METHOD
+ otherThis%CI_DIAGONAL_DRESSED_SHIFT = this%CI_DIAGONAL_DRESSED_SHIFT
otherThis%CI_ACTIVE_SPACE = this%CI_ACTIVE_SPACE
otherThis%CI_STATES_TO_PRINT = this%CI_STATES_TO_PRINT
otherThis%CI_MAX_NCV = this%CI_MAX_NCV
@@ -2665,6 +2723,8 @@ subroutine CONTROL_copy(this, otherThis)
otherThis%CI_NATURAL_ORBITALS = this%CI_NATURAL_ORBITALS
otherThis%CI_PRINT_EIGENVECTORS_FORMAT = this%CI_PRINT_EIGENVECTORS_FORMAT
otherThis%CI_PRINT_THRESHOLD = this%CI_PRINT_THRESHOLD
+ otherThis%CI_SCI_CORE_SPACE = this%CI_SCI_CORE_SPACE
+ otherThis%CI_SCI_TARGET_SPACE = this%CI_SCI_TARGET_SPACE
!!***************************************************************************
!! Non-orthogonal CI
@@ -2672,6 +2732,8 @@ subroutine CONTROL_copy(this, otherThis)
otherThis%NONORTHOGONAL_CONFIGURATION_INTERACTION = this%NONORTHOGONAL_CONFIGURATION_INTERACTION
otherThis%TRANSLATION_SCAN_GRID = this%TRANSLATION_SCAN_GRID
otherThis%ROTATIONAL_SCAN_GRID = this%ROTATIONAL_SCAN_GRID
+ otherThis%ROTATION_AROUND_Z_MAX_ANGLE=this%ROTATION_AROUND_Z_MAX_ANGLE
+ otherThis%ROTATION_AROUND_Z_STEP=this%ROTATION_AROUND_Z_STEP
otherThis%NESTED_ROTATIONAL_GRIDS = this%NESTED_ROTATIONAL_GRIDS
otherThis%TRANSLATION_STEP = this%TRANSLATION_STEP
otherThis%NESTED_GRIDS_DISPLACEMENT = this%NESTED_GRIDS_DISPLACEMENT
@@ -2685,6 +2747,9 @@ subroutine CONTROL_copy(this, otherThis)
otherThis%CONFIGURATION_EQUIVALENCE_DISTANCE=this%CONFIGURATION_EQUIVALENCE_DISTANCE
otherThis%CONFIGURATION_USE_SYMMETRY=this%CONFIGURATION_USE_SYMMETRY
otherThis%READ_NOCI_GEOMETRIES=this%READ_NOCI_GEOMETRIES
+ otherThis%ONLY_FIRST_NOCI_ELEMENTS=this%ONLY_FIRST_NOCI_ELEMENTS
+ otherThis%COMPUTE_ROCI_FORMULA=this%COMPUTE_ROCI_FORMULA
+
!!***************************************************************************
!! CCSD
!!
@@ -2972,10 +3037,32 @@ subroutine CONTROL_show()
if(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) &
write (*,"(T10,A)") "COMPUTING NOCI ELEMENTS ONLY WITH RESPECT TO THE FIRST GEOMETRY - YOU HAVE TO SOLVE THE CI EQUATION MANUALLY!"
-
- print *, ""
+ if(CONTROL_instance%COMPUTE_ROCI_FORMULA) then
+ CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS=.true.
+ if(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE .gt. 180 ) CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE=180
+ write (*,"(T10,A)") "COMPUTING ROTATIONAL ENERGIES FROM THE FIRST GEOMETRY NOCI ELEMENTS"
+ if(CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0 .gt. 0.0 .or. CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B .gt. 0.0) then
+ write (*,"(T10,A,F8.5,A,F8.5)") &
+ "EMPLOYING EMPIRICAL SCALE FACTORS E0=",&
+ CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0,&
+ " AND Sc=",&
+ CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC
+ end if
+ print *, ""
+ end if
+ if(CONTROL_instance%ROTATION_AROUND_Z_STEP .gt. 0 ) then
+ ! if(CONTROL_instance%NESTED_ROTATIONAL_GRIDS .gt. 1 ) then
+ ! write (*,"(T10,I3,A,I6,A)") CONTROL_instance%NESTED_ROTATIONAL_GRIDS, " GRIDS OF", CONTROL_instance%ROTATIONAL_SCAN_GRID_AROUND_Z, " BASIS FUNCTIONS WILL BE PLACED AROUND EACH ROTATIONAL CENTER"
+ ! write (*,"(T10,A,F6.3,A10)") "WITH A RADIAL SEPARATION OF", CONTROL_instance%NESTED_GRIDS_DISPLACEMENT, " BOHRS"
+ ! else
+ write (*,"(T10,A,F8.2,A,I6,A)") "THE MOLECULAR SYSTEM WILL BE ROTATED AROUND THE Z AXIS IN STEPS OF", CONTROL_instance%ROTATION_AROUND_Z_STEP, " DEGREES UP TO ", CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE, " DEGREES"
+ ! end if
+ end if
+
+
+ print *, ""
end if
diff --git a/src/core/ConstantsOfCoupling.f90 b/src/core/ConstantsOfCoupling.f90
index 3e3bba2c..0c190802 100644
--- a/src/core/ConstantsOfCoupling.f90
+++ b/src/core/ConstantsOfCoupling.f90
@@ -71,59 +71,53 @@ subroutine ConstantsOfCoupling_load( this, symbolSelected )
!! Looking for library
inquire(file=trim(CONTROL_instance%DATA_DIRECTORY)//"/dataBases/constantsOfCoupling.lib", exist=existFile)
- if ( existFile ) then
-
- !! Open library
- open(unit=10, file=trim(CONTROL_instance%DATA_DIRECTORY)//"/dataBases/constantsOfCoupling.lib", status="old", form="formatted" )
-
- !! Read information
- symbol = "NONE"
- stat = 0
-
- do while(trim(symbol) /= trim(symbolSelected))
-
- !! Setting defaults
- name = "NONE"
- kappa = 0
- eta = 0
- particlesFraction = 1
-
- if (stat == -1 ) then
-
- call ConstantsOfCoupling_exception( ERROR, "Elemental particle: "//trim(symbolSelected)//" NOT found!!", "In ConstantsOfCoupling at load function.")
- this%isInstanced = .false.
+ if ( .not. existFile ) call ConstantsOfCoupling_exception( ERROR, "LOWDIN library not found!! please export lowdinvars.sh file.", "In ConstantsOfCoupling at load function.")
+
+ !! Open library
+ open(unit=10, file=trim(CONTROL_instance%DATA_DIRECTORY)//"/dataBases/constantsOfCoupling.lib", status="old", form="formatted" )
- end if
-
- read(10,NML=specie, iostat=stat)
-
- if (stat > 0 ) then
-
- call ConstantsOfCoupling_exception( ERROR, "Failed reading ConstantsOfCouplings.lib file!! please check this file.", "In ConstantsOfCoupling at load function.")
-
- end if
+ !! Read information
+ symbol = "NONE"
+ stat = 0
- end do
+ do while(trim(symbol) /= trim(symbolSelected))
- !! Set object variables
- this%name = name
- this%symbol = symbol
- this%kappa = kappa
- this%eta = eta
- this%lambda = lambda
- this%particlesFraction = particlesFraction
-
- !! Debug information.
- !! call ConstantsOfCoupling_show(this)
-
- close(10)
+ !! Setting defaults
+ name = "NONE"
+ kappa = 0
+ eta = 0
+ particlesFraction = 1
- else
+ if (stat == -1 ) then
- call ConstantsOfCoupling_exception( ERROR, "LOWDIN library not found!! please export lowdinvars.sh file.", "In ConstantsOfCoupling at load function.")
+ ! call ConstantsOfCoupling_exception( WARNING, "Elemental particle: "//trim(symbolSelected)//" NOT found!!", "Setting default values")
+ this%isInstanced=.false.
+ exit
+ end if
- end if
+ read(10,NML=specie, iostat=stat)
+ if (stat > 0 ) then
+
+ call ConstantsOfCoupling_exception( ERROR, "Failed reading ConstantsOfCouplings.lib file!! please check this file.", "In ConstantsOfCoupling at load function.")
+
+ end if
+
+ end do
+
+ !! Set object variables
+ this%name = name
+ this%symbol = symbol
+ this%kappa = kappa
+ this%eta = eta
+ this%lambda = lambda
+ this%particlesFraction = particlesFraction
+
+ !! Debug information.
+ ! call ConstantsOfCoupling_show(this)
+
+ close(10)
+
!! Done
end subroutine ConstantsOfCoupling_load
diff --git a/src/core/CosmoCore.f90 b/src/core/CosmoCore.f90
index fef9bfda..72ddde87 100644
--- a/src/core/CosmoCore.f90
+++ b/src/core/CosmoCore.f90
@@ -388,7 +388,7 @@ subroutine CosmoCore_q_builder(cmatinv, cosmo_ints, ints, q_charges,specieid)
call Matrix_constructor(q_charge, int(ints,8), 1_8)
call Matrix_constructor(cosmo_pot, int(ints,8), 1_8)
- specieName=MolecularSystem_getNameOfSpecie(specieid)
+ specieName=MolecularSystem_getNameOfSpecies(specieid)
charge=MolecularSystem_getCharge(MolecularSystem_getSpecieID(specieName))
@@ -503,7 +503,7 @@ subroutine CosmoCore_q_int_builder(integrals_file,charges_file,surface,charges,i
if(trim(charges_file)=="cosmo.clasical") then
- allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(specieID = f_aux), MolecularSystem_getTotalNumberOfContractions(specieID = f_aux)))
+ allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(f_aux), MolecularSystem_getTotalNumberOfContractions(f_aux)))
ints_mat_aux = 0 !!JC
ii = 0
mm = 1
@@ -710,7 +710,7 @@ subroutine CosmoCore_nucleiPotentialQuantumCharges(surface_aux,charges_file,char
allocate(cosmo_int(charges))
allocate(a_mat(segments,charges))
allocate(clasical_positions(np,3))
- allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(specieID = f_aux), MolecularSystem_getTotalNumberOfContractions(specieID = f_aux)))
+ allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(f_aux), MolecularSystem_getTotalNumberOfContractions(f_aux)))
open(unit=100, file=trim(charges_file), status='old', form="unformatted")
diff --git a/src/core/ElementalParticle.f90 b/src/core/ElementalParticle.f90
index ce1b69b9..5b961321 100644
--- a/src/core/ElementalParticle.f90
+++ b/src/core/ElementalParticle.f90
@@ -40,6 +40,7 @@ module ElementalParticle_
real(8) :: mass
real(8) :: charge
real(8) :: spin
+ logical :: custom
end type ElementalParticle
public :: &
@@ -59,6 +60,7 @@ subroutine ElementalParticle_load( this, symbolSelected )
character(*) :: symbolSelected
logical :: existFile
+ logical :: custom
integer :: stat
integer :: i
@@ -81,59 +83,64 @@ subroutine ElementalParticle_load( this, symbolSelected )
!! Looking for library
inquire(file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%ELEMENTAL_PARTICLES_DATABASE), exist=existFile)
- if ( existFile ) then
+ if ( .not. existFile ) call ElementalParticle_exception( ERROR, "LOWDIN library not found!! please export lowdinvars.sh file.", "In ElementalParticle at load function.")
- !! Open library
- open(unit=10, file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%ELEMENTAL_PARTICLES_DATABASE), status="old", form="formatted" )
-
- !! Read information
- symbol = "NONE"
- stat = 0
-
- do while(trim(symbol) /= trim(symbolSelected))
+ !! Open library
+ open(unit=10, file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%ELEMENTAL_PARTICLES_DATABASE), status="old", form="formatted" )
+
+ !! Read information
+ symbol = "NONE"
+ stat = 0
+
+ do while(trim(symbol) /= trim(symbolSelected))
+
+ !! Setting defaults
+ name = "NONE"
+ category = "NONE"
+ mass = -1
+ charge = 0
+ spin = 0
+ custom = .false.
- !! Setting defaults
- name = "NONE"
- category = "NONE"
- mass = -1
- charge = 0
- spin = 0
-
- if (stat == -1 ) then
-
- call ElementalParticle_exception( ERROR, "Elemental particle: "//trim(symbolSelected)//" NOT found!!", "In ElementalParticle at load function.")
+ if (stat == -1 ) then
- end if
+ ! call ElementalParticle_exception( WARNING, "Elemental particle: "//trim(symbolSelected)//" NOT found in ElementalParticles.lib", "Setting default values")
+ name = trim(symbolSelected)
+ symbol = trim(symbolSelected)
+ category = "FERMION"
+ mass = 1.0
+ charge = 1.0
+ spin = 0.5
+ custom = .true.
+
+ exit
- read(10,NML=particle, iostat=stat)
-
- if (stat > 0 ) then
-
- call ElementalParticle_exception( ERROR, "Failed reading ElementalParticles.lib file!! please check this file.", "In ElementalParticle at load function.")
-
- end if
+ end if
- end do
-
- !! Set object variables
- this%name = name
- this%symbol = symbol
- this%category = category
- this%mass = mass
- this%charge = charge
- this%spin = spin
-
- !! Debug information.
- !! call ElementalParticle_show(this)
-
- close(10)
-
- else
+ read(10,NML=particle, iostat=stat)
+
+ if (stat > 0 ) then
+
+ call ElementalParticle_exception( ERROR, "Failed reading ElementalParticles.lib file!! please check this file.", "In ElementalParticle at load function.")
- call ElementalParticle_exception( ERROR, "LOWDIN library not found!! please export lowdinvars.sh file.", "In ElementalParticle at load function.")
+ end if
- end if
+ end do
+ !! Set object variables
+ this%name = name
+ this%symbol = symbol
+ this%category = category
+ this%mass = mass
+ this%charge = charge
+ this%spin = spin
+ this%custom = custom
+
+ !! Debug information.
+ ! call ElementalParticle_show(this)
+
+ close(10)
+
!! Done
end subroutine ElementalParticle_load
diff --git a/src/core/EnergyGradients.f90 b/src/core/EnergyGradients.f90
index 79940c8a..51cd19cd 100644
--- a/src/core/EnergyGradients.f90
+++ b/src/core/EnergyGradients.f90
@@ -746,10 +746,10 @@ end subroutine EnergyGradients_getAnalyticDerivative
! do i=1, ParticleManager_getNumberOfQuantumSpecies()
! if ( ParticleManager_instance%particles(i)%isQuantum ) then
- ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecie( i ))//".vec " &
- ! //trim(fileName)//"0."//trim(ParticleManager_getNameOfSpecie( i ))//".vec ")
- ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecie( i ))//".vec " &
- ! //trim(fileName)//"1."//trim(ParticleManager_getNameOfSpecie( i ))//".vec ")
+ ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecies( i ))//".vec " &
+ ! //trim(fileName)//"0."//trim(ParticleManager_getNameOfSpecies( i ))//".vec ")
+ ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecies( i ))//".vec " &
+ ! //trim(fileName)//"1."//trim(ParticleManager_getNameOfSpecies( i ))//".vec ")
! end if
! end do
@@ -1003,7 +1003,7 @@ subroutine EnergyGradients_calculateAnalyticUncoupledFirstDerivative(surface)
! end do
ocupationNumber = MolecularSystem_getOcupationNumber( specieIterator )
- arguments(2) = MolecularSystem_getNameOfSpecie(specieIterator)
+ arguments(2) = MolecularSystem_getNameOfSpecies(specieIterator)
arguments(1) = "DENSITY"
densityMatrix = &
@@ -1891,7 +1891,7 @@ subroutine EnergyGradients_calculateAnalyticCouplingFirstDerivative()
orderOfMatrix = MolecularSystem_getTotalNumberOfContractions(specieIterator)
- arguments(2) = MolecularSystem_getNameOfSpecie(specieIterator)
+ arguments(2) = MolecularSystem_getNameOfSpecies(specieIterator)
arguments(1) = "DENSITY"
densityMatrix = &
@@ -1921,7 +1921,7 @@ subroutine EnergyGradients_calculateAnalyticCouplingFirstDerivative()
otherOrderOfMatrix = MolecularSystem_getTotalNumberOfContractions(otherSpecieIterator)
- otherArguments(2) = MolecularSystem_getNameOfSpecie(otherSpecieIterator)
+ otherArguments(2) = MolecularSystem_getNameOfSpecies(otherSpecieIterator)
otherArguments(1) = "DENSITY"
otherDensityMatrix = &
diff --git a/src/core/Exception.f90 b/src/core/Exception.f90
index e0f50639..926dacaf 100644
--- a/src/core/Exception.f90
+++ b/src/core/Exception.f90
@@ -41,6 +41,8 @@ module Exception_
integer, public, parameter :: ERROR = 3
public :: &
+ Exception_stopError, &
+ Exception_sendWarning, &
Exception_constructor, &
Exception_destructor, &
Exception_show, &
@@ -96,7 +98,7 @@ subroutine Exception_destructor( this )
this%description = ""
this%debugDescription = ""
-
+
end subroutine Exception_destructor
subroutine Exception_show( this )
@@ -136,7 +138,7 @@ subroutine Exception_show( this )
write(6,"(A16,ES10.2,A4)") "Elapsed Time : ", lowdin_stopwatch%enlapsetTime ," (s)"
write(6,*) "lowdin execution terminated ABNORMALLY at : ", trim( Stopwatch_getCurretData( lowdin_stopwatch ) )
call Stopwatch_destructor( lowdin_stopwatch )
- stop
+ STOP
end select
@@ -161,5 +163,41 @@ subroutine Exception_setDescription( this , description )
end subroutine Exception_setDescription
+ !>
+ !! @brief A nice way to stop the code in other routines
+ !<
+ subroutine Exception_stopError( description, debugDescription)
+ implicit none
+ character(*) :: description
+ character(*) :: debugDescription
+
+ type(Exception) :: ex
+
+ call Exception_constructor( ex , ERROR )
+ call Exception_setDebugDescription( ex, debugDescription )
+ call Exception_setDescription( ex, description )
+ call Exception_show( ex )
+ call Exception_destructor( ex )
+
+ end subroutine Exception_stopError
+
+
+ !>
+ !! @brief A nice way to send warnings in other routines
+ !<
+ subroutine Exception_sendWarning( description, debugDescription)
+ implicit none
+ character(*) :: description
+ character(*) :: debugDescription
+
+ type(Exception) :: ex
+
+ call Exception_constructor( ex , WARNING )
+ call Exception_setDebugDescription( ex, debugDescription )
+ call Exception_setDescription( ex, description )
+ call Exception_show( ex )
+ call Exception_destructor( ex )
+ end subroutine Exception_sendWarning
+
end module Exception_
diff --git a/src/core/ExternalPotential.f90 b/src/core/ExternalPotential.f90
deleted file mode 100644
index f6459bfa..00000000
--- a/src/core/ExternalPotential.f90
+++ /dev/null
@@ -1,378 +0,0 @@
-!!******************************************************************************
-!! This code is part of LOWDIN Quantum chemistry package
-!!
-!! this program has been developed under direction of:
-!!
-!! Prof. A REYES' Lab. Universidad Nacional de Colombia
-!! http://www.qcc.unal.edu.co
-!! Prof. R. FLORES' Lab. Universidad de Guadajara
-!! http://www.cucei.udg.mx/~robertof
-!!
-!! Todos los derechos reservados, 2013
-!!
-!!******************************************************************************
-
-!> @brief This module contains all the routines to handle external potentials
-!! @author E. F. Posada (efposadac@unal.edu.co)
-!! @version 2.0
-!! Creation data : 06-08-10
-!!
-!! History change:
-!!
-!! - 06-08-10 : Sergio A. Gonzalez ( sergmonic@gmail.com )
-!! -# Creacioon del modulo y metodos basicos
-!! - 2011-02-14 : Fernando Posada ( efposadac@unal.edu.co )
-!! -# Reescribe y adapta el módulo para su inclusion en Lowdin
-module ExternalPotential_
- use ContractedGaussian_
- use String_
- use Matrix_
- use Units_
- use Exception_
- implicit none
-
- type, public :: ExternalPot
- character(20) :: name
- character(50) :: specie
- character(50) :: ttype
- character(50) :: units
- integer :: numOfComponents
- integer :: iter
- type(ContractedGaussian), allocatable :: gaussianComponents(:)
- end type
-
- type, public :: ExternalPotential
- integer :: ssize
- type(ExternalPot), allocatable :: potentials(:)
- logical :: isInstanced
- end type
-
- type(ExternalPotential), public, target :: ExternalPotential_instance
-
-contains
-
-
- !>
- !! @brief Constructor by default
- !! @param this
- subroutine ExternalPotential_constructor(numberOfPotentials)
- implicit none
-
- integer :: numberOfPotentials
-
- ExternalPotential_instance%ssize = numberOfPotentials
- allocate(ExternalPotential_instance%potentials(numberOfPotentials))
- ExternalPotential_instance%isInstanced = .true.
-
- end subroutine ExternalPotential_constructor
-
- !>
- !! @brief Destroys the object
- !! @param this
- subroutine ExternalPotential_destructor()
- implicit none
-
- integer :: i
-
- do i = 1, ExternalPotential_instance%ssize
- if (allocated(ExternalPotential_instance%potentials(i)%gaussianComponents)) deallocate(ExternalPotential_instance%potentials(i)%gaussianComponents)
- end do
-
- if (allocated(ExternalPotential_instance%potentials) ) deallocate(ExternalPotential_instance%potentials)
- ExternalPotential_instance%isInstanced=.false.
-
- end subroutine ExternalPotential_destructor
-
- !>
- !! @brief Shows information of the object
- !! @param this
- subroutine ExternalPotential_show()
- implicit none
- type(ExternalPot), pointer :: this
- integer :: potId, i
-
- do potId = 1, ExternalPotential_instance%ssize
- this => ExternalPotential_instance%potentials(potId)
-
- print *,""
- print *,"======="
- print *, "External Potential for ", trim(this%specie), " : ", trim(this%name)
- print *, "Type : ", trim(this%ttype)
- write(6,"(T10,A20,A10,A10,A10,A10,A20)") "Exponent", "l", "R_x", "R_y", "R_z", "Factor"
-
- do i=1,this%numOfComponents
- write(6,"(T10,F20.10,I10,F10.5,F10.5,F10.5,F20.10)") &
- this%gaussianComponents(i)%orbitalExponents(1), &
- this%gaussianComponents(i)%angularMoment, this%gaussianComponents(i)%origin(:), &
- this%gaussianComponents(i)%contractionCoefficients(1)
- end do
- end do
-
- end subroutine ExternalPotential_show
-
- !>
- !! @brief loads information from the input file
- !! @param this
- !! @author E. F. Posada, 2013
- subroutine ExternalPotential_load(potId, name, species)
- implicit none
- integer :: potId
- character(*) :: name
- character(*) :: species
-
- type(ExternalPot), pointer :: this
- integer :: status, i, j
- character(150) :: fileName
- character(20) :: token
- character(10) :: symbol
- logical :: existFile, found
-
- this => ExternalPotential_instance%potentials(potId)
-
- this%name= trim(name)
- this%specie= trim(species)
- this%ttype=""
- this%units="bohr"
- this%numOfComponents=0
- this%iter=1
-
- fileName = trim( trim( CONTROL_instance%DATA_DIRECTORY ) // &
- trim(CONTROL_instance%POTENTIALS_DATABASE)// String_getUppercase(trim(name)))
-
- inquire(file=trim(fileName), exist = existFile)
- if(existFile) then
-
- !! Open File
- open(unit=30, file=trim(fileName), status="old",form="formatted")
- rewind(30)
-
- found = .false.
-
- !! Open element and Find the proper potential
- do while(found .eqv. .false.)
- read(30,*, iostat=status) token
- symbol = token(3:)
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call ExternalPotential_exception(ERROR, &
- "ERROR reading ExternalPotential file: "//trim(this%name)//&
- " Please check that file!","ExternalPotential module at Load function.")
-
- end if
-
- if (status == -1 ) then
-
- call ExternalPotential_exception(ERROR, &
- "The ExternalPotential: "//trim(this%name)//&
- " for: "//trim(species)//&
- " was not found!","ExternalPotential module at Load function.")
-
- end if
-
- if(trim(token(1:2)) == "O-") then
- if(trim(symbol) == trim(species)) then
- found = .true.
-
- end if
-
- end if
-
- end do
-
- !! Neglect any comment
- token = "#"
- do while(trim(token(1:1)) == "#")
-
- read(30,*) token
-
- end do
-
- !! Start reading Potential
- backspace(30)
-
- read(30,*, iostat=status) this%numOfComponents
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call ExternalPotential_exception(ERROR, &
- "ERROR reading ExternalPotential file: "//trim(this%name)//&
- " Please check that file!","ExternalPotential module at Load function.")
-
- end if
-
- allocate(this%gaussianComponents(this%numOfComponents))
-
- do i = 1, this%numOfComponents
-
- read(30,*,iostat=status) this%gaussianComponents(i)%id, &
- this%gaussianComponents(i)%angularMoment
- this%gaussianComponents(i)%length = 1
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call ExternalPotential_exception(ERROR, &
- "ERROR reading ExternalPotential file: "//trim(this%name)//&
- " Please check that file!","ExternalPotential module at Load function.")
-
- end if
-
- allocate(this%gaussianComponents(i)%orbitalExponents(this%gaussianComponents(i)%length))
- allocate(this%gaussianComponents(i)%contractionCoefficients(this%gaussianComponents(i)%length))
-
- do j = 1, this%gaussianComponents(i)%length
-
- read(30,*,iostat=status) this%gaussianComponents(i)%orbitalExponents(j), &
- this%gaussianComponents(i)%contractionCoefficients(j)
- read(30,*,iostat=status) this%gaussianComponents(i)%origin
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call ExternalPotential_exception(ERROR, &
- "ERROR reading ExternalPotential file: "//trim(this%name)//&
- " Please check that file!","ExternalPotential module at Load function.")
-
- end if
-
- end do
-
-
- !! Calculates the number of Cartesian orbitals, by dimensionality
- select case(CONTROL_instance%DIMENSIONALITY)
- case(3)
- this%gaussianComponents(i)%numCartesianOrbital = ( ( this%gaussianComponents(i)%angularMoment + 1_8 )*( this%gaussianComponents(i)%angularMoment + 2_8 ) ) / 2_8
- case(2)
- this%gaussianComponents(i)%numCartesianOrbital = ( ( this%gaussianComponents(i)%angularMoment + 1_8 ) )
- case(1)
- this%gaussianComponents(i)%numCartesianOrbital = 1
- case default
- call ExternalPotential_exception( ERROR, &
- "Class object ExternalPotential in load function",&
- "This Dimensionality is not available")
- end select
-
- !! Normalize
- allocate(this%gaussianComponents(i)%contNormalization(this%gaussianComponents(i)%numCartesianOrbital))
- allocate(this%gaussianComponents(i)%primNormalization(this%gaussianComponents(i)%length, &
- this%gaussianComponents(i)%length*this%gaussianComponents(i)%numCartesianOrbital))
-
- this%gaussianComponents(i)%contNormalization = 1.0_8
- this%gaussianComponents(i)%primNormalization = 1.0_8
-
- call ContractedGaussian_normalizePrimitive(this%gaussianComponents(i))
- call ContractedGaussian_normalizeContraction(this%gaussianComponents(i))
-
- !! DEBUG
- ! call ContractedGaussian_showInCompactForm(ExternalPotential_instance%potentials(potId)%gaussianComponents(i))
-
- end do
-
- close(30)
-
- !!DONE
-
- else
-
- call ExternalPotential_exception(ERROR, &
- "The ExternalPotential file: "//trim(name)//&
- " was not found!","ExternalPotential module at Load function.")
-
- end if
-
- end subroutine ExternalPotential_load
-
-! !>
-! !! @brief
-! !! @param this
-! function ExternalPotential_getPotential( this, coords ) result(output)
-! implicit none
-! type(ExternalPotential) :: this
-! real(8) :: coords(3)
-! real(8) :: output
-
-! ! integer :: i
-
-! ! output=0.0
-
-! ! do i=1, this%gaussianComponents%length
-! ! output = output+( this%gaussianComponents%contractionCoefficients(i)* &
-! ! exp(-this%gaussianComponents%primitives(i)%orbitalExponent*( dot_product(coords,coords) ) ) )
-! ! end do
-
-! end function ExternalPotential_getPotential
-
-
-! ! function ExternalPotential_getInteractionMtx(this, contractions) result(output)
-! subroutine ExternalPotential_getInteractionMtx( this, contractions )
-! implicit none
-! type(ExternalPotential) :: this
-! type(ContractedGaussian) :: contractions(:)
-! type(Matrix) :: output
-
-! ! integer :: i, j, k, l, m, a, b
-! ! integer :: numContractions
-! ! real(8), allocatable :: auxVal(:)
-! ! type(ContractedGaussian) :: auxContract
-
-! ! do i = 1, size(contractions)
-! ! numContractions = numContractions + contractions(i)%numCartesianOrbital
-! ! end do
-
-! ! call Matrix_constructor(output,int(numContractions,8),int(numContractions,8))
-
-! ! a = 1
-! ! b = 1
-
-! ! do i=1, size(contractions)
-
-! ! call ContractedGaussian_product(contractions(i), &
-! ! this%gaussianComponents, auxContract)
-
-! ! do j=1, size(contractions)
-
-! ! call ContractedGaussian_overlapIntegral( auxContract, contractions(j), auxVal)
-
-! ! m = 0
-! ! do k = a, auxContract%numCartesianOrbital - 1
-! ! do l = b, contractions(j)%numCartesianOrbital - 1
-! ! m = m + 1
-! ! output%values(k,l)= auxVal(m)
-! ! end do
-! ! end do
-! ! b = b + contractions(j)%numCartesianOrbital
-! ! end do
-! ! a = a + auxContract%numCartesianOrbital
-! ! call ContractedGaussian_destructor(auxContract)
-! ! end do
-
-! ! call Matrix_show(output)
-
-! ! stop "ExternalPotential_getInteractionMtx"
-
-! ! ! end function ExternalPotential_getInteractionMtx
-! end subroutine ExternalPotential_getInteractionMtx
-
-
- !>
- !! @brief Maneja excepciones de la clase
- subroutine ExternalPotential_exception( typeMessage, description, debugDescription)
- implicit none
- integer :: typeMessage
- character(*) :: description
- character(*) :: debugDescription
-
- type(Exception) :: ex
-
- call Exception_constructor( ex , typeMessage )
- call Exception_setDebugDescription( ex, debugDescription )
- call Exception_setDescription( ex, description )
- call Exception_show( ex )
- call Exception_destructor( ex )
-
- end subroutine ExternalPotential_exception
-
-end module ExternalPotential_
diff --git a/src/core/GTFPotential.f90 b/src/core/GTFPotential.f90
new file mode 100644
index 00000000..4ac4b93a
--- /dev/null
+++ b/src/core/GTFPotential.f90
@@ -0,0 +1,309 @@
+!!******************************************************************************
+!! This code is part of LOWDIN Quantum chemistry package
+!!
+!! this program has been developed under direction of:
+!!
+!! Prof. A REYES' Lab. Universidad Nacional de Colombia
+!! http://www.qcc.unal.edu.co
+!! Prof. R. FLORES' Lab. Universidad de Guadajara
+!! http://www.cucei.udg.mx/~robertof
+!!
+!! Todos los derechos reservados, 2013
+!!
+!!******************************************************************************
+
+!> @brief This module contains all the routines to handle external and interal GTF potentials
+!! @author E. F. Posada (efposadac@unal.edu.co)
+!! @version 2.0
+!! Creation data : 06-08-10
+!!
+!! History change:
+!!
+!! - 06-08-10 : Sergio A. Gonzalez ( sergmonic@gmail.com )
+!! -# Creacioon del modulo y metodos basicos
+!! - 2011-02-14 : Fernando Posada ( efposadac@unal.edu.co )
+!! -# Reescribe y adapta el módulo para su inclusion en Lowdin
+!! - 2024-11-26 : Felix
+!! -# Merges ExternalPotential and InternalPotentials modules into a single file (GTFPotential)
+module GTFPotential_
+ use ContractedGaussian_
+ use String_
+ use Matrix_
+ use Units_
+ use Exception_
+ implicit none
+
+ type, public :: GaussPot
+ character(20) :: name
+ character(50) :: species
+ character(50) :: otherSpecies
+ character(50) :: ttype
+ character(50) :: units
+ integer :: numOfComponents
+ integer :: iter
+ type(ContractedGaussian), allocatable :: gaussianComponents(:)
+ end type GaussPot
+
+ type, public :: GTFPotential
+ integer :: ssize
+ type(GaussPot), allocatable :: potentials(:)
+ character(50) :: type
+ logical :: isInstanced
+ end type GTFPotential
+
+ type(GTFPotential), public, target :: ExternalPotential_instance, InterPotential_instance
+
+contains
+
+ !>
+ !! @brief Initializes the class
+ !! @param this, n
+ !! @author E. F. Posada, 2013
+ subroutine GTFPotential_constructor(this,numberOfPotentials,type)
+ implicit none
+ type(GTFPotential) :: this
+ integer :: numberOfPotentials
+ character(*) :: type
+
+
+ this%ssize = numberOfPotentials
+ allocate(this%potentials(numberOfPotentials))
+ this%isInstanced = .true.
+ this%type = type
+
+ end subroutine GTFPotential_constructor
+
+ !>
+ !! @brief Destroys the object
+ !! @param this
+ subroutine GTFPotential_destructor(this)
+ implicit none
+ type(GTFPotential) :: this
+
+ integer :: i
+
+ do i = 1, this%ssize
+ if (allocated(this%potentials(i)%gaussianComponents)) deallocate(this%potentials(i)%gaussianComponents)
+ end do
+
+ if (allocated(this%potentials) ) deallocate(this%potentials)
+ this%isInstanced=.false.
+
+ end subroutine GTFPotential_destructor
+
+ !>
+ !! @brief loads information from the input file
+ !! @param this
+ !! @author E. F. Posada, 2013
+ subroutine GTFPotential_load(this, potId, name, species, otherSpecies)
+ implicit none
+ type(GTFPotential) :: this
+ integer :: potId
+ character(*) :: name
+ character(*) :: species
+ character(*), optional :: otherSpecies
+
+ if(present(otherSpecies)) then
+ call GaussPot_load(this%potentials(potId), potId, name, species, otherSpecies)
+ else
+ call GaussPot_load(this%potentials(potId), potId, name, species)
+ end if
+ end subroutine GTFPotential_load
+
+ !>
+ !! @brief Shows information of the object
+ !! @param this
+ subroutine GTFPotential_show(this)
+ implicit none
+ type(GTFPotential) :: this
+ integer :: i, j
+
+ do i=1,this%ssize
+ if( this%potentials(i)%ttype .eq. "INTERNAL") then
+ print *,""
+ print *,"======="
+ write(*,"(A30,A)") "GTF Interparticle potential: ", trim(this%potentials(i)%name)
+ write(*,"(A4,A10,A5,A10)") "for ", trim(this%potentials(i)%species) ," and ", trim(this%potentials(i)%otherSpecies)
+ write(*,"(T10,A10,A10)") "Units:", trim(this%potentials(i)%units)
+ write(*,"(T10,A16,A16)") "Exponent", "Factor"
+ do j=1,this%potentials(i)%numOfComponents
+ write(*,"(T10,E16.8,E16.8)") this%potentials(i)%gaussianComponents(j)%orbitalExponents, &
+ this%potentials(i)%gaussianComponents(j)%contractionCoefficients(1)
+ end do
+ else if( this%potentials(i)%ttype .eq. "EXTERNAL") then
+ print *,""
+ print *,"======="
+ write(*,"(A25,A20,A5,A10)") "GTF External potential: ", trim(this%potentials(i)%name), " for ", trim(this%potentials(i)%species)
+ write(*,"(T10,A10,A10)") "Units:", trim(this%potentials(i)%units)
+ write(*,"(T10,A16,A10,A10,A10,A16)") "Exponent", "R_x", "R_y", "R_z", "Factor"
+
+ do j=1,this%potentials(i)%numOfComponents
+ write(*,"(T10,E16.8,F10.5,F10.5,F10.5,E16.8)") &
+ this%potentials(i)%gaussianComponents(j)%orbitalExponents(1), &
+ this%potentials(i)%gaussianComponents(j)%origin(:), &
+ this%potentials(i)%gaussianComponents(j)%contractionCoefficients(1)
+ end do
+ end if
+ end do
+
+ end subroutine GTFPotential_show
+
+ !>
+ !! @brief loads information from the input file
+ !! @param this
+ !! @author Felix, 2024
+ subroutine GaussPot_load(this, potId, name, species, otherSpecies)
+ type(GaussPot) :: this
+ integer :: potId
+ character(*) :: name
+ character(*) :: species
+ character(*), optional :: otherSpecies
+
+ integer :: status, i, j
+ character(150) :: fileName
+ character(20) :: token
+ character(50) :: symbol
+ logical :: existFile, found
+
+ this%name= trim(name)
+ this%species= trim(species)
+ this%units="BOHR"
+ this%numOfComponents=0
+ this%iter=1
+
+ this%ttype="EXTERNAL"
+ this%otherSpecies=""
+ if(present(otherSpecies) ) then
+ this%ttype="INTERNAL"
+ this%otherSpecies=otherSpecies
+ end if
+
+ fileName = trim( trim( CONTROL_instance%DATA_DIRECTORY ) // &
+ trim(CONTROL_instance%POTENTIALS_DATABASE)// String_getUppercase(trim(name)))
+
+ !! Open Potential file from library
+ inquire(file=trim(fileName), exist = existFile)
+ if(existFile) then
+ open(unit=30, file=trim(fileName), status="old",form="formatted")
+ else
+ !! Open Potential file from directory
+ inquire(file=trim(this%name), exist = existFile)
+ if(existFile) then
+ open(unit=30, file=trim(this%name), status="old",form="formatted")
+ else
+ !! File not found
+ call Exception_stopError("The GTFPotential file: "//trim(this%name)//&
+ " was not found!","GTFPotential module at Load function.")
+ end if
+ end if
+
+ !! Open File
+ rewind(30)
+
+ found = .false.
+
+ !! Open element and Find the proper potential
+ do while(found .eqv. .false.)
+ read(30,*, iostat=status) token
+ symbol = token(3:)
+
+ !! Some debug information in case of error!
+ if (status > 0 ) call Exception_stopError("ERROR reading InterPotential file: "//trim(this%name)//&
+ " Please check that file!","GTFPotential module at Load function.")
+
+ if (status == -1 ) call Exception_stopError("The InterPotential: "//trim(this%name)//&
+ " for: "//trim(species)//trim(otherSpecies)//&
+ " was not found!","GTFPotential module at Load function.")
+
+ if(trim(token(1:2)) == "O-") then
+ if(this%ttype=="EXTERNAL" .and. trim(symbol) == trim(species)) found = .true.
+ if(this%ttype=="INTERNAL" .and. trim(symbol) == trim(species)//trim(otherSpecies)) found = .true.
+ end if
+ end do
+
+ !! Neglect any comment
+ token = "#"
+ do while(trim(token(1:1)) == "#")
+ read(30,*) token
+ end do
+
+ !! Start reading Potential
+ backspace(30)
+ read(30,*, iostat=status) this%numOfComponents
+
+ !! Some debug information in case of error!
+ if (status > 0 ) call Exception_stopError("ERROR reading InternalPotential file: "//trim(this%name)//&
+ " Please check that file!","GTFPotential module at Load function.")
+
+ allocate(this%gaussianComponents(this%numOfComponents))
+
+ do i = 1, this%numOfComponents
+ read(30,*,iostat=status) this%gaussianComponents(i)%id, &
+ this%gaussianComponents(i)%angularMoment
+
+ if(this%gaussianComponents(i)%angularMoment .gt. 0) then
+ print *, "Warning! you provided a non-zero angular momentum for a GTFpotential ", this%name ,"this feature is not yet implemented, will be ignored and set to zeo"
+ this%gaussianComponents(i)%angularMoment=0
+ end if
+
+ this%gaussianComponents(i)%length = 1
+
+ !! Some debug information in case of error!
+ if (status > 0 ) call Exception_stopError("ERROR reading InternalPotential file: "//trim(this%name)//&
+ " Please check that file!","GTFPotential module at Load function.")
+
+ allocate(this%gaussianComponents(i)%orbitalExponents(this%gaussianComponents(i)%length))
+ allocate(this%gaussianComponents(i)%contractionCoefficients(this%gaussianComponents(i)%length))
+
+ do j = 1, this%gaussianComponents(i)%length
+
+ read(30,*,iostat=status) this%gaussianComponents(i)%orbitalExponents(j), &
+ this%gaussianComponents(i)%contractionCoefficients(j)
+ read(30,*,iostat=status) this%gaussianComponents(i)%origin
+
+ !! Some debug information in case of error!
+ if (status > 0 ) call Exception_stopError("ERROR reading InternalPotential file: "//trim(this%name)//&
+ " Please check that file!","GTFPotential module at Load function.")
+
+ end do
+
+ if(this%ttype=="INTERNAL" .and. sum(this%gaussianComponents(i)%origin(:)**2) .gt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ print *, "Warning! you provided a non-zero origin for interpotential ", this%name ,"this feature is not yet implemented, will be ignored and set to zeo"
+ this%gaussianComponents(i)%origin=0.0_8
+ end if
+
+ !! Calculates the number of Cartesian orbitals, by dimensionality
+ select case(CONTROL_instance%DIMENSIONALITY)
+ case(3)
+ this%gaussianComponents(i)%numCartesianOrbital = ( ( this%gaussianComponents(i)%angularMoment + 1_8 )*( this%gaussianComponents(i)%angularMoment + 2_8 ) ) / 2_8
+ case(2)
+ this%gaussianComponents(i)%numCartesianOrbital = ( ( this%gaussianComponents(i)%angularMoment + 1_8 ) )
+ case(1)
+ this%gaussianComponents(i)%numCartesianOrbital = 1
+ case default
+ call Exception_stopError("Class object InternalPotential in load function",&
+ "This Dimensionality is not available")
+ end select
+
+ !! Normalize
+ allocate(this%gaussianComponents(i)%contNormalization(this%gaussianComponents(i)%numCartesianOrbital))
+ allocate(this%gaussianComponents(i)%primNormalization(this%gaussianComponents(i)%length, &
+ this%gaussianComponents(i)%length*this%gaussianComponents(i)%numCartesianOrbital))
+
+ this%gaussianComponents(i)%contNormalization = 1.0_8
+ this%gaussianComponents(i)%primNormalization = 1.0_8
+
+ call ContractedGaussian_normalizePrimitive(this%gaussianComponents(i))
+ call ContractedGaussian_normalizeContraction(this%gaussianComponents(i))
+
+ !! DEBUG
+ ! call ContractedGaussian_showInCompactForm(InterPotential_instance%potentials(potId)%gaussianComponents(i))
+
+ end do
+
+ close(30)
+
+ !!DONE
+ end subroutine GaussPot_load
+
+end module GTFPotential_
diff --git a/src/core/InputCI.f90 b/src/core/InputCI.f90
index b18c7def..022d7bce 100644
--- a/src/core/InputCI.f90
+++ b/src/core/InputCI.f90
@@ -173,7 +173,7 @@ subroutine InputCI_load( numberOfSpeciesInCIinput )
"check the name of the species in the INPUT_CI block of your input file")
end if
else
- InputCI_Instance(i)%species = MolecularSystem_getNameOfSpecie(i)
+ InputCI_Instance(i)%species = MolecularSystem_getNameOfSpecies(i)
InputCI_excitation=0
if( CONTROL_instance%MP_FROZEN_CORE_BOUNDARY .ne. 0 &
.and. (trim(InputCI_Instance(i)%species) .eq. "E-" .or. trim(InputCI_Instance(i)%species) .eq. "E-ALPHA" .or. trim(InputCI_Instance(i)%species) .eq. "E-BETA")) &
diff --git a/src/core/InputManager.f90 b/src/core/InputManager.f90
index 12441097..506a89fb 100644
--- a/src/core/InputManager.f90
+++ b/src/core/InputManager.f90
@@ -23,8 +23,7 @@ module InputManager_
use Exception_
use Particle_
use MolecularSystem_
- use InterPotential_
- use ExternalPotential_
+ use GTFPotential_
implicit none
@@ -344,6 +343,9 @@ subroutine InputManager_loadGeometry()
real(8):: InputParticle_origin(3)
real(8) :: InputParticle_charge
real(8) :: InputParticle_mass
+ integer :: InputParticle_eta
+ real(8) :: InputParticle_omega
+ character(15):: InputParticle_qdoCenterOf
character(3):: InputParticle_fixedCoordinates
integer:: InputParticle_addParticles
real(8):: InputParticle_multiplicity
@@ -357,6 +359,9 @@ subroutine InputManager_loadGeometry()
InputParticle_basisSetName, &
InputParticle_charge, &
InputParticle_mass, &
+ InputParticle_eta, &
+ InputParticle_omega, &
+ InputParticle_qdoCenterOf, &
InputParticle_origin, &
InputParticle_fixedCoordinates, &
InputParticle_multiplicity, &
@@ -534,6 +539,9 @@ subroutine InputManager_loadGeometry()
InputParticle_basisSetName = "NONE"
InputParticle_charge=0.0_8
InputParticle_mass=0.0_8
+ InputParticle_eta=0
+ InputParticle_omega=0.0_8
+ InputParticle_qdoCenterOf = "NONE"
InputParticle_origin=0.0_8
InputParticle_fixedCoordinates = "NON"
InputParticle_multiplicity = 1.0_8
@@ -614,7 +622,9 @@ subroutine InputManager_loadGeometry()
spin="ALPHA", &
id = particlesID(speciesID), &
charge = InputParticle_charge, &
- mass = InputParticle_mass )
+ mass = InputParticle_mass, &
+ eta = InputParticle_eta, &
+ omega = InputParticle_omega )
!!BETA SET
speciesID = speciesID + 1
@@ -636,7 +646,9 @@ subroutine InputManager_loadGeometry()
spin="BETA", &
id = particlesID(speciesID), &
charge = InputParticle_charge, &
- mass = InputParticle_mass )
+ mass = InputParticle_mass, &
+ eta = InputParticle_eta, &
+ omega = InputParticle_omega )
else
@@ -662,7 +674,9 @@ subroutine InputManager_loadGeometry()
rotateAround=InputParticle_rotateAround,&
id = particlesID(speciesID), &
charge = InputParticle_charge, &
- mass = InputParticle_mass )
+ mass = InputParticle_mass, &
+ eta = InputParticle_eta, &
+ omega = InputParticle_omega )
end if
@@ -684,7 +698,8 @@ subroutine InputManager_loadGeometry()
rotationPoint=InputParticle_rotationPoint, &
rotateAround=InputParticle_rotateAround,&
id = counter, &
- charge = InputParticle_charge )
+ charge = InputParticle_charge, &
+ qdoCenterOf = InputParticle_qdoCenterOf )
else
!! Loads Particle
@@ -700,7 +715,8 @@ subroutine InputManager_loadGeometry()
rotationPoint=InputParticle_rotationPoint, &
rotateAround=InputParticle_rotateAround,&
id = counter, &
- charge = InputParticle_charge )
+ charge = InputParticle_charge, &
+ qdoCenterOf = InputParticle_qdoCenterOf )
end if
end if
end do
@@ -739,7 +755,7 @@ subroutine InputManager_loadPotentials()
! Load interpotentials
if(CONTROL_instance%IS_THERE_INTERPARTICLE_POTENTIAL) then
- call InterPotential_constructor(Input_instance%numberOfInterPots)
+ call GTFPotential_constructor(InterPotential_instance, Input_instance%numberOfInterPots,"INTERNAL")
!! Reload input file
rewind(4)
@@ -749,10 +765,10 @@ subroutine InputManager_loadPotentials()
read(4,NML=InterPot, iostat=stat)
if( stat > 0 ) then
- call InputManager_exception( ERROR, "check the TASKS block in your input file", "InputManager loadTask function" )
+ call InputManager_exception( ERROR, "check the INTERPOTENTIAL block in your input file", "InputManager loadTask function" )
end if
- call InterPotential_load(potId, trim(InterPot_name), trim(InterPot_specie), trim(InterPot_otherSpecie))
+ call GTFPotential_load(InterPotential_instance, potId, trim(InterPot_name), trim(InterPot_specie), trim(InterPot_otherSpecie))
end do
@@ -761,7 +777,7 @@ subroutine InputManager_loadPotentials()
! Load External Potentials
if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
- call ExternalPotential_constructor(Input_instance%numberOfExternalPots)
+ call GTFPotential_constructor(ExternalPotential_instance, Input_instance%numberOfExternalPots,"EXTERNAL")
!! Reload input file
rewind(4)
@@ -771,10 +787,10 @@ subroutine InputManager_loadPotentials()
read(4,NML=ExternalPot, iostat=stat)
if( stat > 0 ) then
- call InputManager_exception( ERROR, "check the TASKS block in your input file", "InputManager loadTask function" )
+ call InputManager_exception( ERROR, "check the EXTERPOTENTIAL block in your input file", "InputManager loadTask function" )
end if
- call ExternalPotential_load(potId, trim(ExternalPot_name), trim(ExternalPot_specie))
+ call GTFPotential_load(ExternalPotential_instance, potId, trim(ExternalPot_name), trim(ExternalPot_specie))
end do
end if
diff --git a/src/core/InterPotential.f90 b/src/core/InterPotential.f90
deleted file mode 100644
index f30008e7..00000000
--- a/src/core/InterPotential.f90
+++ /dev/null
@@ -1,298 +0,0 @@
-!!******************************************************************************
-!! This code is part of LOWDIN Quantum chemistry package
-!!
-!! this program has been developed under direction of:
-!!
-!! Prof. A REYES' Lab. Universidad Nacional de Colombia
-!! http://www.qcc.unal.edu.co
-!! Prof. R. FLORES' Lab. Universidad de Guadajara
-!! http://www.cucei.udg.mx/~robertof
-!!
-!! Todos los derechos reservados, 2013
-!!
-!!******************************************************************************
-
-!> @brief This module contains all the routines to handle inter particle potentials
-!! @author E. F. Posada (efposadac@unal.edu.co)
-!! @version 2.0
-
-module InterPotential_
- use ContractedGaussian_
- use String_
- use Exception_
- implicit none
-
- type, public :: InterPot
- character(20) :: name
- character(50) :: specie
- character(50) :: otherSpecie
- character(50) :: ttype
- character(50) :: units
- integer :: numOfComponents
- integer :: iter
- type(ContractedGaussian), allocatable :: gaussianComponents(:)
- end type
-
- type, public :: InterPotential
- integer :: ssize
- type(InterPot), allocatable :: Potentials(:)
- logical :: isInstanced
- end type
-
- type(InterPotential), public, target :: InterPotential_instance
-
-contains
-
- !>
- !! @brief Initializes the class
- !! @param this
- !! @author E. F. Posada, 2013
- subroutine InterPotential_constructor(numberOfPotentials)
- implicit none
- integer :: numberOfPotentials
-
- InterPotential_instance%ssize = numberOfPotentials
- allocate(InterPotential_instance%potentials(numberOfPotentials))
- InterPotential_instance%isInstanced = .true.
-
- end subroutine InterPotential_constructor
-
- !>
- !! @brief destroy the class
- !! @param this
- !! @author E. F. Posada, 2013
- subroutine InterPotential_destructor()
- implicit none
-
- integer :: i
-
- do i = 1, InterPotential_instance%ssize
- if (allocated(InterPotential_instance%potentials(i)%gaussianComponents) ) deallocate(InterPotential_instance%potentials(i)%gaussianComponents)
- end do
-
- if (allocated(InterPotential_instance%potentials) )deallocate(InterPotential_instance%potentials)
-
- end subroutine InterPotential_destructor
-
- !>
- !! @brief Shows information of the object
- !! @param this
- subroutine InterPotential_show()
- implicit none
- integer :: i, j
- type(InterPot), pointer :: this
-
- do i=1,InterPotential_instance%ssize
- this => InterPotential_instance%potentials(i)
- print *,""
- print *,"======="
- print *, "InterParticle Potential for ", trim(this%specie) ," and ", trim(this%otherSpecie), " : ", trim(this%name)
- print *, "Type : ", trim(this%ttype)
- write(6,"(T10,A20,A10,A10,A10,A20)") "Exponent", "l", "Factor"
- do j=1,this%numOfComponents
- write(6,"(T10,F20.15,I10,F20.15)") this%gaussianComponents(j)%orbitalExponents, &
- this%gaussianComponents(j)%angularMoment, this%gaussianComponents(j)%contractionCoefficients(1)
- end do
- end do
-
- end subroutine InterPotential_show
-
-
- !>
- !! @brief loads information from the input file
- !! @param this
- !! @author E. F. Posada, 2015
- subroutine InterPotential_load(potId, name, species, otherSpecies)
- implicit none
- integer :: potId
- character(*) :: name
- character(*) :: species
- character(*) :: otherSpecies
-
- type(InterPot), pointer :: this
- integer :: status, i, j
- character(150) :: fileName
- character(20) :: token
- character(20) :: symbol
- logical :: existFile, found
-
- this => InterPotential_instance%potentials(potId)
-
- this%name= trim(name)
- this%specie= trim(species)
- this%otherSpecie= trim(otherSpecies)
- this%ttype=""
- this%units="bohr"
- this%numOfComponents=0
- this%iter=1
-
- fileName = trim( trim( CONTROL_instance%DATA_DIRECTORY ) // &
- trim(CONTROL_instance%POTENTIALS_DATABASE)// String_getUppercase(trim(name)))
-
-
- inquire(file=trim(fileName), exist = existFile)
- if(existFile) then
-
- !! Open File
- open(unit=30, file=trim(fileName), status="old",form="formatted")
- rewind(30)
-
- found = .false.
-
- !! Open element and Find the proper potential
- do while(found .eqv. .false.)
- read(30,*, iostat=status) token
- symbol = token(3:)
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call InterPotential_exception(ERROR, &
- "ERROR reading InterPotential file: "//trim(this%name)//&
- " Please check that file!","InternalPotential module at Load function.")
-
- end if
-
- if (status == -1 ) then
-
- call InterPotential_exception(ERROR, &
- "The InterPotential: "//trim(this%name)//&
- " for: "//trim(species)//trim(otherSpecies)//&
- " was not found!","InternalPotential module at Load function.")
-
- end if
-
- if(trim(token(1:2)) == "O-") then
- if(trim(symbol) == trim(species)//trim(otherSpecies)) then
- found = .true.
-
- end if
-
- end if
-
- end do
-
- !! Neglect any comment
- token = "#"
- do while(trim(token(1:1)) == "#")
-
- read(30,*) token
-
- end do
-
- !! Start reading Potential
- backspace(30)
-
- read(30,*, iostat=status) this%numOfComponents
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call InterPotential_exception(ERROR, &
- "ERROR reading InternalPotential file: "//trim(this%name)//&
- " Please check that file!","InternalPotential module at Load function.")
-
- end if
-
- allocate(this%gaussianComponents(this%numOfComponents))
-
- do i = 1, this%numOfComponents
-
- read(30,*,iostat=status) this%gaussianComponents(i)%id, &
- this%gaussianComponents(i)%angularMoment
- this%gaussianComponents(i)%length = 1
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call InterPotential_exception(ERROR, &
- "ERROR reading InternalPotential file: "//trim(this%name)//&
- " Please check that file!","InternalPotential module at Load function.")
-
- end if
-
- allocate(this%gaussianComponents(i)%orbitalExponents(this%gaussianComponents(i)%length))
- allocate(this%gaussianComponents(i)%contractionCoefficients(this%gaussianComponents(i)%length))
-
- do j = 1, this%gaussianComponents(i)%length
-
- read(30,*,iostat=status) this%gaussianComponents(i)%orbitalExponents(j), &
- this%gaussianComponents(i)%contractionCoefficients(j)
- read(30,*,iostat=status) this%gaussianComponents(i)%origin
-
- !! Some debug information in case of error!
- if (status > 0 ) then
-
- call InterPotential_exception(ERROR, &
- "ERROR reading InternalPotential file: "//trim(this%name)//&
- " Please check that file!","InternalPotential module at Load function.")
-
- end if
-
- end do
-
-
- !! Calculates the number of Cartesian orbitals, by dimensionality
- select case(CONTROL_instance%DIMENSIONALITY)
- case(3)
- this%gaussianComponents(i)%numCartesianOrbital = ( ( this%gaussianComponents(i)%angularMoment + 1_8 )*( this%gaussianComponents(i)%angularMoment + 2_8 ) ) / 2_8
- case(2)
- this%gaussianComponents(i)%numCartesianOrbital = ( ( this%gaussianComponents(i)%angularMoment + 1_8 ) )
- case(1)
- this%gaussianComponents(i)%numCartesianOrbital = 1
- case default
- call InterPotential_exception( ERROR, &
- "Class object InternalPotential in load function",&
- "This Dimensionality is not available")
- end select
-
- !! Normalize
- allocate(this%gaussianComponents(i)%contNormalization(this%gaussianComponents(i)%numCartesianOrbital))
- allocate(this%gaussianComponents(i)%primNormalization(this%gaussianComponents(i)%length, &
- this%gaussianComponents(i)%length*this%gaussianComponents(i)%numCartesianOrbital))
-
- this%gaussianComponents(i)%contNormalization = 1.0_8
- this%gaussianComponents(i)%primNormalization = 1.0_8
-
- call ContractedGaussian_normalizePrimitive(this%gaussianComponents(i))
- call ContractedGaussian_normalizeContraction(this%gaussianComponents(i))
-
- !! DEBUG
- ! call ContractedGaussian_showInCompactForm(InterPotential_instance%potentials(potId)%gaussianComponents(i))
-
- end do
-
- close(30)
-
- !!DONE
-
- else
-
- call InterPotential_exception(ERROR, &
- "The InternalPotential file: "//trim(name)//&
- " was not found!","InternalPotential module at Load function.")
-
- end if
-
- end subroutine InterPotential_load
-
-
- !>
- !! @brief Handles class exceptions
- !<
- subroutine InterPotential_exception( typeMessage, description, debugDescription)
- implicit none
- integer :: typeMessage
- character(*) :: description
- character(*) :: debugDescription
-
- type(Exception) :: ex
-
- call Exception_constructor( ex , typeMessage )
- call Exception_setDebugDescription( ex, debugDescription )
- call Exception_setDescription( ex, description )
- call Exception_show( ex )
- call Exception_destructor( ex )
-
- end subroutine InterPotential_exception
-end module InterPotential_
diff --git a/src/core/Math.f90 b/src/core/Math.f90
index 27bb16b2..c62ca548 100644
--- a/src/core/Math.f90
+++ b/src/core/Math.f90
@@ -707,6 +707,138 @@ subroutine init_md_ftable(nmax)
end subroutine init_md_ftable
+ subroutine Math_p_polynomial_value ( m, n, x, v )
+ !*****************************************************************************80
+ !
+ !! P_POLYNOMIAL_VALUE evaluates the Legendre polynomials P(n,x).
+ !
+ ! Discussion:
+ !
+ ! P(n,1) = 1.
+ ! P(n,-1) = (-1)^N.
+ ! | P(n,x) | <= 1 in [-1,1].
+ !
+ ! The N zeroes of P(n,x) are the abscissas used for Gauss-Legendre
+ ! quadrature of the integral of a function F(X) with weight function 1
+ ! over the interval [-1,1].
+ !
+ ! The Legendre polynomials are orthogonal under the inner product defined
+ ! as integration from -1 to 1:
+ !
+ ! Integral ( -1 <= X <= 1 ) P(I,X) * P(J,X) dX
+ ! = 0 if I =/= J
+ ! = 2 / ( 2*I+1 ) if I = J.
+ !
+ ! Except for P(0,X), the integral of P(I,X) from -1 to 1 is 0.
+ !
+ ! A function F(X) defined on [-1,1] may be approximated by the series
+ ! C0*P(0,x) + C1*P(1,x) + ... + CN*P(n,x)
+ ! where
+ ! C(I) = (2*I+1)/(2) * Integral ( -1 <= X <= 1 ) F(X) P(I,x) dx.
+ !
+ ! The formula is:
+ !
+ ! P(n,x) = (1/2^N) * sum ( 0 <= M <= N/2 ) C(N,M) C(2N-2M,N) X^(N-2*M)
+ !
+ ! Differential equation:
+ !
+ ! (1-X*X) * P(n,x)'' - 2 * X * P(n,x)' + N * (N+1) = 0
+ !
+ ! First terms:
+ !
+ ! P( 0,x) = 1
+ ! P( 1,x) = 1 X
+ ! P( 2,x) = ( 3 X^2 - 1)/2
+ ! P( 3,x) = ( 5 X^3 - 3 X)/2
+ ! P( 4,x) = ( 35 X^4 - 30 X^2 + 3)/8
+ ! P( 5,x) = ( 63 X^5 - 70 X^3 + 15 X)/8
+ ! P( 6,x) = ( 231 X^6 - 315 X^4 + 105 X^2 - 5)/16
+ ! P( 7,x) = ( 429 X^7 - 693 X^5 + 315 X^3 - 35 X)/16
+ ! P( 8,x) = ( 6435 X^8 - 12012 X^6 + 6930 X^4 - 1260 X^2 + 35)/128
+ ! P( 9,x) = (12155 X^9 - 25740 X^7 + 18018 X^5 - 4620 X^3 + 315 X)/128
+ ! P(10,x) = (46189 X^10-109395 X^8 + 90090 X^6 - 30030 X^4 + 3465 X^2-63)/256
+ !
+ ! Recursion:
+ !
+ ! P(0,x) = 1
+ ! P(1,x) = x
+ ! P(n,x) = ( (2*n-1)*x*P(n-1,x)-(n-1)*P(n-2,x) ) / n
+ !
+ ! P'(0,x) = 0
+ ! P'(1,x) = 1
+ ! P'(N,x) = ( (2*N-1)*(P(N-1,x)+X*P'(N-1,x)-(N-1)*P'(N-2,x) ) / N
+ !
+ ! Licensing:
+ !
+ ! This code is distributed under the MIT license.
+ !
+ ! Modified:
+ !
+ ! 10 March 2012
+ !
+ ! Author:
+ !
+ ! John Burkardt
+ !
+ ! Reference:
+ !
+ ! Milton Abramowitz, Irene Stegun,
+ ! Handbook of Mathematical Functions,
+ ! National Bureau of Standards, 1964,
+ ! ISBN: 0-486-61272-4,
+ ! LC: QA47.A34.
+ !
+ ! Daniel Zwillinger, editor,
+ ! CRC Standard Mathematical Tables and Formulae,
+ ! 30th Edition,
+ ! CRC Press, 1996.
+ !
+ ! Parameters:
+ !
+ ! Input, integer ( kind = 4 ) M, the number of evaluation points.
+ !
+ ! Input, integer ( kind = 4 ) N, the highest order polynomial to evaluate.
+ ! Note that polynomials 0 through N will be evaluated.
+ !
+ ! Input, real ( kind = rk ) X(M), the evaluation points.
+ !
+ ! Output, real ( kind = rk ) V(M,0:N), the values of the Legendre polynomials
+ ! of order 0 through N at the points X.
+ !
+ implicit none
+
+ integer, parameter :: rk = 8
+
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ integer ( kind = 4 ) i
+ real ( kind = rk ) v(m,0:n)
+ real ( kind = rk ) x(m)
+
+ if ( n < 0 ) then
+ return
+ end if
+
+ v(1:m,0) = 1.0D+00
+
+ if ( n < 1 ) then
+ return
+ end if
+
+ v(1:m,1) = x(1:m)
+
+ do i = 2, n
+
+ v(1:m,i) = ( real ( 2 * i - 1, kind = rk ) * x(1:m) * v(1:m,i-1) &
+ - real ( i - 1, kind = rk ) * v(1:m,i-2) ) &
+ / real ( i, kind = rk )
+
+ end do
+
+ return
+ end subroutine Math_p_polynomial_value
+
!>
!! @brief Maneja excepciones de la clase
subroutine Math_exception( typeMessage, description, debugDescription)
diff --git a/src/core/MolecularSystem.f90 b/src/core/MolecularSystem.f90
index 4d4a7b68..32dced1b 100644
--- a/src/core/MolecularSystem.f90
+++ b/src/core/MolecularSystem.f90
@@ -38,8 +38,7 @@ module MolecularSystem_
use Matrix_
use Vector_
use InternalCoordinates_
- use ExternalPotential_
- use InterPotential_
+ use GTFPotential_
implicit none
type , public :: MolecularSystem
@@ -92,7 +91,6 @@ module MolecularSystem_
MolecularSystem_getMultiplicity, &
MolecularSystem_getParticlesFraction, &
MolecularSystem_getFactorOfExchangeIntegrals, &
- MolecularSystem_getNameOfSpecie, &
MolecularSystem_getNameOfSpecies, &
MolecularSystem_getSpecieID, &
MolecularSystem_getSpecieIDFromSymbol, &
@@ -199,7 +197,7 @@ subroutine MolecularSystem_build()
!!Check for input errors in the number of particles
if( (abs(int(MolecularSystem_instance%species(i)%ocupationNumber)-MolecularSystem_instance%species(i)%ocupationNumber) .gt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD)) then
- print *, "species ", trim(MolecularSystem_getNameOfSpecie(i)) , "has fractional ocupation number ", &
+ print *, "species ", trim(MolecularSystem_getNameOfSpecies(i)) , "has fractional ocupation number ", &
MolecularSystem_instance%species(i)%ocupationNumber, "please check your input addParticles and multiplicity"
call MolecularSystem_exception(ERROR, "Fractional ocupation number, imposible combination of charge and multiplicity","MolecularSystem module at build function.")
end if
@@ -238,10 +236,6 @@ subroutine MolecularSystem_destroy()
call MecanicProperties_destructor(MolecularSystem_instance%mechanicalProp)
- call ExternalPotential_destructor()
- call InterPotential_destructor()
-
-
end subroutine MolecularSystem_destroy
!>
@@ -348,9 +342,10 @@ subroutine MolecularSystem_showInformation(this)
print *," MOLECULAR SYSTEM: ",trim(system%name)
print *,"-----------------"
print *,""
- write (6,"(T5,A16,A)") "DESCRIPTION : ", trim( system%description )
- write (6,"(T5,A16,I3)") "CHARGE : ",system%charge
- write (6,"(T5,A16,A4)") "PUNTUAL GROUP : ", "NONE"
+ write (6,"(T5,A16,A)") "DESCRIPTION : ", trim( system%description )
+ write (6,"(T5,A16,I3)") "CHARGE : ",system%charge
+ write (6,"(T5,A16,F12.4)") "MASS (m_e) : ", MolecularSystem_getTotalMass(system)
+ write (6,"(T5,A16,A4)") "PUNTUAL GROUP : ", "NONE"
print *,""
@@ -387,16 +382,17 @@ subroutine MolecularSystem_showParticlesInformation(this)
!!
print *,""
print *," INFORMATION OF QUANTUM SPECIES "
- write (6,"(T5,A70)") "---------------------------------------------------------------------"
- write (6,"(T10,A2,A4,A8,A12,A4,A5,A6,A5,A4,A5,A12)") "ID", " ","Symbol", " ","mass", " ","charge", " ","spin","","multiplicity"
- write (6,"(T5,A70)") "---------------------------------------------------------------------"
+ write (6,"(T5,A85)") "------------------------------------------------------------------------------------------------------------"
+ write (6,"(T10,A2,A4,A8,A12,A4,A5,A6,A5,A6,A5,A4,A5,A12)") "ID", " ","Symbol", " ","mass", " ","charge", " ","omega","","spin","","multiplicity"
+ write (6,"(T5,A85)") "------------------------------------------------------------------------------------------------------------"
do i = 1, system%numberOfQuantumSpecies
- write (6,'(T8,I3.0,A5,A10,A5,F10.4,A5,F5.2,A5,F5.2,A5,F5.2)') &
+ write (6,'(T8,I3.0,A5,A10,A5,F10.4,A5,F5.2,A5,F5.2,A5,F5.2,A5,F5.2)') &
i, " ", &
trim(system%species(i)%symbol)," ",&
system%species(i)%mass," ",&
system%species(i)%charge, " ",&
+ system%species(i)%omega," ",&
system%species(i)%spin, "",&
system%species(i)%multiplicity
end do
@@ -419,16 +415,16 @@ subroutine MolecularSystem_showParticlesInformation(this)
print *,""
print *," BASIS SET FOR SPECIES "
- write (6,"(T7,A60)") "------------------------------------------------------------"
- write (6,"(T10,A8,A10,A8,A5,A12,A5,A9)") "Symbol", " ","N. Basis", " ","N. Particles"," ","Basis Set"
- write (6,"(T7,A60)") "------------------------------------------------------------"
+ write (6,"(T7,A70)") "----------------------------------------------------------------------"
+ write (6,"(T10,A8,A10,A8,A5,A12,A5,A20)") "Symbol", " ","N. Basis", " ","N. Particles"," ","Basis Set"
+ write (6,"(T7,A70)") "----------------------------------------------------------------------"
!! Only shows the basis-set name of the first particle by specie.
do i = 1, system%numberOfQuantumSpecies
if( system%species(i)%isElectron .and. CONTROL_instance%IS_OPEN_SHELL ) then
- write (6,'(T10,A10,A5,I8,A5,I12,A5,A10)') &
+ write (6,'(T10,A10,A5,I8,A5,I12,A5,A20)') &
trim(system%species(i)%symbol)," ",&
!MolecularSystem_getTotalNumberOfContractions(i)," ",&
system%species(i)%basisSetSize," ",&
@@ -438,7 +434,7 @@ subroutine MolecularSystem_showParticlesInformation(this)
else
- write (6,'(T10,A10,A5,I8,A5,I12,A5,A10)') &
+ write (6,'(T10,A10,A5,I8,A5,I12,A5,A20)') &
trim(system%species(i)%symbol)," ",&
!MolecularSystem_getTotalNumberOfContractions(i)," ",&
system%species(i)%basisSetSize," ",&
@@ -505,7 +501,7 @@ subroutine MolecularSystem_showParticlesInformation(this)
if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
print *,""
print *," INFORMATION OF EXTERNAL POTENTIALS "
- call ExternalPotential_show()
+ call GTFPotential_show(ExternalPotential_instance)
print *,""
print *," END INFORMATION OF EXTERNAL POTENTIALS"
print *,""
@@ -514,7 +510,7 @@ subroutine MolecularSystem_showParticlesInformation(this)
if(CONTROL_instance%IS_THERE_INTERPARTICLE_POTENTIAL) then
print *,""
print *," INFORMATION OF INTER-PARTICLE POTENTIALS "
- call InterPotential_show()
+ call GTFPotential_show(InterPotential_instance)
print *,""
print *," END INFORMATION OF INTER-PARTICLE POTENTIALS"
print *,""
@@ -659,6 +655,7 @@ subroutine MolecularSystem_saveToFile(targetFilePrefix)
end do
!! Saving Point charges
write(40,*) MolecularSystem_instance%numberOfPointCharges
+
!! Saving info of each point charge
do i = 1, MolecularSystem_instance%numberOfPointCharges
call Particle_saveToFile(MolecularSystem_instance%pointCharges(i), unit=40)
@@ -674,7 +671,7 @@ subroutine MolecularSystem_saveToFile(targetFilePrefix)
do i = 1, ExternalPotential_instance%ssize
write(40,*) i
write(40,*) ExternalPotential_instance%potentials(i)%name
- write(40,*) ExternalPotential_instance%potentials(i)%specie
+ write(40,*) ExternalPotential_instance%potentials(i)%species
end do
end if
@@ -684,8 +681,8 @@ subroutine MolecularSystem_saveToFile(targetFilePrefix)
do i = 1, InterPotential_instance%ssize
write(40,*) i
write(40,*) InterPotential_instance%potentials(i)%name
- write(40,*) InterPotential_instance%potentials(i)%specie
- write(40,*) InterPotential_instance%potentials(i)%otherSpecie
+ write(40,*) InterPotential_instance%potentials(i)%species
+ write(40,*) InterPotential_instance%potentials(i)%otherSpecies
end do
end if
@@ -953,16 +950,14 @@ subroutine MolecularSystem_loadFromFile( form, targetPrefix )
if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
read(40,*) auxValue
- call ExternalPotential_constructor(auxValue)
-
- !! FELIX TODO: create function to get potential ID
+ call GTFPotential_constructor(ExternalPotential_instance,auxValue,"EXTERNAL")
do j = 1, ExternalPotential_instance%ssize
read(40,*) i
read(40,*) name
read(40,*) species
- call ExternalPotential_load(i, name, species)
+ call GTFPotential_load(ExternalPotential_instance, i, name, species)
end do
@@ -971,7 +966,7 @@ subroutine MolecularSystem_loadFromFile( form, targetPrefix )
if(CONTROL_instance%IS_THERE_INTERPARTICLE_POTENTIAL) then
read(40,*) auxValue
- call InterPotential_constructor(auxValue)
+ call GTFPotential_constructor(InterPotential_instance,auxValue,"INTERNAL")
do j = 1, InterPotential_instance%ssize
read(40,*) i
@@ -979,7 +974,7 @@ subroutine MolecularSystem_loadFromFile( form, targetPrefix )
read(40,*) species
read(40,*) otherSpecies
- call InterPotential_load(i, name, species, otherSpecies)
+ call GTFPotential_load(InterPotential_instance, i, name, species, otherSpecies)
end do
@@ -994,52 +989,66 @@ end subroutine MolecularSystem_loadFromFile
!>
!! @brief Returns the number of quantum species in the system.
!! @author E. F. Posada, 2013
- function MolecularSystem_getNumberOfQuantumSpecies() result( output )
+ function MolecularSystem_getNumberOfQuantumSpecies(this) result( output )
implicit none
-
+ type(MolecularSystem), optional, target :: this
integer :: output
-
- output = MolecularSystem_instance%numberOfQuantumSpecies
+
+ type(MolecularSystem), pointer :: system
+
+ output = 0
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+ output = system%numberOfQuantumSpecies
end function MolecularSystem_getNumberOfQuantumSpecies
!>
!! @brief Returns the number of particles of speciesID.
!! @author E. F. Posada, 2013
- function MolecularSystem_getNumberOfParticles(speciesID) result(output)
+ function MolecularSystem_getNumberOfParticles(speciesID,this) result(output)
implicit none
-
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
integer :: output
- output = MolecularSystem_instance%species(speciesID)%internalSize
+ type(MolecularSystem), pointer :: system
+
+ output = 0
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
+ output = system%species(speciesID)%internalSize
end function MolecularSystem_getNumberOfParticles
!>
!! @brief Returns the number of shells for specie.
!! @author E. F. Posada, 2013
- function MolecularSystem_getNumberOfContractions( specieID ) result( output )
+ function MolecularSystem_getNumberOfContractions(speciesID,this) result( output )
implicit none
- integer :: specieID
+ integer :: speciesID
+ type(MolecularSystem), optional, target :: this
integer :: output
- integer :: i, j
+ type(MolecularSystem), pointer :: system
+ integer :: j
output = 0
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
-
- if ( specieID == i ) then
-
- do j = 1, size(MolecularSystem_instance%species(i)%particles)
-
- output = output + size(MolecularSystem_instance%species(i)%particles(j)%basis%contraction)
-
- end do
-
- end if
-
+ do j = 1, size(system%species(speciesID)%particles)
+ output = output + size(system%species(speciesID)%particles(j)%basis%contraction)
end do
end function MolecularSystem_getNumberOfContractions
@@ -1047,9 +1056,9 @@ end function MolecularSystem_getNumberOfContractions
!>
!! @brief Returns the number of cartesian shells for specie.
!! @author E. F. Posada, 2013
- function MolecularSystem_getTotalNumberOfContractions( specieID, this ) result( output )
+ function MolecularSystem_getTotalNumberOfContractions( speciesID, this ) result( output )
implicit none
- integer :: specieID
+ integer :: speciesID
type(MolecularSystem), optional, target :: this
type(MolecularSystem), pointer :: system
@@ -1064,14 +1073,10 @@ function MolecularSystem_getTotalNumberOfContractions( specieID, this ) result(
system=>MolecularSystem_instance
end if
- do j = 1, size(system%species(specieID)%particles)
-
- do k = 1, size(system%species(specieID)%particles(j)%basis%contraction)
-
- output = output + system%species(specieID)%particles(j)%basis%contraction(k)%numCartesianOrbital
-
+ do j = 1, size(system%species(speciesID)%particles)
+ do k = 1, size(system%species(speciesID)%particles(j)%basis%contraction)
+ output = output + system%species(speciesID)%particles(j)%basis%contraction(k)%numCartesianOrbital
end do
-
end do
end function MolecularSystem_getTotalNumberOfContractions
@@ -1152,20 +1157,29 @@ end function MolecularSystem_getMaxNumberofPrimitives
!> @brief find de maximun number of primitives for specieID, necessary for derive with libint
!! @author J.M. Rodas 2015
!! @version 1.0
- function MolecularSystem_getMaxNumberofCartesians(specieID) result(output)
+ function MolecularSystem_getMaxNumberofCartesians(speciesID,this) result(output)
implicit none
- integer :: specieID
+ integer :: speciesID
+ type(MolecularSystem), optional, target :: this
integer :: output
+ type(MolecularSystem), pointer :: system
integer :: i, j
+
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output = -1
- do i = 1, size(MolecularSystem_instance%species(specieID)%particles)
- do j = 1, size(MolecularSystem_instance%species(specieID)%particles(i)%basis%contraction)
+ do i = 1, size(system%species(speciesID)%particles)
+ do j = 1, size(system%species(speciesID)%particles(i)%basis%contraction)
- output = max(output, MolecularSystem_instance%species(specieID)%particles(i)%basis%contraction(j)%numCartesianOrbital)
+ output = max(output, system%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital)
end do
end do
@@ -1217,51 +1231,82 @@ function MolecularSystem_getEta(speciesID,this) result(output)
end function MolecularSystem_getEta
- function MolecularSystem_getLambda(speciesID) result(output)
+ function MolecularSystem_getLambda(speciesID,this) result(output)
implicit none
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
integer :: output
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output = -1
- output = MolecularSystem_instance%species(speciesID)%lambda
+ output = system%species(speciesID)%lambda
end function MolecularSystem_getLambda
- function MolecularSystem_getKappa(speciesID) result(output)
+ function MolecularSystem_getKappa(speciesID,this) result(output)
implicit none
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
integer :: output
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output = -1
- output = MolecularSystem_instance%species(speciesID)%kappa
+ output = system%species(speciesID)%kappa
end function MolecularSystem_getKappa
- function MolecularSystem_getMultiplicity(speciesID) result(output)
+ function MolecularSystem_getMultiplicity(speciesID,this) result(output)
implicit none
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
integer :: output
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output = -1
- output = MolecularSystem_instance%species(speciesID)%spin
+ output = system%species(speciesID)%spin
end function MolecularSystem_getMultiplicity
- function MolecularSystem_getParticlesFraction(speciesID) result(output)
- implicit none
-
+ function MolecularSystem_getParticlesFraction(speciesID,this) result(output)
+ implicit none
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
real(8) :: output
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output = -1
- output = MolecularSystem_instance%species(speciesID)%particlesFraction
+ output = system%species(speciesID)%particlesFraction
end function MolecularSystem_getParticlesFraction
@@ -1269,95 +1314,168 @@ end function MolecularSystem_getParticlesFraction
!> @brief Returns the charge of speciesID
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getCharge( speciesID ) result( output )
+ function MolecularSystem_getCharge(speciesID,this) result( output )
implicit none
integer :: speciesID
-
+ type(MolecularSystem), optional, target :: this
real(8) :: output
- output = MolecularSystem_instance%species(speciesID)%charge
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
+ output = system%species(speciesID)%charge
end function MolecularSystem_getCharge
+ !> @brief Returns the omega frequency of speciesID. Why we have these functions??
+ function MolecularSystem_getOmega(speciesID,this) result( output )
+ implicit none
+ integer :: speciesID
+ type(MolecularSystem), optional, target :: this
+ real(8) :: output
+
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
+ output = system%species(speciesID)%omega
+
+ end function MolecularSystem_getOmega
+
!> @brief Returns the mass of speciesID
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getMass( speciesID ) result( output )
+ function MolecularSystem_getMass(speciesID,this) result( output )
implicit none
integer :: speciesID
-
+ type(MolecularSystem), optional, target :: this
real(8) :: output
- output = MolecularSystem_instance%species(speciesID)%mass
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
+ output = system%species(speciesID)%mass
end function MolecularSystem_getMass
+
+ !> @brief Returns QDO center of quantum species
+ function MolecularSystem_getQDOcenter( speciesID ) result( origin )
+ implicit none
+ integer :: speciesID
+ integer :: i
+ logical :: centerFound
+ real(8) :: origin(3)
+
+ centerFound = .False.
+ do i = 1 , size( MolecularSystem_instance%pointCharges )
+ if ( trim(MolecularSystem_instance%pointCharges(i)%qdoCenterOf) == trim(MolecularSystem_instance%species(speciesID)%symbol) ) then
+ origin = MolecularSystem_instance%pointCharges(i)%origin
+ centerFound = .True.
+ exit
+ end if
+ end do
+ if ( .not. centerFound ) then
+ call MolecularSystem_exception(ERROR, "No QDO center for species: "//MolecularSystem_instance%species(speciesID)%symbol, "MolecularSystem_getQDOcenter" )
+ end if
+
+
+ end function MolecularSystem_getQDOCenter
+
!> @brief Returns the Factor Of Exchange Integrals
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getFactorOfExchangeIntegrals( speciesID ) result( output )
+ function MolecularSystem_getFactorOfExchangeIntegrals(speciesID,this) result( output )
implicit none
integer :: speciesID
-
+ type(MolecularSystem), optional, target :: this
real(8) :: output
- output = MolecularSystem_instance%species(speciesID)%kappa / MolecularSystem_instance%species(speciesID)%eta
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
+ output = system%species(speciesID)%kappa / system%species(speciesID)%eta
end function MolecularSystem_getFactorOfExchangeIntegrals
!> @brief Returns the name of a species
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getNameOfSpecie(speciesID) result(output)
- implicit none
-
+ function MolecularSystem_getNameOfSpecies(speciesID,this) result(output)
+ implicit none
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
character(30) :: output
- output = MolecularSystem_instance%species(speciesID)%name
-
- end function MolecularSystem_getNameOfSpecie
-
- !> @brief Returns the name of a species
- !! @author E. F. Posada, 2013
- !! @version 1.0
- function MolecularSystem_getNameOfSpecies(speciesID) result(output)
- implicit none
-
- integer :: speciesID
- character(30) :: output
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
- output = MolecularSystem_instance%species(speciesID)%name
+ output = system%species(speciesID)%name
end function MolecularSystem_getNameOfSpecies
!> @brief Returns the symbol of a species
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getSymbolOfSpecies(speciesID) result(output)
+ function MolecularSystem_getSymbolOfSpecies(speciesID,this) result(output)
implicit none
integer :: speciesID
+ type(MolecularSystem), optional, target :: this
character(30) :: output
- output = MolecularSystem_instance%species(speciesID)%symbol
+ type(MolecularSystem), pointer :: system
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
+ output = system%species(speciesID)%symbol
end function MolecularSystem_getSymbolOfSpecies
!> @brief Returns the name of a species
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getSpecieID( nameOfSpecie ) result(output)
+ function MolecularSystem_getSpecieID( nameOfSpecie,this ) result(output)
implicit none
character(*) :: nameOfSpecie
+ type(MolecularSystem), optional, target :: this
integer :: output
+
+ type(MolecularSystem), pointer :: system
integer i
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
output = 0
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
- if( trim(MolecularSystem_instance%species(i)%name) == trim(nameOfSpecie)) output = i
+ do i = 1, system%numberOfQuantumSpecies
+ if( trim(system%species(i)%name) == trim(nameOfSpecie)) output = i
end do
end function MolecularSystem_getSpecieID
@@ -1365,67 +1483,100 @@ end function MolecularSystem_getSpecieID
!> @brief Returns the name of a species
!! @author E. F. Posada, 2013
!! @version 1.0
- function MolecularSystem_getSpecieIDFromSymbol( symbolOfSpecie ) result(output)
+ function MolecularSystem_getSpecieIDFromSymbol( symbolOfSpecie,this ) result(output)
implicit none
character(*) :: symbolOfSpecie
+ type(MolecularSystem), optional, target :: this
integer :: output
+
+ type(MolecularSystem), pointer :: system
integer i
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
output = 0
- do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
- if( trim(MolecularSystem_instance%species(i)%symbol) == trim(symbolOfSpecie)) output = i
+ do i = 1, system%numberOfQuantumSpecies
+ if( trim(system%species(i)%symbol) == trim(symbolOfSpecie)) output = i
end do
end function MolecularSystem_getSpecieIDFromSymbol
!>
!! @brief calcula la energia total para una especie especificada
- function MolecularSystem_getPointChargesEnergy() result( output )
+ function MolecularSystem_getPointChargesEnergy(this) result( output )
implicit none
real(8) :: output
+ type(MolecularSystem), optional, target :: this
+ type(MolecularSystem), pointer :: system
integer :: i
integer :: j
real(8) :: deltaOrigin(3)
+
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output =0.0_8
- do i=1, size( MolecularSystem_instance%pointCharges )
- do j = i + 1 , size( MolecularSystem_instance%pointCharges )
+ do i=1, size( system%pointCharges )
+ do j = i + 1 , size( system%pointCharges )
- deltaOrigin = MolecularSystem_instance%pointCharges(i)%origin &
- - MolecularSystem_instance%pointCharges(j)%origin
+ deltaOrigin = system%pointCharges(i)%origin &
+ - system%pointCharges(j)%origin
- output=output + ( ( MolecularSystem_instance%pointCharges(i)%charge &
- * MolecularSystem_instance%pointCharges(j)%charge )&
+ output=output + ( ( system%pointCharges(i)%charge &
+ * system%pointCharges(j)%charge )&
/ sqrt( sum( deltaOrigin**2.0_8 ) ) )
end do
end do
+
+ !! Point charge potential with the external electric field
+ if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then
+ do i=1, size( system%pointCharges )
+ output = output + sum(CONTROL_instance%ELECTRIC_FIELD(:) * system%pointCharges(i)%origin(:) )* system%pointCharges(i)%charge
+ end do
+ end if
+
end function MolecularSystem_getPointChargesEnergy
- function MolecularSystem_getMMPointChargesEnergy() result( output )
+ function MolecularSystem_getMMPointChargesEnergy(this) result( output )
implicit none
real(8) :: output
-
+ type(MolecularSystem), optional, target :: this
+
+ type(MolecularSystem), pointer :: system
integer :: i
integer :: j
real(8) :: deltaOrigin(3)
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
output =0.0_8
- do i=1, size( MolecularSystem_instance%pointCharges )
- if(trim(MolecularSystem_instance%pointCharges(i)%nickname) == "PC") then
- do j = i + 1 , size( MolecularSystem_instance%pointCharges )
+ do i=1, size( system%pointCharges )
+ if(trim(system%pointCharges(i)%nickname) == "PC") then
+ do j = i + 1 , size( system%pointCharges )
- deltaOrigin = MolecularSystem_instance%pointCharges(i)%origin &
- - MolecularSystem_instance%pointCharges(j)%origin
+ deltaOrigin = system%pointCharges(i)%origin &
+ - system%pointCharges(j)%origin
- output=output + ( ( MolecularSystem_instance%pointCharges(i)%charge &
- * MolecularSystem_instance%pointCharges(j)%charge )&
+ output=output + ( ( system%pointCharges(i)%charge &
+ * system%pointCharges(j)%charge )&
/ sqrt( sum( deltaOrigin**2.0_8 ) ) )
end do
@@ -1436,35 +1587,44 @@ end function MolecularSystem_getMMPointChargesEnergy
!>
!! @brief returns an array of labels of all basis set of speciesID
- function MolecularSystem_getlabelsofcontractions(speciesID) result(output)
+ function MolecularSystem_getlabelsofcontractions(speciesID,this) result(output)
implicit none
- integer :: speciesID
character(19),allocatable :: output(:)
+ integer :: speciesID
+ type(MolecularSystem), optional, target :: this
+
+ type(MolecularSystem), pointer :: system
integer :: i, j, k
integer :: counter
character(9), allocatable :: shellCode(:)
+ if( present(this) ) then
+ system=>this
+ else
+ system=>MolecularSystem_instance
+ end if
+
if(allocated(output)) deallocate(output)
- allocate(output(MolecularSystem_getTotalNumberOfContractions(speciesID)))
+ allocate(output(MolecularSystem_getTotalNumberOfContractions(speciesID,system)))
output = ""
counter = 1
- do i = 1, size(MolecularSystem_instance%species(speciesID)%particles)
- do j = 1, size(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction)
+ do i = 1, size(system%species(speciesID)%particles)
+ do j = 1, size(system%species(speciesID)%particles(i)%basis%contraction)
if(allocated(shellCode)) deallocate(shellCode)
- allocate(shellCode(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital))
+ allocate(shellCode(system%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital))
shellCode = ""
- shellCode = ContractedGaussian_getShellCode(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j))
+ shellCode = ContractedGaussian_getShellCode(system%species(speciesID)%particles(i)%basis%contraction(j))
- do k = 1, MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital
+ do k = 1, system%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital
write (output(counter),"(I5,A1,A6,A1,A6)") counter, " ", &
- trim(MolecularSystem_instance%species(speciesID)%particles(i)%nickname), " ", &
+ trim(system%species(speciesID)%particles(i)%nickname), " ", &
trim(shellCode(k))//" "
counter = counter + 1
@@ -1500,6 +1660,74 @@ subroutine MolecularSystem_changeOrbitalOrder( coefficientsOfCombination, specie
labelsOfContractions = MolecularSystem_getlabelsofcontractions(speciesID)
if( (actualFormat.eq."LOWDIN" .and. desiredFormat.eq."MOLDEN") ) then
+ !! Swap some columns according to the molden format
+ do k=1,numberOfContractions
+ !! Take the shellcode
+ read (labelsOfContractions(k), "(I5,A1,A6,A1,A6)") counter, space, nickname, space, shellcode
+
+ !! Reorder the D functions
+ !! counter: 0, 1, 2, 3, 4, 5
+ !! Lowdin: XX, XY, XZ, YY, YZ, ZZ
+ !! Molden: XX, YY, ZZ, XY, XZ, YZ
+ !! 1-1, 2-4, 3-5, 4-2, 5-6, 6-3
+ !! 2-4, 3-5, 5-6
+
+ if ( adjustl(shellcode) == "Dxx" ) then
+ auxcounter = counter
+ !! Swap XY and YY
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+1 , auxcounter+3)
+ !! Swap XZ and ZZ
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+2 , auxcounter+5)
+ !! Swap YZ and XZ'
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+4 , auxcounter+5)
+ end if
+
+ !! Reorder the F functions
+ !! counter: 0, 1, 2, 3, 4, 5, 6, 7, 8 9
+ !! Lowdin: XXX, XXY, XXZ, XYY, XYZ, XZZ, YYY, YYZ, YZZ, ZZZ
+ !! Molden: XXX, YYY, ZZZ, XYY, XXY, XXZ, XZZ, YZZ, YYZ, XYZ
+
+ if ( adjustl(shellcode) == "Fxxx" ) then
+ auxcounter = counter
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+1 , auxcounter+6)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+2 , auxcounter+9)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+4 , auxcounter+6)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+5 , auxcounter+9)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+6 , auxcounter+9)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+7 , auxcounter+8)
+
+ end if
+
+ !! Reorder the G functions
+ !! counter: 0, 1, 2, 3, 4, 5, 6, 7, 8 9, 10, 11, 12, 13, 14
+ !! Lowdin: XXXX,XXXY,XXXZ,XXYY,XXYZ,XXZZ,XYYY,XYYZ,XYZZ,XZZZ,YYYY,YYYZ,YYZZ,YZZZ,ZZZZ
+ !!Molden15G:xxxx yyyy zzzz xxxy xxxz yyyx yyyz zzzx zzzy xxyy xxzz yyzz xxyz yyxz zzxy
+ if ( adjustl(shellcode) == "Gxxxx" ) then
+ auxcounter = counter
+ ! call Matrix_swapRows( coefficientsOfCombination, auxcounter+0 , auxcounter+0)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+1 , auxcounter+10) !XXXY->10
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+2 , auxcounter+14) !XXXZ->14
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+3 , auxcounter+10) !XXYY->10
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+4 , auxcounter+14) !XXYZ->14
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+5 , auxcounter+6) !XXZZ->6
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+6 , auxcounter+11) !XXZZ->11
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+7 , auxcounter+9) !XYYZ->9
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+8 , auxcounter+13) !XYZZ->13
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+9 , auxcounter+10) !XYYZ->10
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+10, auxcounter+11) !XYYZ->11
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+11, auxcounter+12) !XYYZ->12
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+12, auxcounter+14) !XYYZ->14
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+13, auxcounter+14) !XYZZ->14
+ ! call Matrix_swapRows( coefficientsOfCombination, auxcounter+14, auxcounter+14)
+ end if
+
+ if ( adjustl(shellcode) == "Hxxxxx" ) then
+ call MolecularSystem_exception(WARNING, "The order of the coefficients only works until G orbitals", "MolecularSystem_changeOrbitalOrder" )
+ end if
+
+ end do
+
+ else if( (actualFormat.eq."LOWDIN" .and. desiredFormat.eq."FCHK") ) then
!! Swap some columns according to the molden format
do k=1,numberOfContractions
!! Take the shellcode
@@ -1613,6 +1841,71 @@ subroutine MolecularSystem_changeOrbitalOrder( coefficientsOfCombination, specie
end do
else if( actualFormat.eq."MOLDEN" .and. desiredFormat.eq."LOWDIN") then
+ !! Swap some columns according to the molden format
+ do k=1,numberOfContractions
+ !! Take the shellcode
+ read (labelsOfContractions(k), "(I5,A1,A6,A1,A6)") counter, space, nickname, space, shellcode
+
+ !! Reorder the D functions
+ !! counter: 1, 2, 3, 4, 5, 6
+ !! Molden: XX, YY, ZZ, XY, XZ, YZ
+ !! Lowdin: XX, XY, XZ, YY, ZZ, YZ
+ !! 1-1, 2-4, 3-5, 4-2, 5-6, 6-3
+ !! 2-4, 3-5, 5-6
+
+ if ( adjustl(shellcode) == "Dxx" ) then
+ auxcounter = counter
+ !! Swap YY and XY
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+1 , auxcounter+3)
+ !! Swap ZZ and XZ
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+2 , auxcounter+4)
+ !! Swap ZZ and YZ'
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+4 , auxcounter+5)
+ end if
+
+ !! Reorder the F functions
+ !! counter: 1, 2, 3, 4, 5, 6, 7, 8 9, 10
+ !! Molden: XXX, YYY, ZZZ, XYY, XXY, XXZ, XZZ, YZZ, YYZ, XYZ
+ !! Lowdin: XXX, XXY, XXZ, XYY, XYZ, XZZ, YYY, YYZ, YZZ, ZZZ
+
+ if ( adjustl(shellcode) == "Fxxx" ) then
+ auxcounter = counter
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+1 , auxcounter+4)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+2 , auxcounter+5)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+4 , auxcounter+9)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+5 , auxcounter+6)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+6 , auxcounter+9)
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+7 , auxcounter+8)
+ end if
+ !! Reorder the G functions
+ !! counter: 0, 1, 2, 3, 4, 5, 6, 7, 8 9, 10, 11, 12, 13, 14
+ !!Molden15G:xxxx yyyy zzzz xxxy xxxz yyyx yyyz zzzx zzzy xxyy xxzz yyzz xxyz yyxz zzxy
+ !! Lowdin: XXXX,XXXY,XXXZ,XXYY,XXYZ,XXZZ,XYYY,XYYZ,XYZZ,XZZZ,YYYY,YYYZ,YYZZ,YZZZ,ZZZZ
+ if ( adjustl(shellcode) == "Gxxxx" ) then
+ auxcounter = counter
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+1 , auxcounter+3) !YYYY->3
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+2 , auxcounter+4) !ZZZZ->4
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+3 , auxcounter+9) !YYYY->9
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+4 , auxcounter+12)!ZZZZ->12
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+5 , auxcounter+10)!YYYX-10
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+6 , auxcounter+10)!YYYZ-10
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+7 , auxcounter+13)!ZZZX-13
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+8 , auxcounter+14)!ZZZY-14
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+9 , auxcounter+13)!YYYY-13
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+10, auxcounter+13)!YYYZ-13
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+11, auxcounter+13)!YYZZ-13
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+12, auxcounter+13)!ZZZZ-13
+ call Matrix_swapRows( coefficientsOfCombination, auxcounter+13, auxcounter+14)!ZZZZ-14
+ end if
+
+ if ( adjustl(shellcode) == "Hxxxxx" ) then
+ call MolecularSystem_exception(WARNING, "The order of the coefficients only works until G orbitals", "MolecularSystem_changeOrbitalOrder" )
+ end if
+
+
+ end do
+
+ else if( actualFormat.eq."FCHK" .and. desiredFormat.eq."LOWDIN") then
!! Swap some columns according to the molden format
do k=1,numberOfContractions
!! Take the shellcode
@@ -1671,7 +1964,7 @@ subroutine MolecularSystem_changeOrbitalOrder( coefficientsOfCombination, specie
end do
-
+
else
call MolecularSystem_exception(ERROR, "The desired format change from "//actualFormat//" to "//desiredFormat//"has not been implemented","MolecularSystem module at changeOrbitalOrder function.")
@@ -1684,13 +1977,14 @@ end subroutine MolecularSystem_changeOrbitalOrder
!>
!! @brief Lee la matriz de densidad y los orbitales de un archivo fchk tipo Gaussian
- subroutine MolecularSystem_readFchk( fileName, coefficients, densityMatrix, nameOfSpecies )
+ subroutine MolecularSystem_readFchk( fileName, coefficients, densityMatrix, nameOfSpecies, readSuccess )
implicit none
character(*), intent(in) :: fileName
type(Matrix), intent(inout) :: coefficients
type(Matrix), intent(inout) :: densityMatrix
character(*) :: nameOfSpecies
+ logical, optional :: readSuccess
integer :: speciesID
integer :: numberOfContractions
@@ -1711,9 +2005,15 @@ subroutine MolecularSystem_readFchk( fileName, coefficients, densityMatrix, name
speciesID=MolecularSystem_getSpecieID(nameOfSpecies)
numberOfContractions=MolecularSystem_getTotalnumberOfContractions( speciesID )
inquire(FILE = trim(fileName), EXIST = existFchk )
- if ( .not. existFchk ) call MolecularSystem_exception( ERROR, "I did not find any .fchk coefficients file", "At MolecularSystem_readFchk")
+ if ( .not. existFchk .and. present(readSuccess)) then
+ readSuccess=.false.
+ call MolecularSystem_exception( WARNING, "I did not find the "//trim(filename)//" coefficients file for "//trim(nameOfSpecies), "At MolecularSystem_readFchk")
+ return
+ end if
+ if ( .not. existFchk) then
+ call MolecularSystem_exception( ERROR, "I did not find the "//trim(filename)//" coefficients file for "//trim(nameOfSpecies), "At MolecularSystem_readFchk")
+ end if
-
fchkUnit = 50
open(unit=fchkUnit, file=filename, status="old", form="formatted", access='sequential', action='read')
@@ -1784,7 +2084,7 @@ subroutine MolecularSystem_readFchk( fileName, coefficients, densityMatrix, name
end if
end do
- call MolecularSystem_changeOrbitalOrder( coefficients, speciesID, "MOLDEN", "LOWDIN" )
+ call MolecularSystem_changeOrbitalOrder( coefficients, speciesID, "FCHK", "LOWDIN" )
! print *, "coefficients read"
! call Matrix_show(coefficients)
@@ -1802,8 +2102,8 @@ subroutine MolecularSystem_readFchk( fileName, coefficients, densityMatrix, name
! print *, "density matrix from orbitals read"
! call Matrix_show(densityMatrix)
-
close(fchkUnit)
+ if(present(readSuccess)) readSuccess=.true.
end subroutine MolecularSystem_readFchk
@@ -1846,6 +2146,7 @@ subroutine MolecularSystem_copyConstructor(this,originalThis)
this%species(i)%statistics = originalThis%species(i)%statistics
this%species(i)%charge = originalThis%species(i)%charge
this%species(i)%mass = originalThis%species(i)%mass
+ this%species(i)%omega = originalThis%species(i)%omega
this%species(i)%spin = originalThis%species(i)%spin
this%species(i)%totalCharge = originalThis%species(i)%totalCharge
this%species(i)%kappa = originalThis%species(i)%kappa
@@ -1888,6 +2189,8 @@ subroutine MolecularSystem_copyConstructor(this,originalThis)
this%allParticles(i)%particlePtr%origin=originalThis%allParticles(i)%particlePtr%origin
this%allParticles(i)%particlePtr%charge=originalThis%allParticles(i)%particlePtr%charge
this%allParticles(i)%particlePtr%mass=originalThis%allParticles(i)%particlePtr%mass
+ this%allParticles(i)%particlePtr%omega=originalThis%allParticles(i)%particlePtr%omega
+ this%allParticles(i)%particlePtr%qdoCenterOf=originalThis%allParticles(i)%particlePtr%qdoCenterOf
this%allParticles(i)%particlePtr%spin=originalThis%allParticles(i)%particlePtr%spin
this%allParticles(i)%particlePtr%totalCharge=originalThis%allParticles(i)%particlePtr%totalCharge
this%allParticles(i)%particlePtr%klamt=originalThis%allParticles(i)%particlePtr%klamt
@@ -2048,6 +2351,7 @@ subroutine MolecularSystem_mergeTwoSystems(mergedThis,thisA,thisB,sysAbasisList,
mergedThis%species(i)%statistics = thisA%species(i)%statistics
mergedThis%species(i)%charge = thisA%species(i)%charge
mergedThis%species(i)%mass = thisA%species(i)%mass
+ mergedThis%species(i)%omega = thisA%species(i)%omega
mergedThis%species(i)%spin = thisA%species(i)%spin
mergedThis%species(i)%totalCharge = thisA%species(i)%totalCharge
mergedThis%species(i)%kappa = thisA%species(i)%kappa
@@ -2090,6 +2394,8 @@ subroutine MolecularSystem_mergeTwoSystems(mergedThis,thisA,thisB,sysAbasisList,
mergedThis%pointCharges(i)%origin=thisA%pointCharges(i)%origin
mergedThis%pointCharges(i)%charge=thisA%pointCharges(i)%charge
mergedThis%pointCharges(i)%mass=thisA%pointCharges(i)%mass
+ mergedThis%pointCharges(i)%omega=thisA%pointCharges(i)%omega
+ mergedThis%pointCharges(i)%qdoCenterOf=thisA%pointCharges(i)%qdoCenterOf
mergedThis%pointCharges(i)%spin=thisA%pointCharges(i)%spin
mergedThis%pointCharges(i)%totalCharge=thisA%pointCharges(i)%totalCharge
mergedThis%pointCharges(i)%klamt=thisA%pointCharges(i)%klamt
@@ -2131,6 +2437,8 @@ subroutine MolecularSystem_mergeTwoSystems(mergedThis,thisA,thisB,sysAbasisList,
mergedThis%species(i)%particles(j)%origin=thisA%species(i)%particles(jj)%origin
mergedThis%species(i)%particles(j)%charge=thisA%species(i)%particles(jj)%charge
mergedThis%species(i)%particles(j)%mass=thisA%species(i)%particles(jj)%mass
+ mergedThis%species(i)%particles(j)%omega=thisA%species(i)%particles(jj)%omega
+ mergedThis%species(i)%particles(j)%qdoCenterOf=thisA%species(i)%particles(jj)%qdoCenterOf
mergedThis%species(i)%particles(j)%spin=thisA%species(i)%particles(jj)%spin
mergedThis%species(i)%particles(j)%totalCharge=thisA%species(i)%particles(jj)%totalCharge
mergedThis%species(i)%particles(j)%klamt=thisA%species(i)%particles(jj)%klamt
@@ -2218,6 +2526,8 @@ subroutine MolecularSystem_mergeTwoSystems(mergedThis,thisA,thisB,sysAbasisList,
mergedThis%species(i)%particles(j)%origin=thisB%species(i)%particles(jj)%origin
mergedThis%species(i)%particles(j)%charge=thisB%species(i)%particles(jj)%charge
mergedThis%species(i)%particles(j)%mass=thisB%species(i)%particles(jj)%mass
+ mergedThis%species(i)%particles(j)%omega=thisB%species(i)%particles(jj)%omega
+ mergedThis%species(i)%particles(j)%qdoCenterOf=thisB%species(i)%particles(jj)%qdoCenterOf
mergedThis%species(i)%particles(j)%spin=thisB%species(i)%particles(jj)%spin
mergedThis%species(i)%particles(j)%totalCharge=thisB%species(i)%particles(jj)%totalCharge
mergedThis%species(i)%particles(j)%klamt=thisB%species(i)%particles(jj)%klamt
@@ -2297,7 +2607,7 @@ subroutine MolecularSystem_mergeTwoSystems(mergedThis,thisA,thisB,sysAbasisList,
! if( (.not. present(sysAbasisList)) .and. (.not. present(sysBbasisList)) ) return
!!Fill the basis set lists
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, mergedThis%numberOfQuantumSpecies
call Vector_constructorInteger(sysAbasisList(speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,mergedThis), 0 )
call Vector_constructorInteger(sysBbasisList(speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,mergedThis), 0 )
@@ -2478,6 +2788,9 @@ function MolecularSystem_getTotalMass( this, unid ) result( output )
case("AMU")
output = output * AMU
+ case("DALTON")
+ output = output * DALTON
+
case default
end select
diff --git a/src/core/Particle.f90 b/src/core/Particle.f90
index 835a16d3..f927d006 100644
--- a/src/core/Particle.f90
+++ b/src/core/Particle.f90
@@ -32,6 +32,7 @@
module Particle_
use Exception_
use CONTROL_
+ use Units_
use PhysicalConstants_
use AtomicElement_
use ElementalParticle_
@@ -45,9 +46,12 @@ module Particle_
character(50) :: nickname !< Name in input file: e-(H), U-, He_4, etc.
character(10) :: statistics !< Boson / fermion
character(20) :: basisSetName !< basis set name
+ character(20) :: qdoCenterOf !< qdo center of species
real(8) :: origin(3) !< Posicion espacial
real(8) :: charge !< Carga asociada a la particula.
real(8) :: mass !< Masa asociada a la particula.
+ real(8) :: eta !< Particles per orbital
+ real(8) :: omega !< harmonic oscillator frequency
real(8) :: spin !< Especifica el espin de la particula
real(8) :: totalCharge !< Carga total asociada a la particula.
real(8) :: klamt !< Radio de Klamt asociado a la particula
@@ -81,13 +85,14 @@ module Particle_
!! -Re-written and Verified, 2013. E. F. Posada
!! @version 2.0
subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
- addParticles, subsystem, translationCenter, rotationPoint, rotateAround, spin, id, charge, mass )
+ addParticles, subsystem, translationCenter, rotationPoint, rotateAround, spin, id, charge, mass, eta, omega, qdoCenterOf )
implicit none
type(particle) :: this
character(*), intent(in) :: name
character(*), intent(in), optional :: baseName
character(*), intent(in), optional :: fix
character(*), intent(in), optional :: spin
+ character(*), intent(in), optional :: qdoCenterOf
real(8), intent(in), optional :: origin(3)
real(8), intent(in), optional :: multiplicity
integer, intent(in), optional :: addParticles
@@ -98,12 +103,15 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
integer, intent(in) :: id
real(8), intent(in), optional :: charge
real(8), intent(in), optional :: mass
+ integer, intent(in), optional :: eta
+ real(8), intent(in), optional :: omega
type(AtomicElement) :: element
type(ElementalParticle) :: eparticle
character(3) :: varsToFix
character(5) :: massNumberString
character(5) :: elementSymbol
+ character(15) :: auxqdoCenterOf
integer :: i
integer :: j
integer :: massNumber
@@ -115,6 +123,8 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
real(8) :: auxOrigin(3)
real(8) :: auxCharge
real(8) :: auxMass
+ integer :: auxEta
+ real(8) :: auxOmega
real(8) :: auxMultiplicity
logical :: isDummy
logical :: isElectron
@@ -130,6 +140,15 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
auxMass=0.0_8
if ( present(mass) ) auxMass= mass
+
+ auxEta=0
+ if ( present(eta) ) auxEta= eta
+
+ auxOmega=0.0_8
+ if ( present(omega) ) auxOmega= omega
+
+ auxqdoCenterOf= "NONE"
+ if ( present( qdoCenterOf ) ) auxqdoCenterOf = qdoCenterOf
auxMultiplicity=1.0_8
if ( present(multiplicity) ) auxMultiplicity=multiplicity
@@ -207,6 +226,8 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
origin=auxOrigin, &
charge=auxCharge, &
mass=auxMass, &
+ eta=auxEta, &
+ omega=auxOmega, &
basisSetName=trim(baseName), &
elementSymbol=trim(elementSymbol), &
isDummy= isDummy, &
@@ -296,6 +317,8 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
origin = auxOrigin,&
charge = auxCharge,&
mass = auxMass,&
+ eta=auxEta, &
+ omega=auxOmega, &
basisSetName = trim(baseName), &
elementSymbol = trim(elementSymbol), &
isDummy = isDummy, &
@@ -316,10 +339,10 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
this%charge = element%atomicNumber
end if
- if ( auxMass == 0.0_8) then
- this%mass = element%massicNumber * PhysicalConstants_NEUTRON_MASS &
+ if ( auxMass .eq. 0.0_8 .and. element%atomicWeight .eq. 0.0_8 ) &
+ this%mass = element%massicNumber * PhysicalConstants_NEUTRON_MASS &
+ element%atomicNumber * (PhysicalConstants_PROTON_MASS - PhysicalConstants_NEUTRON_MASS)
- end if
+ if ( auxMass .eq. 0.0_8 ) this%mass = element%atomicWeight*DALTON - element%atomicNumber*PhysicalConstants_ELECTRON_MASS
this%totalCharge = element%atomicNumber
this%internalSize = 1 + auxAdditionOfParticles
@@ -379,8 +402,14 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
this%charge = element%atomicNumber
this%totalCharge = element%atomicNumber
end if
- this%mass = element%massicNumber * PhysicalConstants_NEUTRON_MASS &
- + element%atomicNumber * (PhysicalConstants_PROTON_MASS - PhysicalConstants_NEUTRON_MASS)
+
+
+ if ( element%atomicWeight .eq. 0.0_8 ) then
+ this%mass = element%massicNumber * PhysicalConstants_NEUTRON_MASS &
+ + element%atomicNumber * (PhysicalConstants_PROTON_MASS - PhysicalConstants_NEUTRON_MASS)
+ else
+ this%mass = element%atomicWeight*DALTON - element%atomicNumber*PhysicalConstants_ELECTRON_MASS
+ end if
this%internalSize = 1 + auxAdditionOfParticles
this%id = id
@@ -414,7 +443,8 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
rotationPoint=auxRotationPoint, &
rotateAround=auxRotateAround,&
charge=auxCharge, &
- nickname=trim(element%symbol))
+ nickname=trim(element%symbol), &
+ qdoCenterOf = auxqdoCenterOf)
call Particle_setComponentFixed(this, varsToFix )
@@ -424,8 +454,14 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
if ( auxCharge == 0.0_8) then
this%charge = element%atomicNumber
end if
- this%mass = element%massicNumber * PhysicalConstants_NEUTRON_MASS &
- + element%atomicNumber * (PhysicalConstants_PROTON_MASS - PhysicalConstants_NEUTRON_MASS)
+
+ if ( element%atomicWeight .eq. 0.0_8 ) then
+ this%mass = element%massicNumber * PhysicalConstants_NEUTRON_MASS &
+ + element%atomicNumber * (PhysicalConstants_PROTON_MASS - PhysicalConstants_NEUTRON_MASS)
+ else
+ this%mass = element%atomicWeight*DALTON - element%atomicNumber*PhysicalConstants_ELECTRON_MASS
+ end if
+
this%totalCharge = element%atomicNumber
this%internalSize = 1 + auxAdditionOfParticles
this%id = id
@@ -453,12 +489,20 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
else if ( present(baseName) .and. trim(baseName) /= "DIRAC" .and. trim(baseName) /= "MM") then
call ElementalParticle_load( eparticle, trim(name) )
+
+ if(eparticle%custom .and. auxMass .ne. 0.0_8 .and. auxCharge .ne. 0.0_8) &
+ print *, "I'm loading a custom particle from the input", trim(name), "with mass", auxMass, "and charge", auxCharge
+ if(eparticle%custom .and. auxMass .eq. 0.0_8 .and. auxCharge .eq. 0.0_8) &
+ call Particle_exception( ERROR, "Elemental particle: "//trim(name)//&
+ " NOT found in ElementalParticles.lib. If you want to use a custom particle, provide at least its mass and charge in the input", "In Particle_load routine")
call Particle_build( this = this, &
isQuantum = .true., &
origin = auxOrigin, &
charge = auxCharge, &
mass = auxMass, &
+ eta=auxEta, &
+ omega = auxOmega, &
basisSetName = trim(baseName), &
elementSymbol = trim(elementSymbol), &
isDummy = isDummy, &
@@ -537,7 +581,8 @@ subroutine Particle_load( this, name, baseName, origin, fix, multiplicity, &
rotationPoint=auxRotationPoint, &
rotateAround=auxRotateAround,&
owner=id, &
- nickname=trim(eparticle%symbol))
+ nickname=trim(eparticle%symbol), &
+ qdoCenterOf = auxqdoCenterOf )
call Particle_setComponentFixed(this, varsToFix )
@@ -569,7 +614,7 @@ end subroutine Particle_load
!! @param this Quantum particle or point charge
!! @author S. A. Gonzalez (before known as Particle_constructor)
subroutine Particle_build( this, name, symbol, basisSetName, elementSymbol, nickname, &
- origin, mass, charge, totalCharge, spin, &
+ origin, mass, eta, omega, qdoCenterOf, charge, totalCharge, spin, &
owner, subsystem, translationCenter, rotationPoint, rotateAround, massNumber, isQuantum, isDummy)
implicit none
@@ -580,8 +625,11 @@ subroutine Particle_build( this, name, symbol, basisSetName, elementSymbol, nick
character(*), optional, intent(in) :: basisSetName
character(*), optional, intent(in) :: elementSymbol
character(*), optional, intent(in) :: nickname
+ character(*), optional, intent(in) :: qdoCenterOf
real(8), optional, intent(in) :: origin(3)
real(8), optional, intent(in) :: mass
+ integer, optional, intent(in) :: eta
+ real(8), optional, intent(in) :: omega
real(8), optional, intent(in) :: charge
real(8), optional, intent(in) :: totalCharge
real(8), optional, intent(in) :: spin
@@ -602,6 +650,9 @@ subroutine Particle_build( this, name, symbol, basisSetName, elementSymbol, nick
this%isQuantum = .false.
this%origin = 0.0_8
this%mass = PhysicalConstants_ELECTRON_MASS
+ this%eta = 0
+ this%omega = 0.0_8
+ this%qdoCenterOf = "NONE"
this%charge = PhysicalConstants_ELECTRON_CHARGE
this%totalCharge = PhysicalConstants_ELECTRON_CHARGE
this%name = "ELECTRON"
@@ -625,6 +676,9 @@ subroutine Particle_build( this, name, symbol, basisSetName, elementSymbol, nick
!! Loads optional information
if ( present(origin) ) this%origin = origin
if ( present( mass ) ) this%mass = mass
+ if ( present( eta ) ) this%eta = eta
+ if ( present( omega ) ) this%omega = omega
+ if ( present( qdoCenterOf ) ) this%qdoCenterOf = qdoCenterOf
if ( present(charge) ) this%charge = charge
if ( present(totalCharge)) then
this%totalCharge = totalCharge
@@ -695,9 +749,12 @@ subroutine Particle_destroy( this )
this%nickname = "NONE"
this%statistics = "NONE"
this%basisSetName = "NONE"
+ this%qdoCenterOf = "NONE"
this%origin = 0.0_8
this%charge = 0
this%mass = 0.0_8
+ this%eta = 0
+ this%omega = 0.0_8
this%spin = 0.0_8
this%totalCharge = 0
this%isQuantum = .false.
@@ -735,6 +792,9 @@ subroutine Particle_show( this )
write (6,"(T10,A16,I8)") "Owner : ",this%owner
write (6,"(T10,A16,F8.2)") "Charge : ",this%charge
write (6,"(T10,A16,F8.2)") "Mass : ",this%mass
+ write (6,"(T10,A16,I8)") "Eta : ",this%eta
+ write (6,"(T10,A16,F8.2)") "Omega : ",this%omega
+ write (6,"(T10,A16,F8.2)") "QDO center of : ",this%qdoCenterOf
write (6,"(T10,A16,F8.2)") "Spin : ",this%spin
write (6,"(T10,A16,F8.2)") "Klamt radius : ",this%klamt
write (6,"(T10,A16,F8.2)") "vanderWaals radius : ",this%vanderWaalsRadio
@@ -801,6 +861,9 @@ subroutine Particle_saveToFile( this, unit )
write(unit,*) this%origin
write(unit,*) this%charge
write(unit,*) this%mass
+ write(unit,*) this%eta
+ write(unit,*) this%omega
+ write(unit,*) this%qdoCenterOf
write(unit,*) this%spin
write(unit,*) this%totalCharge
write(unit,*) this%isQuantum
@@ -859,6 +922,9 @@ subroutine Particle_loadFromFile( this, unit )
read(unit,*) this%origin
read(unit,*) this%charge
read(unit,*) this%mass
+ read(unit,*) this%eta
+ read(unit,*) this%omega
+ read(unit,*) this%qdoCenterOf
read(unit,*) this%spin
read(unit,*) this%totalCharge
read(unit,*) this%isQuantum
diff --git a/src/core/ParticleManager.f90 b/src/core/ParticleManager.f90
index 30ea6f79..2e28190e 100644
--- a/src/core/ParticleManager.f90
+++ b/src/core/ParticleManager.f90
@@ -555,7 +555,7 @@ end function ParticleManager_isCenterOfOptimization
! !! @brief Retorna un ID asociado a la especie especificada
! !!
! !>
- ! function ParticleManager_getNameOfSpecie( specieID ) result( output )
+ ! function ParticleManager_getNameOfSpecies( specieID ) result( output )
! implicit none
! integer, intent(in) :: specieID
! character(30) :: output
@@ -566,10 +566,10 @@ end function ParticleManager_isCenterOfOptimization
! else
! call ParticleManager_exception( ERROR, "You should instance the ParticleManager before use this function", &
- ! "Class object ParticleManager in the getNameOfSpecie function")
+ ! "Class object ParticleManager in the getNameOfSpecies function")
! end if
- ! end function ParticleManager_getNameOfSpecie
+ ! end function ParticleManager_getNameOfSpecies
! !<
! !! @brief Retorna un iterador a laprimera especie en el sistema molecular
diff --git a/src/core/ReadTransformedIntegrals.f90 b/src/core/ReadTransformedIntegrals.f90
index 8e23b272..aaab130e 100644
--- a/src/core/ReadTransformedIntegrals.f90
+++ b/src/core/ReadTransformedIntegrals.f90
@@ -76,7 +76,7 @@ subroutine ReadTransformedIntegrals_readOneSpecies( specieID, matrixContainer )
real(8) :: auxIntegralValue
numberOfContractions = max( MolecularSystem_getTotalNumberOfContractions(specieID), MolecularSystem_getOcupationNumber( specieID ))
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
prefixOfFile =""//trim(nameOfSpecie)
@@ -365,8 +365,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
+ MolecularSystem_getTotalNumberOfContractions(otherSpecieID)
bias = MolecularSystem_getTotalNumberOfContractions(specieID)
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)
@@ -451,8 +451,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
+ MolecularSystem_getTotalNumberOfContractions(otherSpecieID)
bias = MolecularSystem_getTotalNumberOfContractions(otherSpecieID)
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie)
@@ -542,8 +542,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
+ MolecularSystem_getTotalNumberOfContractions(otherSpecieID)
bias = MolecularSystem_getTotalNumberOfContractions(specieID)
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)
@@ -618,8 +618,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
ssize2a = ( ssizea * (ssizea + 1 ) ) / 2_8
ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)
@@ -673,8 +673,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie)
@@ -726,8 +726,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
+ MolecularSystem_getTotalNumberOfContractions(otherSpecieID)
bias = MolecularSystem_getTotalNumberOfContractions(specieID)
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)
@@ -764,8 +764,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
+ MolecularSystem_getTotalNumberOfContractions(otherSpecieID)
bias = MolecularSystem_getTotalNumberOfContractions(specieID)
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie)
unidOfOutputForIntegrals = CONTROL_instance%UNIT_FOR_MP2_INTEGRALS_FILE
@@ -818,8 +818,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
ssize2a = ( ssizea * (ssizea + 1 ) ) / 2_8
ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)
@@ -877,8 +877,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat
ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8
- nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) )
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) )
+ nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) )
prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie)
unidOfOutputForIntegrals = CONTROL_instance%UNIT_FOR_MP2_INTEGRALS_FILE
diff --git a/src/core/Solver.f90 b/src/core/Solver.f90
index db2d73d1..804d6d66 100644
--- a/src/core/Solver.f90
+++ b/src/core/Solver.f90
@@ -29,16 +29,9 @@ module Solver_
use InputManager_
implicit none
- type, public :: Solver
- logical :: withProperties
- end type Solver
-
public :: &
Solver_run
- !> Singleton lock
- type(Solver), public :: lowdin_solver
-
contains
!>
@@ -70,23 +63,40 @@ subroutine Solver_run( )
!!calculate HF/KS HF/KS properties
call system ("lowdin-CalcProp.x")
+
+ !Check for inconsistent methods
+ if ( (CONTROL_instance%MOLLER_PLESSET_CORRECTION /= 0 .or. &
+ CONTROL_instance%EPSTEIN_NESBET_CORRECTION /= 0 .or. &
+ CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL /= "NONE" .or. &
+ CONTROL_instance%PT_ORDER /= 0) .and. &
+ (trim(CONTROL_instance%METHOD) .eq. "RKS" .or. trim(CONTROL_instance%METHOD) .eq. "UKS")) then
+ print *, "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+ call Solver_exception(WARNING, "You have selected a post-HF calculation that probably doesn't make sense with a KS reference."// &
+ " The calculation will proceed but be mindful of the results", "At Solver module in run function")
+ print *, "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+
+ end if
+
+ if ( (CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL /= "NONE" .or. CONTROL_instance%PT_ORDER .ge. 3) .and. &
+ trim(CONTROL_instance%METHOD) .ne. "UHF" ) then
+ print *, "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+ call Solver_exception(WARNING, "CI calculations have been tested only for UHF. You have selected "//trim(CONTROL_instance%METHOD)//&
+ " The calculation will proceed but be mindful of the results", "At Solver module in run function")
+ print *, "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+ end if
!Post SCF corrections
if ( CONTROL_instance%MOLLER_PLESSET_CORRECTION /= 0 .or. &
CONTROL_instance%EPSTEIN_NESBET_CORRECTION /= 0 .or. &
CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL /= "NONE" .or. &
- CONTROL_instance%PT_ORDER /= 0) then
- call system("lowdin-integralsTransformation.x")
- end if
+ CONTROL_instance%PT_ORDER /= 0) call system("lowdin-integralsTransformation.x")
- if ( CONTROL_instance%MOLLER_PLESSET_CORRECTION /= 0 ) then
- call system("lowdin-MBPT.x CONTROL_instance%MOLLER_PLESSET_CORRECTION")
- end if
+ if ( CONTROL_instance%MOLLER_PLESSET_CORRECTION /= 0 ) call system("lowdin-MBPT.x CONTROL_instance%MOLLER_PLESSET_CORRECTION")
- if ( CONTROL_instance%EPSTEIN_NESBET_CORRECTION /= 0 ) then
- call system("lowdin-MBPT.x CONTROL_instance%EPSTEIN_NESBET_CORRECTION")
- end if
-
+ if ( CONTROL_instance%EPSTEIN_NESBET_CORRECTION /= 0 ) call system("lowdin-MBPT.x CONTROL_instance%EPSTEIN_NESBET_CORRECTION")
+
+ if ( CONTROL_instance%PT_ORDER /= 0 ) call system("lowdin-PT.x CONTROL_instance%PT_ORDER")
+
if ( CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL /= "NONE" ) then
write(auxString,"(I10)") Input_instance%numberOfSpeciesInCI
call system("lowdin-CI.x" //trim(auxString))
@@ -97,22 +107,15 @@ subroutine Solver_run( )
if ( CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION ) then
call system("lowdin-NOCI.x POSTSCF")
!!calculate CI density properties
- call system ("lowdin-CalcProp.x")
+ if ( .not. (CONTROL_instance%COMPUTE_ROCI_FORMULA .or. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS)) call system ("lowdin-CalcProp.x")
end if
- if ( CONTROL_instance%PT_ORDER /= 0 ) then
- call system("lowdin-PT.x CONTROL_instance%PT_ORDER")
- end if
-
- ! lowdin_solver%withProperties = .false.
! if(optimization) then
! call system("lowdin-Optimizer.x")
! else
! end if
end subroutine Solver_run
-
-
!>
!! @brief Manejo de excepciones
diff --git a/src/core/Species.f90 b/src/core/Species.f90
index e4a1a1a0..e4d0de4c 100644
--- a/src/core/Species.f90
+++ b/src/core/Species.f90
@@ -45,6 +45,7 @@ module Species_
character(10) :: statistics !< Boson / fermion
real(8) :: charge !< Carga asociada a la especie.
real(8) :: mass !< Masa asociada a la particula.
+ real(8) :: omega !< harmonic oscillator frequency
real(8) :: spin !< Especifica el espin de la especie
real(8) :: totalCharge !< Carga total asociada a la especie.
real(8) :: kappa
@@ -92,9 +93,9 @@ subroutine Species_setSpecie( this, speciesID)
if(trim(this%statistics) == "FERMION") then
this%kappa = -1.0_8
- this%eta = 2.0_8
- this%lambda = 2.0_8
- this%particlesFraction = 0.5_8
+ this%eta = 1.0_8
+ this%lambda = 1.0_8
+ this%particlesFraction = 1.0_8
else
@@ -143,10 +144,20 @@ subroutine Species_setSpecie( this, speciesID)
this%charge = this%particles(1)%charge
!! Adjust mass
this%mass = this%particles(1)%mass
+ !! Adjust harmonic frequency
+ this%omega = this%particles(1)%omega
!! Adjust spin
this%spin = this%particles(1)%spin
!! Adjust multiplicity
this%multiplicity = this%multiplicity + 1
+
+ !! Adjust eta
+ if(this%particles(1)%eta .ne. 0) then
+ this%eta = this%particles(1)%eta
+ this%lambda = this%particles(1)%eta
+ this%particlesFraction = 1.0_8/this%particles(1)%eta
+ end if
+
!! Adjust Occupation number
this%ocupationNumber = this%ocupationNumber * this%particlesFraction
@@ -174,6 +185,7 @@ subroutine Species_saveToFile(this, unit)
write(unit,*) this%statistics
write(unit,*) this%charge
write(unit,*) this%mass
+ write(unit,*) this%omega
write(unit,*) this%spin
write(unit,*) this%totalCharge
write(unit,*) this%kappa
@@ -211,6 +223,7 @@ subroutine Species_loadFromFile(this, unit)
read(unit,*) this%statistics
read(unit,*) this%charge
read(unit,*) this%mass
+ read(unit,*) this%omega
read(unit,*) this%spin
read(unit,*) this%totalCharge
read(unit,*) this%kappa
diff --git a/src/core/Units.f90 b/src/core/Units.f90
index 3a51a81d..7f111dde 100644
--- a/src/core/Units.f90
+++ b/src/core/Units.f90
@@ -38,6 +38,7 @@ module Units_
real(8) , parameter :: DEBYES = 2.541764_8
real(8) , parameter :: ELECTRON_REST = 1.0_8
real(8) , parameter :: AMU = 1.0_8/1822.88850065855_8
+ real(8) , parameter :: DALTON = 1822.88850065855_8
real(8) , parameter :: kg = 9.109382616D-31
real(8) , parameter :: DEGREES = 57.29577951_8
real(8) , parameter :: CM_NEG1 = 219476.0_8
diff --git a/src/core/Vector.f90 b/src/core/Vector.f90
index b199c8a9..e74a7f9a 100644
--- a/src/core/Vector.f90
+++ b/src/core/Vector.f90
@@ -91,6 +91,8 @@ module Vector_
Vector_reverseSortElements, &
Vector_reverseSortElements8, &
Vector_reverseSortElements8Int, &
+ Vector_reverseSortElementsAbsolute8, &
+ Vector_sortElementsAbsolute8, &
Vector_swapElements, &
Vector_getSize, &
Vector_getElement, &
@@ -1512,6 +1514,114 @@ subroutine Vector_reverseSortElements8(this,indexVector,m)
end subroutine Vector_reverseSortElements8
+ subroutine Vector_reverseSortElementsAbsolute8(this,indexVector,m)
+ type(Vector8) :: this
+ type(IVector8), optional :: indexVector
+ integer(8), optional :: m
+ integer(8) i,j,n
+
+ n = Vector_getSize8(this)
+ if ( .not. present (indexVector) ) then
+ do i=1,n
+ do j=i+1,n
+ if ( abs(this%values(j)).lt. abs(this%values(i)) ) then
+ call Vector_swapElements8( this, i, j )
+ end if
+ end do
+ end do
+ else
+
+ if ( .not. present (m) ) then
+
+ do i=1,n
+ indexVector%values(i) = i
+ end do
+
+ do i=1,n
+ do j=i+1,n
+ if ( abs(this%values(j)).lt. abs(this%values(i)) ) then
+ call Vector_swapElements8( this, i, j )
+ call Vector_swapIntegerElements8( indexVector, i, j )
+ end if
+ end do
+ end do
+ else
+
+ do i=1,n
+ indexVector%values(i) = i
+ end do
+
+ do i=1,m
+ do j=i+1,n
+ if ( abs(this%values(j)).lt.abs(this%values(i))) then
+ call Vector_swapElements8( this, i, j )
+ call Vector_swapIntegerElements8( indexVector, i, j )
+ end if
+ end do
+ end do
+ end if
+ end if
+
+ end subroutine Vector_reverseSortElementsAbsolute8
+
+ subroutine Vector_sortElementsAbsolute8(this,indexVector,m)
+ type(Vector8) :: this
+ type(IVector8), optional :: indexVector
+ integer(8), optional :: m
+ integer(8) i,j,n
+ real(8) :: timeA, timeB
+
+!$ timeA = omp_get_wtime()
+
+ n = Vector_getSize8(this)
+ if ( .not. present (indexVector) ) then
+ do i=1,n
+ do j=i+1,n
+ if ( abs(this%values(j)).gt. abs(this%values(i)) ) then
+ call Vector_swapElements8( this, i, j )
+ end if
+ end do
+ end do
+ else
+
+ if ( .not. present (m) ) then
+
+ do i=1,n
+ indexVector%values(i) = i
+ end do
+
+ do i=1,n
+ do j=i+1,n
+ if ( abs(this%values(j)).gt. abs(this%values(i)) ) then
+ call Vector_swapElements8( this, i, j )
+ call Vector_swapIntegerElements8( indexVector, i, j )
+ end if
+ end do
+ end do
+ else
+
+ !do i=1,n
+ ! indexVector%values(i) = i
+ !end do
+
+ do i=1,m
+ do j=i+1,n
+ if ( abs(this%values(j)).gt.abs(this%values(i))) then
+ call Vector_swapElements8( this, i, j )
+ call Vector_swapIntegerElements8( indexVector, i, j )
+ end if
+ end do
+ end do
+ end if
+ end if
+
+!$ timeB = omp_get_wtime()
+!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for sorting the vector : ", timeB - timeA ," (s)"
+
+ end subroutine Vector_sortElementsAbsolute8
+
+
+
subroutine Vector_reverseSortElements8Int(this,indexVector,m)
type(IVector8) :: this
type(IVector8), optional :: indexVector
diff --git a/src/integralsTransformation/IntegralTransformation.f90 b/src/integralsTransformation/IntegralTransformation.f90
index 1e761928..26d85017 100644
--- a/src/integralsTransformation/IntegralTransformation.f90
+++ b/src/integralsTransformation/IntegralTransformation.f90
@@ -170,7 +170,7 @@ program IntegralsTransformation
do i=1, numberOfQuantumSpecies
- nameOfSpecies = trim( MolecularSystem_getNameOfSpecie( i ) )
+ nameOfSpecies = trim( MolecularSystem_getNameOfSpecies( i ) )
!! For PT = 2 there is no need to transform integrals for all species"
if ( partialTransform == "PT2" .and. CONTROL_instance%IONIZE_SPECIES(1) /= "NONE" ) then
@@ -195,7 +195,7 @@ program IntegralsTransformation
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(i)
occupation = MolecularSystem_getOcupationNumber( i )
- arguments(2) = MolecularSystem_getNameOfSpecie(i)
+ arguments(2) = MolecularSystem_getNameOfSpecies(i)
arguments(1) = "COEFFICIENTS"
eigenVec= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
@@ -253,7 +253,7 @@ program IntegralsTransformation
!!
if ( numberOfQuantumSpecies > 1 ) then
do j = i + 1 , numberOfQuantumSpecies
- nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( j ) )
+ nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( j ) )
!! For PT = 2 there is no need to transform integrals for all species"
if ( partialTransform == "PT2" .and. CONTROL_instance%IONIZE_SPECIES(1) /= "NONE" ) then
@@ -280,7 +280,7 @@ program IntegralsTransformation
numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( j )
otherOccupation = MolecularSystem_getOcupationNumber( j )
- arguments(2) = trim(MolecularSystem_getNameOfSpecie(j))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(j))
arguments(1) = "COEFFICIENTS"
eigenVecOtherSpecie = &
diff --git a/src/integralsTransformation/TransformIntegralsC.f90 b/src/integralsTransformation/TransformIntegralsC.f90
index ad0d62eb..cadbdb8a 100644
--- a/src/integralsTransformation/TransformIntegralsC.f90
+++ b/src/integralsTransformation/TransformIntegralsC.f90
@@ -1716,8 +1716,8 @@ subroutine TransformIntegralsC_checkInterMOIntegralType(speciesID, otherSpeciesI
ionizeA = .false.
ionizeB = .false.
- nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) )
- nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) )
+ nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) )
+ nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) )
do s = 1, size(CONTROL_instance%IONIZE_SPECIES )
if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then
@@ -1843,8 +1843,8 @@ subroutine TransformIntegralsC_checkInterMOIntegralType(speciesID, otherSpeciesI
ionizeA = .false.
ionizeB = .false.
- nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) )
- nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) )
+ nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) )
+ nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) )
do s = 1, size(CONTROL_instance%IONIZE_SPECIES )
if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then
@@ -1979,7 +1979,7 @@ subroutine TransformIntegralsC_getNumberOfNonZeroRepulsionIntegrals( specieID, n
sfile = trim(adjustl(sfile))
unit = ifile+50
- nameOfSpecie = MolecularSystem_getNameOfSpecie( specieID )
+ nameOfSpecie = MolecularSystem_getNameOfSpecies( specieID )
if ( trim(nameOfSpecie) == "E-BETA" ) nameOfSpecie =""//trim("E-ALPHA")
@@ -2009,8 +2009,8 @@ subroutine TransformIntegralsC_getNumberOfNonZeroCouplingIntegrals( i, j, nproc
sfile = trim(adjustl(sfile))
unit = ifile+50
- nameOfSpecie = MolecularSystem_getNameOfSpecie( i )
- nameOfOtherSpecie = MolecularSystem_getNameOfSpecie( j )
+ nameOfSpecie = MolecularSystem_getNameOfSpecies( i )
+ nameOfOtherSpecie = MolecularSystem_getNameOfSpecies( j )
open( UNIT=unit,FILE=trim(sfile)//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)//".nints", status='old',access='sequential', form='Unformatted')
diff --git a/src/integralsTransformation/TransformIntegralsE.f90 b/src/integralsTransformation/TransformIntegralsE.f90
index e001e01e..b22c940b 100644
--- a/src/integralsTransformation/TransformIntegralsE.f90
+++ b/src/integralsTransformation/TransformIntegralsE.f90
@@ -2149,8 +2149,8 @@ subroutine TransformIntegralsE_checkInterMOIntegralType(speciesID, otherSpeciesI
ionizeA = .false.
ionizeB = .false.
- nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) )
- nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) )
+ nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) )
+ nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) )
do s = 1, size(CONTROL_instance%IONIZE_SPECIES )
if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then
@@ -2287,8 +2287,8 @@ subroutine TransformIntegralsE_checkInterMOIntegralType(speciesID, otherSpeciesI
ionizeA = .false.
ionizeB = .false.
- nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) )
- nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) )
+ nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) )
+ nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) )
do s = 1, size(CONTROL_instance%IONIZE_SPECIES )
if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then
diff --git a/src/ints/AttractionIntegrals.f90 b/src/ints/AttractionIntegrals.f90
index 6013b19d..37c67956 100644
--- a/src/ints/AttractionIntegrals.f90
+++ b/src/ints/AttractionIntegrals.f90
@@ -87,6 +87,7 @@ module AttractionIntegrals_
real(8) :: y
real(8) :: z
real(8) :: charge
+ character(15) :: qdoCenterOf
end type pointCharge
public :: &
@@ -105,13 +106,16 @@ module AttractionIntegrals_
!! -2013.02.04: E.F.Posada: change for use in opints
!! @return output: attraction integral of a shell (all combinations)
!! @version 1.0
- subroutine AttractionIntegrals_computeShell(contractedGaussianA, contractedGaussianB, point, npoints, integral)
+ subroutine AttractionIntegrals_computeShell(contractedGaussianA, contractedGaussianB, point, npoints, integral, speciesID, symbolOfSpecies)
implicit none
type(ContractedGaussian), intent(in) :: contractedGaussianA, contractedGaussianB
type(pointCharge), intent(in), allocatable :: point(:)
integer, intent(in) :: npoints
+ integer, intent(in) :: speciesID
+ character(50), intent(in) :: symbolOfSpecies
+
real(8), intent(inout) :: integral(contractedGaussianA%numCartesianOrbital * contractedGaussianB%numCartesianOrbital)
integer :: am1(0:3)
@@ -178,7 +182,7 @@ subroutine AttractionIntegrals_computeShell(contractedGaussianA, contractedGauss
am1(0:2) = angularMomentIndexA(1:3, p)
am2(0:2) = angularMomentIndexB(1:3, q)
- call AttractionIntegrals_computePrimitive(am1, am2, nprim1, nprim2, npoints, A, B, exp1, exp2, coef1, coef2, nor1, nor2, point, auxintegral)
+ call AttractionIntegrals_computePrimitive(am1, am2, nprim1, nprim2, npoints, A, B, exp1, exp2, coef1, coef2, nor1, nor2, point, auxintegral, speciesID, symbolOfSpecies)
auxIntegral = auxIntegral * contractedGaussianA%contNormalization(p) &
@@ -200,7 +204,7 @@ subroutine AttractionIntegrals_computePrimitive(angularMomentindexA, angularMome
orbitalExponentsA, orbitalExponentsB, &
contractionCoefficientsA, contractionCoefficientsB, &
normalizationConstantsA, normalizationConstantsB, &
- pointCharges, integralValue )
+ pointCharges, integralValue, speciesID, symbolOfSpecies )
implicit none
integer, intent(in) :: angularMomentindexA(0:3), angularMomentindexB(0:3)
@@ -212,7 +216,8 @@ subroutine AttractionIntegrals_computePrimitive(angularMomentindexA, angularMome
real(8), intent(in) :: normalizationConstantsA(0:lengthA), normalizationConstantsB(0:lengthB)
type(pointCharge), intent(in) :: pointCharges(0:numberOfPointCharges-1)
real(8), intent(inout) :: integralValue
-
+ integer, intent(in) :: speciesID
+ character(50), intent(in) :: symbolOfSpecies
real(8), allocatable :: AI0(:,:,:)
real(8) :: PA(0:3), PB(0:3), PC(0:3), P(0:3)
@@ -289,15 +294,19 @@ subroutine AttractionIntegrals_computePrimitive(angularMomentindexA, angularMome
PC(1) = P(1) - pointCharges(atom)%y
PC(2) = P(2) - pointCharges(atom)%z
- sumAngularMoment = angularMomentA + angularMomentB + 1
-
- call AttractionIntegrals_obaraSaikaRecursion(AI0,PA,PB,PC,zeta,sumAngularMoment,angularMomentA,angularMomentB)
-
- indexI = angularMomentindexA(2)*izm + angularMomentindexA(1)*iym + angularMomentindexA(0)*ixm
-
- indexJ = angularMomentindexB(2)*jzm + angularMomentindexB(1)*jym + angularMomentindexB(0)*jxm
-
- integralValue = integralValue - AI0(indexI,indexJ,0) * pointCharges(atom)%charge * commonPreFactor
+ !! Skip integral for qdo centers
+ if ( trim( pointCharges(atom)%qdoCenterOf) == "NONE" .or. trim( pointCharges(atom)%qdoCenterOf) /= trim(symbolOfSpecies) ) then
+
+ sumAngularMoment = angularMomentA + angularMomentB + 1
+
+ call AttractionIntegrals_obaraSaikaRecursion(AI0,PA,PB,PC,zeta,sumAngularMoment,angularMomentA,angularMomentB)
+
+ indexI = angularMomentindexA(2)*izm + angularMomentindexA(1)*iym + angularMomentindexA(0)*ixm
+
+ indexJ = angularMomentindexB(2)*jzm + angularMomentindexB(1)*jym + angularMomentindexB(0)*jxm
+
+ integralValue = integralValue - AI0(indexI,indexJ,0) * pointCharges(atom)%charge * commonPreFactor
+ end if
end do
! write(*,*) "se ha llamado obara-saika ",atom," veces"
diff --git a/src/ints/DirectIntegralManager.f90 b/src/ints/DirectIntegralManager.f90
index c466d3c4..6d98d24c 100644
--- a/src/ints/DirectIntegralManager.f90
+++ b/src/ints/DirectIntegralManager.f90
@@ -32,7 +32,8 @@ module DirectIntegralManager_
use RysQuadrature_
use Matrix_
use Stopwatch_
- use ExternalPotential_
+ use GTFPotential_
+ use String_
!# use RysQInts_ !! Please do not remove this line
implicit none
@@ -62,8 +63,7 @@ module DirectIntegralManager_
!! @version 1.0
!! @par History
!!
- recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(speciesID, scheme, &
- densityMatrix, twoParticlesMatrix, factor )
+ recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(speciesID, scheme, densityMatrix, twoParticlesMatrix, factor, system, Libint2Local )
implicit none
integer :: speciesID
@@ -71,17 +71,25 @@ recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(species
type(matrix) :: densityMatrix
real(8), allocatable, target :: twoParticlesMatrix(:,:)
real(8) :: factor
+ type(MolecularSystem), optional, target :: system
+ type(Libint2Interface), optional :: Libint2Local(:)
+ type(MolecularSystem), pointer :: molSys
! integer :: numberOfContractions
! integer(8) :: integralsByProcess
! integer(8) :: nprocess
! integer(8) :: process
! integer(8) :: starting
! integer(8) :: ending
-
real(8), allocatable, target :: density(:,:)
integer(8) :: ssize
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
ssize = size(densityMatrix%values, DIM=1)
allocate(density(ssize, ssize))
density = densityMatrix%values
@@ -101,21 +109,23 @@ recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(species
! if( ending > ssize ) ending = ssize
!! Calculate integrals
- select case (trim(String_getUppercase(trim(scheme))))
-
+ if (trim(String_getUppercase(trim(scheme))) .ne. "LIBINT") STOP "The integral method selected has not been implemented"
! case("RYS")
! call RysQuadrature_directIntraSpecies( speciesID, "ERIS", starting, ending, int( process ) , &
! densityMatrix, &
! twoParticlesMatrix, factor)
- case("LIBINT")
- call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor )
-
- ! ! case("CUDINT")
- ! ! call CudintInterface_computeIntraSpecies(speciesID)
- case default
- call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor )
- end select
+ ! case("CUDINT")
+ ! call CudintInterface_computeIntraSpecies(speciesID)
+ if( present(Libint2Local) ) then
+ if (.not. Libint2Local(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(speciesID), molSys, speciesID)
+ call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Local(speciesID) )
+ else
+ if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species)))
+ if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID)
+ call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Instance(speciesID) )
+ end if
+
deallocate(density)
end subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix
@@ -126,33 +136,43 @@ end subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix
!! @version 1.0
!! @par History
!!
- subroutine DirectIntegralManager_getDirectInterRepulsionMatrix(speciesID, OtherSpeciesID, scheme, &
- densityMatrix, couplingMatrix )
+ subroutine DirectIntegralManager_getDirectInterRepulsionMatrix(speciesID, OtherSpeciesID, scheme, densityMatrix, couplingMatrix, system, Libint2Local )
implicit none
integer :: speciesID
integer :: otherSpeciesID
character(*) :: scheme
type(matrix) :: densityMatrix
real(8), allocatable, target :: couplingMatrix(:,:)
+ type(MolecularSystem), optional, target :: system
+ type(Libint2Interface), optional :: Libint2Local(:)
+ type(MolecularSystem), pointer :: molSys
real(8), allocatable, target :: density(:,:)
integer :: ssize
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
ssize = size(densityMatrix%values, DIM=1)
! print*, "DIRECT, SIZE DENS:", ssize
allocate(density(ssize, ssize))
density = densityMatrix%values
- select case (trim(String_getUppercase(trim(scheme))))
-
- !case("RYS")
- ! Not implemented
+ if (trim(String_getUppercase(trim(scheme))) .ne. "LIBINT") STOP "The integral method selected has not been implemented"
- case("LIBINT")
- call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix)
- case default
- call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix)
- end select
+ if( present(Libint2Local) ) then
+ if (.not. Libint2Local(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(speciesID), molSys, speciesID)
+ if (.not. Libint2Local(otherSpeciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(otherSpeciesID), molSys, otherSpeciesID)
+ call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Local(speciesID), Libint2Local(otherSpeciesID))
+ else
+ if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species)))
+ if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID)
+ if (.not. Libint2Instance(otherSpeciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(otherSpeciesID), molSys, otherSpeciesID)
+ call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Instance(speciesID), Libint2Instance(otherSpeciesID))
+ end if
deallocate(density)
@@ -164,24 +184,39 @@ end subroutine DirectIntegralManager_getDirectInterRepulsionMatrix
!! @version 1.0
!! @par History
!!
- subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix(speciesID, densityMatrix, twoParticlesMatrix, factor )
+ subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix(speciesID, densityMatrix, twoParticlesMatrix, factor, system, Libint2Local )
implicit none
integer :: speciesID
type(matrix) :: densityMatrix
real(8), allocatable, target :: twoParticlesMatrix(:,:)
real(8) :: factor
+ type(MolecularSystem), optional, target :: system
+ type(Libint2Interface), optional :: Libint2Local(:)
+ type(MolecularSystem), pointer :: molSys
real(8), allocatable, target :: density(:,:)
integer(8) :: ssize
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
ssize = size(densityMatrix%values, DIM=1)
allocate(density(ssize, ssize))
density = densityMatrix%values
- !! Calculate integrals
- call Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoParticlesMatrix, factor )
-
+ if( present(Libint2Local) ) then
+ if (.not. Libint2Local(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(speciesID), molSys, speciesID)
+ call Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Local(speciesID) )
+ else
+ if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species)))
+ if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID)
+ call Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Instance(speciesID) )
+ end if
+
deallocate(density)
end subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix
@@ -192,23 +227,39 @@ end subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix
!! @version 1.0
!! @par History
!!
- subroutine DirectIntegralManager_getDirectInterRepulsionG12Matrix(speciesID, OtherSpeciesID, &
- densityMatrix, couplingMatrix)
+ subroutine DirectIntegralManager_getDirectInterRepulsionG12Matrix(speciesID, OtherSpeciesID, densityMatrix, couplingMatrix, system, Libint2Local)
implicit none
integer :: speciesID
integer :: otherSpeciesID
type(matrix) :: densityMatrix
real(8), allocatable, target :: couplingMatrix(:,:)
+ type(MolecularSystem), optional, target :: system
+ type(Libint2Interface), optional :: Libint2Local(:)
+ type(MolecularSystem), pointer :: molSys
real(8), allocatable, target :: density(:,:)
integer :: ssize
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
ssize = size(densityMatrix%values, DIM=1)
! print*, "DIRECT, SIZE DENS:", ssize
allocate(density(ssize, ssize))
density = densityMatrix%values
- call Libint2Interface_computeG12Interspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix)
+ ! Initialize libint objects
+ if( present(Libint2Local)) then
+ call Libint2Interface_computeG12Interspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Local(speciesID), Libint2Local(otherSpeciesID))
+ else
+ if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species)))
+ if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID)
+ if (.not. Libint2Instance(otherSpeciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(otherSpeciesID), molSys, otherSpeciesID)
+ call Libint2Interface_computeG12Interspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Instance(speciesID), Libint2Instance(otherSpeciesID))
+ end if
deallocate(density)
@@ -606,8 +657,9 @@ subroutine DirectIntegralManager_getAttractionIntegrals(molSystem,speciesID,inte
real(8), allocatable :: integralValue(:)
type(pointCharge), allocatable :: point(:)
! character(20) :: colNum
+ character(50) :: symbolOfSpecies
- !!Attraction Integrals for one species
+ symbolOfSpecies = molSystem%species(speciesID)%symbol
numberOfPointCharges = molSystem%numberOfPointCharges
@@ -620,6 +672,7 @@ subroutine DirectIntegralManager_getAttractionIntegrals(molSystem,speciesID,inte
point(p)%x = molSystem%pointCharges(p+1)%origin(1)
point(p)%y = molSystem%pointCharges(p+1)%origin(2)
point(p)%z = molSystem%pointCharges(p+1)%origin(3)
+ point(p)%qdoCenterOf = molSystem%pointCharges(p+1)%qdoCenterOf
end do
if(allocated(labels)) deallocate(labels)
@@ -651,7 +704,7 @@ subroutine DirectIntegralManager_getAttractionIntegrals(molSystem,speciesID,inte
!!Calculating integrals for shell
call AttractionIntegrals_computeShell( molSystem%species(speciesID)%particles(g)%basis%contraction(h), &
- molSystem%species(speciesID)%particles(i)%basis%contraction(j), point, numberOfPointCharges, integralValue)
+ molSystem%species(speciesID)%particles(i)%basis%contraction(j), point, numberOfPointCharges, integralValue, speciesID, symbolOfSpecies)
!!saving integrals on Matrix
m = 0
@@ -700,41 +753,41 @@ subroutine DirectIntegralManager_getMomentIntegrals(molSystem,speciesID,componen
!!Moment Integrals for one species, one component
if(allocated(labels)) deallocate(labels)
- allocate(labels(MolecularSystem_instance%species(speciesID)%basisSetSize))
- labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(speciesID))
+ allocate(labels(molSystem%species(speciesID)%basisSetSize))
+ labels = DirectIntegralManager_getLabels(molSystem%species(speciesID))
call Matrix_constructor(integralsMatrix, int(MolecularSystem_getTotalNumberOfContractions(speciesID,molSystem),8), &
int(MolecularSystem_getTotalNumberOfContractions(speciesID,molSystem),8), 0.0_8)
- if(component.gt.3) return
+ !if(component.gt.3) return !????
ii = 0
- do g = 1, size(MolecularSystem_instance%species(speciesID)%particles)
- do h = 1, size(MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction)
+ do g = 1, size(molSystem%species(speciesID)%particles)
+ do h = 1, size(molSystem%species(speciesID)%particles(g)%basis%contraction)
hh = h
ii = ii + 1
jj = ii - 1
- do i = g, size(MolecularSystem_instance%species(speciesID)%particles)
- do j = hh, size(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction)
+ do i = g, size(molSystem%species(speciesID)%particles)
+ do j = hh, size(molSystem%species(speciesID)%particles(i)%basis%contraction)
jj = jj + 1
!! allocating memory Integrals for shell
if(allocated(integralValue)) deallocate(integralValue)
- allocate(integralValue(MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital * &
- MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital))
+ allocate(integralValue(molSystem%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital * &
+ molSystem%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital))
!!Calculating integrals for shell
- call MomentIntegrals_computeShell( MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(h), &
- MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j), [0.0_8, 0.0_8, 0.0_8], component, integralValue)
+ call MomentIntegrals_computeShell( molSystem%species(speciesID)%particles(g)%basis%contraction(h), &
+ molSystem%species(speciesID)%particles(i)%basis%contraction(j), [0.0_8, 0.0_8, 0.0_8], component, integralValue)
!!saving integrals on Matrix
m = 0
- do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
- do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
+ do k = labels(ii), labels(ii) + (molSystem%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
+ do l = labels(jj), labels(jj) + (molSystem%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
m = m + 1
integralsMatrix%values(k, l) = integralValue(m)
@@ -809,13 +862,12 @@ subroutine DirectIntegralManager_getExternalPotentialIntegrals(molSystem,species
!!Overlap Integrals for one species
potID = 0
-
+
do i= 1, ExternalPotential_instance%ssize
!if( trim(potential(i)%specie)==trim(interactNameSelected) ) then ! This does not work for UHF
! if ( String_findSubstring(trim( molSystem%species(speciesID)%name ), &
- ! trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%specie)))) == 1 ) then
-
- if ( trim( molSystem%species(speciesID)%symbol) == trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%specie))) ) then
+ ! trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%species)))) == 1 ) then
+ if ( trim( molSystem%species(speciesID)%symbol) == trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%species))) ) then
potID=i
exit
end if
@@ -913,7 +965,6 @@ subroutine DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(speciesID,
type(Libint2Interface), optional :: Libint2LocalForSpecies
type(MolecularSystem), pointer :: molSys
-
real(8), allocatable, target :: density(:,:)
integer :: ssize
diff --git a/src/ints/G12Integrals.f90 b/src/ints/G12Integrals.f90
index 3bfa4ad2..1bfc7d4b 100644
--- a/src/ints/G12Integrals.f90
+++ b/src/ints/G12Integrals.f90
@@ -29,7 +29,7 @@ module G12Integrals_
use CONTROL_
use MolecularSystem_
use ContractedGaussian_
- use InterPotential_
+ use GTFPotential_
implicit none
#define contr(n,m) contractions(n)%contractions(m)
@@ -217,7 +217,7 @@ subroutine G12Integrals_diskIntraSpecie(specieID)
G12_ptr => G12Integrals_instance%libintG12
- nameOfSpecie = trim(MolecularSystem_getNameOfSpecie(specieID))
+ nameOfSpecie = trim(MolecularSystem_getNameOfSpecies(specieID))
call cpu_time(startTime)
@@ -253,7 +253,7 @@ subroutine G12Integrals_diskIntraSpecie(specieID)
!Get potential ID
do i=1, InterPotential_instance%ssize
- if ( trim( MolecularSystem_instance%species(specieID)%symbol) == trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. trim( MolecularSystem_instance%species(specieID)%symbol) == trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie))) ) then
+ if ( trim( MolecularSystem_instance%species(specieID)%symbol) == trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. trim( MolecularSystem_instance%species(specieID)%symbol) == trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies))) ) then
potID=i
exit
end if
@@ -918,14 +918,14 @@ subroutine G12Integrals_G12diskInterSpecie(nameOfSpecie, otherNameOfSpecie, spe
!Get potential ID
do i=1, InterPotential_instance%ssize
if ( (trim(MolecularSystem_instance%species(specieID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
trim(MolecularSystem_instance%species(otherSpecieID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) .or. &
(trim( MolecularSystem_instance%species(otherSpecieID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
trim( MolecularSystem_instance%species(specieID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) &
) then
potID=i
diff --git a/src/ints/HarmonicIntegrals.f90 b/src/ints/HarmonicIntegrals.f90
index 01d325b6..99929c43 100644
--- a/src/ints/HarmonicIntegrals.f90
+++ b/src/ints/HarmonicIntegrals.f90
@@ -81,10 +81,11 @@ module HarmonicIntegrals_
!! -2013.02.04: E.F.Posada: change for use in opints
!! @return output: kinetic integral of a shell (all combinations)
!! @version 1.0
- subroutine HarmonicIntegrals_computeShell(contractedGaussianA, contractedGaussianB, integral)
+ subroutine HarmonicIntegrals_computeShell(contractedGaussianA, contractedGaussianB, integral, origin)
implicit none
type(ContractedGaussian), intent(in) :: contractedGaussianA, contractedGaussianB
+ real(8), intent(in) :: origin(3)
real(8), intent(inout) :: integral(contractedGaussianA%numCartesianOrbital * contractedGaussianB%numCartesianOrbital)
integer :: am1(0:3)
@@ -146,7 +147,7 @@ subroutine HarmonicIntegrals_computeShell(contractedGaussianA, contractedGaussia
am2(0:2) = angularMomentIndexB(1:3, q)
- call HarmonicIntegrals_computePrimitive(am1, am2, nprim1, nprim2, A, B, exp1, exp2, coef1, coef2, nor1, nor2, auxIntegral)
+ call HarmonicIntegrals_computePrimitive(am1, am2, nprim1, nprim2, A, B, exp1, exp2, coef1, coef2, nor1, nor2, auxIntegral, origin)
auxIntegral = auxIntegral * contractedGaussianA%contNormalization(p) &
* contractedGaussianB%contNormalization(q)
@@ -163,7 +164,7 @@ end subroutine HarmonicIntegrals_computeShell
!! @author Edwin Posada, 2010
!! @return devuelve los valores de integrales de atraccion (output)
!! @version 1.0
- subroutine HarmonicIntegrals_computePrimitive(angularMomentIndexA, angularMomentIndexB, lengthA, lengthB, A, B, orbitalExponentsA, orbitalExponentsB, contractionCoefficientsA, contractionCoefficientsB, normalizationConstantA, normalizationConstantB, integralValue)
+ subroutine HarmonicIntegrals_computePrimitive(angularMomentIndexA, angularMomentIndexB, lengthA, lengthB, A, B, orbitalExponentsA, orbitalExponentsB, contractionCoefficientsA, contractionCoefficientsB, normalizationConstantA, normalizationConstantB, integralValue, origin)
implicit none
integer, intent(in) :: angularMomentIndexA(0:3), angularMomentIndexB(0:3)
@@ -172,6 +173,7 @@ subroutine HarmonicIntegrals_computePrimitive(angularMomentIndexA, angularMoment
real(8), intent(in) :: orbitalExponentsA(0:lengthA), orbitalExponentsB(0:lengthB)
real(8), intent(in) :: contractionCoefficientsA(0:lengthA), contractionCoefficientsB(0:lengthB)
real(8), intent(in) :: normalizationConstantA(0:lengthA), normalizationConstantB(0:lengthB)
+ real(8), intent(in) :: origin(3)
real(8), intent(out) :: integralValue
real(8), allocatable :: x(:,:), y(:,:), z(:,:)
@@ -182,8 +184,6 @@ subroutine HarmonicIntegrals_computePrimitive(angularMomentIndexA, angularMoment
real(8) :: PA(0:3), PB(0:3), P(0:3)
real(8) :: commonPreFactor
! real(8) :: x0, y0, z0
- real(8) :: I1, I2, I3, I4
- real(8) :: Ix, Iy, Iz
integer :: angularMomentA, angularMomentB
integer :: maxAngularMoment
@@ -192,6 +192,9 @@ subroutine HarmonicIntegrals_computePrimitive(angularMomentIndexA, angularMoment
! integer :: ii, jj, kk, ll
! integer :: l1, m1, n1
! integer :: l2, m2, n2
+ real(8) :: x00, y00, z00
+ real(8) :: x01, y01, z01
+ real(8) :: x02, y02, z02
integralValue = 0.0_8
@@ -233,11 +236,40 @@ subroutine HarmonicIntegrals_computePrimitive(angularMomentIndexA, angularMoment
!! recursion
call HarmonicIntegrals_obaraSaikaRecursion(x, y, z, PA, PB, zeta, angularMomentA+2, angularMomentB+2)
- Ix = x(angularMomentIndexA(0),angularMomentIndexB(0)+2) * y(angularMomentIndexA(1),angularMomentIndexB(1) ) * z(angularMomentIndexA(2),angularMomentIndexB(2) ) * commonPreFactor
- Iy = x(angularMomentIndexA(0),angularMomentIndexB(0) ) * y(angularMomentIndexA(1),angularMomentIndexB(1)+2) * z(angularMomentIndexA(2),angularMomentIndexB(2) ) * commonPreFactor
- Iz = x(angularMomentIndexA(0),angularMomentIndexB(0) ) * y(angularMomentIndexA(1),angularMomentIndexB(1) ) * z(angularMomentIndexA(2),angularMomentIndexB(2)+2) * commonPreFactor
+ x00 = x(angularMomentIndexA(0),angularMomentIndexB(0))
+ y00 = y(angularMomentIndexA(1),angularMomentIndexB(1))
+ z00 = z(angularMomentIndexA(2),angularMomentIndexB(2))
+
+ x01 = x(angularMomentIndexA(0),angularMomentIndexB(0)+1)
+ y01 = y(angularMomentIndexA(1),angularMomentIndexB(1)+1)
+ z01 = z(angularMomentIndexA(2),angularMomentIndexB(2)+1)
+
+ x02 = x(angularMomentIndexA(0),angularMomentIndexB(0)+2)
+ y02 = y(angularMomentIndexA(1),angularMomentIndexB(1)+2)
+ z02 = z(angularMomentIndexA(2),angularMomentIndexB(2)+2)
+
+ !Ix = x(angularMomentIndexA(0),angularMomentIndexB(0)+2) * y(angularMomentIndexA(1),angularMomentIndexB(1) ) * z(angularMomentIndexA(2),angularMomentIndexB(2) ) * commonPreFactor
+ !Iy = x(angularMomentIndexA(0),angularMomentIndexB(0) ) * y(angularMomentIndexA(1),angularMomentIndexB(1)+2) * z(angularMomentIndexA(2),angularMomentIndexB(2) ) * commonPreFactor
+ !Iz = x(angularMomentIndexA(0),angularMomentIndexB(0) ) * y(angularMomentIndexA(1),angularMomentIndexB(1) ) * z(angularMomentIndexA(2),angularMomentIndexB(2)+2) * commonPreFactor
+
+ integralValue = integralValue + (commonPreFactor*y00*z00* &
+ (x02 + 2*( x01 + B(0)*x00 )*B(0) - B(0)**2*x00 &
+ - 2*( x01 + B(0)*x00 )*origin(1) &
+ + origin(1)**2*x00 ))
+
+ integralValue = integralValue + (commonPreFactor*x00*z00* &
+ !(y11) )
+ (y02 + 2*( y01 + B(1)*y00 )*B(1) - B(1)**2*y00 &
+ - 2*( y01 + B(1)*y00 )* origin(2) &
+ + origin(2)**2*y00 ))
+
+
+ integralValue = integralValue + (commonPreFactor*x00*y00* &
+ !(z02) )
+ (z02 + 2*( z01 + B(2)*z00 )*B(2) - B(2)**2*z00 &
+ - 2*( z01 + B(2)*z00 )*origin(3) &
+ + origin(3)**2*z00 ))
- integralValue = integralValue + (Ix + Iy + Iz) / 2.0
end do
end do
diff --git a/src/ints/IntegralManager.f90 b/src/ints/IntegralManager.f90
index c42f2657..ebba8eed 100644
--- a/src/ints/IntegralManager.f90
+++ b/src/ints/IntegralManager.f90
@@ -37,7 +37,7 @@ module IntegralManager_
use Matrix_
use CosmoCore_
use Stopwatch_
- use ExternalPotential_
+ use GTFPotential_
use HarmonicIntegrals_
use FirstDerivativeIntegrals_
@@ -49,7 +49,8 @@ module IntegralManager_
IntegralManager_writeAttractionIntegrals, &
IntegralManager_writeMomentIntegrals, &
IntegralManager_writeInterRepulsionIntegrals, &
- IntegralManager_writeIntraRepulsionIntegrals
+ IntegralManager_writeIntraRepulsionIntegrals, &
+ IntegralManager_writeHarmonicIntegrals
! private :: &
contains
@@ -151,7 +152,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals()
labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f))
if(allocated(integralsMatrix)) deallocate(integralsMatrix)
- allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f)))
+ allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f)))
integralsMatrix = 0.0_8
ii = 0
@@ -222,7 +223,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals()
labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f))
if(allocated(integralsMatrix)) deallocate(integralsMatrix)
- allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f)))
+ allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f)))
integralsMatrix = 0.0_8
ii = 0
@@ -293,7 +294,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals()
labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f))
if(allocated(integralsMatrix)) deallocate(integralsMatrix)
- allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f)))
+ allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f)))
integralsMatrix = 0.0_8
ii = 0
@@ -352,7 +353,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals()
end subroutine IntegralManager_getFirstDerivativeIntegrals
- subroutine IntegralManager_getHarmonicIntegrals()
+ subroutine IntegralManager_writeHarmonicIntegrals()
implicit none
integer :: f, g, h, i
@@ -361,6 +362,7 @@ subroutine IntegralManager_getHarmonicIntegrals()
integer, allocatable :: labels(:)
real(8), allocatable :: integralValue(:)
real(8), allocatable :: integralsMatrix(:,:)
+ real(8) :: origin(3)
character(100) :: job
integer :: ijob
@@ -370,72 +372,75 @@ subroutine IntegralManager_getHarmonicIntegrals()
!!First derivative Integrals for all species
do f = 1, size(MolecularSystem_instance%species)
- write(30) job
- write(30) MolecularSystem_instance%species(f)%name
+ if ( MolecularSystem_getOmega(f) /= 0.0_8 ) then
+ origin = MolecularSystem_getQDOcenter( f )
- if(allocated(labels)) deallocate(labels)
- allocate(labels(MolecularSystem_instance%species(f)%basisSetSize))
- labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f))
+ write(30) job
+ write(30) MolecularSystem_instance%species(f)%name
- if(allocated(integralsMatrix)) deallocate(integralsMatrix)
- allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f)))
- integralsMatrix = 0.0_8
+ if(allocated(labels)) deallocate(labels)
+ allocate(labels(MolecularSystem_instance%species(f)%basisSetSize))
+ labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f))
- ii = 0
- do g = 1, size(MolecularSystem_instance%species(f)%particles)
- do h = 1, size(MolecularSystem_instance%species(f)%particles(g)%basis%contraction)
+ if(allocated(integralsMatrix)) deallocate(integralsMatrix)
+ allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f)))
+ integralsMatrix = 0.0_8
- hh = h
+ ii = 0
+ do g = 1, size(MolecularSystem_instance%species(f)%particles)
+ do h = 1, size(MolecularSystem_instance%species(f)%particles(g)%basis%contraction)
- ii = ii + 1
- jj = ii - 1
+ hh = h
- do i = g, size(MolecularSystem_instance%species(f)%particles)
- do j = hh, size(MolecularSystem_instance%species(f)%particles(i)%basis%contraction)
+ ii = ii + 1
+ jj = ii - 1
- jj = jj + 1
+ do i = g, size(MolecularSystem_instance%species(f)%particles)
+ do j = hh, size(MolecularSystem_instance%species(f)%particles(i)%basis%contraction)
- !! allocating memory Integrals for shell
- if(allocated(integralValue)) deallocate(integralValue)
- allocate(integralValue(MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital * &
- MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital))
+ jj = jj + 1
- !!Calculating integrals for shell
- call HarmonicIntegrals_computeShell( MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h), &
- MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j), integralValue)
+ !! allocating memory Integrals for shell
+ if(allocated(integralValue)) deallocate(integralValue)
+ allocate(integralValue(MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital * &
+ MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital))
- !!saving integrals on Matrix
- m = 0
- do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
- do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
- m = m + 1
- integralsMatrix(k, l) = integralValue(m)
- integralsMatrix(l, k) = integralsMatrix(k, l)
+ !!Calculating integrals for shell
+ call HarmonicIntegrals_computeShell( MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h), &
+ MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j), integralValue, origin)
- end do
- end do
+ !!saving integrals on Matrix
+ m = 0
+ do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
+ do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
+ m = m + 1
+ integralsMatrix(k, l) = integralValue(m)
+ integralsMatrix(l, k) = integralsMatrix(k, l)
- end do
- hh = 1
- end do
+ end do
+ end do
- end do
- end do
+ end do
+ hh = 1
+ end do
- write(*,"(A, A ,A,I6)")" Number of Harmonic Oscillator integrals for species ", &
- trim(MolecularSystem_instance%species(f)%name), ": ", size(integralsMatrix,DIM=1)**2
+ end do
+ end do
- !!Write integrals to file (unit 30)
- if(CONTROL_instance%LAST_STEP) then
- ! write(*,"(A, A ,A,I6)")" Number of First derivative integrals for species ", &
- ! trim(MolecularSystem_instance%species(f)%name), ": ", size(integralsMatrix,DIM=1)**2
- end if
- write(30) int(size(integralsMatrix),8)
- write(30) integralsMatrix
+ write(*,"(A, A ,A,I6)")" Number of Harmonic Oscillator integrals for species ", &
+ trim(MolecularSystem_instance%species(f)%name), ": ", size(integralsMatrix,DIM=1)**2
+ !!Write integrals to file (unit 30)
+ if(CONTROL_instance%LAST_STEP) then
+ ! write(*,"(A, A ,A,I6)")" Number of First derivative integrals for species ", &
+ ! trim(MolecularSystem_instance%species(f)%name), ": ", size(integralsMatrix,DIM=1)**2
+ end if
+ write(30) int(size(integralsMatrix),8)
+ write(30) integralsMatrix
+ end if
end do !done!
- end subroutine IntegralManager_getHarmonicIntegrals
+ end subroutine IntegralManager_writeHarmonicIntegrals
!>
@@ -524,8 +529,8 @@ subroutine IntegralManager_writeAttractionIntegrals(surface)
write(40) MolecularSystem_instance%species(f)%name
total_aux=0
- cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( f ) )//".opints"
- cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( f ) )//".charges"
+ cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".opints"
+ cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".charges"
open(unit=70, file=trim(cosmoIntegralFile), status="unknown",form="unformatted")
open(unit=80, file=trim(cosmoQuantumChargeFile), status="unknown",form="unformatted")
@@ -576,10 +581,11 @@ subroutine IntegralManager_writeAttractionIntegrals(surface)
point(1)%x =surface%xs(c)
point(1)%y =surface%ys(c)
point(1)%z =surface%zs(c)
+ point(1)%qdoCenterOf = "NONE"
!Calculating integrals for shell
call AttractionIntegrals_computeShell( MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h), &
- MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j), point, 1, integralValue)
+ MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j), point, 1, integralValue, f, "NONE")
m=0
do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
@@ -674,8 +680,8 @@ subroutine IntegralManager_writeAttractionIntegrals(surface)
if ( f /= g ) then
- cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( f ) )//".charges"
- cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( g ) )//".opints"
+ cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".charges"
+ cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( g ) )//".opints"
call CosmoCore_q_int_builder(cosmoIntegralFile,cosmoQuantumChargeFile,numberOfPointCharges,totals(f),totals(g),f,g)
@@ -736,7 +742,7 @@ subroutine IntegralManager_writeMomentIntegrals()
do f = 1, size(MolecularSystem_instance%species)
arguments(2) = MolecularSystem_instance%species(f)%name
- do component = 1, 9 !! components x, y, z
+ do component = 1, 9 !! components x, y, z, XX, YY, ZZ, XY, XZ, YZ
arguments(1) = "MOMENT"//trim(coordinate(component))
@@ -773,13 +779,11 @@ subroutine IntegralManager_writeIntraRepulsionIntegrals(nameOfSpecies, scheme)
character(*) :: scheme
integer :: speciesID
- integer :: numberOfContractions
!! Skip integrals calculation two times for electrons alpha and beta
if(CONTROL_instance%IS_OPEN_SHELL .and. ( trim(nameOfSpecies) == "E-BETA" )) return
speciesID = MolecularSystem_getSpecieID(trim(nameOfSpecies))
- numberOfContractions = MolecularSystem_getNumberOfContractions(speciesID)
if ( trim(String_getUppercase( CONTROL_instance%INTEGRAL_STORAGE )) == "DIRECT") return
@@ -826,11 +830,11 @@ subroutine IntegralManager_writeInterRepulsionIntegrals(scheme)
do i = 1, MolecularSystem_instance%numberOfQuantumSpecies
- if(CONTROL_instance%IS_OPEN_SHELL .and. trim(MolecularSystem_getNameOfSpecie(i)) == "E-BETA" ) cycle
+ if(CONTROL_instance%IS_OPEN_SHELL .and. trim(MolecularSystem_getNameOfSpecies(i)) == "E-BETA" ) cycle
do j = i+1, MolecularSystem_instance%numberOfQuantumSpecies
- if(trim(MolecularSystem_getNameOfSpecie(j)) == "E-BETA" .and. .not. trim(MolecularSystem_getNameOfSpecie(i)) == "E-ALPHA" ) cycle
+ if(trim(MolecularSystem_getNameOfSpecies(j)) == "E-BETA" .and. .not. trim(MolecularSystem_getNameOfSpecies(i)) == "E-ALPHA" ) cycle
!! Calculate integrals (stored on disk)
select case (trim(String_getUppercase(trim(scheme))))
@@ -918,15 +922,15 @@ subroutine IntegralManager_writeThreeCenterIntegralsByProduct()
labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f))
if(allocated(integralsMatrix)) deallocate(integralsMatrix)
- allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f)))
+ allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f)))
integralsMatrix = 0.0_8
do i= 1, ExternalPotential_instance%ssize
!if( trim(potential(i)%specie)==trim(interactNameSelected) ) then ! This does not work for UHF
! if ( String_findSubstring(trim( MolecularSystem_instance%species(f)%name ), &
- ! trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%specie)))) == 1 ) then
- if ( trim( MolecularSystem_instance%species(f)%symbol) == trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%specie))) ) then
+ ! trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%species)))) == 1 ) then
+ if ( trim( MolecularSystem_instance%species(f)%symbol) == trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%species))) ) then
potID=i
exit
end if
diff --git a/src/ints/Ints.f90 b/src/ints/Ints.f90
index 9090bbaf..74a90fce 100644
--- a/src/ints/Ints.f90
+++ b/src/ints/Ints.f90
@@ -93,9 +93,7 @@ Program Ints
call IntegralManager_getFirstDerivativeIntegrals()
end if
- if ( CONTROL_instance%HARMONIC_CONSTANT /= 0.0_8 ) then
- call IntegralManager_getHarmonicIntegrals()
- end if
+ call IntegralManager_writeHarmonicIntegrals()
! !!Calculate attraction integrals
! call Libint2Interface_compute1BodyInts(3)
@@ -103,7 +101,7 @@ Program Ints
! !!Calculate moment integrals
call IntegralManager_writeMomentIntegrals()
-
+
!! Calculate integrals with external potential
if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
call IntegralManager_writeThreeCenterIntegrals()
@@ -187,7 +185,7 @@ Program Ints
!! intra-species two-boy integration
do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
!!Calculate attraction integrals (intra-species)
- call IntegralManager_writeIntraRepulsionIntegrals(trim(MolecularSystem_getNameOfSpecie(speciesID)), &
+ call IntegralManager_writeIntraRepulsionIntegrals(trim(MolecularSystem_getNameOfSpecies(speciesID)), &
trim(CONTROL_instance%INTEGRAL_SCHEME))
end do
@@ -256,8 +254,8 @@ Program Ints
call Libint2Interface_computeG12Interspecies_disk(i, j)
- ! call G12Integrals_G12diskInterSpecie(trim(MolecularSystem_getNameOfSpecie(i)), &
- ! trim(MolecularSystem_getNameOfSpecie(j)), i, j)
+ ! call G12Integrals_G12diskInterSpecie(trim(MolecularSystem_getNameOfSpecies(i)), &
+ ! trim(MolecularSystem_getNameOfSpecies(j)), i, j)
end do
end do
diff --git a/src/ints/Libint2Interface.f90 b/src/ints/Libint2Interface.f90
index 4d9cbd2e..78cc9d13 100644
--- a/src/ints/Libint2Interface.f90
+++ b/src/ints/Libint2Interface.f90
@@ -26,7 +26,7 @@
module Libint2Interface_
use, intrinsic :: iso_c_binding
use MolecularSystem_
- use InterPotential_
+ use GTFPotential_
use ContractedGaussian_
! use Matrix_
@@ -483,8 +483,8 @@ subroutine Libint2Interface_compute1BodyInts(integral_kind)
do s = 1, nspecies
! Prepare matrix
if(allocated(integralsMatrix)) deallocate(integralsMatrix)
- allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = s), &
- MolecularSystem_getTotalNumberOfContractions(specieID = s)))
+ allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(s), &
+ MolecularSystem_getTotalNumberOfContractions(s)))
matrix_ptr = c_loc(integralsMatrix(1,1))
! Initialize libint objects
@@ -511,39 +511,38 @@ end subroutine Libint2Interface_compute1BodyInts
!>
!! Compute 2-body integrals and computes the G matrix
- subroutine Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoBody, factor)
+ subroutine Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoBody, factor, molSys, Libint2LocalForSpecies)
implicit none
integer :: speciesID
real(8), allocatable, target :: density(:,:)
real(8), allocatable, target :: twoBody(:,:)
real(8) :: factor
+ type(MolecularSystem) :: molSys
+ type(Libint2Interface) :: Libint2LocalForSpecies
type(c_ptr) :: density_ptr
type(c_ptr) :: twoBody_ptr
integer :: nspecies
- nspecies = size(MolecularSystem_instance%species)
- if (.not. allocated(Libint2Instance)) then
- allocate(Libint2Instance(nspecies))
- endif
+ nspecies = size(molSys%species)
! Prepare matrix
if(allocated(twoBody)) deallocate(twoBody)
- allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), &
- MolecularSystem_getTotalNumberOfContractions(specieID = speciesID)))
+ allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), &
+ MolecularSystem_getTotalNumberOfContractions(speciesID,molSys)))
twoBody_ptr = c_loc(twoBody(1,1))
density_ptr = c_loc(density(1,1))
! Initialize libint objects
- if (.not. Libint2Instance(speciesID)%isInstanced) then
- call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID)
+ if (.not. Libint2LocalForSpecies%isInstanced) then
+ call Libint2Interface_constructor(Libint2LocalForSpecies, molSys, speciesID)
endif
- call c_LibintInterface_init2BodyInts(Libint2Instance(speciesID)%this)
- call c_LibintInterface_compute2BodyDirect(Libint2Instance(speciesID)%this, density_ptr, twoBody_ptr, factor)
+ call c_LibintInterface_init2BodyInts(Libint2LocalForSpecies%this)
+ call c_LibintInterface_compute2BodyDirect(Libint2LocalForSpecies%this, density_ptr, twoBody_ptr, factor)
end subroutine Libint2Interface_compute2BodyIntraspecies_direct
@@ -611,7 +610,7 @@ subroutine Libint2Interface_compute2BodyIntraspecies_disk(speciesID)
open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
labels(1) = "DENSITY"
- labels(2) = trim(MolecularSystem_getNameOfSpecie(speciesID))
+ labels(2) = trim(MolecularSystem_getNameOfSpecies(speciesID))
aux_dens = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
columns= int(numberOfContractions,4), binary=.true., arguments=labels)
@@ -635,45 +634,43 @@ end subroutine Libint2Interface_compute2BodyIntraspecies_disk
!>
!! Compute 2-body integrals and computes the G matrix
- subroutine Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, coupling)
+ subroutine Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, coupling, molSys, Libint2LocalForSpecies, Libint2LocalForOtherSpecies)
implicit none
integer :: speciesID
integer :: otherSpeciesID
real(8), allocatable, target :: density(:,:)
real(8), allocatable, target :: coupling(:,:)
+ type(MolecularSystem) :: molSys
+ type(Libint2Interface) :: Libint2LocalForSpecies
+ type(Libint2Interface) :: Libint2LocalForOtherSpecies
type(c_ptr) :: density_ptr
type(c_ptr) :: coupling_ptr
integer :: nspecies
- nspecies = size(MolecularSystem_instance%species)
-
- if (.not. allocated(Libint2Instance)) then
- allocate(Libint2Instance(nspecies))
- endif
+ nspecies = size(molSys%species)
! Prepare matrix
if(allocated(coupling)) deallocate(coupling)
- allocate(coupling(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), &
- MolecularSystem_getTotalNumberOfContractions(specieID = speciesID)))
+ allocate(coupling(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), &
+ MolecularSystem_getTotalNumberOfContractions(speciesID,molSys)))
coupling_ptr = c_loc(coupling(1,1))
density_ptr = c_loc(density(1,1))
! Initialize libint objects
- if (.not. Libint2Instance(speciesID)%isInstanced) then
- call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID)
- end if
-
- if (.not. Libint2Instance(otherSpeciesID)%isInstanced) then
- call Libint2Interface_constructor(Libint2Instance(otherSpeciesID), MolecularSystem_instance, otherSpeciesID)
- end if
-
+ if (.not. Libint2LocalForSpecies%isInstanced) then
+ call Libint2Interface_constructor(Libint2LocalForSpecies, molSys, speciesID)
+ endif
+ if (.not. Libint2LocalForOtherSpecies%isInstanced) then
+ call Libint2Interface_constructor(Libint2LocalForOtherSpecies, molSys, otherSpeciesID)
+ endif
+
call c_LibintInterface_computeCouplingDirect(&
- Libint2Instance(speciesID)%this, Libint2Instance(otherSpeciesID)%this, density_ptr, coupling_ptr)
+ Libint2LocalForSpecies%this, Libint2LocalForOtherSpecies%this, density_ptr, coupling_ptr)
end subroutine Libint2Interface_compute2BodyInterSpecies_direct
@@ -685,7 +682,7 @@ subroutine Libint2Interface_compute2BodyInterspecies_direct_IT(speciesID, otherS
real(8), target :: density(:,:)
real(8), target :: coefficients(:,:)
real(8), allocatable, target :: coupling(:,:,:)
- integer :: p, n
+ integer :: p
type(MolecularSystem) :: molSys
type(Libint2Interface) :: Libint2LocalForSpecies
type(Libint2Interface) :: Libint2LocalForOtherSpecies
@@ -736,8 +733,8 @@ subroutine Libint2Interface_compute2BodyAlphaBeta_direct(speciesID, otherSpecies
!! Prepare matrix
if(allocated(coupling)) deallocate(coupling)
-! allocate(coupling(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), &
-! MolecularSystem_getTotalNumberOfContractions(specieID = speciesID)))
+! allocate(coupling(MolecularSystem_getTotalNumberOfContractions(speciesID), &
+! MolecularSystem_getTotalNumberOfContractions(speciesID)))
allocate(coupling(1,1))
@@ -827,9 +824,9 @@ subroutine Libint2Interface_computeG12Intraspecies_disk(speciesID)
!Get potential ID
do i=1, InterPotential_instance%ssize
if ( trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie))) ) then
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies))) ) then
potID=i
exit
end if
@@ -886,14 +883,14 @@ subroutine Libint2Interface_computeG12Interspecies_disk(speciesID,otherSpeciesID
!Get potential ID
do i=1, InterPotential_instance%ssize
if ( (trim(MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
trim(MolecularSystem_instance%species(otherSpeciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) .or. &
(trim( MolecularSystem_instance%species(otherSpeciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) &
) then
potID=i
@@ -935,13 +932,15 @@ end subroutine Libint2Interface_computeG12Interspecies_disk
!>
!! Compute 2-body integrals and store them on disk
- subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoBody, factor)
+ subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoBody, factor, molSys, Libint2LocalForSpecies)
implicit none
integer :: speciesID
real(8), allocatable, target :: density(:,:)
real(8), allocatable, target :: twoBody(:,:)
real(8) :: factor
+ type(MolecularSystem) :: molSys
+ type(Libint2Interface) :: Libint2LocalForSpecies
integer :: nspecies
integer :: i, potID, pot_size
@@ -955,23 +954,20 @@ subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, tw
type(c_ptr) :: density_ptr
type(c_ptr) :: twoBody_ptr
- nspecies = size(MolecularSystem_instance%species)
- if (.not. allocated(Libint2Instance)) then
- allocate(Libint2Instance(nspecies))
- endif
+ nspecies = size(molSys%species)
if(allocated(twoBody)) deallocate(twoBody)
- allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), &
- MolecularSystem_getTotalNumberOfContractions(specieID = speciesID)))
+ allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), &
+ MolecularSystem_getTotalNumberOfContractions(speciesID,molSys)))
twoBody_ptr = c_loc(twoBody(1,1))
density_ptr = c_loc(density(1,1))
!Get potential ID
do i=1, InterPotential_instance%ssize
- if ( trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
- trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie))) ) then
+ if ( trim( molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
+ trim( molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies))) ) then
potID=i
exit
end if
@@ -989,24 +985,22 @@ subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, tw
coefficients_ptr = c_loc(coefficients(1))
exponents_ptr = c_loc(exponents(1))
- ! Initialize libint objects
- if (.not. Libint2Instance(speciesID)%isInstanced) then
- call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID)
- end if
-
- call c_LibintInterface_init2BodyInts(Libint2Instance(speciesID)%this)
+ call c_LibintInterface_init2BodyInts(Libint2LocalForSpecies%this)
- call c_LibintInterface_computeG12Direct(Libint2Instance(speciesID)%this, density_ptr, twoBody_ptr, factor, coefficients_ptr, exponents_ptr, pot_size)
+ call c_LibintInterface_computeG12Direct(Libint2LocalForSpecies%this, density_ptr, twoBody_ptr, factor, coefficients_ptr, exponents_ptr, pot_size)
end subroutine Libint2Interface_computeG12Intraspecies_direct
!! Compute 2-body integrals and store them on disk
- subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpeciesID,density, coupling)
+ subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpeciesID,density, coupling, molSys, Libint2LocalForSpecies, Libint2LocalForOtherSpecies)
implicit none
integer :: speciesID, otherSpeciesID
real(8), allocatable, target :: density(:,:)
real(8), allocatable, target :: coupling(:,:)
+ type(MolecularSystem) :: molSys
+ type(Libint2Interface) :: Libint2LocalForSpecies
+ type(Libint2Interface) :: Libint2LocalForOtherSpecies
integer :: nspecies
integer :: i, potID, pot_size
@@ -1020,30 +1014,27 @@ subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpecies
type(c_ptr) :: density_ptr
type(c_ptr) :: coupling_ptr
- nspecies = size(MolecularSystem_instance%species)
- if (.not. allocated(Libint2Instance)) then
- allocate(Libint2Instance(nspecies))
- endif
+ nspecies = size(molSys%species)
! Prepare matrix
if(allocated(coupling)) deallocate(coupling)
- allocate(coupling(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), &
- MolecularSystem_getTotalNumberOfContractions(specieID = speciesID)))
+ allocate(coupling(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), &
+ MolecularSystem_getTotalNumberOfContractions(speciesID,molSys)))
coupling_ptr = c_loc(coupling(1,1))
density_ptr = c_loc(density(1,1))
!Get potential ID
do i=1, InterPotential_instance%ssize
- if ( (trim(MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
- trim(MolecularSystem_instance%species(otherSpeciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ if ( (trim(molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
+ trim(molSys%species(otherSpeciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) .or. &
- (trim( MolecularSystem_instance%species(otherSpeciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
- trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ (trim(molSys%species(otherSpeciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
+ trim(molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) &
) then
potID=i
@@ -1062,19 +1053,9 @@ subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpecies
coefficients_ptr = c_loc(coefficients(1))
exponents_ptr = c_loc(exponents(1))
-
- ! Initialize libint objects
- if (.not. Libint2Instance(speciesID)%isInstanced) then
- call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID)
- endif
-
- if (.not. Libint2Instance(otherSpeciesID)%isInstanced) then
- call Libint2Interface_constructor(Libint2Instance(otherSpeciesID),MolecularSystem_instance, otherSpeciesID)
- endif
-
call c_LibintInterface_computeG12InterDirect(&
- Libint2Instance(speciesID)%this, Libint2Instance(otherSpeciesID)%this, density_ptr, coupling_ptr, coefficients_ptr, exponents_ptr, pot_size)
+ Libint2LocalForSpecies%this, Libint2LocalForOtherSpecies%this, density_ptr, coupling_ptr, coefficients_ptr, exponents_ptr, pot_size)
end subroutine Libint2Interface_computeG12Interspecies_direct
@@ -1090,7 +1071,6 @@ subroutine Libint2Interface_compute2BodyIntraspecies_direct_all(speciesID, densi
type(MolecularSystem) :: molSys
type(Libint2Interface) :: Libint2LocalForSpecies
- integer :: nspecies
integer :: i, potID, pot_size
real(8), allocatable, target :: coefficients(:)
@@ -1107,10 +1087,10 @@ subroutine Libint2Interface_compute2BodyIntraspecies_direct_all(speciesID, densi
if(InterPotential_instance%isInstanced) then !G12 integrals
!Get potential ID
do i=1, InterPotential_instance%ssize
- if ( trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
- trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie))) ) then
+ if ( trim( molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
+ trim( molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies))) ) then
potID=i
exit
end if
@@ -1145,7 +1125,6 @@ subroutine Libint2Interface_compute2BodyInterspecies_direct_all(speciesID, other
type(Libint2Interface) :: Libint2LocalForSpecies
type(Libint2Interface) :: Libint2LocalForOtherSpecies
- integer :: nspecies
integer :: i, potID, pot_size
real(8), allocatable, target :: coefficients(:)
@@ -1162,15 +1141,15 @@ subroutine Libint2Interface_compute2BodyInterspecies_direct_all(speciesID, other
if(InterPotential_instance%isInstanced) then !G12 integrals
!Get potential ID
do i=1, InterPotential_instance%ssize
- if ( (trim(MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
- trim(MolecularSystem_instance%species(otherSpeciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ if ( (trim(molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
+ trim(molSys%species(otherSpeciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) .or. &
- (trim( MolecularSystem_instance%species(otherSpeciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. &
- trim( MolecularSystem_instance%species(speciesID)%symbol) == &
- trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) &
+ (trim( molSys%species(otherSpeciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%species))) .and. &
+ trim( molSys%species(speciesID)%symbol) == &
+ trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecies)) ) &
) &
) then
potID=i
diff --git a/src/ints/MomentIntegrals.f90 b/src/ints/MomentIntegrals.f90
index c8de5737..3a1e1ad4 100644
--- a/src/ints/MomentIntegrals.f90
+++ b/src/ints/MomentIntegrals.f90
@@ -264,14 +264,13 @@ subroutine MomentIntegrals_computePrimitive(angularMomentIndexA, angularMomentIn
!! Quadrupole
case(4) !XX
integralValue = integralValue + (commonPreFactor*y00*z00* &
- (x11 + x10*(B(0)-originRC(1)) + x01*(A(0)-originRC(1)) + x00*(A(0)-originRC(1))*(B(0)-originRC(1)) ) )
+ (x02 - 2*( x01 *( B(0) - originRC(1)) ) + ( B(0) - originRC(1))**2*x00 ))
case(5) !YY
integralValue = integralValue + (commonPreFactor*x00*z00* &
- (y11 + y10*(B(1)-originRC(2)) + y01*(A(1)-originRC(2)) + y00*(A(1)-originRC(3))*(B(1)-originRC(2)) ) )
+ (y02 + 2*( y01 *( B(1) - originRC(2)) ) + ( B(1) - originRC(2))**2*y00 ))
case(6) !ZZ
- !integralValue = integralValue + (1.0/1.0)*(commonPreFactor*x00*y00*(z11))
integralValue = integralValue + (commonPreFactor*x00*y00* &
- (z11 + z10*(B(2)-originRC(3)) + z01*(A(2)-originRC(3)) + z00*(A(2)-originRC(3))*(B(2)-originRC(3)) ) )
+ (z02 + 2*( z01 *( B(2) - originRC(3)) ) + ( B(2) - originRC(3))**2*z00 ))
case(7) !XY
integralValue = integralValue + (commonPreFactor*(x01+x00*(B(0)-originRC(1)))*(y01+y00*(B(1)-originRC(2)))*z00)
case(8) !XZ
@@ -280,28 +279,6 @@ subroutine MomentIntegrals_computePrimitive(angularMomentIndexA, angularMomentIn
integralValue = integralValue + (commonPreFactor*x00*(y01+y00*(B(1)-originRC(2)))*(z01+z00*(B(2)-originRC(3))))
end select
-! !! Quadrupole
-! case(4) !XX
-! integralValue = integralValue + (1.0/1.0)*(commonPreFactor*(x02+x00*(B(0)-originRC(1)))*y00*z00)
-! integralValue = integralValue - (1.0/2.0)*(commonPreFactor*x00*(y02+y00*(B(1)-originRC(2)))*z00)
-! integralValue = integralValue - (1.0/2.0)*(commonPreFactor*x00*y00*(z02+z00*(B(2)-originRC(3))))
-! case(5) !YY
-! integralValue = integralValue - (1.0/2.0)*(commonPreFactor*(x02+x00*(B(0)-originRC(1)))*y00*z00)
-! integralValue = integralValue + (1.0/1.0)*(commonPreFactor*x00*(y02+y00*(B(1)-originRC(2)))*z00)
-! integralValue = integralValue - (1.0/2.0)*(commonPreFactor*x00*y00*(z02+z00*(B(2)-originRC(3))))
-! case(6) !ZZ
-! integralValue = integralValue - (1.0/2.0)*(commonPreFactor*(x02+x00*(B(0)-originRC(1)))*y00*z00)
-! integralValue = integralValue - (1.0/2.0)*(commonPreFactor*x00*(y02+y00*(B(1)-originRC(2)))*z00)
-! integralValue = integralValue + (1.0/1.0)*(commonPreFactor*x00*y00*(z02+z00*(B(2)-originRC(3))))
-! case(7) !XY
-! integralValue = integralValue + (3.0/2.0)*(commonPreFactor*(x01+x00*(B(0)-originRC(1)))*(y01+y00*(B(1)-originRC(2)))*z00)
-! case(8) !XZ
-! integralValue = integralValue + (3.0/2.0)*(commonPreFactor*(x01+x00*(B(0)-originRC(1)))*y00*(z01+z00*(B(2)-originRC(3))))
-! case(9) !YZ
-! integralValue = integralValue + (3.0/2.0)*(commonPreFactor*x00*(y01+y00*(B(1)-originRC(2)))*(z01+z00*(B(2)-originRC(3))))
-! end select
-
-
end do
end do
diff --git a/src/output/CalculateWaveFunction.f90 b/src/output/CalculateWaveFunction.f90
index b95fc4d1..3393cdf8 100644
--- a/src/output/CalculateWaveFunction.f90
+++ b/src/output/CalculateWaveFunction.f90
@@ -50,7 +50,9 @@ module CalculateWaveFunction_
public :: &
CalculateWaveFunction_getDensityAt, &
- CalculateWaveFunction_getOrbitalValueAt
+ CalculateWaveFunction_getOrbitalValueAt, &
+ CalculateWaveFunction_loadDensityMatrices, &
+ CalculateWaveFunction_loadCoefficientsMatrices
! CalculateWaveFunction_getFukuiFunctionAt
contains
@@ -86,20 +88,17 @@ subroutine CalculateWaveFunction_getDensityAt ( speciesID, coordinates, densityM
end subroutine CalculateWaveFunction_getDensityAt
- subroutine CalculateWaveFunction_getOrbitalValueAt ( speciesID, orbitalNum, coordinates, output )
+ subroutine CalculateWaveFunction_getOrbitalValueAt ( speciesID, orbitalNum, coordinates, coefficientsofcombination, output )
implicit none
integer :: speciesID
integer :: orbitalNum
type(Matrix) :: coordinates
+ type(Matrix) :: coefficientsofcombination
type(Vector) :: output
- type(Matrix) :: coefficientsofcombination
type(Matrix) :: basisSetValues
integer :: totalNumberOfContractions, gridSize
integer :: u
- integer :: wfnUnit
- character(50) :: wfnFile
- character(50) :: arguments(20)
totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID )
@@ -109,19 +108,6 @@ subroutine CalculateWaveFunction_getOrbitalValueAt ( speciesID, orbitalNum, coor
call CalculateWaveFunction_getBasisValueAt(speciesID, coordinates, gridSize, basisSetValues)
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
- !! Open file for wavefunction
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- arguments(2) = MolecularSystem_getNameOfSpecie(speciesID)
- arguments(1) = "COEFFICIENTS"
-
- coefficientsofcombination = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(totalNumberOfContractions,4), &
- columns= int(totalNumberOfContractions,4), binary=.true., arguments=arguments(1:2))
- close (wfnUnit)
-
do u=1,totalNumberOfContractions
output%values=output%values + coefficientsofcombination%values(u,orbitalNum)*basisSetValues%values(:,u)
end do
@@ -155,7 +141,163 @@ subroutine CalculateWaveFunction_getBasisValueAt ( speciesID, coordinates, gridS
end subroutine CalculateWaveFunction_getBasisValueAt
+ subroutine CalculateWaveFunction_loadDensityMatrices ( numberOfSpecies, numberOfStates, levelOfTheory, densityMatrices )
+ integer :: numberOfSpecies
+ integer :: numberOfStates
+ character(*) :: levelOfTheory
+ type(Matrix) :: densityMatrices(:,:)
+
+ integer :: l
+ integer :: state
+ character(50) :: auxString
+ integer :: wfnUnit, occupationsUnit
+ character(100) :: wfnFile, occupationsFile
+ integer :: numberOfOrbitals
+ character(50) :: arguments(2)
+
+ if ( trim(levelOfTheory) .eq. "CI" ) then
+ occupationsUnit = 29
+ occupationsFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
+
+ open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
+ do state=1,numberOfStates
+ do l=1,numberOfSpecies
+ numberOfOrbitals=MolecularSystem_getTotalNumberOfContractions(l)
+ write(auxstring,*) state
+ arguments(2) = MolecularSystem_getNameOfSpecies( l )
+ arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
+ densityMatrices(l,state)= Matrix_getFromFile(unit=occupationsUnit, rows= int(numberOfOrbitals,4), &
+ columns= int(numberOfOrbitals,4), binary=.false., arguments=arguments(1:2))
+
+ end do
+ end do
+ close(occupationsUnit)
+
+ else if( trim(levelOfTheory) .eq. "HF" ) then
+ wfnFile = "lowdin.wfn"
+ wfnUnit = 20
+ state = 1
+ open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+ do l=1,numberOfSpecies
+ numberOfOrbitals=MolecularSystem_getTotalNumberOfContractions(l)
+ arguments(2) = MolecularSystem_getNameOfSpecies( l )
+ arguments(1) = "DENSITY"
+ densityMatrices(l,state)= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfOrbitals,4), &
+ columns= int(numberOfOrbitals,4), binary=.true., arguments=arguments(1:2))
+
+ end do
+ close(wfnUnit)
+ end if
+
+ end subroutine CalculateWaveFunction_loadDensityMatrices
+
+ subroutine CalculateWaveFunction_loadCoefficientsMatrices ( numberOfSpecies, numberOfStates, levelOfTheory, coefficientsOfCombination, occupations, energies)
+ integer :: numberOfSpecies
+ integer :: numberOfStates
+ character(*) :: levelOfTheory
+ type(Matrix) :: coefficientsOfCombination(:,:)
+ type(Vector), optional :: occupations(:,:)
+ type(Vector), optional :: energies(:,:)
+
+ type(Vector), allocatable :: fractionalOccupations(:,:)
+ type(Vector), allocatable :: energyOfMolecularOrbital(:,:)
+
+ integer :: i
+ integer :: l
+ integer :: state
+ integer :: wfnUnit, occupationsUnit
+ character(100) :: wfnFile, occupationsFile
+ character(50) :: arguments(2)
+ character(50) :: auxString
+
+
+ allocate(fractionalOccupations(numberOfSpecies,numberOfStates),energyOfMolecularOrbital(numberOfSpecies,numberOfStates))
+
+
+ if ( trim(levelOfTheory) .eq. "CI" ) then
+
+ occupationsUnit = 29
+ occupationsFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
+
+ open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
+ do state=1,numberOfStates
+ do l=1,numberOfSpecies
+ write(auxstring,*) state
+
+ arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring))
+ arguments(2) = MolecularSystem_getNameOfSpecies( l )
+ call Vector_getFromFile(elementsNum=MolecularSystem_getTotalNumberOfContractions(l),&
+ unit=occupationsUnit,&
+ arguments=arguments(1:2),&
+ output=fractionalOccupations(l,state))
+
+ arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring))
+ coefficientsOfCombination(l,state)=Matrix_getFromFile(unit=occupationsUnit,&
+ rows= int(MolecularSystem_getTotalNumberOfContractions(l),4), &
+ columns= int(MolecularSystem_getTotalNumberOfContractions(l),4), &
+ arguments=arguments(1:2))
+
+ call Vector_constructor( energyOfMolecularOrbital(l,state), MolecularSystem_getTotalNumberOfContractions(l) )
+ energyOfMolecularOrbital(l,state)%values=0.0
+
+ end do
+ end do
+ close(occupationsUnit)
+
+ else if( trim(levelOfTheory) .eq. "HF" ) then
+ !! Open file for wavefunction and load results
+ wfnFile = "lowdin.wfn"
+ wfnUnit = 20
+ open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+
+ do l=1,numberOfSpecies
+ call Vector_constructor( fractionalOccupations(l,1), &
+ MolecularSystem_getTotalNumberOfContractions(l) )
+ fractionalOccupations(l,1)%values=0.0
+ do i=1, MolecularSystem_getOcupationNumber(l)
+ fractionalOccupations(l,1)%values(i)=1.0_8 * MolecularSystem_getLambda(l)
+ end do
+ arguments(2) = MolecularSystem_getNameOfSpecies(l)
+ arguments(1) = "COEFFICIENTS"
+ coefficientsOfcombination(l,1) = &
+ Matrix_getFromFile(unit=wfnUnit, &
+ rows= int(MolecularSystem_getTotalNumberOfContractions(l),4), &
+ columns= int(MolecularSystem_getTotalNumberOfContractions(l),4),&
+ binary=.true., &
+ arguments=arguments(1:2))
+
+ arguments(1) = "ORBITALS"
+ call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions(l), &
+ unit = wfnUnit,&
+ binary = .true.,&
+ arguments = arguments(1:2), &
+ output = energyOfMolecularOrbital(l,1) )
+
+ end do
+ close(wfnUnit)
+
+ end if
+
+ if(present(occupations)) then
+ do state=1,numberOfStates
+ do l=1,numberOfSpecies
+ occupations(l,state)=fractionalOccupations(l,state)
+ end do
+ end do
+ end if
+
+ if(present(energies)) then
+ do state=1,numberOfStates
+ do l=1,numberOfSpecies
+ energies(l,state)=energyOfMolecularOrbital(l,state)
+ end do
+ end do
+ end if
+
+ end subroutine CalculateWaveFunction_loadCoefficientsMatrices
+
end module CalculateWaveFunction_
+
!>
!! @brief Retorna el valor de la funcion en la coordenada especificada
!<
diff --git a/src/output/InputOutput.f90 b/src/output/InputOutput.f90
index 80513061..83a2038c 100644
--- a/src/output/InputOutput.f90
+++ b/src/output/InputOutput.f90
@@ -22,13 +22,12 @@
module InputOutput_
use Exception_
-! use OutputManager_
use OutputBuilder_
use Vector_
implicit none
!>
- !! @brief Description
+ !! @brief Description: Reads information from the input, as a namelist, for additional output files
!!
!! @author felix
!!
@@ -40,191 +39,140 @@ module InputOutput_
!! -# description.
!! - 10-31-2014 : Jorge Charry ( jacharry@unal.edu.co )
!! -# Adapts this module to Lowdin2
- !! - MM-DD-YYYY : authorOfChange ( email@server )
- !! -# description
+ !! - 21-11-2024 : Felix ( email@server )
+ !! -# Simplifies routines, adds more options
!!
!<
- type, public :: InputOutput
- character(50) :: type
- character(50) :: species
- integer :: state
- integer :: orbital
- integer :: dimensions
- real(8) :: cubeSize
- type(Vector) :: point1
- type(Vector) :: point2
- type(Vector) :: point3
- logical :: isInstanced
- end type InputOutput
-
character(50) :: Output_type
character(50) :: Output_species
+ character(2) :: Output_plane
+ character(1) :: Output_axis
integer :: Output_state
integer :: Output_orbital
integer :: Output_dimensions
+ integer :: Output_pointsPerDim
+ real(8) :: Output_scanStep
real(8) :: Output_cubeSize
+ real(8) :: Output_minValue
+ real(8) :: Output_maxValue
+ real(8) :: Output_offsetX
+ real(8) :: Output_offsetY
+ real(8) :: Output_offsetZ
+ real(8) :: Output_limitX(2)
+ real(8) :: Output_limitY(2)
+ real(8) :: Output_limitZ(2)
+ real(8) :: Output_center(3)
real(8) :: Output_point1(3)
real(8) :: Output_point2(3)
real(8) :: Output_point3(3)
-
+
NAMELIST /Output/ &
Output_type, &
Output_species, &
+ Output_plane, &
+ Output_axis, &
Output_state, &
Output_orbital, &
Output_dimensions, &
+ Output_pointsPerDim, &
+ Output_scanStep, &
Output_cubeSize, &
+ Output_minValue, &
+ Output_maxValue, &
+ Output_offsetX, &
+ Output_offsetY, &
+ Output_offsetZ, &
+ Output_limitX, &
+ Output_limitY, &
+ Output_limitZ, &
+ Output_center, &
Output_point1, &
Output_point2, &
Output_point3
public :: &
- InputOutput_constructor, &
- InputOutput_destructor, &
- InputOutput_show, &
InputOutput_load
private
- !
- !! @brief Constructor por omision
- !!
- !! @param this
- !<
- subroutine InputOutput_constructor(ssize)
- implicit none
- integer :: ssize
- integer :: i
-
- if(.not.allocated(InputOutput_Instance)) then
- allocate(InputOutput_Instance(ssize))
- InputOutput_Instance%type=""
- InputOutput_Instance%species="ALL"
- InputOutput_Instance%state=1
- InputOutput_Instance%orbital=0
- InputOutput_Instance%dimensions=0
- InputOutput_Instance%cubeSize=0.0_8
- do i=1, size(InputOutput_Instance)
- call Vector_constructor( InputOutput_Instance(i)%point1, 3, 0.0_8)
- call Vector_constructor( InputOutput_Instance(i)%point2, 3, 0.0_8)
- call Vector_constructor( InputOutput_Instance(i)%point3, 3, 0.0_8)
- end do
- end if
-
- end subroutine InputOutput_constructor
-
-
- !>
- !! @brief Destructor por omision
- !!
- !! @param this
- !<
- subroutine InputOutput_destructor()
- implicit none
- integer :: i
-
- do i=1, size(InputOutput_Instance)
- call Vector_destructor( InputOutput_Instance(i)%point1)
- call Vector_destructor( InputOutput_Instance(i)%point2)
- call Vector_destructor( InputOutput_Instance(i)%point3)
- end do
-
- if(allocated(InputOutput_Instance)) then
- deallocate(InputOutput_Instance)
- end if
-
- end subroutine InputOutput_destructor
-
- !>
- !! @brief Muestra informacion del objeto
- !!
- !! @param this
- !<
- subroutine InputOutput_show(this)
- implicit none
- type(InputOutput) :: this
- end subroutine InputOutput_show
-
!>
!! @brief Carga la informacion de potenciales externos desde el input
!!
!! @param this
!<
- subroutine InputOutput_load( )
+ subroutine InputOutput_load( outputObjects )
implicit none
+ type(OutputBuilder) :: outputObjects(:)
integer :: i
integer :: stat
+ character(1000) :: line
open (unit=4, file=trim(CONTROL_instance%INPUT_FILE)//"aux")
-
- if ( allocated(InputOutput_Instance) ) then
- rewind(4)
- do i=1, size(InputOutput_Instance)
- Output_type=""
- Output_species="ALL"
- Output_state=1
- Output_orbital=1
- Output_dimensions=2
- Output_cubeSize=5.0_8
- Output_point1(:)=0.0_8
- Output_point1(3)=-5.0_8
- Output_point2(:)=0.0_8
- Output_point2(3)=5.0_8
- Output_point3(:)=0.0_8
- read(4,NML=Output, iostat=stat)
-
- if(stat > 0 ) then
-
- call InputOutput_exception( ERROR, "Class object InputOutput in the load function", &
- "check the OUTPUTS block in your input file")
- end if
-
- InputOutput_Instance(i)%type = trim(Output_type)
- InputOutput_Instance(i)%species = trim(Output_species)
- InputOutput_Instance(i)%state = Output_state
- InputOutput_Instance(i)%orbital = Output_orbital
- InputOutput_Instance(i)%dimensions = Output_dimensions
- InputOutput_Instance(i)%cubeSize = Output_cubeSize
- InputOutput_Instance(i)%point1%values = Output_point1
- InputOutput_Instance(i)%point2%values = Output_point2
- InputOutput_Instance(i)%point3%values = Output_point3
-
- end do
-
- else
-
- call InputOutput_exception( ERROR, "Class object InputOutput in the load function", &
- "The Input_Parsing module wasn't instanced")
- end if
+ rewind(4)
+ do i=1, size(outputObjects)
+ Output_type=""
+ Output_species="ALL"
+ Output_plane=""
+ Output_axis=""
+ Output_state=1
+ Output_orbital=0
+ Output_dimensions=0
+ Output_pointsPerDim=0
+ Output_scanStep=0.0_8
+ Output_cubeSize=0.0_8
+ Output_minValue=0.0_8
+ Output_maxValue=0.0_8
+ Output_offsetX=0.0_8
+ Output_offsetY=0.0_8
+ Output_offsetZ=0.0_8
+ Output_limitX(:)=0.0_8
+ Output_limitY(:)=0.0_8
+ Output_limitZ(:)=0.0_8
+ Output_center(:)=0.0_8
+ Output_point1(:)=0.0_8
+ Output_point2(:)=0.0_8
+ Output_point3(:)=0.0_8
+ read(4,NML=Output, iostat=stat)
+
+ if( stat > 0 ) then
+ write (*,'(A)') 'Error reading Output block'
+ backspace(4)
+ read(4,fmt='(A)') line
+ write(*,'(A)') 'Invalid line : '//trim(line)
+ call Exception_stopError("Class object InputOutput in the load function", &
+ "check the OUTPUTS block in your input file")
+ end if
+
+ call OutputBuilder_constructor( outputs_instance(i), i, &
+ Output_type, &
+ Output_species, &
+ Output_plane, &
+ Output_axis, &
+ Output_state, &
+ Output_orbital, &
+ Output_dimensions, &
+ Output_pointsPerDim, &
+ Output_scanStep, &
+ Output_cubeSize, &
+ Output_minValue, &
+ Output_maxValue, &
+ Output_offsetX, &
+ Output_offsetY, &
+ Output_offsetZ, &
+ Output_limitX, &
+ Output_limitY, &
+ Output_limitZ, &
+ Output_center, &
+ Output_point1, &
+ Output_point2, &
+ Output_point3)
+ end do
close(4)
end subroutine InputOutput_load
- !>
- !! @brief Maneja excepciones de la clase
- !<
- subroutine InputOutput_exception( typeMessage, description, debugDescription)
- implicit none
- integer :: typeMessage
- character(*) :: description
- character(*) :: debugDescription
-
- type(Exception) :: ex
-
- call Exception_constructor( ex , typeMessage )
- call Exception_setDebugDescription( ex, debugDescription )
- call Exception_setDescription( ex, description )
- call Exception_show( ex )
- call Exception_destructor( ex )
-
- end subroutine InputOutput_exception
-
end module InputOutput_
diff --git a/src/output/Output.f90 b/src/output/Output.f90
index 77c89110..63463cbb 100644
--- a/src/output/Output.f90
+++ b/src/output/Output.f90
@@ -43,7 +43,7 @@ program Output_
character(50) :: job
integer :: numberOfOutputs, i
-
+
job = ""
call get_command_argument(1,value=job)
job = trim(String_getUppercase(job))
@@ -71,23 +71,11 @@ program Output_
else
read(job,"(I10)") numberOfOutputs
- call InputOutput_constructor( numberOfOutputs )
- call InputOutput_load( )
-
allocate(outputs_instance(numberOfOutputs) )
- do i=1, numberOfOutputs
- call OutputBuilder_constructor( outputs_instance(i), i, &
- InputOutput_Instance(i)%type, &
- InputOutput_Instance(i)%species, &
- InputOutput_Instance(i)%state, &
- InputOutput_Instance(i)%orbital, &
- InputOutput_Instance(i)%dimensions, &
- InputOutput_Instance(i)%cubeSize, &
- InputOutput_Instance(i)%point1, &
- InputOutput_Instance(i)%point2, &
- InputOutput_Instance(i)%point3 )
+ call InputOutput_load(outputs_instance(:))
+ do i=1, numberOfOutputs
call OutputBuilder_buildOutput(outputs_instance(i))
call OutputBuilder_show(outputs_instance(i))
end do
diff --git a/src/output/OutputBuilder.f90 b/src/output/OutputBuilder.f90
index b027d18f..ec8e55ba 100644
--- a/src/output/OutputBuilder.f90
+++ b/src/output/OutputBuilder.f90
@@ -57,20 +57,26 @@ module OutputBuilder_
character(50) :: species
character(100),allocatable :: fileName(:)
character(100) :: fileName2
+ character(50) :: axisLabel(3)
+ character(10) :: wavefunctionType
integer :: state
integer :: orbital
integer :: dimensions
integer :: outputID
integer :: auxID
+ integer :: pointsPerDim(3)
real(8) :: cubeSize
+ real(8) :: minValue
+ real(8) :: maxValue
type(vector) :: point1
type(vector) :: point2
type(vector) :: point3
- logical :: isInstanced
+ type(vector) :: step1
+ type(vector) :: step2
end type OutputBuilder
type(OutputBuilder), public, allocatable :: outputs_instance(:)
-
+
public :: &
OutputBuilder_constructor, &
OutputBuilder_destructor, &
@@ -81,24 +87,23 @@ module OutputBuilder_
OutputBuilder_generateAIMFiles, &
OutputBuilder_generateExtendedWfnFile, &
OutputBuilder_buildOutput, &
- OutputBuilder_make2DGraph, &
- OutputBuilder_make3DGraph, &
- OutputBuilder_get2DPlot, &
- OutputBuilder_get3DPlot, &
- OutputBuilder_getDensityPlot, &
+ OutputBuilder_make2DGnuplot, &
+ OutputBuilder_make3DGnuplot, &
+ OutputBuilder_getPlot, &
+ OutputBuilder_getCube, &
OutputBuilder_casinoFile
private
-interface
+ interface
- subroutine Molden2AIM(inputFileName,totalEnergy,virial)
- implicit none
- character(50) :: inputFileName
- real(8) :: totalEnergy, virial
- end subroutine Molden2AIM
+ subroutine Molden2AIM(inputFileName,totalEnergy,virial)
+ implicit none
+ character(50) :: inputFileName
+ real(8) :: totalEnergy, virial
+ end subroutine Molden2AIM
-end interface
+ end interface
contains
@@ -107,69 +112,243 @@ end subroutine Molden2AIM
!! @brief Constructor por omision
!!
!! @param this
- subroutine OutputBuilder_constructor(this, ID, type ,species, state, orbital, dimensions, cubeSize, point1, point2, point3 )
+ subroutine OutputBuilder_constructor(this, ID, &
+ type, &
+ species, &
+ plane, &
+ axis, &
+ state, &
+ orbital, &
+ dimensions, &
+ pointsPerDim, &
+ scanStep, &
+ cubeSize, &
+ minValue, &
+ maxValue, &
+ offsetX, &
+ offsetY, &
+ offsetZ, &
+ limitX, &
+ limitY, &
+ limitZ, &
+ center, &
+ point1, &
+ point2, &
+ point3)
+
type(OutputBuilder) :: this
integer :: ID
character(*) :: type
character(*) :: species
+ character(*),optional :: plane
+ character(*),optional :: axis
integer,optional :: state
integer,optional :: orbital
integer,optional :: dimensions
+ integer,optional :: pointsPerDim
+ real(8),optional :: scanStep
real(8),optional :: cubeSize
- type(Vector),optional :: point1
- type(Vector),optional :: point2
- type(Vector),optional :: point3
+ real(8),optional :: minValue
+ real(8),optional :: maxValue
+ real(8),optional :: offsetX
+ real(8),optional :: offsetY
+ real(8),optional :: offsetZ
+ real(8),optional :: limitX(2)
+ real(8),optional :: limitY(2)
+ real(8),optional :: limitZ(2)
+ real(8),optional :: center(3)
+ real(8),optional :: point1(3)
+ real(8),optional :: point2(3)
+ real(8),optional :: point3(3)
+
integer :: i
-
+ real(8) :: auxX, auxY, auxZ, auxReal, auxStep
+ real(8) :: auxLimX(2), auxLimY(2), auxLimZ(2)
+ character(50) :: auxString
+ logical :: existFile
+
this%type=type
! print *, "this%type", this%type
this%outputID=ID
this%species=trim(String_getUppercase(species))
- if( trim(this%species) .eq. "ALL" .and. this%type .ne. "ORBITALPLOT" ) then
+ if( trim(this%species) .eq. "ALL") then
allocate(this%fileName(MolecularSystem_getNumberOfQuantumSpecies()))
- else if( trim(this%species) .eq. "ALL" .and. this%type .eq. "ORBITALPLOT" ) then
- allocate(this%fileName(1))
- this%species=MolecularSystem_getNameOfSpecies(1)
else
allocate(this%fileName(1))
end if
this%state=1
- if( present(state)) this%state=state
- this%orbital=1
- if( present(orbital)) this%orbital=orbital
- this%dimensions=2
- if( present(dimensions)) this%dimensions=dimensions
+ this%orbital=0
+ this%dimensions=0
this%cubeSize=10
- if( present(cubeSize)) this%cubeSize=cubeSize
-
+ this%axisLabel(1:3)=""
+ this%minValue=0.0_8
+ this%minValue=0.0_8
call Vector_constructor(this%point1, 3, 0.0_8 )
call Vector_constructor(this%point2, 3, 0.0_8 )
call Vector_constructor(this%point3, 3, 0.0_8 )
+ call Vector_constructor(this%step1, 3, 0.0_8 )
+ call Vector_constructor(this%step2, 3, 0.0_8 )
+
+ if( present(state)) this%state=state
+ if( present(orbital)) this%orbital=orbital
+ if( present(dimensions)) this%dimensions=dimensions
+ if( present(cubeSize)) this%cubeSize=cubeSize
+ if( present(pointsPerDim)) this%pointsPerDim(1:3)=pointsPerDim
+ if( present(minValue)) this%minValue=minValue
+ if( present(maxValue)) this%maxValue=maxValue
+ if( present(point1)) this%point1%values=point1
+ if( present(point2)) this%point2%values=point2
+ if( present(point3)) this%point3%values=point3
+
+ if (this%pointsPerDim(1) .eq. 0) this%pointsPerDim(:)=CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
+
+ auxString=""
+ auxX=0.0
+ auxY=0.0
+ auxZ=0.0
+ auxStep=0.0
+
+ if( present(offsetX)) auxX=offsetX
+ if( present(offsetY)) auxY=offsetY
+ if( present(offsetZ)) auxZ=offsetZ
+ if( present(limitX)) auxLimX=limitX
+ if( present(limitY)) auxLimY=limitY
+ if( present(limitZ)) auxLimZ=limitZ
+
+ if(present(plane)) auxString=plane
+ if(present(scanStep)) auxStep=scanStep
+
+ if(auxString .ne. "") then
+ this%dimensions=3
+ if(trim(auxString) .eq. "xy" .or. trim(auxString) .eq. "yx") then
+ this%axisLabel(1)="X"
+ this%axisLabel(2)="Y"
+ this%point1%values(1)=auxLimX(1)
+ this%point1%values(2)=auxLimY(1)
+ this%point1%values(3)=auxZ
+
+ this%point2%values(1)=auxLimX(2)
+ this%point2%values(2)=auxLimY(1)
+ this%point2%values(3)=auxZ
+
+ this%point3%values(1)=auxLimX(1)
+ this%point3%values(2)=auxLimY(2)
+ this%point3%values(3)=auxZ
+ else if(trim(auxString) .eq. "xz" .or. trim(auxString) .eq. "zx") then
+ this%axisLabel(1)="X"
+ this%axisLabel(2)="Z"
+ this%point1%values(1)=auxLimX(1)
+ this%point1%values(2)=auxY
+ this%point1%values(3)=auxLimZ(1)
+
+ this%point2%values(1)=auxLimX(2)
+ this%point2%values(2)=auxY
+ this%point2%values(3)=auxLimZ(1)
+
+ this%point3%values(1)=auxLimX(1)
+ this%point3%values(2)=auxY
+ this%point3%values(3)=auxLimZ(2)
+ else if(trim(auxString) .eq. "yz" .or. trim(auxString) .eq. "zy") then
+ this%axisLabel(1)="Y"
+ this%axisLabel(2)="Z"
+ this%point1%values(1)=auxX
+ this%point1%values(2)=auxLimY(1)
+ this%point1%values(3)=auxLimZ(1)
+
+ this%point2%values(1)=auxX
+ this%point2%values(2)=auxLimY(2)
+ this%point2%values(3)=auxLimZ(1)
+
+ this%point3%values(1)=auxX
+ this%point3%values(2)=auxLimY(1)
+ this%point3%values(3)=auxLimZ(2)
+ else
+ call Exception_stopError("Please select a plane (xy,xz or yz) to build the plot", "OutputBuilder_constructor" )
+ end if
+ end if
- this%point1%values(3)=-5.0
- this%point2%values(3)=5.0
+ if(present(axis)) auxString=axis
+ if(auxString .ne. "") then
+ this%dimensions=2
+ select case(trim(auxString))
+ case ( "x")
+ this%axisLabel(1)="X"
+ this%point1%values(1)=auxLimX(1)
+ this%point2%values(1)=auxLimX(2)
+ this%point1%values(2)=auxY
+ this%point2%values(2)=auxY
+ this%point1%values(3)=auxZ
+ this%point2%values(3)=auxZ
+ case ( "y")
+ this%axisLabel(1)="Y"
+ this%point1%values(1)=auxX
+ this%point2%values(1)=auxX
+ this%point1%values(2)=auxLimY(1)
+ this%point2%values(2)=auxLimY(2)
+ this%point1%values(3)=auxZ
+ this%point2%values(3)=auxZ
+ case ( "z")
+ this%axisLabel(1)="Z"
+ this%point1%values(1)=auxX
+ this%point2%values(1)=auxX
+ this%point1%values(2)=auxY
+ this%point2%values(2)=auxY
+ this%point1%values(3)=auxLimZ(1)
+ this%point2%values(3)=auxLimZ(2)
+ case default
+ call Exception_stopError( "Please select an axis (x,y or z) to build the plot", "OutputBuilder_constructor" )
+ end select
+
+ end if
+
+ if(auxStep .gt. 0.0) then
+ if(this%dimensions .eq. 2 .or. this%dimensions .eq. 3) then
+ auxReal=sqrt(sum((this%point2%values(:)-this%point1%values(:))*(this%point2%values(:)-this%point1%values(:))))
+ this%step1%values(:)=(this%point2%values(:)-this%point1%values(:))/auxReal*auxStep
+ this%pointsPerDim(1)=int(auxReal/auxStep)
+ end if
+ if(this%dimensions .eq. 3) then
+ auxReal=sqrt(sum((this%point3%values(:)-this%point1%values(:))*(this%point3%values(:)-this%point1%values(:))))
+ this%step2%values(:)=(this%point3%values(:)-this%point1%values(:))/auxReal*auxStep
+ this%pointsPerDim(2)=int(auxReal/auxStep)
+ end if
+ else
+ if(this%dimensions .eq. 2 .or. this%dimensions .eq. 3) &
+ this%step1%values(:)=(this%point2%values(:)-this%point1%values(:))/this%pointsPerDim(1)
+ if(this%dimensions .eq. 3) &
+ this%step2%values(:)=(this%point3%values(:)-this%point1%values(:))/this%pointsPerDim(2)
+ end if
+
+ if(auxStep .gt. 0.0 .and. this%cubeSize .gt. 0.0) this%pointsPerDim(1:3)=int((this%cubeSize*2.0)/auxStep)
- if( present(point1)) this%point1%values=point1%values
- if( present(point2)) this%point2%values=point2%values
- if( present(point3)) this%point3%values=point3%values
+ if( present(center) ) auxReal=sum(center*center)
+ if(auxReal .gt. 0.0) this%point1%values=center
if ( trim(CONTROL_instance%UNITS) == "ANGS") then
this%point1%values= this%point1%values/AMSTRONG
this%point2%values= this%point2%values/AMSTRONG
this%point3%values= this%point3%values/AMSTRONG
this%cubeSize=this%cubeSize/AMSTRONG
+ this%step1%values= this%step1%values/AMSTRONG
+ this%step2%values= this%step2%values/AMSTRONG
end if
+ !! By default, we work with HF-KS wavefunctions
+ this%wavefunctionType="HF"
+ !! Check if there are CI density matrices
+ inquire(FILE = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci", EXIST = existFile )
+ if(existFile .and. CONTROL_instance%CI_STATES_TO_PRINT .gt. 0) this%wavefunctionType="CI"
+
this%auxID=1
!!Check for other outputs of the same type
do i=1, this%outputID-1
if( trim(outputs_instance(i)%type) .eq. trim(this%type) .and. &
- trim(outputs_instance(i)%species) .eq. trim(this%species) .and. &
- outputs_instance(i)%dimensions .eq. this%dimensions .and. &
- outputs_instance(i)%orbital .eq. this%orbital) this%auxID=this%auxID+1
+ trim(outputs_instance(i)%species) .eq. trim(this%species) .and. &
+ outputs_instance(i)%dimensions .eq. this%dimensions .and. &
+ outputs_instance(i)%orbital .eq. this%orbital) this%auxID=this%auxID+1
end do
-
+
end subroutine OutputBuilder_constructor
@@ -188,39 +367,6 @@ subroutine OutputBuilder_destructor(this)
end subroutine OutputBuilder_destructor
- !!>
- !! @brief Indica si el objeto ha sido instanciado o no
- !!
- !<
-! function OutputBuilder_isInstanced( this ) result( output )
-! implicit none
-! type(OutputBuilder), intent(in) :: this
-! logical :: output
-!
-! output = this%isInstanced
-!
-! end function OutputBuilder_isInstanced
-
- !>
- !! @brief Maneja excepciones de la clase
- !<
- subroutine OutputBuilder_exception( typeMessage, description, debugDescription)
- implicit none
- integer :: typeMessage
- character(*) :: description
- character(*) :: debugDescription
-
- type(Exception) :: ex
-
- call Exception_constructor( ex , typeMessage )
- call Exception_setDebugDescription( ex, debugDescription )
- call Exception_setDescription( ex, description )
- call Exception_show( ex )
- call Exception_destructor( ex )
-
- end subroutine OutputBuilder_exception
-
-
!>
!! @brief Muestra informacion del objeto
!!
@@ -234,12 +380,13 @@ subroutine OutputBuilder_show(this)
print *, "--------------------------------------------------------"
write (*,"(A20,I5,T2,A18)") "Output Number: ", this%outputID, this%type
- do l=1,size(this%fileName)
- write (*,"(A20,A)") "FileName: ", this%fileName(l)
- end do
! TODO Fix this line.
! if (this%filename2 /= "") print *, "FileName 2: ", this%fileName2
- if (this%species /= "ALL") write (*,"(A20,A)") "for species: ", trim(this%species)
+ if (this%species /= "ALL") then
+ write (*,"(A20,A)") "for species: ", trim(this%species)
+ else
+ write (*,"(T20,A)") "for all species "
+ end if
if (this%state /= 1) write (*,"(A20,I10)") "for excited state: ", this%state
select case(trim(this%type))
@@ -266,22 +413,56 @@ subroutine OutputBuilder_show(this)
write (*,"(A20,I10)") "dimensions: ", this%dimensions
write (*,"(A20,F10.5,F10.5,F10.5)") "Point 1 (a.u.): ", this%point1%values(1), this%point1%values(2), this%point1%values(3)
write (*,"(A20,F10.5,F10.5,F10.5)") "Point 2 (a.u.): ", this%point2%values(1), this%point2%values(2), this%point2%values(3)
- if (this%dimensions >= 3) write (*,"(A20,F10.5,F10.5,F10.5)") "Point 3 (a.u.): ", this%point3%values(1), this%point3%values(2), this%point3%values(3)
-
+ if (this%dimensions .eq. 2) then
+ write (*,"(A20,F10.5)") "Step size: ", sqrt(sum(this%step1%values*this%step1%values))
+ write (*,"(A20,I10)") "No. steps: ", this%pointsPerDim(1)
+ end if
+ if (this%dimensions .eq. 3) then
+ write (*,"(A20,F10.5,F10.5,F10.5)") "Point 3 (a.u.): ", this%point3%values(1), this%point3%values(2), this%point3%values(3)
+ write (*,"(A20,F10.5,F10.5)") "Step sizes: ", sqrt(sum(this%step1%values*this%step1%values)), sqrt(sum(this%step2%values*this%step2%values))
+ write (*,"(A20,2I10)") "No. steps: ", this%pointsPerDim(1), this%pointsPerDim(2)
+ end if
case ( "DENSITYCUBE")
write (*,"(A20,F10.5)") "cube size (a.u.): ", this%cubeSize
write (*,"(A20,3F10.5)") "cube center (a.u.): ", this%point1%values(1:3)
+ write (*,"(A20,3I10)") "No. steps: ", this%pointsPerDim(1:3)
case ( "ORBITALPLOT")
- write (*,"(A20,I10)") "for orbital: ", this%orbital
+ if(this%orbital .eq. 0) then
+ write (*,"(A40)") "for the highest occupied orbital"
+ else
+ write (*,"(A20,I10)") "for orbital: ", this%orbital
+ end if
write (*,"(A20,I10)") "dimensions: ", this%dimensions
write (*,"(A20,F10.5,F10.5,F10.5)") "Point 1 (a.u.): ", this%point1%values(1), this%point1%values(2), this%point1%values(3)
write (*,"(A20,F10.5,F10.5,F10.5)") "Point 2 (a.u.): ", this%point2%values(1), this%point2%values(2), this%point2%values(3)
- if (this%dimensions >= 3) write (*,"(A20,F10.5,F10.5,F10.5)") "Point 3 (a.u.): ", this%point3%values(1), this%point3%values(2), this%point3%values(3)
+ if (this%dimensions .eq. 2) then
+ write (*,"(A20,F10.5)") "Step size: ", sqrt(sum(this%step1%values*this%step1%values))
+ write (*,"(A20,I10)") "No. steps: ", this%pointsPerDim(1)
+ end if
+ if (this%dimensions .eq. 3) then
+ write (*,"(A20,F10.5,F10.5,F10.5)") "Point 3 (a.u.): ", this%point3%values(1), this%point3%values(2), this%point3%values(3)
+ write (*,"(A20,F10.5,F10.5)") "Step sizes: ", sqrt(sum(this%step1%values*this%step1%values)), sqrt(sum(this%step2%values*this%step2%values))
+ write (*,"(A20,2I10)") "No. steps: ", this%pointsPerDim(1), this%pointsPerDim(2)
+ end if
+
+ case ( "ORBITALCUBE")
+ if(this%orbital .eq. 0) then
+ write (*,"(A40)") "for the highest occupied orbital"
+ else
+ write (*,"(A20,I10)") "for orbital: ", this%orbital
+ end if
+ write (*,"(A20,F10.5)") "cube size (a.u.): ", this%cubeSize
+ write (*,"(A20,3F10.5)") "cube center (a.u.): ", this%point1%values(1:3)
+ write (*,"(A20,3I10)") "No. steps: ", this%pointsPerDim(1:3)
case default
end select
+ do l=1,size(this%fileName)
+ write (*,"(A20,A)") "FileName: ", this%fileName(l)
+ end do
+
print *, "--------------------------------------------------------"
print *, ""
@@ -293,74 +474,75 @@ end subroutine OutputBuilder_show
!!
!! @param this
!<
- subroutine OutputBuilder_buildOutput(this)
- implicit none
- type(OutputBuilder) :: this
+ subroutine OutputBuilder_buildOutput(this)
+ implicit none
+ type(OutputBuilder) :: this
+
+ select case( this%type )
- select case( this%type )
+ case ( "MOLDENFILE")
+ call OutputBuilder_writeMoldenFile (this)
- case ( "MOLDENFILE")
- call OutputBuilder_writeMoldenFile (this)
+ case ("VECGAMESSFILE")
+ call OutputBuilder_VecGamessFile (this)
- case ("VECGAMESSFILE")
- call OutputBuilder_VecGamessFile (this)
+ case ("CASINOFILE")
+ call OutputBuilder_casinoFile (this)
- case ("CASINOFILE")
- call OutputBuilder_casinoFile (this)
+ case ("EIGENGAMESSFILE")
+ call OutputBuilder_writeEigenvalues (this)
- case ("EIGENGAMESSFILE")
- call OutputBuilder_writeEigenvalues (this)
+ case ("FCHKFILE")
+ call OutputBuilder_writeFchkFile (this)
- case ("FCHKFILE")
- call OutputBuilder_writeFchkFile (this)
-
- case ( "WFNFILE")
- call OutputBuilder_writeMoldenFile (this)
- call OutputBuilder_generateAIMFiles (this)
+ case ( "WFNFILE")
+ call OutputBuilder_writeMoldenFile (this)
+ call OutputBuilder_generateAIMFiles (this)
case ( "NBO47FILE")
- call OutputBuilder_writeMoldenFile (this)
- call OutputBuilder_generateAIMFiles (this)
+ call OutputBuilder_writeMoldenFile (this)
+ call OutputBuilder_generateAIMFiles (this)
case ( "WFXFILE" )
- call OutputBuilder_writeMoldenFile (this)
- call OutputBuilder_generateAIMFiles (this)
+ call OutputBuilder_writeMoldenFile (this)
+ call OutputBuilder_generateAIMFiles (this)
case ( "EXTENDEDWFNFILE")
- call OutputBuilder_writeMoldenFile (this)
- call OutputBuilder_generateAIMFiles (this)
- call OutputBuilder_generateExtendedWfnFile (this)
+ call OutputBuilder_writeMoldenFile (this)
+ call OutputBuilder_generateAIMFiles (this)
+ call OutputBuilder_generateExtendedWfnFile (this)
case ( "DENSITYPLOT")
- if (this%dimensions == 2) call OutputBuilder_getDensityPlot(this)
- if (this%dimensions == 3) call OutputBuilder_getDensityPlot(this)
-
- case ( "DENSITYCUBE")
- call OutputBuilder_getDensityCube(this)
-!
- case ( "ORBITALPLOT")
- if (this%dimensions == 2) call OutputBuilder_get2DPlot(this)
- if (this%dimensions == 3) call OutputBuilder_get3DPlot(this)
-!
-! case ( "orbitalCube")
-! call OutputBuilder_getCube(this)
-!
-! case ( "fukuiPlot")
-! if (this%dimensions == 2) call OutputBuilder_get2DPlot(this)
-! if (this%dimensions == 3) call OutputBuilder_get3DPlot(this)
-!
-! case ( "fukuiCube")
-! call OutputBuilder_getCube(this)
-!
- case default
- call OutputBuilder_exception(ERROR, "The output type you requested has not been implemented yet", "OutputBuilder_buildOutput" )
-
- end select
- end subroutine OutputBuilder_buildOutput
-
-
-
+ if(this%maxValue .eq. 0.0) this%maxValue=0.5
+ call OutputBuilder_getPlot(this)
+
+ case ( "DENSITYCUBE")
+ call OutputBuilder_getCube(this)
+ !
+ case ( "ORBITALPLOT")
+ if(this%maxValue .eq. 0.0 .and. this%minValue .eq. 0.0) then
+ this%maxValue=1.0
+ this%minValue=-1.0
+ end if
+ call OutputBuilder_getPlot(this)
+ !
+ case ( "ORBITALCUBE")
+ call OutputBuilder_getCube(this)
+ !
+ ! case ( "fukuiPlot")
+ ! if (this%dimensions == 2) call OutputBuilder_get2DPlot(this)
+ ! if (this%dimensions == 3) call OutputBuilder_get3DPlot(this)
+ !
+ ! case ( "fukuiCube")
+ ! call OutputBuilder_getCube(this)
+ !
+ case default
+ call Exception_stopError("The output type "//this%type//" you requested has not been implemented yet", "OutputBuilder_buildOutput" )
+
+ end select
+ end subroutine OutputBuilder_buildOutput
+
subroutine OutputBuilder_writeMoldenFile(this)
implicit none
type(OutputBuilder) :: this
@@ -384,13 +566,9 @@ subroutine OutputBuilder_writeMoldenFile(this)
type(Vector),allocatable :: energyOfMolecularOrbital(:,:)
type(Vector),allocatable :: fractionalOccupations(:,:)
character(10),allocatable :: labels(:)
- integer :: wfnUnit, occupationsUnit
- character(100) :: wfnFile, occupationsFile
integer :: numberOfContractions
- character(50) :: arguments(2)
integer :: totalNumberOfParticles, n
- logical :: existFile
-
+
! if ( CONTROL_instance%ARE_THERE_DUMMY_ATOMS ) then
! auxString=MolecularSystem_getNameOfSpecies( 1 )
! this%fileName=trim(CONTROL_instance%INPUT_FILE)//"mol"
@@ -407,96 +585,30 @@ subroutine OutputBuilder_writeMoldenFile(this)
labels=ParticleManager_getLabelsOfCentersOfOptimization()
charges=ParticleManager_getChargesOfCentersOfOptimization()
numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
-
- occupationsFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- inquire(FILE = occupationsFile, EXIST = existFile )
-
- !! Check if there are CI fractional occupations or build the occupations vector
- if ( CONTROL_instance%CI_STATES_TO_PRINT .gt. 0 .and. existFile) then
-
- print *, " We are printing the molden files for the CI states!"
-
- numberOfStates=CONTROL_instance%CI_STATES_TO_PRINT
- allocate(fractionalOccupations(numberOfSpecies,numberOfStates))
- allocate(energyOfMolecularOrbital(numberOfSpecies,numberOfStates))
- allocate(coefficientsOfCombination(numberOfSpecies,numberOfStates))
- occupationsUnit = 29
-
- open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
- do state=1,numberOfStates
- do l=1,numberOfSpecies
- write(auxstring,*) state
-
- arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring))
- arguments(2) = MolecularSystem_getNameOfSpecies( l )
- call Vector_getFromFile(elementsNum=MolecularSystem_getTotalNumberOfContractions(l),&
- unit=occupationsUnit,&
- arguments=arguments(1:2),&
- output=fractionalOccupations(l,state))
-
- arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring))
- coefficientsOfCombination(l,state)=Matrix_getFromFile(unit=occupationsUnit,&
- rows= int(MolecularSystem_getTotalNumberOfContractions(l),4), &
- columns= int(MolecularSystem_getTotalNumberOfContractions(l),4), &
- arguments=arguments(1:2))
-
- call Vector_constructor( energyOfMolecularOrbital(l,state), MolecularSystem_getTotalNumberOfContractions(l) )
- energyOfMolecularOrbital(l,state)%values=0.0
-
- end do
- end do
- close(occupationsUnit)
-
- else
- !! Open file for wavefunction and load results
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
numberOfStates=1
- allocate(fractionalOccupations(numberOfSpecies,1))
- allocate(energyOfMolecularOrbital(numberOfSpecies,1))
- allocate(coefficientsOfCombination(numberOfSpecies,1))
- do l=1,numberOfSpecies
- call Vector_constructor( fractionalOccupations(l,1), &
- MolecularSystem_getTotalNumberOfContractions(l) )
- fractionalOccupations(l,1)%values=0.0
- do i=1, MolecularSystem_getOcupationNumber(l)
- fractionalOccupations(l,1)%values(i)=1.0_8 * MolecularSystem_getLambda(l)
- end do
- arguments(2) = MolecularSystem_getNameOfSpecies(l)
- arguments(1) = "COEFFICIENTS"
- coefficientsOfcombination(l,1) = &
- Matrix_getFromFile(unit=wfnUnit, &
- rows= int(MolecularSystem_getTotalNumberOfContractions(l),4), &
- columns= int(MolecularSystem_getTotalNumberOfContractions(l),4),&
- binary=.true., &
- arguments=arguments(1:2))
-
- arguments(1) = "ORBITALS"
- call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions(l), &
- unit = wfnUnit,&
- binary = .true.,&
- arguments = arguments(1:2), &
- output = energyOfMolecularOrbital(l,1) )
-
- end do
- close(wfnUnit)
-
+ if( this%wavefunctionType .eq. "CI") then
+ write (*,"(A50)") "We are printing molden files for the CI states!"
+ numberOfStates=CONTROL_instance%CI_STATES_TO_PRINT
+ else ! (this%wavefunctionType .eq. "HF")
+ numberOfStates=1
end if
-
+ allocate(fractionalOccupations(numberOfSpecies,numberOfStates))
+ allocate(coefficientsOfCombination(numberOfSpecies,numberOfStates))
+ allocate(energyOfMolecularOrbital(numberOfSpecies,numberOfStates))
+
+ call CalculateWaveFunction_loadCoefficientsMatrices ( numberOfSpecies, numberOfStates, this%wavefunctionType, coefficientsOfCombination, fractionalOccupations, energyOfMolecularOrbital)
do state=1,numberOfStates
do l=1,numberOfSpecies
if (state .eq. 1) then
- auxString=MolecularSystem_getNameOfSpecies( l )
+ auxString=MolecularSystem_getSymbolOfSpecies( l )
else
write(auxString, "(I8)") state
- auxString=trim(MolecularSystem_getNameOfSpecies( l ))//"-"//trim( adjustl(auxString))
+ auxString=trim(MolecularSystem_getSymbolOfSpecies( l ))//"-"//trim( adjustl(auxString))
end if
-
+
this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".molden"
totalNumberOfParticles = 0
@@ -527,39 +639,39 @@ subroutine OutputBuilder_writeMoldenFile(this)
write (10,"(A,I8,I8,F15.8,F15.8,F15.8)") trim(symbol), j,&
int(abs(molecularSystem_instance%allParticles( MolecularSystem_instance%species(l)%particles(j)%owner )%particlePtr%charge)) ,&
origin(1), origin(2), origin(3)
- ! int(abs(MolecularSystem_instance%species(l)%particles(j)%totalCharge)), &
+ ! int(abs(MolecularSystem_instance%species(l)%particles(j)%totalCharge)), &
end do
if ( CONTROL_instance%MOLDEN_FILE_FORMAT /= "QUANTUM" ) then
- m=j
- do k=1,size(localizationOfCenters%values,dim=1)
-
- wasPress=.false.
- do i=1,j
- if( abs( auxMatrix%values(i,1) - localizationOfCenters%values(k,1)) < 1.0D-9 .and. &
- abs( auxMatrix%values(i,2) - localizationOfCenters%values(k,2)) < 1.0D-9 .and. &
- abs( auxMatrix%values(i,3) - localizationOfCenters%values(k,3)) < 1.0D-9 ) then
- wasPress=.true.
- end if
- end do
-
- if( .not.wasPress) then
- m=m+1
-
- totalNumberOfParticles = totalNumberOfParticles + 1
- origin=localizationOfCenters%values(k,:)
- if ( CONTROL_instance%UNITS=="ANGS") origin = origin * AMSTRONG
- symbol=labels(k)
- if(scan(symbol,"_") /=0) symbol=symbol(1:scan(symbol,"_")-1)
-
- write (10,"(A,I8,I8,F15.8,F15.8,F15.8,I8)") trim(symbol), m,int(abs(charges(k))), origin(1), origin(2), origin(3)
-
- end if
-
- end do
- end if
+ m=j
+ do k=1,size(localizationOfCenters%values,dim=1)
+
+ wasPress=.false.
+ do i=1,j
+ if( abs( auxMatrix%values(i,1) - localizationOfCenters%values(k,1)) < 1.0D-9 .and. &
+ abs( auxMatrix%values(i,2) - localizationOfCenters%values(k,2)) < 1.0D-9 .and. &
+ abs( auxMatrix%values(i,3) - localizationOfCenters%values(k,3)) < 1.0D-9 ) then
+ wasPress=.true.
+ end if
+ end do
+
+ if( .not.wasPress) then
+ m=m+1
+
+ totalNumberOfParticles = totalNumberOfParticles + 1
+ origin=localizationOfCenters%values(k,:)
+ if ( CONTROL_instance%UNITS=="ANGS") origin = origin * AMSTRONG
+ symbol=labels(k)
+ if(scan(symbol,"_") /=0) symbol=symbol(1:scan(symbol,"_")-1)
+
+ write (10,"(A,I8,I8,F15.8,F15.8,F15.8,I8)") trim(symbol), m,int(abs(charges(k))), origin(1), origin(2), origin(3)
+
+ end if
+
+ end do
+ end if
! print *, "totalNumberOfParticles ", totalNumberOfParticles
! print *, "particles for specie", size(MolecularSystem_instance%species(l)%particles)
@@ -578,16 +690,16 @@ subroutine OutputBuilder_writeMoldenFile(this)
end do
if ( totalNumberOfParticles > size(MolecularSystem_instance%species(l)%particles) ) then
- if ( CONTROL_instance%MOLDEN_FILE_FORMAT == "MIXED" ) then
- do n = 1, ( totalNumberOfParticles - size(MolecularSystem_instance%species(l)%particles) )
- write(10,"(I3,I2)") j+n,0
- write(10,"(A,I1,F5.2)") " s ",1,1.00
- write(10,"(ES19.10,ES19.10)") 1.00,1.00
- write(10,*) ""
- end do
- end if
+ if ( CONTROL_instance%MOLDEN_FILE_FORMAT == "MIXED" ) then
+ do n = 1, ( totalNumberOfParticles - size(MolecularSystem_instance%species(l)%particles) )
+ write(10,"(I3,I2)") j+n,0
+ write(10,"(A,I1,F5.2)") " s ",1,1.00
+ write(10,"(ES19.10,ES19.10)") 1.00,1.00
+ write(10,*) ""
+ end do
+ end if
end if
- ! end if
+ ! end if
write(10,*) ""
write(10,"(A)") "[MO]"
@@ -610,13 +722,13 @@ subroutine OutputBuilder_writeMoldenFile(this)
write(10,"(I4,A2,F15.8)") k," ", coefficientsOfCombination(l,state)%values(k,j)
end do
- if ( totalNumberOfParticles > size(MolecularSystem_instance%species(l)%particles) ) then
+ if ( totalNumberOfParticles > size(MolecularSystem_instance%species(l)%particles) ) then
if ( CONTROL_instance%MOLDEN_FILE_FORMAT == "MIXED" ) then
- do n = 1, ( totalNumberOfParticles - size(MolecularSystem_instance%species(l)%particles) )
- write(10,"(I4,A2,ES15.8)") i+n," ", 0.0
- end do
+ do n = 1, ( totalNumberOfParticles - size(MolecularSystem_instance%species(l)%particles) )
+ write(10,"(I4,A2,ES15.8)") i+n," ", 0.0
+ end do
end if
- end if
+ end if
end do
@@ -651,7 +763,7 @@ subroutine OutputBuilder_VecGamessFile(this)
character(100) :: wfnFile
integer :: numberOfContractions
character(50) :: arguments(2)
-
+
wfnFile = "lowdin.wfn"
wfnUnit = 20
@@ -660,7 +772,7 @@ subroutine OutputBuilder_VecGamessFile(this)
do l=1,MolecularSystem_getNumberOfQuantumSpecies()
- auxString=MolecularSystem_getNameOfSpecies( l )
+ auxString=MolecularSystem_getSymbolOfSpecies( l )
this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".vec"
@@ -767,25 +879,25 @@ subroutine OutputBuilder_casinoFile(this)
!! Open file for wavefunction
open(unit = wfnUnit, file = trim(wfnFile), status = "old", form = "unformatted")
-
+
this%fileName = trim(CONTROL_instance%INPUT_FILE)//"casino"
open(29,file=this%fileName(1),status='replace',action='write')
select case ( MolecularSystem_getNumberOfQuantumSpecies() )
- case (1)
- numberOfContractionsA = MolecularSystem_getTotalNumberOfContractions(1)
- numberOfContractionsB = 0
- numberOfShellsA = MolecularSystem_getNumberOfContractions(1)
- numberOfShellsB = 0
-
- case (2)
- numberOfContractionsA = MolecularSystem_getTotalNumberOfContractions(1)
- numberOfContractionsB = MolecularSystem_getTotalNumberOfContractions(2)
- numberOfShellsA = MolecularSystem_getNumberOfContractions(1)
- numberOfShellsB = MolecularSystem_getNumberOfContractions(2)
- case default
- call OutputBuilder_exception(ERROR, "The maximum number of quantum species cannot be greater than two", "OutputBuilder_casinoFile" )
+ case (1)
+ numberOfContractionsA = MolecularSystem_getTotalNumberOfContractions(1)
+ numberOfContractionsB = 0
+ numberOfShellsA = MolecularSystem_getNumberOfContractions(1)
+ numberOfShellsB = 0
+
+ case (2)
+ numberOfContractionsA = MolecularSystem_getTotalNumberOfContractions(1)
+ numberOfContractionsB = MolecularSystem_getTotalNumberOfContractions(2)
+ numberOfShellsA = MolecularSystem_getNumberOfContractions(1)
+ numberOfShellsB = MolecularSystem_getNumberOfContractions(2)
+ case default
+ call Exception_stopError("The maximum number of quantum species cannot be greater than two", "OutputBuilder_casinoFile" )
end select
totalShells = numberOfShellsA + numberOfShellsB
@@ -793,15 +905,15 @@ subroutine OutputBuilder_casinoFile(this)
superSize = 0
maxl = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- specieID = l
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(specieID)
- superSize = superSize + numberOfContractions
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
- maxl = max( maxl, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment)
- end do
- end do
- end do
+ specieID = l
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(specieID)
+ superSize = superSize + numberOfContractions
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ maxl = max( maxl, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment)
+ end do
+ end do
+ end do
!! Basic info
@@ -818,10 +930,10 @@ subroutine OutputBuilder_casinoFile(this)
write (29,*) "Periodicity:"
write (29,*) "0"
write (29,*) "Spin unrestricted:"
- if ( CONTROL_instance%IS_OPEN_SHELL ) write (29,*) ".true."
- if ( .not. CONTROL_instance%IS_OPEN_SHELL ) write (29,*) ".false."
+ if ( CONTROL_instance%IS_OPEN_SHELL ) write (29,*) ".true."
+ if ( .not. CONTROL_instance%IS_OPEN_SHELL ) write (29,*) ".false."
write (29,*) "nuclear-nuclear repulsion energy (au/atom):"
- call Vector_getFromFile(unit=wfnUnit, binary=.true., value=puntualInteractionEnergy, arguments=["PUNTUALINTERACTIONENERGY"])
+ call Vector_getFromFile(unit=wfnUnit, binary=.true., value=puntualInteractionEnergy, arguments=["PUNTUALINTERACTIONENERGY"])
write (29,*) puntualInteractionEnergy
write (29,*) "Number of electrons per primitive cell:" !! ?
write (29,*) "2"
@@ -833,29 +945,29 @@ subroutine OutputBuilder_casinoFile(this)
write (29,*) "Number of atoms:" !! centers?
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- m = m + size(MolecularSystem_instance%species(l)%particles)
- end do
+ m = m + size(MolecularSystem_instance%species(l)%particles)
+ end do
write (29,"(T4,I4)") m
write (29,*) "Atomic positions (au):" !! centers?
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- m = m + 1
- write (29, "(3ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%origin(1:3)
- end do
- end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ m = m + 1
+ write (29, "(3ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%origin(1:3)
+ end do
+ end do
write (29,*) "Atomic numbers for each atom:"
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- m = m + 1
- if (mod(m,8)==0) then
- write (29,"(I10)") int(MolecularSystem_instance%species(l)%particles(g)%charge)
- else
- write (29,"(I10)",advance="no") int(MolecularSystem_instance%species(l)%particles(g)%charge)
- end if
- end do
- end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ m = m + 1
+ if (mod(m,8)==0) then
+ write (29,"(I10)") int(MolecularSystem_instance%species(l)%particles(g)%charge)
+ else
+ write (29,"(I10)",advance="no") int(MolecularSystem_instance%species(l)%particles(g)%charge)
+ end if
+ end do
+ end do
if (.not. mod(m,8)==0) write (29,"(A)", advance='yes') " "
!write (29,*) "_ii_ _ii_"
!write (29,"(2I10)") 1,0
@@ -863,15 +975,15 @@ subroutine OutputBuilder_casinoFile(this)
!write (29,*) " 1.0000000000000E+00 0.0000000000000E+00"
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- m = m + 1
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%charge
- else
- write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%charge
- end if
- end do
- end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ m = m + 1
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%charge
+ else
+ write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%charge
+ end if
+ end do
+ end do
if (.not. mod(m,8)==0) write (29,"(A)", advance='yes') " "
write (29,*) ""
!! Basis set
@@ -881,8 +993,8 @@ subroutine OutputBuilder_casinoFile(this)
write (29,*) "Number of Gaussian centres"
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- m = m + size(MolecularSystem_instance%species(l)%particles)
- end do
+ m = m + size(MolecularSystem_instance%species(l)%particles)
+ end do
write (29,"(T4,I4)") m
write (29,*) "Number of shells per primitive cell" !! total?
write (29,"(T4,I4)") totalShells
@@ -895,37 +1007,37 @@ subroutine OutputBuilder_casinoFile(this)
write (29,*) "Code for shell types (s/sp/p/d/f... 1/2/3/4/5...) "
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
- m = m + 1
- shellCode = 0
- if ( MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment == 0 ) shellCode = 1
- if ( MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment > 0 ) shellCode = 2
-
- if (mod(m,8)==0) then
- write (29,"(I10)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment + shellCode
- else
- write (29,"(I10)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment + shellCode
- end if
- end do
- end do
- end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ m = m + 1
+ shellCode = 0
+ if ( MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment == 0 ) shellCode = 1
+ if ( MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment > 0 ) shellCode = 2
+
+ if (mod(m,8)==0) then
+ write (29,"(I10)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment + shellCode
+ else
+ write (29,"(I10)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%angularMoment + shellCode
+ end if
+ end do
+ end do
+ end do
if (.not. mod(m,8)==0) write (29,"(A)", advance='yes') " "
write (29,*) "Number of primitive Gaussians in each shell"
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
- m = m + 1
- if (mod(m,8)==0) then
- write (29,"(I10)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
- else
- write (29,"(I10)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
- end if
- end do
- end do
- end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ m = m + 1
+ if (mod(m,8)==0) then
+ write (29,"(I10)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
+ else
+ write (29,"(I10)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
+ end if
+ end do
+ end do
+ end do
if (.not. mod(m,8)==0) write (29,"(A)", advance='yes') " "
write (29,*) "Sequence number of first shell on each centre"
@@ -933,74 +1045,74 @@ subroutine OutputBuilder_casinoFile(this)
write (29,*) "Exponents of Gaussian primitives"
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
- do i = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
- m = m + 1
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%orbitalExponents(i)
- else
- write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%orbitalExponents(i)
- end if
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ do i = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
+ m = m + 1
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%orbitalExponents(i)
+ else
+ write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%orbitalExponents(i)
+ end if
+ end do
end do
- end do
- end do
- end do
+ end do
+ end do
if (.not. mod(m,4)==0) write (29,"(A)", advance='yes') " "
write (29,*) "Normalised contraction coefficients" !! check this...
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
- do i = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
-! do j = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%numCartesianOrbital
-! m = m + 1
-! if (mod(m,4)==0) then
-! write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,j)
-! else
-! write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,j)
-! end if
-! end do
-
-! do j = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%numCartesianOrbital
- m = m + 1
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,1)
- else
- write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,1)
- end if
-! end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ do i = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
+ ! do j = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%numCartesianOrbital
+ ! m = m + 1
+ ! if (mod(m,4)==0) then
+ ! write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,j)
+ ! else
+ ! write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,j)
+ ! end if
+ ! end do
+
+ ! do j = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%numCartesianOrbital
+ m = m + 1
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,1)
+ else
+ write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%primNormalization(i,1)
+ end if
+ ! end do
+ end do
end do
- end do
- end do
- end do
+ end do
+ end do
if (.not. mod(m,4)==0) write (29,"(A)", advance='yes') " "
-! m = 0
-! do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
-! do g = 1, size(MolecularSystem_instance%species(l)%particles)
-! do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
-! do i = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
-! m = m + 1
-! if (mod(m,4)==0) then
-! write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%contNormalization(i)
-! else
-! write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%contNormalization(i)
-! end if
-! end do
-! end do
-! end do
-! end do
+ ! m = 0
+ ! do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
+ ! do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ ! do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ ! do i = 1, MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%length
+ ! m = m + 1
+ ! if (mod(m,4)==0) then
+ ! write (29,"(ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%contNormalization(i)
+ ! else
+ ! write (29,"(ES20.13)",advance="no") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%contNormalization(i)
+ ! end if
+ ! end do
+ ! end do
+ ! end do
+ ! end do
write (29,*) "Position of each shell (au)"
m = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- do g = 1, size(MolecularSystem_instance%species(l)%particles)
- do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
- m = m + 1
- write (29,"(3ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%origin(1:3)
- end do
- end do
- end do
+ do g = 1, size(MolecularSystem_instance%species(l)%particles)
+ do h = 1, size(MolecularSystem_instance%species(l)%particles(g)%basis%contraction)
+ m = m + 1
+ write (29,"(3ES20.13)") MolecularSystem_instance%species(l)%particles(g)%basis%contraction(h)%origin(1:3)
+ end do
+ end do
+ end do
write (29,"(A)", advance='yes')" "
@@ -1013,7 +1125,7 @@ subroutine OutputBuilder_casinoFile(this)
write (29,*) "EIGENVECTOR COEFFICIENTS"
write (29,*) "------------------------"
-
+
!! Save the MO coefficients in a supermatrix from for all quantum species (2...)
if ( allocated (superMatrix) ) deallocate (superMatrix)
@@ -1024,164 +1136,164 @@ subroutine OutputBuilder_casinoFile(this)
j0 = 0
do l = 1,MolecularSystem_getNumberOfQuantumSpecies()
- specieID = l
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(specieID)
- arguments(2) = MolecularSystem_getNameOfSpecies(specieID)
- arguments(1) = "COEFFICIENTS"
- coefficientsOfcombination = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
- columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
-
- do i =1, numberOfContractions
- do j =1, numberOfContractions
- superMatrix(i+i0,j+j0) = coefficientsOfCombination%values(i,j)
- end do
- end do
- !! starting positron for the next species
- i0 = i-1
- j0 = j-1
- print *, "i0 j0", i0, j0
+ specieID = l
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(specieID)
+ arguments(2) = MolecularSystem_getNameOfSpecies(specieID)
+ arguments(1) = "COEFFICIENTS"
+ coefficientsOfcombination = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), &
+ columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2))
+
+ do i =1, numberOfContractions
+ do j =1, numberOfContractions
+ superMatrix(i+i0,j+j0) = coefficientsOfCombination%values(i,j)
+ end do
+ end do
+ !! starting positron for the next species
+ i0 = i-1
+ j0 = j-1
+ print *, "i0 j0", i0, j0
end do
do i =1, superSize
- j =1
- !if (mod(numberOfContractions,2)) then
- if (mod(superSize,2) == 1 ) then
- !!!Se activa cuando el numberOfContractions es impar
- do m=1,superSize
+ j =1
+ !if (mod(numberOfContractions,2)) then
+ if (mod(superSize,2) == 1 ) then
+!!!Se activa cuando el numberOfContractions es impar
+ do m=1,superSize
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") superMatrix(m,i)
- j = j + 1
- else
- write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") superMatrix(m,i)
+ j = j + 1
+ else
+ write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ end if
+ end do
+ !write (29, "(A)", advance='yes')" "
+ if (m <= superSize) then
+ write (29,"(A)", advance='no')" "
+ !write (29,"(A)")" "
end if
- end do
- !write (29, "(A)", advance='yes')" "
- if (m <= superSize) then
- write (29,"(A)", advance='no')" "
- !write (29,"(A)")" "
- end if
- else
- !!Se activa cuando el numberOfContractions es par
- do m=1, superSize
+ else
+ !!Se activa cuando el numberOfContractions es par
+ do m=1, superSize
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") superMatrix(m,i)
- j = j + 1
- else
- write (29,"(ES20.13)",advance='no') superMatrix(m,i)
- end if
- end do
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") superMatrix(m,i)
+ j = j + 1
+ else
+ write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ end if
+ end do
!write (29, "(A)", advance='yes')" "
- if (m <= superSize) then
- write (29,"(A)", advance='no') " "
- !write (29,"(A)")" "
- end if
-
- end if
-
- if (.not. mod(m-1,4)==0) write (29,"(A)", advance='yes') " "
+ if (m <= superSize) then
+ write (29,"(A)", advance='no') " "
+ !write (29,"(A)")" "
+ end if
+
+ end if
+
+ if (.not. mod(m-1,4)==0) write (29,"(A)", advance='yes') " "
end do
!! write it twice... why?
do i = numberOfContractionsB + 1, superSize
- j =1
- !if (mod(numberOfContractions,2)) then
- if (mod(superSize,2) == 1 ) then
- !!!Se activa cuando el numberOfContractions es impar
- do m=1,superSize
+ j =1
+ !if (mod(numberOfContractions,2)) then
+ if (mod(superSize,2) == 1 ) then
+!!!Se activa cuando el numberOfContractions es impar
+ do m=1,superSize
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") superMatrix(m,i)
- j = j + 1
- else
- write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") superMatrix(m,i)
+ j = j + 1
+ else
+ write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ end if
+ end do
+ !write (29, "(A)", advance='yes')" "
+ if (m < superSize) then
+ write (29,"(A)", advance='no')" "
+ !write (29,"(A)")" "
end if
- end do
- !write (29, "(A)", advance='yes')" "
- if (m < superSize) then
- write (29,"(A)", advance='no')" "
- !write (29,"(A)")" "
- end if
- else
- !!Se activa cuando el numberOfContractions es par
- do m=1, superSize
+ else
+ !!Se activa cuando el numberOfContractions es par
+ do m=1, superSize
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") superMatrix(m,i)
- j = j + 1
- else
- write (29,"(ES20.13)",advance='no') superMatrix(m,i)
- end if
- end do
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") superMatrix(m,i)
+ j = j + 1
+ else
+ write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ end if
+ end do
!write (29, "(A)", advance='yes')" "
- if (m < superSize) then
- write (29,"(A)", advance='no') " "
- !write (29,"(A)")" "
- end if
-
- end if
-
- if (.not. mod(m-1,4)==0) write (29,"(A)", advance='yes') " "
+ if (m < superSize) then
+ write (29,"(A)", advance='no') " "
+ !write (29,"(A)")" "
+ end if
+
+ end if
+
+ if (.not. mod(m-1,4)==0) write (29,"(A)", advance='yes') " "
end do
do i = 1, numberOfContractionsA
- j =1
- !if (mod(numberOfContractions,2)) then
- if (mod(superSize,2) == 1 ) then
- !!!Se activa cuando el numberOfContractions es impar
- do m=1,superSize
+ j =1
+ !if (mod(numberOfContractions,2)) then
+ if (mod(superSize,2) == 1 ) then
+!!!Se activa cuando el numberOfContractions es impar
+ do m=1,superSize
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") superMatrix(m,i)
- j = j + 1
- else
- write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") superMatrix(m,i)
+ j = j + 1
+ else
+ write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ end if
+ end do
+ !write (29, "(A)", advance='yes')" "
+ if (m < superSize) then
+ write (29,"(A)", advance='no')" "
+ !write (29,"(A)")" "
end if
- end do
- !write (29, "(A)", advance='yes')" "
- if (m < superSize) then
- write (29,"(A)", advance='no')" "
- !write (29,"(A)")" "
- end if
- else
- !!Se activa cuando el numberOfContractions es par
- do m=1, superSize
+ else
+ !!Se activa cuando el numberOfContractions es par
+ do m=1, superSize
- if (mod(m,4)==0) then
- write (29,"(ES20.13)") superMatrix(m,i)
- j = j + 1
- else
- write (29,"(ES20.13)",advance='no') superMatrix(m,i)
- end if
- end do
+ if (mod(m,4)==0) then
+ write (29,"(ES20.13)") superMatrix(m,i)
+ j = j + 1
+ else
+ write (29,"(ES20.13)",advance='no') superMatrix(m,i)
+ end if
+ end do
!write (29, "(A)", advance='yes')" "
- if (m < superSize) then
- write (29,"(A)", advance='no') " "
- !write (29,"(A)")" "
- end if
-
- end if
-
- if (.not. mod(m-1,4)==0) write (29,"(A)", advance='yes') " "
+ if (m < superSize) then
+ write (29,"(A)", advance='no') " "
+ !write (29,"(A)")" "
+ end if
+
+ end if
+
+ if (.not. mod(m-1,4)==0) write (29,"(A)", advance='yes') " "
end do
write (29,"(A)") ""
close(20)
close(29)
- call OutputBuilder_exception(WARNING, "The order of the coefficients only works until P orbitals", "OutputBuilder_casinoFile" )
-
+ call Exception_sendWarning("The order of the coefficients only works until P orbitals", "OutputBuilder_casinoFile" )
+
end subroutine OutputBuilder_casinoFile
-
+
!!Escribe los valores propios en el archivo eigenvalues.dat para que puedan ser leidos por GAMESS Laura
- subroutine OutputBuilder_writeEigenvalues(this)
+ subroutine OutputBuilder_writeEigenvalues(this)
implicit none
type(OutputBuilder) :: this
@@ -1205,55 +1317,55 @@ subroutine OutputBuilder_writeEigenvalues(this)
wfnFile = "lowdin.wfn"
wfnUnit = 20
- ! auxString=MolecularSystem_getNameOfSpecies( 1 )
- ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//".eigen"
- ! open(129,file=this%fileName,status='replace',action='write')
- ! close(129)
+ ! auxString=MolecularSystem_getNameOfSpecies( 1 )
+ ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//".eigen"
+ ! open(129,file=this%fileName,status='replace',action='write')
+ ! close(129)
- localizationOfCenters=ParticleManager_getCartesianMatrixOfCentersOfOptimization()
- auxMatrix=localizationOfCenters
- allocate( labels( size(auxMatrix%values,dim=1) ) )
- allocate( charges( size(auxMatrix%values,dim=1) ) )
- labels=ParticleManager_getLabelsOfCentersOfOptimization()
- charges=ParticleManager_getChargesOfCentersOfOptimization()
+ localizationOfCenters=ParticleManager_getCartesianMatrixOfCentersOfOptimization()
+ auxMatrix=localizationOfCenters
+ allocate( labels( size(auxMatrix%values,dim=1) ) )
+ allocate( charges( size(auxMatrix%values,dim=1) ) )
+ labels=ParticleManager_getLabelsOfCentersOfOptimization()
+ charges=ParticleManager_getChargesOfCentersOfOptimization()
-!! Open file for wavefunction
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
+ !! Open file for wavefunction
+ open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
- do l=1,MolecularSystem_getNumberOfQuantumSpecies()
+ do l=1,MolecularSystem_getNumberOfQuantumSpecies()
+
+ totalNumberOfParticles = 0
- totalNumberOfParticles = 0
+ auxString=MolecularSystem_getSymbolOfSpecies( l )
+ specieID = MolecularSystem_getSpecieID(auxString)
+ this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".eigen"
+ open(129,file=this%fileName(l),status='replace',action='write')
- auxString=MolecularSystem_getNameOfSpecies( l )
- specieID = MolecularSystem_getSpecieID(auxString)
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".eigen"
- open(129,file=this%fileName(l),status='replace',action='write')
+ specieID = int( MolecularSystem_getSpecieID(nameOfSpecie = trim(auxString)) )
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(specieID)
+ arguments(2) = MolecularSystem_getNameOfSpecies(specieID)
- specieID = int( MolecularSystem_getSpecieID(nameOfSpecie = trim(auxString)) )
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(specieID)
- arguments(2) = MolecularSystem_getNameOfSpecies(specieID)
+ arguments(1) = "ORBITALS"
+ call Vector_getFromFile( elementsNum = numberOfContractions, &
+ unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
+ output = energyOfMolecularOrbital )
- arguments(1) = "ORBITALS"
- call Vector_getFromFile( elementsNum = numberOfContractions, &
- unit = wfnUnit, binary = .true., arguments = arguments(1:2), &
- output = energyOfMolecularOrbital )
+ do j=1,size(energyOfMolecularOrbital%values)
+ write (129,"(F15.12)") energyOfMolecularOrbital%values(j)
+ end do
+ close(129)
+ end do
- do j=1,size(energyOfMolecularOrbital%values)
- write (129,"(F15.12)") energyOfMolecularOrbital%values(j)
- end do
- close(129)
- end do
+ call Matrix_destructor( localizationOfCenters )
+ call Matrix_destructor( auxMatrix )
+ deallocate(labels)
- call Matrix_destructor( localizationOfCenters )
- call Matrix_destructor( auxMatrix )
- deallocate(labels)
-
end subroutine OutputBuilder_writeEigenvalues
-
- subroutine OutputBuilder_writeFchkFile(this)
+
+ subroutine OutputBuilder_writeFchkFile(this)
implicit none
type(OutputBuilder) :: this
@@ -1278,7 +1390,7 @@ subroutine OutputBuilder_writeFchkFile(this)
real(8) :: particlesPerOrbital
type(matrix) :: densityMatrix
real(8) :: densityElement
- character(50) :: nameOfSpecies
+ character(50) :: nameOfSpecies, symbolOfSpecies
character(40) :: header
character(50) :: arguments(2)
@@ -1291,40 +1403,6 @@ subroutine OutputBuilder_writeFchkFile(this)
charges=ParticleManager_getChargesOfCentersOfOptimization()
numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
-
- !! Check if there are CI fractional occupations or build the occupations vector
- ! allocate(fractionalOccupations(numberOfSpecies))
-
- ! occupationsFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- ! inquire(FILE = occupationsFile, EXIST = existFile )
-
- ! if ( CONTROL_instance%CONFIGURATION_INTERACTION_LEVEL /= "NONE" .and. CONTROL_instance%CI_STATES_TO_PRINT .gt. 0 .and. existFile) then
-
- ! print *, " We are printing the fchk files for the CI states!"
-
- ! numberOfStates=CONTROL_instance%CI_STATES_TO_PRINT
- ! occupationsUnit = 29
-
- ! open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
- ! do l=1,numberOfSpecies
- ! arguments(1) = "OCCUPATIONS"
- ! arguments(2) = MolecularSystem_getNameOfSpecies( l )
- ! fractionalOccupations(l)= Matrix_getFromFile(unit=occupationsUnit,&
- ! rows=int(MolecularSystem_getTotalNumberOfContractions(l),4),&
- ! columns=int(numberOfStates,4),&
- ! arguments=arguments(1:2))
- ! end do
- ! close(occupationsUnit)
- ! else
- ! numberOfStates=1
- ! do l=1,numberOfSpecies
- ! call Matrix_constructor( fractionalOccupations(l), int(MolecularSystem_getTotalNumberOfContractions(l),8), int(numberOfStates,8), 0.0_8)
- ! do i=1, MolecularSystem_getOcupationNumber(l)
- ! fractionalOccupations(l)%values(i,1)=1.0_8 * MolecularSystem_getLambda(l)
- ! end do
- ! end do
- ! end if
-
!! Open file for wavefunction
wfnFile = "lowdin.wfn"
@@ -1334,6 +1412,7 @@ subroutine OutputBuilder_writeFchkFile(this)
! do state=1,numberOfStates
do l=1,numberOfSpecies
nameOfSpecies=MolecularSystem_getNameOfSpecies(l)
+ symbolOfSpecies=MolecularSystem_getSymbolOfSpecies(l)
particlesPerOrbital=MolecularSystem_getLambda(l)
! if (state .eq. 1) then
! auxString=nameOfSpecies
@@ -1343,7 +1422,7 @@ subroutine OutputBuilder_writeFchkFile(this)
! end if
! this%fileName=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".fchk"
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".fchk"
+ this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".fchk"
numberOfAtoms=size(MolecularSystem_instance%species(l)%particles)
numberOfShells=MolecularSystem_getNumberOfContractions(l)
@@ -1548,8 +1627,8 @@ subroutine OutputBuilder_writeFchkFile(this)
end do
end if
-
- call MolecularSystem_changeOrbitalOrder( coefficientsOfCombination, l, "LOWDIN", "MOLDEN" )
+
+ call MolecularSystem_changeOrbitalOrder( coefficientsOfCombination, l, "LOWDIN", "FCHK" )
header="Alpha MO coefficients"
write(10,"(A40,3X,A1,3X,A2,I12)") header , "R", "N=", numberOfContractions**2
@@ -1582,7 +1661,7 @@ subroutine OutputBuilder_writeFchkFile(this)
end do
end do
end if
-
+
!Build density matrix with the new order
do i=1, numberOfContractions
do j=1, numberOfContractions
@@ -1640,8 +1719,8 @@ subroutine OutputBuilder_writeFchkFile(this)
! end do
end subroutine OutputBuilder_writeFchkFile
-
-
+
+
!**
! @brief Call the molden2aim library to generate the wfn, wfx or NBO47 files from a molden file.
!**
@@ -1687,59 +1766,59 @@ subroutine OutputBuilder_generateAIMFiles (this)
end select
open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
- call Vector_getFromFile(unit=wfnUnit, binary=.true., value=totalEnergy, arguments=["TOTALENERGY"])
- call Vector_getFromFile(unit=wfnUnit, binary=.true., value=virial, arguments=["VIRIAL"])
+ call Vector_getFromFile(unit=wfnUnit, binary=.true., value=totalEnergy, arguments=["TOTALENERGY"])
+ call Vector_getFromFile(unit=wfnUnit, binary=.true., value=virial, arguments=["VIRIAL"])
close(wfnUnit)
open (35,file=initialSettingsFile,status='unknown',action='write')
- write(35,"(A)") " ######################################################################## "
- Write(35,"(A)") " # In the following 6 parameters "
- Write(35,"(A)") " # >0: always performs the operation without asking the user "
- Write(35,"(A)") " # =0: asks the user whether to perform the operation "
- Write(35,"(A)") " # <0: always neglect the operation without asking the user "
- Write(35,"(A)") " molden=1 ! Generating a standard Molden file in Cart. function "
- Write(35,"(A)") " wfn="//wfnStatus//" ! Generating a WFN file "
- Write(35,"(A)") " wfncheck=-1 ! Checking normalization for WFN "
- Write(35,"(A)") " wfx="//wfxStatus//" ! Generating a WFX file (not implemented) "
- Write(35,"(A)") " wfxcheck=-1 ! Checking normalization for WFX (not implemented) "
- Write(35,"(A)") " nbo="//nboStatus//" ! Generating a NBO .47 file "
- Write(35,"(A)") " nbocheck=-1 ! Checking normalization for NBO's .47 "
- Write(35,"(A)") " ######################################################################## "
- Write(35,"(A)") " # Which quantum chemistry program is used to generate the MOLDEN file? "
- Write(35,"(A)") " # 1: ORCA "
- Write(35,"(A)") " # 5: ACES2 "
- Write(35,"(A)") " # 0: other programs "
- Write(35,"(A)") " # "
- Write(35,"(A)") " # If non-zero value is given "
- Write(35,"(A)") " # "
- Write(35,"(A)") " program=0 "
- Write(35,"(A)") " ######################################################################## "
- Write(35,"(A)") " # Which orbirals will be printed in the WFN/WFX file? "
- Write(35,"(A)") " # =0: print only the orbitals with occ. number > 5.0d-8 "
- Write(35,"(A)") " # <0: print only the orbitals with occ. number > 0.1 (debug only) "
- Write(35,"(A)") " # >0: print all the orbitals "
- Write(35,"(A)") " iallmo=1 "
- Write(35,"(A)") " ######################################################################## "
- Write(35,"(A)") " # Print supporting information or not "
- Write(35,"(A)") " # =0: print "
- Write(35,"(A)") " nosupp=-1 "
- Write(35,"(A)") " ######################################################################## "
- Write(35,"(A)") " # The following parameters are used only for debugging. "
- Write(35,"(A)") " clear=1 ! delete temporary files (1) or not (0) "
- Write(35,"(A)") " ######################################################################## "
+ write(35,"(A)") " ######################################################################## "
+ Write(35,"(A)") " # In the following 6 parameters "
+ Write(35,"(A)") " # >0: always performs the operation without asking the user "
+ Write(35,"(A)") " # =0: asks the user whether to perform the operation "
+ Write(35,"(A)") " # <0: always neglect the operation without asking the user "
+ Write(35,"(A)") " molden=1 ! Generating a standard Molden file in Cart. function "
+ Write(35,"(A)") " wfn="//wfnStatus//" ! Generating a WFN file "
+ Write(35,"(A)") " wfncheck=-1 ! Checking normalization for WFN "
+ Write(35,"(A)") " wfx="//wfxStatus//" ! Generating a WFX file (not implemented) "
+ Write(35,"(A)") " wfxcheck=-1 ! Checking normalization for WFX (not implemented) "
+ Write(35,"(A)") " nbo="//nboStatus//" ! Generating a NBO .47 file "
+ Write(35,"(A)") " nbocheck=-1 ! Checking normalization for NBO's .47 "
+ Write(35,"(A)") " ######################################################################## "
+ Write(35,"(A)") " # Which quantum chemistry program is used to generate the MOLDEN file? "
+ Write(35,"(A)") " # 1: ORCA "
+ Write(35,"(A)") " # 5: ACES2 "
+ Write(35,"(A)") " # 0: other programs "
+ Write(35,"(A)") " # "
+ Write(35,"(A)") " # If non-zero value is given "
+ Write(35,"(A)") " # "
+ Write(35,"(A)") " program=0 "
+ Write(35,"(A)") " ######################################################################## "
+ Write(35,"(A)") " # Which orbirals will be printed in the WFN/WFX file? "
+ Write(35,"(A)") " # =0: print only the orbitals with occ. number > 5.0d-8 "
+ Write(35,"(A)") " # <0: print only the orbitals with occ. number > 0.1 (debug only) "
+ Write(35,"(A)") " # >0: print all the orbitals "
+ Write(35,"(A)") " iallmo=1 "
+ Write(35,"(A)") " ######################################################################## "
+ Write(35,"(A)") " # Print supporting information or not "
+ Write(35,"(A)") " # =0: print "
+ Write(35,"(A)") " nosupp=-1 "
+ Write(35,"(A)") " ######################################################################## "
+ Write(35,"(A)") " # The following parameters are used only for debugging. "
+ Write(35,"(A)") " clear=1 ! delete temporary files (1) or not (0) "
+ Write(35,"(A)") " ######################################################################## "
close(35)
-
+
do l=1,MolecularSystem_getNumberOfQuantumSpecies()
- auxString=MolecularSystem_getNameOfSpecies( l )
- moldenFileName=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".molden"
- call Molden2AIM(moldenFileName, totalEnergy, virial)
- !! Just for printing information
- this%fileName(l) = trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//extension//" and .molden"
+ auxString=MolecularSystem_getSymbolOfSpecies( l )
+ moldenFileName=trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//".molden"
+ call Molden2AIM(moldenFileName, totalEnergy, virial)
+ !! Just for printing information
+ this%fileName(l) = trim(CONTROL_instance%INPUT_FILE)//trim(auxString)//extension//" and .molden"
end do
-
+
end subroutine OutputBuilder_generateAIMFiles
-!! For future implementation
+ !! For future implementation
subroutine OutputBuilder_generateExtendedWfnFile (this)
implicit none
@@ -1748,897 +1827,424 @@ subroutine OutputBuilder_generateExtendedWfnFile (this)
character(50) :: auxString
do l=1,MolecularSystem_getNumberOfQuantumSpecies()
- auxString=MolecularSystem_getNameOfSpecies( l )
+ auxString=MolecularSystem_getNameOfSpecies( l )
end do
end subroutine OutputBuilder_generateExtendedWfnFile
- subroutine OutputBuilder_get3DPlot(this)
- type(OutputBuilder) :: this
- character(50) :: outputID, auxID
- character(50) :: orbitalNum
+ subroutine OutputBuilder_getCube(this )
+ implicit none
+ type(OutputBuilder) :: this
+ character(50) :: outputID, auxID
- integer :: speciesID
- character(50) :: nameOfSpecies
- integer :: i,j,n
- integer :: numberOfSteps
- type(vector) :: step1
- type(vector) :: step2
- real(8) :: maxValue, maxValue2
- real(8) :: minValue, minValue2
- real(8) :: plotDistance1, plotDistance2
- Type(Vector) :: val
- Type(Matrix) :: coordinate
-
- character(50) :: title
- character(50) :: x_title
- character(50) :: y_title
- character(50) :: z_title
-
- call Vector_Constructor(step1, 3)
- call Vector_Constructor(step2, 3)
- speciesID = MolecularSystem_getSpecieIDFromSymbol( trim(this%species) )
- nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
-
- this%fileName2=""
- numberOfSteps= CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
- plotDistance1=sqrt(sum((this%point2%values(:)-this%point1%values(:))**2))
- plotDistance2=sqrt(sum((this%point3%values(:)-this%point1%values(:))**2))
- step1%values(:)=(this%point2%values(:)-this%point1%values(:))/numberOfSteps
- step2%values(:)=(this%point3%values(:)-this%point1%values(:))/numberOfSteps
- outputID=String_convertIntegerToString(this%outputID)
- auxID=String_convertIntegerToString(this%auxID)
-
- x_title="x/a.u."
- y_title="y/a.u."
- z_title=""
-
- select case( this%type )
-
- case ( "ORBITALPLOT")
- orbitalNum=String_convertIntegerToString(this%orbital)
- if( this%auxID .eq. 1) then
- this%fileName(1)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".3D.orb"//trim(orbitalNum)
- else
- this%fileName(1)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".3D-"//trim(auxID)//".orb"//trim(orbitalNum)
- end if
- open(10,file=this%fileName(1),status='replace',action='write')
- write (10,"(A10,A20,A20,A20)") "#", "X","Y","OrbitalValue"
- title=trim(this%species)//" Orbital Number: "//trim(orbitalNum)
-
- ! case ( "FUKUIPLOT")
- ! this%fileName(1)=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%species)//".3D.fkpos"
- ! this%fileName2=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%species)//".3D.fkneg"
- ! open(10,file=this%fileName(1),status='replace',action='write')
- ! write (10,"(A10,A20,A20,A20)") "#", "X","Y","PositiveFukuiValue"
- ! title=trim(this%species)//" Positive Fukui"
- ! open(11,file=this%fileName2,status='replace',action='write')
- ! write (11,"(A10,A20,A20,A20)") "#", "X","Y","NegativeFukuiValue"
- ! title2=trim(this%species)//" Negative Fukui"
-
- case default
- call OutputBuilder_exception(ERROR, "The output plot type you requested has not been implemented yet", "OutputBuilder_get3DPlot" )
-
- end select
-
- maxValue=0.0_8
- minValue=0.0_8
- maxValue2=0.0_8
- minValue2=0.0_8
- call Matrix_constructor(coordinate,int((numberOfSteps+1)**2,8),int(3,8),0.0_8)
- n=0
- do i=0,numberOfSteps
- do j=0,numberOfSteps
- n=n+1
- coordinate%values(n,:)=i*step1%values(:)+j*step2%values(:)+this%point1%values(:)
- end do
- end do
-
- select case( this%type )
- case ( "ORBITALPLOT")
- call CalculateWaveFunction_getOrbitalValueAt( speciesID, this%orbital, coordinate, val )
- ! case ( "FUKUIPLOT")
- !! val=CalculateProperties_getFukuiAt( this%species, "positive", coordinate )
- !! val2=CalculateProperties_getFukuiAt( this%species, "negative", coordinate )
- case default
- end select
-
- n=0
- do i=0,numberOfSteps
- write (10,*) ""
- ! if (this%type .eq. "FUKUIPLOT") write(11,*) ""
- do j=0,numberOfSteps
- n=n+1
- if(abs(val%values(n))>1.0E-99_8) then
- write (10,"(T10,F20.8,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1), -plotDistance2*0.5+j*Vector_norm(step2), &
- val%values(n)
- else
- write (10,"(T10,F20.8,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1), -plotDistance2*0.5+j*Vector_norm(step2), &
- 0.0
- end if
- if (val%values(n) > maxValue) maxValue = val%values(n)
- if (val%values(n) < minValue) minValue = val%values(n)
- ! if (this%type .eq. "FUKUIPLOT" ) then
- ! write (11,"(T10,F20.8,F20.8,ES20.8)") i*Vector_norm(step1),j*Vector_norm(step2),val2%values(n)
- ! if (val2%values(n) > maxValue2) maxValue2 = val2%values(n)
- ! if (val2%values(n) < minValue2) minValue2 = val2%values(n)
- ! end if
- ! print *, coordinate, val
- end do
- end do
-
- !!large orbital values lead to bad looking plots
- if(maxValue .gt. 1.0) maxValue=1.0
- if(minValue .lt. -1.0) minValue=-1.0
-
- call OutputBuilder_make3DGraph( this%fileName(1), title, x_title, y_title, z_title, minValue, maxValue)
- close(10)
-
- ! if (this%type .eq. "FUKUIPLOT" ) then
- ! call OutputBuilder_make3DGraph( this%fileName2, title2, x_title, y_title, z_title, minValue2, maxValue2)
- ! close(11)
- ! end if
-
- end subroutine OutputBuilder_get3DPlot
-
- subroutine OutputBuilder_get2DPlot(this)
- implicit none
- type(outputBuilder) :: this
- character(50) :: outputID, auxID
- character(50) :: orbitalNum
-
- integer :: i, n, speciesID
- character(50) :: nameOfSpecies
-
- integer :: numberOfSteps
- type(vector) :: step1
- type(vector) :: val
- Type(Matrix) :: coordinate
- real(8) :: plotDistance1
-
- character(50) :: title
- character(50) :: x_title
- character(50) :: y_title
-
- call Vector_Constructor(step1, 3)
- speciesID = MolecularSystem_getSpecieIDFromSymbol( trim(this%species) )
- nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
-
- this%fileName2=""
- numberOfSteps= CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
- plotDistance1=sqrt(sum((this%point2%values(:)-this%point1%values(:))**2))
- step1%values(:)=(this%point2%values(:)-this%point1%values(:))/numberOfSteps
- outputID=String_convertIntegerToString(this%outputID)
- auxID=String_convertIntegerToString(this%auxID)
-
- x_title="distance/a.u."
- select case( this%type )
-
- case ( "ORBITALPLOT")
- orbitalNum=String_convertIntegerToString(this%orbital)
- if( this%auxID .eq. 1) then
- this%fileName(1)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".2D.orb"//trim(orbitalNum)
- else
- this%fileName(1)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".2D-"//trim(auxID)//".orb"//trim(orbitalNum)
- end if
- open(10,file=this%fileName(1),status='replace',action='write')
- write (10,"(A10,A20,A20)") "#", "X","OrbitalValue"
- title=trim(this%species)//" Orbital Number "//trim(orbitalNum)
- y_title="orbitalValue/a.u.^{-3/2}"
-
- ! case ( "FUKUIPLOT")
- ! this%fileName(1)=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%species)//".2D.fkpos"
- ! this%fileName2=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%species)//".2D.fkneg"
-
- ! open(10,file=this%fileName(1),status='replace',action='write')
- ! write (10,"(A10,A20,A20)") "#","X","PositiveFukuiValue"
- ! title=trim(this%species)//" positive fukui"
- ! y_title="density/a.u.^{-3}"
-
- ! open(11,file=this%fileName2,status='replace',action='write')
- ! write (11,"(A10,A20,A20)") "#","X","NegativeFukuiValue"
-
- case default
- call OutputBuilder_exception(ERROR, "The output plot type you requested has not been implemented yet", "OutputBuilder_get3DPlot" )
-
- end select
-
- call Matrix_constructor(coordinate,int((numberOfSteps+1),8),int(3,8),0.0_8)
- do i=0,numberOfSteps
- coordinate%values(i+1,:)=i*step1%values(:)+this%point1%values(:)
- end do
-
- select case( this%type )
- case ( "ORBITALPLOT")
- call CalculateWaveFunction_getOrbitalValueAt( speciesID, this%orbital, coordinate, val )
- ! case ( "FUKUIPLOT")
- !! val=CalculateProperties_getFukuiAt( this%species, "positive", coordinate )
- !! val2=CalculateProperties_getFukuiAt( this%species, "negative", coordinate )
- case default
- end select
-
- n=0
- do i=0,numberOfSteps
- n=n+1
- if(abs(val%values(n))>1.0E-99_8) then
- write (10,"(T10,F20.8,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1),val%values(n)
- else
- write (10,"(T10,F20.8,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1),0.0
- end if
- ! if (this%type .eq. "FUKUIPLOT") write (11,"(T10,F20.8,ES20.8)") i*Vector_norm(step),val2%values(n)
- end do
-
- close(10)
-
- call OutputBuilder_make2DGraph( this%fileName(1), title, x_title, y_title)
-!! if (this%type .eq. "FUKUIPLOT") then
-!! close(11)
-!! title=trim(this%species)//" negative fukui"
-!! call OutputBuilder_make2DGraph( this%fileName2, title, x_title, y_title)
-!! end if
- call Vector_Destructor ( step1)
-
- end subroutine OutputBuilder_get2DPlot
-
-
- subroutine OutputBuilder_getDensityCube(this )
- implicit none
- type(OutputBuilder) :: this
- character(50) :: outputID, auxID
-
- integer :: l, i, j, k, n, w, natom
- integer :: speciesID
- integer :: numberOfSteps
- real(8) :: step
- real(8) :: lowerLimit(3)
- Type(Vector) :: val
- Type(Matrix) :: coordinate
-
- integer :: wfnunit, occupationsUnit
- integer :: numberOfOrbitals, numberOfSpecies
- type(matrix) :: densityMatrix
-
- character(100) :: arguments(2), wfnFile, occupationsFile, auxstring, nameOfSpecies, symbolOfSpecies
- logical :: existFile
-
- !Writes Gaussian Cube
-
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
-
- l=0
- do speciesID=1, numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
- symbolOfSpecies=MolecularSystem_getSymbolOfSpecies(speciesID)
- if(trim(this%species) .eq. trim(symbolOfSpecies) .or. trim(this%species) .eq. "ALL" ) then
- l=l+1
- numberOfOrbitals=MolecularSystem_getTotalNumberOfContractions(speciesID)
-
- outputID=String_convertIntegerToString(this%outputID)
- auxID=String_convertIntegerToString(this%auxID)
-
- ! Check if there are CI density matrices and read those or the HF matrix
- occupationsFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- inquire(FILE = occupationsFile, EXIST = existFile )
-
- if ( CONTROL_instance%CI_STATES_TO_PRINT .gt. 0 .and. existFile) then
- print *, "We are printing a density file for ", trim(nameOfSpecies), " in the CI state No. ", this%state
-
- occupationsUnit = 29
-
- open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
-
- write(auxstring,*) this%state
- arguments(2) = nameOfSpecies
- arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
-
- densityMatrix= Matrix_getFromFile(unit=occupationsUnit, rows= int(numberOfOrbitals,4), &
- columns= int(numberOfOrbitals,4), binary=.false., arguments=arguments(1:2))
-
-
- close(occupationsUnit)
- else
-
- !! Read density matrix
- !! Open file for wavefunction
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- arguments(2) = nameOfSpecies
- arguments(1) = "DENSITY"
-
- densityMatrix = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfOrbitals,4), &
- columns=int(numberOfOrbitals,4), binary=.true., arguments=arguments(1:2))
-
- close (wfnUnit)
-
- end if
-
-
- if( this%auxID .eq. 1) then
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".dens.cub"
- else
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//"."//trim(auxID)//".dens.cub"
- end if
-
- open(10,file=this%fileName(l),status='replace',action='write')
-
- lowerLimit(:)=this%point1%values(:)-this%cubeSize/2
- numberOfSteps=CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
- step= this%cubeSize/numberOfSteps
-
- natom=MolecularSystem_instance%numberOfPointCharges
-
- write (10,"(A)") "Gaussian Cube generated with Lowdin Software"
- write (10,"(A)") this%fileName(l)
- if(natom .gt. 0) then
- write (10,"(I8,F20.8,F20.8,F20.8,I8)") natom, lowerLimit(1), lowerLimit(2), lowerLimit(3), 1
- else
- write (10,"(I8,F20.8,F20.8,F20.8,I8)") 1, lowerLimit(1), lowerLimit(2), lowerLimit(3), 1
- end if
- write (10,"(I8,F20.8,F20.8,F20.8)") numberOfSteps, step, 0.0, 0.0
- write (10,"(I8,F20.8,F20.8,F20.8)") numberOfSteps, 0.0, step, 0.0
- write (10,"(I8,F20.8,F20.8,F20.8)") numberOfSteps, 0.0, 0.0, step
-
- if(natom .gt. 0) then
- do n = 1, MolecularSystem_instance%numberOfPointCharges
- write (10, "(I8,F20.8,F20.8,F20.8,F20.8)") &
- int(MolecularSystem_instance%pointCharges(n)%charge), 0.0, MolecularSystem_instance%pointCharges(n)%origin(1:3)
- end do
- else
- write (10, "(I8,I8,F20.8,F20.8,F20.8)") &
- 1, 0, this%point1%values
- end if
-
- do i=1,numberOfSteps
- do j=1, numberOfSteps
- call Matrix_constructor(coordinate,int(numberOfSteps,8),int(3,8),0.0_8)
- do k=1, numberOfSteps
- coordinate%values(k,1)=lowerLimit(1)+(i-1)*step
- coordinate%values(k,2)=lowerLimit(2)+(j-1)*step
- coordinate%values(k,3)=lowerLimit(3)+(k-1)*step
- end do
- call CalculateWaveFunction_getDensityAt( speciesID, coordinate, densityMatrix, val )
- write(10,*) ( val%values(w) , w=1,numberOfSteps )
- write(10,*) ( "" )
- end do
- end do
- close(10)
- end if
- end do
- end subroutine OutputBuilder_getDensityCube
-
- subroutine OutputBuilder_getDensityPlot(this)
- type(OutputBuilder) :: this
- character(50) :: outputID, auxID
-
- integer :: i,j,l,n, speciesID, wfnunit, occupationsUnit
- integer :: numberOfSteps, numberOfOrbitals
- integer :: numberOfSpecies
- type(vector) :: step1, step2
- type(matrix) :: densityMatrix
- real(8) :: maxValue, minValue
- real(8) :: plotDistance1, plotDistance2
- Type(Vector) :: val
- Type(Matrix) :: coordinate
-
- character(100) :: arguments(2), wfnFile, occupationsFile, auxstring, nameOfSpecies, symbolOfSpecies
- character(50) :: title, x_title, y_title, z_title
- logical :: existFile
-
- call Vector_Constructor(step1, 3)
- call Vector_Constructor(step2, 3)
-
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
- outputID=String_convertIntegerToString(this%outputID)
- auxID=String_convertIntegerToString(this%auxID)
-
- l=0
- do speciesID=1, numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
- symbolOfSpecies=MolecularSystem_getSymbolOfSpecies(speciesID)
- if(trim(this%species) .eq. trim(symbolOfSpecies) .or. trim(this%species) .eq. "ALL" ) then
- l=l+1
- numberOfOrbitals=MolecularSystem_getTotalNumberOfContractions(speciesID)
-
- occupationsFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci"
- inquire(FILE = occupationsFile, EXIST = existFile )
-
- ! Check if there are CI density matrices and read those or the HF matrix
- if ( CONTROL_instance%CI_STATES_TO_PRINT .gt. 0 .and. existFile) then
- print *, "We are printing a density file for ", trim(nameOfSpecies), " in the CI state No. ", this%state
-
- occupationsUnit = 29
-
- open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted")
-
- write(auxstring,*) this%state
- arguments(2) = nameOfSpecies
- arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring))
-
- densityMatrix= Matrix_getFromFile(unit=occupationsUnit, rows= int(numberOfOrbitals,4), &
- columns= int(numberOfOrbitals,4), binary=.false., arguments=arguments(1:2))
-
- ! print *, "output density matrix for", arguments
- ! call Matrix_show(densityMatrix)
- close(occupationsUnit)
- else
-
- !! Read density matrix
- !! Open file for wavefunction
- wfnFile = "lowdin.wfn"
- wfnUnit = 20
- open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted")
-
- arguments(2) = nameOfSpecies
- arguments(1) = "DENSITY"
-
- densityMatrix = &
- Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfOrbitals,4), &
- columns=int(numberOfOrbitals,4), binary=.true., arguments=arguments(1:2))
-
- close (wfnUnit)
-
- end if
-
- ! call Matrix_show(densityMatrix)
-
- !Define graph parameters
- numberOfSteps= CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
- plotDistance1=sqrt(sum((this%point2%values(:)-this%point1%values(:))**2))
- plotDistance2=sqrt(sum((this%point3%values(:)-this%point1%values(:))**2))
- step1%values(:)=(this%point2%values(:)-this%point1%values(:))/numberOfSteps
- step2%values(:)=(this%point3%values(:)-this%point1%values(:))/numberOfSteps
-
- write(auxstring,*) this%state
- title=trim(nameOfSpecies)//" state "//auxstring//" density"
-
- maxValue=0.0_8
- minValue=0.0_8
-
- !Write density grids according to the number of dimensions chosen
- if(this%dimensions.eq.3)then
- !!check if there is another density plot with the same same
- if( this%auxID .eq. 1) then
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".3D.dens"
- else
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".3D-"//trim(auxID)//".dens"
- end if
- x_title="x/a.u."
- y_title="y/a.u."
- z_title=""
- open(10,file=this%fileName(l),status='replace',action='write')
- write (10,"(A10,A20,A20,A20)") "#","X","Y","Density"
- call Matrix_constructor(coordinate,int((numberOfSteps+1)**2,8),int(3,8),0.0_8)
- n=0
- do i=0,numberOfSteps
- do j=0,numberOfSteps
- n=n+1
- coordinate%values(n,:)=this%point1%values(:)+i*step1%values(:)+j*step2%values(:)
- end do
- end do
-
- call CalculateWaveFunction_getDensityAt( speciesID, coordinate, densityMatrix, val )
- n=0
- do i=0,numberOfSteps
- write (10,*) ""
- do j=0,numberOfSteps
- n=n+1
- if(val%values(n)>1.0E-99_8) then
- write (10,"(T10,F20.8,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1), -plotDistance2*0.5+j*Vector_norm(step2), &
- val%values(n)
- else
- write (10,"(T10,F20.8,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1), -plotDistance2*0.5+j*Vector_norm(step2), &
- 0.0
- end if
- if (val%values(n) > maxValue) maxValue = val%values(n)
- if (val%values(n) < minValue) minValue = val%values(n)
- ! print *, coordinate, val
- end do
- end do
-
- !!large density values lead to bad looking plots
- if(maxValue .gt. 1.0) maxValue=1.0
-
- call OutputBuilder_make3DGraph( this%fileName(l), title, x_title, y_title, z_title, 0.0_8, maxValue)
- close(10)
-
- elseif(this%dimensions.eq.2) then
- !!check if there is another density plot with the same same
- if( this%auxID .eq. 1) then
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".2D.dens"
- else
- this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".2D-"//trim(auxID)//".dens"
- end if
-
- x_title="distance/a.u."
- y_title="density/a.u.^{-3}"
- open(10,file=this%fileName(l),status='replace',action='write')
-
- write (10,"(A10,A20,A20)") "#","X","Density"
-
- call Matrix_constructor(coordinate,int(numberOfSteps+1,8),int(3,8),0.0_8)
- do i=0,numberOfSteps
- coordinate%values(i+1,:)=this%point1%values(:)+i*step1%values(:)
- end do
-
- call CalculateWaveFunction_getDensityAt( speciesID, coordinate, densityMatrix, val )
-
- n=0
- do i=0,numberOfSteps
- n=n+1
- if(val%values(n)>1.0E-99_8) then
- write (10,"(T10,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1),val%values(n)
- else
- write (10,"(T10,F20.8,E20.8)") -plotDistance1*0.5+i*Vector_norm(step1),0.0
- end if
- ! print *, coordinate, val
- end do
-
- call OutputBuilder_make2DGraph( this%fileName(l), title, x_title, y_title)
- close(10)
-
- end if
- end if
- end do
-
- call Vector_Destructor(step1)
- call Vector_Destructor(step2)
-
- end subroutine OutputBuilder_getDensityPlot
-
-
-
- subroutine OutputBuilder_make2DGraph(fileName, title, x_title, y_title,&
- x_format, y_format, x_range, y_range, numOfGraphs)
- implicit none
- character(*) :: fileName
- character(*) :: title
- character(*) :: x_title
- character(*) :: y_title
- character(*), optional :: x_format
- character(*), optional :: y_format
- character(*), optional :: x_range
- character(*), optional :: y_range
- integer, optional :: numOfGraphs
-
- integer :: i
- character(20) :: charNumOfGraph
- character(20) :: auxXformat
- character(20) :: auxYformat
- character(20) :: auxXRange
- character(20) :: auxYRange
-
- integer :: auxNumOfGraphs
-
- auxXformat="%.2f"
- if(present(x_format)) auxXformat=trim(x_format)
-
- auxYformat="%.2f"
- if(present(y_format)) auxYformat=trim(y_format)
-
- auxXRange=" [] "
- if(present(x_range)) auxXRange=' ['//trim(x_range)//'] '
-
- auxYRange="[] "
- if(present(y_range)) auxYRange='['//trim(y_range)//'] '
-
- auxNumOfGraphs=1
- if(present(numOfGraphs)) auxNumOfGraphs=numOfGraphs
-
- open ( 10,FILE=trim(fileName)//".gnp", STATUS='REPLACE',ACTION='WRITE')
- write (10,"(A)") 'set term post eps enh color dashed rounded dl 4 "Times-Bold" 15'
- write (10,"(A)") 'set output "'//trim(fileName)//'.eps"'
- write (10,"(A)") 'set encoding iso_8859_1'
- write (10,"(A)") 'set title "'//trim(title)//'"'
- write (10,"(A)") 'set xlabel "'//trim(x_title)//'"'
- write (10,"(A)") 'set format x "'//trim(auxXformat)//'"'
- write (10,"(A)") 'set ylabel "'//trim(y_title)//'"'
- write (10,"(A)") 'set format y "'//trim(auxYformat)//'"'
- if( auxNumOfGraphs >1) then
- write (10,"(A$)") 'plot '//trim(auxXRange)//trim(auxYRange)//' "'//trim(fileName)//'" using 1:2 w l title "" '
- do i=2, auxNumOfGraphs
- charNumOfGraph=String_convertIntegerToString(i+1)
- write (10,"(A$)") ', "'//trim(fileName)//'.dat"'//' using 1:'//trim(charNumOfGraph)//' w l title "" '
- end do
- write (10,"(A)") ""
- else
- write (10,"(A)") 'plot '//trim(auxXRange)//trim(auxYRange)//' "'//trim(fileName)//'" w l title "" '
- end if
- write (10,"(A)") 'set output'
- close(10)
-
-! status= system("gnuplot "//trim(fileName)//".gnp")
- call system("gnuplot "//trim(fileName)//".gnp")
-
- end subroutine OutputBuilder_make2DGraph
-
-
- subroutine OutputBuilder_make3DGraph(fileName, title, x_title, y_title, z_title, minValue, maxValue)
-
- implicit none
- character(*) :: fileName
- character(*) :: title
- character(*) :: x_title
- character(*) :: y_title
- character(*) :: z_title
- real(8) :: minValue
- real(8) :: maxValue
-
- open ( 100,FILE=trim(fileName)//'.gnp', STATUS='REPLACE',ACTION='WRITE')
- write (100,"(A)") 'set term post eps enh color "Helvetica" 16 size 7cm,5cm'
- write (100,"(A)") 'set encoding iso_8859_1'
- write (100,"(A)") 'set output "'//trim(fileName)//'.eps"'
-
- write (100,"(A)") 'set table "'//trim(fileName)//'.table"'
- write (100,"(A)") 'splot "'//trim(fileName)//'" u 1:2:3'
- write (100,"(A)") 'unset table'
-
- if(minValue.lt.0 .and. maxValue.gt.0) then
- write (100,"(A,I5)") 'levels=', 11
- else
- write (100,"(A,I5)") 'levels=', 10
- end if
-
- write (100,"(A,E20.8)") 'maxValue=', maxValue
- write (100,"(A,E20.8)") 'minValue=', minValue
- write (100,"(A)") 'step=(maxValue-minValue)/levels'
-
- write (100,"(A)") 'set contour base'
- write (100,"(A)") 'set cntrparam level incremental minValue, step , maxValue'
- write (100,"(A)") 'unset surface'
-
- write (100,"(A)") 'set table "'//trim(fileName)//'.cont"'
- write (100,"(A)") 'splot "'//trim(fileName)//'" u 1:2:3'
- write (100,"(A)") 'unset table'
-
- write (100,"(A)") 'reset'
- write (100,"(A)") 'unset key'
-
- write (100,"(A)") 'set cbrange [minValue:maxValue]'
- write (100,"(A)") 'set palette maxcolors levels'
- if(minValue.lt.0 .and. maxValue.gt.0) then
- write (100,"(A)") 'set cbtics (minValue, 0.0, maxValue)'
- else
- write (100,"(A)") 'set cbtics step'
- end if
- write (100,"(A)") 'set format cb "%3.1E"'
-
- if(minValue.lt.0 .and. maxValue.gt.0) then
- write (100,"(A)") 'set palette defined (minValue "blue", 0.0 "white", maxValue "red")'
- else if(minValue.ge.0) then
- write (100,"(A)") 'set palette defined (minValue "white", maxValue "red")'
- else
- write (100,"(A)") 'set palette defined (minValue "blue", maxValue "white")'
- end if
-
- write (100,"(A)") 'set grid front'
-
- write (100,"(A)") 'set format x "%.0f"'
- write (100,"(A)") 'set format y "%.0f"'
- write (100,"(A)") 'set xlabel "X (a.u.)"'
- write (100,"(A)") 'set ylabel "Y (a.u.)"'
-
- write (100,"(A)") 'plot "'//trim(fileName)//'.table" with image, "'//trim(fileName)//'.cont" w l lt -1 lw 1.5'
+ integer :: l, i, j, k, n, w, natom
+ integer :: speciesID, state
+ integer :: numberOfSteps
+ real(8) :: step
+ real(8) :: lowerLimit(3)
+ Type(Vector) :: val
+ Type(Matrix) :: coordinate
+
+ integer :: numberOfSpecies, numberOfStates, orbital
+ type(matrix), allocatable :: densityMatrices(:,:), coefficientsMatrices(:,:)
+
+ character(100) :: nameOfSpecies, symbolOfSpecies
+
+ !Writes Gaussian Cube
+
+ numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+ auxID=String_convertIntegerToString(this%auxID)
+ numberOfStates=1
+ if (this%wavefunctionType .eq. "CI") then
+ numberOfStates=CONTROL_instance%CI_STATES_TO_PRINT
+ state=this%state
+ else
+ state=1
+ end if
+
+ if (this%type=="DENSITYCUBE") then
+ allocate(densityMatrices(numberOfSpecies,numberOfStates))
+ call CalculateWaveFunction_loadDensityMatrices ( numberOfSpecies, numberOfStates, this%wavefunctionType, densityMatrices )
+
+ else if(this%type=="ORBITALCUBE") then
+ allocate(coefficientsMatrices(numberOfSpecies,numberOfStates))
+ call CalculateWaveFunction_loadCoefficientsMatrices ( numberOfSpecies, numberOfStates, this%wavefunctionType, coefficientsMatrices)
+ end if
+
+ l=0
+ do speciesID=1, numberOfSpecies
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
+ symbolOfSpecies=MolecularSystem_getSymbolOfSpecies(speciesID)
+ if(trim(this%species) .eq. trim(symbolOfSpecies) .or. trim(this%species) .eq. "ALL" ) then
+ l=l+1
+ outputID=String_convertIntegerToString(this%outputID)
+
+ this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)
+ if( state .gt. 1) this%fileName(l)=trim(this%fileName(l))//"-"//trim(String_convertIntegerToString(state))
+ if( this%auxID .gt. 1) this%fileName(l)=trim(this%fileName(l))//"."//trim(auxID)
+ if( this%type=="DENSITYCUBE") this%fileName(l)=trim(this%fileName(l))//".dens.cub"
+ if( this%type=="ORBITALCUBE") then
+ orbital=this%orbital
+ if(orbital.eq.0) orbital=MolecularSystem_getOcupationNumber(speciesID)
+ this%fileName(l)=trim(this%fileName(l))//".orb"//trim(String_convertIntegerToString(orbital))//".cub"
+ end if
+
+ open(10,file=this%fileName(l),status='replace',action='write')
+
+ lowerLimit(:)=this%point1%values(:)-this%cubeSize/2
+ numberOfSteps=this%pointsPerDim(1) !for now, only cubic cubes
+ step= this%cubeSize/numberOfSteps
+
+ natom=MolecularSystem_instance%numberOfPointCharges
+
+ write (10,"(A)") "Gaussian Cube generated with Lowdin Software"
+ write (10,"(A)") this%fileName(l)
+ if(natom .gt. 0) then
+ write (10,"(I8,F20.8,F20.8,F20.8,I8)") natom, lowerLimit(1), lowerLimit(2), lowerLimit(3), 1
+ else
+ write (10,"(I8,F20.8,F20.8,F20.8,I8)") 1, lowerLimit(1), lowerLimit(2), lowerLimit(3), 1
+ end if
+ write (10,"(I8,F20.8,F20.8,F20.8)") numberOfSteps, step, 0.0, 0.0
+ write (10,"(I8,F20.8,F20.8,F20.8)") numberOfSteps, 0.0, step, 0.0
+ write (10,"(I8,F20.8,F20.8,F20.8)") numberOfSteps, 0.0, 0.0, step
+
+ if(natom .gt. 0) then
+ do n = 1, MolecularSystem_instance%numberOfPointCharges
+ write (10, "(I8,F20.8,F20.8,F20.8,F20.8)") &
+ int(MolecularSystem_instance%pointCharges(n)%charge), 0.0, MolecularSystem_instance%pointCharges(n)%origin(1:3)
+ end do
+ else
+ write (10, "(I8,I8,F20.8,F20.8,F20.8)") &
+ 1, 0, this%point1%values
+ end if
+
+ do i=1,numberOfSteps
+ do j=1, numberOfSteps
+ call Matrix_constructor(coordinate,int(numberOfSteps,8),int(3,8),0.0_8)
+ do k=1, numberOfSteps
+ coordinate%values(k,1)=lowerLimit(1)+(i-1)*step
+ coordinate%values(k,2)=lowerLimit(2)+(j-1)*step
+ coordinate%values(k,3)=lowerLimit(3)+(k-1)*step
+ end do
+ if( this%type=="DENSITYCUBE") then
+ call CalculateWaveFunction_getDensityAt( speciesID, coordinate, densityMatrices(speciesID,state), val )
+ else if( this%type=="ORBITALCUBE") then
+ call CalculateWaveFunction_getOrbitalValueAt( speciesID, orbital, coordinate, coefficientsMatrices(speciesID,state), val )
+ end if
+ write(10,*) ( val%values(w) , w=1,numberOfSteps )
+ write(10,*) ( "" )
+ end do
+ end do
+ close(10)
+ end if
+ end do
+ end subroutine OutputBuilder_getCube
+
+ subroutine OutputBuilder_getPlot(this)
+ type(OutputBuilder) :: this
+ character(50) :: outputID, auxID
+
+ integer :: i,j,l,n, speciesID, orbital, state
+ integer :: numberOfSteps,numberOfSteps2
+ integer :: numberOfSpecies, numberOfStates
+ type(matrix), allocatable :: densityMatrices(:,:), coefficientsMatrices(:,:)
+ real(8) :: maxValue, minValue
+ real(8) :: plotDistance1, plotDistance2, initialValue1, initialValue2
+ Type(Vector) :: val
+ Type(Matrix) :: coordinate
+
+ character(100) :: nameOfSpecies, symbolOfSpecies
+ character(50) :: title, x_title, y_title, z_title
+
+ numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
+ outputID=String_convertIntegerToString(this%outputID)
+ auxID=String_convertIntegerToString(this%auxID)
+ numberOfSteps=this%pointsPerDim(1)
+
+ !Define graph display distances, check which axes are changing
+ plotDistance1=sqrt(sum((this%point2%values(:)-this%point1%values(:))**2))
+ initialValue1=-0.5*plotDistance1
+ x_title="distance/a.u."
+ if(abs(abs(this%point2%values(1)-this%point1%values(1))-plotDistance1) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ initialValue1=this%point1%values(1)
+ x_title="X/a.u."
+ else if(abs(abs(this%point2%values(2)-this%point1%values(2))-plotDistance1) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ initialValue1=this%point1%values(2)
+ x_title="Y/a.u."
+ else if(abs(abs(this%point2%values(3)-this%point1%values(3))-plotDistance1) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ initialValue1=this%point1%values(3)
+ x_title="Z/a.u."
+ end if
+
+ if(this%dimensions.eq.3) then
+ numberOfSteps2=this%pointsPerDim(2)
+ plotDistance2=sqrt(sum((this%point3%values(:)-this%point1%values(:))**2))
+ initialValue2=-0.5*plotDistance2
+ y_title="distance2/a.u."
+ if(abs(abs(this%point3%values(1)-this%point1%values(1))-plotDistance2) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ initialValue2=this%point1%values(1)
+ y_title="X/a.u."
+ else if(abs(abs(this%point3%values(2)-this%point1%values(2))-plotDistance2) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ initialValue2=this%point1%values(2)
+ y_title="Y/a.u."
+ else if(abs(abs(this%point3%values(3)-this%point1%values(3))-plotDistance2) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD) then
+ initialValue2=this%point1%values(3)
+ y_title="Z/a.u."
+ end if
+ end if
+ if(this%axisLabel(1) .ne. "") x_title=this%axisLabel(1)//"/a.u."
+ if(this%axisLabel(2) .ne. "") y_title=this%axisLabel(2)//"/a.u."
+
+ numberOfStates=1
+ if (this%wavefunctionType .eq. "CI") then
+ numberOfStates=CONTROL_instance%CI_STATES_TO_PRINT
+ state=this%state
+ else
+ state=1
+ end if
+ if (this%type=="DENSITYPLOT") then
+ allocate(densityMatrices(numberOfSpecies,numberOfStates))
+ call CalculateWaveFunction_loadDensityMatrices ( numberOfSpecies, numberOfStates, this%wavefunctionType, densityMatrices )
+ if(this%dimensions.eq.2) y_title="density/a.u.^{-3}"
+ if(this%dimensions.eq.3) z_title=""
+
+ else if(this%type=="ORBITALPLOT") then
+ allocate(coefficientsMatrices(numberOfSpecies,numberOfStates))
+ call CalculateWaveFunction_loadCoefficientsMatrices ( numberOfSpecies, numberOfStates, this%wavefunctionType, coefficientsMatrices)
+ if(this%dimensions.eq.2) y_title="orbital/a.u.^{-3/2}"
+ if(this%dimensions.eq.3) z_title=""
+
+ end if
+
+ l=0
+ do speciesID=1, numberOfSpecies
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
+ symbolOfSpecies=MolecularSystem_getSymbolOfSpecies(speciesID)
+ if(trim(this%species) .eq. trim(symbolOfSpecies) .or. trim(this%species) .eq. "ALL" ) then
+ l=l+1
+
+ !Set up filename
+ this%fileName(l)=trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)
+ if( state .gt. 1) this%fileName(l)=trim(this%fileName(l))//"-"//trim(String_convertIntegerToString(state))
+ if( this%auxID .gt. 1) this%fileName(l)=trim(this%fileName(l))//"."//trim(auxID)
+ if( this%dimensions.eq.2) this%fileName(l)=trim(this%fileName(l))//".2D"
+ if( this%dimensions.eq.3) this%fileName(l)=trim(this%fileName(l))//".3D"
+ if( this%type=="DENSITYPLOT") this%fileName(l)=trim(this%fileName(l))//".dens"
+ if( this%type=="ORBITALPLOT") then
+ orbital=this%orbital
+ if(orbital.eq.0) orbital=MolecularSystem_getOcupationNumber(speciesID)
+ this%fileName(l)=trim(this%fileName(l))//".orb"//trim(String_convertIntegerToString(orbital))
+ end if
+ open(10,file=this%fileName(l),status='replace',action='write')
+
+ if( this%dimensions.eq.3) then
+ call Matrix_constructor(coordinate,int((numberOfSteps+1)*(numberOfSteps2+1),8),int(3,8),0.0_8)
+ n=0
+ do i=0,numberOfSteps
+ do j=0,numberOfSteps2
+ n=n+1
+ coordinate%values(n,:)=this%point1%values(:)+i*this%step1%values(:)+j*this%step2%values(:)
+ end do
+ end do
+
+ else if( this%dimensions.eq.2) then
+ call Matrix_constructor(coordinate,int(numberOfSteps+1,8),int(3,8),0.0_8)
+ do i=0,numberOfSteps
+ coordinate%values(i+1,:)=this%point1%values(:)+i*this%step1%values(:)
+ end do
+ end if
+
+ if( this%type=="DENSITYPLOT") call CalculateWaveFunction_getDensityAt( speciesID, coordinate, densityMatrices(speciesID,state), val )
+ if( this%type=="ORBITALPLOT") call CalculateWaveFunction_getOrbitalValueAt( speciesID, orbital, coordinate, coefficientsMatrices(speciesID,state), val )
+
+ if( this%dimensions.eq.3) then
- close(100)
+ if( this%type=="DENSITYPLOT") write (10,"(A10,A20,A20,A20)") "#","X","Y","Density"
+ if( this%type=="ORBITALPLOT") write (10,"(A10,A20,A20,A20)") "#","X","Y","Orbital"
+ n=0
+ maxValue=0.0
+ minValue=0.0
+ do i=0,numberOfSteps
+ write (10,*) ""
+ do j=0,numberOfSteps2
+ n=n+1
+ if(abs(val%values(n))>1.0E-99_8) then
+ write (10,"(T10,F20.8,F20.8,E20.8)") initialValue1+i*Vector_norm(this%step1), initialValue2+j*Vector_norm(this%step2), val%values(n)
+ else
+ write (10,"(T10,F20.8,F20.8,E20.8)") initialValue1+i*Vector_norm(this%step1), initialValue2+j*Vector_norm(this%step2), 0.0
+ end if
+ if (val%values(n) > maxValue) maxValue = val%values(n)
+ if (val%values(n) < minValue) minValue = val%values(n)
+ end do
+ end do
+ !!large values lead to bad looking contour plots
+ if(maxValue .gt. this%maxValue) maxValue=this%maxValue
+ if(minValue .lt. this%minValue) minValue=this%minValue
+
+ title=""
+ call OutputBuilder_make3DGnuplot( this%fileName(l), title, x_title, y_title, z_title, minValue, maxValue)
+ else if( this%dimensions.eq.2) then
+ if( this%type=="DENSITYPLOT") write (10,"(A10,A20,A20)") "#","X","Density"
+ if( this%type=="ORBITALPLOT") write (10,"(A10,A20,A20)") "#","X","Orbital"
+ n=0
+ do i=0,numberOfSteps
+ n=n+1
+ if(abs(val%values(n))>1.0E-99_8) then
+ write (10,"(T10,F20.8,E20.8)") initialValue1+i*Vector_norm(this%step1), val%values(n)
+ else
+ write (10,"(T10,F20.8,E20.8)") initialValue1+i*Vector_norm(this%step1), 0.0
+ end if
+ end do
+ if( this%type=="DENSITYPLOT") title=trim(nameOfSpecies)//" state "//trim(String_convertIntegerToString(state))//" density"
+ if( this%type=="ORBITALPLOT") title=trim(nameOfSpecies)//" state "//trim(String_convertIntegerToString(state))//" orbital"//trim(String_convertIntegerToString(orbital))
+ call OutputBuilder_make2DGnuplot( this%fileName(l), title, x_title, y_title)
+ end if
+ close(10)
+ end if
+ end do
-! status= system("gnuplot "//trim(fileName)//".gnp")
- call system("gnuplot "//trim(fileName)//".gnp")
+ end subroutine OutputBuilder_getPlot
- end subroutine OutputBuilder_make3DGraph
-end module OutputBuilder_
-! subroutine OutputBuilder_get2DDensityPlot(this)
-! implicit none
-! type(outputBuilder) :: this
-! character(50) :: outputID
-! character(50) :: orbitalNum
-
-! integer :: i
-! integer :: numberOfSteps
-! type(vector) :: step
-! real(8) :: val, val2
-! real(8) :: coordinate(3)
-
-! character(50) :: title
-! character(50) :: x_title
-! character(50) :: y_title
-
-! stop "trololo 2D"
-
-! ! call Vector_Constructor(step, 3)
-
-! ! this%fileName2=""
-! ! numberOfSteps= CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
-! ! step%values(:)=(this%point2%values(:)-this%point1%values(:))/numberOfSteps
-! ! outputID=String_convertIntegerToString(this%outputID)
-
-! ! select case( this%type )
-! ! case ( "densityPlot")
-
-
-! ! case ( "orbitalPlot")
-! ! orbitalNum=String_convertIntegerToString(this%orbital)
-! ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".2D.orb"//trim(orbitalNum)
-! ! open(10,file=this%fileName,status='replace',action='write')
-! ! write (10,"(A10,A20,A20)") "#", "X","OrbitalValue"
-! ! title=trim(this%specie)//" Orbital Number "//trim(orbitalNum)
-! ! y_title="orbitalValue/a.u.^{-3/2}"
-
-! ! case ( "fukuiPlot")
-! ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".2D.fkpos"
-! ! this%fileName2=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".2D.fkneg"
-
-! ! open(10,file=this%fileName,status='replace',action='write')
-! ! write (10,"(A10,A20,A20)") "#","X","PositiveFukuiValue"
-! ! title=trim(this%specie)//" positive fukui"
-! ! y_title="density/a.u.^{-3}"
-
-! ! open(11,file=this%fileName,status='replace',action='write')
-! ! write (11,"(A10,A20,A20)") "#","X","NegativeFukuiValue"
-
-! ! case default
-! ! call OutputBuilder_exception(ERROR, "The output plot type you requested has not been implemented yet", "OutputBuilder_get3DPlot" )
-
-! ! end select
-
-! ! do i=0,numberOfSteps
-! ! coordinate(:)=i*step%values(:)+this%point1%values(:)
-! ! val=CalculateWaveFunction_getDensityAt( this%specie, coordinate )
-! ! select case( this%type )
-! ! case ( "densityPlot")
-! ! val=CalculateWaveFunction_getDensityAt( this%specie, coordinate )
-! ! case ( "orbitalPlot")
-! ! val=CalculateWaveFunction_getOrbitalValueAt( this%specie, this%orbital, coordinate )
-! ! case ( "fukuiPlot")
-! ! !! val=CalculateProperties_getFukuiAt( this%specie, "positive", coordinate )
-! ! !! val2=CalculateProperties_getFukuiAt( this%specie, "negative", coordinate )
-! ! case default
-! ! end select
-! ! write (10,"(T10,F20.8,F20.8)") i*Vector_norm(step),val
-! ! if (this%type .eq. "fukuiPlot") write (11,"(T10,F20.8,F20.8)") i*Vector_norm(step),val2
-! ! end do
-
-! ! close(10)
-
-! ! call OutputBuilder_make2DGraph( this%fileName, title, x_title, y_title)
-! ! !! if (this%type .eq. "fukuiPlot") then
-! ! !! close(11)
-! ! !! title=trim(this%specie)//" negative fukui"
-! ! !! call OutputBuilder_make2DGraph( this%fileName2, title, x_title, y_title)
-! ! !! end if
-! ! call Vector_Destructor ( step)
-
-! end subroutine OutputBuilder_get2DDensityPlot
-
- ! subroutine OutputBuilder_getCube(this )
- ! implicit none
- ! type(output) :: this
- ! character(50) :: outputID
- ! real(8):: cubeSize
- ! character(50) :: orbitalNum
-
- ! integer :: i, j, k, n, w, natom
- ! integer :: atomicCharge
- ! integer :: specieID
- ! integer :: numberOfSteps
- ! real(8) :: step(3)
- ! real(8) :: lowerLimit(3)
- ! real(8), allocatable :: val(:), val2(:)
- ! real(8) :: coordinate(3)
-
- ! !Writes Gaussian Cube
- ! this%fileName=""
- ! ! this%fileName2=""
- ! outputID=String_convertIntegerToString(this%outputID)
- ! specieID= MolecularSystem_getSpecieID( nameOfSpecie=this%specie)
-
- ! ! if (.not. allocated(CalculateProperties_instance%densityCube) ) call CalculateProperties_buildDensityCubesLimits(CalculateProperties_instance)
-
- ! ! if (this%type .eq. "densityCube" .and. .not. CalculateProperties_instance%densityCube(specieID)%areValuesCalculated ) then
- ! ! call CalculateProperties_buildDensityCubes(CalculateProperties_instance)
- ! ! end if
-
- ! lowerLimit=this%point1
- ! numberOfSteps=CONTROL_instance%NUMBER_OF_POINTS_PER_DIMENSION
- ! step= this%cubeSize/numberOfSteps
-
-
- ! allocate (val (int(numberOfSteps(3))) )
-
- ! select case( this%type )
- ! case ( "densityCube")
- ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".dens.cub"
- ! open(10,file=this%fileName,status='replace',action='write')
-
- ! ! case ( "orbitalCube")
- ! ! orbitalNum=String_convertIntegerToString(this%orbital)
- ! ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".orb"//trim(orbitalNum)//".cub"
- ! ! open(10,file=this%fileName,status='replace',action='write')
-
- ! ! case ( "fukuiCube")
- ! ! this%fileName=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".fkpos.cub"
- ! ! this%fileName2=trim(CONTROL_instance%INPUT_FILE)//"out"//trim(outputID)//"."//trim(this%specie)//".fkneg.cub"
-
- ! ! open(10,file=this%fileName,status='replace',action='write')
- ! ! open(11,file=this%fileName2,status='replace',action='write')
-
- ! case default
- ! call OutputBuilder_exception(ERROR, "The output cube type you requested has not been implemented yet", "OutputBuilder_getCube" )
-
- ! end select
-
- ! ! do n=1, size(MolecularSystem_instance%particlesPtr)
- ! ! if ( trim(MolecularSystem_instance%particlesPtr(n)%symbol) == "E-" .or. &
- ! ! trim(MolecularSystem_instance%particlesPtr(n)%symbol) == "E-ALPHA" .and. &
- ! ! MolecularSystem_instance%particlesPtr(k)%isQuantum ) then
- ! ! natom = natom +1
- ! ! end if
- ! ! end do
-
- ! write (10,"(A)") "Gaussian Cube generated with Lowdin Software"
- ! write (10,"(A)") this%fileName
- ! write (10,"(I8,F20.8,F20.8,F20.8)") natom, lowerLimit(1), lowerLimit(2), lowerLimit(3)
- ! write (10,"(I8,F20.8,F20.8,F20.8)") int(numberOfSteps(1)), step(1), 0.0, 0.0
- ! write (10,"(I8,F20.8,F20.8,F20.8)") int(numberOfSteps(2)), 0.0, step(2), 0.0
- ! write (10,"(I8,F20.8,F20.8,F20.8)") int(numberOfSteps(3)), 0.0, 0.0, step(3)
- ! ! do n=1, size(MolecularSystem_instance%particlesPtr)
- ! ! if ( trim(MolecularSystem_instance%particlesPtr(n)%symbol) == "E-" .or. &
- ! ! trim(MolecularSystem_instance%particlesPtr(n)%symbol) == "E-ALPHA" .and. &
- ! ! MolecularSystem_instance%particlesPtr(n)%isQuantum ) then
- ! ! atomicCharge=-MolecularSystem_instance%particlesPtr(n)%totalCharge
- ! ! write (10, "(I8,F20.8,F20.8,F20.8,F20.8)") &
- ! ! atomicCharge, 0.0, MolecularSystem_instance%particlesPtr(n)%origin(1:3)
- ! ! end if
- ! ! end do
-
- ! ! if (this%type .eq. "fukuiCube") then
- ! ! write (11,"(A)") "Gassian Cube generated with Lowdin Software"
- ! ! write (11,"(A)") this%fileName2
- ! ! write (11,"(I8,F20.8,F20.8,F20.8)") natom, lowerLimit(1), lowerLimit(2), lowerLimit(3)
- ! ! write (11,"(I8,F20.8,F20.8,F20.8)") int(numberOfSteps(1)), step(1), 0.0, 0.0
- ! ! write (11,"(I8,F20.8,F20.8,F20.8)") int(numberOfSteps(2)), 0.0, step(2), 0.0
- ! ! write (11,"(I8,F20.8,F20.8,F20.8)") int(numberOfSteps(3)), 0.0, 0.0, step(3)
- ! ! do n=1, size(MolecularSystem_instance%particlesPtr)
- ! ! if ( trim(MolecularSystem_instance%particlesPtr(n)%symbol) == "e-" .or. &
- ! ! trim(MolecularSystem_instance%particlesPtr(n)%symbol) == "e-ALPHA" .and. &
- ! ! MolecularSystem_instance%particlesPtr(n)%isQuantum ) then
- ! ! atomicCharge=-MolecularSystem_instance%particlesPtr(n)%totalCharge
- ! ! write (11, "(I8,F20.8,F20.8,F20.8,F20.8)") &
- ! ! atomicCharge, 0.0, MolecularSystem_instance%particlesPtr(n)%origin(1:3)
- ! ! end if
- ! ! end do
- ! ! end if
-
- ! do i=1,numberOfSteps
- ! coordinate(1)=lowerLimit(1)+(i-1)*step(1)
- ! do j=1, numberOfSteps
- ! coordinate(2)=lowerLimit(2)+(j-1)*step(2)
- ! do k=1, numberOfSteps
- ! coordinate(3)=lowerLimit(3)+(k-1)*step(3)
- ! select case (this%type)
- ! case ( "densityCube")
- ! val(k)=CalculateProperties_instance%densityCube(specieID)%values(i,j,k)
- ! ! case ( "orbitalCube")
- ! ! val(k)=MolecularSystem_getOrbitalValueAt( this%specie, this%orbital, coordinate )
- ! ! case ( "fukuiCube")
- ! ! val(k)=CalculateProperties_getFukuiAt( this%specie, "positive", coordinate )
- ! ! val2(k)=CalculateProperties_getFukuiAt( this%specie, "negative", coordinate )
- ! case default
- ! end select
- ! end do
- ! write(10,*) ( val(w) , w=1,numberOfSteps(3) )
- ! if (this%type .eq. "fukuiCube") write(11,*) ( val2(w) , w=1,numberOfSteps(3) )
- ! end do
- ! end do
-
- ! deallocate (val, val2)
-
- ! close(10)
- ! if (this%type .eq. "fukuiCube" ) close(11)
-
- ! end subroutine OutputBuilder_getCube
+ subroutine OutputBuilder_make2DGnuplot(fileName, title, x_title, y_title,&
+ x_format, y_format, x_range, y_range, numOfGraphs)
+ implicit none
+ character(*) :: fileName
+ character(*) :: title
+ character(*) :: x_title
+ character(*) :: y_title
+ character(*), optional :: x_format
+ character(*), optional :: y_format
+ character(*), optional :: x_range
+ character(*), optional :: y_range
+ integer, optional :: numOfGraphs
+
+ integer :: i
+ character(20) :: charNumOfGraph
+ character(20) :: auxXformat
+ character(20) :: auxYformat
+ character(20) :: auxXRange
+ character(20) :: auxYRange
+
+ integer :: auxNumOfGraphs
+
+ auxXformat="%.1f"
+ if(present(x_format)) auxXformat=trim(x_format)
+
+ auxYformat="%3.1E"
+ if(present(y_format)) auxYformat=trim(y_format)
+
+ auxXRange=" [] "
+ if(present(x_range)) auxXRange=' ['//trim(x_range)//'] '
+
+ auxYRange="[] "
+ if(present(y_range)) auxYRange='['//trim(y_range)//'] '
+
+ auxNumOfGraphs=1
+ if(present(numOfGraphs)) auxNumOfGraphs=numOfGraphs
+
+ open ( 10,FILE=trim(fileName)//".gnp", STATUS='REPLACE',ACTION='WRITE')
+ write (10,"(A)") 'set term post eps enh color dashed rounded dl 4 "Times-Bold" 15'
+ write (10,"(A)") 'set output "'//trim(fileName)//'.eps"'
+ write (10,"(A)") 'set encoding iso_8859_1'
+ write (10,"(A)") 'set title "'//trim(title)//'"'
+ write (10,"(A)") 'set xlabel "'//trim(x_title)//'"'
+ write (10,"(A)") 'set format x "'//trim(auxXformat)//'"'
+ write (10,"(A)") 'set ylabel "'//trim(y_title)//'"'
+ write (10,"(A)") 'set format y "'//trim(auxYformat)//'"'
+ if( auxNumOfGraphs >1) then
+ write (10,"(A$)") 'plot '//trim(auxXRange)//trim(auxYRange)//' "'//trim(fileName)//'" using 1:2 w l title "" '
+ do i=2, auxNumOfGraphs
+ charNumOfGraph=String_convertIntegerToString(i+1)
+ write (10,"(A$)") ', "'//trim(fileName)//'.dat"'//' using 1:'//trim(charNumOfGraph)//' w l title "" '
+ end do
+ write (10,"(A)") ""
+ else
+ write (10,"(A)") 'plot '//trim(auxXRange)//trim(auxYRange)//' "'//trim(fileName)//'" w l title "" '
+ end if
+ write (10,"(A)") 'set output'
+ close(10)
+
+ ! status= system("gnuplot "//trim(fileName)//".gnp")
+ call system("gnuplot "//trim(fileName)//".gnp")
+
+ end subroutine OutputBuilder_make2DGnuplot
+
+
+ subroutine OutputBuilder_make3DGnuplot(fileName, title, x_title, y_title, z_title, minValue, maxValue)
+
+ implicit none
+ character(*) :: fileName
+ character(*) :: title
+ character(*) :: x_title
+ character(*) :: y_title
+ character(*) :: z_title
+ real(8) :: minValue
+ real(8) :: maxValue
+
+ open ( 100,FILE=trim(fileName)//'.gnp', STATUS='REPLACE',ACTION='WRITE')
+ write (100,"(A)") 'set term post eps enh color "Helvetica" 16 size 7cm,5cm'
+ write (100,"(A)") 'set encoding iso_8859_1'
+ write (100,"(A)") 'set output "'//trim(fileName)//'.eps"'
+
+ write (100,"(A)") 'set table "'//trim(fileName)//'.table"'
+ write (100,"(A)") 'splot "'//trim(fileName)//'" u 1:2:3'
+ write (100,"(A)") 'unset table'
+
+ if(minValue.lt.0 .and. maxValue.gt.0) then
+ write (100,"(A,I5)") 'levels=', 11
+ else
+ write (100,"(A,I5)") 'levels=', 10
+ end if
+
+ write (100,"(A,E20.8)") 'maxValue=', maxValue
+ write (100,"(A,E20.8)") 'minValue=', minValue
+ write (100,"(A)") 'step=(maxValue-minValue)/levels'
+
+ write (100,"(A)") 'set contour base'
+ write (100,"(A)") 'set cntrparam level incremental minValue, step , maxValue'
+ write (100,"(A)") 'unset surface'
+
+ write (100,"(A)") 'set table "'//trim(fileName)//'.cont"'
+ write (100,"(A)") 'splot "'//trim(fileName)//'" u 1:2:3'
+ write (100,"(A)") 'unset table'
+
+ write (100,"(A)") 'reset'
+ write (100,"(A)") 'unset key'
+
+ write (100,"(A)") 'set cbrange [minValue:maxValue]'
+ write (100,"(A)") 'set palette maxcolors levels'
+ if(minValue.lt.0 .and. maxValue.gt.0) then
+ write (100,"(A)") 'set cbtics (minValue, 0.0, maxValue)'
+ else
+ write (100,"(A)") 'set cbtics step'
+ end if
+ write (100,"(A)") 'set format cb "%3.1E"'
+
+ if(minValue.lt.0 .and. maxValue.gt.0) then
+ write (100,"(A)") 'set palette defined (minValue "blue", 0.0 "white", maxValue "red")'
+ else if(minValue.ge.0) then
+ write (100,"(A)") 'set palette defined (minValue "white", maxValue "red")'
+ else
+ write (100,"(A)") 'set palette defined (minValue "blue", maxValue "white")'
+ end if
+
+ write (100,"(A)") 'set grid front'
+
+ write (100,"(A)") 'set format x "%.0f"'
+ write (100,"(A)") 'set format y "%.0f"'
+ write (100,"(A)") 'set xlabel "'//trim(x_title)//'"'
+ write (100,"(A)") 'set ylabel "'//trim(y_title)//'"'
+
+ write (100,"(A)") 'plot "'//trim(fileName)//'.table" with image, "'//trim(fileName)//'.cont" w l lt -1 lw 1.5'
+
+ close(100)
+
+ ! status= system("gnuplot "//trim(fileName)//".gnp")
+ call system("gnuplot "//trim(fileName)//".gnp")
+
+ end subroutine OutputBuilder_make3DGnuplot
+
+end module OutputBuilder_
diff --git a/src/scf/Convergence.f90 b/src/scf/Convergence.f90
index c8a27efc..ce06ef90 100644
--- a/src/scf/Convergence.f90
+++ b/src/scf/Convergence.f90
@@ -40,6 +40,7 @@ module Convergence_
type, public :: Convergence
character(30) :: name
+ type(MolecularSystem), pointer :: molSys
type(Matrix) :: initialDensityMatrix
type(Matrix) :: initialFockMatrix
@@ -97,12 +98,19 @@ module Convergence_
!>
!! @brief Define el constructor para la clase
- subroutine Convergence_constructor( this, name ,methodType )
+ subroutine Convergence_constructor( this, name ,methodType, system )
implicit none
type(Convergence), intent(inout) :: this
character(*),optional :: name
integer, optional :: methodType
+ type(MolecularSystem), optional, target :: system
+ if( present(system) ) then
+ this%molSys=>system
+ else
+ this%molSys=>MolecularSystem_instance
+ end if
+
this%name = "undefined"
if ( present(name) ) this%name = trim(name)
this%methodType = SCF_CONVERGENCE_DEFAULT
@@ -473,7 +481,7 @@ subroutine Convergence_dampingMethod( this )
!!********************************************************************************************
if ( fockAndDensityEffect <= densityEffect &
- .or. abs(fockAndDensityEffect+densityEffect) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD ) then
+ .or. abs(fockAndDensityEffect) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD ) then
this%initialFockMatrix%values = this%newFockMatrixPtr%values
this%initialDensityMatrix%values = this%newDensityMatrixPtr%values
@@ -682,7 +690,7 @@ subroutine Convergence_levelShifting(this)
if ( .not. CONTROL_instance%ACTIVATE_LEVEL_SHIFTING) return
- if ( MolecularSystem_instance%species(this%speciesID)%isElectron ) then
+ if ( this%molSys%species(this%speciesID)%isElectron ) then
levelShiftingFactor=CONTROL_instance%ELECTRONIC_LEVEL_SHIFTING
else
levelShiftingFactor=CONTROL_instance%NONELECTRONIC_LEVEL_SHIFTING
@@ -692,8 +700,8 @@ subroutine Convergence_levelShifting(this)
matmul( matmul( transpose(this%coefficientMatrix%values ) , &
this%newFockMatrixPtr%values), this%coefficientMatrix%values )
- do i=MolecularSystem_getOcupationNumber(this%speciesID)+1, &
- MolecularSystem_getTotalnumberOfContractions(this%speciesID)
+ do i=MolecularSystem_getOcupationNumber(this%speciesID,this%molSys)+1, &
+ MolecularSystem_getTotalnumberOfContractions(this%speciesID,this%molSys)
fockMatrixTransformed%values(i,i) = levelShiftingFactor + fockMatrixTransformed%values(i,i)
end do
@@ -722,14 +730,14 @@ subroutine Convergence_removeLevelShifting(this, eigenvalues)
if ( .not. CONTROL_instance%ACTIVATE_LEVEL_SHIFTING) return
- if ( MolecularSystem_instance%species(this%speciesID)%isElectron ) then
+ if ( this%molSys%species(this%speciesID)%isElectron ) then
levelShiftingFactor=CONTROL_instance%ELECTRONIC_LEVEL_SHIFTING
else
levelShiftingFactor=CONTROL_instance%NONELECTRONIC_LEVEL_SHIFTING
end if
- do i=MolecularSystem_getOcupationNumber(this%speciesID)+1, &
- MolecularSystem_getTotalnumberOfContractions(this%speciesID)
+ do i=MolecularSystem_getOcupationNumber(this%speciesID,this%molSys)+1, &
+ MolecularSystem_getTotalnumberOfContractions(this%speciesID,this%molSys)
eigenvalues%values(i) = eigenvalues%values(i) -levelShiftingFactor
end do
diff --git a/src/scf/DensityMatrixSCFGuess.f90 b/src/scf/DensityMatrixSCFGuess.f90
index a4937b0a..f3a279a3 100644
--- a/src/scf/DensityMatrixSCFGuess.f90
+++ b/src/scf/DensityMatrixSCFGuess.f90
@@ -41,7 +41,7 @@ module DensityMatrixSCFGuess_
!>
!! @brief Obtiene la matriz de densidad inicial
- subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformationMatrix, densityMatrix, orbitals, printInfo )
+ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformationMatrix, densityMatrix, orbitals, printInfo, system)
implicit none
integer, intent(in) :: speciesID
type(Matrix), intent(in) :: hcoreMatrix
@@ -49,9 +49,12 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio
type(Matrix), intent(inout) :: densityMatrix
type(Matrix), intent(inout) :: orbitals
logical, intent(in) :: printInfo
-
+ type(MolecularSystem), optional, target :: system
+
+ type(MolecularSystem), pointer :: molSys
+
type(Matrix) :: auxMatrix
- character(30) :: nameOfSpecies
+ character(30) :: nameOfSpecies, symbolOfSpecies
integer(8) :: orderOfMatrix, occupationNumber
logical :: existPlain, existBinnary, readSuccess
character(50) :: guessType
@@ -60,9 +63,16 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio
integer :: wfnUnit
integer :: i,j,k
- orderOfMatrix = MolecularSystem_getTotalnumberOfContractions( speciesID )
- nameOfSpecies = MolecularSystem_instance%species(speciesID)%name
- occupationNumber = MolecularSystem_getOcupationNumber( speciesID )
+ if( present(system) ) then
+ molSys=>system
+ else
+ molSys=>MolecularSystem_instance
+ end if
+
+ orderOfMatrix = MolecularSystem_getTotalnumberOfContractions(speciesID,molSys)
+ nameOfSpecies = molSys%species(speciesID)%name
+ symbolOfSpecies = molSys%species(speciesID)%symbol
+ occupationNumber = MolecularSystem_getOcupationNumber(speciesID,molSys)
readSuccess=.false.
arguments(2) = nameOfSpecies
@@ -70,11 +80,12 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio
call Matrix_constructor(densityMatrix, int(orderOfMatrix,8), int(orderOfMatrix,8), 0.0_8 )
call Matrix_constructor(orbitals, int(orderOfMatrix,8), int(orderOfMatrix,8), 0.0_8 )
-
+
+ readSuccess=.false.
!!Verifica el archivo que contiene los coeficientes para una especie dada
if ( CONTROL_instance%READ_FCHK ) then
- call MolecularSystem_readFchk(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".fchk", orbitals, densityMatrix, nameOfSpecies )
- return
+ wfnFile=trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".fchk"
+ call MolecularSystem_readFchk(wfnFile, orbitals, densityMatrix, nameOfSpecies, readSuccess)
else if ( CONTROL_instance%READ_COEFFICIENTS ) then
wfnUnit = 30
@@ -98,15 +109,12 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio
end if
end if
end if
-
- !check if the orbitals were read correctly
- if(.not. allocated(orbitals%values) ) readSuccess=.false.
-
+
if(readSuccess .and. printInfo ) print *, "Combination coefficients for ", trim(nameOfSpecies), " were read from ", trim(wfnFile)
if(.not. readSuccess) then
call Matrix_constructor(orbitals, orderOfMatrix, orderOfMatrix, 0.0_8 )
- if ( MolecularSystem_instance%species(speciesID)%isElectron ) then
+ if ( molSys%species(speciesID)%isElectron ) then
guessType=CONTROL_instance%SCF_ELECTRONIC_TYPE_GUESS
else
guessType=CONTROL_instance%SCF_NONELECTRONIC_TYPE_GUESS
@@ -159,10 +167,12 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio
end do
end do
end do
- densityMatrix%values=densityMatrix%values*MolecularSystem_getEta( speciesID )
+ densityMatrix%values=densityMatrix%values*MolecularSystem_getEta(speciesID,molSys)
- if ( CONTROL_instance%BUILD_MIXED_DENSITY_MATRIX ) then
- densityMatrix%values(occupationNumber,:) = 0.1*densityMatrix%values(occupationNumber,:)*densityMatrix%values(occupationNumber+1,:)
+ if ( CONTROL_instance%BUILD_MIXED_DENSITY_MATRIX .and. ( trim(nameOfSpecies)=="E-ALPHA" .or. trim(nameOfSpecies)=="E+A") ) then
+
+ densityMatrix%values(occupationNumber,:) = densityMatrix%values(occupationNumber,:) + 0.25*densityMatrix%values(occupationNumber,:)*densityMatrix%values(occupationNumber+1,:)
+
end if
end subroutine DensityMatrixSCFGuess_getGuess
@@ -182,7 +192,7 @@ subroutine DensityMatrixSCFGuess_hcore(speciesID, hcore, transformation, eigenVe
integer(8) :: orderOfMatrix
- orderOfMatrix = MolecularSystem_getTotalnumberOfContractions( speciesID )
+ orderOfMatrix = size(hcore%values,DIM=1)
if ( .not.allocated(eigenVectors%values) ) then
call Matrix_constructor(eigenVectors, orderOfMatrix, orderOfMatrix )
@@ -313,7 +323,7 @@ end module DensityMatrixSCFGuess_
! numberOfMatrixElements = int(orderOfMatrix, 8) ** 2_8
- ! ocupationNumber = MolecularSystem_instance%species(speciesID)%ocupationNumber
+ ! ocupationNumber = molSys%species(speciesID)%ocupationNumber
! ! vectors = Matrix_getFromFile(orderOfMatrix, orderOfMatrix, &
! ! file=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//".vec", binary = .false.)
diff --git a/src/scf/MultiSCF.f90 b/src/scf/MultiSCF.f90
index 4cc3be71..a5588ea4 100644
--- a/src/scf/MultiSCF.f90
+++ b/src/scf/MultiSCF.f90
@@ -38,11 +38,13 @@ module MultiSCF_
use List_
use MolecularSystem_
use WaveFunction_
+ use DensityFunctionalTheory_
use SingleSCF_
use omp_lib
use DensityMatrixSCFGuess_
use OrbitalLocalizer_
use Convergence_
+ use Libint2Interface_
implicit none
@@ -52,6 +54,7 @@ module MultiSCF_
type, public :: MultiSCF
+ type(MolecularSystem), pointer :: molSys
type(List) :: energyOMNE
character(100) :: name
integer :: numberOfIterations
@@ -75,6 +78,9 @@ module MultiSCF_
!!
logical :: printSCFiterations
+ !!
+ type(Grid), allocatable :: DFTGrids(:), DFTGridsCommonPoints(:,:)
+
end type MultiSCF
type(MultiSCF), public, target :: MultiSCF_instance
@@ -95,13 +101,22 @@ module MultiSCF_
!>
!! @brief Define el constructor para la clase
- subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
+ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme,molsystem)
implicit none
type(MultiSCF) :: this
type(WaveFunction) :: wfObjects(*)
integer :: iterationScheme
- integer :: i
+ type(MolecularSystem), target :: molsystem
+
+ integer :: i, nspecies, speciesID
+ integer :: dftUnit
+ character(50) :: labels(2)
+ character(50) :: dftFile
+
+ this%molSys=>molsystem
+ nspecies=MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
+
! isROHF = .false.
select case(iterationScheme)
case(0)
@@ -120,12 +135,12 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
this%numberOfIterations = 0
this%status = 0
- allocate(this%singleEnergyTolerance(MolecularSystem_getNumberOfQuantumSpecies()),&
- this%singleDensityTolerance(MolecularSystem_getNumberOfQuantumSpecies()),&
- this%singleMaxIterations(MolecularSystem_getNumberOfQuantumSpecies()))
+ allocate(this%singleEnergyTolerance(nspecies),&
+ this%singleDensityTolerance(nspecies),&
+ this%singleMaxIterations(nspecies))
- do i = 1, MolecularSystem_getNumberOfQuantumSpecies()
- if(MolecularSystem_instance%species(i)%isElectron ) then
+ do i = 1, nspecies
+ if(this%molSys%species(i)%isElectron ) then
this%singleEnergyTolerance(i)=CONTROL_instance%ELECTRONIC_ENERGY_TOLERANCE
this%singleDensityTolerance(i)=CONTROL_instance%ELECTRONIC_DENSITY_MATRIX_TOLERANCE
else
@@ -138,7 +153,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
case( 0 )
! we perform single species iterations for nonelectrons
- if(MolecularSystem_instance%species(i)%isElectron ) then
+ if(this%molSys%species(i)%isElectron ) then
this%singleMaxIterations(i)=1
else
this%singleMaxIterations(i)=CONTROL_instance%SCF_NONELECTRONIC_MAX_ITERATIONS
@@ -146,7 +161,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
case( 1 )
! we perform single species iterations for nelectrons
- if(MolecularSystem_instance%species(i)%isElectron ) then
+ if(this%molSys%species(i)%isElectron ) then
this%singleMaxIterations(i)=CONTROL_instance%SCF_ELECTRONIC_MAX_ITERATIONS
else
this%singleMaxIterations(i)=1
@@ -155,7 +170,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
case( 2 )
! we perform single species for all species
- if(MolecularSystem_instance%species(i)%isElectron ) then
+ if(this%molSys%species(i)%isElectron ) then
this%singleMaxIterations(i)=CONTROL_instance%SCF_ELECTRONIC_MAX_ITERATIONS
else
this%singleMaxIterations(i)=CONTROL_instance%SCF_NONELECTRONIC_MAX_ITERATIONS
@@ -163,7 +178,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
case ( 3 )
! we do not perform single species SCF
- if(MolecularSystem_instance%species(i)%isElectron ) then
+ if(this%molSys%species(i)%isElectron ) then
this%singleMaxIterations(i)=1
else
this%singleMaxIterations(i)=1
@@ -183,8 +198,36 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme)
if(CONTROL_instance%DEBUG_SCFS) this%printSCFiterations=.true.
!! Start the wavefunction object
- call WaveFunction_constructor(wfObjects)
+ call WaveFunction_constructor(wfObjects,nspecies,this%molSys)
+ !!Initialize DFT: Calculate Grids and build functionals
+ if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
+ if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then
+ call system("lowdin-DFT.x BUILD_SCF_GRID")
+ do speciesID = 1, nspecies
+ dftUnit = 77
+ dftFile = "lowdin."//trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys))//".grid"
+ open(unit = dftUnit, file=trim(dftFile), status="old", form="unformatted")
+
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys)
+ labels(1) = "EXACT-EXCHANGE-FRACTION"
+
+ call Vector_getFromFile(unit=dftUnit, binary=.true., value=wfObjects(speciesID)%exactExchangeFraction, arguments=labels)
+ close(unit=dftUnit)
+ ! print *, "el tormento tuyo", speciesID, these(speciesID)%exactExchangeFraction
+ end do
+ else !! Allocate DFT grids memory.
+ if(allocated(this%DFTGrids)) deallocate(this%DFTGrids)
+ allocate(this%DFTGrids(nspecies))
+
+ if (allocated(this%DFTGridsCommonPoints)) deallocate(this%DFTGridsCommonPoints)
+ allocate(this%DFTGridsCommonPoints(nspecies,nspecies))
+
+ call DensityFunctionalTheory_buildSCFGrid(this%DFTGrids,this%DFTGridsCommonPoints,wfObjects(1:nspecies)%exactExchangeFraction,this%molSys)
+ end if
+ end if
+
+
!! Start the orbital localizer object
if (CONTROL_instance%LOCALIZE_ORBITALS) call OrbitalLocalizer_constructor( )
@@ -230,10 +273,11 @@ end function MultiSCF_getLastEnergy
!! @brief Realiza esquema de iteracion SCF para todas las especies cuanticas presentes
!! @param
!!
- subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
+ subroutine MultiSCF_iterate(this, wfObjects, libint2Objects, iterationScheme)
implicit none
type(MultiSCF) :: this
- type(WaveFunction) :: wfObjects(*)
+ type(WaveFunction) :: wfObjects(*)
+ type(Libint2Interface) :: libint2Objects(:)
integer, intent(in) :: iterationScheme
integer :: i,j
@@ -247,7 +291,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
!!!We start with an update of the global energy and matrices
this%status = SCF_INTRASPECIES_CONVERGENCE_CONTINUE
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
densFile="lowdin.densmatrix"
@@ -258,7 +302,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
call WaveFunction_writeDensityMatricesToFile(wfObjects, densFile)
call system("lowdin-DFT.x SCF_DFT "//trim(densFile))
else
- call WaveFunction_getDFTContributions(wfObjects,"SCF")
+ call WaveFunction_getDFTContributions(wfObjects,this%DFTGrids,this%DFTGridsCommonPoints,"SCF")
end if
end if
@@ -266,9 +310,9 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
!Coupling Matrix is only updated in global SCF cycles
do i = 1, numberOfSpecies
- call WaveFunction_buildTwoParticlesMatrix(wfObjects(i))
+ call WaveFunction_buildTwoParticlesMatrix(wfObjects(i),libint2Objects=libint2Objects(:))
- call WaveFunction_buildCouplingMatrix(wfObjects,i)
+ call WaveFunction_buildCouplingMatrix(wfObjects,i,libint2Objects=libint2Objects(:))
if ( (CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS") .and. CONTROL_instance%GRID_STORAGE .eq. "DISK") then
call WaveFunction_readExchangeCorrelationMatrix(wfObjects(i))
@@ -305,7 +349,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
!!!Now we procede to update each species density matrices according to the iteration scheme selected
this%totalDensityMatrixStandardDeviation=0.0
do i = 1, numberOfSpecies
- nameOfSpecies = MolecularSystem_getNameOfSpecies(i)
+ nameOfSpecies = MolecularSystem_getNameOfSpecies(i,this%molSys)
oldEnergy=wfObjects(i)%totalEnergyForSpecies
deltaEnergy=1.0E16_8
singleIterator=0
@@ -334,7 +378,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
if(this%singleMaxIterations(i).gt.1) then
!! Updates two particle matrix
- call WaveFunction_buildTwoParticlesMatrix(wfObjects(i))
+ call WaveFunction_buildTwoParticlesMatrix(wfObjects(i),libint2Objects=libint2Objects(:))
if (CONTROL_instance%COSMO) then
call WaveFunction_buildCosmo2Matrix(wfObjects(i))
@@ -382,10 +426,10 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme)
if ( CONTROL_instance%FORCE_CLOSED_SHELL .and. &
(CONTROL_instance%METHOD .eq. "UKS" .or. CONTROL_instance%METHOD .eq. "UHF") ) then
- i=MolecularSystem_getSpecieIDFromSymbol( trim("E-ALPHA") )
- j=MolecularSystem_getSpecieIDFromSymbol( trim("E-BETA") )
+ i=MolecularSystem_getSpecieIDFromSymbol(trim("E-ALPHA"),this%molSys)
+ j=MolecularSystem_getSpecieIDFromSymbol(trim("E-BETA"),this%molSys)
- if(MolecularSystem_getNumberOfParticles(i) .eq. MolecularSystem_getNumberOfParticles(j) ) then
+ if(MolecularSystem_getNumberOfParticles(i,this%molSys) .eq. MolecularSystem_getNumberOfParticles(j,this%molSys) ) then
wfObjects(j)%waveFunctionCoefficients%values= wfObjects(i)%waveFunctionCoefficients%values
wfObjects(j)%densityMatrix%values= wfObjects(i)%densityMatrix%values
end if
@@ -432,13 +476,13 @@ end subroutine MultiSCF_iterate
! if ( this%numberOfIterations > 1 ) then
! auxVar=.true.
- ! do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies()
+ ! do speciesID = 1, nspecies
! nameOfSpecie = MolecularSystem_getNameOfSpecies(speciesID)
! toleraceOfSpecie = this%electronicTolerance
- ! if (.not. MolecularSystem_instance%species(speciesID)%isElectron ) then
+ ! if (.not. this%molSys%species(speciesID)%isElectron ) then
! toleraceOfSpecie = this%nonelectronicTolerance
! end if
@@ -504,7 +548,7 @@ subroutine MultiSCF_reset(this,wfObjects)
call List_clear( this%energyOMNE )
this%status = SCF_INTRASPECIES_CONVERGENCE_CONTINUE
- do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies()
+ do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
call SingleSCF_reset(wfObjects(speciesIterator))
end do
@@ -566,10 +610,10 @@ subroutine MultiSCF_buildHcore(this,wfObjects)
call MolecularSystem_exception(ERROR,"lowdin.opints file not found!", "In SCF.f90 at main program")
open(unit=integralsUnit, file=trim(integralsFile), status="old", form="unformatted")
read(integralsUnit) numberOfSpecies
- if(MolecularSystem_instance%numberOfQuantumSpecies /= numberOfSpecies ) &
+ if(this%molSys%numberOfQuantumSpecies /= numberOfSpecies ) &
call MolecularSystem_exception( ERROR, "Bad "//trim(integralsFile)//" file!", "In SCF.f90 at main program")
close(integralsUnit)
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
call WaveFunction_readOverlapMatrix(wfObjects(speciesID), trim(integralsFile))
call WaveFunction_readKineticMatrix(wfObjects(speciesID), trim(integralsFile))
call WaveFunction_readPuntualInteractionMatrix(wfObjects(speciesID), trim(integralsFile))
@@ -579,6 +623,10 @@ subroutine MultiSCF_buildHcore(this,wfObjects)
if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then
call WaveFunction_readElectricFieldMatrices(wfObjects(speciesID), trim(integralsFile))
end if
+
+ if ( MolecularSystem_getOmega(speciesID,this%molSys) .ne. 0.0_8) then
+ call WaveFunction_readHarmonicOscillatorMatrix(wfObjects(speciesID), trim(integralsFile))
+ end if
!! Builds Cosmo hcore integrals
if(CONTROL_instance%COSMO)then
cosmoIntegralsFile="cosmo.opints"
@@ -586,24 +634,24 @@ subroutine MultiSCF_buildHcore(this,wfObjects)
end if
end do
else !!DIRECT or MEMORY
- numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies
+ numberOfSpecies = this%molSys%numberOfQuantumSpecies
do speciesID = 1, numberOfSpecies
- call DirectIntegralManager_getOverlapIntegrals(molecularSystem_instance,speciesID,&
+ call DirectIntegralManager_getOverlapIntegrals(this%molSys,speciesID,&
wfObjects(speciesID)%overlapMatrix)
- call DirectIntegralManager_getKineticIntegrals(molecularSystem_instance,speciesID,&
+ call DirectIntegralManager_getKineticIntegrals(this%molSys,speciesID,&
wfObjects(speciesID)%kineticMatrix)
- call DirectIntegralManager_getAttractionIntegrals(molecularSystem_instance,speciesID,&
+ call DirectIntegralManager_getAttractionIntegrals(this%molSys,speciesID,&
wfObjects(speciesID)%puntualInteractionMatrix)
if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then
- call DirectIntegralManager_getExternalPotentialIntegrals(molecularSystem_instance,speciesID,&
+ call DirectIntegralManager_getExternalPotentialIntegrals(this%molSys,speciesID,&
wfObjects(speciesID)%externalPotentialMatrix)
end if
end do
end if
!!**********************************************************
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
!! Transformation Matrix
call WaveFunction_buildTransformationMatrix(wfObjects(speciesID), 2)
!! Hcore Matrix
@@ -624,23 +672,24 @@ subroutine MultiSCF_getInitialGuess(this,wfObjects)
!!**********************************************************
!! Build Guess and first density matrix
!!
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
call DensityMatrixSCFGuess_getGuess( speciesID, wfObjects(speciesID)%HcoreMatrix, &
wfObjects(speciesID)%transformationMatrix, &
wfObjects(speciesID)%densityMatrix,&
wfObjects(speciesID)%waveFunctionCoefficients, &
- this%printSCFiterations)
+ this%printSCFiterations, &
+ this%molSys)
normCheck=sum( transpose(wfObjects(speciesID)%densityMatrix%values)*wfObjects(speciesID)%overlapMatrix%values)
if ( this%printSCFiterations ) &
- write(*,"(A15,A10,A40,F12.6)") "number of ", trim(MolecularSystem_getNameOfSpecies( speciesID )) , &
+ write(*,"(A15,A10,A40,F12.6)") "number of ", trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys)) , &
" particles in guess density matrix: ", normCheck
- expectedOccupation=MolecularSystem_getEta(speciesID)*MolecularSystem_instance%species(speciesID)%ocupationNumber
- if (trim(MolecularSystem_getNameOfSpecies( speciesID )) .eq. trim(CONTROL_instance%IONIZE_SPECIES(1))) then
+ expectedOccupation=MolecularSystem_getEta(speciesID,this%molSys)*this%molSys%species(speciesID)%ocupationNumber
+ if (trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys)) .eq. trim(CONTROL_instance%IONIZE_SPECIES(1))) then
do i=1,size(CONTROL_instance%IONIZE_MO)
if(CONTROL_instance%IONIZE_MO(i) .gt. 0 .and. CONTROL_instance%MO_FRACTION_OCCUPATION(i) .lt. 1.0_8) &
- expectedOccupation=expectedOccupation-MolecularSystem_getEta(speciesID)*(1.0-CONTROL_instance%MO_FRACTION_OCCUPATION(i))
+ expectedOccupation=expectedOccupation-MolecularSystem_getEta(speciesID,this%molSys)*(1.0-CONTROL_instance%MO_FRACTION_OCCUPATION(i))
end do
end if
@@ -653,8 +702,8 @@ subroutine MultiSCF_getInitialGuess(this,wfObjects)
end if
if ( CONTROL_instance%DEBUG_SCFS ) then
- print *, "Initial Density Matrix ", trim(MolecularSystem_getNameOfSpecie( speciesID ))
- call Matrix_show(WaveFunction_instance(speciesID)%densityMatrix)
+ print *, "Initial Density Matrix ", trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys))
+ call Matrix_show(wfObjects(speciesID)%densityMatrix)
end if
end do
@@ -662,10 +711,10 @@ subroutine MultiSCF_getInitialGuess(this,wfObjects)
!Forces equal coefficients for E-ALPHA and E-BETA in open shell calculations
if ( CONTROL_instance%FORCE_CLOSED_SHELL .and. &
(CONTROL_instance%METHOD .eq. "UKS" .or. CONTROL_instance%METHOD .eq. "UHF") ) then
- speciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-ALPHA") )
- otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-BETA") )
+ speciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-ALPHA"),this%molSys)
+ otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-BETA"),this%molSys)
- if(MolecularSystem_getNumberOfParticles(speciesID) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID) ) then
+ if(MolecularSystem_getNumberOfParticles(speciesID,this%molSys) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID,this%molSys)) then
wfObjects(otherSpeciesID)%waveFunctionCoefficients%values= wfObjects(speciesID)%waveFunctionCoefficients%values
wfObjects(otherSpeciesID)%densityMatrix%values= wfObjects(speciesID)%densityMatrix%values
end if
@@ -681,7 +730,7 @@ end subroutine MultiSCF_getInitialGuess
subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects)
type(MultiSCF) :: this
type(WaveFunction) :: wfObjects(*)
- type(Libint2Interface), optional :: libint2Objects(*)
+ type(Libint2Interface) :: libint2Objects(:)
real(8) :: oldEnergy
real(8) :: deltaEnergy
@@ -704,7 +753,7 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects)
densUnit=78
densFile="lowdin.densmatrix"
- numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies
+ numberOfSpecies = this%molSys%numberOfQuantumSpecies
!!
!!***************************************************************************************************************
@@ -731,7 +780,7 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects)
do while(GLOBAL_SCF_CONTINUE)
- call MultiSCF_iterate(this, wfObjects, CONTROL_instance%ITERATION_SCHEME )
+ call MultiSCF_iterate(this, wfObjects, libint2Objects(:), CONTROL_instance%ITERATION_SCHEME )
deltaEnergy = oldEnergy -MultiSCF_getLastEnergy(this)
oldEnergy = MultiSCF_getLastEnergy(this)
@@ -741,7 +790,7 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects)
write(*,"(I15,F25.12,F25.12,F25.12,F25.12)") MultiSCF_getNumberOfIterations(this), &
MultiSCF_getLastEnergy(this), deltaEnergy, &
this%totalDensityMatrixStandardDeviation ,&
- sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%particlesInGrid)
+ sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%particlesInGrid)
else
write(*,"(I15,F25.12,F25.12,F25.12)") MultiSCF_getNumberOfIterations(this), &
MultiSCF_getLastEnergy(this), deltaEnergy, &
@@ -809,17 +858,18 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects)
! print *,""
! end if
- call MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
+ call MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects(:))
end subroutine MultiSCF_solveHartreeFockRoothan
!>
!! @brief solve multcomponent FC=eSC SCF equations, store the coefficients in wfObjects, use the libint2Objects to compute the integrals in direct calculations
- subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
+ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects,method)
type(MultiSCF) :: this
type(WaveFunction) :: wfObjects(*)
- type(Libint2Interface), optional :: libint2Objects(*)
-
+ type(Libint2Interface) :: libint2Objects(:)
+ character(*), optional :: method
+
integer :: numberOfSpecies
integer :: wfnUnit, densUnit
integer :: speciesID, otherSpeciesID, i
@@ -828,6 +878,8 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
character(50) :: integralsFile
integer :: integralsUnit
+ if( .not. present(method) ) method=CONTROL_instance%METHOD
+
!! Open file for wfn
wfnUnit = 300
wfnFile = "lowdin.wfn"
@@ -838,7 +890,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
densUnit=78
densFile="lowdin.densmatrix"
- numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies
+ numberOfSpecies = this%molSys%numberOfQuantumSpecies
if (CONTROL_instance%LOCALIZE_ORBITALS) then
@@ -846,7 +898,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted")
rewind(wfnUnit)
do speciesID=1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys)
labels(1) = "COEFFICIENTS"
call Matrix_writeToFile(wfObjects(speciesID)%waveFunctionCoefficients, unit=wfnUnit, binary=.true., arguments = labels )
labels(1) = "ORBITALS"
@@ -864,7 +916,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
write(*,*) "=============================="
write(*,*) ""
do speciesID=1, numberOfSpecies
- if(MolecularSystem_getMass( speciesID ) .lt. 10.0 .and. MolecularSystem_getOcupationNumber( speciesID ) .gt. 1) then !We assume that heavy particle orbitals are naturally localized
+ if(MolecularSystem_getMass(speciesID,this%molSys) .lt. 10.0 .and. MolecularSystem_getOcupationNumber(speciesID,this%molSys) .gt. 1) then !We assume that heavy particle orbitals are naturally localized
call OrbitalLocalizer_erkaleLocal(speciesID,&
wfObjects( speciesID )%densityMatrix,&
wfObjects( speciesID )%fockMatrix, &
@@ -891,10 +943,10 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
!Forces equal coefficients for E-ALPHA and E-BETA in open shell calculations
if ( CONTROL_instance%FORCE_CLOSED_SHELL .and. &
(CONTROL_instance%METHOD .eq. "UKS" .or. CONTROL_instance%METHOD .eq. "UHF") ) then
- speciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-ALPHA") )
- otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-BETA") )
+ speciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-ALPHA"),this%molSys)
+ otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-BETA"),this%molSys)
- if(MolecularSystem_getNumberOfParticles(speciesID) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID) ) then
+ if(MolecularSystem_getNumberOfParticles(speciesID,this%molSys) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID,this%molSys)) then
wfObjects(otherSpeciesID)%waveFunctionCoefficients%values= wfObjects(speciesID)%waveFunctionCoefficients%values
wfObjects(otherSpeciesID)%densityMatrix%values= wfObjects(speciesID)%densityMatrix%values
end if
@@ -908,7 +960,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
call system("lowdin-DFT.x BUILD_FINAL_GRID "//trim(densFile))
call system("lowdin-DFT.x FINAL_DFT "//trim(densFile))
else
- call WaveFunction_getDFTContributions(wfObjects,"FINAL")
+ call WaveFunction_getDFTContributions(wfObjects,this%DFTGrids,this%DFTGridsCommonPoints,"FINAL")
end if
end if
@@ -923,16 +975,16 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects)
call WaveFunction_readExchangeCorrelationMatrix(wfObjects(speciesID))
end if
- call WaveFunction_buildTwoParticlesMatrix(wfObjects(speciesID))
+ call WaveFunction_buildTwoParticlesMatrix(wfObjects(speciesID),libint2Objects=libint2Objects(:))
!Separate coulomb and exchange contributions to two particles matrix
call WaveFunction_buildTwoParticlesMatrix(wfObjects(speciesID), &
- twoParticlesMatrixOUT=wfObjects(speciesID)%hartreeMatrix(speciesID), factorIN=0.0_8 )
+ twoParticlesMatrixOUT=wfObjects(speciesID)%hartreeMatrix(speciesID), factorIN=0.0_8, libint2Objects=libint2Objects(:) )
wfObjects(speciesID)%exchangeHFMatrix%values= wfObjects(speciesID)%twoParticlesMatrix%values &
-wfObjects(speciesID)%hartreeMatrix(speciesID)%values
- call WaveFunction_buildCouplingMatrix(wfObjects,speciesID)
+ call WaveFunction_buildCouplingMatrix(wfObjects,speciesID, libint2Objects=libint2Objects(:))
call WaveFunction_buildFockMatrix(wfObjects(speciesID))
@@ -972,13 +1024,14 @@ subroutine MultiSCF_showResults(this,wfObjects)
!! Show results
!! Shows iterations by species
+
if ( this%printSCFiterations ) then
if(.not. CONTROL_instance%ELECTRONIC_WaveFunction_ANALYSIS ) then
- do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies()
+ do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
- nameOfSpecies = MolecularSystem_getNameOfSpecies(speciesID)
+ nameOfSpecies = MolecularSystem_getNameOfSpecies(speciesID,this%molSys)
numberOfIterations = List_size( wfObjects(speciesID)%energySCF )
call List_begin( wfObjects(speciesID)%energySCF )
@@ -1030,12 +1083,12 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) ""
if ( CONTROL_instance%HF_PRINT_EIGENVALUES ) then
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
write(*,*) ""
- write(*,*) " Eigenvalues for: ", trim( MolecularSystem_instance%species(speciesID)%name )
+ write(*,*) " Eigenvalues for: ", trim( this%molSys%species(speciesID)%name )
write(*,*) "-----------------"
write(*,*) ""
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,this%molSys)
do i = 1 , numberOfContractions
write(6,"(T2,I4,F25.12)") i,wfObjects(speciesID)%molecularOrbitalsEnergy%values(i)
end do
@@ -1046,14 +1099,14 @@ subroutine MultiSCF_showResults(this,wfObjects)
if ( trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "ALL" .or. trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "OCCUPIED" ) then
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,this%molSys)
if ( trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "ALL") then
write(*,*) ""
- write(*,*) " Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name )
+ write(*,*) " Eigenvectors for: ", trim( this%molSys%species(speciesID)%name )
write(*,*) "-----------------"
write(*,*) ""
@@ -1068,13 +1121,13 @@ subroutine MultiSCF_showResults(this,wfObjects)
else if ( trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "OCCUPIED" ) then
write(*,*) ""
- write(*,*) " Occupied Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name )
+ write(*,*) " Occupied Eigenvectors for: ", trim( this%molSys%species(speciesID)%name )
write(*,*) "--------------------------- "
write(*,*) ""
- call Matrix_constructor(coefficientsShow,int(numberOfContractions,8),int(MolecularSystem_getOcupationNumber(speciesID),8),0.0_8)
+ call Matrix_constructor(coefficientsShow,int(numberOfContractions,8),int(MolecularSystem_getOcupationNumber(speciesID,this%molSys),8),0.0_8)
do i=1, numberOfContractions
- do j=1, MolecularSystem_getOcupationNumber(speciesID)
+ do j=1, MolecularSystem_getOcupationNumber(speciesID,this%molSys)
coefficientsShow%values(i,j)=wfObjects(speciesID)%waveFunctionCoefficients%values(i,j)
end do
end do
@@ -1082,8 +1135,8 @@ subroutine MultiSCF_showResults(this,wfObjects)
end if
call Matrix_show(coefficientsShow , &
- rowkeys = MolecularSystem_getlabelsofcontractions( speciesID ), &
- columnkeys = string_convertvectorofrealstostring( wfObjects(speciesID)%molecularOrbitalsEnergy ),&
+ rowkeys = MolecularSystem_getlabelsofcontractions(speciesID,this%molSys), &
+ columnkeys = string_convertvectorofrealstostring(wfObjects(speciesID)%molecularOrbitalsEnergy ),&
flags=WITH_BOTH_KEYS)
call Matrix_destructor(coefficientsShow)
@@ -1104,11 +1157,11 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) "-----------------------------"
write(*,*) ""
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
" Kinetic energy = ", wfObjects(speciesID)%kineticEnergy
end do
- this%totalKineticEnergy = sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%kineticEnergy)
+ this%totalKineticEnergy = sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%kineticEnergy)
write(*,"(T38,A25)") "___________________________"
write(*,"(A38,F25.12)") "Total kinetic energy = ", this%totalKineticEnergy
@@ -1118,10 +1171,10 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) "-------------------------------"
write(*,*) ""
- puntualInteractionEnergy = MolecularSystem_getPointChargesEnergy()
+ puntualInteractionEnergy = MolecularSystem_getPointChargesEnergy(this%molSys)
write(*,"(A38,F25.12)") "Fixed potential energy = ", puntualInteractionEnergy
- puntualMMInteractionEnergy = MolecularSystem_getMMPointChargesEnergy()
+ puntualMMInteractionEnergy = MolecularSystem_getMMPointChargesEnergy(this%molSys)
if(CONTROL_instance%CHARGES_MM) then
write(*,"(A38,F25.12)") "Self MM potential energy = ", puntualMMInteractionEnergy
end if
@@ -1131,11 +1184,11 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) "----------------------------------"
write(*,*) ""
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
"/Fixed interact. energy = ", wfObjects(speciesID)%puntualInteractionEnergy
end do
- totalQuantumPuntualInteractionEnergy = sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%puntualInteractionEnergy )
+ totalQuantumPuntualInteractionEnergy = sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%puntualInteractionEnergy )
write(*,"(T38,A25)") "___________________________"
write(*,"(A38,F25.12)") "Total Q/Fixed energy = ", totalQuantumPuntualInteractionEnergy
@@ -1144,16 +1197,16 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) "------------------"
write(*,*) ""
totalHartreeEnergy=0.0
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- "/"//trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
+ "/"//trim( this%molSys%species(speciesID)%name ) // &
" Hartree energy = ", wfObjects(speciesID)%hartreeEnergy(speciesID)
totalHartreeEnergy=totalHartreeEnergy+wfObjects(speciesID)%hartreeEnergy(speciesID)
end do
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- do otherSpeciesID = speciesID + 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ do otherSpeciesID = speciesID + 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
+ "/"//trim( this%molSys%species(otherSpeciesID)%name ) // &
" Hartree energy = ", wfObjects(speciesID)%hartreeEnergy(otherSpeciesID)
totalHartreeEnergy=totalHartreeEnergy+wfObjects(speciesID)%hartreeEnergy(otherSpeciesID)
end do
@@ -1165,11 +1218,11 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) " Exchange(HF) energy: "
write(*,*) "----------------------"
write(*,*) ""
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
" Exchange energy = ", wfObjects(speciesID)%exchangeHFEnergy
end do
- totalExchangeHFEnergy=sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%exchangeHFEnergy)
+ totalExchangeHFEnergy=sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%exchangeHFEnergy)
write(*,"(T38,A25)") "___________________________"
write(*,"(A38,F25.12)") "Total Exchange energy = ", totalExchangeHFEnergy
@@ -1180,15 +1233,15 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) "-----------------------------------"
write(*,*) ""
totalExchangeCorrelationEnergy=0.0
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
" Exc.Corr. energy = ", wfObjects(speciesID)%exchangeCorrelationEnergy(speciesID)
totalExchangeCorrelationEnergy=totalExchangeCorrelationEnergy+wfObjects(speciesID)%exchangeCorrelationEnergy(speciesID)
end do
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- do otherSpeciesID = speciesID + 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // &
- "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ do otherSpeciesID = speciesID + 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // &
+ "/"//trim( this%molSys%species(otherSpeciesID)%name ) // &
" Corr. energy = ", wfObjects(speciesID)%exchangeCorrelationEnergy(otherSpeciesID)
totalExchangeCorrelationEnergy=totalExchangeCorrelationEnergy+wfObjects(speciesID)%exchangeCorrelationEnergy(otherSpeciesID)
end do
@@ -1205,11 +1258,11 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) "----------------------------"
write(*,*) ""
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name) // &
+ do speciesID = 1, this%molSys%numberOfQuantumSpecies
+ write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name) // &
" Ext Pot energy = ", wfObjects(speciesID)%externalPotentialEnergy
end do
- totalExternalPotentialEnergy=sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%externalPotentialEnergy)
+ totalExternalPotentialEnergy=sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%externalPotentialEnergy)
write(*,"(T38,A25)") "___________________________"
write(*,"(A38,F25.12)") "Total External Potential energy = ", totalExternalPotentialEnergy
@@ -1220,7 +1273,7 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) " COSMO ENERGY: "
write(*,*) "--------------"
write(*,*) ""
- totalCosmoEnergy = sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%cosmoEnergy)
+ totalCosmoEnergy = sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%cosmoEnergy)
write(*,"(A38,F25.12)") "Total Cosmo Energy = ", totalCosmoEnergy
write(*,"(A38,F25.12)") "Cosmo 3 Energy = ", this%cosmo3Energy
end if
@@ -1255,7 +1308,7 @@ subroutine MultiSCF_showResults(this,wfObjects)
write(*,*) " COSMO CHARGE: "
write(*,*) "--------------"
write(*,*) ""
- call WaveFunction_cosmoQuantumCharge()
+ call WaveFunction_cosmoQuantumCharge(this%molSys)
end if
end subroutine MultiSCF_showResults
@@ -1293,11 +1346,11 @@ subroutine MultiSCF_saveWfn(this,wfObjects)
labels = ""
- numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies
+ numberOfSpecies = this%molSys%numberOfQuantumSpecies
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys)
labels(1) = "REMOVED-ORBITALS"
call Vector_writeToFile(unit=wfnUnit, binary=.true., value=real(wfObjects(speciesID)%removedOrbitals,8), arguments= labels )
@@ -1370,7 +1423,7 @@ subroutine MultiSCF_saveWfn(this,wfObjects)
vecFile = trim(CONTROL_instance%INPUT_FILE)//"vec"
open(unit=vecUnit, file=trim(vecFile), form="unformatted", status='replace')
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys)
labels(1) = "COEFFICIENTS"
call Matrix_writeToFile(wfObjects(speciesID)%waveFunctionCoefficients, &
unit=vecUnit, binary=.true., arguments = labels)
@@ -1385,7 +1438,7 @@ subroutine MultiSCF_saveWfn(this,wfObjects)
open(unit=vecUnit, file=trim(vecFile), form="formatted", status='replace')
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys)
labels(1) = "COEFFICIENTS"
call Matrix_writeToFile(wfObjects(speciesID)%waveFunctionCoefficients, &
unit=vecUnit, binary=.false., arguments = labels)
@@ -1408,7 +1461,7 @@ subroutine MultiSCF_saveWfn(this,wfObjects)
call Vector_writeToFile(unit=wfnUnit, binary=.true., value=this%totalCouplingEnergy, arguments=["COUPLINGENERGY"])
- call Vector_writeToFile(unit=wfnUnit, binary=.true., value=MolecularSystem_getPointChargesEnergy(), arguments=["PUNTUALINTERACTIONENERGY"])
+ call Vector_writeToFile(unit=wfnUnit, binary=.true., value=MolecularSystem_getPointChargesEnergy(this%molSys), arguments=["PUNTUALINTERACTIONENERGY"])
call Vector_writeToFile(unit=wfnUnit, binary=.true., value=- ( this%totalPotentialEnergy / this%totalKineticEnergy) , arguments=["VIRIAL"])
@@ -1425,9 +1478,9 @@ subroutine MultiSCF_reorderIonizedCoefficients(this,wfObjects)
type(Vector) :: auxVector
integer :: occupationNumber, newOccupationNumber, i, j, speciesID
- do speciesID=1, MolecularSystem_getNumberOfQuantumSpecies()
+ do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
if (trim(wfObjects(speciesID)%name) .eq. trim(CONTROL_instance%IONIZE_SPECIES(1)) ) then
- occupationNumber=MolecularSystem_getOcupationNumber(speciesID)
+ occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molSys)
newOccupationNumber=occupationNumber
call Matrix_copyConstructor(auxMatrix,wfObjects(speciesID)%waveFunctionCoefficients)
call Vector_copyConstructor(auxVector,wfObjects(speciesID)%molecularOrbitalsEnergy)
@@ -1442,9 +1495,9 @@ subroutine MultiSCF_reorderIonizedCoefficients(this,wfObjects)
newOccupationNumber=newOccupationNumber-1
end if
end do
- molecularSystem_instance%species(speciesID)%ocupationNumber=newOccupationNumber
+ this%molSys%species(speciesID)%ocupationNumber=newOccupationNumber
if(CONTROL_instance%DEBUG_SCFS) then
- print *, "newOccupationNumber for", trim(wfObjects(speciesID)%name), molecularSystem_instance%species(speciesID)%ocupationNumber
+ print *, "newOccupationNumber for", trim(wfObjects(speciesID)%name), this%molSys%species(speciesID)%ocupationNumber
call Matrix_show(wfObjects(speciesID)%waveFunctionCoefficients)
end if
end if
diff --git a/src/scf/OrbitalLocalizer.f90 b/src/scf/OrbitalLocalizer.f90
index b959c306..006ab893 100644
--- a/src/scf/OrbitalLocalizer.f90
+++ b/src/scf/OrbitalLocalizer.f90
@@ -109,7 +109,7 @@ subroutine OrbitalLocalizer_erkaleLocal(speciesID,densityMatrix,fockMatrix,orbit
type(Matrix) :: orbitalCoefficients
type(Vector) :: orbitalEnergies
- character(30) :: nameOfSpecies
+ character(30) :: nameOfSpecies, symbolOfSpecies
integer :: statusSystem
integer :: numberOfContractions
@@ -117,12 +117,13 @@ subroutine OrbitalLocalizer_erkaleLocal(speciesID,densityMatrix,fockMatrix,orbit
!! Convert lowdin fchk files to erkale chk files
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
+ symbolOfSpecies=MolecularSystem_getSymbolOfSpecies(speciesID)
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
open(unit=30, file="erkale.read", status="replace", form="formatted")
- write(30,*) "LoadFChk ", trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".fchk"
- write(30,*) "SaveChk ", trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".chk"
+ write(30,*) "LoadFChk ", trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".fchk"
+ write(30,*) "SaveChk ", trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".chk"
write(30,*) "Reorthonormalize true"
close(30)
@@ -132,8 +133,8 @@ subroutine OrbitalLocalizer_erkaleLocal(speciesID,densityMatrix,fockMatrix,orbit
!! Localize orbitals
open(unit=30, file="erkale.local", status="replace", form="formatted")
- write(30,*) "LoadChk ", trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".chk"
- write(30,*) "SaveChk ", trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".local.chk"
+ write(30,*) "LoadChk ", trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".chk"
+ write(30,*) "SaveChk ", trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".local.chk"
write(30,*) "Method ", trim(CONTROL_instance%ERKALE_LOCALIZATION_METHOD)
write(30,*) "Virtual false"
write(30,*) "Maxiter 5000"
@@ -149,15 +150,15 @@ subroutine OrbitalLocalizer_erkaleLocal(speciesID,densityMatrix,fockMatrix,orbit
!!Convert erkale chk files to lowdin fchk files
open(unit=30, file="erkale.write", status="replace", form="formatted")
- write(30,*) "LoadChk ", trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".local.chk"
- write(30,*) "SaveFChk ", trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".local.fchk"
+ write(30,*) "LoadChk ", trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".local.chk"
+ write(30,*) "SaveFChk ", trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".local.fchk"
close(30)
call system("erkale_fchkpt erkale.write")
!! Read orbital coefficients from fchk files
- call MolecularSystem_readFchk(trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecies)//".local.fchk", orbitalCoefficients, densityMatrix, nameOfSpecies )
+ call MolecularSystem_readFchk(trim(CONTROL_instance%INPUT_FILE)//trim(symbolOfSpecies)//".local.fchk", orbitalCoefficients, densityMatrix, nameOfSpecies )
orbitalEnergies%values=0.0
!! Molecular orbital fock operator expected value
@@ -294,7 +295,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
do speciesID=1, numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
numberOfCenters = size(MolecularSystem_instance%species(speciesID)%particles)
occupationNumber = MolecularSystem_getOcupationNumber( speciesID )
@@ -491,7 +492,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
!!Reduce basis set loops
do speciesID=1, numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
numberOfCenters = size(MolecularSystem_instance%species(speciesID)%particles)
overlapMatrix=WaveFunction_instance( speciesID )%OverlapMatrix
@@ -578,7 +579,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
end do
do speciesID=1, numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
!Adds diagonal proyection elements to orbitals with small contributions to A orbitals - small mulliken population
@@ -673,7 +674,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
write(*,"(A15,A15,A15,A15,A15)") "Species", "Occupied A","Virtual A","Occupied B", "Virtual B"
write(*,"(A75)") "---------------------------------------------------------------------------"
do speciesID=1, numberOfSpecies
- write(*,"(A15,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A)") trim(MolecularSystem_getNameOfSpecie(speciesID)), &
+ write(*,"(A15,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A)") trim(MolecularSystem_getNameOfSpecies(speciesID)), &
OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsA,&
100.0_8*OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsA/(OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsA+OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsB),&
"%",&
@@ -699,7 +700,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
!Two particles and coupling matrices
do speciesID=1, numberOfSpecies
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
!Only Coulomb (factor=0.0)
call WaveFunction_buildTwoParticlesMatrix(WaveFunction_instance(speciesID),&
densityMatrixIN=densityMatrixB(speciesID),&
@@ -814,7 +815,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
!Calculates the fock matrix with the new subsystem density
do speciesID=1, numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
!Updates two particles matrix - only Coulomb (factor=0.0)
call WaveFunction_buildTwoParticlesMatrix(WaveFunction_instance(speciesID),&
@@ -991,7 +992,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
!Calculates the subsystem orbitals with the new fock matrix
do speciesID=1, numberOfSpecies
numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
- nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID)
+ nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID)
call Matrix_copyConstructor( fockMatrixTransformed, OrbitalLocalizer_instance(speciesID)%fockMatrixA )
@@ -1833,7 +1834,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
!! Start the wavefunction object
deallocate(WaveFunction_instance)
- call WaveFunction_constructor(WaveFunction_instance)
+ call WaveFunction_constructor(WaveFunction_instance,numberOfSpecies)
do speciesID=1, numberOfSpecies
call WaveFunction_readOverlapMatrix(WaveFunction_instance(speciesID), "lowdin.opints")
@@ -1930,7 +1931,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted")
rewind(wfnUnit)
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
labels(1) = "DENSITY"
call Matrix_writeToFile(WaveFunction_instance(speciesID)%densityMatrix, unit=wfnUnit, binary=.true., arguments = labels )
end do
@@ -2103,7 +2104,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
labels(1) = "REMOVED-ORBITALS"
call Vector_writeToFile(unit=wfnUnit, binary=.true., value=real(WaveFunction_instance(speciesID)%removedOrbitals,8), arguments= labels )
@@ -2162,7 +2163,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
vecFile = trim(CONTROL_instance%INPUT_FILE)//"subvec"
open(unit=vecUnit, file=trim(vecFile), form="unformatted", status='replace')
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
labels(1) = "COEFFICIENTS"
call Matrix_writeToFile(WaveFunction_instance(speciesID)%waveFunctionCoefficients, &
unit=vecUnit, binary=.true., arguments = labels)
@@ -2177,7 +2178,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals()
open(unit=vecUnit, file=trim(vecFile), form="formatted", status='replace')
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
labels(1) = "COEFFICIENTS"
call Matrix_writeToFile(WaveFunction_instance(speciesID)%waveFunctionCoefficients, &
unit=vecUnit, binary=.false., arguments = labels)
diff --git a/src/scf/SCF.f90 b/src/scf/SCF.f90
index 906e1e7a..187810d9 100644
--- a/src/scf/SCF.f90
+++ b/src/scf/SCF.f90
@@ -67,7 +67,7 @@ program SCF
!! Start the MultiSCF object
allocate(WaveFunction_instance(MolecularSystem_instance%numberOfQuantumSpecies))
- call MultiSCF_constructor(MultiSCF_instance,WaveFunction_instance,CONTROL_instance%ITERATION_SCHEME)
+ call MultiSCF_constructor(MultiSCF_instance,WaveFunction_instance,CONTROL_instance%ITERATION_SCHEME,molecularSystem_instance)
!! Calculate one-particle integrals
if ( CONTROL_instance%INTEGRAL_STORAGE == "DISK" ) &
@@ -87,7 +87,7 @@ program SCF
wfnFile = "lowdin.wfn"
open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted")
do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- labels(2) = MolecularSystem_getNameOfSpecie(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
labels(1) = "DENSITY"
call Matrix_writeToFile(WaveFunction_instance(speciesID)%densityMatrix, unit=wfnUnit, binary=.true., arguments = labels )
end do
diff --git a/src/scf/SingleSCF.f90 b/src/scf/SingleSCF.f90
index 6d528083..16c219fb 100644
--- a/src/scf/SingleSCF.f90
+++ b/src/scf/SingleSCF.f90
@@ -155,7 +155,7 @@ subroutine SingleSCF_iterate(wfObject)
real(8) :: hold
! wfnFile = trim(CONTROL_instance%INPUT_FILE)//"lowdin.vec"
- numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species )
+ numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species, wfObject%molSys )
!!**********************************************************************************************
@@ -281,7 +281,7 @@ subroutine SingleSCF_reset(wfObject)
call Convergence_destructor(wfObject%convergenceMethod)
call Convergence_constructor(wfObject%convergenceMethod, &
- wfObject%name,CONTROL_instance%CONVERGENCE_METHOD)
+ wfObject%name,CONTROL_instance%CONVERGENCE_METHOD,wfObject%molSys)
call Convergence_reset()
@@ -300,7 +300,7 @@ end subroutine SingleSCF_reset
! wfObject%name = "E-"
! if ( present(wfObject%name ) ) wfObject%name= trim(wfObject%name )
- ! wfObject%species = MolecularSystem_getSpecieID(wfObject%name=trim(wfObject%name ) )
+ ! wfObject%species = MolecularSystem_getSpecieID(wfObject%name=trim(wfObject%name,wfObject%molSys ) )
! !! Determina la desviacion estandar de los elementos de la matriz de densidad
! call Matrix_copyConstructor(wfObject%beforeDensityMatrix, wfObject%densityMatrix )
@@ -365,7 +365,7 @@ subroutine SingleSCF_orbitalExchange(wfObject,previousWavefunctionCoefficients)
!When the user explicitly requires EXCHANGE_ORBITALS_IN_SCF to have a solution with max overlap to the guess function
!Or when an orbital is selected for partial ionization
if(CONTROL_instance%EXCHANGE_ORBITALS_IN_SCF) then
- activeOrbitals = MolecularSystem_getOcupationNumber(wfObject%species)
+ activeOrbitals = MolecularSystem_getOcupationNumber(wfObject%species,wfObject%molSys)
call Vector_constructorInteger(orbitalsVector,activeOrbitals)
do i=1,activeOrbitals
orbitalsVector%values(i)=i
@@ -388,7 +388,7 @@ subroutine SingleSCF_orbitalExchange(wfObject,previousWavefunctionCoefficients)
call Matrix_copyConstructor(auxOverlapMatrix,wfObject%overlapMatrix)
- numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species )
+ numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species,wfObject%molSys)
call Matrix_constructor (matchingMatrix, int(activeOrbitals,8), int(activeOrbitals,8))
@@ -499,21 +499,21 @@ subroutine SingleSCF_readFrozenOrbitals(wfObject)
integer :: wfnUnit
wfnUnit = 30
- numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species )
+ numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species,wfObject%molSys)
!! NO SCF cicle for electrons or non-electrons
- if ( CONTROL_instance%FREEZE_ELECTRONIC_ORBITALS .and. .not. MolecularSystem_instance%species(wfObject%species)%isElectron) return
- if ( CONTROL_instance%FREEZE_NON_ELECTRONIC_ORBITALS .and. MolecularSystem_instance%species(wfObject%species)%isElectron ) return
+ if ( CONTROL_instance%FREEZE_ELECTRONIC_ORBITALS .and. .not. wfObject%molSys%species(wfObject%species)%isElectron) return
+ if ( CONTROL_instance%FREEZE_NON_ELECTRONIC_ORBITALS .and. wfObject%molSys%species(wfObject%species)%isElectron ) return
!! Read coefficients from various possible files
if (CONTROL_instance%READ_FCHK) then
call Matrix_constructor (auxiliaryMatrix, numberOfContractions, numberOfContractions)
- call MolecularSystem_readFchk( trim(CONTROL_instance%INPUT_FILE)//trim(wfObject%name)//".fchk", &
+ call MolecularSystem_readFchk( trim(CONTROL_instance%INPUT_FILE)//trim(wfObject%molSys%species(wfObject%species)%symbol)//".fchk", &
wfObject%waveFunctionCoefficients, auxiliaryMatrix, wfObject%name )
call Matrix_destructor(auxiliaryMatrix)
else if (CONTROL_instance%READ_COEFFICIENTS) then
- arguments(2) = MolecularSystem_getNameOfSpecie(wfObject%species)
+ arguments(2) = MolecularSystem_getNameOfSpecies(wfObject%species,wfObject%molSys)
arguments(1) = "COEFFICIENTS"
wfnFile=trim(CONTROL_instance%INPUT_FILE)//"plainvec"
diff --git a/src/scf/WaveFunction.f90 b/src/scf/WaveFunction.f90
index 6f04e641..117ad0a0 100644
--- a/src/scf/WaveFunction.f90
+++ b/src/scf/WaveFunction.f90
@@ -28,6 +28,7 @@ module WaveFunction_
use CosmoCore_
use DirectIntegralManager_
use DensityFunctionalTheory_
+ use Libint2Interface_
implicit none
@@ -47,6 +48,7 @@ module WaveFunction_
!!Identity
character(30) :: name
integer :: species
+ type(MolecularSystem), pointer :: molSys
!!**************************************************************
!! Matrices requeridas y alteradas en la realizacion del ciclo SCF
@@ -76,6 +78,7 @@ module WaveFunction_
type(Matrix) :: cosmo4
type(Matrix) :: cosmoCoupling
type(Matrix) :: electricField(3)
+ type(Matrix) :: harmonic
real(8) :: cosmoCharge
real(8) :: cosmoChargeValue
@@ -120,35 +123,36 @@ module WaveFunction_
!>
!! @brief Define el constructor para la clase
- subroutine WaveFunction_constructor(these )
+ subroutine WaveFunction_constructor(these,nspecies,molsystem)
implicit none
- type(WaveFunction) :: these(*)
+ type(WaveFunction) :: these(nspecies)
+ integer :: nspecies
+ type(MolecularSystem), optional, target :: molsystem
integer :: speciesID, otherSpeciesID
integer(8) :: numberOfContractions, otherNumberOfContractions
- character(50) :: labels(2)
- character(50) :: dftFile
- integer :: dftUnit
-
+
!! Allocate memory for specie in system and load some matrices.
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, nspecies
+ if( present(molsystem) ) then
+ these(speciesID)%molSys=>molsystem
+ else
+ these(speciesID)%molSys=>MolecularSystem_instance
+ end if
these(speciesID)%species=speciesID
- these(speciesID)%name=trim(MolecularSystem_getNameOfSpecies(speciesID))
+ these(speciesID)%name=trim(MolecularSystem_getNameOfSpecies(speciesID,these(speciesID)%molSys))
-
- labels = ""
- labels(2) = trim(MolecularSystem_getNameOfSpecies(speciesID))
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,these(speciesID)%molSys)
if(allocated(these(speciesID)%hartreeMatrix)) deallocate(these(speciesID)%hartreeMatrix)
if(allocated(these(speciesID)%hartreeEnergy)) deallocate(these(speciesID)%hartreeEnergy)
if(allocated(these(speciesID)%exchangeCorrelationEnergy)) deallocate(these(speciesID)%exchangeCorrelationEnergy)
- allocate(these(speciesID)%hartreeMatrix( MolecularSystem_instance%numberOfQuantumSpecies))
- allocate(these(speciesID)%hartreeEnergy( MolecularSystem_instance%numberOfQuantumSpecies))
- allocate(these(speciesID)%exchangeCorrelationEnergy( MolecularSystem_instance%numberOfQuantumSpecies))
+ allocate(these(speciesID)%hartreeMatrix( nspecies))
+ allocate(these(speciesID)%hartreeEnergy( nspecies))
+ allocate(these(speciesID)%exchangeCorrelationEnergy( nspecies))
!! Parametros Asociados con el SCF
@@ -158,7 +162,7 @@ subroutine WaveFunction_constructor(these )
!! Instancia un objeto para manejo de aceleracion y convergencia del metodo SCF
call Convergence_constructor(these( speciesID )%convergenceMethod, &
- these(speciesID)%name,CONTROL_instance%CONVERGENCE_METHOD)
+ these(speciesID)%name,CONTROL_instance%CONVERGENCE_METHOD,these(speciesID)%molSys)
!! Set defaults
these(speciesID)%totalEnergyForSpecies = 0.0_8
@@ -188,7 +192,7 @@ subroutine WaveFunction_constructor(these )
call Matrix_constructor( these(speciesID)%couplingMatrix, numberOfContractions, numberOfContractions, 0.0_8 )
call Matrix_constructor( these(speciesID)%externalPotentialMatrix, numberOfContractions, numberOfContractions, 0.0_8 )
- do otherSpeciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do otherSpeciesID = 1, nspecies
call Matrix_constructor( these(speciesID)%hartreeMatrix(otherSpeciesID), numberOfContractions, numberOfContractions, 0.0_8 )
end do
@@ -211,35 +215,18 @@ subroutine WaveFunction_constructor(these )
if (CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then
if(allocated(these(speciesID)%fourCenterIntegrals)) deallocate(these(speciesID)%fourCenterIntegrals)
- allocate(these(speciesID)%fourCenterIntegrals(MolecularSystem_instance%numberOfQuantumSpecies))
+ allocate(these(speciesID)%fourCenterIntegrals(nspecies))
!its not necessary to allocate all the species
- do otherSpeciesID=speciesID, MolecularSystem_instance%numberOfQuantumSpecies
- otherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID)
+ do otherSpeciesID=speciesID, nspecies
+ otherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,these(speciesID)%molSys)
call Matrix_fourIndexConstructor(these(speciesID)%fourCenterIntegrals(otherSpeciesID),&
otherNumberOfContractions,otherNumberOfContractions,numberOfContractions,numberOfContractions,0.0_8)
end do
end if
end do
-
- !!Initialize DFT: Calculate Grids and build functionals
- if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then
- if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then
- call system ("lowdin-DFT.x BUILD_SCF_GRID")
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
- dftUnit = 77
- dftFile = "lowdin."//trim(MolecularSystem_getNameOfSpecies(speciesID))//".grid"
- open(unit = dftUnit, file=trim(dftFile), status="old", form="unformatted")
-
- labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
- labels(1) = "EXACT-EXCHANGE-FRACTION"
-
- call Vector_getFromFile(unit=dftUnit, binary=.true., value=these(speciesID)%exactExchangeFraction, arguments=labels)
- close(unit=dftUnit)
- ! print *, "el tormento tuyo", speciesID, these(speciesID)%exactExchangeFraction
- end do
- else
- call DensityFunctionalTheory_buildSCFGrid(these(1:MolecularSystem_instance%numberOfQuantumSpecies)%exactExchangeFraction)
- end if
+
+ if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then
+ write (*,"(T2,A15,3F12.8)") "ELECTRIC FIELD:", CONTROL_instance%ELECTRIC_FIELD
end if
end subroutine WaveFunction_constructor
@@ -256,19 +243,19 @@ subroutine WaveFunction_readOverlapMatrix(this, file)
character(10) :: arguments(2)
arguments(1) = "OVERLAP"
- arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
!! Open file
unit = 34
open(unit = unit, file=trim(file), status="old", form="unformatted")
!! Get number of shells and number of cartesian contractions
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
this%overlapMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, columns=totalNumberOfContractions, &
unit=unit, binary=.true., arguments=arguments)
close(34)
!! DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
- print *,"Matriz de overlap: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ print *,"Matriz de overlap: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
call Matrix_show(this%overlapMatrix)
end if
end subroutine WaveFunction_readOverlapMatrix
@@ -285,19 +272,19 @@ subroutine WaveFunction_readKineticMatrix(this, file)
character(10) :: arguments(2)
arguments(1) = "KINETIC"
- arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
!! Open file
unit = 34
open(unit = unit, file=trim(file), status="old", form="unformatted")
!! Get number of shells and number of cartesian contractions
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
this%kineticMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, columns=totalNumberOfContractions, &
unit=unit, binary=.true., arguments=arguments)
close(34)
!! DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
- print *,"Matriz de kinetic: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ print *,"Matriz de kinetic: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
call Matrix_show(this%kineticMatrix)
end if
end subroutine WaveFunction_readKineticMatrix
@@ -314,19 +301,19 @@ subroutine WaveFunction_readPuntualInteractionMatrix(this, file)
character(10) :: arguments(2)
arguments(1) = "ATTRACTION"
- arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
!! Open file
unit = 34
open(unit = unit, file=trim(file), status="old", form="unformatted")
!! Get number of shells and number of cartesian contractions
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
this%puntualInteractionMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, columns=totalNumberOfContractions, &
unit=unit, binary=.true., arguments=arguments)
close(34)
!! DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
- print *,"Matriz de puntual interaction: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ print *,"Matriz de puntual interaction: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
call Matrix_show(this%puntualInteractionMatrix)
end if
end subroutine WaveFunction_readPuntualInteractionMatrix
@@ -342,13 +329,12 @@ subroutine WaveFunction_readElectricFieldMatrices(this, file)
integer :: totalNumberOfContractions
character(10) :: arguments(2)
- arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
!! Open file
unit = 34
open(unit = unit, file=trim(file), status="old", form="unformatted")
!! Get number of shells and number of cartesian contractions
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
- write (*,"(T2,A15,3F12.8)") "ELECTRIC FIELD:", CONTROL_instance%ELECTRIC_FIELD
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
arguments(1) = "MOMENTX"
this%electricField(1) = Matrix_getFromFile(rows=totalNumberOfContractions, &
columns=totalNumberOfContractions, &
@@ -365,7 +351,7 @@ subroutine WaveFunction_readElectricFieldMatrices(this, file)
!! DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
- print *,"Matrices de electric field: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ print *,"External electric field Matrix: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
call Matrix_show(this%electricField(1))
call Matrix_show(this%electricField(2))
call Matrix_show(this%electricField(3))
@@ -373,6 +359,36 @@ subroutine WaveFunction_readElectricFieldMatrices(this, file)
end subroutine WaveFunction_readElectricFieldMatrices
!>
+ !! @brief Lee la matrix de interaccion con cargas puntuales.
+ subroutine WaveFunction_readHarmonicOscillatorMatrix( this, file)
+ implicit none
+ type(WaveFunction) :: this
+ character(*), intent(in) :: file
+
+ integer :: unit
+ integer :: totalNumberOfContractions
+ character(10) :: arguments(2)
+
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
+ !! Open file
+ unit = 34
+ open(unit = unit, file=trim(file), status="old", form="unformatted")
+ !! Get number of shells and number of cartesian contractions
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
+ arguments(1) = "HARMONIC"
+ this%harmonic = Matrix_getFromFile(rows=totalNumberOfContractions, &
+ columns=totalNumberOfContractions, &
+ unit=unit, binary=.true., arguments=arguments)
+ close(34)
+
+ !! DEBUG
+ if ( CONTROL_instance%DEBUG_SCFS) then
+ print *,"Harmonic oscillator Matrix: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
+ call Matrix_show(this%harmonic )
+ end if
+
+ end subroutine WaveFunction_readHarmonicOscillatorMatrix
+
!! @brief Contruye la matrix de de transformacion.
!! @param nameOfSpecie nombre de la especie seleccionada.
subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization )
@@ -386,7 +402,7 @@ subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization
integer :: i, j
!! Numero de contracciones "totales"
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
if ( numberOfContractions > 1) then
call Vector_constructor( eigenValues, int(numberOfContractions) )
@@ -414,7 +430,7 @@ subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization
end do
if (this%removedOrbitals .gt. 0 .and. CONTROL_instance%PRINT_LEVEL .gt. 0) &
write(*,"(A,I5,A,A,A,ES9.3)") "Removed ", this%removedOrbitals , " orbitals for species ", &
- trim(MolecularSystem_getNameOfSpecies(this%species)), " with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD
+ trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)), " with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD
!!
!!****************************************************************
@@ -444,7 +460,7 @@ subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization
!! DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
- print *,"Matriz de transformation: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ print *,"Matriz de transformation: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
call Matrix_show(this%transformationMatrix)
end if
@@ -461,48 +477,43 @@ subroutine WaveFunction_buildHCoreMatrix(this)
integer :: numberOfCartesiansOrbitals, numberOfCartesiansOrbitals_2
integer :: owner, owner_2
real(8) :: auxCharge
- integer :: numberOfContractions
- integer :: totalNumberOfContractions
-
- !! Get number of shells and number of cartesian contractions
- numberOfContractions = MolecularSystem_getNumberOfContractions(this%species)
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ real(8) :: auxOmega
!! Incluiding mass effect
if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then
this%kineticMatrix%values = &
this%kineticMatrix%values * &
- ( 1.0_8/MolecularSystem_getMass(this%species) -1.0_8 / MolecularSystem_getTotalMass() )
+ ( 1.0_8/MolecularSystem_getMass(this%species,this%molSys) -1.0_8 / MolecularSystem_getTotalMass(this%molSys) )
else
this%kineticMatrix%values = &
this%kineticMatrix%values / &
- MolecularSystem_getMass(this%species)
+ MolecularSystem_getMass(this%species,this%molSys)
end if
!! Finite Nuclear Mass Correction
if ( CONTROL_instance%FINITE_MASS_CORRECTION ) then
k=1
- do particleID = 1, size(MolecularSystem_instance%species(this%species)%particles)
- do contractionID = 1, size(MolecularSystem_instance%species(this%species)%particles(particleID)%basis%contraction)
+ do particleID = 1, size(this%molSys%species(this%species)%particles)
+ do contractionID = 1, size(this%molSys%species(this%species)%particles(particleID)%basis%contraction)
- numberOfCartesiansOrbitals = MolecularSystem_instance%species(this%species)%particles(particleID)%basis%contraction(contractionID)%numCartesianOrbital
- owner = MolecularSystem_instance%species(this%species)%particles(particleID)%basis%contraction(contractionID)%owner
+ numberOfCartesiansOrbitals = this%molSys%species(this%species)%particles(particleID)%basis%contraction(contractionID)%numCartesianOrbital
+ owner = this%molSys%species(this%species)%particles(particleID)%basis%contraction(contractionID)%owner
do s = 1, numberOfCartesiansOrbitals
l=k
- do particleID_2 = 1, size(MolecularSystem_instance%species(this%species)%particles)
- do contractionID_2 = 1, size(MolecularSystem_instance%species(this%species)%particles(particleID_2)%basis%contraction)
+ do particleID_2 = 1, size(this%molSys%species(this%species)%particles)
+ do contractionID_2 = 1, size(this%molSys%species(this%species)%particles(particleID_2)%basis%contraction)
- numberOfCartesiansOrbitals_2 = MolecularSystem_instance%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%numCartesianOrbital
- owner_2 = MolecularSystem_instance%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%owner
+ numberOfCartesiansOrbitals_2 = this%molSys%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%numCartesianOrbital
+ owner_2 = this%molSys%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%owner
do r = 1, numberOfCartesiansOrbitals_2
if ( owner .eq. owner_2) then
this%kineticMatrix%values(k,l)=&
this%kineticMatrix%values(k,l)*&
- ( 1 + MolecularSystem_getMass(this%species) / MolecularSystem_instance%species(this%species)%particles(particleID)%mass )
+ ( 1 + MolecularSystem_getMass(this%species,this%molSys) / this%molSys%species(this%species)%particles(particleID)%mass )
this%kineticMatrix%values(l,k)=&
this%kineticMatrix%values(k,l)
@@ -519,7 +530,7 @@ subroutine WaveFunction_buildHCoreMatrix(this)
end if
!! Incluiding charge effect
- auxcharge = MolecularSystem_getCharge(this%species)
+ auxcharge = MolecularSystem_getCharge(this%species,this%molSys)
this%puntualInteractionMatrix%values = &
this%puntualInteractionMatrix%values * (-auxCharge)
@@ -540,9 +551,19 @@ subroutine WaveFunction_buildHCoreMatrix(this)
CONTROL_instance%ELECTRIC_FIELD(3)*this%electricField(3)%values )
end if
+
+ !! Add harmonic oscillator potential 1/2 m omega**2 < \mu | r**2 | \nu >
+ auxOmega = MolecularSystem_getOmega(this%species,this%molSys)
+
+ if ( auxOmega .ne. 0.0_8 ) then
+ this%HCoreMatrix%values = this%HCoreMatrix%values + &
+ (1.0/2.0) * MolecularSystem_getMass(this%species,this%molSys) * auxOmega**2 * this%harmonic%values
+ end if
+
+
!! DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
- print *,"Matriz de hcore: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ print *,"Matriz de hcore: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
call Matrix_show(this%HCoreMatrix)
end if
@@ -558,7 +579,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this)
integer :: otherSpeciesID
real(8) :: auxCharge
- auxcharge = MolecularSystem_getCharge(this%species)
+ auxcharge = MolecularSystem_getCharge(this%species,this%molSys)
!! Remove the electric field matrix to calculate the energy components
if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then
@@ -613,7 +634,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this)
this%externalPotentialMatrix%values))
!! Calcula energia de acoplamiento por especies
- do otherSpeciesID=1, MolecularSystem_instance%numberOfQuantumSpecies
+ do otherSpeciesID=1, this%molSys%numberOfQuantumSpecies
if (this%species .ne. otherSpeciesID) then
this%hartreeEnergy( otherSpeciesID ) = &
sum( transpose( this%densityMatrix%values ) * &
@@ -639,7 +660,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this)
write(*,*)"COSMO energy contributions"
- write(*,*)"Especie = ",trim(MolecularSystem_instance%species(this%species)%name)
+ write(*,*)"Especie = ",trim(this%molSys%species(this%species)%name)
this%cosmoEnergy = &
0.5_8* (sum( transpose( this%densitymatrix%values ) * &
@@ -674,7 +695,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this)
! print *, "__________________ ENERGY COMPONENTS _______________________"
- ! print *, " Specie ", MolecularSystem_getNameOfSpecies(this%species)
+ ! print *, " Specie ", MolecularSystem_getNameOfSpecies(this%species,this%molSys)
! print *, " Total Energy =", this%totalEnergyForSpecies
! print *, " Indepent Specie Energy =", this%independentSpeciesEnergy
! print *, " Kinetic Energy =",this%kineticEnergy
@@ -700,7 +721,6 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file)
! integer :: numberOfCartesiansOrbitals, numberOfCartesiansOrbitals_2
! integer :: owner, owner_2
! integer :: auxCharge
- integer :: numberOfContractions
integer :: totalNumberOfContractions
character(10) :: arguments(2)
@@ -708,12 +728,11 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file)
unit = 44
open(unit = unit, file=trim(file), status="old", form="unformatted")
- arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
!! Get number of shells and number of cartesian contractions
- numberOfContractions = MolecularSystem_getNumberOfContractions(this%species)
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
!! Load electron potential vs clasical charges cosmo matrix
@@ -724,7 +743,7 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file)
! DEBUG
- ! print *,"Matriz cosmo1: ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ ! print *,"Matriz cosmo1: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
! call Matrix_show( this%cosmo1 )
!! Load clasical potential vs quantum charges cosmo matrix
@@ -736,7 +755,7 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file)
!! DEBUG
- ! print *,"Matriz cosmo 4 ", trim(MolecularSystem_getNameOfSpecies(this%species))
+ ! print *,"Matriz cosmo 4 ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
! call Matrix_show( this%cosmo4 )
close(44)
@@ -758,12 +777,12 @@ subroutine WaveFunction_readExternalPotentialMatrix(this, file)
character(50) :: arguments(2)
arguments(1) = "EXTERNAL_POTENTIAL"
- arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species))
+ arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys))
!! Open file
unit = 34
open(unit = unit, file=trim(file), status="old", form="unformatted")
!! Get number of shells and number of cartesian contractions
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
this%externalPotentialMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, &
columns=totalNumberOfContractions, &
unit=unit, binary=.true., arguments=arguments(1:2))
@@ -795,13 +814,14 @@ end subroutine WaveFunction_readExternalPotentialMatrix
!>
!! @brief Builds two-particles matrix.
- subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN, twoParticlesMatrixOUT )
+ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN, twoParticlesMatrixOUT, Libint2Objects )
implicit none
type(WaveFunction) :: this
type(Matrix), optional :: densityMatrixIN
real(8), optional :: factorIN
type(Matrix), optional :: twoParticlesMatrixOUT
-
+ type(Libint2Interface), optional :: Libint2Objects(:)
+
real(8) :: coulomb
real(8) :: exchange
real(8) :: factor
@@ -825,8 +845,8 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN
integer :: nthreads
integer :: threadid
integer :: unitid
-
- totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
+
+ totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
call Matrix_constructor(densityMatrix, int(totalNumberOfContractions,8), int(totalNumberOfContractions,8), 0.0_8 )
if ( present(densityMatrixIN)) then
@@ -836,15 +856,15 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN
end if
if ( present(factorIN)) then
- factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species)*factorIN
+ factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species,this%molSys)*factorIN
else
- factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species)*this%exactExchangeFraction
+ factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species,this%molSys)*this%exactExchangeFraction
end if
call Matrix_constructor(twoParticlesMatrix, int(totalNumberOfContractions,8), int(totalNumberOfContractions,8), 0.0_8 )
!! This matrix is only calculated if there are more than one particle for this%species or if the user want to calculate it.
- if ( MolecularSystem_getNumberOfParticles(this%species) > 1 .or. CONTROL_instance%BUILD_TWO_PARTICLES_MATRIX_FOR_ONE_PARTICLE ) then
+ if ( MolecularSystem_getNumberOfParticles(this%species,this%molSys) > 1 .or. CONTROL_instance%BUILD_TWO_PARTICLES_MATRIX_FOR_ONE_PARTICLE ) then
if ( CONTROL_instance%INTEGRAL_STORAGE == "DISK" ) then
@@ -856,7 +876,7 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN
write(fileid,*) threadid
fileid = trim(adjustl(fileid))
- if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(this%species)%isElectron) then
+ if(CONTROL_instance%IS_OPEN_SHELL .and. this%molSys%species(this%species)%isElectron) then
open( UNIT=unitid,FILE=trim(fileid)//"E-ALPHA.ints", status='old', access='stream', form='Unformatted')
else
open( UNIT=unitid,FILE=trim(fileid)//trim(this%name)//".ints", status='old', access='stream', form='Unformatted')
@@ -1026,7 +1046,7 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN
end do
if ( .not. InterPotential_instance%isInstanced) &
- twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(speciesID=this%species))**2.0_8
+ twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(this%species,this%molSys))**2.0_8
else if ( CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then
@@ -1070,27 +1090,52 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN
end do
end do
if ( .not. InterPotential_instance%isInstanced) &
- twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(speciesID=this%species))**2.0_8
+ twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(this%species,this%molSys))**2.0_8
else !! Direct
if ( .not. InterPotential_instance%isInstanced) then !!regular integrals
- call DirectIntegralManager_getDirectIntraRepulsionMatrix(&
- this%species, &
- trim(CONTROL_instance%INTEGRAL_SCHEME), &
- densityMatrix, &
- tmpTwoParticlesMatrix, &
- factor)
+ if( present(Libint2Objects) ) then
+ call DirectIntegralManager_getDirectIntraRepulsionMatrix(&
+ this%species, &
+ trim(CONTROL_instance%INTEGRAL_SCHEME), &
+ densityMatrix, &
+ tmpTwoParticlesMatrix, &
+ factor, &
+ this%molSys, &
+ Libint2Objects(:))
+ else
+ call DirectIntegralManager_getDirectIntraRepulsionMatrix(&
+ this%species, &
+ trim(CONTROL_instance%INTEGRAL_SCHEME), &
+ densityMatrix, &
+ tmpTwoParticlesMatrix, &
+ factor, &
+ this%molSys, &
+ Libint2Instance)
+ end if
tmpTwoParticlesMatrix = &
- tmpTwoParticlesMatrix * ( MolecularSystem_getCharge(speciesID=this%species ) )**2.0_8
+ tmpTwoParticlesMatrix * ( MolecularSystem_getCharge(this%species,this%molSys) )**2.0_8
else !! G12 integrals
- call DirectIntegralManager_getDirectIntraRepulsionG12Matrix(&
- this%species, &
- densityMatrix, &
- tmpTwoParticlesMatrix, &
- factor)
+ if( present(Libint2Objects) ) then
+ call DirectIntegralManager_getDirectIntraRepulsionG12Matrix(&
+ this%species, &
+ densityMatrix, &
+ tmpTwoParticlesMatrix, &
+ factor,&
+ this%molSys, &
+ Libint2Objects(:))
+ else
+ call DirectIntegralManager_getDirectIntraRepulsionG12Matrix(&
+ this%species, &
+ densityMatrix, &
+ tmpTwoParticlesMatrix, &
+ factor,&
+ this%molSys, &
+ Libint2Instance)
+ end if
end if
twoParticlesMatrix%values = tmpTwoParticlesMatrix
@@ -1115,13 +1160,14 @@ end subroutine WaveFunction_buildTwoParticlesMatrix
!>
!! @brief Builds the coupling matrix for the selected speciesID.
- subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN, couplingMatrixOUT, hartreeMatricesOUT )
+ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN, couplingMatrixOUT, hartreeMatricesOUT, Libint2Objects)
implicit none
type(WaveFunction) :: these(*)
integer :: speciesID
type(Matrix), optional :: densityMatricesIN(*)
type(Matrix), optional :: couplingMatrixOUT
type(Matrix), optional :: hartreeMatricesOUT(*)
+ type(Libint2Interface), optional :: Libint2Objects(:)
character(30) :: nameOfSpecies
character(30) :: nameOfOtherSpecies
@@ -1153,8 +1199,8 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
nameOfSpecies=these(speciesID)%name
- numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies()
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID)
+ numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,these(1)%molSys)
allocate(densityMatrices(numberOfSpecies))
allocate(hartreeMatrices(numberOfSpecies))
@@ -1192,8 +1238,8 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
do otherSpeciesID = 1, numberOfSpecies
- nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID )
- OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID)
+ nameOfOtherSpecies = MolecularSystem_getNameOfSpecies(otherSpeciesID,these(otherSpeciesID)%molSys)
+ OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,these(otherSpeciesID)%molSys)
!! Restringe suma de terminos repulsivos de la misma especie.
if ( otherSpeciesID .eq. speciesID ) cycle
@@ -1206,14 +1252,14 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
!! open file for integrals
if(CONTROL_instance%IS_OPEN_SHELL .and. &
- MolecularSystem_instance%species(speciesID)%isElectron .and. &
- MolecularSystem_instance%species(otherSpeciesID)%isElectron ) then
+ these(speciesID)%molSys%species(speciesID)%isElectron .and. &
+ these(speciesID)%molSys%species(otherSpeciesID)%isElectron ) then
open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA.E-BETA.ints", &
STATUS='OLD', ACCESS='stream', FORM='Unformatted')
- else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(otherSpeciesID)%isElectron) then
+ else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(otherSpeciesID)%isElectron) then
open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA."//trim(nameOfSpecies)//".ints", &
STATUS='OLD', ACCESS='stream', FORM='Unformatted')
- else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(speciesID)%isElectron) then
+ else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(speciesID)%isElectron) then
open(UNIT=unitid,FILE=trim(fileid)//trim(nameOfOtherSpecies)//".E-ALPHA.ints", &
STATUS='OLD', ACCESS='stream', FORM='Unformatted')
else
@@ -1250,7 +1296,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
close(unitid)
if ( .not. InterPotential_instance%isInstanced) &
- auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID ) * MolecularSystem_getCharge( otherSpeciesID )
+ auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID,these(speciesID)%molSys ) * MolecularSystem_getCharge( otherSpeciesID,these(otherSpeciesID)%molSys )
do i = 1 , numberOfContractions
do j = i , numberOfContractions
@@ -1266,14 +1312,14 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
!! open file for integrals
if(CONTROL_instance%IS_OPEN_SHELL .and. &
- MolecularSystem_instance%species(speciesID)%isElectron .and. &
- MolecularSystem_instance%species(otherSpeciesID)%isElectron ) then
+ these(speciesID)%molSys%species(speciesID)%isElectron .and. &
+ these(speciesID)%molSys%species(otherSpeciesID)%isElectron ) then
open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA.E-BETA.ints", &
STATUS='OLD', ACCESS='stream', FORM='Unformatted')
- else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(otherSpeciesID)%isElectron) then
+ else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(otherSpeciesID)%isElectron) then
open(UNIT=unitid,FILE=trim(fileid)//trim(nameOfSpecies)//".E-ALPHA.ints", &
STATUS='OLD', ACCESS='stream', FORM='Unformatted')
- else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(speciesID)%isElectron) then
+ else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(speciesID)%isElectron) then
open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA."//trim(nameOfOtherSpecies)//".ints", &
STATUS='OLD', ACCESS='stream', FORM='Unformatted')
else
@@ -1310,7 +1356,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
close(unitid)
if ( .not. InterPotential_instance%isInstanced) &
- auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID ) * MolecularSystem_getCharge( otherSpeciesID )
+ auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID,these(speciesID)%molSys ) * MolecularSystem_getCharge( otherSpeciesID,these(otherSpeciesID)%molSys )
do i = 1 , numberOfContractions
do j = i , numberOfContractions
@@ -1331,7 +1377,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
else if ( CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then
do otherSpeciesID = 1, numberOfSpecies
if ( otherSpeciesID .eq. speciesID ) cycle
- OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID)
+ OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,these(otherSpeciesID)%molSys)
!integral storage order
if( speciesID < otherSpeciesID) then
do v = 1 , numberOfContractions
@@ -1378,7 +1424,8 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
end do
end do
if ( .not. InterPotential_instance%isInstanced) &
- hartreeMatrices(otherSpeciesID)%values=hartreeMatrices(otherSpeciesID)%values*MolecularSystem_getCharge(speciesID)*MolecularSystem_getCharge(otherSpeciesID)
+ hartreeMatrices(otherSpeciesID)%values=hartreeMatrices(otherSpeciesID)%values*&
+ MolecularSystem_getCharge(speciesID,these(speciesID)%molSys)*MolecularSystem_getCharge(otherSpeciesID,these(otherSpeciesID)%molSys)
end do
@@ -1390,19 +1437,42 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
if ( otherSpeciesID .eq. speciesID ) cycle
if ( .not. InterPotential_instance%isInstanced) then !!regular integrals
- call DirectIntegralManager_getDirectInterRepulsionMatrix(&
- speciesID, OtherSpeciesID, &
- trim(CONTROL_instance%INTEGRAL_SCHEME), &
- densityMatrices(otherSpeciesID), &
- auxMatrix )
+ if(present(Libint2Objects)) then
+ call DirectIntegralManager_getDirectInterRepulsionMatrix(&
+ speciesID, OtherSpeciesID, &
+ trim(CONTROL_instance%INTEGRAL_SCHEME), &
+ densityMatrices(otherSpeciesID), &
+ auxMatrix, &
+ these(speciesID)%molSys, &
+ Libint2Objects(:))
+ else
+ call DirectIntegralManager_getDirectInterRepulsionMatrix(&
+ speciesID, OtherSpeciesID, &
+ trim(CONTROL_instance%INTEGRAL_SCHEME), &
+ densityMatrices(otherSpeciesID), &
+ auxMatrix, &
+ these(speciesID)%molSys, &
+ Libint2Instance)
+ end if
auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID ) * MolecularSystem_getCharge( otherSpeciesID )
else !! G12 integrals
- call DirectIntegralManager_getDirectInterRepulsionG12Matrix(&
- speciesID, OtherSpeciesID, &
- densityMatrices(otherSpeciesID), &
- auxMatrix )
+ if(present(Libint2Objects)) then
+ call DirectIntegralManager_getDirectInterRepulsionG12Matrix(&
+ speciesID, OtherSpeciesID, &
+ densityMatrices(otherSpeciesID), &
+ auxMatrix, &
+ these(speciesID)%molSys, &
+ Libint2Objects(:))
+ else
+ call DirectIntegralManager_getDirectInterRepulsionG12Matrix(&
+ speciesID, OtherSpeciesID, &
+ densityMatrices(otherSpeciesID), &
+ auxMatrix, &
+ these(speciesID)%molSys, &
+ Libint2Instance)
+ end if
end if
hartreeMatrices(otherSpeciesID)%values = &
@@ -1427,7 +1497,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
end do
end do
- nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID )
+ nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,these(otherSpeciesID)%molSys )
if ( nameOfOtherSpecies .ne. CONTROL_instance%SCF_GHOST_SPECIES ) &
couplingMatrix%values = couplingMatrix%values + hartreeMatrices(otherSpeciesID)%values
@@ -1454,7 +1524,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN
if ( CONTROL_instance%DEBUG_SCFS) then
do otherSpeciesID = 1, numberOfSpecies
if ( otherSpeciesID .eq. speciesID ) cycle
- nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID )
+ nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,these(otherSpeciesID)%molSys )
write(*,*) "Hartree Matrix for: ", trim(nameOfSpecies), trim(nameOfOtherSpecies)
call Matrix_show( these(speciesID)%hartreeMatrix(otherSpeciesID) )
end do
@@ -1487,8 +1557,8 @@ subroutine WaveFunction_readExchangeCorrelationMatrix( this, excFileIN, &
character(50) :: labels(2)
integer :: excUnit
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species)
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
allocate(exchangeCorrelationEnergy(numberOfSpecies))
!! Open file from dft and read matrices
@@ -1510,7 +1580,7 @@ subroutine WaveFunction_readExchangeCorrelationMatrix( this, excFileIN, &
binary=.true., arguments=labels(1:2))
do otherSpeciesID = this%species, numberOfSpecies
- otherNameOfSpecies=trim(MolecularSystem_getNameOfSpecies(otherSpeciesID))
+ otherNameOfSpecies=trim(MolecularSystem_getNameOfSpecies(otherSpeciesID,this%molSys))
labels(1) = "EXCHANGE-CORRELATION-ENERGY"
labels(2) = trim(this%name)//trim(otherNameOfSpecies)
call Vector_getFromFile(unit=excUnit, binary=.true., value=exchangeCorrelationEnergy(otherSpeciesID), arguments= labels )
@@ -1541,10 +1611,11 @@ end subroutine WaveFunction_readExchangeCorrelationMatrix
!>
!! @brief Builds exchange correlation contributions Matrix for DFT calculations (FELIX)
- subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, &
+ subroutine WaveFunction_getDFTContributions( these, DFTGrids, DFTGridCommonPoints, status, densityMatricesIN, &
exchangeCorrelationMatricesOUT, exchangeCorrelationEnergyOUT, particlesInGridOUT )
implicit none
type(WaveFunction) :: these(*)
+ type(Grid) :: DFTGrids(:), DFTGridCommonPoints(:,:)
character(*) :: status
type(Matrix), optional :: densityMatricesIN(*)
type(Matrix), optional :: exchangeCorrelationMatricesOUT(*)
@@ -1556,7 +1627,7 @@ subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, &
type(Matrix) :: energyMatrix
integer :: numberOfSpecies, i,j
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys)
allocate(densityMatrices(numberOfSpecies), exchangeCorrelationMatrices(numberOfSpecies), particlesInGrid(numberOfSpecies))
if ( present(densityMatricesIN)) then
@@ -1572,7 +1643,7 @@ subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, &
call Matrix_constructor(energyMatrix, int(numberOfSpecies,8), int(numberOfSpecies,8), 0.0_8 )
if (status .eq. "SCF" ) then
- call DensityFunctionalTheory_SCFDFT(densityMatrices, &
+ call DensityFunctionalTheory_SCFDFT(DFTGrids, DFTGridCommonPoints, densityMatrices, &
exchangeCorrelationMatrices, &
energyMatrix, &
particlesInGrid)
@@ -1585,9 +1656,9 @@ subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, &
energyMatrix%values(i,j)=these(i)%exchangeCorrelationEnergy(j)
end do
end do
- call DensityFunctionalTheory_buildFinalGrid()
+ call DensityFunctionalTheory_buildFinalGrid(DFTGrids, DFTGridCommonPoints, these(1)%molSys)
- call DensityFunctionalTheory_finalDFT(densityMatrices, &
+ call DensityFunctionalTheory_finalDFT(DFTGrids, DFTGridCommonPoints,densityMatrices, &
exchangeCorrelationMatrices, &
energyMatrix, &
particlesInGrid)
@@ -1666,7 +1737,7 @@ subroutine WaveFunction_writeDensityMatricesToFile( these, densityFileOUT, densi
integer :: densUnit
character(50) :: labels(2)
- numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies()
+ numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys)
allocate(densityMatrices(numberOfSpecies))
densUnit = 78
@@ -1682,7 +1753,7 @@ subroutine WaveFunction_writeDensityMatricesToFile( these, densityFileOUT, densi
open(unit = densUnit, file=trim(densityFileOUT), status="replace", form="unformatted")
labels(1) = "DENSITY-MATRIX"
do speciesID = 1, numberOfSpecies
- labels(2) = MolecularSystem_getNameOfSpecies(speciesID)
+ labels(2) = MolecularSystem_getNameOfSpecies(speciesID,these(speciesID)%molSys)
call Matrix_writeToFile(densityMatrices(speciesID), unit=densUnit, binary=.true., arguments = labels )
call Matrix_destructor(densityMatrices(speciesID))
end do
@@ -1769,7 +1840,7 @@ subroutine WaveFunction_buildDensityMatrix(this)
orderMatrix = size( this%densityMatrix%values, DIM = 1 )
- ocupationNumber = MolecularSystem_getOcupationNumber(this%species)
+ ocupationNumber = MolecularSystem_getOcupationNumber(this%species,this%molSys)
this%densityMatrix%values = 0.0_8
@@ -1796,7 +1867,7 @@ subroutine WaveFunction_buildDensityMatrix(this)
end do
end do
- this%densityMatrix%values = MolecularSystem_getEta(this%species) * this%densityMatrix%values
+ this%densityMatrix%values = MolecularSystem_getEta(this%species,this%molSys) * this%densityMatrix%values
!!DEBUG
if ( CONTROL_instance%DEBUG_SCFS) then
@@ -1864,7 +1935,7 @@ subroutine WaveFunction_obtainTotalEnergy( these, totalEnergy, totalCouplingEner
cosmo3Energy = 0.0_8
!! Adicionado energia de interaccion entre particulas puntuales
- totalEnergy = MolecularSystem_getPointChargesEnergy()
+ totalEnergy = MolecularSystem_getPointChargesEnergy(these(1)%molSys)
!! cosmo potential nuclei-charges nuclei
if(CONTROL_instance%COSMO)then
@@ -1874,7 +1945,7 @@ subroutine WaveFunction_obtainTotalEnergy( these, totalEnergy, totalCouplingEner
totalEnergy=totalEnergy+cosmo3Energy
end if
- do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies
+ do speciesID = 1, these(1)%molSys%numberOfQuantumSpecies
!! Calula enegia de especie independiente ( sin considerar el termino de acoplamiento )
these(speciesID)%independentSpeciesEnergy = &
@@ -1912,8 +1983,8 @@ subroutine WaveFunction_obtainTotalEnergy( these, totalEnergy, totalCouplingEner
end do
!! Adicionar energia de acoplamiento y recalcula matrices de acoplamiento, including E-ALPHA/E-BETA
- do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies()
- do otherSpeciesID = speciesID+1, MolecularSystem_getNumberOfQuantumSpecies()
+ do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys)
+ do otherSpeciesID = speciesID+1, MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys)
totalCouplingEnergy = totalCouplingEnergy + (sum( transpose(these(speciesID)%densityMatrix%values) &
* (these(speciesID)%hartreeMatrix(otherSpeciesID)%values)))
totalEnergy = totalEnergy+these(speciesID)%exchangeCorrelationEnergy(otherSpeciesID)
@@ -2174,7 +2245,7 @@ subroutine WaveFunction_buildCosmo2Matrix(this)
integer:: auxLabelsOfContractions
integer:: a, b, c
- specieSelected=MolecularSystem_instance%species(this%species)
+ specieSelected=this%molSys%species(this%species)
open(unit=110, file=trim(this%name)//"_qq.inn", status='old', form="unformatted")
read(110)m
@@ -2187,14 +2258,14 @@ subroutine WaveFunction_buildCosmo2Matrix(this)
if(allocated(labels)) deallocate(labels)
- allocate(labels(MolecularSystem_instance%species(this%species)%basisSetSize))
+ allocate(labels(this%molSys%species(this%species)%basisSetSize))
if(allocated(ints_mat_aux)) deallocate(ints_mat_aux)
- allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(this%species), MolecularSystem_getTotalNumberOfContractions(this%species)))
+ allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys), MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)))
if(allocated(cosmo2_aux)) deallocate(cosmo2_aux)
- allocate(cosmo2_aux(MolecularSystem_getTotalNumberOfContractions(this%species), MolecularSystem_getTotalNumberOfContractions(this%species)))
+ allocate(cosmo2_aux(MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys), MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys)))
auxLabelsOfContractions = 1
@@ -2220,35 +2291,35 @@ subroutine WaveFunction_buildCosmo2Matrix(this)
m = 0
ii = 0
- do g = 1, size(MolecularSystem_instance%species(this%species)%particles)
- do h = 1, size(MolecularSystem_instance%species(this%species)%particles(g)%basis%contraction)
+ do g = 1, size(this%molSys%species(this%species)%particles)
+ do h = 1, size(this%molSys%species(this%species)%particles(g)%basis%contraction)
hh = h
ii = ii + 1
jj = ii - 1
- do i = g, size(MolecularSystem_instance%species(this%species)%particles)
- do j = hh, size(MolecularSystem_instance%species(this%species)%particles(i)%basis%contraction)
+ do i = g, size(this%molSys%species(this%species)%particles)
+ do j = hh, size(this%molSys%species(this%species)%particles(i)%basis%contraction)
jj = jj + 1
!!saving integrals on Matrix
- do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(this%species)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
- do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(this%species)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
+ do k = labels(ii), labels(ii) + (this%molSys%species(this%species)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
+ do l = labels(jj), labels(jj) + (this%molSys%species(this%species)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
iii=0
- do gg = 1, size(MolecularSystem_instance%species(this%species)%particles)
- do ll = 1, size(MolecularSystem_instance%species(this%species)%particles(gg)%basis%contraction)
+ do gg = 1, size(this%molSys%species(this%species)%particles)
+ do ll = 1, size(this%molSys%species(this%species)%particles(gg)%basis%contraction)
hhh = ll
iii = iii + 1
jjj = iii - 1
- do p = gg, size(MolecularSystem_instance%species(this%species)%particles)
- do o = hhh, size(MolecularSystem_instance%species(this%species)%particles(p)%basis%contraction)
+ do p = gg, size(this%molSys%species(this%species)%particles)
+ do o = hhh, size(this%molSys%species(this%species)%particles(p)%basis%contraction)
jjj = jjj + 1
!!saving integrals on Matrix
- do pp = labels(iii), labels(iii) + (MolecularSystem_instance%species(this%species)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1)
- do oo = labels(jjj), labels(jjj) + (MolecularSystem_instance%species(this%species)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1)
+ do pp = labels(iii), labels(iii) + (this%molSys%species(this%species)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1)
+ do oo = labels(jjj), labels(jjj) + (this%molSys%species(this%species)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1)
m = m + 1
read(110)cosmo_int
@@ -2323,12 +2394,12 @@ subroutine WaveFunction_buildCosmoCoupling(this)
integer:: a, b, c
- currentSpeciesID = MolecularSystem_getSpecieID( nameOfSpecie=this%name )
- numberOfContractions = MolecularSystem_getTotalNumberOfContractions(currentSpeciesID)
- specieSelected=MolecularSystem_instance%species(currentSpeciesID)
+ currentSpeciesID = MolecularSystem_getSpecieID(this%name,this%molSys)
+ numberOfContractions = MolecularSystem_getTotalNumberOfContractions(currentSpeciesID,this%molSys)
+ specieSelected=this%molSys%species(currentSpeciesID)
if(allocated(labels)) deallocate(labels)
- allocate(labels(MolecularSystem_instance%species(currentSpeciesID)%basisSetSize))
+ allocate(labels(this%molSys%species(currentSpeciesID)%basisSetSize))
this%cosmoCoupling%values(:,:)=0.0_8
@@ -2352,16 +2423,16 @@ subroutine WaveFunction_buildCosmoCoupling(this)
end do
- if( MolecularSystem_getNumberOfQuantumSpecies() > 1 ) then
+ if( MolecularSystem_getNumberOfQuantumSpecies(this%molSys) > 1 ) then
this%cosmoCoupling%values = 0.0_8
- do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies()
+ do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys)
otherSpeciesID = speciesIterator
- nameOfOtherSpecie = MolecularSystem_getNameOfSpecies( otherSpeciesID )
- OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID)
- otherSpecieSelected=MolecularSystem_instance%species(otherSpeciesID)
+ nameOfOtherSpecie = MolecularSystem_getNameOfSpecies(otherSpeciesID,this%molSys)
+ OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,this%molSys)
+ otherSpecieSelected=this%molSys%species(otherSpeciesID)
if ( otherSpeciesID /= currentSpeciesID ) then
@@ -2378,7 +2449,7 @@ subroutine WaveFunction_buildCosmoCoupling(this)
if(allocated(otherLabels)) deallocate(otherLabels)
- allocate(otherLabels(MolecularSystem_instance%species(otherSpeciesID)%basisSetSize))
+ allocate(otherLabels(this%molSys%species(otherSpeciesID)%basisSetSize))
otherAuxLabelsOfContractions=1
@@ -2399,48 +2470,48 @@ subroutine WaveFunction_buildCosmoCoupling(this)
if(allocated(ints_mat_aux)) deallocate(ints_mat_aux)
- allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(otherSpeciesID), MolecularSystem_getTotalNumberOfContractions(otherSpeciesID)))
+ allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,this%molSys), MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,this%molSys)))
ints_mat_aux=0.0_8
if(allocated(cosmoCoup_aux)) deallocate(cosmoCoup_aux)
- allocate(cosmoCoup_aux(MolecularSystem_getTotalNumberOfContractions(currentSpeciesID), MolecularSystem_getTotalNumberOfContractions(currentSpeciesID)))
+ allocate(cosmoCoup_aux(MolecularSystem_getTotalNumberOfContractions(currentSpeciesID,this%molSys), MolecularSystem_getTotalNumberOfContractions(currentSpeciesID,this%molSys)))
m = 0
ii = 0
- do g = 1, size(MolecularSystem_instance%species(currentSpeciesID)%particles)
- do h = 1, size(MolecularSystem_instance%species(currentSpeciesID)%particles(g)%basis%contraction)
+ do g = 1, size(this%molSys%species(currentSpeciesID)%particles)
+ do h = 1, size(this%molSys%species(currentSpeciesID)%particles(g)%basis%contraction)
hh = h
ii = ii + 1
jj = ii - 1
- do i = g, size(MolecularSystem_instance%species(currentSpeciesID)%particles)
- do j = hh, size(MolecularSystem_instance%species(currentSpeciesID)%particles(i)%basis%contraction)
+ do i = g, size(this%molSys%species(currentSpeciesID)%particles)
+ do j = hh, size(this%molSys%species(currentSpeciesID)%particles(i)%basis%contraction)
jj = jj + 1
!!saving integrals on Matrix
- do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(currentSpeciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
- do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(currentSpeciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
+ do k = labels(ii), labels(ii) + (this%molSys%species(currentSpeciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
+ do l = labels(jj), labels(jj) + (this%molSys%species(currentSpeciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
iii=0
- do gg = 1, size(MolecularSystem_instance%species(otherSpeciesID)%particles)
- do ll = 1, size(MolecularSystem_instance%species(otherSpeciesID)%particles(gg)%basis%contraction)
+ do gg = 1, size(this%molSys%species(otherSpeciesID)%particles)
+ do ll = 1, size(this%molSys%species(otherSpeciesID)%particles(gg)%basis%contraction)
hhh = ll
iii = iii + 1
jjj = iii - 1
- do p = gg, size(MolecularSystem_instance%species(otherSpeciesID)%particles)
- do o = hhh, size(MolecularSystem_instance%species(otherSpeciesID)%particles(p)%basis%contraction)
+ do p = gg, size(this%molSys%species(otherSpeciesID)%particles)
+ do o = hhh, size(this%molSys%species(otherSpeciesID)%particles(p)%basis%contraction)
jjj = jjj + 1
!!saving integrals on Matrix
- do pp = otherlabels(iii), otherlabels(iii) + (MolecularSystem_instance%species(otherSpeciesID)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1)
- do oo = otherlabels(jjj), otherlabels(jjj) + (MolecularSystem_instance%species(otherSpeciesID)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1)
+ do pp = otherlabels(iii), otherlabels(iii) + (this%molSys%species(otherSpeciesID)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1)
+ do oo = otherlabels(jjj), otherlabels(jjj) + (this%molSys%species(otherSpeciesID)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1)
m = m + 1
! write(*,*)"m,cosmo_int(m),P_element,pp,oo",m,cosmo_int(m),wavefunction_instance(otherSpeciesID)%densityMatrix%values(pp,oo),pp,oo
@@ -2504,7 +2575,8 @@ subroutine WaveFunction_buildCosmoCoupling(this)
end subroutine WaveFunction_buildCosmoCoupling
- subroutine WaveFunction_cosmoQuantumCharge()
+ subroutine WaveFunction_cosmoQuantumCharge(molSys)
+ type(MolecularSystem) :: molSys
integer :: f,g,a,c,b
integer :: m,k,l
integer :: h,hh,i,ii,jj,j
@@ -2545,18 +2617,18 @@ subroutine WaveFunction_cosmoQuantumCharge()
! write(*,*)"Cosmo Clasical Charges : ", qTotalCosmo(:)
! write(*,*)"sum Cosmo Clasical Charges : ", sum(qTotalCosmo(:))
- numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies
+ numberOfSpecies = molSys%numberOfQuantumSpecies
do f = 1, numberOfSpecies
- specieSelected=MolecularSystem_instance%species(f)
+ specieSelected=molSys%species(f)
if(allocated(labels)) deallocate(labels)
- allocate(labels(MolecularSystem_instance%species(f)%basisSetSize))
+ allocate(labels(molSys%species(f)%basisSetSize))
- orderOfMatrix = MolecularSystem_getTotalNumberOfContractions(f)
+ orderOfMatrix = MolecularSystem_getTotalNumberOfContractions(f,molSys)
- arguments(2) = MolecularSystem_getNameOfSpecies(f)
+ arguments(2) = MolecularSystem_getNameOfSpecies(f,molSys)
arguments(1) = "DENSITY"
densityMatrix = &
@@ -2580,23 +2652,23 @@ subroutine WaveFunction_cosmoQuantumCharge()
end do
end do
- charges_file="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".charges"
+ charges_file="cosmo"//trim( MolecularSystem_getNameOfSpecies( f,molSys ) )//".charges"
open(unit=100, file=trim(charges_file), status='old', form="unformatted")
read(100)m
if(allocated(qiDensityCosmo)) deallocate(qiDensityCosmo)
allocate(qiDensityCosmo(orderOfMatrix, orderOfMatrix,numberOfPointCharges))
ii = 0
- do g = 1, size(MolecularSystem_instance%species(f)%particles)
- do h = 1, size(MolecularSystem_instance%species(f)%particles(g)%basis%contraction)
+ do g = 1, size(molSys%species(f)%particles)
+ do h = 1, size(molSys%species(f)%particles(g)%basis%contraction)
hh = h
ii = ii + 1
jj = ii - 1
- do i = g, size(MolecularSystem_instance%species(f)%particles)
- do j = hh, size(MolecularSystem_instance%species(f)%particles(i)%basis%contraction)
+ do i = g, size(molSys%species(f)%particles)
+ do j = hh, size(molSys%species(f)%particles(i)%basis%contraction)
jj = jj + 1
- do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
- do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
+ do k = labels(ii), labels(ii) + (molSys%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1)
+ do l = labels(jj), labels(jj) + (molSys%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1)
read(100)(qiCosmo(m),m=1,numberOfPointCharges)
do m=1, numberOfPointCharges
qiDensityCosmo(k, l, m) = densityMatrix%values(k,l)*qiCosmo(m)
@@ -2624,7 +2696,7 @@ subroutine WaveFunction_cosmoQuantumCharge()
end do
! write(*,*)"Cosmo Quantum Charges : ", qiCosmo(:)
- write(*,*) "COSMO Charges for ",MolecularSystem_getNameOfSpecies( f )," = ", sum(qiCosmo(:))
+ write(*,*) "COSMO Charges for ",MolecularSystem_getNameOfSpecies( f,molSys )," = ", sum(qiCosmo(:))
end do
close(wfnUnit)
@@ -2650,7 +2722,7 @@ subroutine Wavefunction_removeOrbitalsBelowEigenThreshold(this)
real(8) :: normCheck
integer :: i, j, mu, nu, index
- numberOfContractions = MolecularSystem_getTotalnumberOfContractions(this%species)
+ numberOfContractions = MolecularSystem_getTotalnumberOfContractions(this%species,this%molSys)
i=0
do index = 1 , numberOfContractions
diff --git a/test/Ar.qdo.lowdin b/test/Ar.qdo.lowdin
new file mode 100644
index 00000000..1fc54e4b
--- /dev/null
+++ b/test/Ar.qdo.lowdin
@@ -0,0 +1,13 @@
+GEOMETRY
+ ea- aug-cc-pvtz 0.00 0.00 10.00 m = 0.3020 q = -1.3314 omega=0.7272 multiplicity=2
+ H dirac 0.00 0.00 10.00 q = 1.3314 qdoCenterOf=EA-
+END GEOMETRY
+
+TASKS
+ method = "UHF"
+END TASKS
+
+CONTROL
+ readCoefficients=F
+END CONTROL
+
diff --git a/test/Ar.qdo.py b/test/Ar.qdo.py
new file mode 100644
index 00000000..41de56eb
--- /dev/null
+++ b/test/Ar.qdo.py
@@ -0,0 +1,60 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [1.090868916669,1E-8],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+HF_prop = True
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/Ar2.qdo.lowdin b/test/Ar2.qdo.lowdin
new file mode 100644
index 00000000..f606e8ce
--- /dev/null
+++ b/test/Ar2.qdo.lowdin
@@ -0,0 +1,22 @@
+GEOMETRY
+ ea- aug-cc-pVTZ 0.00 0.00 0.0 m = 0.3020 q = -1.3314 omega = 0.7272
+ ea- aug-cc-pVTZ 0.00 0.00 1.0 m = 0.3020 q = -1.3314 addParticles=-1
+ eb- aug-cc-pVTZ 0.00 0.00 0.0 m = 0.3020 q = -1.3314 omega = 0.7272
+ eb- aug-cc-pVTZ 0.00 0.00 1.0 m = 0.3020 q = -1.3314 addParticles=-1
+ H dirac 0.00 0.00 0.0 q = 1.3314 qdoCenterOf=EA-
+ H dirac 0.00 0.00 1.0 q = 1.3314 qdoCenterOf=EB-
+END GEOMETRY
+
+TASKS
+ method = "UHF"
+ configurationInteractionLevel ="FCI"
+END TASKS
+
+CONTROL
+ numberOfCIstates=1
+ CIStatesToPrint = 1
+ CIdiagonalizationMethod = "JADAMILU"
+ units = "bohr"
+ readCoefficients=F
+END CONTROL
+
diff --git a/test/Ar2.qdo.py b/test/Ar2.qdo.py
new file mode 100644
index 00000000..c66ecf01
--- /dev/null
+++ b/test/Ar2.qdo.py
@@ -0,0 +1,63 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [2.632759326800,1E-8],
+"CI 1" : [2.597994064509,1E-8],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+HF_prop = True
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "STATE: 1 ENERGY =" in line:
+ testValues["CI 1"] = float(line.split()[4])
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/CHDTHemu.massTest.lowdin b/test/CHDTHemu.massTest.lowdin
new file mode 100644
index 00000000..85916399
--- /dev/null
+++ b/test/CHDTHemu.massTest.lowdin
@@ -0,0 +1,23 @@
+
+GEOMETRY
+e-(C) NAKAI-CC-PVTZ 0.0000000 0.0000000 0.0000000
+e-(H) NAKAI-CC-PVTZ 0.6283310 0.6283310 0.6283310
+e-(H) NAKAI-CC-PVTZ -0.6283310 -0.6283310 0.6283310
+e-(H) NAKAI-CC-PVTZ -0.6283310 0.6283310 -0.6283310
+e-(H) NAKAI-CC-PVTZ 0.6283310 -0.6283310 -0.6283310
+U- HEMU 0.6283310 0.6283310 0.6283310
+C_12 NAKAI-3-SP 0.0000000 0.0000000 0.0000000
+He_4 NAKAI-3-SP 0.6283310 0.6283310 0.6283310
+H_1 DZSPNB -0.6283310 -0.6283310 0.6283310
+H_2 DZSPNB -0.6283310 0.6283310 -0.6283310
+H_3 DZSPNB 0.6283310 -0.6283310 -0.6283310
+END GEOMETRY
+
+TASKS
+ method = "RHF"
+END TASKS
+
+CONTROL
+ readCoefficients=F
+ removeTranslationalContamination=T
+END CONTROL
diff --git a/test/CHDTHemu.massTest.py b/test/CHDTHemu.massTest.py
new file mode 100644
index 00000000..e1d5f5a4
--- /dev/null
+++ b/test/CHDTHemu.massTest.py
@@ -0,0 +1,84 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+# Reference values and tolerance
+
+refValues = {
+ "Total mass" : [40383.2869, 5E-4],
+ "E- Kinetic energy" : [36.558549208752,1E-6],
+ "MUON Kinetic energy" : [4.823223401186,1E-6],
+ "C_12 Kinetic energy" : [0.020362665915,1E-6],
+ "HE_4 Kinetic energy" : [0.042798597334,1E-6],
+ "H_1 Kinetic energy" : [0.018810346458,1E-6],
+ "H_2 Kinetic energy" : [0.013654378944,1E-6],
+ "H_3 Kinetic energy" : [0.011128664979,1E-6],
+ "HF energy" : [-74.168958869716,1E-8]
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+checkArray=[0,0,0,0]
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "MASS (m_e)" in line:
+ testValues["Total mass"] = float(line.split()[3])
+ if "E- Kinetic energy" in line:
+ testValues["E- Kinetic energy"] = float(line.split()[4])
+ if "MUON Kinetic energy" in line:
+ testValues["MUON Kinetic energy"] = float(line.split()[4])
+ if "C_12 Kinetic energy" in line:
+ testValues["C_12 Kinetic energy"] = float(line.split()[4])
+ if "HE_4 Kinetic energy" in line:
+ testValues["HE_4 Kinetic energy"] = float(line.split()[4])
+ if "H_1 Kinetic energy" in line:
+ testValues["H_1 Kinetic energy"] = float(line.split()[4])
+ if "H_2 Kinetic energy" in line:
+ testValues["H_2 Kinetic energy"] = float(line.split()[4])
+ if "H_3 Kinetic energy" in line:
+ testValues["H_3 Kinetic energy"] = float(line.split()[4])
+
+output.close()
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
diff --git a/test/Gly.e+-molden.py b/test/Gly.e+-molden.py
index eba52463..d84290c8 100644
--- a/test/Gly.e+-molden.py
+++ b/test/Gly.e+-molden.py
@@ -13,7 +13,7 @@
inputName = testName + ".lowdin"
outputName = testName + ".out"
molden1Name = testName + ".E-.molden"
-molden2Name = testName + ".POSITRON.molden"
+molden2Name = testName + ".E+.molden"
# Reference values and tolerance
refValues = {
diff --git a/test/H-e+H-.DD-CISD.lowdin b/test/H-e+H-.DD-CISD.lowdin
new file mode 100644
index 00000000..f2e10528
--- /dev/null
+++ b/test/H-e+H-.DD-CISD.lowdin
@@ -0,0 +1,29 @@
+GEOMETRY
+ e-(H) aug-cc-pvdz 0.00 0.00 0.00 addParticles=2
+ e-(H) aug-cc-pvdz 0.00 0.00 3.37
+ H dirac 0.00 0.00 0.00
+ H dirac 0.00 0.00 3.37
+ e+ e+aug-cc-pvdz 0.00 0.00 0.00 addParticles=-1
+ e+ e+aug-cc-pvdz 0.00 0.00 3.37
+END GEOMETRY
+
+TASKS
+ method = "UHF"
+ !configurationInteractionLevel ="FCI"
+ configurationInteractionLevel ="CISD"
+END TASKS
+
+CONTROL
+ readCoefficients=F
+ numberOfCIstates=1
+ !CIdiagonalizationMethod = "DSYEVX"
+ CIdiagonalizationMethod = "JADAMILU"
+ CIdiagonalDressedShift = "CISD"
+END CONTROL
+
+INPUT_CI
+ species="E-ALPHA" core=0 active=0
+ species="E-BETA" core=0 active=0
+ species="POSITRON" core=0 active=0
+END INPUT_CI
+
diff --git a/test/H-e+H-.DD-CISD.py b/test/H-e+H-.DD-CISD.py
new file mode 100644
index 00000000..743fba81
--- /dev/null
+++ b/test/H-e+H-.DD-CISD.py
@@ -0,0 +1,62 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [-1.165428966723,1E-8],
+"CISD energy" : [-1.284366244580,1E-7],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "STATE: 1 ENERGY =" in line:
+ testValues["CISD energy"] = float(line.split()[4])
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/H2O.APMO.FCI.lowdin b/test/H2O.APMO.FCI.lowdin
index ec8dd0d6..9358efb5 100644
--- a/test/H2O.APMO.FCI.lowdin
+++ b/test/H2O.APMO.FCI.lowdin
@@ -14,12 +14,12 @@
SYSTEM_DESCRIPTION='Molecula de H2O'
GEOMETRY
- e-[O] 6-31G 0.000000 0.000000 -0.066575
- e-[H] 6-31G 0.000000 0.754175 0.528381
- e-[H] 6-31G 0.000000 -0.754174 0.528382
- O dirac 0.000000 0.000000 -0.066575
- H-a_1 Nakai-3-s 0.000000 0.754175 0.528381
- H-b_1 Nakai-3-s 0.000000 -0.754174 0.528382
+ e-[O] 6-31G 0.000000 0.000000 0.111053
+ e-[H] 6-31G 0.000000 0.757759 -0.444211
+ e-[H] 6-31G 0.000000 -0.757759 -0.444211
+ O dirac 0.000000 0.000000 0.111053
+ H-a_1 Nakai-3-s 0.000000 0.757759 -0.444211
+ H-b_1 Nakai-3-s 0.000000 -0.757759 -0.444211
END GEOMETRY
END GEOMETRY
diff --git a/test/H2O.APMO.FCI.py b/test/H2O.APMO.FCI.py
index 47af04bc..e59c55a6 100644
--- a/test/H2O.APMO.FCI.py
+++ b/test/H2O.APMO.FCI.py
@@ -9,15 +9,29 @@
else:
lowdinbin = "lowdin2"
-testName = "H2O.APMO.FCI"
+testName = sys.argv[0][:-3]
inputName = testName + ".lowdin"
outputName = testName + ".out"
-# Reference values
-
-refTotalEnergy = -75.895908288860
-refFCIEnergy = -75.913887561202
+# Reference values and tolerance
+refValues = {
+"HF energy" : [-75.895520937848,1E-8],
+"HF dipole" : [1.06383820,1E-7],
+"HF quadrupole xx" : [-7.21841981,1E-6],
+"HF quadrupole yy" : [-4.02024678,1E-6],
+"HF quadrupole zz" : [-6.20812552,1E-6],
+"CI 1" : [-75.911063510564,1E-8],
+"CI dipole" : [1.01277057,1E-7],
+"CI quadrupole xx" : [-7.26705299,1E-6],
+"CI quadrupole yy" : [-4.21742308,1E-6],
+"CI quadrupole zz" : [-6.30621482,1E-6]
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
# Run calculation
status = os.system(lowdinbin + " -i " + inputName)
@@ -28,24 +42,65 @@
output = open(outputName, "r")
outputRead = output.readlines()
+HF_dipo = True
+HF_quad = True
# Values
-
-for line in outputRead:
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
if "TOTAL ENERGY =" in line:
- totalEnergy = float(line.split()[3])
+ testValues["HF energy"] = float(line.split()[3])
if "STATE: 1 ENERGY =" in line:
- FCIEnergy = float(line.split()[4])
+ testValues["CI 1"] = float(line.split()[4])
+
+ if "DIPOLE: (A.U.)" in line and HF_dipo:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["HF dipole"] = float(linej.split()[5])
+ HF_dipo = False
+ break
+
+ if "DIPOLE: (A.U.)" in line and not HF_dipo:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["CI dipole"] = float(linej.split()[5])
+ break
+
+ if "QUADRUPOLE NON-TRACELESS: (DEBYE ANGS)" in line and HF_quad:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Quadrupole:" in linej:
+ testValues["HF quadrupole xx"] = float(linej.split()[2])
+ testValues["HF quadrupole yy"] = float(linej.split()[3])
+ testValues["HF quadrupole zz"] = float(linej.split()[4])
+ HF_quad = False
+ break
+
+ if "QUADRUPOLE NON-TRACELESS: (DEBYE ANGS)" in line and not HF_quad:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Quadrupole:" in linej:
+ testValues["CI quadrupole xx"] = float(linej.split()[2])
+ testValues["CI quadrupole yy"] = float(linej.split()[3])
+ testValues["CI quadrupole zz"] = float(linej.split()[4])
+ break
+
+passTest = True
-diffTotalEnergy = abs(refTotalEnergy - totalEnergy)
-diffFCIEnergy = abs(refFCIEnergy - FCIEnergy)
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
-if (diffTotalEnergy <= 1E-8 and diffFCIEnergy <= 1E-6):
+if passTest :
print(testName + str_green(" ... OK"))
else:
print(testName + str_red(" ... NOT OK"))
- print("Difference HF: " + str(diffTotalEnergy))
- print("Difference FCI: " + str(diffFCIEnergy))
sys.exit(1)
output.close()
diff --git a/test/H2O.BOA.efield.lowdin b/test/H2O.BOA.efield.lowdin
new file mode 100644
index 00000000..ff43874e
--- /dev/null
+++ b/test/H2O.BOA.efield.lowdin
@@ -0,0 +1,22 @@
+GEOMETRY
+e-(O) aug-cc-pVTZ 0.00000 0.00000 0.11285
+e-(H) aug-cc-pVTZ 0.00000 0.75306 -0.45141
+e-(H) aug-cc-pVTZ 0.00000 -0.75306 -0.45141
+O dirac 0.00000 0.00000 0.11285
+H dirac 0.00000 0.75306 -0.45141
+H dirac 0.00000 -0.75306 -0.45141
+END GEOMETRY
+
+TASKS
+ method = "RHF"
+END TASKS
+
+CONTROL
+ electricField = 0.00 0.00 0.001
+! multipoleOrder = 1
+END CONTROL
+
+
+
+
+
diff --git a/test/HCOOPs.HF.DensCube.py b/test/H2O.BOA.efield.py
similarity index 56%
rename from test/HCOOPs.HF.DensCube.py
rename to test/H2O.BOA.efield.py
index 9233a570..2f8c8d74 100644
--- a/test/HCOOPs.HF.DensCube.py
+++ b/test/H2O.BOA.efield.py
@@ -12,14 +12,12 @@
testName = sys.argv[0][:-3]
inputName = testName + ".lowdin"
outputName = testName + ".out"
-cube1Name = testName + ".E-.dens.cub"
-cube2Name = testName + ".POSITRON.dens.cub"
+
# Reference values and tolerance
refValues = {
-"HF energy" : [-188.362545831570,1E-8],
-"Num e- in cube" : [24.0,1E-1],
-"Num e+ in cube" : [1.0,1E-2],
+"HF energy" : [-76.062503916951,1E-8],
+"HF dipole" : [0.76847102,1E-7],
}
testValues = dict(refValues) #copy
@@ -36,40 +34,30 @@
output = open(outputName, "r")
outputRead = output.readlines()
+HF_prop = True
# Values
for i in range(0,len(outputRead)):
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
+ if "STATE: 1 ENERGY =" in line:
+ testValues["CI 1"] = float(line.split()[4])
-output.close()
-
-cube1 = open(cube1Name, "r")
-cube1Read = cube1.readlines()
-sumE=0
-for i in range(0,len(cube1Read)):
- line = cube1Read[i]
- if i == 3: step=float(line.split()[1])
- if i > 10:
- values = line.split()
- for j in range(0,len(values)):
- sumE+=float(values[j])
-testValues["Num e- in cube"]=sumE*step**3
-cube1.close()
+ if "DIPOLE: (A.U.)" in line and HF_prop:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["HF dipole"] = float(linej.split()[5])
+ HF_prop = False
+ break
-cube2 = open(cube2Name, "r")
-cube2Read = cube2.readlines()
-sumP=0
-for i in range(0,len(cube2Read)):
- line = cube2Read[i]
- if i == 3: step=float(line.split()[1])
- if i > 10:
- values = line.split()
- for j in range(0,len(values)):
- sumP+=float(values[j])
-testValues["Num e+ in cube"]=sumP*step**3
-cube2.close()
+ if "DIPOLE: (A.U.)" in line and not HF_prop:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["CI dipole"] = float(linej.split()[5])
+ break
passTest = True
@@ -87,3 +75,4 @@
print(testName + str_red(" ... NOT OK"))
sys.exit(1)
+output.close()
diff --git a/test/H2O.BOA.lowdin b/test/H2O.BOA.lowdin
index 2d3adb9a..f9c9fe57 100644
--- a/test/H2O.BOA.lowdin
+++ b/test/H2O.BOA.lowdin
@@ -9,12 +9,12 @@
SYSTEM_DESCRIPTION='Molecula de H2O'
GEOMETRY
- e-[O] 6-311G 0.000000 0.000000 -0.066575
- e-[H] 6-311G 0.000000 0.754175 0.528381
- e-[H] 6-311G 0.000000 -0.754174 0.528382
- O dirac 0.000000 0.000000 -0.066575
- H_1 dirac 0.000000 0.754175 0.528381
- H_1 dirac 0.000000 -0.754174 0.528382
+ e-[O] 6-311G 0.000000 0.000000 0.111053
+ e-[H] 6-311G 0.000000 0.757759 -0.444211
+ e-[H] 6-311G 0.000000 -0.757759 -0.444211
+ O dirac 0.000000 0.000000 0.111053
+ H_1 dirac 0.000000 0.757759 -0.444211
+ H_1 dirac 0.000000 -0.757759 -0.444211
END GEOMETRY
TASKS
diff --git a/test/H2O.BOA.molden.lowdin b/test/H2O.BOA.molden.lowdin
new file mode 100644
index 00000000..0899a36c
--- /dev/null
+++ b/test/H2O.BOA.molden.lowdin
@@ -0,0 +1,18 @@
+SYSTEM_DESCRIPTION='Molecula de H2O'
+
+GEOMETRY
+e-[O] CC-PVQZ 0.000000 0.000000 -0.066575
+e-[H] 6-31G 0.000000 0.754175 0.528381
+e-[H] 6-31G 0.000000 -0.754174 0.528382
+O dirac 0.000000 0.000000 -0.066575
+H_1 dirac 0.000000 0.754175 0.528381
+H_1 dirac 0.000000 -0.754174 0.528382
+END GEOMETRY
+
+TASKS
+method = "RHF"
+END TASKS
+
+OUTPUTS
+moldenFile
+END OUTPUTS
\ No newline at end of file
diff --git a/test/H2O.BOA.molden.py b/test/H2O.BOA.molden.py
new file mode 100644
index 00000000..088b68bc
--- /dev/null
+++ b/test/H2O.BOA.molden.py
@@ -0,0 +1,192 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+molden1Name = testName + ".E-.molden"
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [-76.056328834832,1E-8],
+"e-HOMO" : [-5.08882E-01,1E-4],
+"eigvec,1,1": [0.9939786,0.001],
+"eigvec,1,2": [0.00321949,0.001],
+"eigvec,1,3": [0.02029773,0.001],
+"eigvec,1,8": [0.00208321,0.001],
+"eigvec,1,11": [0.0017893,0.001],
+"eigvec,1,14": [0.0015845,0.001],
+"eigvec,1,18": [0.00156669,0.001],
+"eigvec,1,20": [0.00113877,0.001],
+"eigvec,1,24": [0.0033928,0.001],
+"eigvec,1,26": [0.00158062,0.001],
+"eigvec,1,48": [0.00110448,0.001],
+"eigvec,1,56": [0.00263608,0.001],
+"eigvec,1,58": [0.00160313,0.001],
+"eigvec,1,65": [0.00106948,0.001],
+"eigvec,1,66": [0.00125158,0.001],
+"eigvec,2,1": [0.0078336,0.001],
+"eigvec,2,2": [0.30870689,0.001],
+"eigvec,2,3": [0.19694376,0.001],
+"eigvec,2,4": [0.56914251,0.001],
+"eigvec,2,5": [0.30272071,0.001],
+"eigvec,2,8": [0.02142744,0.001],
+"eigvec,2,11": [0.06790512,0.001],
+"eigvec,2,14": [0.02891775,0.001],
+"eigvec,2,17": [0.02847843,0.001],
+"eigvec,2,18": [0.00191158,0.001],
+"eigvec,2,19": [0.00182459,0.001],
+"eigvec,2,20": [0.00238583,0.001],
+"eigvec,2,24": [0.01976506,0.001],
+"eigvec,2,25": [0.00425676,0.001],
+"eigvec,2,26": [0.0098827,0.001],
+"eigvec,2,30": [0.03229255,0.001],
+"eigvec,2,31": [0.02079304,0.001],
+"eigvec,2,32": [0.01922866,0.001],
+"eigvec,2,38": [0.00116329,0.001],
+"eigvec,2,44": [0.0022189,0.001],
+"eigvec,2,48": [0.04645561,0.001],
+"eigvec,2,51": [0.0155471,0.001],
+"eigvec,2,54": [0.03489843,0.001],
+"eigvec,2,57": [0.0016457,0.001],
+"eigvec,2,65": [0.00194347,0.001],
+"eigvec,2,66": [0.00124899,0.001],
+"eigvec,2,67": [0.00679824,0.001],
+"eigvec,2,71": [0.1195507,0.001],
+"eigvec,2,72": [0.00111498,0.001],
+"eigvec,2,73": [0.11955076,0.001],
+"eigvec,2,74": [0.00111497,0.001],
+"eigvec,3,7": [0.14103306,0.001],
+"eigvec,3,10": [0.26698666,0.001],
+"eigvec,3,13": [0.29854243,0.001],
+"eigvec,3,16": [0.14680475,0.001],
+"eigvec,3,23": [0.00612365,0.001],
+"eigvec,3,29": [0.01201828,0.001],
+"eigvec,3,35": [0.03167148,0.001],
+"eigvec,3,37": [0.0020827,0.001],
+"eigvec,3,40": [0.00100915,0.001],
+"eigvec,3,43": [0.00271485,0.001],
+"eigvec,3,47": [0.03543525,0.001],
+"eigvec,3,50": [0.00106762,0.001],
+"eigvec,3,53": [0.01304568,0.001],
+"eigvec,3,62": [0.01280384,0.001],
+"eigvec,3,64": [0.00520432,0.001],
+"eigvec,3,71": [0.21875249,0.001],
+"eigvec,3,72": [0.11175294,0.001],
+"eigvec,3,73": [0.21875254,0.001],
+"eigvec,3,74": [0.11175293,0.001],
+"eigvec,4,1": [0.0029427,0.001],
+"eigvec,4,2": [0.11064105,0.001],
+"eigvec,4,3": [0.09231006,0.001],
+"eigvec,4,4": [0.17254931,0.001],
+"eigvec,4,5": [0.23227883,0.001],
+"eigvec,4,8": [0.15648245,0.001],
+"eigvec,4,11": [0.29035693,0.001],
+"eigvec,4,14": [0.32398334,0.001],
+"eigvec,4,17": [0.24327021,0.001],
+"eigvec,4,18": [0.00390379,0.001],
+"eigvec,4,20": [0.00378954,0.001],
+"eigvec,4,25": [0.00339092,0.001],
+"eigvec,4,30": [0.00946407,0.001],
+"eigvec,4,31": [0.01003612,0.001],
+"eigvec,4,32": [0.05371892,0.001],
+"eigvec,4,38": [0.00166599,0.001],
+"eigvec,4,44": [0.00343828,0.001],
+"eigvec,4,48": [0.02940923,0.001],
+"eigvec,4,51": [0.00174679,0.001],
+"eigvec,4,54": [0.01368111,0.001],
+"eigvec,4,56": [0.00429996,0.001],
+"eigvec,4,57": [0.00137211,0.001],
+"eigvec,4,58": [0.00364046,0.001],
+"eigvec,4,65": [0.00181726,0.001],
+"eigvec,4,66": [0.00196488,0.001],
+"eigvec,4,67": [0.00609422,0.001],
+"eigvec,4,71": [0.13676351,0.001],
+"eigvec,4,72": [0.07750444,0.001],
+"eigvec,4,73": [0.13676345,0.001],
+"eigvec,4,74": [0.07750437,0.001],
+"eigvec,5,6": [0.17966322,0.001],
+"eigvec,5,9": [0.33034402,0.001],
+"eigvec,5,12": [0.38223722,0.001],
+"eigvec,5,15": [0.32672634,0.001],
+"eigvec,5,22": [0.00385062,0.001],
+"eigvec,5,28": [0.00134941,0.001],
+"eigvec,5,34": [0.04247752,0.001],
+"eigvec,5,36": [0.00350524,0.001],
+"eigvec,5,39": [0.00103526,0.001],
+"eigvec,5,42": [0.00117129,0.001],
+"eigvec,5,46": [0.00723327,0.001],
+"eigvec,5,49": [0.02445057,0.001],
+"eigvec,5,52": [0.01703417,0.001],
+"eigvec,5,63": [0.00285564,0.001],
+"eigvec,5,69": [0.00492437,0.001]
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+
+output.close()
+
+molden1 = open(molden1Name, "r")
+molden1Read = molden1.readlines()
+v=0
+eigenv=[]
+flag=0
+for i in range(0,len(molden1Read)):
+ line = molden1Read[i]
+ if "Ene=" in line:
+ eigenv.append(float(line.split()[1]))
+ v+=1
+ if flag==1 and "=" not in line:
+ if abs(float(line.split()[1])) >= 0.001:
+ string="eigvec,"+str(v)+","+str(line.split()[0])
+ testValues[string] = abs(float(line.split()[1]))
+ if "[MO]" in line:
+ flag=1
+ if "Occup=" in line and "0.0" in line :
+ testValues["e-HOMO"] = eigenv[v-2]
+ break
+molden1.close()
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
diff --git a/test/H2O.BOA.py b/test/H2O.BOA.py
index 3082cd5e..00cfb22a 100644
--- a/test/H2O.BOA.py
+++ b/test/H2O.BOA.py
@@ -9,14 +9,24 @@
else:
lowdinbin = "lowdin2"
-testName = "H2O.BOA"
+testName = sys.argv[0][:-3]
inputName = testName + ".lowdin"
outputName = testName + ".out"
-# Reference values
+# Reference values and tolerance
-refTotalEnergy = -76.008843007734
+refValues = {
+"HF energy" : [-76.010288769789,1E-8],
+"HF dipole" : [1.01124369,1E-7],
+"HF quadrupole xx" : [-7.25729057,1E-7],
+"HF quadrupole yy" : [-4.07831587,1E-7],
+"HF quadrupole zz" : [-6.25445146,1E-7],
+}
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
# Run calculation
status = os.system(lowdinbin + " -i " + inputName)
@@ -27,20 +37,47 @@
output = open(outputName, "r")
outputRead = output.readlines()
+HF_dip = True
+HF_quad = True
# Values
-
-for line in outputRead:
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
if "TOTAL ENERGY =" in line:
- totalEnergy = float(line.split()[3])
+ testValues["HF energy"] = float(line.split()[3])
+
+ if "DIPOLE: (A.U.)" in line and HF_dip:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["HF dipole"] = float(linej.split()[5])
+ HF_dip = False
+ break
+
+ if "QUADRUPOLE NON-TRACELESS: (DEBYE ANGS)" in line and HF_quad:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Quadrupole:" in linej:
+ testValues["HF quadrupole xx"] = float(linej.split()[2])
+ testValues["HF quadrupole yy"] = float(linej.split()[3])
+ testValues["HF quadrupole zz"] = float(linej.split()[4])
+ HF_quad = False
+ break
+
+passTest = True
-diffTotalEnergy = abs(refTotalEnergy - totalEnergy)
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
-if (diffTotalEnergy <= 1E-8):
+if passTest :
print(testName + str_green(" ... OK"))
else:
print(testName + str_red(" ... NOT OK"))
- print("Difference HF: " + str(diffTotalEnergy))
sys.exit(1)
output.close()
diff --git a/test/HCOOPs.HF.DensCube.lowdin b/test/HCOOPs.HF.DensCube.lowdin
deleted file mode 100644
index 335a8d4c..00000000
--- a/test/HCOOPs.HF.DensCube.lowdin
+++ /dev/null
@@ -1,30 +0,0 @@
-GEOMETRY
-e-(C) cc-pVDZ 0.0000000 0.0000000 0.3157740
-e-(H) cc-pVDZ 0.0000000 0.0000000 1.4510170
-e-(O) aug-cc-pVDZ 0.0000000 1.1357680 -0.2091040
-e-(O) aug-cc-pVDZ 0.0000000 -1.1357680 -0.2091040 addParticles=1
-e+ PSX-DZ 0.0000000 1.1357680 -0.2091040
-e+ PSX-DZ 0.0000000 -1.1357680 -0.2091040 addParticles=-1
-C dirac 0.0000000 0.0000000 0.3157740
-H dirac 0.0000000 0.0000000 1.4510170
-O dirac 0.0000000 1.1357680 -0.2091040
-O dirac 0.0000000 -1.1357680 -0.2091040
-END GEOMETRY
-
-TASKS
- method = "RHF"
-END TASKS
-
-CONTROL
- readCoefficients=.F.
- numberOfPointsPerDimension=100
-END CONTROL
-
-OUTPUTS
- densityCube cubeSize=5 point1=0.0 0.0 0.0 species="E-"
- densityCube cubeSize=20 point1=0.0 0.0 -2.5 species="E+"
-END OUTPUTS
-
-
-
-
diff --git a/test/HCOOPs.HF.densOrbCube.lowdin b/test/HCOOPs.HF.densOrbCube.lowdin
new file mode 100644
index 00000000..0dd11727
--- /dev/null
+++ b/test/HCOOPs.HF.densOrbCube.lowdin
@@ -0,0 +1,34 @@
+GEOMETRY
+e-(C) cc-pVDZ 0.0000000 0.0000000 0.3157740
+e-(H) cc-pVDZ 0.0000000 0.0000000 1.4510170
+e-(O) aug-cc-pVDZ 0.0000000 1.1357680 -0.2091040
+e-(O) aug-cc-pVDZ 0.0000000 -1.1357680 -0.2091040 addparticles=1
+e+ PSX-DZ 0.0000000 1.1357680 -0.2091040
+e+ PSX-DZ 0.0000000 -1.1357680 -0.2091040 ADDParticles=-1
+C dirac 0.0000000 0.0000000 0.3157740
+H dirac 0.0000000 0.0000000 1.4510170
+O dirac 0.0000000 1.1357680 -0.2091040
+O dirac 0.0000000 -1.1357680 -0.2091040
+END GEOMETRY
+
+TASKS
+ method = "RHF"
+END TASKS
+
+CONTROL
+ readCoefficients=.F.
+END CONTROL
+
+OUTPUTS
+ densityCube cubeSize=5 point1=0.0 0.0 0.0 species="E-" pointsPerDim=100
+ densityCube cubesize=20 point1=0.0 0.0 -2.5 species="E+" pointsPerDim=50
+ orbitalCube CubeSize=15 center=0.0 0.0 -2.5 species="ALL" scanStep=0.5
+ orbitalPlot axis="y" limitY=-7.5 7.5 offsetZ=-0.2091040 species="E+" scanStep=0.1
+ orbitalPlot plane="yz" limitY=-7.5 7.5 limitZ=-7.5 7.5 species="E+" pointsPerDim=100
+END OUTPUTS
+
+
+
+
+
+
diff --git a/test/HCOOPs.HF.densOrbCube.py b/test/HCOOPs.HF.densOrbCube.py
new file mode 100644
index 00000000..a8c542a4
--- /dev/null
+++ b/test/HCOOPs.HF.densOrbCube.py
@@ -0,0 +1,158 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+cubes=[testName + ".E-.dens.cub",
+ testName + ".E+.dens.cub",
+ testName + ".E+.orb1.cub",
+ testName + ".E-.orb12.cub"]
+plots=[testName + ".E+.2D.orb1",
+ testName + ".E+.3D.orb1"
+ ]
+
+# Reference values and tolerance
+refValues = {
+"HF energy" : [-188.362545831570,1E-8],
+"Num E- in density cube" : [24.0,1E-1],
+"Num E+ in density cube" : [1.0,1E-2],
+"Num E+ in orbital cube" : [1.0,1E-2],
+"Num E- in orbital cube" : [1.0,1E-2],
+"Num E+ in 2D orbital plot" : [0.00010605,1E-4],
+"Num E+ in 3D orbital plot" : [0.03267345,3E-2],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+
+output.close()
+
+index=0
+cube = open(cubes[index], "r")
+cubeRead = cube.readlines()
+sumPart=0
+for i in range(0,len(cubeRead)):
+ line = cubeRead[i]
+ if i == 3: step=float(line.split()[1])
+ if i > 10:
+ values = line.split()
+ for j in range(0,len(values)):
+ sumPart+=float(values[j])
+testValues["Num E- in density cube"]=sumPart*step**3
+cube.close()
+
+index=1
+cube = open(cubes[index], "r")
+cubeRead = cube.readlines()
+sumPart=0
+for i in range(0,len(cubeRead)):
+ line = cubeRead[i]
+ if i == 3: step=float(line.split()[1])
+ if i > 10:
+ values = line.split()
+ for j in range(0,len(values)):
+ sumPart+=float(values[j])
+testValues["Num E+ in density cube"]=sumPart*step**3
+cube.close()
+
+index=2
+cube = open(cubes[index], "r")
+cubeRead = cube.readlines()
+sumPart=0
+for i in range(0,len(cubeRead)):
+ line = cubeRead[i]
+ if i == 3: step=float(line.split()[1])
+ if i > 10:
+ values = line.split()
+ for j in range(0,len(values)):
+ sumPart+=float(values[j])**2
+testValues["Num E+ in orbital cube"]=sumPart*step**3
+cube.close()
+
+index=3
+cube = open(cubes[index], "r")
+cubeRead = cube.readlines()
+sumPart=0
+for i in range(0,len(cubeRead)):
+ line = cubeRead[i]
+ if i == 3: step=float(line.split()[1])
+ if i > 10:
+ values = line.split()
+ for j in range(0,len(values)):
+ sumPart+=float(values[j])**2
+testValues["Num E- in orbital cube"]=sumPart*step**3
+cube.close()
+
+index=0
+orbplotName=plots[index]
+orbplot = open(orbplotName, "r")
+orbplotRead = orbplot.readlines()
+sumPart=0
+for i in range(0,len(orbplotRead)):
+ line = orbplotRead[i]
+ if i > 1:
+ values = line.split()
+ if i == 3: x1=float(values[0])
+ if i == 4: x2=float(values[0])
+ if len(values) > 1 and float(values[0]) > 0.0 : sumPart+=float(values[1])**2
+testValues["Num E+ in 2D orbital plot"]=sumPart*(x2-x1)**3
+orbplot.close()
+
+index=1
+orbplotName=plots[index]
+orbplot = open(orbplotName, "r")
+orbplotRead = orbplot.readlines()
+sumPart=0
+for i in range(0,len(orbplotRead)):
+ line = orbplotRead[i]
+ if i > 1:
+ values = line.split()
+ if i == 3: x1=float(values[1])
+ if i == 4: x2=float(values[1])
+ if len(values) > 1: sumPart+=float(values[2])**2
+testValues["Num E+ in 3D orbital plot"]=sumPart*(x2-x1)**3
+orbplot.close()
+
+
+passTest = True
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
diff --git a/test/HCl.ROCI-DFT.lowdin b/test/HCl.ROCI-DFT.lowdin
new file mode 100644
index 00000000..5e08ce9b
--- /dev/null
+++ b/test/HCl.ROCI-DFT.lowdin
@@ -0,0 +1,25 @@
+GEOMETRY
+ e-(Cl) CC-PVDZ 0.00 0.00 0.00 addParticles=0
+ e-(H) CC-PVDZ 1.284 0.00 0.00
+ Cl dirac 0.00 0.00 0.00
+ H_1 DZSPNB 1.284 0.00 0.00
+END GEOMETRY
+
+TASKS
+ method = "RKS"
+ nonOrthogonalConfigurationInteraction=.T.
+END TASKS
+
+CONTROL
+ computeROCIformula=.T.
+ rotationAroundZMaxAngle=35
+ rotationAroundZStep=5
+ numberOfCIStates=5
+ electronExchangeCorrelationFunctional="B3LYP"
+ nuclearElectronCorrelationFunctional="epc17-2"
+ integralStorage="MEMORY"
+ gridStorage="MEMORY"
+ readCoefficients=.F.
+ nonElectronicLevelShifting=0.005
+END CONTROL
+
diff --git a/test/HCl.ROCI-DFT.py b/test/HCl.ROCI-DFT.py
new file mode 100644
index 00000000..8b697004
--- /dev/null
+++ b/test/HCl.ROCI-DFT.py
@@ -0,0 +1,92 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"KS energy" : [-460.740603426038,1E-6],
+"CI 1" : [-460.763938669911,1E-6],
+"CI 2" : [-460.763767549387,1E-6],
+"H_1 Kin 1" : [0.004031326872,1E-6],
+"H_1 Kin 2" : [0.004117680624,1E-6],
+"E-/H_1 Corr 1" : [-0.026900321722,1E-4],
+"E-/H_1 Corr 2" : [-0.026900318425,1E-4],
+"scaled CI 1" : [-460.753068611851,1E-6],
+"scaled CI 2" : [-460.752986688385,1E-6],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+stateFlag=0
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["KS energy"] = float(line.split()[3])
+ if "STATE: 1 ENERGY =" in line:
+ testValues["CI 1"] = float(line.split()[4])
+ stateFlag=1
+ if "STATE: 2 ENERGY =" in line:
+ testValues["CI 2"] = float(line.split()[4])
+ stateFlag=2
+ if "H_1 Kinetic energy =" in line:
+ if stateFlag == 1:
+ testValues["H_1 Kin 1"] = float(line.split()[4])
+ elif stateFlag == 2:
+ testValues["H_1 Kin 2"] = float(line.split()[4])
+ if "E-/H_1 DFTcorrelation energy =" in line:
+ if stateFlag == 1:
+ testValues["E-/H_1 Corr 1"] = float(line.split()[4])
+ elif stateFlag == 2:
+ testValues["E-/H_1 Corr 2"] = float(line.split()[4])
+ if "STATE: 3 ENERGY =" in line:
+ stateFlag = 3
+ if "STATE: 1 SCALED ENERGY =" in line:
+ testValues["scaled CI 1"] = float(line.split()[5])
+ stateFlag=1
+ if "STATE: 2 SCALED ENERGY =" in line:
+ testValues["scaled CI 2"] = float(line.split()[5])
+ stateFlag=2
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/HOO+.ROCI-HF.lowdin b/test/HOO+.ROCI-HF.lowdin
new file mode 100644
index 00000000..0bd2a74a
--- /dev/null
+++ b/test/HOO+.ROCI-HF.lowdin
@@ -0,0 +1,23 @@
+GEOMETRY
+ e-(O) CC-PVDZ 0.00 0.00 1.2274 addParticles=-1 multiplicity=3
+ e-(O) CC-PVDZ 0.00 0.00 0.00
+ e-(H) CC-PVDZ 0.9271944658 0.00 -0.4197943098
+ O dirac 0.00 0.00 1.2274
+ O dirac 0.00 0.00 0.00
+ H_1 DZSPNB 0.9271944658 0.00 -0.4197943098
+END GEOMETRY
+
+TASKS
+ method = "UHF"
+ nonOrthogonalConfigurationInteraction=.T.
+END TASKS
+
+CONTROL
+ computeROCIformula=.T.
+ rotationAroundZMaxAngle=40
+ rotationAroundZStep=5
+ numberOfCIStates=5
+ integralStorage="MEMORY"
+ readCoefficients=.F.
+END CONTROL
+
diff --git a/test/HOO+.ROCI-HF.py b/test/HOO+.ROCI-HF.py
new file mode 100644
index 00000000..482a5afc
--- /dev/null
+++ b/test/HOO+.ROCI-HF.py
@@ -0,0 +1,76 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [-149.774990836259,1E-8],
+"CI 1" : [-149.784025139570,1E-7],
+"CI 2" : [-149.783893009711,1E-7],
+"H_1 Kin 1" : [0.010857088555,1E-7],
+"H_1 Kin 2" : [0.010941452494,1E-7],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+stateFlag=0
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "STATE: 1 ENERGY =" in line:
+ testValues["CI 1"] = float(line.split()[4])
+ stateFlag=1
+ if "STATE: 2 ENERGY =" in line:
+ testValues["CI 2"] = float(line.split()[4])
+ stateFlag=2
+ if "H_1 Kinetic energy =" in line:
+ if stateFlag == 1:
+ testValues["H_1 Kin 1"] = float(line.split()[4])
+ elif stateFlag == 2:
+ testValues["H_1 Kin 2"] = float(line.split()[4])
+ break
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/He2-C60potential-NOCI.lowdin b/test/He2-C60potential-NOCI.lowdin
index c06d7379..4883911f 100644
--- a/test/He2-C60potential-NOCI.lowdin
+++ b/test/He2-C60potential-NOCI.lowdin
@@ -2,8 +2,8 @@ SYSTEM_DESCRIPTION='H'
GEOMETRY
N0 dirac 0.0 0.0 0.0 rotationPoint=1
-HEA3 HE2-1S 1.818207 0.0 -0.347193 rotateAround=1
-HEB3 HE2-1S -1.818207 0.0 0.347193 rotateAround=1
+HEA3 HE2-1S 1.818207 0.0 -0.347193 rotateAround=1 m=5494.8926
+HEB3 HE2-1S -1.818207 0.0 0.347193 rotateAround=1 m=5494.8926
END GEOMETRY
TASKS
diff --git a/test/He3-C60potential-NOCI.lowdin b/test/He3-C60potential-NOCI.lowdin
index 16870c5d..a5efe877 100644
--- a/test/He3-C60potential-NOCI.lowdin
+++ b/test/He3-C60potential-NOCI.lowdin
@@ -2,9 +2,9 @@ SYSTEM_DESCRIPTION='H'
GEOMETRY
N0 dirac 0.0 0.0 0.0 rotationPoint=1
-HEA3 HE2-1S 2.159 0.0 0.0 rotateAround=1
-HEA3 HE2-1S 0.0 2.159 0.0 rotateAround=1
-HEB3 HE2-1S 0.0 0.0 2.159 rotateAround=1
+HEA3 HE2-1S 2.159 0.0 0.0 rotateAround=1 m=5494.8926
+HEA3 HE2-1S 0.0 2.159 0.0 rotateAround=1 m=5494.8926
+HEB3 HE2-1S 0.0 0.0 2.159 rotateAround=1 m=5494.8926
END GEOMETRY
TASKS
diff --git a/test/HemuH-CUSTOM_BASIS.lowdin b/test/HemuH-CUSTOM_BASIS.lowdin
index 19b21087..27c3692a 100644
--- a/test/HemuH-CUSTOM_BASIS.lowdin
+++ b/test/HemuH-CUSTOM_BASIS.lowdin
@@ -2,9 +2,9 @@
GEOMETRY
e-[H] cc-pvtz 0.0000 0.0000 0.00000
e-[H] CUSTOM_1 0.0000 0.0000 0.74144
- H_1 CUSTOM_2 0.0000 0.0000 0.00000
- U- CUSTOM_3 0.0000 0.0000 0.74144
- He_4 CUSTOM_3 0.0000 0.0000 0.74144
+ H_1 CUSTOM_2 0.0000 0.0000 0.00000 m=1836.1527
+ U- CUSTOM_3 0.0000 0.0000 0.74144 m=206.7683
+ He_4 CUSTOM_3 0.0000 0.0000 0.74144 m=7349.6727
END GEOMETRY
TASKS
diff --git a/test/HemuH-CUSTOM_BASIS.py b/test/HemuH-CUSTOM_BASIS.py
index 7d461f17..44c69e98 100644
--- a/test/HemuH-CUSTOM_BASIS.py
+++ b/test/HemuH-CUSTOM_BASIS.py
@@ -15,11 +15,11 @@
# Reference values and tolerance
refValues = {
-"HF energy" : [-343.383191892820,1E-8],
-"U-HOMO" : [-371.890049816287,1E-1],
-"H_1-HOMO" : [-1.019360160964,1E-4],
-"He_4-HOMO" : [-652.366876763392,1E-1],
-"e-HOMO" : [-0.585414450602,1E-4],
+"HF energy" : [-343.383218426575,1E-8],
+"U-HOMO" : [-371.889981903188,1E-1],
+"H_1-HOMO" : [-1.019346186407,1E-4],
+"He_4-HOMO" : [-652.365841581870,1E-1],
+"e-HOMO" : [-0.585408097570,1E-4],
}
testValues = dict(refValues) #copy
diff --git a/test/Ps2F2.RHF-customEta.lowdin b/test/Ps2F2.RHF-customEta.lowdin
new file mode 100644
index 00000000..2484865d
--- /dev/null
+++ b/test/Ps2F2.RHF-customEta.lowdin
@@ -0,0 +1,17 @@
+GEOMETRY
+ e-(F) aug-cc-pvdz 0.00 0.00 -1.33 addParticles=1
+ e-(F) aug-cc-pvdz 0.00 0.00 1.33 addParticles=1
+ e+ PSX-DZ 0.00 0.00 -1.33 eta=2
+ e+ PSX-DZ 0.00 0.00 1.33
+ F dirac 0.00 0.00 -1.33
+ F dirac 0.00 0.00 1.33
+END GEOMETRY
+
+TASKS
+ method = "RHF"
+END TASKS
+
+CONTROL
+ readCoefficients=F
+END CONTROL
+
diff --git a/test/Ps2F2.RHF-customEta.py b/test/Ps2F2.RHF-customEta.py
new file mode 100644
index 00000000..a812ee62
--- /dev/null
+++ b/test/Ps2F2.RHF-customEta.py
@@ -0,0 +1,68 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+refValues = {
+ "HF energy" : [-199.213740198536,1E-8],
+ "eta e+" : [2.0,1E-8],
+ "occupation e+" : [1.0,1E-8]
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+flagC=0
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "CONSTANTS OF COUPLING" in line:
+ flagC=1
+ if "E+" in line and flagC==1:
+ testValues["eta e+"] = float(line.split()[2])
+ testValues["occupation e+"] = float(line.split()[4])
+ flagC=0
+output.close()
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/PsCl-B3LYP-PSNAP.lowdin b/test/PsCl-B3LYP-PSNAP.lowdin
new file mode 100644
index 00000000..668be420
--- /dev/null
+++ b/test/PsCl-B3LYP-PSNAP.lowdin
@@ -0,0 +1,20 @@
+SYSTEM_DESCRIPTION='Molecula de H2'
+
+GEOMETRY
+e-(Cl) AUG-CC-PVTZ 0.0000 0.00000 0.0000 addParticles=1
+e+ PSX-TZ 0.0000 0.00000 0.0000
+Cl dirac 0.0000 0.00000 0.0000
+END GEOMETRY
+
+TASKS
+method = "RKS"
+END TASKS
+
+CONTROL
+readCoefficients=.F.
+electronExchangeCorrelationFunctional="B3LYP"
+positronElectronCorrelationFunctional="PSNAP"
+END CONTROL
+
+
+
diff --git a/test/PsCl-B3LYP-PSNAP.py b/test/PsCl-B3LYP-PSNAP.py
new file mode 100644
index 00000000..fa1dd4e1
--- /dev/null
+++ b/test/PsCl-B3LYP-PSNAP.py
@@ -0,0 +1,62 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"KS energy" : [-460.482424811788,1E-6],
+"E+/E- Corr energy" : [-0.113810155630,1E-3],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["KS energy"] = float(line.split()[3])
+ if "E-/POSITRON Corr. energy =" in line:
+ testValues["E+/E- Corr energy"] = float(line.split()[4])
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/PsF.HF.densOrbPlots.lowdin b/test/PsF.HF.densOrbPlots.lowdin
index 01c72254..dd248385 100644
--- a/test/PsF.HF.densOrbPlots.lowdin
+++ b/test/PsF.HF.densOrbPlots.lowdin
@@ -13,12 +13,13 @@ CONTROL
readCoefficients=F
numberOfPointsPerDimension=1000
totalEnergyTolerance=1E-12
+ units="BOHRS"
END CONTROL
OUTPUTS
- densityPlot dimensions=2 point1=0.0 0.0 -10.0 point2= 0.0 0.0 10.0
- orbitalPlot dimensions=2 point1=0.0 0.0 -10.0 point2= 0.0 0.0 10.0 species="E+" orbital=1
- orbitalPlot dimensions=2 point1=0.0 0.0 -2.0 point2= 0.0 0.0 2.0 species="E-" orbital=2
+ densityPlot dimensions=2 point1=0.0 0.0 -20.0 point2= 0.0 0.0 20.0
+ orbitalPlot axis="z" limitZ=-20.0 20.0 species="E+" orbital=1 scanStep=0.005
+ orbitalPlot axis="x" limitX=0.0 10.0 species="E-" orbital=2 pointsPerDim=2000
END OUTPUTS
diff --git a/test/PsF.HF.densOrbPlots.py b/test/PsF.HF.densOrbPlots.py
index 5ee3e329..bd0eb6a5 100644
--- a/test/PsF.HF.densOrbPlots.py
+++ b/test/PsF.HF.densOrbPlots.py
@@ -13,17 +13,17 @@
inputName = testName + ".lowdin"
outputName = testName + ".out"
densplot1Name = testName + ".E-.2D.dens"
-densplot2Name = testName + ".POSITRON.2D.dens"
+densplot2Name = testName + ".E+.2D.dens"
orbplot1Name = testName + ".E-.2D.orb2"
-orbplot2Name = testName + ".POSITRON.2D.orb1"
+orbplot2Name = testName + ".E+.2D.orb1"
# Reference values and tolerance
refValues = {
"HF energy" : [-99.635031860198,1E-8],
-"Num e- in densplot" : [9.99830528,1E-3],
-"Num e- in orbplot" : [0.99956206,1E-3],
-"Num e+ in densplot" : [0.99999922,1E-5],
-"Num e+ in orbplot" : [0.99999921,1E-3],
+"Num e- in densplot" : [10.0,1E-2],
+"Num e- in orbplot" : [1.0,1E-2],
+"Num e+ in densplot" : [1.0,1E-3],
+"Num e+ in orbplot" : [1.0,1E-2],
}
testValues = dict(refValues) #copy
@@ -58,8 +58,8 @@
values = line.split()
if i == 3: x1=float(values[0])
if i == 4: x2=float(values[0])
- if len(values) > 1: sumE+=float(values[0])**2*float(values[1])
-testValues["Num e- in densplot"]=2.0*3.14159265359*sumE*(x2-x1)
+ if len(values) > 1 and float(values[0]) > 0.0 : sumE+=float(values[0])**2*float(values[1])
+testValues["Num e- in densplot"]=4.0*3.14159265359*sumE*(x2-x1)
densplot1.close()
densplot2 = open(densplot2Name, "r")
@@ -71,8 +71,8 @@
values = line.split()
if i == 3: x1=float(values[0])
if i == 4: x2=float(values[0])
- if len(values) > 1: sumP+=float(values[0])**2*float(values[1])
-testValues["Num e+ in densplot"]=2.0*3.14159265359*sumP*(x2-x1)
+ if len(values) > 1 and float(values[0]) > 0.0 : sumP+=float(values[0])**2*float(values[1])
+testValues["Num e+ in densplot"]=4.0*3.14159265359*sumP*(x2-x1)
densplot2.close()
orbplot1 = open(orbplot1Name, "r")
@@ -84,8 +84,8 @@
values = line.split()
if i == 3: x1=float(values[0])
if i == 4: x2=float(values[0])
- if len(values) > 1: sumE+=float(values[0])**2*float(values[1])**2
-testValues["Num e- in orbplot"]=2.0*3.14159265359*sumE*(x2-x1)
+ if len(values) > 1 and float(values[0]) > 0.0 : sumE+=float(values[0])**2*float(values[1])**2
+testValues["Num e- in orbplot"]=4.0*3.14159265359*sumE*(x2-x1)
orbplot1.close()
orbplot2 = open(orbplot2Name, "r")
@@ -97,8 +97,8 @@
values = line.split()
if i == 3: x1=float(values[0])
if i == 4: x2=float(values[0])
- if len(values) > 1: sumP+=float(values[0])**2*float(values[1])**2
-testValues["Num e+ in orbplot"]=2.0*3.14159265359*sumP*(x2-x1)
+ if len(values) > 1 and float(values[0]) > 0.0 : sumP+=float(values[0])**2*float(values[1])**2
+testValues["Num e+ in orbplot"]=4.0*3.14159265359*sumP*(x2-x1)
orbplot2.close()
passTest = True
diff --git a/test/PsF2.CISD+molden.py b/test/PsF2.CISD+molden.py
index 7a7941ba..5aaec76b 100644
--- a/test/PsF2.CISD+molden.py
+++ b/test/PsF2.CISD+molden.py
@@ -14,7 +14,7 @@
outputName = testName + ".out"
molden1Name = testName + ".E-ALPHA.molden"
molden2Name = testName + ".E-BETA.molden"
-molden3Name = testName + ".POSITRON.molden"
+molden3Name = testName + ".E+.molden"
# Reference values and tolerance
refValues = {
diff --git a/test/PsH.SCI.lowdin b/test/PsH.SCI.lowdin
new file mode 100644
index 00000000..77ee9bc5
--- /dev/null
+++ b/test/PsH.SCI.lowdin
@@ -0,0 +1,35 @@
+GEOMETRY
+ e-(H) SHARON-E-6S2P 0.00 0.00 0.00 addParticles=1
+ H dirac 0.00 0.00 0.00
+ e+ SHARON-E+6S2P 0.00 0.00 0.00
+END GEOMETRY
+
+TASKS
+ method = "UHF"
+ configurationInteractionLevel ="SCI"
+ !configurationInteractionLevel ="CISD"
+END TASKS
+
+CONTROL
+ readCoefficients=F
+ numberOfCIstates=1
+ CINaturalOrbitals=T
+ CIStatesToPrint = 1
+ CIdiagonalizationMethod = "JADAMILU"
+ !CIPrintEigenVectorsFormat = "NONE"
+ !CIPrintEigenVectorsFormat = "OCCUPIED"
+ !CIPrintEigenVectorsFormat = "ORBITALS"
+ !CIPrintThreshold = 5e-2
+ buildTwoParticlesMatrixForOneParticle=T
+ CISCICoreSpace = 100
+ CISCITargetSpace = 500
+ CIMatVecTolerance = 1e-10
+ HFprintEigenVectors = "ALL"
+END CONTROL
+
+INPUT_CI
+ species="E-ALPHA" core=0 active=0
+ species="E-BETA" core=0 active=0
+ species="POSITRON" core=0 active=0
+END INPUT_CI
+
diff --git a/test/PsH.SCI.py b/test/PsH.SCI.py
new file mode 100644
index 00000000..a98410a8
--- /dev/null
+++ b/test/PsH.SCI.py
@@ -0,0 +1,63 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [-0.666783062050,1E-8],
+"E_SCI+PT2" : [-0.743335783194,1E-6],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "E_SCI + E_PT2 :" in line:
+ testValues["E_SCI+PT2"] = float(line.split()[4])
+
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/PsH2.FCI.EField.lowdin b/test/PsH2.FCI.EField.lowdin
new file mode 100644
index 00000000..6678957f
--- /dev/null
+++ b/test/PsH2.FCI.EField.lowdin
@@ -0,0 +1,36 @@
+GEOMETRY
+ e-(H) SHARON-E-6S2P 0.00 0.00 0.00 addParticles=2
+ e-(H) SHARON-E-6S2P 0.00 0.00 3.20
+ H dirac 0.00 0.00 0.00
+ H dirac 0.00 0.00 3.20
+ e+A SHARON-E+6S2P 0.00 0.00 0.00 addParticles=-1
+ e+A SHARON-E+6S2P 0.00 0.00 3.20
+ e+B SHARON-E+6S2P 0.00 0.00 0.00 addParticles=-1
+ e+B SHARON-E+6S2P 0.00 0.00 3.20
+END GEOMETRY
+
+TASKS
+ method = "UHF"
+ configurationInteractionLevel ="CISD"
+END TASKS
+
+CONTROL
+ buildMixedDensityMatrix = T
+ numberOfCIstates=1
+ !CINaturalOrbitals=T
+ CIStatesToPrint = 1
+ CIdiagonalizationMethod = "JADAMILU"
+ !buildTwoParticlesMatrixForOneParticle=T
+ integralsTransformationMethod = "E"
+ electricField = 0.00 0.00 0.001
+! multipoleOrder = 1
+ readCoefficients=F
+ CIConvergence = 1e-6 !! 1e-4 for energies, 1e-6 for dipole
+END CONTROL
+
+INPUT_CI
+ species="E-ALPHA" core=0 active=0
+ species="E-BETA" core=0 active=0
+ species="E+A" core=0 active=0
+ species="E+B" core=0 active=0
+END INPUT_CI
diff --git a/test/PsH2.FCI.EField.py b/test/PsH2.FCI.EField.py
new file mode 100644
index 00000000..46fffae7
--- /dev/null
+++ b/test/PsH2.FCI.EField.py
@@ -0,0 +1,80 @@
+#!/usr/bin/env python
+from __future__ import print_function
+import os
+import sys
+from colorstring import *
+
+if len(sys.argv)==2:
+ lowdinbin = sys.argv[1]
+else:
+ lowdinbin = "lowdin2"
+
+testName = sys.argv[0][:-3]
+inputName = testName + ".lowdin"
+outputName = testName + ".out"
+
+# Reference values and tolerance
+
+refValues = {
+"HF energy" : [-1.330593653938,1E-8],
+"CI 1" : [-1.472334104068,1E-8],
+"HF dipole" : [0.35853379,1E-7],
+"CI dipole" : [0.27625290,1E-4],
+}
+
+testValues = dict(refValues) #copy
+for value in testValues: #reset
+ testValues[value] = 0 #reset
+
+# Run calculation
+
+status = os.system(lowdinbin + " -i " + inputName)
+
+if status:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output = open(outputName, "r")
+outputRead = output.readlines()
+HF_prop = True
+
+# Values
+for i in range(0,len(outputRead)):
+ line = outputRead[i]
+ if "TOTAL ENERGY =" in line:
+ testValues["HF energy"] = float(line.split()[3])
+ if "STATE: 1 ENERGY =" in line:
+ testValues["CI 1"] = float(line.split()[4])
+
+ if "DIPOLE: (A.U.)" in line and HF_prop:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["HF dipole"] = float(linej.split()[5])
+ HF_prop = False
+ break
+
+ if "DIPOLE: (A.U.)" in line and not HF_prop:
+ for j in range (i,len(outputRead)) :
+ linej = outputRead[j]
+ if "Total Dipole:" in linej:
+ testValues["CI dipole"] = float(linej.split()[5])
+ break
+
+passTest = True
+
+for value in refValues:
+ diffValue = abs(refValues[value][0] - testValues[value])
+ if ( diffValue <= refValues[value][1] ):
+ passTest = passTest * True
+ else :
+ passTest = passTest * False
+ print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue))
+
+if passTest :
+ print(testName + str_green(" ... OK"))
+else:
+ print(testName + str_red(" ... NOT OK"))
+ sys.exit(1)
+
+output.close()
diff --git a/test/PsOH.HF.densOrbPlots.lowdin b/test/PsOH.HF.densOrbPlots.lowdin
index 0cf90678..98db0165 100644
--- a/test/PsOH.HF.densOrbPlots.lowdin
+++ b/test/PsOH.HF.densOrbPlots.lowdin
@@ -19,10 +19,10 @@ CONTROL
END CONTROL
OUTPUTS
- densityPlot dimensions=3 point1=0.0 -1.5 -1.5 point2= 0.0 1.5 -1.5 point3= 0.0 -1.5 1.5 species="E-"
+ densityPlot plane="xz" limitX=-1.5 1.5 limitZ=-1.5 2.0 species="E-" scanStep=0.01
orbitalPlot dimensions=3 point1=0.0 -2.0 -2.0 point2= 0.0 2.0 -2.0 point3= 0.0 -2.0 2.0 species="E-" orbital=3
densityPlot dimensions=3 point1=0.0 -5.0 -5.0 point2= 0.0 5.0 -5.0 point3= 0.0 -5.0 5.0 species="E+"
- orbitalPlot dimensions=3 point1=0.0 -5.0 -5.0 point2= 0.0 5.0 -5.0 point3= 0.0 -5.0 5.0 species="E+" orbital=1
+ orbitalPlot plane="yz" limitY=-5.0 5.0 limitZ=-5.0 5.0 species="E+" orbital=1
END OUTPUTS
diff --git a/test/PsOH.HF.densOrbPlots.py b/test/PsOH.HF.densOrbPlots.py
index e79be372..3b90de74 100644
--- a/test/PsOH.HF.densOrbPlots.py
+++ b/test/PsOH.HF.densOrbPlots.py
@@ -13,17 +13,17 @@
inputName = testName + ".lowdin"
outputName = testName + ".out"
densplot1Name = testName + ".E-.3D.dens"
-densplot2Name = testName + ".POSITRON.3D.dens"
+densplot2Name = testName + ".E+.3D.dens"
orbplot1Name = testName + ".E-.3D.orb3"
-orbplot2Name = testName + ".POSITRON.3D.orb1"
+orbplot2Name = testName + ".E+.3D.orb1"
# Reference values and tolerance
refValues = {
"HF energy" : [-75.587683637788,1E-8],
-"Num e- in densplot" : [10.37978910220915,1E-1],
-"Num e- in orbplot" : [1.7211264610474177,1E-1],
-"Num e+ in densplot" : [0.9870409056582871,1E-2],
-"Num e+ in orbplot" : [0.9870409056980444,1E-2],
+"Num e- in densplot" : [10.0,1E-0],
+"Num e- in orbplot" : [2.0,5E-1],
+"Num e+ in densplot" : [1.0,5E-2],
+"Num e+ in orbplot" : [1.0,5E-2],
}
testValues = dict(refValues) #copy
diff --git a/test/TIP4P-dimer-singlet-NOCI.lowdin b/test/TIP4P-dimer-singlet-NOCI.lowdin
index d886158d..213f2093 100644
--- a/test/TIP4P-dimer-singlet-NOCI.lowdin
+++ b/test/TIP4P-dimer-singlet-NOCI.lowdin
@@ -2,12 +2,12 @@ SYSTEM_DESCRIPTION='H'
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 translationCenter=1
-Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 translationCenter=2
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 translationCenter=1 q=0.5564 m=1836.15267247
+Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 translationCenter=2 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -36,3 +36,452 @@ INTERPOTENTIAL
X0.5+ Y0.5+ VHH-CCSDT
Y0.5+ Y0.5+ VHH-CCSDT
END INTERPOTENTIAL
+
+EXTERPOTENTIAL
+ X0.5+ VOH-CCSDT
+ Y0.5+ VOH-CCSDT
+END EXTERPOTENTIAL
+
+INTERPOTENTIAL
+ X0.5+ X0.5+ VHH-CCSDT
+ X0.5+ Y0.5+ VHH-CCSDT
+ Y0.5+ Y0.5+ VHH-CCSDT
+END INTERPOTENTIAL
+
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+
+O-H-TIP Y0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+
+O-Y0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-X0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-Y0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-singlet-direct.lowdin b/test/TIP4P-dimer-singlet-direct.lowdin
index 9e5e2eaa..3788cc16 100644
--- a/test/TIP4P-dimer-singlet-direct.lowdin
+++ b/test/TIP4P-dimer-singlet-direct.lowdin
@@ -1,11 +1,11 @@
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200
-Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 q=0.5564 m=1836.15267247
+Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -31,3 +31,440 @@ INTERPOTENTIAL
Y0.5+ Y0.5+ VHH-CCSDT
END INTERPOTENTIAL
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+
+O-H-TIP Y0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+
+O-Y0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-X0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-Y0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-singlet-direct.py b/test/TIP4P-dimer-singlet-direct.py
index f3b406ea..bc41eaa3 100644
--- a/test/TIP4P-dimer-singlet-direct.py
+++ b/test/TIP4P-dimer-singlet-direct.py
@@ -17,11 +17,11 @@
refValues = {
"HF energy" : [-0.651377267238,1E-8],
-"HA-TIP Ext Pot" : [0.005339817047,1E-4],
-"HB-TIP Ext Pot" : [0.005265789260,1E-4],
-"HA-TIP/HB-TIP Hartree" : [0.003393498016,1E-4],
-"HA-TIP/Fixed interact." : [-0.025239485153,1E-4],
-"HB-TIP/Fixed interact." : [-0.010156190638,1E-4]
+"X0.5+ Ext Pot" : [0.005339817047,1E-4],
+"Y0.5+ Ext Pot" : [0.005265789260,1E-4],
+"X0.5+/Y0.5+ Hartree" : [0.003393498016,1E-4],
+"X0.5+/Fixed interact." : [-0.025239485153,1E-4],
+"Y0.5+/Fixed interact." : [-0.010156190638,1E-4]
}
testValues = dict(refValues) #copy
@@ -44,16 +44,16 @@
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
- if "HA-TIP Ext Pot" in line:
- testValues["HA-TIP Ext Pot"] = float(line.split()[5])
- if "HB-TIP Ext Pot" in line:
- testValues["HB-TIP Ext Pot"] = float(line.split()[5])
- if "HA-TIP/HB-TIP Hartree" in line:
- testValues["HA-TIP/HB-TIP Hartree"] = float(line.split()[4])
- if "HA-TIP/Fixed interact." in line:
- testValues["HA-TIP/Fixed interact."] = float(line.split()[4])
- if "HB-TIP/Fixed interact." in line:
- testValues["HB-TIP/Fixed interact."] = float(line.split()[4])
+ if "X0.5+ Ext Pot" in line:
+ testValues["X0.5+ Ext Pot"] = float(line.split()[5])
+ if "Y0.5+ Ext Pot" in line:
+ testValues["Y0.5+ Ext Pot"] = float(line.split()[5])
+ if "X0.5+/Y0.5+ Hartree" in line:
+ testValues["X0.5+/Y0.5+ Hartree"] = float(line.split()[4])
+ if "X0.5+/Fixed interact." in line:
+ testValues["X0.5+/Fixed interact."] = float(line.split()[4])
+ if "Y0.5+/Fixed interact." in line:
+ testValues["Y0.5+/Fixed interact."] = float(line.split()[4])
passTest = True
diff --git a/test/TIP4P-dimer-singlet-memory.lowdin b/test/TIP4P-dimer-singlet-memory.lowdin
index bc275bf3..1dc863f5 100644
--- a/test/TIP4P-dimer-singlet-memory.lowdin
+++ b/test/TIP4P-dimer-singlet-memory.lowdin
@@ -1,11 +1,11 @@
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200
-Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 q=0.5564 m=1836.15267247
+Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -31,3 +31,440 @@ INTERPOTENTIAL
Y0.5+ Y0.5+ VHH-CCSDT
END INTERPOTENTIAL
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+
+O-H-TIP Y0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+
+O-Y0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-X0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-Y0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-singlet-memory.py b/test/TIP4P-dimer-singlet-memory.py
index f3b406ea..bc41eaa3 100644
--- a/test/TIP4P-dimer-singlet-memory.py
+++ b/test/TIP4P-dimer-singlet-memory.py
@@ -17,11 +17,11 @@
refValues = {
"HF energy" : [-0.651377267238,1E-8],
-"HA-TIP Ext Pot" : [0.005339817047,1E-4],
-"HB-TIP Ext Pot" : [0.005265789260,1E-4],
-"HA-TIP/HB-TIP Hartree" : [0.003393498016,1E-4],
-"HA-TIP/Fixed interact." : [-0.025239485153,1E-4],
-"HB-TIP/Fixed interact." : [-0.010156190638,1E-4]
+"X0.5+ Ext Pot" : [0.005339817047,1E-4],
+"Y0.5+ Ext Pot" : [0.005265789260,1E-4],
+"X0.5+/Y0.5+ Hartree" : [0.003393498016,1E-4],
+"X0.5+/Fixed interact." : [-0.025239485153,1E-4],
+"Y0.5+/Fixed interact." : [-0.010156190638,1E-4]
}
testValues = dict(refValues) #copy
@@ -44,16 +44,16 @@
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
- if "HA-TIP Ext Pot" in line:
- testValues["HA-TIP Ext Pot"] = float(line.split()[5])
- if "HB-TIP Ext Pot" in line:
- testValues["HB-TIP Ext Pot"] = float(line.split()[5])
- if "HA-TIP/HB-TIP Hartree" in line:
- testValues["HA-TIP/HB-TIP Hartree"] = float(line.split()[4])
- if "HA-TIP/Fixed interact." in line:
- testValues["HA-TIP/Fixed interact."] = float(line.split()[4])
- if "HB-TIP/Fixed interact." in line:
- testValues["HB-TIP/Fixed interact."] = float(line.split()[4])
+ if "X0.5+ Ext Pot" in line:
+ testValues["X0.5+ Ext Pot"] = float(line.split()[5])
+ if "Y0.5+ Ext Pot" in line:
+ testValues["Y0.5+ Ext Pot"] = float(line.split()[5])
+ if "X0.5+/Y0.5+ Hartree" in line:
+ testValues["X0.5+/Y0.5+ Hartree"] = float(line.split()[4])
+ if "X0.5+/Fixed interact." in line:
+ testValues["X0.5+/Fixed interact."] = float(line.split()[4])
+ if "Y0.5+/Fixed interact." in line:
+ testValues["Y0.5+/Fixed interact."] = float(line.split()[4])
passTest = True
diff --git a/test/TIP4P-dimer-singlet.lowdin b/test/TIP4P-dimer-singlet.lowdin
index 9d540025..7ffc1cfe 100644
--- a/test/TIP4P-dimer-singlet.lowdin
+++ b/test/TIP4P-dimer-singlet.lowdin
@@ -1,11 +1,11 @@
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200
-Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 q=0.5564 m=1836.15267247
+Y0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -31,3 +31,440 @@ INTERPOTENTIAL
Y0.5+ Y0.5+ VHH-CCSDT
END INTERPOTENTIAL
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+
+O-H-TIP Y0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+
+O-Y0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-X0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-Y0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-singlet.py b/test/TIP4P-dimer-singlet.py
index f3b406ea..bc41eaa3 100644
--- a/test/TIP4P-dimer-singlet.py
+++ b/test/TIP4P-dimer-singlet.py
@@ -17,11 +17,11 @@
refValues = {
"HF energy" : [-0.651377267238,1E-8],
-"HA-TIP Ext Pot" : [0.005339817047,1E-4],
-"HB-TIP Ext Pot" : [0.005265789260,1E-4],
-"HA-TIP/HB-TIP Hartree" : [0.003393498016,1E-4],
-"HA-TIP/Fixed interact." : [-0.025239485153,1E-4],
-"HB-TIP/Fixed interact." : [-0.010156190638,1E-4]
+"X0.5+ Ext Pot" : [0.005339817047,1E-4],
+"Y0.5+ Ext Pot" : [0.005265789260,1E-4],
+"X0.5+/Y0.5+ Hartree" : [0.003393498016,1E-4],
+"X0.5+/Fixed interact." : [-0.025239485153,1E-4],
+"Y0.5+/Fixed interact." : [-0.010156190638,1E-4]
}
testValues = dict(refValues) #copy
@@ -44,16 +44,16 @@
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
- if "HA-TIP Ext Pot" in line:
- testValues["HA-TIP Ext Pot"] = float(line.split()[5])
- if "HB-TIP Ext Pot" in line:
- testValues["HB-TIP Ext Pot"] = float(line.split()[5])
- if "HA-TIP/HB-TIP Hartree" in line:
- testValues["HA-TIP/HB-TIP Hartree"] = float(line.split()[4])
- if "HA-TIP/Fixed interact." in line:
- testValues["HA-TIP/Fixed interact."] = float(line.split()[4])
- if "HB-TIP/Fixed interact." in line:
- testValues["HB-TIP/Fixed interact."] = float(line.split()[4])
+ if "X0.5+ Ext Pot" in line:
+ testValues["X0.5+ Ext Pot"] = float(line.split()[5])
+ if "Y0.5+ Ext Pot" in line:
+ testValues["Y0.5+ Ext Pot"] = float(line.split()[5])
+ if "X0.5+/Y0.5+ Hartree" in line:
+ testValues["X0.5+/Y0.5+ Hartree"] = float(line.split()[4])
+ if "X0.5+/Fixed interact." in line:
+ testValues["X0.5+/Fixed interact."] = float(line.split()[4])
+ if "Y0.5+/Fixed interact." in line:
+ testValues["Y0.5+/Fixed interact."] = float(line.split()[4])
passTest = True
diff --git a/test/TIP4P-dimer-triplet-NOCI.lowdin b/test/TIP4P-dimer-triplet-NOCI.lowdin
index b8411434..8a88242a 100644
--- a/test/TIP4P-dimer-triplet-NOCI.lowdin
+++ b/test/TIP4P-dimer-triplet-NOCI.lowdin
@@ -2,12 +2,12 @@ SYSTEM_DESCRIPTION='H'
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 translationCenter=1
-X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 translationCenter=2
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 translationCenter=1 q=0.5564 m=1836.15267247
+X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 translationCenter=2 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -33,3 +33,441 @@ END EXTERPOTENTIAL
INTERPOTENTIAL
X0.5+ X0.5+ VHH-CCSDT
END INTERPOTENTIAL
+
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+
+O-H-TIP Y0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+
+O-Y0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-X0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+
+O-Y0.5+Y0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-triplet-direct.lowdin b/test/TIP4P-dimer-triplet-direct.lowdin
index 15ab0abb..2db120e6 100644
--- a/test/TIP4P-dimer-triplet-direct.lowdin
+++ b/test/TIP4P-dimer-triplet-direct.lowdin
@@ -1,11 +1,11 @@
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200
-X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 q=0.5564 m=1836.15267247
+X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -28,3 +28,186 @@ INTERPOTENTIAL
X0.5+ X0.5+ VHH-CCSDT
END INTERPOTENTIAL
+
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-triplet-direct.py b/test/TIP4P-dimer-triplet-direct.py
index 41f2ebc4..d13b500b 100644
--- a/test/TIP4P-dimer-triplet-direct.py
+++ b/test/TIP4P-dimer-triplet-direct.py
@@ -17,10 +17,10 @@
refValues = {
"HF energy" : [-0.651377261423,1E-8],
- "HA-TIP Ext Pot" : [0.010606635479,1E-4],
- "HA-TIP/HA-TIP Hartree" : [1.217813835967,1E-4],
- "HA-TIP Exchange" : [-1.214419735313,1E-4],
- "HA-TIP/Fixed interact." : [-0.035396418562,1E-4]
+ "X0.5+ Ext Pot" : [0.010606635479,1E-4],
+ "X0.5+/X0.5+ Hartree" : [1.217813835967,1E-4],
+ "X0.5+ Exchange" : [-1.214419735313,1E-4],
+ "X0.5+/Fixed interact." : [-0.035396418562,1E-4]
}
testValues = dict(refValues) #copy
@@ -43,14 +43,14 @@
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
- if "HA-TIP Ext Pot" in line:
- testValues["HA-TIP Ext Pot"] = float(line.split()[5])
- if "HA-TIP/HA-TIP Hartree" in line:
- testValues["HA-TIP/HA-TIP Hartree"] = float(line.split()[4])
- if "HA-TIP Exchange" in line:
- testValues["HA-TIP Exchange"] = float(line.split()[4])
- if "HA-TIP/Fixed interact." in line:
- testValues["HA-TIP/Fixed interact."] = float(line.split()[4])
+ if "X0.5+ Ext Pot" in line:
+ testValues["X0.5+ Ext Pot"] = float(line.split()[5])
+ if "X0.5+/X0.5+ Hartree" in line:
+ testValues["X0.5+/X0.5+ Hartree"] = float(line.split()[4])
+ if "X0.5+ Exchange" in line:
+ testValues["X0.5+ Exchange"] = float(line.split()[4])
+ if "X0.5+/Fixed interact." in line:
+ testValues["X0.5+/Fixed interact."] = float(line.split()[4])
passTest = True
diff --git a/test/TIP4P-dimer-triplet-memory.lowdin b/test/TIP4P-dimer-triplet-memory.lowdin
index c37e1e48..5d36490e 100644
--- a/test/TIP4P-dimer-triplet-memory.lowdin
+++ b/test/TIP4P-dimer-triplet-memory.lowdin
@@ -1,11 +1,11 @@
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200
-X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 q=0.5564 m=1836.15267247
+X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -28,3 +28,194 @@ INTERPOTENTIAL
X0.5+ X0.5+ VHH-CCSDT
END INTERPOTENTIAL
+EXTERPOTENTIAL
+ X0.5+ VOH-CCSDT
+END EXTERPOTENTIAL
+
+INTERPOTENTIAL
+ X0.5+ X0.5+ VHH-CCSDT
+END INTERPOTENTIAL
+
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-triplet-memory.py b/test/TIP4P-dimer-triplet-memory.py
index 41f2ebc4..d13b500b 100644
--- a/test/TIP4P-dimer-triplet-memory.py
+++ b/test/TIP4P-dimer-triplet-memory.py
@@ -17,10 +17,10 @@
refValues = {
"HF energy" : [-0.651377261423,1E-8],
- "HA-TIP Ext Pot" : [0.010606635479,1E-4],
- "HA-TIP/HA-TIP Hartree" : [1.217813835967,1E-4],
- "HA-TIP Exchange" : [-1.214419735313,1E-4],
- "HA-TIP/Fixed interact." : [-0.035396418562,1E-4]
+ "X0.5+ Ext Pot" : [0.010606635479,1E-4],
+ "X0.5+/X0.5+ Hartree" : [1.217813835967,1E-4],
+ "X0.5+ Exchange" : [-1.214419735313,1E-4],
+ "X0.5+/Fixed interact." : [-0.035396418562,1E-4]
}
testValues = dict(refValues) #copy
@@ -43,14 +43,14 @@
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
- if "HA-TIP Ext Pot" in line:
- testValues["HA-TIP Ext Pot"] = float(line.split()[5])
- if "HA-TIP/HA-TIP Hartree" in line:
- testValues["HA-TIP/HA-TIP Hartree"] = float(line.split()[4])
- if "HA-TIP Exchange" in line:
- testValues["HA-TIP Exchange"] = float(line.split()[4])
- if "HA-TIP/Fixed interact." in line:
- testValues["HA-TIP/Fixed interact."] = float(line.split()[4])
+ if "X0.5+ Ext Pot" in line:
+ testValues["X0.5+ Ext Pot"] = float(line.split()[5])
+ if "X0.5+/X0.5+ Hartree" in line:
+ testValues["X0.5+/X0.5+ Hartree"] = float(line.split()[4])
+ if "X0.5+ Exchange" in line:
+ testValues["X0.5+ Exchange"] = float(line.split()[4])
+ if "X0.5+/Fixed interact." in line:
+ testValues["X0.5+/Fixed interact."] = float(line.split()[4])
passTest = True
diff --git a/test/TIP4P-dimer-triplet.lowdin b/test/TIP4P-dimer-triplet.lowdin
index 75996651..18fd85c8 100644
--- a/test/TIP4P-dimer-triplet.lowdin
+++ b/test/TIP4P-dimer-triplet.lowdin
@@ -1,11 +1,11 @@
GEOMETRY
N0 dirac 0 0 0
-X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200
-X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570
+X0.5+ H2O-1S1P1D -0.151399 0.000276 1.807200 q=0.5564 m=1836.15267247
+X0.5+ H2O-1S1P1D -1.715032 0.000843 -0.589570 q=0.5564 m=1836.15267247
N0 dirac 0.0 0.0 6.0
-X1.1- dirac 0.0 0.0 6.292152
-X0.5+ dirac 0.0 1.430429 7.107157
-X0.5+ dirac 0.0 -1.430429 7.107157
+X1.1- dirac 0.0 0.0 6.292152 q=-1.1128
+X0.5+ dirac 0.0 1.430429 7.107157 q=0.5564
+X0.5+ dirac 0.0 -1.430429 7.107157 q=0.5564
END GEOMETRY
TASKS
@@ -28,3 +28,186 @@ INTERPOTENTIAL
X0.5+ X0.5+ VHH-CCSDT
END INTERPOTENTIAL
+
+BASIS H2O-1S1P1D
+#optimized exponents
+O-H-TIP X0.5+ (1S) BASIS TYPE: 2
+3
+1 0 1
+14.509888498676842 1.0
+2 1 1
+6.885507269761004 1.0
+3 2 1
+9.023681376783887 1.0
+END BASIS
+
+POTENTIAL VOH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant RHH
+O-X0.5+
+27
+1 0
+13.892336977 9.839539381
+0.0 0.0 0.0
+2 0
+10.000000000 15.916259785
+0.0 0.0 0.0
+3 0
+7.498942093 -18.199008237
+0.0 0.0 0.0
+4 0
+5.623413252 6.723316202
+0.0 0.0 0.0
+5 0
+4.216965034 4.671467422
+0.0 0.0 0.0
+6 0
+3.162277660 1.703771884
+0.0 0.0 0.0
+7 0
+2.371373706 0.297676262
+0.0 0.0 0.0
+8 0
+1.778279410 0.967600283
+0.0 0.0 0.0
+9 0
+1.333521432 1.034932150
+0.0 0.0 0.0
+10 0
+1.000000000 0.657621305
+0.0 0.0 0.0
+11 0
+0.749894209 -0.327381267
+0.0 0.0 0.0
+12 0
+0.562341325 0.221528399
+0.0 0.0 0.0
+13 0
+0.421696503 -0.255694044
+0.0 0.0 0.0
+14 0
+0.316227766 0.097853405
+0.0 0.0 0.0
+15 0
+0.237137371 0.744489008
+0.0 0.0 0.0
+16 0
+0.177827941 -0.750090202
+0.0 0.0 0.0
+17 0
+0.133352143 -0.309090719
+0.0 0.0 0.0
+18 0
+0.100000000 -0.998800172
+0.0 0.0 0.0
+19 0
+0.074989421 0.718795407
+0.0 0.0 0.0
+20 0
+0.056234133 0.228002288
+0.0 0.0 0.0
+21 0
+0.042169650 0.573744431
+0.0 0.0 0.0
+22 0
+0.031622777 -0.056969092
+0.0 0.0 0.0
+23 0
+0.023713737 -0.392241803
+0.0 0.0 0.0
+24 0
+0.017782794 -0.569609681
+0.0 0.0 0.0
+25 0
+0.013335214 0.759323484
+0.0 0.0 0.0
+26 0
+0.010000000 -0.194525832
+0.0 0.0 0.0
+27 0
+0.000000000 0.138912412
+0.0 0.0 0.0
+END POTENTIAL
+
+POTENTIAL VHH-CCSDT
+#Fitted from CCSD(T)/def2-TZVPPD with constant ROH
+O-X0.5+X0.5+
+26
+1 0
+10.000000000 1.313644267
+0.0 0.0 0.0
+2 0
+7.498942093 3.312208762
+0.0 0.0 0.0
+3 0
+5.623413252 -4.290599715
+0.0 0.0 0.0
+4 0
+4.216965034 -2.400490962
+0.0 0.0 0.0
+5 0
+3.162277660 6.160643793
+0.0 0.0 0.0
+6 0
+2.371373706 2.406172066
+0.0 0.0 0.0
+7 0
+1.778279410 -6.852617537
+0.0 0.0 0.0
+8 0
+1.333521432 -1.043562213
+0.0 0.0 0.0
+9 0
+1.000000000 7.556790649
+0.0 0.0 0.0
+10 0
+0.749894209 0.777037995
+0.0 0.0 0.0
+11 0
+0.562341325 -8.976316536
+0.0 0.0 0.0
+12 0
+0.421696503 0.575296040
+0.0 0.0 0.0
+13 0
+0.316227766 8.672468936
+0.0 0.0 0.0
+14 0
+0.237137371 -0.855388714
+0.0 0.0 0.0
+15 0
+0.177827941 -6.271012179
+0.0 0.0 0.0
+16 0
+0.133352143 1.152328020
+0.0 0.0 0.0
+17 0
+0.100000000 3.403807143
+0.0 0.0 0.0
+18 0
+0.074989421 -1.745300340
+0.0 0.0 0.0
+19 0
+0.056234133 -1.349326021
+0.0 0.0 0.0
+20 0
+0.042169650 1.605561812
+0.0 0.0 0.0
+21 0
+0.031622777 -0.267553445
+0.0 0.0 0.0
+22 0
+0.023713737 0.034566428
+0.0 0.0 0.0
+23 0
+0.017782794 -0.185356609
+0.0 0.0 0.0
+24 0
+0.013335214 -0.103128899
+0.0 0.0 0.0
+25 0
+0.010000000 0.128087663
+0.0 0.0 0.0
+26 0
+0.000000000 0.085213897
+0.0 0.0 0.0
+END POTENTIAL
diff --git a/test/TIP4P-dimer-triplet.py b/test/TIP4P-dimer-triplet.py
index 41f2ebc4..d13b500b 100644
--- a/test/TIP4P-dimer-triplet.py
+++ b/test/TIP4P-dimer-triplet.py
@@ -17,10 +17,10 @@
refValues = {
"HF energy" : [-0.651377261423,1E-8],
- "HA-TIP Ext Pot" : [0.010606635479,1E-4],
- "HA-TIP/HA-TIP Hartree" : [1.217813835967,1E-4],
- "HA-TIP Exchange" : [-1.214419735313,1E-4],
- "HA-TIP/Fixed interact." : [-0.035396418562,1E-4]
+ "X0.5+ Ext Pot" : [0.010606635479,1E-4],
+ "X0.5+/X0.5+ Hartree" : [1.217813835967,1E-4],
+ "X0.5+ Exchange" : [-1.214419735313,1E-4],
+ "X0.5+/Fixed interact." : [-0.035396418562,1E-4]
}
testValues = dict(refValues) #copy
@@ -43,14 +43,14 @@
line = outputRead[i]
if "TOTAL ENERGY =" in line:
testValues["HF energy"] = float(line.split()[3])
- if "HA-TIP Ext Pot" in line:
- testValues["HA-TIP Ext Pot"] = float(line.split()[5])
- if "HA-TIP/HA-TIP Hartree" in line:
- testValues["HA-TIP/HA-TIP Hartree"] = float(line.split()[4])
- if "HA-TIP Exchange" in line:
- testValues["HA-TIP Exchange"] = float(line.split()[4])
- if "HA-TIP/Fixed interact." in line:
- testValues["HA-TIP/Fixed interact."] = float(line.split()[4])
+ if "X0.5+ Ext Pot" in line:
+ testValues["X0.5+ Ext Pot"] = float(line.split()[5])
+ if "X0.5+/X0.5+ Hartree" in line:
+ testValues["X0.5+/X0.5+ Hartree"] = float(line.split()[4])
+ if "X0.5+ Exchange" in line:
+ testValues["X0.5+ Exchange"] = float(line.split()[4])
+ if "X0.5+/Fixed interact." in line:
+ testValues["X0.5+/Fixed interact."] = float(line.split()[4])
passTest = True
diff --git a/test/ci-test/H-.cisd.lowdin b/test/ci-test/H-.cisd.lowdin
deleted file mode 100644
index 06120869..00000000
--- a/test/ci-test/H-.cisd.lowdin
+++ /dev/null
@@ -1,29 +0,0 @@
-GEOMETRY
- e-(H) SHARON-E-6S2P 0.00 0.00 0.00 addParticles=1
- H dirac 0.00 0.00 0.00
-! e+ SHARON-E+6S2P 0.00 0.00 0.00
-END GEOMETRY
-
-TASKS
- method = "UHF"
- !configurationInteractionLevel ="FCI"
- configurationInteractionLevel ="CISD"
-END TASKS
-
-CONTROL
- numberOfCIstates=1
- CIdiagonalizationMethod = "DSYEVX"
- !CIdiagonalizationMethod = "ARPACK"
- !CIdiagonalizationMethod = "JADAMILU"
- CISizeOfGuessMatrix=300
-END CONTROL
-INPUT_CI
- species="E-ALPHA" core=0 active=0 excitation=2
- species="E-BETA" core=0 active=0 excitation=2
-! species="POSITRON" core=0 active=0 excitation=2
-END INPUT_CI
-
-
-
-
-
diff --git a/test/ci-test/H-.lowdin b/test/ci-test/H-.lowdin
deleted file mode 100644
index 4901e4fa..00000000
--- a/test/ci-test/H-.lowdin
+++ /dev/null
@@ -1,29 +0,0 @@
-GEOMETRY
- e-(H) SHARON-E-6S2P 0.00 0.00 0.00 addParticles=1 multiplicity=3
- H dirac 0.00 0.00 0.00
-! e+ SHARON-E+6S2P 0.00 0.00 0.00
-END GEOMETRY
-
-TASKS
- method = "UHF"
- configurationInteractionLevel ="FCI"
- !configurationInteractionLevel ="CISD"
-END TASKS
-
-CONTROL
- numberOfCIstates=1
- CIdiagonalizationMethod = "DSYEVX"
- !CIdiagonalizationMethod = "ARPACK"
- !CIdiagonalizationMethod = "JADAMILU"
- CISizeOfGuessMatrix=300
-END CONTROL
-INPUT_CI
- species="E-ALPHA" core=0 active=0 excitation=2
- species="E-BETA" core=0 active=0 excitation=2
-! species="POSITRON" core=0 active=0 excitation=2
-END INPUT_CI
-
-
-
-
-
diff --git a/test/ci-test/PsH.CISD.lowdin b/test/ci-test/PsH.CISD.lowdin
index 3b1dd16e..96bdb8e5 100644
--- a/test/ci-test/PsH.CISD.lowdin
+++ b/test/ci-test/PsH.CISD.lowdin
@@ -1,7 +1,7 @@
GEOMETRY
- e-(H) SHARON-E-6S2P 0.00 0.00 0.00 addParticles=1
+ e-(H) aug-cc-pvdz 0.00 0.00 0.00 addParticles=1
H dirac 0.00 0.00 0.00
- e+ SHARON-E+6S2P 0.00 0.00 0.00
+ e+ e+aug-cc-pvdz 0.00 0.00 0.00
END GEOMETRY
TASKS
@@ -11,24 +11,22 @@ TASKS
END TASKS
CONTROL
- numberOfCIstates=1
- !CIdiagonalizationMethod = "DSYEVX"
- !CIdiagonalizationMethod = "ARPACK"
- CIdiagonalizationMethod = "JADAMILU"
- CISizeOfGuessMatrix=300
- CIConvergence=1E-4
- CIJacobi = F
- CIMadSpace = 30
- !CISaveEigenvector=T
- !CILoadEigenvector=T
+readCoefficients=F
+numberOfCIstates=!
+CINaturalOrbitals=T
+ CIStatesToPrint = 1
+ CIdiagonalizationMethod = "DSYEVX"
+ !CIdiagonalizationMethod = "JADAMILU"
+ !CIPrintEigenVectorsFormat = "NONE"
+ CIPrintEigenVectorsFormat = "OCCUPIED"
+ !CIPrintEigenVectorsFormat = "ORBITALS"
+ CIPrintThreshold = 5e-2
+ buildTwoParticlesMatrixForOneParticle=T
END CONTROL
+
INPUT_CI
- species="E-ALPHA" core=0 active=0 excitation=2
- species="E-BETA" core=0 active=0 excitation=2
- species="POSITRON" core=0 active=0 excitation=2
+ species="E-ALPHA" core=0 active=0
+ species="E-BETA" core=0 active=0
+ species="POSITRON" core=0 active=0
END INPUT_CI
-
-
-
-
diff --git a/test/ci-test/PsH.FCI.lowdin b/test/ci-test/PsH.FCI.lowdin
index f4ea9f2a..219eab99 100644
--- a/test/ci-test/PsH.FCI.lowdin
+++ b/test/ci-test/PsH.FCI.lowdin
@@ -1,7 +1,7 @@
GEOMETRY
- e-(H) SHARON-E-6S2P 0.00 0.00 0.00 addParticles=1 q = 1.00
- H dirac 0.00 0.00 0.00 q = -1.00
- e+ SHARON-E+6S2P 0.00 0.00 0.00 q = -1.00
+ e-(H) aug-cc-pvdz 0.00 0.00 0.00 addParticles=1
+ H dirac 0.00 0.00 0.00
+ e+ e+aug-cc-pvdz 0.00 0.00 0.00
END GEOMETRY
TASKS
@@ -11,25 +11,22 @@ TASKS
END TASKS
CONTROL
- numberOfCIstates=1
+readCoefficients=F
+numberOfCIstates=!
+CINaturalOrbitals=T
+ CIStatesToPrint = 1
!CIdiagonalizationMethod = "DSYEVX"
- !CIdiagonalizationMethod = "ARPACK"
CIdiagonalizationMethod = "JADAMILU"
-! CISizeOfGuessMatrix=1728
- CISizeOfGuessMatrix=300
- CIConvergence=1E-4
- CIJacobi = F
- CIMadSpace = 30
- !CISaveEigenvector=T
- !CILoadEigenvector=T
+ !CIPrintEigenVectorsFormat = "NONE"
+ CIPrintEigenVectorsFormat = "OCCUPIED"
+ !CIPrintEigenVectorsFormat = "ORBITALS"
+ CIPrintThreshold = 5e-2
+ buildTwoParticlesMatrixForOneParticle=T
END CONTROL
+
INPUT_CI
- species="E-ALPHA" core=0 active=0 excitation=2
- species="E-BETA" core=0 active=0 excitation=2
- species="POSITRON" core=0 active=0 excitation=2
+ species="E-ALPHA" core=0 active=0
+ species="E-BETA" core=0 active=0
+ species="POSITRON" core=0 active=0
END INPUT_CI
-
-
-
-
diff --git a/test/clean.sh b/test/clean.sh
index b6989d54..ee17c91b 100755
--- a/test/clean.sh
+++ b/test/clean.sh
@@ -20,3 +20,5 @@ find . -name "*.pyc" -exec rm -f {} \;
find . -name "*.ints" -exec rm -f {} \;
find . -name "*.dens" -exec rm -f {} \;
find . -name "*.cub" -exec rm -f {} \;
+find . -name "*.coords" -exec rm -f {} \;
+find . -name "*.states" -exec rm -f {} \;
diff --git a/test/runtest.sh b/test/runtest.sh
old mode 100644
new mode 100755
index aaedd1ef..f91fdf94
--- a/test/runtest.sh
+++ b/test/runtest.sh
@@ -9,7 +9,7 @@ fi
echo $lowdinbin
for testfile in `ls *.py`; do
- echo $testfile
+ #echo $testfile
python3 $testfile $lowdinbin
status=$((status + $?))
done