PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2025-05-06 07:05:33 +02:00
Code Releases Activity

Merge pull request #14 from lburth/master

Browse Source 
CAP implementation
This commit is contained in:
Pierre-Francois Loos 2025-04-29 14:48:31 +02:00 committed by GitHub
commit d6c4f5db64
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
137 changed files with 52661 additions and 272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

332
PyDuck.py Normal file → Executable file
View File

@ -1,55 +1,74 @@
#!/usr/bin/env python3
import os, sys
import os
import sys
import argparse
import pyscf
from pyscf import gto
import numpy as np
import subprocess
import time
import gc
try:
import pyopencap
use_cap = True
except ImportError:
print("Module pyopencap is not installed.")
use_cap = False
#Find the value of the environnement variable QUACK_ROOT. If not present we use the current repository
# Find the value of the environnement variable QUACK_ROOT. If not present we use the current repository
if "QUACK_ROOT" not in os.environ:
print("Please set the QUACK_ROOT environment variable, for example:\n")
print("$ export QUACK_ROOT={0}".format(os.getcwd()))
sys.exit(1)
QuAcK_dir=os.environ.get('QUACK_ROOT','./')
print("Please set the QUACK_ROOT environment variable, for example:\n")
print("$ export QUACK_ROOT={0}".format(os.getcwd()))
sys.exit(1)
QuAcK_dir = os.environ.get('QUACK_ROOT', './')
#Create the argument parser object and gives a description of the script
parser = argparse.ArgumentParser(description='This script is the main script of QuAcK, it is used to run the calculation.\n If $QUACK_ROOT is not set, $QUACK_ROOT is replaces by the current directory.')
# Create the argument parser object and gives a description of the script
parser = argparse.ArgumentParser(
description='This script is the main script of QuAcK, it is used to run the calculation.\n If $QUACK_ROOT is not set, $QUACK_ROOT is replaces by the current directory.')
#Initialize all the options for the script
parser.add_argument('-b', '--basis', type=str, required=True, help='Name of the file containing the basis set information in the $QUACK_ROOT/basis/ directory')
parser.add_argument('--bohr', default='Angstrom', action='store_const', const='Bohr', help='By default QuAcK assumes that the xyz files are in Angstrom. Add this argument if your xyz file is in Bohr.')
parser.add_argument('-c', '--charge', type=int, default=0, help='Total charge of the molecule. Specify negative charges with "m" instead of the minus sign, for example m1 instead of -1. Default is 0')
parser.add_argument('--cartesian', default=False, action='store_true', help='Add this option if you want to use cartesian basis functions.')
parser.add_argument('--print_2e', default=True, action='store_true', help='If True, print ERIs to disk.')
parser.add_argument('--formatted_2e', default=False, action='store_true', help='Add this option if you want to print formatted ERIs.')
parser.add_argument('--mmap_2e', default=False, action='store_true', help='If True, avoid using DRAM when generating ERIs.')
parser.add_argument('--aosym_2e', default=False, action='store_true', help='If True, use 8-fold symmetry in ERIs.')
parser.add_argument('-fc', '--frozen_core', type=bool, default=False, help='Freeze core orbitals. Default is false')
parser.add_argument('-m', '--multiplicity', type=int, default=1, help='Spin multiplicity. Default is 1 (singlet)')
parser.add_argument('--working_dir', type=str, default=QuAcK_dir, help='Set a working directory to run the calculation.')
parser.add_argument('-x', '--xyz', type=str, required=True, help='Name of the file containing the nuclear coordinates in xyz format in the $QUACK_ROOT/mol/ directory without the .xyz extension')
# Initialize all the options for the script
parser.add_argument('-b', '--basis', type=str, required=True,
help='Name of the file containing the basis set information in the $QUACK_ROOT/basis/ directory')
parser.add_argument('--bohr', default='Angstrom', action='store_const', const='Bohr',
help='By default QuAcK assumes that the xyz files are in Angstrom. Add this argument if your xyz file is in Bohr.')
parser.add_argument('-c', '--charge', type=int, default=0,
help='Total charge of the molecule. Specify negative charges with "m" instead of the minus sign, for example m1 instead of -1. Default is 0')
parser.add_argument('--cartesian', default=False, action='store_true',
help='Add this option if you want to use cartesian basis functions.')
parser.add_argument('--print_2e', default=True,
action='store_true', help='If True, print ERIs to disk.')
parser.add_argument('--formatted_2e', default=False, action='store_true',
help='Add this option if you want to print formatted ERIs.')
parser.add_argument('--mmap_2e', default=False, action='store_true',
help='If True, avoid using DRAM when generating ERIs.')
parser.add_argument('--aosym_2e', default=False, action='store_true',
help='If True, use 8-fold symmetry in ERIs.')
parser.add_argument('-fc', '--frozen_core', type=bool,
default=False, help='Freeze core orbitals. Default is false')
parser.add_argument('-m', '--multiplicity', type=int, default=1,
help='Spin multiplicity. Default is 1 (singlet)')
parser.add_argument('--working_dir', type=str, default=QuAcK_dir,
help='Set a working directory to run the calculation.')
parser.add_argument('-x', '--xyz', type=str, required=True,
help='Name of the file containing the nuclear coordinates in xyz format in the $QUACK_ROOT/mol/ directory without the .xyz extension')
#Parse the arguments
# Parse the arguments
args = parser.parse_args()
input_basis=args.basis
unit=args.bohr
charge=args.charge
frozen_core=args.frozen_core
multiplicity=args.multiplicity
xyz=args.xyz + '.xyz'
cartesian=args.cartesian
print_2e=args.print_2e
formatted_2e=args.formatted_2e
mmap_2e=args.mmap_2e
aosym_2e=args.aosym_2e
working_dir=args.working_dir
#Read molecule
f = open(working_dir+'/mol/'+xyz,'r')
working_dir = args.working_dir
input_basis = args.basis
unit = args.bohr
charge = args.charge
frozen_core = args.frozen_core
multiplicity = args.multiplicity
xyz = args.xyz + '.xyz'
cartesian = args.cartesian
print_2e = args.print_2e
formatted_2e = args.formatted_2e
mmap_2e = args.mmap_2e
aosym_2e = args.aosym_2e
# Read molecule
f = open(working_dir+'/mol/'+xyz, 'r')
lines = f.read().splitlines()
nbAt = int(lines.pop(0))
lines.pop(0)
@ -57,98 +76,207 @@ list_pos_atom = []
for line in lines:
tmp = line.split()
atom = tmp[0]
pos = (float(tmp[1]),float(tmp[2]),float(tmp[3]))
list_pos_atom.append([atom,pos])
pos = (float(tmp[1]), float(tmp[2]), float(tmp[3]))
list_pos_atom.append([atom, pos])
f.close()
#Definition of the molecule
mol = gto.M(
atom = list_pos_atom,
basis = input_basis,
charge = charge,
spin = multiplicity - 1
# symmetry = True # Enable symmetry
)
#Fix the unit for the lengths
mol.unit=unit
# Create PySCF molecule
if use_cap:
atoms = list(set(atom[0] for atom in list_pos_atom))
if os.path.exists(input_basis):
basis_dict = {atom: gto.basis.parse_nwchem.load(
input_basis, atom) for atom in atoms}
else:
basis_dict = {atom: gto.basis.parse_nwchem.load(
working_dir + "/basis/" + input_basis, atom) for atom in atoms}
basis = basis_dict
mol = gto.M(
atom=list_pos_atom,
basis=basis,
charge=charge,
spin=multiplicity - 1
# symmetry = True # Enable symmetry
)
else:
mol = gto.M(
atom=list_pos_atom,
basis=input_basis,
charge=charge,
spin=multiplicity - 1
# symmetry = True # Enable symmetry
)
# Fix the unit for the lengths
mol.unit = unit
#
mol.cart = cartesian
#Update mol object
# Update mol object
mol.build()
#Accessing number of electrons
nelec=mol.nelec #Access the number of electrons
nalpha=nelec[0]
nbeta=nelec[1]
# Accessing number of electrons
nelec = mol.nelec # Access the number of electrons
nalpha = nelec[0]
nbeta = nelec[1]
subprocess.call(['mkdir', '-p', working_dir+'/input'])
f = open(working_dir+'/input/molecule','w')
f = open(working_dir+'/input/molecule', 'w')
f.write('# nAt nEla nElb nCore nRyd\n')
f.write(str(mol.natm)+' '+str(nalpha)+' '+str(nbeta)+' '+str(0)+' '+str(0)+'\n')
f.write(str(mol.natm)+' '+str(nalpha)+' ' +
str(nbeta)+' '+str(0)+' '+str(0)+'\n')
f.write('# Znuc x y z\n')
for i in range(len(list_pos_atom)):
f.write(list_pos_atom[i][0]+' '+str(list_pos_atom[i][1][0])+' '+str(list_pos_atom[i][1][1])+' '+str(list_pos_atom[i][1][2])+'\n')
f.write(list_pos_atom[i][0]+' '+str(list_pos_atom[i][1][0])+' ' +
str(list_pos_atom[i][1][1])+' '+str(list_pos_atom[i][1][2])+'\n')
f.close()
#Compute nuclear energy and put it in a file
# Compute nuclear energy and put it in a file
subprocess.call(['mkdir', '-p', working_dir+'/int'])
subprocess.call(['rm', '-f', working_dir + '/int/ENuc.dat'])
f = open(working_dir+'/int/ENuc.dat','w')
f = open(working_dir+'/int/ENuc.dat', 'w')
f.write(str(mol.energy_nuc()))
f.write(' ')
f.close()
#Compute 1e integrals
ovlp = mol.intor('int1e_ovlp')#Overlap matrix elements
v1e = mol.intor('int1e_nuc') #Nuclear repulsion matrix elements
t1e = mol.intor('int1e_kin') #Kinetic energy matrix elements
dipole = mol.intor('int1e_r') #Matrix elements of the x, y, z operators
x,y,z = dipole[0],dipole[1],dipole[2]
# Compute 1e integrals
ovlp = mol.intor('int1e_ovlp') # Overlap matrix elements
v1e = mol.intor('int1e_nuc') # Nuclear repulsion matrix elements
t1e = mol.intor('int1e_kin') # Kinetic energy matrix elements
dipole = mol.intor('int1e_r') # Matrix elements of the x, y, z operators
x, y, z = dipole[0], dipole[1], dipole[2]
norb = len(ovlp) # nBAS_AOs
norb = len(ovlp) # nBAS_AOs
subprocess.call(['rm', '-f', working_dir + '/int/nBas.dat'])
f = open(working_dir+'/int/nBas.dat','w')
f = open(working_dir+'/int/nBas.dat', 'w')
f.write(" {} ".format(str(norb)))
f.close()
def write_matrix_to_file(matrix,size,file,cutoff=1e-15):
def create_psi4_basis(basis_dict):
"""
Converts a dictionary representation of a basis set (pyscf internal format) into a Psi4-formatted string.
Parameters:
basis_dict (dict): A dictionary where keys are element symbols and values are lists of primitives.
Each primitive is represented as [angular momentum, [exponent, coefficient(s)]].
Returns:
str: filepath to the create file containing the psi4 formatted basis
"""
l_mapping = {0: 'S', 1: 'P', 2: 'D', 3: 'F', 4: 'G', 5: 'H'}
basis_str = "****\n"
for element, shells in basis_dict.items():
basis_str += f"{element} 0\n"
for shell in shells:
l_value = shell[0]
l_letter = l_mapping.get(l_value, str(l_value))
primitives = shell[1:]
num_primitives = len(primitives)
# Determine number of contractions
max_contractions = max(len(p) - 1 for p in primitives)
for contraction_idx in range(max_contractions):
basis_str += f"{l_letter} {num_primitives} 1.00\n"
for primitive in primitives:
exponent = primitive[0]
coefficient = primitive[1 + contraction_idx] if len(
primitive) > (1 + contraction_idx) else 0.0
basis_str += f" {exponent: .6E} {coefficient: .6E}\n"
basis_str += "****\n"
basis_filename_psi4 = working_dir + "/input/basis_psi4"
with open(basis_filename_psi4, "w") as file:
file.write(basis_str.strip())
return basis_filename_psi4
# CAP definition
if use_cap:
f = open(working_dir+'/cap_data/'+args.xyz, 'r')
lines = f.read().splitlines()
line = lines[1]
tmp = line.split()
onset_x = float(tmp[0])
onset_y = float(tmp[1])
onset_z = float(tmp[2])
eta_opt = float(tmp[3])
f.close()
f = open(working_dir+'/input/eta_opt.dat', 'w')
f.write(" {} ".format(str(eta_opt)))
f.close()
# xyz file
with open(working_dir + "/mol/" + xyz, "r") as f:
lines = f.readlines()
f.close()
num_atoms = int(lines[0].strip())
atoms = [line.strip() for line in lines[2:2+num_atoms]]
if unit == 'Bohr':
bohr_coordinates = 'true'
else:
bohr_coordinates = 'false'
sys_dict = {
"molecule": "inline",
"geometry": "\n".join(atoms), # XYZ format as a string
"basis_file": create_psi4_basis(basis_dict),
"bohr_coordinates": bohr_coordinates
}
cap_system = pyopencap.System(sys_dict)
if not(cap_system.check_overlap_mat(ovlp, "pyscf")):
raise Exception(
"Provided cap basis does not match to the pyscf basis.")
cap_dict = {"cap_type": "box",
"cap_x": onset_x,
"cap_y": onset_y,
"cap_z": onset_z,
"Radial_precision": "16",
"angular_points": "590",
"thresh": 15}
pc = pyopencap.CAP(cap_system, cap_dict, norb)
cap_ao = pc.get_ao_cap(ordering="pyscf")
def write_matrix_to_file(matrix, size, file, cutoff=1e-15):
f = open(file, 'w')
for i in range(size):
for j in range(i,size):
for j in range(i, size):
if abs(matrix[i][j]) > cutoff:
f.write(str(i+1)+' '+str(j+1)+' '+"{:.16E}".format(matrix[i][j]))
f.write(str(i+1)+' '+str(j+1)+' ' +
"{:.16E}".format(matrix[i][j]))
f.write('\n')
f.close()
#Write all 1 electron quantities in files
#Ov,Nuc,Kin,x,y,z
subprocess.call(['rm', '-f', working_dir + '/int/Ov.dat'])
write_matrix_to_file(ovlp,norb,working_dir+'/int/Ov.dat')
subprocess.call(['rm', '-f', working_dir + '/int/Nuc.dat'])
write_matrix_to_file(v1e,norb,working_dir+'/int/Nuc.dat')
subprocess.call(['rm', '-f', working_dir + '/int/Kin.dat'])
write_matrix_to_file(t1e,norb,working_dir+'/int/Kin.dat')
subprocess.call(['rm', '-f', working_dir + '/int/x.dat'])
write_matrix_to_file(x,norb,working_dir+'/int/x.dat')
subprocess.call(['rm', '-f', working_dir + '/int/y.dat'])
write_matrix_to_file(y,norb,working_dir+'/int/y.dat')
subprocess.call(['rm', '-f', working_dir + '/int/z.dat'])
write_matrix_to_file(z,norb,working_dir+'/int/z.dat')
def write_tensor_to_file(tensor,size,file_name,cutoff=1e-15):
# Write all 1 electron quantities in files
# Ov,Nuc,Kin,x,y,z,CAP
subprocess.call(['rm', '-f', working_dir + '/int/Ov.dat'])
write_matrix_to_file(ovlp, norb, working_dir+'/int/Ov.dat')
subprocess.call(['rm', '-f', working_dir + '/int/Nuc.dat'])
write_matrix_to_file(v1e, norb, working_dir+'/int/Nuc.dat')
subprocess.call(['rm', '-f', working_dir + '/int/Kin.dat'])
write_matrix_to_file(t1e, norb, working_dir+'/int/Kin.dat')
subprocess.call(['rm', '-f', working_dir + '/int/x.dat'])
write_matrix_to_file(x, norb, working_dir+'/int/x.dat')
subprocess.call(['rm', '-f', working_dir + '/int/y.dat'])
write_matrix_to_file(y, norb, working_dir+'/int/y.dat')
subprocess.call(['rm', '-f', working_dir + '/int/z.dat'])
write_matrix_to_file(z, norb, working_dir+'/int/z.dat')
if use_cap:
subprocess.call(['rm', '-f', working_dir + '/int/CAP.dat'])
write_matrix_to_file(cap_ao, norb, working_dir+'/int/CAP.dat')
def write_tensor_to_file(tensor, size, file_name, cutoff=1e-15):
f = open(file_name, 'w')
for i in range(size):
for j in range(i,size):
for k in range(i,size):
for l in range(j,size):
for j in range(i, size):
for k in range(i, size):
for l in range(j, size):
if abs(tensor[i][k][j][l]) > cutoff:
f.write(str(i+1)+' '+str(j+1)+' '+str(k+1)+' '+str(l+1)+' '+"{:.16E}".format(tensor[i][k][j][l]))
f.write(str(i+1)+' '+str(j+1)+' '+str(k+1)+' ' +
str(l+1)+' '+"{:.16E}".format(tensor[i][k][j][l]))
f.write('\n')
f.close()
if print_2e:
# Write two-electron integrals to HD
ti_2e = time.time()
@ -172,25 +300,31 @@ if print_2e:
if(mmap_2e):
# avoid using DRAM
eri_shape = (norb, norb, norb, norb)
eri_mmap = np.memmap(output_file_path, dtype='float64', mode='w+', shape=eri_shape)
eri_mmap = np.memmap(
output_file_path, dtype='float64', mode='w+', shape=eri_shape)
mol.intor('int2e', out=eri_mmap)
for i in range(norb):
eri_mmap[i, :, :, :] = eri_mmap[i, :, :, :].transpose(1, 0, 2)
eri_mmap.flush()
del eri_mmap
else:
eri_ao = mol.intor('int2e').transpose(0, 2, 1, 3) # chem -> phys
eri_ao = mol.intor('int2e').transpose(0, 2, 1, 3) # chem -> phys
f = open(output_file_path, 'w')
eri_ao.tofile(output_file_path)
f.close()
te_2e = time.time()
print("Wall time for writing 2e-integrals to disk: {:.3f} seconds".format(te_2e - ti_2e))
print(
"Wall time for writing 2e-integrals to disk: {:.3f} seconds".format(te_2e - ti_2e))
sys.stdout.flush()
# Free memory
del ovlp, v1e, t1e, x, y, z, mol
if print_2e and not(mmap_2e):
del eri_ao
if use_cap:
del cap_ao, pc
gc.collect()
#Execute the QuAcK fortran program
# Execute the QuAcK fortran program
subprocess.call([QuAcK_dir + '/bin/QuAcK', working_dir])

4785
basis/aug-cc-pvtz+3s3p3d_C2H2 Normal file
View File

File diff suppressed because it is too large Load Diff

4785
basis/aug-cc-pvtz+3s3p3d_C2H4 Normal file
View File

File diff suppressed because it is too large Load Diff

4784
basis/aug-cc-pvtz+3s3p3d_CO Normal file
View File

File diff suppressed because it is too large Load Diff

4784
basis/aug-cc-pvtz+3s3p3d_CO2 Normal file
View File

File diff suppressed because it is too large Load Diff

4784
basis/aug-cc-pvtz+3s3p3d_N2 Normal file
View File

File diff suppressed because it is too large Load Diff

107
basis/install.py Executable file
View File

@ -0,0 +1,107 @@
#!/usr/bin/env python3
"""Installs the default basis set files from the BSE command-line tool in the required format for """
import basis_set_exchange as bse
conversion = {
"3-21g": "3-21G",
"4-31g": "4-31G",
"6-311g": "6-311G",
"6-311++g_2d_2p": "6-311++G(2d,2p)",
"6-311g_2df_2pd": "6-311G(2df,2pd)",
"6-311++g_3df_3pd": "6-311++G(3df,3pd)",
"6-311+g_star": "6-311+G*",
"6-311G_star": "6-311G*",
"6-311++g_star_star": "6-311++G**",
"6-311G_star_star": "6-311G**",
"6-31g": "6-31G",
"6-31+g": "6-31+G",
"6-31++g": "6-31++G",
"6-31g_3df_3pd": "6-31G(3df,3pd)",
"6-31++g_star": "6-31++G*",
"6-31+g_star": "6-31+G*",
"6-31g_star": "6-31G*",
"6-31++g_star_star": "6-31++G**",
"6-31g_star_star": "6-31G**",
"ano2_ames": "NASA Ames ANO2",
"ano_ames": "NASA Ames ANO",
"ano-rcc": "ANO-RCC",
"apr-cc-pv_q+d_z": "apr-cc-pV(Q+d)Z",
"aug-cc-pcv5z": "aug-cc-pCV5Z",
"aug-cc-pcvdz": "aug-cc-pCVDZ",
"aug-cc-pcvqz": "aug-cc-pCVQZ",
"aug-cc-pcvtz": "aug-cc-pCVTZ",
"aug-cc-pv5z": "aug-cc-pV5Z",
"aug-cc-pv6z": "aug-cc-pV6Z",
"aug-cc-pvdz": "aug-cc-pVDZ",
"aug-cc-pvqz": "aug-cc-pVQZ",
"aug-cc-pvtz": "aug-cc-pVTZ",
"aug-cc-pwcv5z": "aug-cc-pwCV5Z",
"aug-cc-pwcvdz": "aug-cc-pwCVDZ",
"aug-cc-pwcvqz": "aug-cc-pwCVQZ",
"aug-cc-pwcvtz": "aug-cc-pwCVTZ",
"cc-pcv5z": "cc-pCV5Z",
"cc-pcvdz": "cc-pCVDZ",
"cc-pcvqz": "cc-pCVQZ",
"cc-pcvtz": "cc-pCVTZ",
"cc-pv5z": "cc-pV5Z",
"cc-pv6z": "cc-pV6Z",
"cc-pv8z": "cc-pV8Z",
"cc-pv9z": "cc-pV9Z",
"cc-pvdz": "cc-pVDZ",
"cc-pvqz": "cc-pVQZ",
"cc-pvtz": "cc-pVTZ",
"cc-pwcv5z": "cc-pwCV5Z",
"cc-pwcvdz": "cc-pwCVDZ",
"cc-pwcvqz": "cc-pwCVQZ",
"cc-pwcvtz": "cc-pwCVTZ",
"d-aug-cc-pv5z": "d-aug-cc-pV5Z",
"d-aug-cc-pv6z": "d-aug-cc-pV6Z",
"d-aug-cc-pvdz": "d-aug-cc-pVDZ",
"d-aug-cc-pvqz": "d-aug-cc-pVQZ",
"d-aug-cc-pvtz": "d-aug-cc-pVTZ",
"def2-qzvp": "def2-QZVP",
"def2-qzvpd": "def2-QZVPD",
"def2-qzvpp": "def2-QZVPP",
"def2-qzvppd": "def2-QZVPPD",
"def2-svp": "def2-SVP",
"def2-sv_p": "def2-SV(P)",
"def2-svpd": "def2-SVPD",
"def2-tzvp": "def2-TZVP",
"def2-tzvpd": "def2-TZVPD",
"def2-tzvpp": "def2-TZVPP",
"def2-tzvppd": "def2-TZVPPD",
"jul-cc-pv_d+d_z": "jul-cc-pV(D+d)Z",
"jul-cc-pv_q+d_z": "jul-cc-pV(Q+d)Z",
"jul-cc-pv_t+d_z": "jul-cc-pV(T+d)Z",
"jun-cc-pv_d+d_z": "jun-cc-pV(D+d)Z",
"jun-cc-pv_q+d_z": "jun-cc-pV(Q+d)Z",
"jun-cc-pv_t+d_z": "jun-cc-pV(T+d)Z",
"lanl08": "LANL08",
"lanl08+": "LANL08+",
"lanl08d": "LANL08(d)",
"lanl08f": "LANL08(f)",
"m6-31g": "m6-31G",
"may-cc-pv_q+d_z": "may-cc-pV(Q+d)Z",
"may-cc-pv_t+d_z": "may-cc-pV(T+d)Z",
"midi_bang": "MIDI!",
"midi_huzinaga": "MIDI",
"mini": "MINI",
"pv6z": "pV6Z",
"pv7z": "pV7Z",
"pvdz_ahlrichs": "Ahlrichs pVDZ",
"sto-2g": "STO-2G",
"sto-3g": "STO-3G",
"sto-4g": "STO-4G",
"sto-5g": "STO-5G",
"sto-6g": "STO-6G",
"sto-3g_star": "STO-3G*",
}
for filename in conversion.keys():
print(filename)
data = bse.get_basis(
conversion[filename], fmt='nwchem', uncontract_general=True, uncontract_spdf=True)
with open(filename, 'w') as f:
f.write(data)

2
cap_data/C2H2X Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
3.2 3.2 3.2 0.0015

2
cap_data/C2H4X Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
7.1 4.65 3.40 0.0015

2
cap_data/C4H6X Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
16.20 7.25 4.65 0.0015

2
cap_data/CH2OX Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
3.85 2.95 6.10 0.0015

2
cap_data/CO Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
2.76 2.76 4.97 0.0028

2
cap_data/CO2X Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
3.33 3.33 9.57 0.0015

2
cap_data/COX Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
2.76 2.76 4.97 0.0028

2
cap_data/H2 Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
2.76 2.76 4.88 0.0015

2
cap_data/He Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
2.76 2.76 2.76 0.0015

2
cap_data/N2 Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
2.76 2.76 4.88 0.00

2
cap_data/N2X Normal file
View File

@ -0,0 +1,2 @@
onset_x onset_y onset_z eta_opt
2.76 2.76 4.88 0.0015

3259
cap_integrals/aug-cc-pvtz+3s3p3d_C2H2 Normal file
View File

File diff suppressed because it is too large Load Diff

10087
cap_integrals/aug-cc-pvtz+3s3p3d_C2H4 Normal file
View File

File diff suppressed because it is too large Load Diff

1603
cap_integrals/aug-cc-pvtz+3s3p3d_CO Normal file
View File

File diff suppressed because it is too large Load Diff

1611
cap_integrals/aug-cc-pvtz+3s3p3d_N2 Normal file
View File

File diff suppressed because it is too large Load Diff

63
input/basis_psi4 Normal file
View File

@ -0,0 +1,63 @@
****
C 0
S 10 1.00
8.236000E+03 5.310000E-04
1.235000E+03 4.108000E-03
2.808000E+02 2.108700E-02
7.927000E+01 8.185300E-02
2.559000E+01 2.348170E-01
8.997000E+00 4.344010E-01
3.319000E+00 3.461290E-01
9.059000E-01 3.937800E-02
3.643000E-01 -8.983000E-03
1.285000E-01 2.385000E-03
S 10 1.00
8.236000E+03 -1.130000E-04
1.235000E+03 -8.780000E-04
2.808000E+02 -4.540000E-03
7.927000E+01 -1.813300E-02
2.559000E+01 -5.576000E-02
8.997000E+00 -1.268950E-01
3.319000E+00 -1.703520E-01
9.059000E-01 1.403820E-01
3.643000E-01 5.986840E-01
1.285000E-01 3.953890E-01
S 1 1.00
9.059000E-01 1.000000E+00
S 1 1.00
1.285000E-01 1.000000E+00
P 5 1.00
1.871000E+01 1.403100E-02
4.133000E+00 8.686600E-02
1.200000E+00 2.902160E-01
3.827000E-01 5.010080E-01
1.209000E-01 3.434060E-01
P 1 1.00
3.827000E-01 1.000000E+00
P 1 1.00
1.209000E-01 1.000000E+00
D 1 1.00
1.097000E+00 1.000000E+00
D 1 1.00
3.180000E-01 1.000000E+00
F 1 1.00
7.610000E-01 1.000000E+00
****
H 0
S 5 1.00
3.387000E+01 6.068000E-03
5.095000E+00 4.530800E-02
1.159000E+00 2.028220E-01
3.258000E-01 5.039030E-01
1.027000E-01 3.834210E-01
S 1 1.00
3.258000E-01 1.000000E+00
S 1 1.00
1.027000E-01 1.000000E+00
P 1 1.00
1.407000E+00 1.000000E+00
P 1 1.00
3.880000E-01 1.000000E+00
D 1 1.00
1.057000E+00 1.000000E+00
****

1
input/eta_opt.dat Normal file
View File

@ -0,0 +1 @@
0.00000

26
input/methods Normal file
View File

@ -0,0 +1,26 @@
# RHF UHF GHF ROHF HFB cRHF
F F F F F F
# MP2 MP3
F F
# CCD pCCD DCD CCSD CCSD(T)
F F F F F
# drCCD rCCD crCCD lCCD
F F F F
# CIS CIS(D) CID CISD FCI
F F F F F
# phRPA phRPAx crRPA ppRPA
F F F F
# G0F2 evGF2 qsGF2 ufGF2 G0F3 evGF3
F F F F F F
# G0W0 evGW qsGW ufG0W0 ufGW
T F F F F
# G0T0pp evGTpp qsGTpp ufG0T0pp
F F F F
# G0T0eh evGTeh qsGTeh
F F F
# cG0W0 cG0F2
F F
# Parquet
F
# Rtest Utest Gtest
F F F

8
input/methods.default
View File

@ -1,5 +1,5 @@
# RHF UHF GHF ROHF HFB
F F F F F
# RHF UHF GHF ROHF HFB cRHF
F F F F F F
# MP2 MP3
F F
# CCD pCCD DCD CCSD CCSD(T)
@ -13,11 +13,13 @@
# G0F2 evGF2 qsGF2 ufGF2 G0F3 evGF3
F F F F F F
# G0W0 evGW qsGW ufG0W0 ufGW
F F F F F
T F F F F
# G0T0pp evGTpp qsGTpp ufG0T0pp
F F F F
# G0T0eh evGTeh qsGTeh
F F F
# cG0W0 cG0F2
F F
# Parquet
F
# Rtest Utest Gtest

28
input/options Normal file
View File

@ -0,0 +1,28 @@
# HF: maxSCF thresh DIIS guess mix shift stab search
<<<<<<< Updated upstream
1000 0.00000001 5 1 0.0 0.0 F F
=======
1000 0.00000001 3 1 0.0 0.0 F F
>>>>>>> Stashed changes
# MP: reg
F
# CC: maxSCF thresh DIIS
64 0.00001 5
# LR: TDA singlet triplet
F T T
# GF: maxSCF thresh DIIS lin eta renorm reg
256 0.00001 5 F 0.0 0 F
# GW: maxSCF thresh DIIS lin eta TDA_W reg
<<<<<<< Updated upstream
256 0.00001 1 F 0.0 F F
=======
256 0.00000001 5 F 0.0 F F
>>>>>>> Stashed changes
# GT: maxSCF thresh DIIS lin eta TDA_T reg
256 0.00001 5 F 0.0 F F
# ACFDT: AC Kx XBS
F F T
# BSE: phBSE phBSE2 ppBSE dBSE dTDA
F F F F T
# HFB: temperature sigma chem_pot_HF restart_HFB
0.05 1.00 T F

4
input/options.default
View File

@ -1,5 +1,7 @@
# HF: maxSCF thresh DIIS guess mix shift stab search
256 0.00001 5 1 0.0 0.0 F F
1000 0.00001 5 1 0.0 0.0 F F
# CAP: eta
0.0015
# MP: reg
F
# CC: maxSCF thresh DIIS

4260
int/CAP.dat Normal file
View File

File diff suppressed because it is too large Load Diff

7
mol/C2H2X.xyz Normal file
View File

@ -0,0 +1,7 @@
5
C 0.0000 0.0000 0.6014892763648376
C 0.0000 0.0000 -0.6014892763648376
H 0.0000 0.0000 1.6874667478432346
H 0.0000 0.0000 -1.6874667478432346
X 0.0000 0.0000 0.0

9
mol/C2H4X.xyz Normal file
View File

@ -0,0 +1,9 @@
7
C 0.6694885479197417 0.0000000000000000 0.0000
C -0.6694885479197417 0.0000000000000000 0.0000
H 1.2320542097162894 0.9289063164420966 0.0000
H -1.2320542097162894 0.9289063164420966 0.0000
H 1.2320542097162894 -0.9289063164420966 0.0000
H -1.2320542097162894 -0.9289063164420966 0.0000
X 0.0000000000000000 0.0000000000000000 0.0000

4
mol/CO.xyz
View File

@ -1,4 +1,4 @@
2
C 0.0000 0.0000 0.0000
O 0.0000 0.0000 1.1335
C 0.0000 0.0000 -0.5639970709977953
O 0.0000 0.0000 0.5639970709977953

6
mol/CO2X.xyz Normal file
View File

@ -0,0 +1,6 @@
4
O 0.0000 0.0000 -1.1630256733336033
C 0.0000 0.0000 0.0000
O 0.0000 0.0000 1.1630256733336033
X 0.0000 0.0000 0.0000

5
mol/COX.xyz Normal file
View File

@ -0,0 +1,5 @@
3
C 0.0000 0.0000 -0.5639970709977953
O 0.0000 0.0000 0.5639970709977953
X 0.0000 0.0000 0.0000

4
mol/H2.xyz
View File

@ -1,4 +1,4 @@
2
H 0.00000000 0.0 0.0
H 0.00000000 0.0 1.235
H 0.00000000 0.0 -0.6175
H 0.00000000 0.0 0.6175

4
mol/N2.xyz
View File

@ -1,4 +1,4 @@
2
N 0.0000 0.0000 -0.5475132
N 0.0000 0.0000 0.5475132
N 0.0000 0.0000 -0.5487567673341279
N 0.0000 0.0000 0.5487567673341279

0
mol/N2X Normal file
View File

5
mol/N2X.xyz Normal file
View File

@ -0,0 +1,5 @@
3
N 0.0000 0.0000 -0.5487567673341279
N 0.0000 0.0000 0.5487567673341279
X 0.0000 0.0000 0.000000

24
src/AOtoMO/complex_AOtoMO.f90 Normal file
View File

@ -0,0 +1,24 @@
subroutine complex_AOtoMO(nBas, nOrb, C, M_AOs, M_MOs)
! Perform AO to MO transformation of a matrix M_AOs for given coefficients c
! M_MOs = C.T M_AOs C
implicit none
integer, intent(in) :: nBas, nOrb
complex*16, intent(in) :: C(nBas,nOrb)
double precision, intent(in) :: M_AOs(nBas,nBas)
complex*16, intent(out) :: M_MOs(nOrb,nOrb)
complex*16, allocatable :: AC(:,:)
complex*16, allocatable :: complex_C(:,:)
allocate(AC(nBas,nOrb))
AC = matmul(M_AOs, C)
M_MOs = matmul(transpose(C), AC)
deallocate(AC)
end subroutine

58
src/AOtoMO/complex_AOtoMO_ERI_RHF.f90 Normal file
View File

@ -0,0 +1,58 @@
subroutine complex_AOtoMO_ERI_RHF(nBas,nOrb,c,ERI_AO,ERI_MO)
! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
complex*16,intent(in) :: c(nBas,nOrb)
! Local variables
complex*16,allocatable :: a1(:,:,:,:)
complex*16,allocatable :: a2(:,:,:,:)
complex*16,allocatable :: complex_ERI_AO(:,:,:,:)
! Output variables
complex*16,intent(out) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
! Memory allocation
allocate(a2(nBas,nBas,nBas,nOrb))
allocate(a1(nBas,nBas,nOrb,nOrb))
allocate(complex_ERI_AO(nBas,nBas,nBas,nBas))
complex_ERI_AO = (1d0,0d0)*ERI_AO
! Four-index transform via semi-direct O(N^5) algorithm
call zgemm( 'T', 'N', nBas*nBas*nBas, nOrb, nBas, 1.d0 &
, complex_ERI_AO(1,1,1,1), nBas, c(1,1), nBas&
, 0.d0, a2(1,1,1,1), nBas*nBas*nBas)
deallocate(complex_ERI_AO)
call zgemm( 'T', 'N', nBas*nBas*nOrb, nOrb, nBas, 1.d0 &
, a2(1,1,1,1), nBas, c(1,1), nBas &
, 0.d0, a1(1,1,1,1), nBas*nBas*nOrb)
deallocate(a2)
allocate(a2(nBas,nOrb,nOrb,nOrb))
call zgemm( 'T', 'N', nBas*nOrb*nOrb, nOrb, nBas, 1.d0 &
, a1(1,1,1,1), nBas, c(1,1), nBas &
, 0.d0, a2(1,1,1,1), nBas*nOrb*nOrb)
deallocate(a1)
call zgemm( 'T', 'N', nOrb*nOrb*nOrb, nOrb, nBas, 1.d0 &
, a2(1,1,1,1), nBas, c(1,1), nBas &
, 0.d0, ERI_MO(1,1,1,1), nOrb*nOrb*nOrb)
deallocate(a2)
end subroutine

36
src/AOtoMO/complex_Hartree_matrix_AO_basis.f90 Normal file
View File

@ -0,0 +1,36 @@
subroutine complex_Hartree_matrix_AO_basis(nBas,P,ERI,H)
! Compute Hartree matrix in the AO basis
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
complex*16,intent(in) :: P(nBas,nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: mu,nu,la,si
! Output variables
complex*16,intent(out) :: H(nBas,nBas)
H(:,:) = cmplx(0.d0,0.d0,kind=8)
do si=1,nBas
do nu=1,nBas
do la=1,nBas
do mu=1,nBas
H(mu,nu) = H(mu,nu) + P(la,si)*ERI(mu,la,nu,si)
end do
end do
end do
end do
end subroutine
! ---

39
src/AOtoMO/complex_MOtoAO.f90 Normal file
View File

@ -0,0 +1,39 @@
subroutine complex_MOtoAO(nBas, nOrb, S, C, M_MOs, M_AOs)
! Perform MO to AO transformation of a matrix M_AOs for a given metric S
! and coefficients c
!
! M_AOs = S C M_MOs (S C).T
implicit none
integer, intent(in) :: nBas, nOrb
double precision, intent(in) :: S(nBas,nBas)
complex*16, intent(in) :: C(nBas,nOrb)
complex*16, intent(in) :: M_MOs(nOrb,nOrb)
complex*16, intent(out) :: M_AOs(nBas,nBas)
complex*16, allocatable :: SC(:,:),BSC(:,:),cS(:,:)
allocate(SC(nBas,nOrb), BSC(nOrb,nBas),cS(nBas,nBas))
cS(:,:) = (1d0,0d0)*S(:,:)
!SC = matmul(S, C)
!BSC = matmul(M_MOs, transpose(SC))
!M_AOs = matmul(SC, BSC)
call zgemm("N", "N", nBas, nOrb, nBas, 1.d0, &
cS(1,1), nBas, C(1,1), nBas, &
0.d0, SC(1,1), nBas)
call zgemm("N", "T", nOrb, nBas, nOrb, 1.d0, &
M_MOs(1,1), nOrb, SC(1,1), nBas, &
0.d0, BSC(1,1), nOrb)
call zgemm("N", "N", nBas, nBas, nOrb, 1.d0, &
SC(1,1), nBas, BSC(1,1), nOrb, &
0.d0, M_AOs(1,1), nBas)
deallocate(SC, BSC)
end subroutine

24
src/AOtoMO/complex_complex_AOtoMO.f90 Normal file
View File

@ -0,0 +1,24 @@
subroutine complex_complex_AOtoMO(nBas, nOrb, C, M_AOs, M_MOs)
! Perform AO to MO transformation of a matrix M_AOs for given coefficients c
! M_MOs = C.T M_AOs C
implicit none
integer, intent(in) :: nBas, nOrb
complex*16, intent(in) :: C(nBas,nOrb)
complex*16, intent(in) :: M_AOs(nBas,nBas)
complex*16, intent(out) :: M_MOs(nOrb,nOrb)
complex*16, allocatable :: AC(:,:)
complex*16, allocatable :: complex_C(:,:)
allocate(AC(nBas,nOrb))
AC = matmul(M_AOs, C)
M_MOs = matmul(transpose(C), AC)
deallocate(AC)
end subroutine

39
src/AOtoMO/complex_exchange_matrix_AO_basis.f90 Normal file
View File

@ -0,0 +1,39 @@
subroutine complex_exchange_matrix_AO_basis(nBas,P,ERI,K)
! Compute exchange matrix in the AO basis
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
complex*16,intent(in) :: P(nBas,nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: mu,nu,la,si
! Output variables
complex*16,intent(out) :: K(nBas,nBas)
K(:,:) = cmplx(0.d0,0.d0,kind=8)
do nu=1,nBas
do si=1,nBas
do la=1,nBas
do mu=1,nBas
K(mu,nu) = K(mu,nu) - P(la,si)*ERI(mu,la,si,nu)
end do
end do
end do
end do
end subroutine
! ---

24
src/GF/RGF.f90
View File

@ -1,7 +1,8 @@
subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,maxSCF, &
subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,docG0F2, &
renorm,maxSCF, &
thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF, &
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
S,X,T,V,Hc,ERI_AO,ERI_MO,CAP,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
! Green's function module
@ -13,6 +14,7 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
logical,intent(in) :: dotest
logical,intent(in) :: doG0F2
logical,intent(in) :: docG0F2
logical,intent(in) :: doevGF2
logical,intent(in) :: doqsGF2
logical,intent(in) :: doufG0F02
@ -52,6 +54,7 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
double precision,intent(in) :: cHF(nBas,nOrb)
double precision,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: S(nBas,nBas)
double precision,intent(in) :: CAP(nBas,nBas)
double precision,intent(in) :: T(nBas,nBas)
double precision,intent(in) :: V(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
@ -168,4 +171,21 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
end if
!------------------------------------------------------------------------
! Compute complex G0F2 electronic binding energies
!------------------------------------------------------------------------
if(docG0F2) then
call wall_time(start_GF)
call cRG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS, &
ENuc,ERHF,ERI_MO,CAP,dipole_int_MO,eHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
write(*,*)
end if
end subroutine

2
src/GF/RGF2_reg_self_energy.f90
View File

@ -40,7 +40,7 @@ subroutine RGF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Parameters for regularized calculations !
!-----------------------------------------!
s = 100d0
s = 500d0
!----------------------------------------------------!
! Compute GF2 self-energy and renormalization factor !

1
src/GF/RGF2_reg_self_energy_diag.f90
View File

@ -81,5 +81,4 @@ subroutine RGF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
end do
Z(:) = 1d0/(1d0 - Z(:))
end subroutine

1
src/GF/RGF2_self_energy_diag.f90
View File

@ -66,7 +66,6 @@ subroutine RGF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
end do
end do
end do
Z(:) = 1d0/(1d0 - Z(:))
end subroutine

152
src/GF/cRG0F2.f90 Normal file
View File

@ -0,0 +1,152 @@
subroutine cRG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,CAP,dipole_int,eHF)
! Perform a one-shot second-order Green function calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: regularize
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nO
integer,intent(in) :: nC
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nOrb)
double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: dipole_int(nOrb,nOrb,ncart)
double precision,intent(in) :: CAP(nOrb,nOrb)
! Local variables
integer :: p
double precision :: Ec
double precision :: EcBSE(nspin)
double precision,allocatable :: Re_SigC(:)
double precision,allocatable :: Im_SigC(:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
double precision,allocatable :: Re_eGFlin(:)
double precision, allocatable :: Im_eGFlin(:)
double precision,allocatable :: Re_eGF(:)
double precision,allocatable :: Im_eGF(:)
double precision, allocatable :: e_CAP(:)
! Hello world
write(*,*)
write(*,*)'*******************************'
write(*,*)'* Restricted G0F2 Calculation *'
write(*,*)'*******************************'
write(*,*)
! Memory allocation
allocate(Re_SigC(nOrb),Im_SigC(nOrb), Re_Z(nOrb),Im_Z(nOrb),&
Re_eGFlin(nOrb),Im_eGFlin(nOrb), Re_eGF(nOrb),Im_eGF(nOrb),e_CAP(nOrb))
do p = 1, nOrb
e_CAP(p) = CAP(p,p)
end do
! Frequency-dependent second-order contribution
if(regularize) then
write(*,*) "Regularisation not implemented (yet)"
!call RGF2_reg_self_energy_diag(eta,nOrb,nC,nO,nV,nR,eHF,ERI,SigC,Z)
else
call cRGF2_self_energy_diag(eta,nOrb,nC,nO,nV,nR,eHF,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z,e_CAP)
end if
Re_eGFlin(:) = eHF(:) + Re_Z(:)*Re_SigC(:) - Im_Z(:)*Im_SigC(:)
Im_eGFlin(:) = e_CAP(:) + Re_Z(:)*Im_SigC(:) + Im_Z(:)*Re_SigC(:)
if(linearize) then
write(*,*) '*** Quasiparticle energies obtained by linearization ***'
Re_eGF(:) = Re_eGFlin(:)
Im_eGF(:) = Im_eGFlin(:)
else
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call cRGF2_QP_graph(eta,nOrb,nC,nO,nV,nR,eHF,e_cap,ERI,Re_eGFlin,Im_eGFlin,eHF,e_cap,Re_eGF,Im_eGF,Re_Z,Im_Z)
end if
! Print results
! call RMP2(.false.,regularize,nOrb,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_cRG0F2(nOrb,nO,eHF,e_CAP,Re_SigC,Im_SigC,Re_eGF,Im_eGF,Re_Z,Im_Z,ENuc,ERHF,Ec)
! Perform BSE@GF2 calculation
!
! if(dophBSE) then
!
! call RGF2_phBSE(TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eGF,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy (singlet) =',EcBSE(1)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy (triplet) =',EcBSE(2)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy =',sum(EcBSE)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 total energy =',ENuc + ERHF + sum(EcBSE)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Perform ppBSE@GF2 calculation
!
! if(doppBSE) then
!
! call RGF2_ppBSE(TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,ERI,dipole_int,eGF,EcBSE)
!
! EcBSE(2) = 3d0*EcBSE(2)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy (singlet) =',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy (triplet) =',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy =',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 total energy =',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Testing zone
!
! if(dotest) then
!
! call dump_test_value('R','G0F2 correlation energy',Ec)
! call dump_test_value('R','G0F2 HOMO energy',eGF(nO))
! call dump_test_value('R','G0F2 LUMO energy',eGF(nO+1))
!
! end if
!
! deallocate(SigC, Z, eGFlin, eGF)
!
end subroutine

59
src/GF/cRGF2_Im_SigC.f90 Normal file
View File

@ -0,0 +1,59 @@
double precision function cRGF2_Im_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,eHF,e_cap,ERI)
! Compute diagonal of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
double precision :: eps
double precision :: eta_tilde
double precision :: num
! Initialize
cRGF2_Im_SigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_w + eHF(a) - eHF(i) - eHF(j)
eta_tilde = eta - Im_w + e_cap(i) -( e_cap(a) - e_cap(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
cRGF2_Im_SigC = cRGF2_Im_SigC + num*eta_tilde/(eps**2 + eta_tilde**2)
end do
end do
end do
! Virtual part of the correlation self-energy
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_w + eHF(i) - eHF(a) - eHF(b)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
eta_tilde = eta + Im_w - e_cap(a) - e_cap(b) + e_cap(i)
cRGF2_Im_SigC = cRGF2_Im_SigC - num*eta_tilde/(eps**2 + eta_tilde**2)
end do
end do
end do
end function

56
src/GF/cRGF2_Im_dSigC.f90 Normal file
View File

@ -0,0 +1,56 @@
double precision function cRGF2_Im_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,eHF,e_cap,ERI)
! Compute diagonal of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
double precision :: eps
double precision :: eta_tilde
double precision :: num
! Initialize
cRGF2_Im_dSigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_w + eHF(a) - eHF(i) - eHF(j)
eta_tilde = eta - Im_w + e_cap(i) -( e_cap(a) - e_cap(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
cRGF2_Im_dSigC = cRGF2_Im_dSigC - 2d0*num*eps*eta_tilde/(eps**2 + eta_tilde**2)**2
end do
end do
end do
! Virtual part of the correlation self-energy
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_w + eHF(i) - eHF(a) - eHF(b)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
eta_tilde = eta + Im_w - e_cap(a) - e_cap(b) + e_cap(i)
cRGF2_Im_dSigC = cRGF2_Im_dSigC + 2d0*num*eps*eta_tilde/(eps**2 + eta_tilde**2)**2
end do
end do
end do
end function

97
src/GF/cRGF2_QP_graph.f90 Normal file
View File

@ -0,0 +1,97 @@
subroutine cRGF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,e_cap,ERI,Re_eGFlin,Im_eGFlin,Re_eOld,Im_eold,Re_eGF,Im_eGF,Re_Z,Im_Z)
! Compute the graphical solution of the GF2 QP equation
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: Re_eGFlin(nBas)
double precision,intent(in) :: Im_eGFlin(nBas)
double precision,intent(in) :: Re_eOld(nBas)
double precision,intent(in) :: Im_eOld(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: p
integer :: nIt
integer,parameter :: maxIt = 64
double precision,parameter :: thresh = 1d-6
double precision,external :: cRGF2_Re_SigC,cRGF2_Im_SigC,cRGF2_Re_dSigC,cRGF2_Im_dSigC
double precision :: Re_SigC,Im_SigC,Re_dSigC,Im_dSigC
double precision :: Re_f,Im_f,Re_df,Im_df
double precision :: Re_w,Im_w
! Output variables
double precision,intent(out) :: Re_eGF(nBas),Im_eGF(nBas)
double precision,intent(out) :: Re_Z(nBas),Im_Z(nBas)
! Run Newton's algorithm to find the root
write(*,*)'-----------------------------------------------------'
write(*,'(A5,1X,A3,1X,A15,1X,A15,1X,A10)') 'Orb.','It.','Re(e_GFlin) (eV)','Re(e_GF) (eV)','Re(Z)'
write(*,'(A5,1X,A3,1X,A15,1X,A15,1X,A10)') 'Orb.','It.','Im(e_GFlin) (eV)','Im(e_GF) (eV)','Im(Z)'
write(*,*)'-----------------------------------------------------'
do p=nC+1,nBas-nR
Re_w = Re_eGFlin(p)
Im_w = Im_eGFlin(p)
nIt = 0
Re_f = 1d0
Im_f = 0d0
do while (abs(cmplx(Re_f,Im_f,kind=8)) > thresh .and. nIt < maxIt)
nIt = nIt + 1
Re_SigC = cRGF2_Re_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,Re_eOld,Im_eOld,ERI)
Im_SigC = cRGF2_Im_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,Re_eOld,Im_eOld,ERI)
Re_dSigC = cRGF2_Re_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,Re_eOld,Im_eOld,ERI)
Im_dSigC = cRGF2_Im_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,Re_eOld,Im_eOld,ERI)
Re_f = Re_w - eHF(p) - Re_SigC
Im_f = Im_w - e_cap(p) - Im_SigC
Re_df = (1d0 - Re_dSigC)/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Im_df = Im_dSigC/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Re_w = Re_w - Re_df*Re_f + Im_df*Im_f
Im_w = Im_w - Re_f*Im_df - Re_df*Im_f
end do
if(nIt == maxIt) then
Re_eGF(p) = Re_eGFlin(p)
Im_eGF(p) = Im_eGFlin(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,Re_eGFlin(p)*HaToeV,Re_eGF(p)*HaToeV,Re_Z(p),'Cvg Failed!'
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,Im_eGFlin(p)*HaToeV,Im_eGF(p)*HaToeV,Im_Z(p),'Cvg Failed!'
else
Re_eGF(p) = Re_w
Im_eGF(p) = Im_w
Re_Z(p) = Re_df
Im_Z(p) = Im_df
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Re_eGFlin(p)*HaToeV,Re_eGF(p)*HaToeV,Re_Z(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Im_eGFlin(p)*HaToeV,Im_eGF(p)*HaToeV,Im_Z(p)
write(*,*)'-----------------------------------------------------'
end if
end do
end subroutine

58
src/GF/cRGF2_Re_SigC.f90 Normal file
View File

@ -0,0 +1,58 @@
double precision function cRGF2_Re_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,eHF,e_cap,ERI)
! Compute diagonal of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
double precision :: eps
double precision :: eta_tilde
double precision :: num
! Initialize
cRGF2_Re_SigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_w + eHF(a) - eHF(i) - eHF(j)
eta_tilde = eta - Im_w + e_cap(i) -(e_cap(a) - e_cap(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
cRGF2_Re_SigC = cRGF2_Re_SigC + num*eps/(eps**2 + eta_tilde**2)
end do
end do
end do
! Virtual part of the correlation self-energy
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_w + eHF(i) - eHF(a) - eHF(b)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
eta_tilde = eta + Im_w - e_cap(a) - e_cap(b) + e_cap(i)
cRGF2_Re_SigC = cRGF2_Re_SigC + num*eps/(eps**2 + eta_tilde**2)
end do
end do
end do
end function

59
src/GF/cRGF2_Re_dSigC.f90 Normal file
View File

@ -0,0 +1,59 @@
double precision function cRGF2_Re_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,eHF,e_cap,ERI)
! Compute diagonal of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
double precision :: eps
double precision :: eta_tilde
double precision :: num
! Initialize
cRGF2_Re_dSigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_w + eHF(a) - eHF(i) - eHF(j)
eta_tilde = eta - Im_w + e_cap(i) - (e_cap(a) - e_cap(j))
cRGF2_Re_dSigC = cRGF2_Re_dSigC -&
(2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
end do
end do
end do
! Virtual part of the correlation self-energy
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_w + eHF(i) - eHF(a) - eHF(b)
eta_tilde = eta + Im_w - e_cap(a) - e_cap(b) + e_cap(i)
cRGF2_Re_dSigC = cRGF2_Re_dSigC -&
(2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
end do
end do
end do
end function

87
src/GF/cRGF2_self_energy_diag.f90 Normal file
View File

@ -0,0 +1,87 @@
subroutine cRGF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,e,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z,e_cap)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
integer :: p
double precision :: eps
double precision :: eta_tilde
double precision :: num
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
! Output variables
double precision,intent(out) :: Re_SigC(nBas)
double precision,intent(out) :: Im_SigC(nBas)
double precision,intent(out) :: Re_Z(nBas)
double precision,intent(out) :: Im_Z(nBas)
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas))
Re_SigC(:) = 0d0
Im_SigC(:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
! Compute GF2 self-energy
do p=nC+1,nBas-nR
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = e(p) + e(a) - e(i) - e(j)
eta_tilde = eta - e_cap(p) + e_cap(i) - (e_cap(a) - e_cap(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
Re_SigC(p) = Re_SigC(p) + num*eps/(eps**2 + eta_tilde**2)
Im_SigC(p) = Im_SigC(p) + num*eta_tilde/(eps**2 + eta_tilde**2)
Re_DS(p) = Re_DS(p) - num*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
Im_DS(p) = Im_DS(p) - 2*num*eta_tilde*eps/(eps**2 + eta_tilde**2)**2
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = e(p) + e(i) - e(a) - e(b)
eta_tilde = eta + e_cap(p) - e_cap(a) - e_cap(b) + e_cap(i)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
Re_SigC(p) = Re_SigC(p) + num*eps/(eps**2 + eta_tilde**2)
Im_SigC(p) = Im_SigC(p) - num*eta_tilde/(eps**2 + eta_tilde**2)
Re_DS(p) = Re_DS(p) - num*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
Im_DS(p) = Im_DS(p) + 2*num*eta_tilde*eps/(eps**2 + eta_tilde**2)**2
end do
end do
end do
end do
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
deallocate(Re_DS,Im_DS)
end subroutine

112
src/GF/complex_RGF.f90 Normal file
View File

@ -0,0 +1,112 @@
subroutine complex_RGF(dotest,docG0F2,doevGF2,doqsGF2,maxSCF, &
thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF, &
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF, &
CAP_AO,CAP_MO)
! Perform a one-shot second-order Green function calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: docG0F2,doevGF2,doqsGF2
integer,intent(in) :: maxSCF
double precision,intent(in) :: thresh
integer,intent(in) :: max_diis
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: regularize
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
double precision,intent(in) :: rNuc(nNuc,ncart)
double precision,intent(in) :: ENuc
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: cHF(nBas,nOrb)
complex*16,intent(in) :: PHF(nBas,nBas)
complex*16,intent(in) :: S(nBas,nBas)
complex*16,intent(in) :: CAP_AO(nBas,nBas)
complex*16,intent(in) :: CAP_MO(nBas,nBas)
double precision,intent(in) :: T(nBas,nBas)
double precision,intent(in) :: V(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
double precision,intent(in) :: X(nBas,nOrb)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
complex*16,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
complex*16,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
! Local variables
double precision :: start_GF ,end_GF ,t_GF
!------------------------------------------------------------------------
! Compute complex G0F2 electronic binding energies
!------------------------------------------------------------------------
if(docG0F2) then
call wall_time(start_GF)
call complex_cRG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS, &
ENuc,ERHF,ERI_MO,CAP_MO,dipole_int_MO,eHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
write(*,*)
end if
if(doevGF2) then
call wall_time(start_GF)
call complex_evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,triplet, &
linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
write(*,*)
end if
if(doqsGF2) then
call wall_time(start_GF)
call complex_qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA, &
dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc, &
rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, &
ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF, &
CAP_AO,CAP_MO)
call wall_time(end_GF)
t_GF = end_GF - start_GF
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
write(*,*)
end if
end subroutine

101
src/GF/complex_cRG0F2.f90 Normal file
View File

@ -0,0 +1,101 @@
subroutine complex_cRG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,CAP,dipole_int,eHF)
! Perform a one-shot second-order Green function calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: regularize
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nO
integer,intent(in) :: nC
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: CAP(nOrb,nOrb)
complex*16,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
complex*16,intent(in) :: dipole_int(nOrb,nOrb,ncart)
! Local variables
integer :: p
double precision :: Ec
double precision :: flow
double precision :: EcBSE(nspin)
double precision,allocatable :: Re_SigC(:)
double precision,allocatable :: Im_SigC(:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
double precision,allocatable :: Re_eGFlin(:)
double precision, allocatable :: Im_eGFlin(:)
double precision,allocatable :: Re_eGF(:)
double precision,allocatable :: Im_eGF(:)
double precision, allocatable :: Re_eHF(:)
double precision, allocatable :: Im_eHF(:)
! Hello world
write(*,*)
write(*,*)'*******************************'
write(*,*)'* Restricted G0F2 Calculation *'
write(*,*)'*******************************'
write(*,*)
! Memory allocation
allocate(Re_SigC(nOrb),Im_SigC(nOrb), Re_Z(nOrb),Im_Z(nOrb),&
Re_eGFlin(nOrb),Im_eGFlin(nOrb), Re_eGF(nOrb),Im_eGF(nOrb),Re_eHF(nOrb),Im_eHF(nOrb))
Re_eHF(:) = real(eHF(:))
Im_eHF(:) = aimag(eHF(:))
flow = 100d0
! Frequency-dependent second-order contribution
if(regularize) then
call complex_cRGF2_reg_self_energy_diag(flow,eta,nOrb,nC,nO,nV,nR,Re_eHF,Im_eHF,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z)
else
call complex_cRGF2_self_energy_diag(eta,nOrb,nC,nO,nV,nR,Re_eHF,Im_eHF,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z)
end if
Re_eGFlin(:) = Re_eHF(:) + Re_Z(:)*Re_SigC(:) - Im_Z(:)*Im_SigC(:)
Im_eGFlin(:) = Im_eHF(:) + Re_Z(:)*Im_SigC(:) + Im_Z(:)*Re_SigC(:)
if(linearize) then
write(*,*) '*** Quasiparticle energies obtained by linearization ***'
Re_eGF(:) = Re_eGFlin(:)
Im_eGF(:) = Im_eGFlin(:)
else
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call complex_cRGF2_QP_graph(flow,regularize,eta,nOrb,nC,nO,nV,nR,Re_eHF,Im_eHF,ERI,Re_eGFlin,Im_eGFlin,&
Re_eHF,Im_eHF,Re_eGF,Im_eGF,Re_Z,Im_Z)
end if
! Print results
call print_complex_cRG0F2(nOrb,nO,Re_eHF,Im_eHF,Re_SigC,Im_SigC,Re_eGF,Im_eGF,Re_Z,Im_Z,ENuc,ERHF,Ec)
deallocate(Re_SigC,Im_SigC, Re_Z,Im_Z,&
Re_eGFlin,Im_eGFlin, Re_eGF,Im_eGF)
end subroutine

104
src/GF/complex_cRGF2_QP_graph.f90 Normal file
View File

@ -0,0 +1,104 @@
subroutine complex_cRGF2_QP_graph(flow,reg,eta,nBas,nC,nO,nV,nR,Re_eHF,Im_eHF,&
ERI,Re_eGFlin,Im_eGFlin,Re_eOld,Im_eold,Re_eGF,Im_eGF,Re_Z,Im_Z)
! Compute the graphical solution of the complex GF2 QP equation
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
double precision,intent(in) :: flow
logical, intent(in) :: reg
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: Re_eHF(nBas)
double precision,intent(in) :: Im_eHF(nBas)
double precision,intent(in) :: Re_eGFlin(nBas)
double precision,intent(in) :: Im_eGFlin(nBas)
double precision,intent(in) :: Re_eOld(nBas)
double precision,intent(in) :: Im_eOld(nBas)
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: p
integer :: nIt
integer,parameter :: maxIt = 64
double precision,parameter :: thresh = 1d-6
double precision :: Re_SigC,Im_SigC,Re_dSigC,Im_dSigC
double precision :: Re_f,Im_f,Re_df,Im_df
double precision :: Re_w,Im_w
! Output variables
double precision,intent(out) :: Re_eGF(nBas),Im_eGF(nBas)
double precision,intent(out) :: Re_Z(nBas),Im_Z(nBas)
! Run Newton's algorithm to find the root
write(*,*)'-----------------------------------------------------'
write(*,'(A5,1X,A3,1X,A15,1X,A15,1X,A10)') 'Orb.','It.','Re(e_GFlin) (eV)','Re(e_GF) (eV)','Re(Z)'
write(*,'(A5,1X,A3,1X,A15,1X,A15,1X,A10)') 'Orb.','It.','Im(e_GFlin) (eV)','Im(e_GF) (eV)','Im(Z)'
write(*,*)'-----------------------------------------------------'
Re_SigC = 0d0
Im_SigC = 0d0
Re_dSigC = 0d0
Im_dSigC = 0d0
do p=nC+1,nBas-nR
Re_w = Re_eGFlin(p)
Im_w = Im_eGFlin(p)
nIt = 0
Re_f = 1d0
Im_f = 1d0
do while (abs(cmplx(Re_f,Im_f,kind=8)) > thresh .and. nIt < maxIt)
nIt = nIt + 1
if(reg) then
call complex_cRGF_reg_SigC_dSigC(flow,p,eta,nBas,nC,nO,nV,nR,Re_w,Im_w,Re_eOld,Im_eOld,ERI,&
Re_SigC,Im_SigC,Re_dSigC,Im_dSigC)
else
call complex_cRGF_SigC_dSigC(p,eta,nBas,nC,nO,nV,nR,Re_w,Im_w,Re_eOld,Im_eOld,ERI,&
Re_SigC,Im_SigC,Re_dSigC,Im_dSigC)
end if
Re_f = Re_w - Re_eHF(p) - Re_SigC
Im_f = Im_w - Im_eHF(p) - Im_SigC
Re_df = (1d0 - Re_dSigC)/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Im_df = Im_dSigC/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Re_w = Re_w - Re_df*Re_f + Im_df*Im_f
Im_w = Im_w - Re_f*Im_df - Re_df*Im_f
end do
if(nIt == maxIt) then
Re_eGF(p) = Re_eGFlin(p)
Im_eGF(p) = Im_eGFlin(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,Re_eGFlin(p)*HaToeV,Re_eGF(p)*HaToeV,Re_Z(p),'Cvg Failed!'
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,Im_eGFlin(p)*HaToeV,Im_eGF(p)*HaToeV,Im_Z(p),'Cvg Failed!'
else
Re_eGF(p) = Re_w
Im_eGF(p) = Im_w
Re_Z(p) = Re_df
Im_Z(p) = Im_df
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Re_eGFlin(p)*HaToeV,Re_eGF(p)*HaToeV,Re_Z(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Im_eGFlin(p)*HaToeV,Im_eGF(p)*HaToeV,Im_Z(p)
!write(*,*) "e_GF - e_HF - \Sigma(e_GF) = ", sqrt(Re_f**2 + Im_f**2)
write(*,*)'-----------------------------------------------------'
end if
end do
end subroutine

138
src/GF/complex_cRGF2_reg_self_energy.f90 Normal file
View File

@ -0,0 +1,138 @@
subroutine complex_cRGF2_reg_self_energy(flow,eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
double precision,intent(in) :: flow
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
complex*16,intent(in) :: e(nBas)
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
integer :: p,q
double precision :: eps_p
double precision :: eps_q
double precision :: s
double precision :: eta_tilde_p
double precision :: eta_tilde_q
complex*16 :: num
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
complex*16 :: z_dummy
double precision,allocatable :: Re_SigC(:,:)
double precision,allocatable :: Im_SigC(:,:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
! Output variables
complex*16,intent(out) :: SigC(nBas,nBas)
complex*16,intent(out) :: Z(nBas)
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas),Re_SigC(nBas,nBas),Im_SigC(nBas,nBas),&
Re_Z(nBas),Im_Z(nBas))
Re_SigC(:,:) = 0d0
Im_SigC(:,:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
s = flow
! Compute GF2 self-energy
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,Re_SigC,Im_SigC,ERI,eta,nC,nO,nBas,nR,e,s) &
!$OMP PRIVATE(p,q,i,j,a,eps_p,eps_q,num,eta_tilde_p,eta_tilde_q,z_dummy) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do q=nC+1,nBas-nR
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps_p = real(e(p)) + real(e(a)) - real(e(i)) - real(e(j))
eps_q = real(e(q)) + real(e(a)) - real(e(i)) - real(e(j))
eta_tilde_p = eta - aimag(e(p)) + aimag(e(i)) - (aimag(e(a)) - aimag(e(j)))
eta_tilde_q = eta - aimag(e(q)) + aimag(e(i)) - (aimag(e(a)) - aimag(e(j)))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j)&
*(1d0 - exp(-s*(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2)))
z_dummy = num*cmplx((eps_p + eps_q)/(eps_p**2 + eta_tilde_p**2 +eps_q**2 + eta_tilde_q**2 ),&
(eta_tilde_p + eta_tilde_q)/(eps_p**2 + eta_tilde_p**2 +eps_q**2 + eta_tilde_q**2 ),kind=8)
Re_SigC(p,q) = Re_SigC(p,q) + real(z_dummy)
Im_SigC(p,q) = Im_SigC(p,q) + aimag(z_dummy)
if(p==q) then
z_dummy = num*cmplx(-(eps_p**2 - eta_tilde_p**2)/(eps_p**2 + eta_tilde_p**2)**2,&
-2*eta_tilde_p*eps_p/(eps_p**2 + eta_tilde_p**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end if
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,Re_SigC,Im_SigC,ERI,eta,nC,nO,nBas,nR,e,s) &
!$OMP PRIVATE(p,q,i,a,b,eps_p,eps_q,num,eta_tilde_p,eta_tilde_q,z_dummy) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do q=nC+1,nBas-nR
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps_p = real(e(p)) + real(e(i)) - real(e(a)) - real(e(b))
eps_q = real(e(q)) + real(e(i)) - real(e(a)) - real(e(b))
eta_tilde_p = eta + aimag(e(p)) - aimag(e(a)) - aimag(e(b)) + aimag(e(i))
eta_tilde_q = eta + aimag(e(q)) - aimag(e(a)) - aimag(e(b)) + aimag(e(i))
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b)&
*(1d0 - exp(-s*(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2)))
z_dummy = num*cmplx((eps_p + eps_q)/(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2),&
-(eta_tilde_p + eta_tilde_q)/(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2),kind=8)
Re_SigC(p,q) = Re_SigC(p,q) + real(z_dummy)
Im_SigC(p,q) = Im_SigC(p,q) + aimag(z_dummy)
if(p==q) then
z_dummy = num*cmplx(-(eps_p**2 - eta_tilde_p**2)/(eps_p**2 + eta_tilde_p**2)**2,&
2*eta_tilde_p*eps_p/(eps_p**2 + eta_tilde_p**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end if
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Z = cmplx(Re_Z,Im_Z,kind=8)
SigC = cmplx(Re_SigC,Im_SigC,kind=8)
deallocate(Re_DS,Im_DS,Re_Z,Im_Z,Re_SigC,Im_SigC)
end subroutine

98
src/GF/complex_cRGF2_reg_self_energy_diag.f90 Normal file
View File

@ -0,0 +1,98 @@
subroutine complex_cRGF2_reg_self_energy_diag(flow,eta,nBas,nC,nO,nV,nR,Re_e,Im_e,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: flow
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
integer :: p
double precision :: eps
double precision :: s
double precision :: eta_tilde
complex*16 :: num
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
complex*16 :: z_dummy
! Output variables
double precision,intent(out) :: Re_SigC(nBas)
double precision,intent(out) :: Im_SigC(nBas)
double precision,intent(out) :: Re_Z(nBas)
double precision,intent(out) :: Im_Z(nBas)
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas))
Re_SigC(:) = 0d0
Im_SigC(:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
s = flow
! Compute GF2 self-energy
do p=nC+1,nBas-nR
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_e(p) + Re_e(a) - Re_e(i) - Re_e(j)
eta_tilde = eta - Im_e(p) + Im_e(i) - (Im_e(a) - Im_e(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) &
*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC(p) = Re_SigC(p) + real(z_dummy)
Im_SigC(p) = Im_SigC(p) + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_e(p) + Re_e(i) - Re_e(a) - Re_e(b)
eta_tilde = eta + Im_e(p) - Im_e(a) - Im_e(b) + Im_e(i)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)&
*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC(p) = Re_SigC(p) + real(z_dummy)
Im_SigC(p) = Im_SigC(p) + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end do
end do
end do
end do
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
deallocate(Re_DS,Im_DS)
end subroutine

124
src/GF/complex_cRGF2_self_energy.f90 Normal file
View File

@ -0,0 +1,124 @@
subroutine complex_cRGF2_self_energy(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
complex*16,intent(in) :: e(nBas)
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
integer :: p,q
double precision :: eps
double precision :: eta_tilde
complex*16 :: num
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
complex*16 :: z_dummy
double precision,allocatable :: Re_SigC(:,:)
double precision,allocatable :: Im_SigC(:,:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
! Output variables
complex*16,intent(out) :: SigC(nBas,nBas)
complex*16,intent(out) :: Z(nBas)
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas),Re_SigC(nBas,nBas),Im_SigC(nBas,nBas),&
Re_Z(nBas),Im_Z(nBas))
Re_SigC(:,:) = 0d0
Im_SigC(:,:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
! Compute GF2 self-energy
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,Im_SigC,Re_SigC,ERI,eta,nC,nO,nBas,nR,e) &
!$OMP PRIVATE(p,i,j,a,eps,num,eta_tilde,z_dummy) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do q=nC+1,nBas-nR
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = real(e(p)) + real(e(a)) - real(e(i)) - real(e(j))
eta_tilde = eta - aimag(e(p)) + aimag(e(i)) - (aimag(e(a)) - aimag(e(j)))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j)
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC(p,q) = Re_SigC(p,q) + real(z_dummy)
Im_SigC(p,q) = Im_SigC(p,q) + aimag(z_dummy)
if(p==q) then
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end if
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,Re_SigC,Im_SigC,ERI,eta,nC,nO,nBas,nR,e) &
!$OMP PRIVATE(p,i,a,b,eps,num,eta_tilde,z_dummy) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do q=nC+1,nBas-nR
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = real(e(p)) + real(e(i)) - real(e(a)) - real(e(b))
eta_tilde = eta + aimag(e(p)) - aimag(e(a)) - aimag(e(b)) + aimag(e(i))
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b)
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC(p,q) = Re_SigC(p,q) + real(z_dummy)
Im_SigC(p,q) = Im_SigC(p,q) + aimag(z_dummy)
if(p==q) then
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end if
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Z = cmplx(Re_Z,Im_Z,kind=8)
SigC = cmplx(Re_SigC,Im_SigC,kind=8)
deallocate(Re_DS,Im_DS,Re_Z,Im_Z,Re_SigC,Im_SigC)
end subroutine

95
src/GF/complex_cRGF2_self_energy_diag.f90 Normal file
View File

@ -0,0 +1,95 @@
subroutine complex_cRGF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,Re_e,Im_e,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
integer :: p
double precision :: eps
double precision :: eta_tilde
complex*16 :: num
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
complex*16 :: z_dummy
! Output variables
double precision,intent(out) :: Re_SigC(nBas)
double precision,intent(out) :: Im_SigC(nBas)
double precision,intent(out) :: Re_Z(nBas)
double precision,intent(out) :: Im_Z(nBas)
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas))
Re_SigC(:) = 0d0
Im_SigC(:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
! Compute GF2 self-energy
do p=nC+1,nBas-nR
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_e(p) + Re_e(a) - Re_e(i) - Re_e(j)
eta_tilde = eta - Im_e(p) + Im_e(i) - (Im_e(a) - Im_e(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC(p) = Re_SigC(p) + real(z_dummy)
Im_SigC(p) = Im_SigC(p) + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_e(p) + Re_e(i) - Re_e(a) - Re_e(b)
eta_tilde = eta + Im_e(p) - Im_e(a) - Im_e(b) + Im_e(i)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC(p) = Re_SigC(p) + real(z_dummy)
Im_SigC(p) = Im_SigC(p) + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(z_dummy)
Im_DS(p) = Im_DS(p) + aimag(z_dummy)
end do
end do
end do
end do
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
deallocate(Re_DS,Im_DS)
call vecout(nBas,Re_SigC)
call vecout(nBas,Im_SigC)
end subroutine

84
src/GF/complex_cRGF_SigC_dSigC.f90 Normal file
View File

@ -0,0 +1,84 @@
subroutine complex_cRGF_SigC_dSigC(p,eta,nBas,nC,nO,nV,nR,Re_w,Im_w,Re_e,Im_e,ERI,Re_SigC,Im_SigC,Re_DS,Im_DS)
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
double precision :: eps
double precision :: eta_tilde
complex*16 :: num
complex*16 :: z_dummy
! Output variables
double precision,intent(out) :: Re_SigC
double precision,intent(out) :: Im_SigC
double precision,intent(out) :: Re_DS
double precision,intent(out) :: Im_DS
! Initialize
Re_SigC = 0d0
Im_SigC = 0d0
Re_DS = 0d0
Im_DS = 0d0
! Compute GF2 self-energy
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_w + Re_e(a) - Re_e(i) - Re_e(j)
eta_tilde = eta - Im_w + Im_e(i) - (Im_e(a) - Im_e(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(z_dummy)
Im_SigC = Im_SigC + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(z_dummy)
Im_DS = Im_DS + aimag(z_dummy)
end do
end do
end do
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_w + Re_e(i) - Re_e(a) - Re_e(b)
eta_tilde = eta + Im_w - Im_e(a) - Im_e(b) + Im_e(i)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(z_dummy)
Im_SigC = Im_SigC + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(z_dummy)
Im_DS = Im_DS + aimag(z_dummy)
end do
end do
end do
end subroutine

88
src/GF/complex_cRGF_reg_SigC_dSigC.f90 Normal file
View File

@ -0,0 +1,88 @@
subroutine complex_cRGF_reg_SigC_dSigC(s,p,eta,nBas,nC,nO,nV,nR,Re_w,Im_w,Re_e,Im_e,ERI,Re_SigC,Im_SigC,Re_DS,Im_DS)
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: eta
double precision,intent(in) :: s
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
complex*16,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: i,j,a,b
double precision :: eps
double precision :: eta_tilde
complex*16 :: num
complex*16 :: z_dummy
! Output variables
double precision,intent(out) :: Re_SigC
double precision,intent(out) :: Im_SigC
double precision,intent(out) :: Re_DS
double precision,intent(out) :: Im_DS
! Initialize
Re_SigC = 0d0
Im_SigC = 0d0
Re_DS = 0d0
Im_DS = 0d0
! Compute GF2 self-energy
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = Re_w + Re_e(a) - Re_e(i) - Re_e(j)
eta_tilde = eta - Im_w + Im_e(i) - (Im_e(a) - Im_e(j))
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)&
*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(z_dummy)
Im_SigC = Im_SigC + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(z_dummy)
Im_DS = Im_DS + aimag(z_dummy)
end do
end do
end do
do i=nC+1,nO
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = Re_w + Re_e(i) - Re_e(a) - Re_e(b)
eta_tilde = eta + Im_w - Im_e(a) - Im_e(b) + Im_e(i)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)&
*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
z_dummy = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(z_dummy)
Im_SigC = Im_SigC + aimag(z_dummy)
z_dummy = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(z_dummy)
Im_DS = Im_DS + aimag(z_dummy)
end do
end do
end do
end subroutine

222
src/GF/complex_evRGF2.f90 Normal file
View File

@ -0,0 +1,222 @@
subroutine complex_evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,triplet, &
linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform eigenvalue self-consistent second-order Green function calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
integer,intent(in) :: maxSCF
double precision,intent(in) :: thresh
integer,intent(in) :: max_diis
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: regularize
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nO
integer,intent(in) :: nC
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
complex*16,intent(in) :: dipole_int(nOrb,nOrb,ncart)
! Local variables
integer :: nSCF
integer :: n_diis
double precision :: Ec
double precision :: flow
double precision :: EcBSE(nspin)
double precision :: Conv
double precision :: rcond
double precision,allocatable :: Re_eHF(:)
double precision,allocatable :: Im_eHF(:)
complex*16,allocatable :: eGF(:)
double precision,allocatable :: Re_eGF(:)
double precision,allocatable :: Im_eGF(:)
complex*16,allocatable :: eOld(:)
double precision,allocatable :: Re_eOld(:)
double precision,allocatable :: Im_eOld(:)
double precision,allocatable :: Re_SigC(:)
double precision,allocatable :: Im_SigC(:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
complex*16,allocatable :: error_diis(:,:)
complex*16,allocatable :: e_diis(:,:)
! Hello world
write(*,*)
write(*,*)'********************************'
write(*,*)'* Restricted evGF2 Calculation *'
write(*,*)'********************************'
write(*,*)
! Memory allocation
allocate(Re_SigC(nOrb),Im_SigC(nOrb), Re_Z(nOrb),Im_Z(nOrb), eGF(nOrb),&
Re_eGF(nOrb),Im_eGF(nOrb), eOld(nOrb),Re_eOld(nOrb),Im_eOld(nOrb),&
error_diis(nOrb,max_diis), e_diis(nOrb,max_diis),Re_eHF(nOrb),Im_eHF(nOrb))
! Initialization
Conv = 1d0
nSCF = 0
n_diis = 0
e_diis(:,:) = 0d0
error_diis(:,:) = 0d0
Re_eHF(:) = real(eHF(:))
Im_eHF(:) = aimag(eHF(:))
eGF(:) = eHF(:)
Re_eGF(:) = Re_eHF(:)
Im_eGF(:) = Im_eHF(:)
eOld(:) = eHF(:)
Re_eOld(:) = Re_eHF(:)
Im_eOld(:) = Im_eHF(:)
rcond = 0d0
Re_Z(:) = 0d0
Im_Z(:) = 0d0
flow = 100d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
do while(Conv > thresh .and. nSCF < maxSCF)
! Frequency-dependent second-order contribution
if(regularize) then
call complex_cRGF2_reg_self_energy_diag(flow,eta,nOrb,nC,nO,nV,nR,Re_eGF,Im_eGF,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z)
else
call complex_cRGF2_self_energy_diag(eta,nOrb,nC,nO,nV,nR,Re_eGF,Im_eGF,ERI,Re_SigC,Im_SigC,Re_Z,Im_Z)
end if
! Solve the quasi-particle equation
if(linearize) then
Re_eGF(:) = Re_eHF(:) + Re_SigC(:)
Im_eGF(:) = Im_eHF(:) + Im_SigC(:)
eGF = cmplx(Re_eGF,Im_eGF,kind=8)
else
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call complex_cRGF2_QP_graph(flow,regularize,eta,nOrb,nC,nO,nV,nR,Re_eHF,Im_eHF,&
ERI,Re_eOld,Im_eOld,Re_eOld,Im_eOld,Re_eGF,Im_eGF,Re_Z,Im_Z)
eGF = cmplx(Re_eGF,Im_eGF,kind=8)
end if
Conv = maxval(abs(eGF - eOld))
! Print results
!call RMP2(.false.,regularize,nOrb,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_complex_evRGF2(nOrb,nO,nSCF,Conv,Re_eHF,Im_eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGF,Im_eGF)
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call complex_DIIS_extrapolation(rcond,nOrb,nOrb,n_diis,error_diis,e_diis,eGF-eOld,eGF)
if(abs(rcond) < 1d-15) n_diis = 0
Re_eGF(:) = real(eGF(:))
Im_eGF(:) = aimag(eGF(:))
eOld(:) = eGF(:)
Re_eOld(:) = real(eOld(:))
Im_eOld(:) = aimag(eOld(:))
! Increment
nSCF = nSCF + 1
end do
!------------------------------------------------------------------------
! End main SCF loop
!------------------------------------------------------------------------
! Did it actually converge?
if(nSCF == maxSCF+1) then
write(*,*)
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)' Convergence failed '
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)
stop
end if
!! Perform BSE@GF2 calculation
!
! if(dophBSE) then
!
! call RGF2_phBSE(TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eGF,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGF2 correlation energy (singlet) =',EcBSE(1)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGF2 correlation energy (triplet) =',EcBSE(2)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGF2 correlation energy =',sum(EcBSE(:))
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGF2 total energy =',ENuc + ERHF + sum(EcBSE(:))
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Perform ppBSE@GF2 calculation
!
! if(doppBSE) then
!
! call RGF2_ppBSE(TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,ERI,dipole_int,eGF,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGF2 correlation energy (singlet) =',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGF2 correlation energy (triplet) =',3d0*EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGF2 correlation energy =',EcBSE(1) + 3d0*EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGF2 total energy =',ENuc + ERHF + EcBSE(1) + 3d0*EcBSE(2),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Testing zone
!
! if(dotest) then
!
! call dump_test_value('R','evGF2 correlation energy',Ec)
! call dump_test_value('R','evGF2 HOMO energy',eGF(nO))
! call dump_test_value('R','evGF2 LUMO energy',eGF(nO+1))
!
! end if
deallocate(Re_SigC,Im_SigC, Re_Z,Im_Z, eGF,Re_eGF,Im_eGF, eOld,Re_eOld,Im_eOld, error_diis, e_diis)
end subroutine

346
src/GF/complex_qsRGF2.f90 Normal file
View File

@ -0,0 +1,346 @@
subroutine complex_qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA, &
dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc, &
rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, &
ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF, &
CAP_AO,CAP_MO)
! Perform a quasiparticle self-consistent GF2 calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: singlet
logical,intent(in) :: triplet
double precision,intent(in) :: eta
logical,intent(in) :: regularize
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
double precision,intent(in) :: rNuc(nNuc,ncart)
double precision,intent(in) :: ENuc
integer,intent(in) :: nBas,nOrb,nC,nO,nV,nR,nS
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: cHF(nBas,nOrb)
complex*16,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: S(nBas,nBas)
double precision,intent(in) :: T(nBas,nBas)
double precision,intent(in) :: V(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
double precision,intent(in) :: X(nBas,nOrb)
double precision,intent(in) :: CAP_AO(nBas,nBas)
complex*16,intent(inout) :: CAP_MO(nBas,nBas)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
complex*16,intent(inout) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
complex*16,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
! Local variables
integer :: nSCF
integer :: nBas_Sq
integer :: ispin
integer :: n_diis
complex*16 :: EqsGF2
double precision :: Conv
double precision :: flow
double precision :: rcond
complex*16,external :: complex_trace_matrix
complex*16 :: dipole(ncart)
complex*16 :: ET
complex*16 :: EV
complex*16 :: EW
complex*16 :: EJ
complex*16 :: Ex
complex*16 :: Ec
complex*16 :: EcBSE(nspin)
complex*16,allocatable :: error_diis(:,:)
complex*16,allocatable :: F_diis(:,:)
complex*16,allocatable :: c(:,:)
complex*16,allocatable :: cp(:,:)
complex*16,allocatable :: eGF(:)
complex*16,allocatable :: eOld(:)
complex*16,allocatable :: P(:,:)
complex*16,allocatable :: F(:,:)
complex*16,allocatable :: Fp(:,:)
complex*16,allocatable :: J(:,:)
complex*16,allocatable :: K(:,:)
complex*16,allocatable :: SigC(:,:)
complex*16,allocatable :: SigCp(:,:)
complex*16,allocatable :: Z(:)
complex*16,allocatable :: error(:,:)
! Hello world
write(*,*)
write(*,*)'********************************'
write(*,*)'* Restricted qsGF2 Calculation *'
write(*,*)'********************************'
write(*,*)
! Warning
write(*,*) '!! ERIs in MO basis will be overwritten in qsGF2 !!'
write(*,*)
! Stuff
nBas_Sq = nBas*nBas
flow = 500d0
! TDA
if(TDA) then
write(*,*) 'Tamm-Dancoff approximation activated!'
write(*,*)
end if
! Memory allocation
allocate(eGF(nOrb))
allocate(eOld(nOrb))
allocate(c(nBas,nOrb))
allocate(cp(nOrb,nOrb))
allocate(Fp(nOrb,nOrb))
allocate(P(nBas,nBas))
allocate(F(nBas,nBas))
allocate(J(nBas,nBas))
allocate(K(nBas,nBas))
allocate(error(nBas,nBas))
allocate(Z(nOrb))
allocate(SigC(nOrb,nOrb))
allocate(SigCp(nBas,nBas))
allocate(error_diis(nBas_Sq,max_diis))
allocate(F_diis(nBas_Sq,max_diis))
! Initialization
nSCF = -1
n_diis = 0
ispin = 1
Conv = 1d0
P(:,:) = PHF(:,:)
eOld(:) = eHF(:)
eGF(:) = eHF(:)
c(:,:) = cHF(:,:)
F_diis(:,:) = 0d0
error_diis(:,:) = 0d0
rcond = 0d0
!------------------------------------------------------------------------
! Main loop
!------------------------------------------------------------------------
do while(Conv > thresh .and. nSCF <= maxSCF)
! Increment
nSCF = nSCF + 1
! Buid Hartree matrix
call complex_Hartree_matrix_AO_basis(nBas, P, ERI_AO, J)
! Compute exchange part of the self-energy
call complex_exchange_matrix_AO_basis(nBas, P, ERI_AO, K)
! AO to MO transformation of two-electron integrals
call complex_AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
! Compute self-energy and renormalization factor
if(regularize) then
call complex_cRGF2_reg_self_energy(flow,eta, nOrb, nC, nO, nV, nR, eGF, ERI_MO, SigC, Z)
else
call complex_cRGF2_self_energy(eta, nOrb, nC, nO, nV, nR, eGF, ERI_MO, SigC, Z)
end if
! Make correlation self-energy Hermitian and transform it back to AO basis
SigC = 0.5d0*(SigC + transpose(SigC))
call complex_MOtoAO(nBas, nOrb, S, c, SigC, SigCp)
! Solve the quasi-particle equation
F(:,:) = cmplx(Hc(:,:),CAP_AO(:,:),kind=8) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
if(nBas .ne. nOrb) then
call complex_complex_AOtoMO(nBas, nOrb, c(1,1), F(1,1), Fp(1,1))
call complex_MOtoAO(nBas, nOrb, S(1,1), c(1,1), Fp(1,1), F(1,1))
endif
! Compute commutator and convergence criteria
error = matmul(F, matmul(P, S)) - matmul(matmul(S, P), F)
! DIIS extrapolation
n_diis = min(n_diis+1, max_diis)
if(abs(rcond) > 1d-7) then
call complex_DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,error_diis,F_diis,error,F)
else
n_diis = 0
end if
! Diagonalize Hamiltonian in AO basis
if(nBas .eq. nOrb) then
Fp = matmul(transpose(X), matmul(F, X))
cp(:,:) = Fp(:,:)
call complex_diagonalize_matrix(nOrb, cp, eGF)
c = matmul(X, cp)
else
Fp = matmul(transpose(c), matmul(F, c))
cp(:,:) = Fp(:,:)
call complex_diagonalize_matrix(nOrb, cp, eGF)
c = matmul(c, cp)
endif
! Compute new density matrix in the AO basis
P(:,:) = 2d0*matmul(c(:,1:nO), transpose(c(:,1:nO)))
! Save quasiparticles energy for next cycle
Conv = maxval(abs(eGF - eOld))
eOld(:) = eGF(:)
!------------------------------------------------------------------------
! Compute total energy
!------------------------------------------------------------------------
! Kinetic energy
ET = complex_trace_matrix(nBas, matmul(P, T))
! Potential energy
EV = complex_trace_matrix(nBas, matmul(P, V))
! CAP
EW = complex_trace_matrix(nBas,matmul(P,(0d0,1d0)*CAP_AO))
! Hartree energy
EJ = 0.5d0*complex_trace_matrix(nBas, matmul(P, J))
! Exchange energy
Ex = 0.25d0*complex_trace_matrix(nBas, matmul(P, K))
! Correlation energy
!call RMP2(.false., regularize, nOrb, nC, nO, nV, nR, ERI_MO, ENuc, EqsGF2, eGF, Ec)
! Total energy
EqsGF2 = ET + EV + EJ + Ex + Ec
!------------------------------------------------------------------------
! Print results
!------------------------------------------------------------------------
!call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int_AO, dipole)
call print_complex_qsRGF2(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGF, &
c, SigC, Z, ENuc, ET, EV,EW, EJ, Ex, Ec, EqsGF2, dipole)
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
! Did it actually converge?
if(nSCF == maxSCF+1) then
write(*,*)
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)' Convergence failed '
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, error, error_diis, F_diis)
stop
end if
! Deallocate memory
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, error, error_diis, F_diis)
!! Perform phBSE@GF2 calculation
!
! if(dophBSE) then
!
! call RGF2_phBSE(TDA, dBSE, dTDA, singlet, triplet, eta, nOrb, nC, nO, &
! nV, nR, nS, ERI_MO, dipole_int_MO, eGF, EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGF2 correlation energy (singlet) =',EcBSE(1)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGF2 correlation energy (triplet) =',EcBSE(2)
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGF2 correlation energy =',sum(EcBSE(:))
! write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGF2 total energy =',ENuc + EqsGF2 + sum(EcBSE(:))
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
! Perform ppBSE@GF2 calculation
if(doppBSE) then
call RGF2_ppBSE(TDA, dBSE, dTDA, singlet, triplet, eta, nOrb, &
nC, nO, nV, nR, ERI_MO, dipole_int_MO, eGF, EcBSE)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGF2 correlation energy (singlet) =',EcBSE(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGF2 correlation energy (triplet) =',3d0*EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGF2 correlation energy =',EcBSE(1) + 3d0*EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGF2 total energy =',ENuc + EqsGF2 + EcBSE(1) + 3d0*EcBSE(2),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
end if
! Testing zone
if(dotest) then
call dump_test_value('R','qsGF2 correlation energy',Ec)
call dump_test_value('R','qsGF2 HOMO energy',eGF(nO))
call dump_test_value('R','qsGF2 LUMO energy',eGF(nO+1))
end if
end subroutine

47
src/GF/print_cRG0F2.f90 Normal file
View File

@ -0,0 +1,47 @@
subroutine print_cRG0F2(nBas,nO,eHF,e_cap,Re_Sig,Im_Sig,Re_eGF,Im_eGF,Re_Z,Im_Z,ENuc,ERHF,Ec)
! Print one-electron energies and other stuff for G0F2
implicit none
include 'parameters.h'
integer,intent(in) :: nBas
integer,intent(in) :: nO
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: Re_Sig(nBas)
double precision,intent(in) :: Im_Sig(nBas)
double precision,intent(in) :: Re_eGF(nBas)
double precision,intent(in) :: Im_eGF(nBas)
double precision,intent(in) :: Re_Z(nBas)
double precision,intent(in) :: Im_Z(nBas)
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: Ec
integer :: p
integer :: HOMO
integer :: LUMO
double precision :: Gap
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' One-shot G0F2 calculation'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','e_HF (eV)','|','Re(Sig_GF2) (eV)','|','Re(Z)','|','Re(e_GF2) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','CAP(p,p) (eV)','|','Im(Sig_GF2) (eV)','|','Im(Z)','|','Im(e_GF2) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',eHF(p)*HaToeV,'|',Re_Sig(p)*HaToeV,'|',Re_Z(p),'|',Re_eGF(p)*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',e_cap(p)*HaToeV,'|',Im_Sig(p)*HaToeV,'|',Im_Z(p),'|',Im_eGF(p)*HaToeV,'|'
write(*,*)'-------------------------------------------------------------------------------'
end do
end subroutine

47
src/GF/print_complex_cRG0F2.f90 Normal file
View File

@ -0,0 +1,47 @@
subroutine print_complex_cRG0F2(nBas,nO,Re_eHF,Im_eHF,Re_Sig,Im_Sig,Re_eGF,Im_eGF,Re_Z,Im_Z,ENuc,ERHF,Ec)
! Print one-electron energies and other stuff for G0F2
implicit none
include 'parameters.h'
integer,intent(in) :: nBas
integer,intent(in) :: nO
double precision,intent(in) :: Re_eHF(nBas)
double precision,intent(in) :: Im_eHF(nBas)
double precision,intent(in) :: Re_Sig(nBas)
double precision,intent(in) :: Im_Sig(nBas)
double precision,intent(in) :: Re_eGF(nBas)
double precision,intent(in) :: Im_eGF(nBas)
double precision,intent(in) :: Re_Z(nBas)
double precision,intent(in) :: Im_Z(nBas)
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: Ec
integer :: p
integer :: HOMO
integer :: LUMO
double precision :: Gap
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' One-shot G0F2 calculation'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Re(e_HF) (eV)','|','Re(Sig_GF2) (eV)','|','Re(Z)','|','Re(e_GF2) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Im(e_HF) (eV)','|','Im(Sig_GF2) (eV)','|','Im(Z)','|','Im(e_GF2) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Re_eHF(p)*HaToeV,'|',Re_Sig(p)*HaToeV,'|',Re_Z(p),'|',Re_eGF(p)*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Im_eHF(p)*HaToeV,'|',Im_Sig(p)*HaToeV,'|',Im_Z(p),'|',Im_eGF(p)*HaToeV,'|'
write(*,*)'-------------------------------------------------------------------------------'
end do
end subroutine

60
src/GF/print_complex_evRGF2.f90 Normal file
View File

@ -0,0 +1,60 @@
subroutine print_complex_evRGF2(nBas,nO,nSCF,Conv,Re_eHF,Im_eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGF,Im_eGF,EcRPA,EcGM)
! Print one-electron energies and other stuff for G0W0
implicit none
include 'parameters.h'
integer,intent(in) :: nBas,nO,nSCF
double precision,intent(in) :: Conv
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: EcRPA
complex*16,intent(in) :: EcGM
double precision,intent(in) :: Re_eHF(nBas)
double precision,intent(in) :: Im_eHF(nBas)
double precision,intent(in) :: Re_SigC(nBas)
double precision,intent(in) :: Im_SigC(nBas)
double precision,intent(in) :: Re_Z(nBas)
double precision,intent(in) :: Im_Z(nBas)
double precision,intent(in) :: Re_eGF(nBas)
double precision,intent(in) :: Im_eGF(nBas)
integer :: p,index_homo,index_lumo
double precision :: Re_eHOMO,Re_eLUMO,Im_eHOMO,Im_eLUMO,Re_Gap,Im_Gap
! HOMO and LUMO
index_homo = maxloc(Re_eGF(1:nO),1)
Re_eHOMO = Re_eGF(index_homo)
Im_eHOMO = Im_eGF(index_homo)
index_lumo = minloc(Re_eGF(nO+1:nBas),1) + nO
Re_eLUMO = Re_eGF(index_lumo)
Im_eLUMO = Im_eGF(index_lumo)
Re_Gap = Re_eLUMO-Re_eHOMO
Im_Gap = Im_eLUMO-Im_eHOMO
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' Self-consistent evGF2 calculation'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Re(e_HF) (eV)','|','Re(Sig_GF) (eV)','|','Re(Z)','|','Re(e_GF) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Im(e_HF) (eV)','|','Im(Sig_GF) (eV)','|','Im(Z)','|','Im(e_GF) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Re_eHF(p)*HaToeV,'|',Re_SigC(p)*HaToeV,'|',Re_Z(p),'|',Re_eGF(p)*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Im_eHF(p)*HaToeV,'|',Im_SigC(p)*HaToeV,'|',Im_Z(p),'|',Im_eGF(p)*HaToeV,'|'
if(p==nO) then
write(*,*)'-------------------------------------------------------------------------------'
end if
write(*,*)'-------------------------------------------------------------------------------'
end do
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.9)')'Convergence = ',Conv
write(*,*)
end subroutine

140
src/GF/print_complex_qsRGF2.f90 Normal file
View File

@ -0,0 +1,140 @@
! ---
subroutine print_complex_qsRGF2(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, SigC, &
Z, ENuc, ET, EV,EW, EJ, EK, EcGM, EcRPA, EqsGW, dipole)
! Print useful information about qsRGW calculation
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas, nOrb
integer,intent(in) :: nO
integer,intent(in) :: nSCF
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ET
complex*16,intent(in) :: EV
complex*16,intent(in) :: EW
complex*16,intent(in) :: EJ
complex*16,intent(in) :: EK
complex*16,intent(in) :: EcGM
complex*16,intent(in) :: EcRPA
double precision,intent(in) :: Conv
double precision,intent(in) :: thresh
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: eGW(nOrb)
complex*16,intent(in) :: c(nBas,nOrb)
complex*16,intent(in) :: SigC(nOrb,nOrb)
complex*16,intent(in) :: Z(nOrb)
complex*16,intent(in) :: EqsGW
complex*16,intent(in) :: dipole(ncart)
! Local variables
logical :: dump_orb = .false.
integer :: p,ixyz,HOMO,LUMO
complex*16 :: Gap
double precision,external :: complex_trace_matrix
! Output variables
! HOMO and LUMO
HOMO = maxloc(real(eGW(1:nO)),1)
LUMO = minloc(real(eGW(nO+1:nBas)),1) + nO
Gap = eGW(LUMO)-eGW(HOMO)
! Compute energies
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' Self-consistent qsGF2 calculation'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Re(e_HF (eV))','|','Re(Sig_GW) (eV)','|','Re(Z)','|','Re(e_GW) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Im(e_HF (eV))','|','Im(Sig_GW) (eV)','|','Im(Z)','|','Im(e_GW) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nOrb
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',real(eHF(p))*HaToeV,'|',real(SigC(p,p))*HaToeV,'|',real(Z(p)),'|',real(eGW(p))*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',aimag(eHF(p))*HaToeV,'|',aimag(SigC(p,p))*HaToeV,'|',aimag(Z(p)),'|',aimag(eGW(p))*HaToeV,'|'
write(*,*)'-------------------------------------------------------------------------------'
if(p==nO) then
write(*,*)'-------------------------------------------------------------------------------'
end if
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO real energy = ',real(eGW(HOMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO imag energy = ',aimag(eGW(HOMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF LUMO real energy = ',real(eGW(LUMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF LUMO imag energy = ',aimag(eGW(LUMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO-LUMO gap = ',real(Gap)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO-LUMO gap = ',aimag(Gap)*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF total real energy = ',ENuc + real(EqsGW),' au'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF total imag energy = ',aimag(EqsGW),' au'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF exchange energy = ',real(EK),' au'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF exchange energy = ',aimag(EK),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
! Dump results for final iteration
if(Conv < thresh) then
write(*,*)
write(*,'(A50)') '---------------------------------------'
write(*,'(A33)') ' Summary '
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' One-electron energy = ',real(ET) + real(EV) + real(EW),' au'
write(*,'(A33,1X,F16.10,A3)') ' One-electron energy = ',aimag(ET) + aimag(EV) + aimag(EW),' au'
write(*,'(A33,1X,F16.10,A3)') ' Kinetic energy = ',real(ET),' au'
write(*,'(A33,1X,F16.10,A3)') ' Kinetic energy = ',aimag(ET),' au'
write(*,'(A33,1X,F16.10,A3)') ' Potential energy = ',real(EV),' au'
write(*,'(A33,1X,F16.10,A3)') ' Potential energy = ',aimag(EV),' au'
write(*,'(A33,1X,F16.10,A3)') ' CAP energy = ',real(EW),' au'
write(*,'(A33,1X,F16.10,A3)') ' CAP energy = ',aimag(EW),' au'
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' Two-electron energy = ',real(EJ + EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Two-electron energy = ',aimag(EJ + EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Hartree energy = ',real(EJ),' au'
write(*,'(A33,1X,F16.10,A3)') ' Hartree energy = ',aimag(EJ),' au'
write(*,'(A33,1X,F16.10,A3)') ' Exchange energy = ',real(EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Exchange energy = ',aimag(EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Correlation energy = ',real(EcGM),' au'
write(*,'(A33,1X,F16.10,A3)') ' Correlation energy = ',aimag(EcGM),' au'
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' Electronic energy = ',real(EqsGW),' au'
write(*,'(A33,1X,F16.10,A3)') ' Electronic energy = ',aimag(EqsGW),' au'
write(*,'(A33,1X,F16.10,A3)') ' Nuclear repulsion = ',ENuc,' au'
write(*,'(A33,1X,F16.10,A3)') ' qsRGW energy = ',ENuc + real(EqsGW),' au'
write(*,'(A33,1X,F16.10,A3)') ' qsRGW energy = ',aimag(EqsGW),' au'
write(*,'(A50)') '---------------------------------------'
write(*,*)
if(dump_orb) then
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' Restricted qsGW orbital coefficients'
write(*,'(A50)') '---------------------------------------'
call complex_matout(nBas, nOrb, c)
write(*,*)
end if
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' Restricted qsGW orbital energies (au) '
write(*,'(A50)') '---------------------------------------'
call complex_vecout(nOrb, eGW)
write(*,*)
end if
end subroutine

5
src/GW/RG0W0.f90
View File

@ -43,7 +43,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
! Local variables
logical :: print_W = .false.
logical :: plot_self = .false.
logical :: plot_self = .true.
logical :: dRPA_W
integer :: isp_W
double precision :: flow
@ -134,7 +134,6 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
!-----------------------------------!
! Linearized or graphical solution?
eGWlin(:) = eHF(:) + Z(:)*SigC(:)
if(linearize) then
@ -155,7 +154,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
! Plot self-energy, renormalization factor, and spectral function
if(plot_self) call RGW_plot_self_energy(nOrb,eta,nC,nO,nV,nR,nS,eHF,eHF,Om,rho)
if(plot_self) call RGW_plot_self_energy(nOrb,eta,nC,nO,nV,nR,nS,eHF,eGW,Om,rho)
! Cumulant expansion

22
src/GW/RGW.f90
View File

@ -1,7 +1,7 @@
subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,maxSCF,thresh,max_diis,doACFDT, &
subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,doSRG,nNuc,ZNuc,rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF, &
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF,eGW)
S,X,T,V,Hc,ERI_AO,ERI_MO,CAP_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF,eGW)
! Restricted GW module
@ -17,6 +17,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,maxSCF,thresh,max_dii
logical,intent(in) :: doqsGW
logical,intent(in) :: doufG0W0
logical,intent(in) :: doufGW
logical,intent(in) :: docG0W0
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -61,6 +62,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,maxSCF,thresh,max_dii
double precision,intent(in) :: X(nBas,nOrb)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
double precision,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: CAP_MO(nOrb,nOrb)
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
@ -91,6 +93,22 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,maxSCF,thresh,max_dii
end if
!------------------------------------------------------------------------
! Perform cG0W0 calculation
!------------------------------------------------------------------------
if(docG0W0) then
call wall_time(start_GW)
call cRG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,CAP_MO,dipole_int_MO,eHF)
call wall_time(end_GW)
t_GW = end_GW - start_GW
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for G0W0 = ',t_GW,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform evGW calculation
!------------------------------------------------------------------------

8
src/GW/RGW_plot_self_energy.f90
View File

@ -83,10 +83,10 @@ subroutine RGW_plot_self_energy(nBas,eta,nC,nO,nV,nR,nS,eHF,eGW,Om,rho)
open(unit=11 ,file='RGW_A.dat')
do g=1,nGrid
write(8 ,*) w(g)*HaToeV,(ReSigC(p,g)*HaToeV,p=nC+1,nBas-nR)
write(9 ,*) w(g)*HaToeV,((w(g)-eHF(p))*HaToeV,p=nC+1,nBas-nR)
write(10,*) w(g)*HaToeV,(Z(p,g),p=nC+1,nBas-nR)
write(11,*) w(g)*HaToeV,(A(p,g),p=nC+1,nBas-nR)
write(8 ,'(F12.6,1X,150(F12.6,1X))') w(g)*HaToeV,(ReSigC(p,g)*HaToeV,p=nC+1,nBas-nR)
write(9 ,'(F12.6,1X,150(F12.6,1X))') w(g)*HaToeV,((w(g)-eHF(p))*HaToeV,p=nC+1,nBas-nR)
write(10,'(F12.6,1X,150(F12.6,1X))') w(g)*HaToeV,(Z(p,g),p=nC+1,nBas-nR)
write(11,'(F12.6,1X,150(F12.6,1X))') w(g)*HaToeV,(A(p,g),p=nC+1,nBas-nR)
end do
! Closing files

1
src/GW/RGW_self_energy.f90
View File

@ -149,5 +149,4 @@ subroutine RGW_self_energy(eta,nBas,nOrb,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z)
end do
end do
end do
end subroutine

242
src/GW/cRG0W0.f90 Normal file
View File

@ -0,0 +1,242 @@
subroutine cRG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,CAP,dipole_int,eHF)
! Perform G0W0 calculation
implicit none
include 'parameters.h'
include 'quadrature.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
logical,intent(in) :: dophBSE
logical,intent(in) :: dophBSE2
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA_W
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: doSRG
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: CAP(nOrb,nOrb)
double precision,intent(in) :: dipole_int(nOrb,nOrb,ncart)
double precision,intent(in) :: eHF(nOrb)
! Local variables
logical :: print_W = .false.
logical :: plot_self = .false.
logical :: dRPA_W
integer :: isp_W
integer :: p
double precision :: flow
double precision :: EcRPA
double precision :: EcBSE(nspin)
double precision :: EcGM
double precision,allocatable :: Aph(:,:)
double precision,allocatable :: Bph(:,:)
double precision,allocatable :: Re_SigC(:)
double precision,allocatable :: Im_SigC(:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
double precision,allocatable :: Om(:)
double precision,allocatable :: XpY(:,:)
double precision,allocatable :: XmY(:,:)
double precision,allocatable :: rho(:,:,:)
double precision,allocatable :: Re_eGWlin(:)
double precision, allocatable :: Im_eGWlin(:)
double precision,allocatable :: Re_eGW(:)
double precision,allocatable :: Im_eGW(:)
double precision, allocatable :: e_cap(:)
! Hello world
write(*,*)
write(*,*)'***************************************'
write(*,*)'* Restricted complex G0W0 Calculation *'
write(*,*)'***************************************'
write(*,*)
! Spin manifold and TDA for dynamical screening
isp_W = 1
dRPA_W = .true.
if(TDA_W) then
write(*,*) 'Tamm-Dancoff approximation for dynamical screening!'
write(*,*)
end if
! SRG regularization
flow = 500d0
if(doSRG) then
! Not implemented
write(*,*) '*** SRG regularized G0W0 scheme ***'
write(*,*) '!!! No SRG with cRG0W0 !!!'
write(*,*)
end if
! Memory allocation
allocate(Aph(nS,nS),Bph(nS,nS),Re_SigC(nOrb),Im_SigC(nOrb),Re_Z(nOrb),Im_Z(nOrb),Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS), &
Re_eGW(nOrb),Im_eGW(nOrb),Re_eGWlin(nOrb),Im_eGWlin(nOrb),e_cap(nOrb))
do p = 1, nOrb
e_cap(p) = CAP(p,p)
end do
!-------------------!
! Compute screening !
!-------------------!
call phRLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
if(.not.TDA_W) call phRLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phRLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
if(print_W) call print_excitation_energies('phRPA@RHF','singlet',nS,Om)
!--------------------------!
! Compute spectral weights !
!--------------------------!
call RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
!------------------------!
! Compute GW self-energy !
!------------------------!
call cRGW_self_energy_diag(eta,nBas,nOrb,nC,nO,nV,nR,nS,eHF,Om,rho,EcGM,Re_SigC,Im_SigC,Re_Z,Im_Z,e_cap)
!-----------------------------------!
! Solve the quasi-particle equation !
!-----------------------------------!
! Linearized or graphical solution?
Re_eGWlin(:) = eHF(:) + Re_Z(:)*Re_SigC(:) - Im_Z(:)*Im_SigC(:)
Im_eGWlin(:) = e_cap(:) + Re_Z(:)*Im_SigC(:) + Im_Z(:)*Re_SigC(:)
if(linearize) then
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
write(*,*)
Re_eGW(:) = Re_eGWlin(:)
Im_eGW(:) = Im_eGWlin(:)
else
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call cRGW_QP_graph(doSRG,eta,flow,nOrb,nC,nO,nV,nR,nS,eHF,e_cap,Om,rho,Re_eGWlin,Im_eGWlin,eHF,e_cap,Re_eGW,Im_eGW,Re_Z,Im_Z)
end if
! Plot self-energy, renormalization factor, and spectral function
if(plot_self) call RGW_plot_self_energy(nOrb,eta,nC,nO,nV,nR,nS,eHF,eHF,Om,rho)
! Cumulant expansion
! call RGWC(dotest,eta,nOrb,nC,nO,nV,nR,nS,Om,rho,eHF,eHF,eGW,Z)
! Compute the RPA correlation energy
call phRLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,Re_eGW,ERI,Aph)
if(.not.TDA_W) call phRLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phRLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
!--------------!
! Dump results !
!--------------!
call print_cRG0W0(nOrb,nO,eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGW,Im_eGW,EcRPA,EcGM,CAP)
!---------------------------!
! Perform phBSE calculation !
!---------------------------!
!
! if(dophBSE) then
!
! call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, &
! nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,Re_eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! ! Compute the BSE correlation energy via the adiabatic connection fluctuation dissipation theorem
!
! if(doACFDT) then
!
! call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,eHF,Re_eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
! end if
!
!!---------------------------!
!! Perform ppBSE calculation !
!!---------------------------!
!
! if(doppBSE) then
!
! call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,Re_eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Testing zone
!
! if(dotest) then
!
! call dump_test_value('R','G0W0 correlation energy',EcRPA)
! call dump_test_value('R','G0W0 HOMO energy',Re_eGW(nO))
! call dump_test_value('R','G0W0 LUMO energy',Re_eGW(nO+1))
!
! end if
!
end subroutine

56
src/GW/cRGW_Im_SigC.f90 Normal file
View File

@ -0,0 +1,56 @@
double precision function cRGW_Im_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_e,Im_e,Om,rho)
! Compute diagonal of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,m
double precision :: num,eps,eta_tilde
! Initialize
cRGW_Im_SigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do m=1,nS
eps = Re_w - Re_e(i) + Om(m)
eta_tilde = eta - Im_w + Im_e(i)
num = 2d0*rho(p,i,m)**2
cRGW_Im_SigC = cRGW_Im_SigC + num*eta_tilde/(eps**2 + eta_tilde**2)
end do
end do
! Virtual part of the correlation self-energy
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_w - Re_e(a) - Om(m)
eta_tilde = eta + Im_w - Im_e(a)
num = 2d0*rho(p,a,m)**2
cRGW_Im_SigC =cRGW_Im_SigC - num*eta_tilde/(eps**2 + eta_tilde**2)
end do
end do
end function

56
src/GW/cRGW_Im_dSigC.f90 Normal file
View File

@ -0,0 +1,56 @@
double precision function cRGW_Im_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_e,Im_e,Om,rho)
! Compute the derivative of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,m
double precision :: num,eps,eta_tilde
! Initialize
cRGW_Im_dSigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do m=1,nS
eps = Re_w - Re_e(i) + Om(m)
eta_tilde = eta - Im_w + Im_e(i)
num = 2d0*rho(p,i,m)**2
cRGW_Im_dSigC = cRGW_Im_dSigC - 2d0*num*eps*eta_tilde/(eps**2 + eta_tilde**2)**2
end do
end do
! Virtual part of the correlation self-energy
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_w - Re_e(a) - Om(m)
eta_tilde = eta + Im_w - Im_e(a)
num = 2d0*rho(p,a,m)**2
cRGW_Im_dSigC = cRGW_Im_dSigC + 2d0*num*eps*eta_tilde/(eps**2 + eta_tilde**2)**2
end do
end do
end function

106
src/GW/cRGW_QP_graph.f90 Normal file
View File

@ -0,0 +1,106 @@
subroutine cRGW_QP_graph(doSRG,eta,flow,nBas,nC,nO,nV,nR,nS,eHF,e_cap,Om,rho,Re_eGWlin,Im_eGWlin, &
Re_eOld,Im_eOld,Re_eGW,Im_eGW,Re_Z,Im_Z)
! Compute the graphical solution of the QP equation
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
logical,intent(in) :: doSRG
double precision,intent(in) :: eta
double precision,intent(in) :: flow
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: e_cap(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
double precision,intent(in) :: Re_eGWlin(nBas)
double precision,intent(in) :: Im_eGWlin(nBas)
double precision,external :: cRGW_Re_SigC,cRGW_Re_dSigC
double precision,external :: cRGW_Im_SigC,cRGW_Im_dSigC
double precision,intent(in) :: Re_eOld(nBas)
double precision,intent(in) :: Im_eOld(nBas)
! Local variables
integer :: p
integer :: nIt
integer,parameter :: maxIt = 64
double precision,parameter :: thresh = 1d-6
double precision :: Re_SigC,Re_dSigC
double precision :: Im_SigC,Im_dSigC
double precision :: Re_f,Im_f,Re_df,Im_df
double precision :: Re_w
double precision :: Im_w
! Output variables
double precision,intent(out) :: Re_eGW(nBas),Im_eGW(nBas)
double precision,intent(out) :: Re_Z(nBas),Im_Z(nBas)
! Run Newton's algorithm to find the root
write(*,*)'-----------------------------------------------------'
write(*,'(A5,1X,A3,1X,A16,1X,A16,1X,A10)') 'Orb.','It.','Re(e_GWlin) (eV)','Re(e_GW (eV))','Re(Z)'
write(*,'(A5,1X,A3,1X,A16,1X,A16,1X,A10)') 'Orb.','It.','Im(e_GWlin) (eV)','Im(e_GW (eV))','Im(Z)'
write(*,*)'-----------------------------------------------------'
do p=nC+1,nBas-nR
Re_w = Re_eGWlin(p)
Im_w = Im_eGWlin(p)
nIt = 0
Re_f = 1d0
Im_f = 1d0
do while (sqrt(Re_f**2+Im_f**2) > thresh .and. nIt < maxIt)
nIt = nIt + 1
Re_SigC = cRGW_Re_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_eOld,Im_eold,Om,rho)
Im_SigC = cRGW_Im_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_eOld,Im_eold,Om,rho)
Re_dSigC = cRGW_Re_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_eOld,Im_eold,Om,rho)
Im_dSigC = cRGW_Im_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_eOld,Im_eold,Om,rho)
Re_f = Re_w - eHF(p) - Re_SigC
Im_f = Im_w - e_cap(p) - Im_SigC
Re_df = (1d0 - Re_dSigC)/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Im_df = Im_dSigC/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Re_w = Re_w - Re_df*Re_f + Im_df*Im_f
Im_w = Im_w - Re_f*Im_df - Re_df*Im_f
end do
if(nIt == maxIt) then
Re_eGW(p) = Re_eGWlin(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,Re_eGWlin(p)*HaToeV,Re_eGW(p)*HaToeV,Re_Z(p),'Cvg Failed!'
else
Re_eGW(p) = Re_w
Im_eGW(p) = Im_w
Re_Z(p) = Re_df
Im_Z(p) = Im_df
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Re_eGWlin(p)*HaToeV,Re_eGW(p)*HaToeV,Re_Z(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Im_eGWlin(p)*HaToeV,Im_eGW(p)*HaToeV,Im_Z(p)
end if
write(*,*)'-----------------------------------------------------'
end do
write(*,*)
end subroutine

57
src/GW/cRGW_Re_SigC.f90 Normal file
View File

@ -0,0 +1,57 @@
double precision function cRGW_Re_SigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_e,Im_e,Om,rho)
! Compute diagonal of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,m
double precision :: num,eps
double precision :: eta_tilde
! Initialize
cRGW_Re_SigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do m=1,nS
eps = Re_w - Re_e(i) + Om(m)
eta_tilde = eta - Im_w + Im_e(i)
num = 2d0*rho(p,i,m)**2
cRGW_Re_SigC = cRGW_Re_SigC + num*eps/(eps**2 + eta_tilde**2)
end do
end do
! Virtual part of the correlation self-energy
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_w - Re_e(a) - Om(m)
eta_tilde = eta + Im_w - Im_e(a)
num = 2d0*rho(p,a,m)**2
cRGW_Re_SigC = cRGW_Re_SigC + num*eps/(eps**2 + eta_tilde**2)
end do
end do
end function

56
src/GW/cRGW_Re_dSigC.f90 Normal file
View File

@ -0,0 +1,56 @@
double precision function cRGW_Re_dSigC(p,Re_w,Im_w,eta,nBas,nC,nO,nV,nR,nS,Re_e,Im_e,Om,rho)
! Compute the derivative of the correlation part of the self-energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,m
double precision :: num,eps,eta_tilde
! Initialize
cRGW_Re_dSigC = 0d0
! Occupied part of the correlation self-energy
do i=nC+1,nO
do m=1,nS
eps = Re_w - Re_e(i) + Om(m)
eta_tilde = eta - Im_w + Im_e(i)
num = 2d0*rho(p,i,m)**2
cRGW_Re_dSigC = cRGW_Re_dSigC - num*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
end do
end do
! Virtual part of the correlation self-energy
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_w - Re_e(a) - Om(m)
eta_tilde = eta + Im_w - Im_e(a)
num = 2d0*rho(p,a,m)**2
cRGW_Re_dSigC = cRGW_Re_dSigC - num*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
end do
end do
end function

102
src/GW/cRGW_self_energy_diag.f90 Normal file
View File

@ -0,0 +1,102 @@
subroutine cRGW_self_energy_diag(eta,nBas,nOrb,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Re_Sig,Im_Sig,Re_Z,Im_Z,e_cap)
! Compute diagonal of the correlation part of the self-energy and the renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
double precision,intent(in) :: e_cap(nBas)
! Local variables
integer :: i,a,p,m
double precision :: num,eps
double precision :: eta_tilde
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
! Output variables
double precision,intent(out) :: Re_Sig(nBas)
double precision,intent(out) :: Im_Sig(nBas)
double precision,intent(out) :: Re_Z(nBas)
double precision,intent(out) :: Im_Z(nBas)
double precision,intent(out) :: EcGM
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas))
Re_Sig(:) = 0d0
Im_Sig(:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
!----------------!
! GW self-energy !
!----------------!
! Occupied part of the correlation self-energy
do p=nC+1,nBas-nR
do i=nC+1,nO
do m=1,nS
eps = e(p) - e(i) + Om(m)
eta_tilde = eta - e_cap(p) + e_cap(i)
num = 2d0*rho(p,i,m)**2
Re_Sig(p) = Re_Sig(p) + num*eps/(eps**2 + eta_tilde**2)
Im_Sig(p) = Im_Sig(p) + num*eta_tilde/(eps**2 + eta_tilde**2)
Re_DS(p) = Re_DS(p) - num*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
Im_DS(p) = Im_DS(p) - 2*num*eta_tilde*eps/(eps**2 + eta_tilde**2)**2
end do
end do
end do
! Virtual part of the correlation self-energy
do p=nC+1,nBas-nR
do a=nO+1,nBas-nR
do m=1,nS
eps = e(p) - e(a) - Om(m)
eta_tilde = eta + e_cap(p) - e_cap(a)
num = 2d0*rho(p,a,m)**2
Re_Sig(p) = Re_Sig(p) + num*eps/(eps**2 + eta_tilde**2)
Im_Sig(p) = Im_Sig(p) - num*eta_tilde/(eps**2 + eta_tilde**2)
Re_DS(p) = Re_DS(p) - num*(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2
Im_DS(p) = Im_DS(p) + 2*num*eta_tilde*eps/(eps**2 + eta_tilde**2)**2
end do
end do
end do
! Galitskii-Migdal correlation energy
! MAYBE MODIFY THIS TERM
EcGM = 0d0
do i=nC+1,nO
do a=nO+1,nBas-nR
do m=1,nS
eps = e(a) - e(i) + Om(m)
num = 4d0*rho(a,i,m)**2
EcGM = EcGM - num*eps/(eps**2 + eta**2)
end do
end do
end do
! Compute renormalization factor from derivative
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
deallocate(Re_DS,Im_DS)
end subroutine

124
src/GW/complex_RGW.f90 Normal file
View File

@ -0,0 +1,124 @@
subroutine complex_RGW(dotest,docG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,doSRG,nNuc,ZNuc,rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF, &
S,X,T,V,Hc,ERI_AO,ERI_MO,CAP_AO,CAP_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
! Restricted GW module
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: docG0W0,doevGW,doqsGW
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
logical,intent(in) :: dophBSE
logical,intent(in) :: dophBSE2
logical,intent(in) :: TDA_W
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: doppBSE
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: doSRG
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
double precision,intent(in) :: rNuc(nNuc,ncart)
double precision,intent(in) :: ENuc
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: cHF(nBas,nOrb)
complex*16,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: S(nBas,nBas)
double precision,intent(in) :: T(nBas,nBas)
double precision,intent(in) :: V(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
double precision,intent(in) :: X(nBas,nOrb)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
complex*16,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: CAP_AO(nOrb,nOrb)
complex*16,intent(in) :: CAP_MO(nOrb,nOrb)
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
complex*16,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
! Local variables
double precision :: start_GW ,end_GW ,t_GW
logical :: doccG0W0,doccGW
!------------------------------------------------------------------------
! Perform cG0W0 calculation
!------------------------------------------------------------------------
if(docG0W0) then
call wall_time(start_GW)
call complex_cRG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,CAP_MO,dipole_int_MO,eHF)
call wall_time(end_GW)
t_GW = end_GW - start_GW
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for complex G0W0 = ',t_GW,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform evGW calculation
!------------------------------------------------------------------------
if(doevGW) then
call wall_time(start_GW)
call complex_evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
call wall_time(end_GW)
t_GW = end_GW - start_GW
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for evGW = ',t_GW,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform qsGW calculation
!------------------------------------------------------------------------
if(doqsGW) then
call wall_time(start_GW)
call complex_qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2, &
TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet,eta,doSRG,nNuc,ZNuc,rNuc, &
ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
dipole_int_AO,dipole_int_MO,PHF,cHF,eHF, &
CAP_AO,CAP_MO)
call wall_time(end_GW)
t_GW = end_GW - start_GW
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for qsGW = ',t_GW,' seconds'
write(*,*)
end if
end subroutine

107
src/GW/complex_RGW_QP_graph.f90 Normal file
View File

@ -0,0 +1,107 @@
subroutine complex_RGW_QP_graph(doSRG,eta,flow,nBas,nC,nO,nV,nR,nS,Re_eHF,Im_eHF,Om,rho,Re_eGWlin,Im_eGWlin, &
Re_eOld,Im_eOld,Re_eGW,Im_eGW,Re_Z,Im_Z)
! Compute the graphical solution of the QP equation
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
logical,intent(in) :: doSRG
double precision,intent(in) :: eta
double precision,intent(in) :: flow
double precision,intent(in) :: Re_eHF(nBas)
double precision,intent(in) :: Im_eHF(nBas)
complex*16,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
double precision,intent(in) :: Re_eGWlin(nBas)
double precision,intent(in) :: Im_eGWlin(nBas)
double precision,intent(in) :: Re_eOld(nBas)
double precision,intent(in) :: Im_eOld(nBas)
! Local variables
integer :: p
integer :: nIt
integer,parameter :: maxIt = 64
double precision,parameter :: thresh = 1d-6
double precision :: Re_SigC,Re_dSigC
double precision :: Im_SigC,Im_dSigC
double precision :: Re_f,Im_f,Re_df,Im_df
double precision :: Re_w
double precision :: Im_w
! Output variables
double precision,intent(out) :: Re_eGW(nBas),Im_eGW(nBas)
double precision,intent(out) :: Re_Z(nBas),Im_Z(nBas)
! Run Newton's algorithm to find the root
write(*,*)'-----------------------------------------------------'
write(*,'(A5,1X,A3,1X,A16,1X,A16,1X,A10)') 'Orb.','It.','Re(e_GWlin) (eV)','Re(e_GW (eV))','Re(Z)'
write(*,'(A5,1X,A3,1X,A16,1X,A16,1X,A10)') 'Orb.','It.','Im(e_GWlin) (eV)','Im(e_GW (eV))','Im(Z)'
write(*,*)'-----------------------------------------------------'
do p=nC+1,nBas-nR
Re_w = Re_eGWlin(p)
Im_w = Im_eGWlin(p)
nIt = 0
Re_f = 1d0
Im_f = 1d0
do while (sqrt(Re_f**2+Im_f**2) > thresh .and. nIt < maxIt)
nIt = nIt + 1
if(doSRG) then
call complex_RGW_SRG_SigC_dSigC(flow,p,eta,nBas,nC,nO,nV,nR,nS,&
Re_w,Im_w,Re_eOld,Im_eOld,Om,rho,&
Re_SigC,Im_SigC,Re_dSigC,Im_dSigC)
else
call complex_RGW_SigC_dSigC(p,eta,nBas,nC,nO,nV,nR,nS,&
Re_w,Im_w,Re_eOld,Im_eOld,Om,rho,&
Re_SigC,Im_SigC,Re_dSigC,Im_dSigC)
end if
Re_f = Re_w - Re_eHF(p) - Re_SigC
Im_f = Im_w - Im_eHF(p) - Im_SigC
Re_df = (1d0 - Re_dSigC)/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Im_df = Im_dSigC/((1d0 - Re_dSigC)**2 + Im_dSigC**2)
Re_w = Re_w - Re_df*Re_f + Im_df*Im_f
Im_w = Im_w - Re_f*Im_df - Re_df*Im_f
end do
if(nIt == maxIt) then
Re_eGW(p) = Re_eGWlin(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,Re_eGWlin(p)*HaToeV,Re_eGW(p)*HaToeV,Re_Z(p),'Cvg Failed!'
else
Re_eGW(p) = Re_w
Im_eGW(p) = Im_w
Re_Z(p) = Re_df
Im_Z(p) = Im_df
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Re_eGWlin(p)*HaToeV,Re_eGW(p)*HaToeV,Re_Z(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,Im_eGWlin(p)*HaToeV,Im_eGW(p)*HaToeV,Im_Z(p)
end if
write(*,*)'-----------------------------------------------------'
end do
write(*,*)
end subroutine

101
src/GW/complex_RGW_SRG_SigC_dSigC.f90 Normal file
View File

@ -0,0 +1,101 @@
subroutine complex_RGW_SRG_SigC_dSigC(flow,p,eta,nBas,nC,nO,nV,nR,nS,Re_w,Im_w,Re_e,Im_e,Om,rho,Re_SigC,Im_SigC,Re_DS,Im_DS)
! Complute diagonal of the correlation part of the self-energy and its derivative fully complex
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: eta
double precision,intent(in) :: flow
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
complex*16,intent(in) :: Om(nS)
complex*16,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,m
double precision :: eps,s
double precision :: eta_tilde
complex*16 :: num
complex*16 :: tmp
! Output variables
double precision,intent(out) :: Re_SigC
double precision,intent(out) :: Im_SigC
double precision,intent(out) :: Re_DS
double precision,intent(out) :: Im_DS
! Initialize
Re_SigC = 0d0
Im_SigC = 0d0
Re_DS = 0d0
Im_DS = 0d0
s = flow
! Compute self energy and its derivative
! Occupied part
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP SHARED(p,rho,eta,nS,nC,nO,nR,Re_w,Im_w,Re_e,Im_e,Om,s), &
!$OMP PRIVATE(m,i,eps,num,eta_tilde,tmp) &
!$OMP REDUCTION(+:Re_SigC,Im_SigC,Re_DS,Im_DS)
do i=nC+1,nO
do m=1,nS
eps = Re_w - Re_e(i) + real(Om(m))
eta_tilde = eta - Im_w + Im_e(i) - aimag(Om(m))
num = 2d0*rho(p,i,m)**2*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(tmp)
Im_SigC = Im_SigC + aimag(tmp)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(tmp)
Im_DS = Im_DS + aimag(tmp)
end do
end do
!$OMP END PARALLEL DO
! Virtual part
!$OMP PARALLEL &
!$OMP SHARED(p,nBas,rho,eta,nS,nC,nO,nR,Re_w,Im_w,Re_e,Im_e,Om,s) &
!$OMP PRIVATE(m,a,eps,tmp,eta_tilde,num) &
!$OMP REDUCTION(+:Re_SigC,Im_SigC,Re_DS,Im_DS) &
!$OMP DEFAULT(NONE)
!$OMP DO
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_w - Re_e(a) - real(Om(m))
eta_tilde = eta + Im_w - Im_e(a) - aimag(Om(m))
num = 2d0*rho(p,a,m)**2*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(tmp)
Im_SigC = Im_SigC + aimag(tmp)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(tmp)
Im_DS = Im_DS + aimag(tmp)
end do
end do
!$OMP END DO
!$OMP END PARALLEL
end subroutine

193
src/GW/complex_RGW_SRG_self_energy.f90 Normal file
View File

@ -0,0 +1,193 @@
subroutine complex_RGW_SRG_self_energy(flow,eta,nBas,nOrb,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z)
! Compute correlation part of the self-energy and the renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
double precision,intent(in) :: flow
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: e(nOrb)
complex*16,intent(in) :: Om(nS)
complex*16,intent(in) :: rho(nOrb,nOrb,nS)
! Local variables
integer :: i,j,a,b
integer :: p,q,m
double precision :: eps_p,eps_q,eta_tilde_p,eta_tilde_q
double precision :: eps,eta_tilde,s
complex*16 :: num,tmp
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
double precision,allocatable :: Re_Sig(:,:)
double precision,allocatable :: Im_Sig(:,:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
! Output variables
complex*16,intent(out) :: EcGM
complex*16,intent(out) :: Sig(nOrb,nOrb)
complex*16,intent(out) :: Z(nOrb)
!----------------!
! GW self-energy !
!----------------!
allocate(Re_DS(nOrb),Im_DS(nOrb),Re_Z(nOrb),Im_Z(nOrb),Re_Sig(nOrb,nOrb),Im_Sig(nOrb,nOrb))
Re_Sig(:,:) = 0d0
Im_Sig(:,:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
s = flow
! Occupied part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(Re_Sig,Im_Sig,rho,eta,nS,nC,nO,nOrb,nR,e,Om,s) &
!$OMP PRIVATE(m,i,q,p,eps_p,eps_q,num,eta_tilde_p,eta_tilde_q,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
do m=1,nS
do i=nC+1,nO
eps_p = real(e(p)) - real(e(i)) + real(Om(m))
eps_q = real(e(q)) - real(e(i)) + real(Om(m))
eta_tilde_p = eta - aimag(e(p)) + aimag(e(i)) - aimag(Om(m))
eta_tilde_q = eta - aimag(e(q)) + aimag(e(i)) - aimag(Om(m))
num = 2d0*rho(p,i,m)*rho(q,i,m)*(1d0 - exp(-s*(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2)))
tmp = num*cmplx((eps_p + eps_q)/(eps_p**2 + eps_q**2 + eta_tilde_p**2 + eta_tilde_q**2),&
(eta_tilde_p + eta_tilde_q)/(eps_p**2 + eps_q**2 + eta_tilde_p**2 + eta_tilde_q**2),kind=8)
Re_Sig(p,q) = Re_Sig(p,q) + real(tmp)
Im_Sig(p,q) = Im_Sig(p,q) + aimag(tmp)
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(Re_Sig,Im_Sig,rho,eta,nS,nC,nO,nOrb,nR,e,Om,s) &
!$OMP PRIVATE(m,a,q,p,eps_p,eps_q,num,eta_tilde_p,eta_tilde_q,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
do m=1,nS
do a=nO+1,nOrb-nR
eps_p = real(e(p)) - real(e(a)) - real(Om(m))
eps_q = real(e(q)) - real(e(a)) - real(Om(m))
eta_tilde_p = eta + aimag(e(p)) - aimag(e(a)) - aimag(Om(m))
eta_tilde_q = eta + aimag(e(q)) - aimag(e(a)) - aimag(Om(m))
num = 2d0*rho(p,a,m)*rho(q,a,m)*(1d0 - exp(-s*(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2)))
tmp = num*cmplx((eps_p +eps_q)/(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2),&
-(eta_tilde_p + eta_tilde_q)/(eps_p**2+eta_tilde_p**2 + eps_q**2 + eta_tilde_q**2),kind=8)
Re_Sig(p,q) = Re_Sig(p,q) + real(tmp)
Im_Sig(p,q) = Im_Sig(p,q) + aimag(tmp)
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
!------------------------!
! Renormalization factor !
!------------------------!
!Occupied part of the renormalization factor
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,rho,eta,nS,nC,nO,nOrb,nR,e,Om,s) &
!$OMP PRIVATE(m,i,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nOrb-nR
do m=1,nS
do i=nC+1,nO
eps = real(e(p)) - real(e(i)) + real(Om(m))
eta_tilde = eta - aimag(e(p)) + aimag(e(i)) - aimag(Om(m))
num = 2d0*rho(p,i,m)*rho(p,i,m)*(1d0-exp(-2d0*s*(eps**2+eta_tilde**2)))
tmp = num*cmplx(-(eps**2-eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part of the renormalization factor
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,rho,eta,nS,nC,nO,nOrb,nR,e,Om,s) &
!$OMP PRIVATE(m,a,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nOrb-nR
do m=1,nS
do a=nO+1,nOrb-nR
eps = real(e(p)) - real(e(a)) - real(Om(m))
eta_tilde = eta + aimag(e(p)) - aimag(e(a)) - aimag(Om(m))
num = 2d0*rho(p,a,m)*rho(p,a,m)*(1d0-exp(-2d0*s*(eps**2+eta_tilde**2)))
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Compute renormalization factor from derivative
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Z = cmplx(Re_Z,Im_Z,kind=8)
Sig = cmplx(Re_Sig,Im_Sig,kind=8)
deallocate(Re_DS)
deallocate(Im_DS)
deallocate(Re_Z)
deallocate(Im_Z)
deallocate(Re_Sig)
deallocate(Im_Sig)
!!-------------------------------------!
!! Galitskii-Migdal correlation energy !
!!-------------------------------------!
!
! EcGM = 0d0
! do m=1,nS
! do a=nO+1,nOrb-nR
! do i=nC+1,nO
!
! eps = e(a) - e(i) + Om(m)
! num = 4d0*rho(a,i,m)*rho(a,i,m)
! EcGM = EcGM - num*eps/(eps**2 + eta**2)
!
! end do
! end do
! end do
!
end subroutine

113
src/GW/complex_RGW_SRG_self_energy_diag.f90 Normal file
View File

@ -0,0 +1,113 @@
subroutine complex_RGW_SRG_self_energy_diag(flow,eta,nBas,nOrb,nC,nO,nV,nR,nS,Re_e,Im_e,Om,rho,EcGM,Re_Sig,Im_Sig,Re_Z,Im_Z)
! Compute diagonal of the correlation part of the self-energy and the renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
double precision,intent(in) :: flow
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
complex*16,intent(in) :: Om(nS)
complex*16,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,p,m
double precision :: eps,s
complex*16 :: num
double precision :: eta_tilde
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
complex*16 :: tmp
! Output variables
double precision,intent(out) :: Re_Sig(nBas)
double precision,intent(out) :: Im_Sig(nBas)
double precision,intent(out) :: Re_Z(nBas)
double precision,intent(out) :: Im_Z(nBas)
complex*16,intent(out) :: EcGM
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas))
Re_Sig(:) = 0d0
Im_Sig(:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
s = flow
!----------------!
! GW self-energy !
!----------------!
! Occupied part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(nBas,Re_Sig,Im_Sig,Re_Z,Im_Z,rho,eta,nS,nC,nO,nOrb,nR,Re_e,Im_e,Om,Re_DS,s,Im_DS), &
!$OMP PRIVATE(m,i,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do i=nC+1,nO
do m=1,nS
eps = Re_e(p) - Re_e(i) + real(Om(m))
eta_tilde = eta - Im_e(p) + Im_e(i) - aimag(Om(m))
num = 2d0*rho(p,i,m)**2*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
eta_tilde/(eps**2+eta_tilde**2),kind=8)
Re_Sig(p) = Re_Sig(p) + real(tmp)
Im_Sig(p) = Im_Sig(p) + aimag(tmp)
tmp = num*cmplx(-(eps**2-eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(nBas,Re_Sig,Im_Sig,Re_Z,Im_Z,Re_DS,Im_DS,rho,eta,nS,nC,nO,nOrb,nR,Re_e,Im_e,Om,s) &
!$OMP PRIVATE(m,a,p,eps,tmp,eta_tilde,num) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_e(p) - Re_e(a) - real(Om(m))
eta_tilde = eta + Im_e(p) - Im_e(a) - aimag(Om(m))
num = 2d0*rho(p,a,m)**2*(1d0 - exp(-2d0*s*(eps**2 + eta_tilde**2)))
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_Sig(p) = Re_Sig(p) + real(tmp)
Im_Sig(p) = Im_Sig(p) + aimag(tmp)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Compute renormalization factor from derivative
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
deallocate(Re_DS,Im_DS)
end subroutine

101
src/GW/complex_RGW_SigC_dSigC.f90 Normal file
View File

@ -0,0 +1,101 @@
subroutine complex_RGW_SigC_dSigC(p,eta,nBas,nC,nO,nV,nR,nS,Re_w,Im_w,Re_e,Im_e,Om,rho,Re_SigC,Im_SigC,Re_DS,Im_DS)
! Complute diagonal of the correlation part of the self-energy and its derivative fully complex
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: p
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
double precision,intent(in) :: Re_w
double precision,intent(in) :: Im_w
complex*16,intent(in) :: Om(nS)
complex*16,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,m
double precision :: eps
double precision :: eta_tilde
complex*16 :: num
complex*16 :: tmp
! Output variables
double precision,intent(out) :: Re_SigC
double precision,intent(out) :: Im_SigC
double precision,intent(out) :: Re_DS
double precision,intent(out) :: Im_DS
! Initialize
Re_SigC = 0d0
Im_SigC = 0d0
Re_DS = 0d0
Im_DS = 0d0
! Compute self energy and its derivative
! Occupied part
!$OMP PARALLEL &
!$OMP SHARED(p,rho,eta,nS,nC,nO,nR,Re_w,Im_w,Re_e,Im_e,Om), &
!$OMP PRIVATE(m,i,eps,num,eta_tilde,tmp) &
!$OMP REDUCTION(+:Re_SigC,Im_SigC,Re_DS,Im_DS)&
!$OMP DEFAULT(NONE)
!$OMP DO
do i=nC+1,nO
do m=1,nS
eps = Re_w - Re_e(i) + real(Om(m))
eta_tilde = eta - Im_w + Im_e(i) - aimag(Om(m))
num = 2d0*rho(p,i,m)**2
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(tmp)
Im_SigC = Im_SigC + aimag(tmp)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(tmp)
Im_DS = Im_DS + aimag(tmp)
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part
!$OMP PARALLEL &
!$OMP SHARED(p,nBas,rho,eta,nS,nC,nO,nR,Re_w,Im_w,Re_e,Im_e,Om) &
!$OMP PRIVATE(m,a,eps,tmp,eta_tilde,num) &
!$OMP REDUCTION(+:Re_SigC,Im_SigC,Re_DS,Im_DS) &
!$OMP DEFAULT(NONE)
!$OMP DO
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_w - Re_e(a) - real(Om(m))
eta_tilde = eta + Im_w - Im_e(a) - aimag(Om(m))
num = 2d0*rho(p,a,m)**2
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_SigC = Re_SigC + real(tmp)
Im_SigC = Im_SigC + aimag(tmp)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS = Re_DS + real(tmp)
Im_DS = Im_DS + aimag(tmp)
end do
end do
!$OMP END DO
!$OMP END PARALLEL
end subroutine

46
src/GW/complex_RGW_excitation_density.f90 Normal file
View File

@ -0,0 +1,46 @@
subroutine complex_RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
! Compute excitation densities
implicit none
! Input variables
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
complex*16,intent(in) :: XpY(nS,nS)
! Local variables
integer :: ia,jb,p,q,j,b
! Output variables
complex*16,intent(out) :: rho(nOrb,nOrb,nS)
rho(:,:,:) = 0d0
!$OMP PARALLEL &
!$OMP SHARED(nC,nOrb,nR,nO,nS,rho,ERI,XpY) &
!$OMP PRIVATE(q,p,jb,ia) &
!$OMP DEFAULT(NONE)
!$OMP DO
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
jb = 0
do j=nC+1,nO
do b=nO+1,nOrb-nR
jb = jb + 1
do ia=1,nS
rho(p,q,ia) = rho(p,q,ia) + ERI(p,j,q,b)*XpY(ia,jb)
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
end subroutine

99
src/GW/complex_RGW_plot_self_energy.f90 Normal file
View File

@ -0,0 +1,99 @@
subroutine complex_RGW_plot_self_energy(nBas,eta,nC,nO,nV,nR,nS,eHF,eGW,Om,rho)
! Dump several GW quantities for external plotting
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: eGW(nBas)
double precision,intent(in) :: Om(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: p,g
integer :: nGrid
double precision :: wmin,wmax,dw
double precision,external :: RGW_Re_SigC,RGW_Im_SigC,RGW_Re_dSigC
double precision,allocatable :: w(:)
double precision,allocatable :: ReSigC(:,:),ImSigC(:,:)
double precision,allocatable :: Z(:,:)
double precision,allocatable :: A(:,:)
! Construct grid
nGrid = 5000
allocate(w(nGrid),ReSigC(nBas,nGrid),ImSigC(nBas,nGrid),Z(nBas,nGrid),A(nBas,nGrid))
! Initialize
ReSigC(:,:) = 0d0
ImSigC(:,:) = 0d0
Z(:,:) = 0d0
! Minimum and maximum frequency values
wmin = -5d0
wmax = +5d0
dw = (wmax - wmin)/dble(ngrid)
do g=1,nGrid
w(g) = wmin + dble(g)*dw
end do
! Occupied part of the self-energy and renormalization factor
do g=1,nGrid
do p=nC+1,nBas-nR
ReSigC(p,g) = RGW_Re_SigC(p,w(g),eta,nBas,nC,nO,nV,nR,nS,eGW,Om,rho)
ImSigC(p,g) = RGW_Im_SigC(p,w(g),eta,nBas,nC,nO,nV,nR,nS,eGW,Om,rho)
Z(p,g) = RGW_Re_dSigC(p,w(g),eta,nBas,nC,nO,nV,nR,nS,eGW,Om,rho)
end do
end do
Z(:,:) = 1d0/(1d0 + Z(:,:))
! Compute spectral function
do g=1,nGrid
do p=nC+1,nBas-nR
A(p,g) = abs(ImSigC(p,g))/((w(g) - eHF(p) - ReSigC(p,g))**2 + ImSigC(p,g)**2)
end do
end do
A(:,:) = A(:,:)/pi
! Dump quantities in files as a function of w
open(unit=8 ,file='RGW_SigC.dat')
open(unit=9 ,file='RGW_freq.dat')
open(unit=10 ,file='RGW_Z.dat')
open(unit=11 ,file='RGW_A.dat')
do g=1,nGrid
write(8 ,*) w(g)*HaToeV,(ReSigC(p,g)*HaToeV,p=nC+1,nBas-nR)
write(9 ,*) w(g)*HaToeV,((w(g)-eHF(p))*HaToeV,p=nC+1,nBas-nR)
write(10,*) w(g)*HaToeV,(Z(p,g),p=nC+1,nBas-nR)
write(11,*) w(g)*HaToeV,(A(p,g),p=nC+1,nBas-nR)
end do
! Closing files
close(unit=8)
close(unit=9)
close(unit=10)
close(unit=11)
end subroutine

182
src/GW/complex_RGW_self_energy.f90 Normal file
View File

@ -0,0 +1,182 @@
subroutine complex_RGW_self_energy(eta,nBas,nOrb,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z)
! Compute correlation part of the self-energy and the renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: e(nOrb)
complex*16,intent(in) :: Om(nS)
complex*16,intent(in) :: rho(nOrb,nOrb,nS)
! Local variables
integer :: i,j,a,b
integer :: p,q,m
double precision :: eps,eta_tilde
complex*16 :: num,tmp
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
double precision,allocatable :: Re_Sig(:,:)
double precision,allocatable :: Im_Sig(:,:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
! Output variables
complex*16,intent(out) :: EcGM
complex*16,intent(out) :: Sig(nOrb,nOrb)
complex*16,intent(out) :: Z(nOrb)
!----------------!
! GW self-energy !
!----------------!
allocate(Re_DS(nOrb),Im_DS(nOrb),Re_Z(nOrb),Im_Z(nOrb),Re_Sig(nOrb,nOrb),Im_Sig(nOrb,nOrb))
Re_Sig(:,:) = 0d0
Im_Sig(:,:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
! Occupied part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(Re_Sig,Im_Sig,rho,eta,nS,nC,nO,nOrb,nR,e,Om) &
!$OMP PRIVATE(m,i,q,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
do m=1,nS
do i=nC+1,nO
eps = real(e(p)) - real(e(i)) + real(Om(m))
eta_tilde = eta - aimag(e(p)) + aimag(e(i)) - aimag(Om(m))
num = 2d0*rho(p,i,m)*rho(q,i,m)
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
eta_tilde/(eps**2+eta_tilde**2),kind=8)
Re_Sig(p,q) = Re_Sig(p,q) + real(tmp)
Im_Sig(p,q) = Im_Sig(p,q) + aimag(tmp)
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(Re_Sig,Im_Sig,rho,eta,nS,nC,nO,nOrb,nR,e,Om) &
!$OMP PRIVATE(m,a,q,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
do m=1,nS
do a=nO+1,nOrb-nR
eps = real(e(p)) - real(e(a)) - real(Om(m))
eta_tilde = eta + aimag(e(p)) - aimag(e(a)) - aimag(Om(m))
num = 2d0*rho(p,a,m)*rho(q,a,m)
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_Sig(p,q) = Re_Sig(p,q) + real(tmp)
Im_Sig(p,q) = Im_Sig(p,q) + aimag(tmp)
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
!------------------------!
! Renormalization factor !
!------------------------!
! Occupied part of the renormalization factor
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,rho,eta,nS,nC,nO,nOrb,nR,e,Om) &
!$OMP PRIVATE(m,i,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nOrb-nR
do m=1,nS
do i=nC+1,nO
eps = real(e(p)) - real(e(i)) + real(Om(m))
eta_tilde = eta - aimag(e(p)) + aimag(e(i)) - aimag(Om(m))
num = 2d0*rho(p,i,m)*rho(p,i,m)
tmp = num*cmplx(-(eps**2-eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part of the renormalization factor
!$OMP PARALLEL &
!$OMP SHARED(Re_DS,Im_DS,rho,eta,nS,nC,nO,nOrb,nR,e,Om) &
!$OMP PRIVATE(m,a,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nOrb-nR
do m=1,nS
do a=nO+1,nOrb-nR
eps = real(e(p)) - real(e(a)) - real(Om(m))
eta_tilde = eta + aimag(e(p)) - aimag(e(a)) - aimag(Om(m))
num = 2d0*rho(p,a,m)*rho(p,a,m)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Compute renormalization factor from derivative
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Z = cmplx(Re_Z,Im_Z,kind=8)
Sig = cmplx(Re_Sig,Im_Sig,kind=8)
deallocate(Re_DS,Im_DS,Re_Z,Im_Z,Re_Sig,Im_Sig)
!!-------------------------------------!
!! Galitskii-Migdal correlation energy !
!!-------------------------------------!
!
! EcGM = 0d0
! do m=1,nS
! do a=nO+1,nOrb-nR
! do i=nC+1,nO
!
! eps = e(a) - e(i) + Om(m)
! num = 4d0*rho(a,i,m)*rho(a,i,m)
! EcGM = EcGM - num*eps/(eps**2 + eta**2)
!
! end do
! end do
! end do
!
end subroutine

110
src/GW/complex_RGW_self_energy_diag.f90 Normal file
View File

@ -0,0 +1,110 @@
subroutine complex_RGW_self_energy_diag(eta,nBas,nOrb,nC,nO,nV,nR,nS,Re_e,Im_e,Om,rho,EcGM,Re_Sig,Im_Sig,Re_Z,Im_Z)
! Compute diagonal of the correlation part of the self-energy and the renormalization factor
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: Re_e(nBas)
double precision,intent(in) :: Im_e(nBas)
complex*16,intent(in) :: Om(nS)
complex*16,intent(in) :: rho(nBas,nBas,nS)
! Local variables
integer :: i,a,p,m
double precision :: eps
complex*16 :: num
double precision :: eta_tilde
double precision,allocatable :: Re_DS(:)
double precision,allocatable :: Im_DS(:)
complex*16 :: tmp
! Output variables
double precision,intent(out) :: Re_Sig(nBas)
double precision,intent(out) :: Im_Sig(nBas)
double precision,intent(out) :: Re_Z(nBas)
double precision,intent(out) :: Im_Z(nBas)
complex*16,intent(out) :: EcGM
! Initialize
allocate(Re_DS(nBas),Im_DS(nBas))
Re_Sig(:) = 0d0
Im_Sig(:) = 0d0
Re_DS(:) = 0d0
Im_DS(:) = 0d0
!----------------!
! GW self-energy !
!----------------!
! Occupied part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(nBas,Re_Sig,Im_Sig,rho,eta,nS,nC,nO,nOrb,nR,Re_e,Im_e,Om,Re_DS,Im_DS) &
!$OMP PRIVATE(m,i,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do i=nC+1,nO
do m=1,nS
eps = Re_e(p) - Re_e(i) + real(Om(m))
eta_tilde = eta - Im_e(p) + Im_e(i) - aimag(Om(m))
num = 2d0*rho(p,i,m)**2
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
eta_tilde/(eps**2+eta_tilde**2),kind=8)
Re_Sig(p) = Re_Sig(p) + real(tmp)
Im_Sig(p) = Im_Sig(p) + aimag(tmp)
tmp = num*cmplx(-(eps**2-eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
-2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Virtual part of the correlation self-energy
!$OMP PARALLEL &
!$OMP SHARED(nBas,Re_Sig,Im_Sig,rho,eta,nS,nC,nO,nOrb,nR,Re_e,Im_e,Om,Re_DS,Im_DS) &
!$OMP PRIVATE(m,a,p,eps,num,eta_tilde,tmp) &
!$OMP DEFAULT(NONE)
!$OMP DO
do p=nC+1,nBas-nR
do a=nO+1,nBas-nR
do m=1,nS
eps = Re_e(p) - Re_e(a) - real(Om(m))
eta_tilde = eta + Im_e(p) - Im_e(a) - aimag(Om(m))
num = 2d0*rho(p,a,m)**2
tmp = num*cmplx(eps/(eps**2 + eta_tilde**2),&
-eta_tilde/(eps**2 + eta_tilde**2),kind=8)
Re_Sig(p) = Re_Sig(p) + real(tmp)
Im_Sig(p) = Im_Sig(p) + aimag(tmp)
tmp = num*cmplx(-(eps**2 - eta_tilde**2)/(eps**2 + eta_tilde**2)**2,&
2*eta_tilde*eps/(eps**2 + eta_tilde**2)**2,kind=8)
Re_DS(p) = Re_DS(p) + real(tmp)
Im_DS(p) = Im_DS(p) + aimag(tmp)
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL
! Compute renormalization factor from derivative
Re_Z(:) = (1d0-Re_DS(:))/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
Im_Z(:) = Im_DS(:)/((1d0 - Re_DS(:))**2 + Im_DS(:)**2)
deallocate(Re_DS,Im_DS)
end subroutine

243
src/GW/complex_cRG0W0.f90 Normal file
View File

@ -0,0 +1,243 @@
subroutine complex_cRG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,CAP,dipole_int,eHF)
! Perform a fully complex G0W0 calculation with CAP
implicit none
include 'parameters.h'
include 'quadrature.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
logical,intent(in) :: dophBSE
logical,intent(in) :: dophBSE2
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA_W
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: doSRG
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
complex*16,intent(in) :: CAP(nOrb,nOrb)
complex*16,intent(in) :: dipole_int(nOrb,nOrb,ncart)
complex*16,intent(in) :: eHF(nOrb)
! Local variables
logical :: print_W = .false.
logical :: plot_self = .false.
logical :: dRPA_W
integer :: isp_W
integer :: p
double precision :: flow
complex*16 :: EcRPA
complex*16 :: EcBSE(nspin)
complex*16 :: EcGM
complex*16,allocatable :: Aph(:,:)
complex*16,allocatable :: Bph(:,:)
double precision,allocatable :: Re_SigC(:)
double precision,allocatable :: Im_SigC(:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
complex*16,allocatable :: Om(:)
complex*16,allocatable :: XpY(:,:)
complex*16,allocatable :: XmY(:,:)
complex*16,allocatable :: rho(:,:,:)
double precision,allocatable :: Re_eGWlin(:)
double precision, allocatable :: Im_eGWlin(:)
double precision,allocatable :: Re_eGW(:)
double precision,allocatable :: Im_eGW(:)
double precision, allocatable :: Re_eHF(:)
double precision, allocatable :: Im_eHF(:)
! Hello world
write(*,*)
write(*,*)'***************************************'
write(*,*)'* Restricted complex G0W0 Calculation *'
write(*,*)'***************************************'
write(*,*)
! Spin manifold and TDA for dynamical screening
isp_W = 1
dRPA_W = .true.
if(TDA_W) then
write(*,*) 'Tamm-Dancoff approximation for dynamical screening!'
write(*,*)
end if
! SRG regularization
flow = 500d0
if(doSRG) then
write(*,*) '*** SRG regularized G0W0 scheme ***'
write(*,*)
end if
! Memory allocation
allocate(Aph(nS,nS),Bph(nS,nS),Re_SigC(nOrb),Im_SigC(nOrb),Re_Z(nOrb),Im_Z(nOrb),Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS), &
Re_eGW(nOrb),Im_eGW(nOrb),Re_eGWlin(nOrb),Im_eGWlin(nOrb),Re_eHF(nOrb),Im_eHF(nOrb))
Re_eHF(:) = real(eHF(:))
Im_eHF(:) = aimag(eHF(:))
!-------------------!
! Compute screening !
!-------------------!
call complex_phRLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
if(.not.TDA_W) call complex_phRLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call complex_phRLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
!if(print_W) call print_excitation_energies('phRPA@RHF','singlet',nS,Om)
!--------------------------!
! Compute spectral weights !
!--------------------------!
call complex_RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
!------------------------!
! Compute GW self-energy !
!------------------------!
if(doSRG) then
call complex_RGW_SRG_self_energy_diag(flow,eta,nBas,nOrb,nC,nO,nV,nR,nS,Re_eHF,Im_eHF,Om,rho,EcGM,Re_SigC,Im_SigC,Re_Z,Im_Z)
else
call complex_RGW_self_energy_diag(eta,nBas,nOrb,nC,nO,nV,nR,nS,Re_eHF,Im_eHF,Om,rho,EcGM,Re_SigC,Im_SigC,Re_Z,Im_Z)
end if
!-----------------------------------!
! Solve the quasi-particle equation !
!-----------------------------------!
! Linearized or graphical solution?
Re_eGWlin(:) = Re_eHF(:) + Re_Z(:)*Re_SigC(:) - Im_Z(:)*Im_SigC(:)
Im_eGWlin(:) = Im_eHF(:) + Re_Z(:)*Im_SigC(:) + Im_Z(:)*Re_SigC(:)
if(linearize) then
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
write(*,*)
Re_eGW(:) = Re_eGWlin(:)
Im_eGW(:) = Im_eGWlin(:)
else
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call complex_RGW_QP_graph(doSRG,eta,flow,nOrb,nC,nO,nV,nR,nS, &
Re_eHF,Im_eHF,Om,rho,Re_eGWlin,Im_eGWlin,Re_eHF,Im_eHF, &
Re_eGW,Im_eGW,Re_Z,Im_Z)
end if
! Plot self-energy, renormalization factor, and spectral function
!
if(plot_self) call complex_RGW_plot_self_energy(nOrb,eta,nC,nO,nV,nR,nS,eHF,eHF,Om,rho)
!
!! Cumulant expansion
!
!! call RGWC(dotest,eta,nOrb,nC,nO,nV,nR,nS,Om,rho,eHF,eHF,eGW,Z)
!
!! Compute the RPA correlation energy
!
! call phRLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,Re_eGW,ERI,Aph)
! if(.not.TDA_W) call phRLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
!
! call phRLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
!
!!--------------!
!! Dump results !
!!--------------!
!
call print_complex_cRG0W0(nOrb,nO,Re_eHF,Im_eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGW,Im_eGW,EcRPA,EcGM)
!!---------------------------!
!! Perform phBSE calculation !
!!---------------------------!
!!
!! if(dophBSE) then
!!
!! call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, &
!! nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,Re_eGW,EcBSE)
!!
!! write(*,*)
!! write(*,*)'-------------------------------------------------------------------------------'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF correlation energy (singlet) = ',EcBSE(1),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF correlation energy (triplet) = ',EcBSE(2),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF correlation energy = ',sum(EcBSE),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0W0@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
!! write(*,*)'-------------------------------------------------------------------------------'
!! write(*,*)
!!
!! ! Compute the BSE correlation energy via the adiabatic connection fluctuation dissipation theorem
!!
!! if(doACFDT) then
!!
!! call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,eHF,Re_eGW,EcBSE)
!!
!! write(*,*)
!! write(*,*)'-------------------------------------------------------------------------------'
!! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF correlation energy (singlet) = ',EcBSE(1),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF correlation energy (triplet) = ',EcBSE(2),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF correlation energy = ',sum(EcBSE),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0W0@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
!! write(*,*)'-------------------------------------------------------------------------------'
!! write(*,*)
!!
!! end if
!!
!! end if
!!
!!!---------------------------!
!!! Perform ppBSE calculation !
!!!---------------------------!
!!
!! if(doppBSE) then
!!
!! call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,Re_eGW,EcBSE)
!!
!! write(*,*)
!! write(*,*)'-------------------------------------------------------------------------------'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF correlation energy (singlet) = ',EcBSE(1),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF correlation energy (triplet) = ',EcBSE(2),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF correlation energy = ',sum(EcBSE),' au'
!! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0W0@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
!! write(*,*)'-------------------------------------------------------------------------------'
!! write(*,*)
!!
!! end if
!!
!!! Testing zone
!!
!! if(dotest) then
!!
!! call dump_test_value('R','G0W0 correlation energy',EcRPA)
!! call dump_test_value('R','G0W0 HOMO energy',Re_eGW(nO))
!! call dump_test_value('R','G0W0 LUMO energy',Re_eGW(nO+1))
!!
!! end if
!!
end subroutine

295
src/GW/complex_evRGW.f90 Normal file
View File

@ -0,0 +1,295 @@
subroutine complex_evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform self-consistent eigenvalue-only GW calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ERHF
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
logical,intent(in) :: dophBSE
logical,intent(in) :: dophBSE2
logical,intent(in) :: TDA_W
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: doppBSE
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: linearize
double precision,intent(in) :: eta
logical,intent(in) :: doSRG
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
complex*16,intent(in) :: dipole_int(nOrb,nOrb,ncart)
! Local variables
logical :: dRPA = .true.
integer :: ispin
integer :: nSCF
integer :: n_diis
double precision :: flow
double precision :: rcond
double precision :: Conv
complex*16 :: EcRPA
complex*16 :: EcBSE(nspin)
complex*16 :: EcGM
double precision :: alpha
complex*16,allocatable :: Aph(:,:)
complex*16,allocatable :: Bph(:,:)
complex*16,allocatable :: error_diis(:,:)
complex*16,allocatable :: e_diis(:,:)
complex*16,allocatable :: eGW(:)
complex*16,allocatable :: eOld(:)
double precision,allocatable :: Re_eGW(:)
double precision,allocatable :: Im_eGW(:)
double precision,allocatable :: Re_eOld(:)
double precision,allocatable :: Im_eOld(:)
double precision,allocatable :: Re_eHF(:)
double precision,allocatable :: Im_eHF(:)
double precision,allocatable :: Re_Z(:)
double precision,allocatable :: Im_Z(:)
double precision,allocatable :: Re_SigC(:)
double precision,allocatable :: Im_SigC(:)
complex*16,allocatable :: Om(:)
complex*16,allocatable :: XpY(:,:)
complex*16,allocatable :: XmY(:,:)
complex*16,allocatable :: rho(:,:,:)
! Hello world
write(*,*)
write(*,*)'*******************************'
write(*,*)'* Restricted evGW Calculation *'
write(*,*)'*******************************'
write(*,*)
! TDA for W
if(TDA_W) then
write(*,*) 'Tamm-Dancoff approximation for dynamic screening!'
write(*,*)
end if
! SRG regularization
flow = 100d0
if(doSRG) then
write(*,*) '*** SRG regularized evGW scheme ***'
write(*,*)
end if
! Memory allocation
allocate(Aph(nS,nS),Bph(nS,nS),Re_eGW(nOrb),Im_eGW(nOrb),eGW(nOrb),Re_eOld(nOrb),Im_eOld(nOrb),&
eOld(nOrb),Re_Z(nOrb),Im_Z(nOrb),Re_SigC(nOrb),Im_SigC(nOrb), &
Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS),error_diis(nOrb,max_diis),e_diis(nOrb,max_diis),&
Re_eHF(nOrb),Im_eHF(nOrb))
! Initialization
nSCF = 0
ispin = 1
n_diis = 0
Conv = 1d0
e_diis(:,:) = 0d0
error_diis(:,:) = 0d0
Re_eHF(:) = real(eHF(:))
Im_eHF(:) = aimag(eHF(:))
eGW(:) = eHF(:)
Re_eGW(:) = Re_eHF(:)
Im_eGW(:) = Im_eHF(:)
eOld(:) = eGW(:)
Re_eOld(:) = Re_eGW(:)
Im_eOld(:) = Im_eGW(:)
Re_Z(:) = 1d0
Im_Z(:) = 0d0
rcond = 0d0
!------------------------------------------------------------------------
! Main loop
!------------------------------------------------------------------------
do while(Conv > thresh .and. nSCF <= maxSCF)
! Compute screening
call complex_phRLR_A(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph)
if(.not.TDA_W) call complex_phRLR_B(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call complex_phRLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
! Compute spectral weights
call complex_RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
if(doSRG) then
call complex_RGW_SRG_self_energy_diag(flow,eta,nBas,nOrb,nC,nO,nV,nR,nS,Re_eGW,Im_eGW,Om,rho,&
EcGM,Re_SigC,Im_SigC,Re_Z,Im_Z)
else
call complex_RGW_self_energy_diag(eta,nBas,nOrb,nC,nO,nV,nR,nS,Re_eGW,Im_eGW,Om,rho,&
EcGM,Re_SigC,Im_SigC,Re_Z,Im_Z)
end if
! Solve the quasi-particle equation
if(linearize) then
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
write(*,*)
Re_eGW(:) = Re_eHF(:) + Re_SigC(:)
Im_eGW(:) = Im_eHF(:) + Im_SigC(:)
eGW = cmplx(Re_eGW,Im_eGW,kind=8)
else
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call complex_RGW_QP_graph(doSRG,eta,flow,nOrb,nC,nO,nV,nR,nS,Re_eHF,Im_eHF,Om,&
rho,Re_eOld,Im_eOld,Re_eOld,Im_eOld,Re_eGW,Im_eGW,Re_Z,Im_Z)
eGW = cmplx(Re_eGW,Im_eGW,kind=8)
end if
! Convergence criteria
Conv = maxval(abs(eGW - eOld))
! Print results
call print_complex_evRGW(nBas,nO,nSCF,Conv,Re_eHF,Im_eHF,ENuc,ERHF,Re_SigC,Im_SigC,&
Re_Z,Im_Z,Re_eGW,Im_eGW,EcRPA,EcGM)
! DIIS extrapolation
if(max_diis > 1) then
n_diis = min(n_diis+1,max_diis)
call complex_DIIS_extrapolation(rcond,nOrb,nOrb,n_diis,error_diis,e_diis,eGW-eOld,eGW)
end if
! Save quasiparticles energy for next cycle
Re_eGW(:) = real(eGW(:))
Im_eGW(:) = aimag(eGW(:))
eOld(:) = eGW(:)
Re_eOld(:) = real(eOld(:))
Im_eOld(:) = aimag(eOld(:))
! Increment
nSCF = nSCF + 1
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
! Did it actually converge?
if(nSCF == maxSCF+1) then
write(*,*)
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)' Convergence failed '
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)
stop
end if
!--------------------!
! Cumulant expansion !
!--------------------!
!
!! call RGWC(dotest,eta,nOrb,nC,nO,nV,nR,nS,Om,rho,eHF,eGW,eGW,Z)
!
!! Deallocate memory
!
! deallocate(Aph,Bph,eOld,Z,SigC,Om,XpY,XmY,rho,error_diis,e_diis)
!
!! Perform BSE calculation
!
! if(dophBSE) then
!
! call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, &
! nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eGW,eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@evGW@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@evGW@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@evGW@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@evGW@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
!! Compute the BSE correlation energy via the adiabatic connection
!
! if(doACFDT) then
!
! call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@evGW@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@evGW@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@evGW@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@evGW@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
! end if
!
! if(doppBSE) then
!
! call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGW@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGW@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGW@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@evGW@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Testing zone
!
! if(dotest) then
!
! call dump_test_value('R','evGW correlation energy',EcRPA)
! call dump_test_value('R','evGW HOMO energy',eGW(nO))
! call dump_test_value('R','evGW LUMO energy',eGW(nO+1))
!
! end if
!
end subroutine

388
src/GW/complex_qsRGW.f90 Normal file
View File

@ -0,0 +1,388 @@
subroutine complex_qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2, &
TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet,eta,doSRG,nNuc,ZNuc,rNuc, &
ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO, &
ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF, &
CAP_AO,CAP_MO)
! Perform a quasiparticle self-consistent GW calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
logical,intent(in) :: dophBSE
logical,intent(in) :: dophBSE2
logical,intent(in) :: TDA_W
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
logical,intent(in) :: dTDA
logical,intent(in) :: doppBSE
logical,intent(in) :: singlet
logical,intent(in) :: triplet
double precision,intent(in) :: eta
logical,intent(in) :: doSRG
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
double precision,intent(in) :: rNuc(nNuc,ncart)
double precision,intent(in) :: ENuc
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: cHF(nBas,nOrb)
complex*16,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: S(nBas,nBas)
double precision,intent(in) :: T(nBas,nBas)
double precision,intent(in) :: V(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
double precision,intent(in) :: X(nBas,nBas)
double precision,intent(in) :: CAP_AO(nBas,nBas)
complex*16,intent(inout) :: CAP_MO(nBas,nBas)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
complex*16,intent(inout) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
complex*16,intent(inout) :: dipole_int_MO(nOrb,nOrb,ncart)
! Local variables
integer :: nSCF
integer :: nBas_Sq
integer :: ispin
integer :: ixyz
integer :: n_diis
complex*16 :: ET
complex*16 :: EV
complex*16 :: EJ
complex*16 :: EK
complex*16 :: EqsGW
complex*16 :: EW
complex*16 :: EcRPA
complex*16 :: EcBSE(nspin)
complex*16 :: EcGM
double precision :: Conv
double precision :: rcond
complex*16,external :: complex_trace_matrix
complex*16 :: dipole(ncart)
double precision :: flow
logical :: dRPA_W = .true.
logical :: print_W = .false.
complex*16,allocatable :: err_diis(:,:)
complex*16,allocatable :: F_diis(:,:)
complex*16,allocatable :: Aph(:,:)
complex*16,allocatable :: Bph(:,:)
complex*16,allocatable :: Om(:)
complex*16,allocatable :: XpY(:,:)
complex*16,allocatable :: XmY(:,:)
complex*16,allocatable :: rho(:,:,:)
complex*16,allocatable :: c(:,:)
complex*16,allocatable :: cp(:,:)
complex*16,allocatable :: eGW(:)
complex*16,allocatable :: P(:,:)
complex*16,allocatable :: F(:,:)
complex*16,allocatable :: Fp(:,:)
complex*16,allocatable :: J(:,:)
complex*16,allocatable :: K(:,:)
complex*16,allocatable :: SigC(:,:)
complex*16,allocatable :: SigCp(:,:)
complex*16,allocatable :: Z(:)
complex*16,allocatable :: err(:,:)
! Hello world
write(*,*)
write(*,*)'*******************************'
write(*,*)'* Restricted qsGW Calculation *'
write(*,*)'*******************************'
write(*,*)
! Warning
write(*,*) '!! ERIs and CAP in MO basis will be overwritten in qsGW !!'
write(*,*)
! Stuff
nBas_Sq = nBas*nBas
! TDA for W
if(TDA_W) then
write(*,*) 'Tamm-Dancoff approximation for dynamical screening!'
write(*,*)
end if
! SRG regularization
flow = 500d0
if(doSRG) then
write(*,*) '*** SRG regularized qsGW scheme ***'
write(*,*)
end if
! Memory allocation
allocate(eGW(nOrb))
allocate(Z(nOrb))
allocate(c(nBas,nOrb))
allocate(cp(nOrb,nOrb))
allocate(Fp(nOrb,nOrb))
allocate(SigC(nOrb,nOrb))
allocate(P(nBas,nBas))
allocate(F(nBas,nBas))
allocate(J(nBas,nBas))
allocate(K(nBas,nBas))
allocate(err(nBas,nBas))
allocate(SigCp(nBas,nBas))
allocate(Aph(nS,nS))
allocate(Bph(nS,nS))
allocate(Om(nS))
allocate(XpY(nS,nS))
allocate(XmY(nS,nS))
allocate(rho(nOrb,nOrb,nS))
allocate(err_diis(nBas_Sq,max_diis))
allocate(F_diis(nBas_Sq,max_diis))
! Initialization
nSCF = -1
n_diis = 0
ispin = 1
Conv = 1d0
P(:,:) = PHF(:,:)
eGW(:) = eHF(:)
c(:,:) = cHF(:,:)
F_diis(:,:) = 0d0
err_diis(:,:) = 0d0
rcond = 0d0
!------------------------------------------------------------------------
! Main loop
!------------------------------------------------------------------------
do while(Conv > thresh .and. nSCF <= maxSCF)
! Increment
nSCF = nSCF + 1
! Build Hartree-exchange matrix
call complex_Hartree_matrix_AO_basis(nBas,P,ERI_AO,J)
call complex_exchange_matrix_AO_basis(nBas,P,ERI_AO,K)
! AO to MO transformation of two-electron integrals
do ixyz=1,ncart
call complex_AOtoMO(nBas,nOrb,c,dipole_int_AO(1,1,ixyz),dipole_int_MO(1,1,ixyz))
end do
call complex_AOtoMO_ERI_RHF(nBas,nOrb,c,ERI_AO,ERI_MO)
! Compute linear response
call complex_phRLR_A(ispin,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,Aph)
if(.not.TDA_W) call complex_phRLR_B(ispin,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
call complex_phRLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
if(print_W) call print_excitation_energies('phRPA@GW@RHF','singlet',nS,Om)
call complex_RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI_MO,XpY,rho)
if(doSRG) then
call complex_RGW_SRG_self_energy(flow,eta,nBas,nOrb,nC,nO,nV,nR,nS,eGW,Om,&
rho,EcGM,SigC,Z)
else
call complex_RGW_self_energy(eta,nBas,nOrb,nC,nO,nV,nR,nS,eGW,Om,rho,&
EcGM,SigC,Z)
end if
! Make correlation self-energy Hermitian and transform it back to AO basis
SigC = 0.5d0*(SigC + transpose(SigC))
call complex_MOtoAO(nBas,nOrb,S,c,SigC,SigCp)
! Solve the quasi-particle equation
F(:,:) = cmplx(Hc(:,:),CAP_AO(:,:),kind=8) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
if(nBas .ne. nOrb) then
call complex_complex_AOtoMO(nBas,nOrb,c(1,1),F(1,1),Fp(1,1))
call complex_MOtoAO(nBas,nOrb,S(1,1),c(1,1),Fp(1,1),F(1,1))
endif
! Compute commutator and convergence criteria
err = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
if(nSCF > 1) Conv = maxval(abs(err))
! Kinetic energy
ET = complex_trace_matrix(nBas,matmul(P,T))
! Potential energy
EV = complex_trace_matrix(nBas,matmul(P,V))
! Hartree energy
EJ = 0.5d0*complex_trace_matrix(nBas,matmul(P,J))
! Exchange energy
EK = 0.25d0*complex_trace_matrix(nBas,matmul(P,K))
! CAP energy
EW = complex_trace_matrix(nBas,matmul(P,(0d0,1d0)*CAP_AO))
! Total energy
EqsGW = ET + EV + EJ + EK + EW
! DIIS extrapolation
if(max_diis > 1) then
n_diis = min(n_diis+1,max_diis)
call complex_DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,err_diis,F_diis,err,F)
end if
! Diagonalize Hamiltonian in AO basis
if(nBas .eq. nOrb) then
Fp = matmul(transpose(X),matmul(F,X))
cp(:,:) = Fp(:,:)
call complex_diagonalize_matrix(nOrb,cp,eGW)
call complex_orthogonalize_matrix(nBas,cp)
c = matmul(X,cp)
else
Fp = matmul(transpose(c),matmul(F,c))
cp(:,:) = Fp(:,:)
call complex_diagonalize_matrix(nOrb,cp,eGW)
call complex_orthogonalize_matrix(nBas,cp)
c = matmul(c,cp)
endif
call complex_complex_AOtoMO(nBas,nOrb,c,SigCp,SigC)
! Density matrix
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
! Print results
!call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_complex_qsRGW(nBas,nOrb,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z, &
ENuc,ET,EV,EW,EJ,EK,EcGM,EcRPA,EqsGW,dipole)
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
! Did it actually converge?
! if(nSCF == maxSCF+1) then
!
! write(*,*)
! write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
! write(*,*)' Convergence failed '
! write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
! write(*,*)
!
! deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,Z,Om,XpY,XmY,rho,err,err_diis,F_diis)
! stop
!
! end if
!
!! Deallocate memory
!
! deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,Z,Om,XpY,XmY,rho,err,err_diis,F_diis)
!
!! Perform BSE calculation
!
! if(dophBSE) then
!
! call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, &
! nOrb,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eGW,eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@qsGW@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@qsGW@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@qsGW@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@qsGW@RHF total energy = ',ENuc + EqsGW + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
!! Compute the BSE correlation energy via the adiabatic connection
!
! if(doACFDT) then
!
! call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@qsGW@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@qsGW@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@qsGW@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@qsGW@RHF total energy = ',ENuc + EqsGW + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
! end if
!
! if(doppBSE) then
!
! call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eHF,eGW,EcBSE)
!
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGW@RHF correlation energy (singlet) = ',EcBSE(1),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGW@RHF correlation energy (triplet) = ',EcBSE(2),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGW@RHF correlation energy = ',sum(EcBSE),' au'
! write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@qsGW@RHF total energy = ',ENuc + ERHF + sum(EcBSE),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
! end if
!
!! Testing zone
!
! if(dotest) then
!
! call dump_test_value('R','qsGW correlation energy',EcRPA)
! call dump_test_value('R','qsGW HOMO energy',eGW(nO))
! call dump_test_value('R','qsGW LUMO energy',eGW(nO+1))
!
! end if
!
end subroutine

66
src/GW/print_cRG0W0.f90 Normal file
View File

@ -0,0 +1,66 @@
subroutine print_cRG0W0(nBas,nO,eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGW,Im_eGW,EcRPA,EcGM,CAP)
! Print one-electron energies and other stuff for G0W0
implicit none
include 'parameters.h'
integer,intent(in) :: nBas,nO
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: EcRPA
double precision,intent(in) :: EcGM
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: Re_SigC(nBas)
double precision,intent(in) :: Im_SigC(nBas)
double precision,intent(in) :: Re_Z(nBas)
double precision,intent(in) :: Im_Z(nBas)
double precision,intent(in) :: Re_eGW(nBas)
double precision,intent(in) :: Im_eGW(nBas)
double precision,intent(in) :: CAP(nBas,nBas)
integer :: p,index_homo,index_lumo
double precision :: Re_eHOMO,Re_eLUMO,Im_eHOMO,Im_eLUMO,Re_Gap,Im_Gap
! HOMO and LUMO
index_homo = maxloc(Re_eGW(1:nO),1)
Re_eHOMO = Re_eGW(index_homo)
Im_eHOMO = Im_eGW(index_homo)
index_lumo = minloc(Re_eGW(nO+1:nBas),1) + nO
Re_eLUMO = Re_eGW(index_lumo)
Im_eLUMO = Im_eGW(index_lumo)
Re_Gap = Re_eLUMO-Re_eHOMO
Im_Gap = Im_eLUMO-Im_eHOMO
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' cG0W0@RHF calculation '
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','e_HF (eV)','|','Re(Sig_GW) (eV)','|','Re(Z)','|','Re(e_GW) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','CAP (eV)','|','Im(Sig_GW) (eV)','|','Im(Z)','|','Im(e_GW) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',eHF(p)*HaToeV,'|',Re_SigC(p)*HaToeV,'|',Re_Z(p),'|',Re_eGW(p)*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',CAP(p,p)*HaToeV,'|',Im_SigC(p)*HaToeV,'|',Im_Z(p),'|',Im_eGW(p)*HaToeV,'|'
write(*,*)'-------------------------------------------------------------------------------'
end do
write(*,*)
write(*,*)'---------------------------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A5,F15.6,A3)') 'cG0W0@RHF HOMO energy = ',Re_eHOMO*HaToeV,' + i*',Im_eHOMO*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A5,F15.6,A3)') 'cG0W0@RHF LUMO energy = ',Re_eLUMO*HaToeV,' + i*',Im_eLUMO*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A5,F15.6,A3)') 'cG0W0@RHF HOMO-LUMO gap = ',Re_Gap*HaToeV,' + i*',Im_Gap*HaToeV,' eV'
write(*,*)'---------------------------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'phRPA@cG0W0@RHF total energy = ',ENuc + ERHF + EcRPA,' au'
write(*,'(2X,A60,F15.6,A3)') 'phRPA@cG0W0@RHF correlation energy = ',EcRPA,' au'
write(*,'(2X,A60,F15.6,A3)') ' GM@cG0W0@RHF total energy = ',ENuc + ERHF + EcGM,' au'
write(*,'(2X,A60,F15.6,A3)') ' GM@cG0W0@RHF correlation energy = ',EcGM,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
end subroutine

69
src/GW/print_complex_cRG0W0.f90 Normal file
View File

@ -0,0 +1,69 @@
subroutine print_complex_cRG0W0(nBas,nO,Re_eHF,Im_eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGW,Im_eGW,EcRPA,EcGM)
! Print one-electron energies and other stuff for G0W0
implicit none
include 'parameters.h'
integer,intent(in) :: nBas,nO
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: EcRPA
complex*16,intent(in) :: EcGM
double precision,intent(in) :: Re_eHF(nBas)
double precision,intent(in) :: Im_eHF(nBas)
double precision,intent(in) :: Re_SigC(nBas)
double precision,intent(in) :: Im_SigC(nBas)
double precision,intent(in) :: Re_Z(nBas)
double precision,intent(in) :: Im_Z(nBas)
double precision,intent(in) :: Re_eGW(nBas)
double precision,intent(in) :: Im_eGW(nBas)
integer :: p,index_homo,index_lumo
double precision :: Re_eHOMO,Re_eLUMO,Im_eHOMO,Im_eLUMO,Re_Gap,Im_Gap
! HOMO and LUMO
index_homo = maxloc(Re_eGW(1:nO),1)
Re_eHOMO = Re_eGW(index_homo)
Im_eHOMO = Im_eGW(index_homo)
index_lumo = minloc(Re_eGW(nO+1:nBas),1) + nO
Re_eLUMO = Re_eGW(index_lumo)
Im_eLUMO = Im_eGW(index_lumo)
Re_Gap = Re_eLUMO-Re_eHOMO
Im_Gap = Im_eLUMO-Im_eHOMO
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' cG0W0@RHF calculation '
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Re(e_HF) (eV)','|','Re(Sig_GW) (eV)','|','Re(Z)','|','Re(e_GW) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Im(e_HF) (eV)','|','Im(Sig_GW) (eV)','|','Im(Z)','|','Im(e_GW) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Re_eHF(p)*HaToeV,'|',Re_SigC(p)*HaToeV,'|',Re_Z(p),'|',Re_eGW(p)*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Im_eHF(p)*HaToeV,'|',Im_SigC(p)*HaToeV,'|',Im_Z(p),'|',Im_eGW(p)*HaToeV,'|'
if(p==nO) then
write(*,*)'-------------------------------------------------------------------------------'
end if
write(*,*)'-------------------------------------------------------------------------------'
end do
write(*,*)
write(*,*)'---------------------------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A5,F15.6,A3)') 'cG0W0@RHF HOMO energy = ',Re_eHOMO*HaToeV,' + i*',Im_eHOMO*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A5,F15.6,A3)') 'cG0W0@RHF LUMO energy = ',Re_eLUMO*HaToeV,' + i*',Im_eLUMO*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A5,F15.6,A3)') 'cG0W0@RHF HOMO-LUMO gap = ',Re_Gap*HaToeV,' + i*',Im_Gap*HaToeV,' eV'
write(*,*)'---------------------------------------------------------------------------------------------------'
! write(*,'(2X,A60,F15.6,A3)') 'phRPA@cG0W0@RHF total energy = ',ENuc + ERHF + EcRPA,' au'
! write(*,'(2X,A60,F15.6,A3)') 'phRPA@cG0W0@RHF correlation energy = ',EcRPA,' au'
! write(*,'(2X,A60,F15.6,A3)') ' GM@cG0W0@RHF total energy = ',ENuc + ERHF + EcGM,' au'
! write(*,'(2X,A60,F15.6,A3)') ' GM@cG0W0@RHF correlation energy = ',EcGM,' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
!
end subroutine

67
src/GW/print_complex_evRGW.f90 Normal file
View File

@ -0,0 +1,67 @@
subroutine print_complex_evRGW(nBas,nO,nSCF,Conv,Re_eHF,Im_eHF,ENuc,ERHF,Re_SigC,Im_SigC,Re_Z,Im_Z,Re_eGW,Im_eGW,EcRPA,EcGM)
! Print one-electron energies and other stuff for G0W0
implicit none
include 'parameters.h'
integer,intent(in) :: nBas,nO,nSCF
double precision,intent(in) :: Conv
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ERHF
complex*16,intent(in) :: EcRPA
complex*16,intent(in) :: EcGM
double precision,intent(in) :: Re_eHF(nBas)
double precision,intent(in) :: Im_eHF(nBas)
double precision,intent(in) :: Re_SigC(nBas)
double precision,intent(in) :: Im_SigC(nBas)
double precision,intent(in) :: Re_Z(nBas)
double precision,intent(in) :: Im_Z(nBas)
double precision,intent(in) :: Re_eGW(nBas)
double precision,intent(in) :: Im_eGW(nBas)
integer :: p,index_homo,index_lumo
double precision :: Re_eHOMO,Re_eLUMO,Im_eHOMO,Im_eLUMO,Re_Gap,Im_Gap
! HOMO and LUMO
index_homo = maxloc(Re_eGW(1:nO),1)
Re_eHOMO = Re_eGW(index_homo)
Im_eHOMO = Im_eGW(index_homo)
index_lumo = minloc(Re_eGW(nO+1:nBas),1) + nO
Re_eLUMO = Re_eGW(index_lumo)
Im_eLUMO = Im_eGW(index_lumo)
Re_Gap = Re_eLUMO-Re_eHOMO
Im_Gap = Im_eLUMO-Im_eHOMO
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
if(nSCF < 10) then
write(*,'(1X,A20,I1,A1,I1,A17)')' Self-consistent evG',nSCF,'W',nSCF,'@cRHF calculation'
elseif(nSCF < 100) then
write(*,'(1X,A20,I2,A1,I2,A17)')' Self-consistent evG',nSCF,'W',nSCF,'@cRHF calculation'
else
write(*,'(1X,A20,I3,A1,I3,A17)')' Self-consistent evG',nSCF,'W',nSCF,'@cRHF calculation'
end if
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Re(e_HF) (eV)','|','Re(Sig_GW) (eV)','|','Re(Z)','|','Re(e_GW) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Im(e_HF) (eV)','|','Im(Sig_GW) (eV)','|','Im(Z)','|','Im(e_GW) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Re_eHF(p)*HaToeV,'|',Re_SigC(p)*HaToeV,'|',Re_Z(p),'|',Re_eGW(p)*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',Im_eHF(p)*HaToeV,'|',Im_SigC(p)*HaToeV,'|',Im_Z(p),'|',Im_eGW(p)*HaToeV,'|'
if(p==nO) then
write(*,*)'-------------------------------------------------------------------------------'
end if
write(*,*)'-------------------------------------------------------------------------------'
end do
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.9)')'Convergence = ',Conv
write(*,*)
end subroutine

148
src/GW/print_complex_qsRGW.f90 Normal file
View File

@ -0,0 +1,148 @@
! ---
subroutine print_complex_qsRGW(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, SigC, &
Z, ENuc, ET, EV,EW, EJ, EK, EcGM, EcRPA, EqsGW, dipole)
! Print useful information about qsRGW calculation
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas, nOrb
integer,intent(in) :: nO
integer,intent(in) :: nSCF
double precision,intent(in) :: ENuc
complex*16,intent(in) :: ET
complex*16,intent(in) :: EV
complex*16,intent(in) :: EW
complex*16,intent(in) :: EJ
complex*16,intent(in) :: EK
complex*16,intent(in) :: EcGM
complex*16,intent(in) :: EcRPA
double precision,intent(in) :: Conv
double precision,intent(in) :: thresh
complex*16,intent(in) :: eHF(nOrb)
complex*16,intent(in) :: eGW(nOrb)
complex*16,intent(in) :: c(nBas,nOrb)
complex*16,intent(in) :: SigC(nOrb,nOrb)
complex*16,intent(in) :: Z(nOrb)
complex*16,intent(in) :: EqsGW
complex*16,intent(in) :: dipole(ncart)
! Local variables
logical :: dump_orb = .false.
integer :: p,ixyz,HOMO,LUMO
complex*16 :: Gap
double precision,external :: complex_trace_matrix
! Output variables
! HOMO and LUMO
HOMO = maxloc(real(eGW(1:nO)),1)
LUMO = minloc(real(eGW(nO+1:nBas)),1) + nO
Gap = eGW(LUMO)-eGW(HOMO)
! Compute energies
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
if(nSCF < 10) then
write(*,'(1X,A20,I1,A1,I1,A17)')' Self-consistent qsG',nSCF,'W',nSCF,'@cRHF calculation'
elseif(nSCF < 100) then
write(*,'(1X,A20,I2,A1,I2,A17)')' Self-consistent qsG',nSCF,'W',nSCF,'@cRHF calculation'
else
write(*,'(1X,A20,I3,A1,I3,A17)')' Self-consistent qsG',nSCF,'W',nSCF,'@cRHF calculation'
end if
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Re(e_HF (eV))','|','Re(Sig_GW) (eV)','|','Re(Z)','|','Re(e_GW) (eV)','|'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','Im(e_HF (eV))','|','Im(Sig_GW) (eV)','|','Im(Z)','|','Im(e_GW) (eV)','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nOrb
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',real(eHF(p))*HaToeV,'|',real(SigC(p,p))*HaToeV,'|',real(Z(p)),'|',real(eGW(p))*HaToeV,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',aimag(eHF(p))*HaToeV,'|',aimag(SigC(p,p))*HaToeV,'|',aimag(Z(p)),'|',aimag(eGW(p))*HaToeV,'|'
write(*,*)'-------------------------------------------------------------------------------'
if(p==nO) then
write(*,*)'-------------------------------------------------------------------------------'
end if
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO real energy = ',real(eGW(HOMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO imag energy = ',aimag(eGW(HOMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF LUMO real energy = ',real(eGW(LUMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF LUMO imag energy = ',aimag(eGW(LUMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO-LUMO gap = ',real(Gap)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'qsGW@RHF HOMO-LUMO gap = ',aimag(Gap)*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF total real energy = ',ENuc + real(EqsGW),' au'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF total imag energy = ',aimag(EqsGW),' au'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF exchange energy = ',real(EK),' au'
write(*,'(2X,A60,F15.6,A3)') ' qsGW@RHF exchange energy = ',aimag(EK),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
! Dump results for final iteration
if(Conv < thresh) then
write(*,*)
write(*,'(A50)') '---------------------------------------'
write(*,'(A33)') ' Summary '
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' One-electron energy = ',real(ET) + real(EV) + real(EW),' au'
write(*,'(A33,1X,F16.10,A3)') ' One-electron energy = ',aimag(ET) + aimag(EV) + aimag(EW),' au'
write(*,'(A33,1X,F16.10,A3)') ' Kinetic energy = ',real(ET),' au'
write(*,'(A33,1X,F16.10,A3)') ' Kinetic energy = ',aimag(ET),' au'
write(*,'(A33,1X,F16.10,A3)') ' Potential energy = ',real(EV),' au'
write(*,'(A33,1X,F16.10,A3)') ' Potential energy = ',aimag(EV),' au'
write(*,'(A33,1X,F16.10,A3)') ' CAP energy = ',real(EW),' au'
write(*,'(A33,1X,F16.10,A3)') ' CAP energy = ',aimag(EW),' au'
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' Two-electron energy = ',real(EJ + EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Two-electron energy = ',aimag(EJ + EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Hartree energy = ',real(EJ),' au'
write(*,'(A33,1X,F16.10,A3)') ' Hartree energy = ',aimag(EJ),' au'
write(*,'(A33,1X,F16.10,A3)') ' Exchange energy = ',real(EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Exchange energy = ',aimag(EK),' au'
write(*,'(A33,1X,F16.10,A3)') ' Correlation energy = ',real(EcGM),' au'
write(*,'(A33,1X,F16.10,A3)') ' Correlation energy = ',aimag(EcGM),' au'
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' Electronic energy = ',real(EqsGW),' au'
write(*,'(A33,1X,F16.10,A3)') ' Electronic energy = ',aimag(EqsGW),' au'
write(*,'(A33,1X,F16.10,A3)') ' Nuclear repulsion = ',ENuc,' au'
write(*,'(A33,1X,F16.10,A3)') ' qsRGW energy = ',ENuc + real(EqsGW),' au'
write(*,'(A33,1X,F16.10,A3)') ' qsRGW energy = ',aimag(EqsGW),' au'
write(*,'(A50)') '---------------------------------------'
write(*,*)
if(dump_orb) then
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' Restricted qsGW orbital coefficients'
write(*,'(A50)') '---------------------------------------'
call complex_matout(nBas, nOrb, c)
write(*,*)
end if
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' Restricted qsGW orbital energies (au) '
write(*,'(A50)') '---------------------------------------'
call complex_vecout(nOrb, eGW)
write(*,*)
end if
end subroutine

2
src/HF/RHF.f90
View File

@ -70,7 +70,6 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
write(*,*)
! Useful quantities
nBas_Sq = nBas*nBas
! Memory allocation
@ -125,7 +124,6 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
call Hartree_matrix_AO_basis(nBas,P,ERI,J)
call exchange_matrix_AO_basis(nBas,P,ERI,K)
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:)
! Check convergence

127
src/HF/cRHF.f90
View File

@ -1,5 +1,5 @@
subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nO,S,T,V,ERI,dipole_int,X,ERHF,eHF,c,P)
subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,ENuc, &
nBas,nO,S,T,V,ERI,CAP,X,ERHF,eHF,c,P,F)
! Perform complex restricted Hartree-Fock calculation
@ -18,50 +18,46 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
integer,intent(in) :: nBas
integer,intent(in) :: nO
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
double precision,intent(in) :: rNuc(nNuc,ncart)
double precision,intent(in) :: ENuc
double precision,intent(in) :: S(nBas,nBas)
double precision,intent(in) :: T(nBas,nBas)
double precision,intent(in) :: V(nBas,nBas)
double precision,intent(in) :: X(nBas,nBas)
double precision,intent(in) :: CAP(nBas,nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
! Local variables
! Local variables
integer :: nSCF
integer :: nBasSq
integer :: n_diis
double precision :: ET
double precision :: EV
double precision :: EJ
double precision :: EK
double precision :: dipole(ncart)
complex*16 :: ET
complex*16 :: EV
complex*16 :: EJ
complex*16 :: EK
complex*16 :: EW
double precision :: Conv
double precision :: rcond
double precision,external :: trace_matrix
complex*16,external :: complex_trace_matrix
double precision :: eta
double precision,allocatable :: W(:,:)
complex*16,allocatable :: Hc(:,:)
complex*16,allocatable :: J(:,:)
complex*16,allocatable :: K(:,:)
complex*16,allocatable :: cp(:,:)
complex*16,allocatable :: F(:,:)
complex*16,allocatable :: Fp(:,:)
complex*16,allocatable :: err(:,:)
complex*16,allocatable :: err_diis(:,:)
complex*16,allocatable :: F_diis(:,:)
complex*16,allocatable :: Hc(:,:)
! Output variables
complex*16,intent(out) :: ERHF
complex*16,intent(out) :: eHF(nBas)
complex*16,intent(out) :: c(nBas,nBas)
complex*16,intent(inout) :: c(nBas,nBas)
complex*16,intent(out) :: P(nBas,nBas)
complex*16,intent(inout) :: F(nBas,nBas)
! Hello world
@ -74,59 +70,51 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
! Useful quantities
nBasSq = nBas*nBas
eta = 0.01d0
! Memory allocation
allocate(J(nBas,nBas),K(nBas,nBas),err(nBas,nBas),cp(nBas,nBas),F(nBas,nBas), &
Fp(nBas,nBas),err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis), &
Hc(nBas,nBas),W(nBas,nBas))
allocate(err_diis(nBasSq,max_diis))
allocate(F_diis(nBasSq,max_diis))
allocate(Hc(nBas,nBas))
allocate(J(nBas,nBas))
allocate(K(nBas,nBas))
allocate(err(nBas,nBas))
allocate(cp(nBas,nBas))
allocate(Fp(nBas,nBas))
! Read CAP integrals from file
call read_CAP_integrals(nBas,W)
W(:,:) = eta*W(:,:)
! Define core Hamiltonian
Hc(:,:) = dcmplx(T+V,W)
! Define core Hamiltonian with CAP part
Hc(:,:) = cmplx(T+V,CAP,kind=8)
! Guess coefficients and density matrix
call mo_guess(nBas,nBas,guess_type,S,Hc,X,c)
call complex_mo_guess(nBas,nBas,guess_type,S,Hc,X,c)
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
! Initialization
! Initialization
n_diis = 0
F_diis(:,:) = 0d0
err_diis(:,:) = 0d0
F_diis(:,:) = cmplx(0d0,0d0,kind=8)
err_diis(:,:) = cmplx(0d0,0d0,kind=8)
rcond = 0d0
Conv = 1d0
nSCF = 0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'-----------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(RHF)','|','EJ(RHF)','|','EK(RHF)','|','Conv','|'
write(*,*)'-----------------------------------------------------------------------------'
write(*,*)'-------------------------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A36,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(RHF)','|','RE(EJ(RHF))','|','Re(EK(RHF))','|','Conv','|'
write(*,*)'-------------------------------------------------------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Build Fock matrix
call Hartree_matrix_AO_basis(nBas,P,ERI,J)
call exchange_matrix_AO_basis(nBas,P,ERI,K)
call complex_Hartree_matrix_AO_basis(nBas,P,ERI,J)
call complex_exchange_matrix_AO_basis(nBas,P,ERI,K)
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:)
@ -137,55 +125,55 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
! Kinetic energy
ET = trace_matrix(nBas,matmul(P,T))
ET = cmplx(trace_matrix(nBas,real(matmul(P,T))),trace_matrix(nBas,aimag(matmul(P,T))),kind=8)
! Potential energy
EV = trace_matrix(nBas,matmul(P,V))
EV = cmplx(trace_matrix(nBas,real(matmul(P,V))),trace_matrix(nBas,aimag(matmul(P,V))),kind=8)
! CAP energy
EW = complex_trace_matrix(nBas,matmul(P,(0d0,1d0)*CAP))
! Hartree energy
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
EJ = 0.5d0*cmplx(trace_matrix(nBas,real(matmul(P,J))),trace_matrix(nBas,aimag(matmul(P,J))),kind=8)
! Exchange energy
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
EK = 0.25d0*cmplx(trace_matrix(nBas,real(matmul(P,K))),trace_matrix(nBas,aimag(matmul(P,K))),kind=8)
! Total energy
ERHF = ET + EV + EJ + EK
ERHF = ET + EV + EW + EJ + EK
! DIIS extrapolation
! DIIS extrapolation !
if(max_diis > 1) then
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
call complex_DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
end if
! Level shift
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nBas,nO,S,c,F)
if(level_shift > 0d0 .and. Conv > thresh) call complex_level_shifting(level_shift,nBas,nBas,nO,S,c,F)
! Diagonalize Fock matrix
Fp = matmul(transpose(X),matmul(F,X))
Fp = matmul(transpose(X(:,:)),matmul(F(:,:),X(:,:)))
cp(:,:) = Fp(:,:)
call diagonalize_matrix(nBas,cp,eHF)
call complex_diagonalize_matrix(nBas,cp,eHF)
call complex_orthogonalize_matrix(nBas,cp)
c = matmul(X,cp)
! Density matrix
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
! Dump results
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,E10.2,1X,A1,1X)') &
'|',nSCF,'|',ERHF + ENuc,'|',EJ,'|',EK,'|',Conv,'|'
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,A1,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,E10.2,1X,A1,1X)') &
'|',nSCF,'|',real(ERHF + ENuc),'+',aimag(ERHF),'i','|',real(EJ),'|',real(EK),'|',Conv,'|'
end do
write(*,*)'-----------------------------------------------------------------------------'
write(*,*)'-------------------------------------------------------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
!------------------------------------------------------------------------
@ -204,12 +192,9 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
end if
! Compute dipole moments
call print_cRHF(nBas,nBas,nO,eHF,C,ENuc,ET,EV,EW,EJ,EK,ERHF)
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
call print_RHF(nBas,nBas,nO,eHF,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
! Testing zone
! Testing zone
if(dotest) then
@ -219,5 +204,5 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
! call dump_test_value('R','RHF dipole moment',norm2(dipole))
end if
deallocate(J,K,err,cp,Fp,err_diis,F_diis,Hc)
end subroutine

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