diff --git a/GoHu b/GoHu deleted file mode 100755 index f795b6b..0000000 --- a/GoHu +++ /dev/null @@ -1,13 +0,0 @@ -#! /bin/bash - -cp input/molecule.Hu input/molecule -cp input/basis.Hu input/basis -cp int/nBas.Hu.dat int/nBas.dat -cp int/ERI.Hu.dat int/ERI.dat -cp int/Kin.Hu.dat int/Kin.dat -cp int/Nuc.Hu.dat int/Nuc.dat -cp int/Ov.Hu.dat int/Ov.dat -cp int/x.Hu.dat int/x.dat -cp int/y.Hu.dat int/y.dat -cp int/z.Hu.dat int/z.dat -./bin/QuAcK diff --git a/PyDuck.py b/PyDuck.py index 9bcfb57..afd73b1 100755 --- a/PyDuck.py +++ b/PyDuck.py @@ -23,27 +23,25 @@ parser = argparse.ArgumentParser( # 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 in the $QUACK_ROOT/basis/ directory (if local basis is use) otherwise name of basis set for pyscf.') -parser.add_argument('--use_local_basis', default=False, action='store_true', - help='If True, basis is loaded from local storage. Needed for CAP. From file in $QUACK_ROOT/basis/ in nwchem formatting') + 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 2e-integrals to disk.') +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 2e-integrals.') + 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 2e-integrals.') + 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 2e-integrals.') + help='If True, use 8-fold symmetry in ERIs.') parser.add_argument('-fc', '--frozen_core', type=bool, - default=False, help='Freeze core MOs. Default is false') + default=False, help='Freeze core orbitals. Default is false') parser.add_argument('-m', '--multiplicity', type=int, default=1, - help='Spin multiplicity. Default is 1 therefore singlet') + 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, @@ -82,7 +80,7 @@ for line in lines: list_pos_atom.append([atom, pos]) f.close() # Create PySCF molecule -if args.use_local_basis: +if use_local_basis: atoms = list(set(atom[0] for atom in list_pos_atom)) basis_dict = {atom: gto.basis.parse_nwchem.load( working_dir + "/basis/" + input_basis, atom) for atom in atoms} diff --git a/README.md b/README.md index 9ed2498..5ed8fa7 100644 --- a/README.md +++ b/README.md @@ -4,17 +4,24 @@ **Contributors:** - [Pierre-Francois Loos](https://pfloos.github.io/WEB_LOOS) +- [Anthony Scemama](https://scemama.github.io) - [Enzo Monino](https://enzomonino.github.io) - [Antoine Marie](https://antoine-marie.github.io) - [Abdallah Ammar](https://scholar.google.com/citations?user=y437T5sAAAAJ&hl=en) -- [Anthony Scemama](https://scemama.github.io) +- [Mauricio Rodriguez-Mayorga](https://scholar.google.com/citations?user=OLGOgQgAAAAJ&hl=es) +- [Loris Burth](https://github.com/lburth) # What is it? -QuAcK is a small electronic structure program written in `Fortran 90` and developed at the Laboratoire de Chimie et Physique Quantiques [LCPQ](https://www.lcpq.ups-tlse.fr) (Toulouse, France). -QuAcK is usually used for prototyping purposes and the successful ideas are usually implemented more efficiently in [Quantum Package](https://quantumpackage.github.io/qp2/). QuAcK is an excellent place to start for experienced PhD students or postdocs as the code is simple and written with a fairly well-known and straightforward language. For beginners, we suggest having a look at [qcmath](https://github.com/LCPQ/qcmath/), a [Mathematica](https://www.wolfram.com/mathematica/)-based program to help newcomers in quantum chemistry easily develop their ideas. +**QuAcK** is a lightweight electronic structure program written in `Fortran 90`, developed at the [Laboratoire de Chimie et Physique Quantiques (LCPQ)](https://www.lcpq.ups-tlse.fr) in Toulouse, France. Originally designed as a platform for rapid prototyping of new ideas in quantum chemistry, QuAcK serves as a flexible and accessible environment for testing novel methods before integrating them more efficiently into larger-scale projects such as the [Quantum Package](https://quantumpackage.github.io/qp2/). -QuAcK is under continuous and active development, so it is very (very) likely to contain many bugs and errors. QuAcK is a code for experts, which means that you must know what you're doing and you have to make sure you're not doing anything silly (QuAcK may allow silly things to happen on purpose!). You have been warned. +Thanks to its compact and transparent codebase, QuAcK is particularly well-suited for experienced PhD students and postdoctoral researchers who are already familiar with electronic structure theory and want to quickly implement or explore new concepts. Written in a clean and relatively straightforward programming language, it provides an excellent entry point for those looking to dive into method development. + +For beginners in the field or those with less programming experience, we recommend starting with [qcmath](https://github.com/LCPQ/qcmath/), a symbolic and numerical quantum chemistry toolkit built in [Mathematica](https://www.wolfram.com/mathematica/). qcmath is specifically designed to help newcomers explore and develop ideas without the complexity of full-fledged numerical implementations. + +QuAcK is under active and ongoing development, which means that bugs, inconsistencies, and incomplete features are to be expected. It is a tool made *by* experts *for* experts—users are expected to understand what they’re doing and to remain cautious when interpreting results. The code may allow questionable inputs or behavior *on purpose*, to encourage flexibility during prototyping—so always double-check your results and assumptions. + +In short: use QuAcK at your own risk—but also to your advantage, if you're ready to experiment and explore. # Installation guide The QuAcK software can be downloaded on GitHub as a Git repository @@ -39,27 +46,30 @@ Therefore, it is very easy to use other software to compute the integrals or to ``` ~ 💩 % cd $QUACK_ROOT QuAcK 💩 % python PyDuck.py -h -usage: PyDuck.py [-h] -b BASIS [--bohr] [-c CHARGE] [--cartesian] [-fc FROZEN_CORE] [-m MULTIPLICITY] [--working_dir WORKING_DIR] -x XYZ +usage: PyDuck.py [-h] -b BASIS [--bohr] [-c CHARGE] [--cartesian] [--print_2e] [--formatted_2e] [--mmap_2e] [--aosym_2e] [-fc FROZEN_CORE] + [-m MULTIPLICITY] [--working_dir WORKING_DIR] -x XYZ This script is the main script of QuAcK, it is used to run the calculation. If $QUACK_ROOT is not set, $QUACK_ROOT is replaces by the current directory. options: -h, --help show this help message and exit - -b BASIS, --basis BASIS - Name of the file containing the basis set in the $QUACK_ROOT/basis/ directory + -b, --basis BASIS Name of the file containing the basis set information in the $QUACK_ROOT/basis/ directory --bohr By default QuAcK assumes that the xyz files are in Angstrom. Add this argument if your xyz file is in Bohr. - -c CHARGE, --charge CHARGE - Total charge of the molecule. Specify negative charges with "m" instead of the minus sign, for example m1 instead of -1. + -c, --charge CHARGE Total charge of the molecule. Specify negative charges with "m" instead of the minus sign, for example m1 instead of -1. Default is 0 --cartesian Add this option if you want to use cartesian basis functions. - -fc FROZEN_CORE, --frozen_core FROZEN_CORE - Freeze core MOs. Default is false - -m MULTIPLICITY, --multiplicity MULTIPLICITY - Number of unpaired electrons 2S. Default is 0 therefore singlet + --print_2e If True, print ERIs to disk. + --formatted_2e Add this option if you want to print formatted ERIs. + --mmap_2e If True, avoid using DRAM when generating ERIs. + --aosym_2e If True, use 8-fold symmetry in ERIs. + -fc, --frozen_core FROZEN_CORE + Freeze core orbitals. Default is false + -m, --multiplicity MULTIPLICITY + Spin multiplicity. Default is 1 (singlet) --working_dir WORKING_DIR Set a working directory to run the calculation. - -x XYZ, --xyz XYZ Name of the file containing the nuclear coordinates in xyz format in the $QUACK_ROOT/mol/ directory without the .xyz + -x, --xyz XYZ Name of the file containing the nuclear coordinates in xyz format in the $QUACK_ROOT/mol/ directory without the .xyz extension ``` @@ -67,50 +77,65 @@ The two most important files are: - `$QUACK_ROOT/input/methods` that gathers the methods you want to use. - `$QUACK_ROOT/input/options` that gathers the different options associated these methods. +Copy the files `methods.default` and `options.default` to `methods` and `options`, respectively. +``` +cp $QUACK_ROOT/input/methods.default $QUACK_ROOT/input/methods +cp $QUACK_ROOT/input/options.default $QUACK_ROOT/input/options +``` +You can then edit these files to run the methods you'd like (by replacing `F` with `T`) with specific options. These files look like this ``` QuAcK 💩 % cat input/methods -# RHF UHF RMOM UMOM KS - T F F F F -# MP2* MP3 +# RHF UHF GHF ROHF HFB + 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* G0F3 evGF3 - F F F F F -# G0W0* evGW* qsGW* SRG-qsGW ufG0W0 ufGW - T F F F F F -# G0T0pp* evGTpp* qsGTpp* G0T0eh evGTeh qsGTeh - F F F F F F -# * unrestricted version available +# 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 + F F F F F +# G0T0pp evGTpp qsGTpp ufG0T0pp + F F F F +# G0T0eh evGTeh qsGTeh + F F F +# Parquet + F +# Rtest Utest Gtest + F F F ``` and ``` QuAcK 💩 % cat input/options -# HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess level_shift stability - 512 0.0000001 T 5 1 1 F 0.0 F +# HF: maxSCF thresh DIIS guess mix shift stab search + 256 0.00001 5 1 0.0 0.0 F F # MP: reg F -# CC: maxSCF thresh DIIS n_diis - 64 0.0000001 T 5 -# spin: TDA singlet triplet spin_conserved spin_flip - F T F T T -# GF: maxSCF thresh DIIS n_diis lin eta renorm reg - 256 0.00001 T 5 T 0.0 0 F -# GW: maxSCF thresh DIIS n_diis lin eta COHSEX TDA_W reg - 256 0.00001 T 5 T 0.0 F F F -# GT: maxSCF thresh DIIS n_diis lin eta TDA_T reg - 256 0.00001 T 5 T 0.1 F 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 + 256 0.00001 5 F 0.0 F F +# GT: maxSCF thresh DIIS lin eta TDA_T reg + 256 0.00001 5 F 0.0 F F # ACFDT: AC Kx XBS - F T T -# BSE: BSE dBSE dTDA evDyn ppBSE BSE2 - T T T F F F + 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 +# Parquet: TDAeh TDApp max_it_1b conv_1b max_it_2b conv_2b DIIS_1b DIIS_2b lin reg + T T 10 0.00001 10 0.00001 2 2 T 100.0 ``` For example, if you want to run a calculation on water using the cc-pvdz basis set: @@ -118,8 +143,7 @@ For example, if you want to run a calculation on water using the cc-pvdz basis s QuAcK 💩 % python PyDuck.py -x water -b cc-pvdz ``` -QuAcK runs calculations in the `QUACK_ROOT` directory which is quite unusual but it can be easily modified to run calculations elsewhere. -You just have to make sure that QuAcK reads/writes the integrals and molecular information at the right spot. +QuAcK runs calculations in the `QUACK_ROOT` directory which is quite unusual but it also use the `--working_dir` option to run calculations elsewhere. diff --git a/input/basis.Hu b/input/basis.Hu deleted file mode 100644 index bbcbbde..0000000 --- a/input/basis.Hu +++ /dev/null @@ -1,6 +0,0 @@ -1 1 -S 1 - 1 1.0000000000e+00 1.0000000000e+00 -2 1 -S 1 - 1 1.0000000000e+00 1.0000000000e+00 diff --git a/input/methods b/input/methods index cda57a4..bc212bd 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF GHF ROHF HFB cRHF - F F F F F T + F F F F F F # MP2 MP3 F F # CCD pCCD DCD CCSD CCSD(T) @@ -19,6 +19,8 @@ # G0T0eh evGTeh qsGTeh F F F # cG0W0 cG0F2 - F F + F F +# Parquet + F # Rtest Utest Gtest F F F diff --git a/input/methods.default b/input/methods.default index e67d4ac..bc212bd 100644 --- a/input/methods.default +++ b/input/methods.default @@ -18,7 +18,9 @@ F F F F # G0T0eh evGTeh qsGTeh F F F -# cG0W0 +# cG0W0 cG0F2 + F F +# Parquet F # Rtest Utest Gtest F F F diff --git a/input/molecule.Hu b/input/molecule.Hu deleted file mode 100644 index 17c73c7..0000000 --- a/input/molecule.Hu +++ /dev/null @@ -1,5 +0,0 @@ -# nAt nEla nElb nCore nRyd - 2 1 1 0 0 -# Znuc x y z - X 0.0000000000 0.0000000000 0.0000000000 - X 0.0000000000 0.0000000000 1.0000000000 diff --git a/input/options.default b/input/options.default index 02586d6..01b11f6 100644 --- a/input/options.default +++ b/input/options.default @@ -20,3 +20,5 @@ F F F F T # HFB: temperature sigma chem_pot_HF restart_HFB 0.05 1.00 T F +# Parquet: TDAeh TDApp max_it_1b conv_1b max_it_2b conv_2b DIIS_1b DIIS_2b lin reg + T T 10 0.00001 10 0.00001 2 2 T 100.0 diff --git a/input/sph b/input/sph deleted file mode 100644 index d60b6fd..0000000 --- a/input/sph +++ /dev/null @@ -1,2 +0,0 @@ -# rs - 1.0 diff --git a/mol/H2O.xyz b/mol/H2O.xyz index 00a490d..2e291f6 100644 --- a/mol/H2O.xyz +++ b/mol/H2O.xyz @@ -1,5 +1,5 @@ 3 O 0.0000 0.0000 0.0000 -H 0.9591 0.0000 0.0000 -H -0.2373 0.9293 0.0000 +H 0.7571 0.0000 0.5861 +H -0.7571 0.0000 0.5861 diff --git a/mol/MgO.xyz b/mol/MgO.xyz index 091c39f..78b1186 100644 --- a/mol/MgO.xyz +++ b/mol/MgO.xyz @@ -1,4 +1,4 @@ 2 Mg 0.0000 0.0000 0.0000 -O 0.0000 0.0000 1.728 +O 0.0000 0.0000 1.749 diff --git a/scripts/PyDuck b/scripts/PyDuck deleted file mode 100755 index 25016c9..0000000 --- a/scripts/PyDuck +++ /dev/null @@ -1,321 +0,0 @@ -#!/usr/bin/env python2 -import sys -from termcolor import colored -import shlex -from subprocess import Popen, PIPE -import itertools -import re -import numpy as np -import os -from shutil import copy2 -import matplotlib.pyplot as plt -import json -from math import * -from collections import OrderedDict -import csv -import argparse -def GetDuckDir(): - return os.path.dirname(os.path.realpath(__file__)) - -def nNucl(molbaselines): - return float(molbaselines[1].split()[0]) - -def isMononucle(molbaselines): - return nNucl(molbaselines)==1 - -def openfileindir(path,readwrite): - mydir=os.path.dirname(path) - if not os.path.exists(mydir) and mydir!="": - os.makedirs(mydir) - return open(path,readwrite) -def outfile(Outdic,item,index=None): - itemdata=Outdic[item] - if itemdata["Enabled"]: - fmt=itemdata["Format"] - if index is not None: - filename=fmt.format(index) - else: - filename=fmt - if "Parent" in Outdic: - path=os.path.join(Outdic["Parent"],filename) - else: - path=filename - return openfileindir(path,'w') - else: - return - -def runDuck(mol,basis,x,molbaselines,molbase,basisbase): - #gennerate molecule file - currdir=os.getcwd() - os.chdir(GetDuckDir()) - molname='.'.join([mol,str(x)]) - lstw=list() - for i,line in enumerate(molbaselines): - if i<3: - lstw.append(line) - else: - if isMononucle(molbaselines): - if i==3: - lstw.append(' '.join([str(x)]+line.split()[1:])) - else: - v=[float(abs(x))/float(2),float(-abs(x)/float(2))] - val=v[i-3] - lstw.append(' '.join([line.split()[0],'0.','0.',str(val)])) - junkfiles=list() - with open(molbase+molname,'w') as n: - junkfiles.append(n.name) - n.write(os.linesep.join(lstw)) - #Copy basis - basisfile=basisbase+'.'.join([mol,basis]) - newbasisfile=basisbase+'.'.join([molname,basis]) - copy2(basisfile,newbasisfile) - junkfiles.append(newbasisfile) - #start child process Goduck - cmd=" ".join(["./GoDuck",molname, basis]) - Duck=Popen(shlex.split(cmd),stdout=PIPE) - (DuckOut, DuckErr) = Duck.communicate() - excode=Duck.wait() - for junk in junkfiles: - os.remove(junk) - os.chdir(currdir) - return (excode,DuckOut,DuckErr) - -def addvalue(dic,key,x,y): - if key not in dic: - dic[key]=list() - dic[key].append(y) - print(key) - print(x,y) - -def main(mol): - #get basepath for files - molbase='examples/molecule.' - basisbase=molbase.replace('molecule','basis') - with open('PyOptions.json','r') as jfile: - options=json.loads(jfile.read()) - basis=str(options['Basis']) - #Get mehtod to analyse - methodsdic=options['Methods'] - #Get datas to analyse in this method - scandic=options['Scan'] - scan=np.arange(scandic['Start'],scandic['Stop']+scandic['Step'],scandic['Step']) - print(scan) - mymethods=dict() - alllabels=list() - for method,methoddatas in methodsdic.iteritems(): - if methoddatas['Enabled']: - mymethods[method]=methoddatas - for label,labeldatas in methoddatas['Labels'].iteritems(): - if type(labeldatas) is dict: - enabled=labeldatas['Enabled'] - else: - enabled=labeldatas - if enabled and label not in alllabels: - alllabels.append(label) - graphdic=dict() - errorconvstring="Convergence failed" - with open(os.path.join(GetDuckDir(),molbase+mol),'r') as b: - molbaselines=b.read().splitlines() - if isMononucle(molbaselines): - print('monoatomic system: variation of the nuclear charge') - else: - print('polyatomic system: variation is on the distance') - for x in scan: - (DuckExit,DuckOut,DuckErr)=runDuck(mol,basis,x,molbaselines,molbase,basisbase) - #print DuckOut on file or not - if "Outputs" in options: - outdat=options["Outputs"] - if 'DuckOutput' in outdat: - outopt=outdat["DuckOutput"] - if outopt['Enabled']: - if outopt['Multiple']: - duckoutf=outfile(outopt,"DuckOutput",x) - else: - if x==scan[0]: - duckoutf=outfile(outdat,"DuckOutput") - duckoutf.write('Z' if isMononucle(molbaselines) else 'Distance'+' '+str(x)+os.linesep+os.linesep) - duckoutf.write(DuckOut) - if outopt['Multiple']: - duckoutf.close() - print("GoDuk exit code " + str(DuckExit)) - if DuckExit !=0: - #if GoDuck is not happy - print(DuckErr) - sys.exit(-1) - #get all data for the method - for method,methoddatas in mymethods.iteritems(): - isnan=False - if '{0}' in method: - if "index" in methoddatas: - methodheaders=[method.format(str(x)) for x in methoddatas['Index']] - else: - try: - print(method) - reglist=re.findall('(\d+)'.join([re.escape(s) for s in method.split('{0}')]),DuckOut) - print(reglist) - final=max([(int(i[0]) if type(i) is tuple else int(i)) for i in reglist]) - print(final) - methodheaders=[method.format(str(final))] - except: - isnan=True - methodheaders=[None] - method=method.replace('{0}','') - else: - methodheaders=list([method]) - for methodheader in methodheaders: - if len(methodheaders)!=1: - method=methodheader - lbldic=methoddatas['Labels'] - print(methodheader) - if methodheader is None: - methodtxt='' - else: - it=itertools.dropwhile(lambda line: methodheader + ' calculation' not in line , DuckOut.splitlines()) - it=itertools.takewhile(lambda line: 'Total CPU time for ' not in line, it) - methodtxt=os.linesep.join(it) - if errorconvstring in methodtxt: - print(colored(' '.join([method, errorconvstring, '!!!!!']),'red')) - isnan=True - if methodtxt=='': - print(colored('No data' +os.linesep+ 'RHF scf not converged or method not enabled','red')) - isnan=True - #find the expected values - for label,labeldatas in lbldic.iteritems(): - if type(labeldatas) is dict: - indexed=('Index' in labeldatas) - enabled=labeldatas['Enabled'] - graph=labeldatas['Graph'] if 'Graph' in labeldatas else 1 - else: - enabled=labeldatas - graph=1 - indexed=False - if enabled: - if graph not in graphdic: - graphdic[graph]=OrderedDict() - y=graphdic[graph] - if not indexed: - v=np.nan - print(method) - print(label) - if not isnan: - try: - m=re.search('\s+'.join([re.escape(w) for w in label.split()]) + "\s+(?:"+re.escape("(eV):")+"\s+)?(?:=\s+)?(-?\d+.?\d*)",methodtxt) - v=m.group(1) - except: - v=np.nan - addvalue(y,(method,label),x,v) - else: - startindex=-1 - columnindex=-1 - linedtxt=methodtxt.split(os.linesep) - for n,line in enumerate(linedtxt): - if all(x in line for x in ['|',' '+label+' ','#']): - startindex=n+2 - columnindex=[s.strip() for s in line.split('|')].index(label) - break - with open(os.path.join(GetDuckDir(),'input','molecule'),'r') as molfile: - molfile.readline() - line=molfile.readline() - nel=int(line.split()[1]) - print(nel) - HOMO=int(nel/2) - HO=HOMO - LUMO=HOMO+1 - BV=LUMO - for i in labeldatas['Index']: - v=np.nan - if type(i) is str or type(i) is unicode: - ival=eval(i) - if type(ival) is not int: - print('Index '+ str(i) + 'must be integer') - sys.exit(-2) - else: - ival=i - v=np.nan - if not isnan: - try: - if startindex!=-1 and columnindex!=-1: - line=linedtxt[startindex+ival-1] - v=float(line.split('|')[columnindex].split()[0]) - print(method) - print(label) - print(i) - else: - v=np.nan - except: - v=np.nan - key=(method,label,i) - addvalue(y,key,x,v) - tpl=(x,scan.tolist().index(x)+1,len(y[key])) - print(tpl) - if tpl[1]-tpl[2]: - sys.exit() - #define graph grid - maxgraph=max(graphdic.keys()) - maxrow=int(round(sqrt(maxgraph))) - maxcol=int(ceil(float(maxgraph)/float(maxrow))) - #define label ls - for graph,y in graphdic.iteritems(): - datas=list() - datas.append(["#x"]+scan.tolist()) - if len(y.keys())!=0: - plt.subplot(maxrow,maxcol,graph) - plt.xlabel('Z' if isMononucle(molbaselines) else 'Distance '+mol) - ylbls=list([basis]) - for i in range(0,2): - lst=list(set([key[i] for key in y.keys()])) - if len(lst)==1: - ylbls.append(lst[0]) - plt.ylabel(' '.join(ylbls)) - print('Legend') - print(list(y.keys())) - for key,values in y.iteritems(): - legend=list() - for el in key[0:2]: - if el not in ylbls: - legend.append(el) - if len(key)>2: - legend.append(str(key[2])) - #plot curves - lbl=' '.join(legend) - plt.plot(scan,y[key],'-o',label=lbl) - #print("min",x[y.index(min(y))]/2) - #generate legends - plt.legend() - dataout=False - if "Outputs" in options: - outputs=options['Outputs'] - if "DataOutput" in outputs: - DataOutput=outputs['DataOutput'] - dataout=DataOutput['Enabled'] - if dataout: - fmtlegendf='{0}({1})' - datas.append([fmtlegendf.format("y",lbl)]+y[key]) - if dataout: - csvdatas=zip(*datas) - with outfile(outputs,"DataOutput",graph) as csvf: - writer = csv.writer(csvf, delimiter=' ') - writer.writerow(['#']+ylbls) - writer.writerows(csvdatas) - #show graph - if "Outputs" in options: - outputs=options['Outputs'] - if "FigureOutput" in outputs: - figout=outputs["FigureOutput"] - if figout["Enabled"]: - plt.savefig(figout['Path']) - plt.show() -if __name__ == '__main__': - parser=argparse.ArgumentParser() - parser.add_argument("mol",nargs='?', help="molecule to compute",type=str) - parser.add_argument("-c,--copy", help="Copy sample option file",action="store_true",dest="copy") - args = parser.parse_args() - if len(sys.argv)==1: - parser.print_help() - else: - if args.copy: - copy2(os.path.join(GetDuckDir(),"PyOptions.template.json"),"PyOptions.json") - if args.mol is not None: - os.system("vim PyOptions.json") - if args.mol is not None: - main(args.mol) diff --git a/scripts/PyOptions.json b/scripts/PyOptions.json deleted file mode 100644 index 055b3aa..0000000 --- a/scripts/PyOptions.json +++ /dev/null @@ -1,145 +0,0 @@ -{ - "Scan": { - "Start":1.8, - "Stop":1.9, - "Step":0.1 - }, - "Basis":"VDZ", - "Outputs": { - "DataOutput": { - "Enabled":true, - "Format":"Duck{0}.dat" - }, - "DuckOutput": { - "Enabled":true, - "Multiple":false, - "Format":"DuckOut.out" - }, - "FigureOutput":{ - "Enabled":false, - "Path":"Figure.png" - } - }, - "Methods": { - "RHF":{ - "Enabled": true, - "Labels": { - "One-electron energy":false, - "Kinetic energy":false, - "Potential energy":false, - "Two-electron energy":false, - "Coulomb energy":false, - "Exchange energy":false, - "Electronic energy":false, - "Nuclear repulsion":false, - "Hartree-Fock energy":true, - "HF HOMO energy":false, - "HF LUMO energy":false, - "HF HOMO-LUMO gap":false - } - }, - "One-shot G0W0": { - "Enabled": true, - "Labels": { - "G0W0 HOMO energy":true, - "G0W0 LUMO energy":true, - "G0W0 HOMO-LUMO gap":false, - "G0W0 total energy":false, - "RPA correlation energy" :false, - "Z": { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":1 - }, - "Sigma_c (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":2 - }, - "e_QP (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO+1","LUMO+2"], - "Graph":3 - }, - "e_HF (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":4 - } - } - }, - "Self-consistent evG{0}W{0}": { - "Enabled":false, - "Labels": { - "evGW HOMO energy":false, - "evGW LUMO energy":false, - "evGW HOMO-LUMO gap":false, - "evGW total energy":false, - "RPA correlation energy" :false, - "Z": { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":1 - }, - "Sigma_c (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":2 - }, - "e_QP (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":3 - }, - "e_HF (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":4 - } - } - }, - "Self-consistent qsG{0}W{0}": { - "Enabled": false, - "Labels": { - "qsGW HOMO energy":false, - "qsGW LUMO energy":false, - "qsGW HOMO-LUMO gap":false, - "qsGW total energy":false, - "qsGW exchange energy":false, - "qsGW correlation energy":false, - "RPA correlation energy":{ - "Enabled":false, - "Graph":2 - }, - "Z": { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":4 - }, - "e_QP-e_HF (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":5 - }, - "e_QP (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":6 - } - } - }, - "MP2": { - "Enabled": false, - "Labels": { - "MP2 correlation energy": { - "Enabled":true, - "Graph":4 - }, - "Direct part":false, - "Exchange part":false, - "MP2 total energy":true, - "MP2 energy":false - } - } - } -} diff --git a/scripts/PyOptions.template.json b/scripts/PyOptions.template.json deleted file mode 100644 index 055b3aa..0000000 --- a/scripts/PyOptions.template.json +++ /dev/null @@ -1,145 +0,0 @@ -{ - "Scan": { - "Start":1.8, - "Stop":1.9, - "Step":0.1 - }, - "Basis":"VDZ", - "Outputs": { - "DataOutput": { - "Enabled":true, - "Format":"Duck{0}.dat" - }, - "DuckOutput": { - "Enabled":true, - "Multiple":false, - "Format":"DuckOut.out" - }, - "FigureOutput":{ - "Enabled":false, - "Path":"Figure.png" - } - }, - "Methods": { - "RHF":{ - "Enabled": true, - "Labels": { - "One-electron energy":false, - "Kinetic energy":false, - "Potential energy":false, - "Two-electron energy":false, - "Coulomb energy":false, - "Exchange energy":false, - "Electronic energy":false, - "Nuclear repulsion":false, - "Hartree-Fock energy":true, - "HF HOMO energy":false, - "HF LUMO energy":false, - "HF HOMO-LUMO gap":false - } - }, - "One-shot G0W0": { - "Enabled": true, - "Labels": { - "G0W0 HOMO energy":true, - "G0W0 LUMO energy":true, - "G0W0 HOMO-LUMO gap":false, - "G0W0 total energy":false, - "RPA correlation energy" :false, - "Z": { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":1 - }, - "Sigma_c (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":2 - }, - "e_QP (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO+1","LUMO+2"], - "Graph":3 - }, - "e_HF (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":4 - } - } - }, - "Self-consistent evG{0}W{0}": { - "Enabled":false, - "Labels": { - "evGW HOMO energy":false, - "evGW LUMO energy":false, - "evGW HOMO-LUMO gap":false, - "evGW total energy":false, - "RPA correlation energy" :false, - "Z": { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":1 - }, - "Sigma_c (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":2 - }, - "e_QP (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":3 - }, - "e_HF (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":4 - } - } - }, - "Self-consistent qsG{0}W{0}": { - "Enabled": false, - "Labels": { - "qsGW HOMO energy":false, - "qsGW LUMO energy":false, - "qsGW HOMO-LUMO gap":false, - "qsGW total energy":false, - "qsGW exchange energy":false, - "qsGW correlation energy":false, - "RPA correlation energy":{ - "Enabled":false, - "Graph":2 - }, - "Z": { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":4 - }, - "e_QP-e_HF (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":5 - }, - "e_QP (eV)" : { - "Enabled":true, - "Index":["HOMO","LUMO","LUMO+1","LUMO+2"], - "Graph":6 - } - } - }, - "MP2": { - "Enabled": false, - "Labels": { - "MP2 correlation energy": { - "Enabled":true, - "Graph":4 - }, - "Direct part":false, - "Exchange part":false, - "MP2 total energy":true, - "MP2 energy":false - } - } - } -} diff --git a/scripts/extract.sh b/scripts/extract.sh deleted file mode 100755 index 824fdfc..0000000 --- a/scripts/extract.sh +++ /dev/null @@ -1,229 +0,0 @@ -#! /bin/bash - -INPUT=$1 - - echo - echo '******************************************' - echo '*** Extracting information of' $INPUT ' ***' - echo '******************************************' - echo - - echo - echo '*** WFT information ***' - echo - grep "Hartree-Fock energy" $INPUT - EHF=`grep "Hartree-Fock energy" $INPUT | cut -f2 -d"="` - grep "MP2 correlation energy" $INPUT - EcMP2=`grep "MP2 correlation energy" $INPUT | cut -f2 -d"="` - grep "Ec(MP2) =" $INPUT - grep "Ec(CCD) =" $INPUT - grep "Ec(CCSD) =" $INPUT - grep "Ec(CCSD(T)) =" $INPUT - -# echo -# echo '*** Gap information: HF, G0F2, GF2, G0W0 & evGW ***' -# HF=`grep "HF HOMO-LUMO gap (eV):" $INPUT | cut -f2 -d":"` -# G0F2=`grep "GF2 HOMO-LUMO gap (eV):" $INPUT | head -1 | cut -f2 -d":"` -# GF2=`grep "GF2 HOMO-LUMO gap (eV):" $INPUT | tail -1 | cut -f2 -d":"` -# G0W0=`grep "G0W0 HOMO-LUMO gap (eV):" $INPUT | cut -f2 -d":"` -# evGW=`grep "evGW HOMO-LUMO gap (eV):" $INPUT | tail -1 | cut -f2 -d":"` - -# echo -e "\t" $HF "\t" $G0F2 "\t" $GF2 "\t" $G0W0 "\t" $evGW - - echo - echo '*** RPA information: Tr@RPA (singlet), Tr@RPA (triplet), AC@RPA (singlet), AC@RPA (triplet) ***' - echo - Tr_RPA_1=`grep "Tr@RPA correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_RPA_3=`grep "Tr@RPA correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - AC_RPA_1=`grep "AC@RPA correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - AC_RPA_3=`grep "AC@RPA correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - - echo -e "\t" $Tr_RPA_1 "\t" $Tr_RPA_3 "\t" $AC_RPA_1 "\t" $AC_RPA_3 - - echo - echo '*** RPAx information: Tr@RPAx (singlet), Tr@RPAx (triplet), AC@RPAx (singlet), AC@RPAx (triplet) ***' - echo - Tr_RPAx_1=`grep "Tr@RPAx correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_RPAx_3=`grep "Tr@RPAx correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - AC_RPAx_1=`grep "AC@RPAx correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - AC_RPAx_3=`grep "AC@RPAx correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - - echo -e "\t" $Tr_RPAx_1 "\t" $Tr_RPAx_3 "\t" $AC_RPAx_1 "\t" $AC_RPAx_3 - - echo - echo '*** G0W0 information: Tr@RPA (singlet), Tr@RPA (triplet), Tr@BSE (singlet), Tr@BSE (triplet), AC@BSE (singlet), AC@BSE (triplet) ***' - echo - Tr_RPA_G0W0_1=`grep "Tr@RPA@G0W0 correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_RPA_G0W0_3=`grep "Tr@RPA@G0W0 correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - Tr_BSE_G0W0_1=`grep "Tr@BSE@G0W0 correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_BSE_G0W0_3=`grep "Tr@BSE@G0W0 correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - AC_BSE_G0W0_1=`grep "AC@BSE@G0W0 correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - AC_BSE_G0W0_3=`grep "AC@BSE@G0W0 correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - - echo -e "\t" $Tr_RPA_G0W0_1 "\t" $Tr_RPA_G0W0_3 "\t" $Tr_BSE_G0W0_1 "\t" $Tr_BSE_G0W0_3 "\t" $AC_BSE_G0W0_1 "\t" $AC_BSE_G0W0_3 - - echo - echo '*** evGW information: Tr@RPA (singlet), Tr@RPA (triplet), Tr@BSE (singlet), Tr@BSE (triplet), AC@BSE (singlet), AC@BSE (triplet) ***' - echo - Tr_RPA_evGW_1=`grep "Tr@RPA@evGW correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_RPA_evGW_3=`grep "Tr@RPA@evGW correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - Tr_BSE_evGW_1=`grep "Tr@BSE@evGW correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_BSE_evGW_3=`grep "Tr@BSE@evGW correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - AC_BSE_evGW_1=`grep "AC@BSE@evGW correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - AC_BSE_evGW_3=`grep "AC@BSE@evGW correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - - echo -e "\t" $Tr_RPA_evGW_1 "\t" $Tr_RPA_evGW_3 "\t" $Tr_BSE_evGW_1 "\t" $Tr_BSE_evGW_3 "\t" $AC_BSE_evGW_1 "\t" $AC_BSE_evGW_3 - - - echo - echo '*** qsGW information: Tr@RPA (singlet), Tr@RPA (triplet), Tr@BSE (singlet), Tr@BSE (triplet), AC@BSE (singlet), AC@BSE (triplet) ***' - echo - Tr_RPA_qsGW_1=`grep "Tr@RPA@qsGW correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_RPA_qsGW_3=`grep "Tr@RPA@qsGW correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - Tr_BSE_qsGW_1=`grep "Tr@BSE@qsGW correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - Tr_BSE_qsGW_3=`grep "Tr@BSE@qsGW correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - AC_BSE_qsGW_1=`grep "AC@BSE@qsGW correlation energy (singlet) =" $INPUT| cut -f2 -d"="` - AC_BSE_qsGW_3=`grep "AC@BSE@qsGW correlation energy (triplet) =" $INPUT| cut -f2 -d"="` - - echo -e "\t" $Tr_RPA_qsGW_1 "\t" $Tr_RPA_qsGW_3 "\t" $Tr_BSE_qsGW_1 "\t" $Tr_BSE_qsGW_3 "\t" $AC_BSE_qsGW_1 "\t" $AC_BSE_qsGW_3 - - echo - echo '*** CIS excitation energy (singlet & triplet) ***' - echo - - CIS_1_1=`grep "| 1 |" $INPUT | head -1 | cut -f3 -d"|"` - CIS_1_2=`grep "| 2 |" $INPUT | head -1 | cut -f3 -d"|"` - CIS_1_3=`grep "| 3 |" $INPUT | head -1 | cut -f3 -d"|"` - CIS_1_4=`grep "| 4 |" $INPUT | head -1 | cut -f3 -d"|"` - CIS_1_5=`grep "| 5 |" $INPUT | head -1 | cut -f3 -d"|"` - - CIS_3_1=`grep "| 1 |" $INPUT | head -2 | tail -1 | cut -f3 -d"|"` - CIS_3_2=`grep "| 2 |" $INPUT | head -2 | tail -1 | cut -f3 -d"|"` - CIS_3_3=`grep "| 3 |" $INPUT | head -2 | tail -1 | cut -f3 -d"|"` - CIS_3_4=`grep "| 4 |" $INPUT | head -2 | tail -1 | cut -f3 -d"|"` - CIS_3_5=`grep "| 5 |" $INPUT | head -2 | tail -1 | cut -f3 -d"|"` - - echo -e "\t" $CIS_1_1 "\t" $CIS_3_1 - echo -e "\t" $CIS_1_2 "\t" $CIS_3_2 - echo -e "\t" $CIS_1_3 "\t" $CIS_3_3 - echo -e "\t" $CIS_1_4 "\t" $CIS_3_4 - echo -e "\t" $CIS_1_5 "\t" $CIS_3_5 - - echo - echo '*** RPA excitation energy (singlet & triplet) ***' - echo - - RPA_1_1=`grep "| 1 |" $INPUT | head -3 | tail -1 | cut -f3 -d"|"` - RPA_1_2=`grep "| 2 |" $INPUT | head -3 | tail -1 | cut -f3 -d"|"` - RPA_1_3=`grep "| 3 |" $INPUT | head -3 | tail -1 | cut -f3 -d"|"` - RPA_1_4=`grep "| 4 |" $INPUT | head -3 | tail -1 | cut -f3 -d"|"` - RPA_1_5=`grep "| 5 |" $INPUT | head -3 | tail -1 | cut -f3 -d"|"` - - RPA_3_1=`grep "| 1 |" $INPUT | head -4 | tail -1 | cut -f3 -d"|"` - RPA_3_2=`grep "| 2 |" $INPUT | head -4 | tail -1 | cut -f3 -d"|"` - RPA_3_3=`grep "| 3 |" $INPUT | head -4 | tail -1 | cut -f3 -d"|"` - RPA_3_4=`grep "| 4 |" $INPUT | head -4 | tail -1 | cut -f3 -d"|"` - RPA_3_5=`grep "| 5 |" $INPUT | head -4 | tail -1 | cut -f3 -d"|"` - - echo -e "\t" $RPA_1_1 "\t" $RPA_3_1 - echo -e "\t" $RPA_1_2 "\t" $RPA_3_2 - echo -e "\t" $RPA_1_3 "\t" $RPA_3_3 - echo -e "\t" $RPA_1_4 "\t" $RPA_3_4 - echo -e "\t" $RPA_1_5 "\t" $RPA_3_5 - - echo - echo '*** RPAx excitation energy (singlet & triplet) ***' - echo - - RPAx_1_1=`grep "| 1 |" $INPUT | head -5 | tail -1 | cut -f3 -d"|"` - RPAx_1_2=`grep "| 2 |" $INPUT | head -5 | tail -1 | cut -f3 -d"|"` - RPAx_1_3=`grep "| 3 |" $INPUT | head -5 | tail -1 | cut -f3 -d"|"` - RPAx_1_4=`grep "| 4 |" $INPUT | head -5 | tail -1 | cut -f3 -d"|"` - RPAx_1_5=`grep "| 5 |" $INPUT | head -5 | tail -1 | cut -f3 -d"|"` - - RPAx_3_1=`grep "| 1 |" $INPUT | head -6 | tail -1 | cut -f3 -d"|"` - RPAx_3_2=`grep "| 2 |" $INPUT | head -6 | tail -1 | cut -f3 -d"|"` - RPAx_3_3=`grep "| 3 |" $INPUT | head -6 | tail -1 | cut -f3 -d"|"` - RPAx_3_4=`grep "| 4 |" $INPUT | head -6 | tail -1 | cut -f3 -d"|"` - RPAx_3_5=`grep "| 5 |" $INPUT | head -6 | tail -1 | cut -f3 -d"|"` - - echo -e "\t" $RPAx_1_1 "\t" $RPAx_3_1 - echo -e "\t" $RPAx_1_2 "\t" $RPAx_3_2 - echo -e "\t" $RPAx_1_3 "\t" $RPAx_3_3 - echo -e "\t" $RPAx_1_4 "\t" $RPAx_3_4 - echo -e "\t" $RPAx_1_5 "\t" $RPAx_3_5 - - echo - echo '*** BSE@G0W0 excitation energy (singlet & triplet) ***' - echo - - G0W0_1_1=`grep "| 1 |" $INPUT | head -7 | tail -1 | cut -f3 -d"|"` - G0W0_1_2=`grep "| 2 |" $INPUT | head -7 | tail -1 | cut -f3 -d"|"` - G0W0_1_3=`grep "| 3 |" $INPUT | head -7 | tail -1 | cut -f3 -d"|"` - G0W0_1_4=`grep "| 4 |" $INPUT | head -7 | tail -1 | cut -f3 -d"|"` - G0W0_1_5=`grep "| 5 |" $INPUT | head -7 | tail -1 | cut -f3 -d"|"` - - G0W0_3_1=`grep "| 1 |" $INPUT | head -8 | tail -1 | cut -f3 -d"|"` - G0W0_3_2=`grep "| 2 |" $INPUT | head -8 | tail -1 | cut -f3 -d"|"` - G0W0_3_3=`grep "| 3 |" $INPUT | head -8 | tail -1 | cut -f3 -d"|"` - G0W0_3_4=`grep "| 4 |" $INPUT | head -8 | tail -1 | cut -f3 -d"|"` - G0W0_3_5=`grep "| 5 |" $INPUT | head -8 | tail -1 | cut -f3 -d"|"` - - echo -e "\t" $G0W0_1_1 "\t" $G0W0_3_1 - echo -e "\t" $G0W0_1_2 "\t" $G0W0_3_2 - echo -e "\t" $G0W0_1_3 "\t" $G0W0_3_3 - echo -e "\t" $G0W0_1_4 "\t" $G0W0_3_4 - echo -e "\t" $G0W0_1_5 "\t" $G0W0_3_5 - - echo - echo '*** BSE@evGW excitation energy (singlet & triplet) ***' - echo - - evGW_1_1=`grep "| 1 |" $INPUT | head -9 | tail -1 | cut -f3 -d"|"` - evGW_1_2=`grep "| 2 |" $INPUT | head -9 | tail -1 | cut -f3 -d"|"` - evGW_1_3=`grep "| 3 |" $INPUT | head -9 | tail -1 | cut -f3 -d"|"` - evGW_1_4=`grep "| 4 |" $INPUT | head -9 | tail -1 | cut -f3 -d"|"` - evGW_1_5=`grep "| 5 |" $INPUT | head -9 | tail -1 | cut -f3 -d"|"` - - evGW_3_1=`grep "| 1 |" $INPUT | head -10 | tail -1 | cut -f3 -d"|"` - evGW_3_2=`grep "| 2 |" $INPUT | head -10 | tail -1 | cut -f3 -d"|"` - evGW_3_3=`grep "| 3 |" $INPUT | head -10 | tail -1 | cut -f3 -d"|"` - evGW_3_4=`grep "| 4 |" $INPUT | head -10 | tail -1 | cut -f3 -d"|"` - evGW_3_5=`grep "| 5 |" $INPUT | head -10 | tail -1 | cut -f3 -d"|"` - - echo -e "\t" $evGW_1_1 "\t" $evGW_3_1 - echo -e "\t" $evGW_1_2 "\t" $evGW_3_2 - echo -e "\t" $evGW_1_3 "\t" $evGW_3_3 - echo -e "\t" $evGW_1_4 "\t" $evGW_3_4 - echo -e "\t" $evGW_1_5 "\t" $evGW_3_5 - - echo - echo '*** BSE@qsGW excitation energy (singlet & triplet) ***' - echo - - qsGW_1_1=`grep "| 1 |" $INPUT | head -11 | tail -1 | cut -f3 -d"|"` - qsGW_1_2=`grep "| 2 |" $INPUT | head -11 | tail -1 | cut -f3 -d"|"` - qsGW_1_3=`grep "| 3 |" $INPUT | head -11 | tail -1 | cut -f3 -d"|"` - qsGW_1_4=`grep "| 4 |" $INPUT | head -11 | tail -1 | cut -f3 -d"|"` - qsGW_1_5=`grep "| 5 |" $INPUT | head -11 | tail -1 | cut -f3 -d"|"` - - qsGW_3_1=`grep "| 1 |" $INPUT | head -12 | tail -1 | cut -f3 -d"|"` - qsGW_3_2=`grep "| 2 |" $INPUT | head -12 | tail -1 | cut -f3 -d"|"` - qsGW_3_3=`grep "| 3 |" $INPUT | head -12 | tail -1 | cut -f3 -d"|"` - qsGW_3_4=`grep "| 4 |" $INPUT | head -12 | tail -1 | cut -f3 -d"|"` - qsGW_3_5=`grep "| 5 |" $INPUT | head -12 | tail -1 | cut -f3 -d"|"` - - echo -e "\t" $qsGW_1_1 "\t" $qsGW_3_1 - echo -e "\t" $qsGW_1_2 "\t" $qsGW_3_2 - echo -e "\t" $qsGW_1_3 "\t" $qsGW_3_3 - echo -e "\t" $qsGW_1_4 "\t" $qsGW_3_4 - echo -e "\t" $qsGW_1_5 "\t" $qsGW_3_5 - - echo - echo '*** MATHEMATICA OUTPUT ***' - echo - echo -e "\t" $EHF "\t" $EcMP2 "\t" $Tr_RPA_1 "\t" $Tr_RPA_3 "\t" $AC_RPA_1 "\t" $AC_RPA_3 "\t" $Tr_RPAx_1 "\t" $Tr_RPAx_3 "\t" $AC_RPAx_1 "\t" $AC_RPAx_3 "\t" $Tr_RPA_G0W0_1 "\t" $Tr_RPA_G0W0_3 "\t" $Tr_BSE_G0W0_1 "\t" $Tr_BSE_G0W0_3 "\t" $AC_BSE_G0W0_1 "\t" $AC_BSE_G0W0_3 "\t" $CIS_1_1 "\t" $CIS_1_2 "\t" $CIS_1_3 "\t" $CIS_1_4 "\t" $CIS_1_5 "\t" $CIS_3_1 "\t" $CIS_3_2 "\t" $CIS_3_3 "\t" $CIS_3_4 "\t" $CIS_3_5 "\t" $RPA_1_1 "\t" $RPA_1_2 "\t" $RPA_1_3 "\t" $RPA_1_4 "\t" $RPA_1_5 "\t" $RPA_3_1 "\t" $RPA_3_2 "\t" $RPA_3_3 "\t" $RPA_3_4 "\t" $RPA_3_5 "\t" $RPAx_1_1 "\t" $RPAx_1_2 "\t" $RPAx_1_3 "\t" $RPAx_1_4 "\t" $RPAx_1_5 "\t" $RPAx_3_1 "\t" $RPAx_3_2 "\t" $RPAx_3_3 "\t" $RPAx_3_4 "\t" $RPAx_3_5 "\t" $G0W0_1_1 "\t" $G0W0_1_2 "\t" $G0W0_1_3 "\t" $G0W0_1_4 "\t" $G0W0_1_5 "\t" $G0W0_3_1 "\t" $G0W0_3_2 "\t" $G0W0_3_3 "\t" $G0W0_3_4 "\t" $G0W0_3_5 "\t" $Tr_RPA_evGW_1 "\t" $Tr_RPA_evGW_3 "\t" $Tr_BSE_evGW_1 "\t" $Tr_BSE_evGW_3 "\t" $AC_BSE_evGW_1 "\t" $AC_BSE_evGW_3 "\t" $evGW_1_1 "\t" $evGW_1_2 "\t" $evGW_1_3 "\t" $evGW_1_4 "\t" $evGW_1_5 "\t" $evGW_3_1 "\t" $evGW_3_2 "\t" $evGW_3_3 "\t" $evGW_3_4 "\t" $evGW_3_5 "\t" $Tr_RPA_qsGW_1 "\t" $Tr_RPA_qsGW_3 "\t" $Tr_BSE_qsGW_1 "\t" $Tr_BSE_qsGW_3 "\t" $AC_BSE_qsGW_1 "\t" $AC_BSE_qsGW_3 "\t" $qsGW_1_1 "\t" $qsGW_1_2 "\t" $qsGW_1_3 "\t" $qsGW_1_4 "\t" $qsGW_1_5 "\t" $qsGW_3_1 "\t" $qsGW_3_2 "\t" $qsGW_3_3 "\t" $qsGW_3_4 "\t" $qsGW_3_5 - echo - echo '*** DONE ***' - echo - diff --git a/scripts/run_sph.sh b/scripts/run_sph.sh deleted file mode 100755 index fd1cc87..0000000 --- a/scripts/run_sph.sh +++ /dev/null @@ -1,41 +0,0 @@ -#! /bin/bash - -Lmin=1 -Lmax=1 -Mmax=10 -rs=$1 - -if [ $# != 1 ] -then - echo "Please, specify rs value" -else - - echo "------------------------" - echo "Maxmium L value = " $Lmax - echo "Maxmium M value = " $Mmax - echo "------------------------" - echo - - for (( L=$Lmin ; L<=$Lmax ; L++ )) ; do - - ne=$(bc -l <<< "(2*($L+1)*($L+1))") - echo - echo "------------------------" - echo "Number of electrons = " $ne - echo "------------------------" - echo - - for (( M=$L+1 ; M<=$Mmax ; M++ )) ; do - - nb=$(bc -l <<< "(($M+1)*($M+1))") - echo "Number of basis functions = " $nb - echo -e "# rs \n" $rs > input/sph - ./GoSph $ne $M > out/Sph_${ne}_${nb}.out - grep "Total CPU time for QuAcK =" out/Sph_${ne}_${nb}.out - - done - - done - -fi - diff --git a/scripts/scan_w.sh b/scripts/scan_w.sh deleted file mode 100755 index e79e50a..0000000 --- a/scripts/scan_w.sh +++ /dev/null @@ -1,119 +0,0 @@ -#! /bin/bash - -MOL=$1 -BASIS=$2 - -w_start=0.00 -w_end=1.05 -dw=0.05 - -w1=0.00 - -XF=$3 -CF=$4 - -# for H -#aw1="1.49852 7.79815 25.1445" -#aw2="0.424545 -0.0382349 -0.32472" - - -# for He -#aw1="0.429447 0.053506 -0.339391" -#aw2="0.254939 -0.0893396 0.00765453" - -# for H2 -aw1="0.445525 0.0901503 -0.286898" -aw2="0.191734 -0.0364788 -0.017035" - -# for Li -#aw1="0.055105 -0.00943825 -0.0267771" -#aw2="0.0359827 0.0096623 -0.0173542" - -# for Li+ -#aw1="0.503566, 0.137076, -0.348529" -#aw2="0.0553828, 0.00830375, -0.0234602" - - -# for B -#aw1="0.052676 -0.00624118 -0.000368825" -#aw2="0.0385558 -0.0015764 -0.000894297" - -# for O -#aw1="-0.0187067 -0.0141017 -0.0100849" -#aw2="0.00544868 -0.0000118236 -0.000163245" - -# for Al -#aw1="-0.00201219 -0.00371002 -0.00212719" -#aw2="-0.00117715 0.00188738 -0.000414761" - -# for Be -#aw1="0.0663282, -0.0117682, -0.0335909" -#aw2="0.0479262, 0.00966351, -0.0208712" - - -DATA=${MOL}_${BASIS}_${XF}_${CF}_${w2}.dat -rm $DATA -touch $DATA - -for w2 in $(seq $w_start $dw $w_end) -do - ## w2=${w1} - echo "# Restricted or unrestricted KS calculation" > input/dft - echo " eDFT-UKS" >> input/dft - echo "# exchange rung:" >> input/dft - echo "# Hartree = 0" >> input/dft - echo "# LDA = 1: RS51,RMFL20" >> input/dft - echo "# GGA = 2: RB88" >> input/dft - echo "# Hybrid = 4" >> input/dft - echo "# Hartree-Fock = 666" >> input/dft - echo " 1 $XF " >> input/dft - echo "# correlation rung: " >> input/dft - echo "# Hartree = 0" >> input/dft - echo "# LDA = 1: RVWN5,RMFL20" >> input/dft - echo "# GGA = 2: " >> input/dft - echo "# Hybrid = 4: " >> input/dft - echo "# Hartree-Fock = 666" >> input/dft - echo " 0 $CF " >> input/dft - echo "# quadrature grid SG-n" >> input/dft - echo " 1" >> input/dft - echo "# Number of states in ensemble (nEns)" >> input/dft - echo " 3" >> input/dft - echo "# occupation numbers of orbitals nO and nO+1" >> input/dft - echo " 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 " >> input/dft - echo " 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 " >> input/dft - echo " " >> input/dft - echo " 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 " >> input/dft - echo " 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 " >> input/dft - echo " " >> input/dft - echo " 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 " >> input/dft - echo " 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 " >> input/dft - echo "# Ensemble weights: wEns(1),...,wEns(nEns-1)" >> input/dft - echo " ${w1} ${w2} " >> input/dft - echo "# Ncentered ? 0 for NO " >> input/dft - echo " 0 " >> input/dft - echo "# Parameters for CC weight-dependent exchange functional" >> input/dft - echo ${aw1} >> input/dft - echo ${aw2} >> input/dft - echo "# choice of UCC exchange coefficient : 1 for Cx1, 2 for Cx2, 3 for Cx1*Cx2" >> input/dft - echo "2" >> input/dft - echo "# GOK-DFT: maxSCF thresh DIIS n_diis guess_type ortho_type" >> input/dft - echo " 1000 0.00001 T 5 1 1" >> input/dft - OUTPUT=${MOL}_${BASIS}_${XF}_${CF}_${w2}.out - ./GoXC $MOL $BASIS > ${OUTPUT} - Ew=`grep "Ensemble energy:" ${OUTPUT} | cut -d":" -f 2 | sed 's/au//'` - E0=`grep "Individual energy state 1:" ${OUTPUT} | cut -d":" -f 2 | sed 's/au//'` - E1=`grep "Individual energy state 2:" ${OUTPUT} | cut -d":" -f 2 | sed 's/au//'` - E2=`grep "Individual energy state 3:" ${OUTPUT} | cut -d":" -f 2 | sed 's/au//'` - IP=`grep "Ionization Potential" ${OUTPUT} | grep " au" | tail -1 | cut -d":" -f 2 | sed 's/au//'` - EA=`grep "Electronic Affinity" ${OUTPUT} | grep " au" | tail -1 | cut -d":" -f 2 | sed 's/au//'` - FG=`grep "Fundamental Gap" ${OUTPUT} | grep " au" | tail -1 | cut -d":" -f 2 | sed 's/au//'` - Ex=`grep "Exchange energy:" ${OUTPUT} | cut -d":" -f 2 | sed 's/au//'` - HOMOa=`grep "HOMO a energy:" ${OUTPUT} | cut -d":" -f 2 | sed 's/eV//'` - LUMOa=`grep "LUMO a energy:" ${OUTPUT} | cut -d":" -f 2 | sed 's/eV//'` - HOMOb=`grep "HOMO a energy:" ${OUTPUT} | cut -d":" -f 2 | sed 's/eV//'` - LUMOb=`grep "LUMO b energy:" ${OUTPUT} | cut -d":" -f 2 | sed 's/eV//'` - - echo $w1 $w2 $Ew $E0 $E1 $E2 $IP $EA $FG $Ex $HOMOa $LUMOa $HOMOb $LUMOb - echo $w1 $w2 $Ew $E0 $E1 $E2 $IP $EA $FG $Ex $HOMOa $LUMOa $HOMOb $LUMOb >> ${DATA} -done - diff --git a/src/AOtoMO/AOtoMO.f90 b/src/AOtoMO/AOtoMO.f90 index 8383273..6481ee2 100644 --- a/src/AOtoMO/AOtoMO.f90 +++ b/src/AOtoMO/AOtoMO.f90 @@ -1,17 +1,17 @@ -subroutine AOtoMO(nBas, nOrb, C, M_AOs, M_MOs) +subroutine 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 - double precision, intent(in) :: C(nBas,nOrb) - double precision, intent(in) :: M_AOs(nBas,nBas) + integer,intent(in) :: nBas, nOrb + double precision,intent(in) :: C(nBas,nOrb) + double precision,intent(in) :: M_AOs(nBas,nBas) - double precision, intent(out) :: M_MOs(nOrb,nOrb) + double precision,intent(out) :: M_MOs(nOrb,nOrb) - double precision, allocatable :: AC(:,:) + double precision,allocatable :: AC(:,:) allocate(AC(nBas,nOrb)) diff --git a/src/AOtoMO/AOtoMO_ERI_RHF.f90 b/src/AOtoMO/AOtoMO_ERI_RHF.f90 index a248ce1..ac57590 100644 --- a/src/AOtoMO/AOtoMO_ERI_RHF.f90 +++ b/src/AOtoMO/AOtoMO_ERI_RHF.f90 @@ -32,6 +32,7 @@ subroutine AOtoMO_ERI_RHF(nBas,nOrb,c,ERI_AO,ERI_MO) , ERI_AO(1,1,1,1), nBas, c(1,1), nBas & , 0.d0, a2(1,1,1,1), nBas*nBas*nBas) + call dgemm( '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) @@ -50,5 +51,5 @@ subroutine AOtoMO_ERI_RHF(nBas,nOrb,c,ERI_AO,ERI_MO) , 0.d0, ERI_MO(1,1,1,1), nOrb*nOrb*nOrb) deallocate(a2) - + end subroutine diff --git a/src/AOtoMO/AOtoMO_GHF.f90 b/src/AOtoMO/AOtoMO_GHF.f90 index 0338a42..bb086c2 100644 --- a/src/AOtoMO/AOtoMO_GHF.f90 +++ b/src/AOtoMO/AOtoMO_GHF.f90 @@ -1,4 +1,4 @@ -subroutine AOtoMO_GHF(nBas,nBas2,Ca,Cb,A,B) +subroutine AOtoMO_GHF(nBas,nOrb,Ca,Cb,A,B) ! Perform AO to MO transformation of a matrix A for given coefficients c @@ -7,25 +7,45 @@ subroutine AOtoMO_GHF(nBas,nBas2,Ca,Cb,A,B) ! Input variables integer,intent(in) :: nBas - integer,intent(in) :: nBas2 - double precision,intent(in) :: Ca(nBas,nBas2) - double precision,intent(in) :: Cb(nBas,nBas2) + integer,intent(in) :: nOrb + double precision,intent(in) :: Ca(nBas,nOrb) + double precision,intent(in) :: Cb(nBas,nOrb) double precision,intent(in) :: A(nBas,nBas) ! Local variables double precision,allocatable :: AC(:,:) +! double precision,allocatable :: Ba(:,:) ! Output variables - double precision,intent(out) :: B(nBas2,nBas2) + double precision,intent(out) :: B(nOrb,nOrb) - allocate(AC(nBas,nBas2)) + allocate(AC(nBas,nOrb)) +! allocate(Ba(nOrb,nOrb)) AC = matmul(A,Ca) B = matmul(transpose(Ca),AC) +! call dgemm("N", "N", nBas, nOrb, nBas, 1.d0, & +! A(1,1), nBas, Ca(1,1), nBas, & +! 0.d0, AC(1,1), nBas) + +! call dgemm("T", "N", nOrb, nOrb, nBas, 1.d0, & +! Ca(1,1), nBas, AC(1,1), nBas, & +! 0.d0, Ba(1,1), nOrb) + AC = matmul(A,Cb) B = B + matmul(transpose(Cb),AC) +! call dgemm("N", "N", nBas, nOrb, nBas, 1.d0, & +! A(1,1), nBas, Cb(1,1), nBas, & +! 0.d0, AC(1,1), nBas) + +! call dgemm("T", "N", nOrb, nOrb, nBas, 1.d0, & +! Cb(1,1), nBas, AC(1,1), nBas, & +! 0.d0, B(1,1), nOrb) + +! B(:,:) = Ba(:,:) + B(:,:) + end subroutine diff --git a/src/CC/EE_EOM_CCD_1h1p.f90 b/src/CC/EE_EOM_CCD_1h1p.f90 index ef3f7f9..6e72c31 100644 --- a/src/CC/EE_EOM_CCD_1h1p.f90 +++ b/src/CC/EE_EOM_CCD_1h1p.f90 @@ -30,19 +30,19 @@ subroutine EE_EOM_CCD_1h1p(nC,nO,nV,nR,eO,eV,OOVV,OVVO,t) double precision,allocatable :: Om(:) double precision,allocatable :: VL(:,:) double precision,allocatable :: VR(:,:) - double precision,allocatable :: Leom(:,:,:) - double precision,allocatable :: Reom(:,:,:) +! double precision,allocatable :: Leom(:,:,:) +! double precision,allocatable :: Reom(:,:,:) - integer :: nstate,m - double precision :: Ex,tmp +! integer :: nstate,m +! double precision :: Ex,tmp integer,allocatable :: order(:) - double precision,allocatable :: rdm1_oo(:,:) - double precision,allocatable :: rdm1_vv(:,:) +! double precision,allocatable :: rdm1_oo(:,:) +! double precision,allocatable :: rdm1_vv(:,:) - double precision,allocatable :: rdm2_oovv(:,:,:,:) - double precision,allocatable :: rdm2_ovvo(:,:,:,:) +! double precision,allocatable :: rdm2_oovv(:,:,:,:) +! double precision,allocatable :: rdm2_ovvo(:,:,:,:) ! Hello world @@ -165,120 +165,119 @@ subroutine EE_EOM_CCD_1h1p(nC,nO,nV,nR,eO,eV,OOVV,OVVO,t) end if - allocate(Leom(nO,nV,nS),Reom(nO,nV,nS)) +! allocate(Leom(nO,nV,nS),Reom(nO,nV,nS)) - do m=1,nS - ia = 0 - do i=1,nO - do a=1,nV - ia = ia + 1 - Leom(i,a,m) = VL(ia,m) - Reom(i,a,m) = VR(ia,m) - end do - end do - end do +! do m=1,nS +! ia = 0 +! do i=1,nO +! do a=1,nV +! ia = ia + 1 +! Leom(i,a,m) = VL(ia,m) +! Reom(i,a,m) = VR(ia,m) +! end do +! end do +! end do - deallocate(VL,VR) +! deallocate(VL,VR) !------------------------------------------------------------------------ ! EOM section !------------------------------------------------------------------------ - allocate(rdm1_oo(nO,nO),rdm1_vv(nV,nV)) - allocate(rdm2_oovv(nO,nO,nV,nV),rdm2_ovvo(nO,nV,nV,nO)) +! allocate(rdm1_oo(nO,nO),rdm1_vv(nV,nV)) +! allocate(rdm2_oovv(nO,nO,nV,nV),rdm2_ovvo(nO,nV,nV,nO)) - nstate = 1 +! nstate = 1 - tmp = 0d0 - do i=1,nO - do a=1,nV - tmp = tmp + Leom(i,a,nstate)*Reom(i,a,nstate) - end do - end do - print*,tmp +! tmp = 0d0 +! do i=1,nO +! do a=1,nV +! tmp = tmp + Leom(i,a,nstate)*Reom(i,a,nstate) +! end do +! end do +! print*,tmp - rdm1_oo(:,:) = 0d0 - do i=1,nO - do j=1,nO - do c=1,nV +! rdm1_oo(:,:) = 0d0 +! do i=1,nO +! do j=1,nO +! do c=1,nV - rdm1_oo(i,j) = rdm1_oo(i,j) - Reom(i,c,nstate)*Leom(j,c,nstate) +! rdm1_oo(i,j) = rdm1_oo(i,j) - Reom(i,c,nstate)*Leom(j,c,nstate) - end do - end do - end do +! end do +! end do +! end do - rdm1_vv(:,:) = 0d0 - do a=1,nV - do b=1,nV - do k=1,nO +! rdm1_vv(:,:) = 0d0 +! do a=1,nV +! do b=1,nV +! do k=1,nO - rdm1_vv(a,b) = rdm1_vv(a,b) + Reom(k,b,nstate)*Leom(k,a,nstate) +! rdm1_vv(a,b) = rdm1_vv(a,b) + Reom(k,b,nstate)*Leom(k,a,nstate) - end do - end do - end do +! end do +! end do +! end do - rdm2_ovvo(:,:,:,:) = 0d0 - do i=1,nO - do a=1,nV - do b=1,nV - do j=1,nO - - rdm2_ovvo(i,a,b,j) = Reom(i,b,nstate)*Leom(j,a,nstate) +! rdm2_ovvo(:,:,:,:) = 0d0 +! do i=1,nO +! do a=1,nV +! do b=1,nV +! do j=1,nO +! +! rdm2_ovvo(i,a,b,j) = Reom(i,b,nstate)*Leom(j,a,nstate) - end do - end do - end do - end do +! end do +! end do +! end do +! end do - rdm2_oovv(:,:,:,:) = 0d0 - do i=1,nO - do j=1,nO - do a=1,nV - do b=1,nV +! rdm2_oovv(:,:,:,:) = 0d0 +! do i=1,nO +! do j=1,nO +! do a=1,nV +! do b=1,nV - do k=1,nO - do c=1,nV - - rdm2_oovv(i,j,a,b) = rdm2_oovv(i,j,a,b) & - + Reom(j,b,nstate)*t(k,i,c,a)*Leom(k,c,nstate) & - - Reom(i,b,nstate)*t(k,j,c,a)*Leom(k,c,nstate) & - - Reom(j,a,nstate)*t(k,i,c,b)*Leom(k,c,nstate) & - + Reom(i,a,nstate)*t(k,j,c,b)*Leom(k,c,nstate) +! do k=1,nO +! do c=1,nV +! +! rdm2_oovv(i,j,a,b) = rdm2_oovv(i,j,a,b) & +! + Reom(j,b,nstate)*t(k,i,c,a)*Leom(k,c,nstate) & +! - Reom(i,b,nstate)*t(k,j,c,a)*Leom(k,c,nstate) & +! - Reom(j,a,nstate)*t(k,i,c,b)*Leom(k,c,nstate) & +! + Reom(i,a,nstate)*t(k,j,c,b)*Leom(k,c,nstate) - end do - end do +! end do +! end do - end do - end do - end do - end do +! end do +! end do +! end do +! end do - Ex = 0d0 +! Ex = 0d0 - do i=1,nO - Ex = Ex + rdm1_oo(i,i)*eO(i) - end do +! do i=1,nO +! Ex = Ex + rdm1_oo(i,i)*eO(i) +! end do - do a=1,nV - Ex = Ex + rdm1_vv(a,a)*eV(a) - end do +! do a=1,nV +! Ex = Ex + rdm1_vv(a,a)*eV(a) +! end do - do i=1,nO - do a=1,nV - do b=1,nV - do j=1,nO - - Ex = Ex + rdm2_ovvo(i,a,b,j)*OVVO(i,a,b,j) + 0.25d0*rdm2_oovv(i,j,a,b)*OOVV(i,j,a,b) - - end do - end do - end do - end do - - print*,'Ex = ',Ex - print*,'Om = ',Om(nstate) +! do i=1,nO +! do a=1,nV +! do b=1,nV +! do j=1,nO +! +! Ex = Ex + rdm2_ovvo(i,a,b,j)*OVVO(i,a,b,j) + 0.25d0*rdm2_oovv(i,j,a,b)*OOVV(i,j,a,b) +! +! end do +! end do +! end do +! end do +! print*,'Ex = ',Ex +! print*,'Om = ',Om(nstate) end subroutine diff --git a/src/GT/GG0T0pp.f90 b/src/GT/GG0T0pp.f90 index 7be6092..2af71ca 100644 --- a/src/GT/GG0T0pp.f90 +++ b/src/GT/GG0T0pp.f90 @@ -128,7 +128,7 @@ subroutine GG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,T if(regularize) call GTpp_regularization(nOrb,nC,nO,nV,nR,nOO,nVV,eHF,Om1,rho1,Om2,rho2) - call GGTpp_self_energy_diag(eta,nOrb,nC,nO,nV,nR,nOO,nVV,eHF,Om1,rho1,Om2,rho2,EcGM,Sig,Z) + call GGTpp_self_energy_diag(eta,nOrb,nC,nO,nV,nR,nOO,nVV,eHF,Om1,rho1,Om2,rho2,EcGM,Sig,Z,ERI) !---------------------------------------------- ! Solve the quasi-particle equation diff --git a/src/GT/GGTpp_self_energy_diag.f90 b/src/GT/GGTpp_self_energy_diag.f90 index 1f34638..961c915 100644 --- a/src/GT/GGTpp_self_energy_diag.f90 +++ b/src/GT/GGTpp_self_energy_diag.f90 @@ -1,4 +1,4 @@ -subroutine GGTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Om1,rho1,Om2,rho2,EcGM,Sig,Z) +subroutine GGTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Om1,rho1,Om2,rho2,EcGM,Sig,Z,ERI) ! Compute diagonal of the correlation part of the T-matrix self-energy @@ -20,11 +20,12 @@ subroutine GGTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Om1,rho1,Om2,rh double precision,intent(in) :: rho1(nBas,nBas,nVV) double precision,intent(in) :: Om2(nOO) double precision,intent(in) :: rho2(nBas,nBas,nOO) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables - integer :: i,j,a,b,p,cd,kl - double precision :: num,eps + integer :: i,j,k,a,b,c,p,m,cd,kl + double precision :: num,eps,dem1,dem2 ! Output variables @@ -42,36 +43,130 @@ subroutine GGTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Om1,rho1,Om2,rh ! Occupied part of the Tpp self-energy ! !--------------------------------------! - do p=nC+1,nBas-nR - do i=nC+1,nO +! do p=nC+1,nBas-nR +! do i=nC+1,nO - do cd=1,nVV - eps = e(p) + e(i) - Om1(cd) - num = rho1(p,i,cd)**2 - Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - end do +! do cd=1,nVV +! eps = e(p) + e(i) - Om1(cd) +! num = rho1(p,i,cd)**2 +! Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) +! Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 +! end do - end do - end do +! end do +! end do -!------------------------------------------! -! Virtual part of the T-matrix self-energy ! -!------------------------------------------! +! !------------------------------------------! +! ! Virtual part of the T-matrix self-energy ! +! !------------------------------------------! + +! do p=nC+1,nBas-nR +! do a=nO+1,nBas-nR + +! do kl=1,nOO +! eps = e(p) + e(a) - Om2(kl) +! num = rho2(p,a,kl)**2 +! Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) +! Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 +! end do + +! end do +! end do + +!-----------------------------------------------! +! Testing another way to compute GT self-energy ! +!-----------------------------------------------! do p=nC+1,nBas-nR - do a=nO+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR - do kl=1,nOO - eps = e(p) + e(a) - Om2(kl) - num = rho2(p,a,kl)**2 - Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - end do + eps = e(p) + e(a) - e(i) - e(j) + num = 0.5d0*(ERI(p,a,i,j) - ERI(p,a,j,i))**2 - end do + Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + do a=nO+1,nBas-nR + + do m=1,nVV + num = - ERI(p,a,i,j) * rho1(p,a,m) * rho1(i,j,m) + dem1 = e(p) + e(a) - e(i) - e(j) + dem2 = Om1(m) - e(i) - e(j) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 + end do + + do m=1,nOO + num = - ERI(p,a,i,j) * rho2(p,a,m) * rho2(i,j,m) + dem1 = e(p) + e(a) - e(i) - e(j) + dem2 = e(p) + e(a) - Om2(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 - num/dem1/dem2/dem2 + end do + + end do + ! do k=nC+1,nO + + ! do m=1,nVV + ! num = - ERI(p,i,j,k) * rho1(p,i,m) * rho1(j,k,m) + ! dem1 = e(p) + e(i) - Om1(m) + ! dem2 = Om1(m) - e(j) - e(k) + ! Sig(p) = Sig(p) + num/dem1/dem2 + ! Z(p) = Z(p) - num/dem1/dem1/dem2 + ! end do + + ! end do + end do + end do end do + do p=nC+1,nBas-nR + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + do i=nC+1,nO + + eps = e(p) + e(i) - e(a) - e(b) + num = 0.5d0*(ERI(p,i,a,b) - ERI(p,i,b,a))**2 + + Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + do i=nC+1,nO + + do m=1,nVV + num = ERI(p,i,a,b) * rho1(p,i,m) * rho1(a,b,m) + dem1 = e(p) + e(i) - e(a) - e(b) + dem2 = e(p) + e(i) - Om1(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 - num/dem1/dem2/dem2 + end do + + do m=1,nOO + num = ERI(p,i,a,b) * rho2(p,i,m) * rho2(a,b,m) + dem1 = e(p) + e(i) - e(a) - e(b) + dem2 = Om2(m) - e(a) - e(b) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 + end do + end do + ! do c=nO+1,nBas-nR + ! do m=1,nOO + ! num = ERI(p,a,b,c) * rho2(p,a,m) * rho2(b,c,m) + ! dem1 = e(p) + e(a) - Om2(m) + ! dem2 = Om2(m) - e(b) - e(c) + ! Sig(p) = Sig(p) + num/dem1/dem2 + ! Z(p) = Z(p) - num/dem1/dem1/dem2 + ! end do + + ! end do + end do + end do + end do + !-------------------------------------! ! Galitskii-Migdal correlation energy ! !-------------------------------------! diff --git a/src/GW/GG0W0.f90 b/src/GW/GG0W0.f90 index 780ec2e..72163d6 100644 --- a/src/GW/GG0W0.f90 +++ b/src/GW/GG0W0.f90 @@ -1,5 +1,5 @@ subroutine GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, & - linearize,eta,doSRG,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF) + linearize,eta,doSRG,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF,eGW_out) ! Perform G0W0 calculation implicit none @@ -58,6 +58,8 @@ subroutine GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA ! Output variables + double precision,intent(out) :: eGW_out(nBas) + ! Hello world write(*,*) @@ -117,7 +119,7 @@ subroutine GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA if(doSRG) then call GGW_SRG_self_energy_diag(flow,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,EcGM,SigC,Z) else - call GGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,EcGM,SigC,Z) + call GGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,EcGM,SigC,Z,ERI) end if !-----------------------------------! @@ -157,6 +159,8 @@ subroutine GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA call print_GG0W0(nBas,nO,eHF,ENuc,EGHF,SigC,Z,eGW,EcRPA,EcGM) + eGW_out(:) = eGW(:) + ! Deallocate memory deallocate(SigC,Z,Om,XpY,XmY,rho) diff --git a/src/GW/GGW.f90 b/src/GW/GGW.f90 index adacd18..b4ab3a2 100644 --- a/src/GW/GGW.f90 +++ b/src/GW/GGW.f90 @@ -1,6 +1,6 @@ subroutine GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE, & TDA_W,TDA,dBSE,dTDA,linearize,eta,doSRG,nNuc,ZNuc,rNuc,ENuc,nBas,nBas2,nC,nO,nV,nR,nS,EGHF,S,X,T,V,Hc, & - ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,eHF) + ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,eHF,eGW) ! GW module @@ -63,6 +63,10 @@ subroutine GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT,exchan double precision :: start_GW ,end_GW ,t_GW +! Output variables + + double precision,intent(out) :: eGW(nBas2) + !------------------------------------------------------------------------ ! Perform G0W0 calculatiom !------------------------------------------------------------------------ @@ -71,7 +75,7 @@ subroutine GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT,exchan call wall_time(start_GW) call GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, & - linearize,eta,doSRG,nBas2,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF) + linearize,eta,doSRG,nBas2,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF,eGW) call wall_time(end_GW) t_GW = end_GW - start_GW diff --git a/src/GW/GGW_self_energy_diag.f90 b/src/GW/GGW_self_energy_diag.f90 index 2a02837..0f1bd30 100644 --- a/src/GW/GGW_self_energy_diag.f90 +++ b/src/GW/GGW_self_energy_diag.f90 @@ -1,4 +1,4 @@ -subroutine GGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z) +subroutine GGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z,ERI) ! Compute diagonal of the correlation part of the self-energy and the renormalization factor @@ -17,11 +17,12 @@ subroutine GGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z) double precision,intent(in) :: e(nBas) double precision,intent(in) :: Om(nS) double precision,intent(in) :: rho(nBas,nBas,nS) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables - integer :: i,a,p,m - double precision :: num,eps + integer :: i,j,a,b,p,m + double precision :: num,eps,dem1,dem2 ! Output variables @@ -38,36 +39,118 @@ subroutine GGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,e,Om,rho,EcGM,Sig,Z) ! GW self-energy ! !----------------! -! Occupied part of the correlation 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) +! num = rho(p,i,m)**2 +! Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) +! Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**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) +! num = rho(p,a,m)**2 +! Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) +! Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + +! end do +! end do +! end do + +!-----------------------------------------------! +! Testing another way to compute GT self-energy ! +!-----------------------------------------------! do p=nC+1,nBas-nR - do i=nC+1,nO - do m=1,nS + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR - eps = e(p) - e(i) + Om(m) - num = rho(p,i,m)**2 - Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + eps = e(p) + e(a) - e(i) - e(j) + num = ERI(p,a,i,j)**2 - end do - end do + Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + do a=nO+1,nBas-nR + + do m=1,nS + num = - ERI(p,i,j,a) * rho(i,a,m) * rho(j,p,m) + dem1 = e(p) + e(a) - e(i) - e(j) + dem2 = e(p) - e(j) + Om(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 - num/dem1/dem2/dem2 + + num = - ERI(p,i,j,a) * rho(i,a,m) * rho(j,p,m) + dem1 = e(p) + e(a) - e(i) - e(j) + dem2 = e(a) - e(i) + Om(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 + + num = - ERI(p,a,j,i) * rho(a,i,m) * rho(j,p,m) + dem1 = e(p) - e(j) + Om(m) + dem2 = e(a) - e(i) + Om(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 + end do + + end do + 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 + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + do i=nC+1,nO + + eps = e(p) + e(i) - e(a) - e(b) + num = ERI(p,i,a,b)**2 + + Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + do i=nC+1,nO + + do m=1,nS + num = ERI(p,a,b,i) * rho(a,i,m) * rho(b,p,m) + dem1 = e(p) + e(i) - e(a) - e(b) + dem2 = e(p) - e(b) - Om(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 - num/dem1/dem2/dem2 - eps = e(p) - e(a) - Om(m) - num = rho(p,a,m)**2 - Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + num = - ERI(p,a,b,i) * rho(a,i,m) * rho(b,p,m) + dem1 = e(p) + e(i) - e(a) - e(b) + dem2 = e(a) - e(i) + Om(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 + + num = - ERI(p,i,b,a) * rho(i,a,m) * rho(b,p,m) + dem1 = e(p) - e(b) - Om(m) + dem2 = e(a) - e(i) + Om(m) + Sig(p) = Sig(p) + num/dem1/dem2 + Z(p) = Z(p) - num/dem1/dem1/dem2 + end do - end do - end do + end do + end do + end do end do + ! Galitskii-Migdal correlation energy EcGM = 0d0 diff --git a/src/GW/RG0W0.f90 b/src/GW/RG0W0.f90 index 132ddeb..4c3fa2c 100644 --- a/src/GW/RG0W0.f90 +++ b/src/GW/RG0W0.f90 @@ -1,5 +1,5 @@ subroutine RG0W0(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,dipole_int,eHF) + linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eGW_out) ! Perform G0W0 calculation @@ -62,6 +62,9 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA double precision,allocatable :: eGWlin(:) double precision,allocatable :: eGW(:) +! Output variables + + double precision,intent(out) :: eGW_out(nOrb) ! Output variables @@ -170,6 +173,8 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA call print_RG0W0(nOrb,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM) + eGW_out(:) = eGW(:) + !---------------------------! ! Perform phBSE calculation ! !---------------------------! diff --git a/src/GW/RGW.f90 b/src/GW/RGW.f90 index 8ce3f16..03b9688 100644 --- a/src/GW/RGW.f90 +++ b/src/GW/RGW.f90 @@ -1,7 +1,11 @@ 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,CAP_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) +<<<<<<< HEAD + S,X,T,V,Hc,ERI_AO,ERI_MO,CAP_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF,eGW) +======= + S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF,eGW) +>>>>>>> upstream/master ! Restricted GW module @@ -72,6 +76,10 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF,thresh logical :: doccG0W0,doccGW +! Output variables + + double precision,intent(out) :: eGW(nOrb) + !------------------------------------------------------------------------ ! Perform G0W0 calculation !------------------------------------------------------------------------ @@ -80,7 +88,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF,thresh call wall_time(start_GW) call RG0W0(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,dipole_int_MO,eHF) + linearize,eta,doSRG,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,eGW) call wall_time(end_GW) t_GW = end_GW - start_GW @@ -148,9 +156,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF,thresh if(doufG0W0) then call wall_time(start_GW) - ! TODO call ufRG0W0(dotest,TDA_W,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) -! call eomRG0W0(dotest,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call wall_time(end_GW) t_GW = end_GW - start_GW @@ -166,7 +172,6 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF,thresh if(doufGW) then call wall_time(start_GW) - ! TODO call ufRGW(dotest,TDA_W,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call wall_time(end_GW) @@ -185,8 +190,8 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF,thresh if(doccG0W0) then call wall_time(start_GW) - call ccRG0W0(maxSCF,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR,nS,ERI_MO,ENuc,ERHF,eHF) -! call ccRG0W0_TDA(maxSCF,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF) +! call ccRG0W0(maxSCF,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR,nS,ERI_MO,ENuc,ERHF,eHF) + call ccRG0W0_TDA(maxSCF,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF) call wall_time(end_GW) t_GW = end_GW - start_GW diff --git a/src/GW/eomRG0W0.f90 b/src/GW/eomRG0W0.f90 deleted file mode 100644 index cfa6b6f..0000000 --- a/src/GW/eomRG0W0.f90 +++ /dev/null @@ -1,315 +0,0 @@ -subroutine eomRG0W0(dotest,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) - -! EOM version of G0W0 - - implicit none - include 'parameters.h' - -! Input variables - - logical,intent(in) :: dotest - - 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) :: eHF(nOrb) - -! Local variables - - integer :: p - integer :: s - integer :: i,j,k,l - integer :: a,b,c,d - integer :: jb,kc,ia,ja - integer :: klc,kcd,ija,ijb,iab,jab - - logical :: print_W = .false. - logical :: dRPA - integer :: isp_W - double precision :: EcRPA - integer :: n2h1p,n2p1h,nH - double precision,external :: Kronecker_delta - double precision,allocatable :: H(:,:) - double precision,allocatable :: cGW(:,:) - double precision,allocatable :: eGW(:) - double precision,allocatable :: Z(:) - integer,allocatable :: order(:) - - logical :: verbose = .false. - double precision,parameter :: cutoff1 = 0.01d0 - double precision,parameter :: cutoff2 = 0.01d0 - double precision :: eF - double precision,parameter :: window = 2.5d0 - - double precision :: start_timing,end_timing,timing - -! Output variables - -! Hello world - - write(*,*) - write(*,*)'***********************************' - write(*,*)'* Restricted EOM-G0W0 Calculation *' - write(*,*)'***********************************' - write(*,*) - -! Dimension of the supermatrix - - n2h1p = nO*nO*nV - n2p1h = nV*nV*nO - nH = 1 + n2h1p + n2p1h - -! Memory allocation - - allocate(H(nH,nH),eGW(nH),cGW(nH,nH),Z(nH),order(nH)) - -! Initialization - - dRPA = .true. - EcRPA = 0d0 - - eF = 0.5d0*(eHF(nO+1) + eHF(nO)) - -!-------------------------! -! Main loop over orbitals ! -!-------------------------! - - do p=nO,nO+1 - - H(:,:) = 0d0 - -!-----------------------------------------! -! Compute BSE supermatrix ! -!-----------------------------------------! -! ! -! | A V2h1p V2p1h 0 0 | ! -! | | ! -! | V2h1p A2h2p 0 B2h1p 0 | ! -! | | ! -! H = | V2p1h 0 A2p2h 0 B2p1h | ! -! | | ! -! | 0 0 0 0 0 | ! -! | | ! -! | 0 0 0 0 0 | ! -! ! -!-----------------------------------------! - - call wall_time(start_timing) - - !---------! - ! Block F ! - !---------! - - H(1,1) = eHF(p) - - !-------------! - ! Block V2h1p ! - !-------------! - - ija = 0 - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nOrb-nR - ija = ija + 1 - - H(1 ,1+ija) = sqrt(2d0)*ERI(p,a,i,j) - H(1+ija,1 ) = sqrt(2d0)*ERI(p,a,i,j) -! H(1+n2h1p+n2p1h+ija,1 ) = sqrt(2d0)*ERI(p,a,i,j) -! H(1+ija,1+n2h1p+n2p1h ) = sqrt(2d0)*ERI(p,a,i,j) - - end do - end do - end do - - !-------------! - ! Block V2p1h ! - !-------------! - - iab = 0 - do i=nC+1,nO - do a=nO+1,nOrb-nR - do b=nO+1,nOrb-nR - iab = iab + 1 - - H(1 ,1+n2h1p+iab) = sqrt(2d0)*ERI(p,i,b,a) - H(1+n2h1p+iab,1 ) = sqrt(2d0)*ERI(p,i,b,a) -! H(1 ,1+2*n2h1p+n2p1h+iab) = sqrt(2d0)*ERI(p,i,b,a) -! H(1+2*n2h1p+n2p1h+iab,1 ) = sqrt(2d0)*ERI(p,i,b,a) - - end do - end do - end do - - !-------------! - ! Block A2h1p ! - !-------------! - - ija = 0 - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nOrb-nR - ija = ija + 1 - - klc = 0 - do k=nC+1,nO - do l=nC+1,nO - do c=nO+1,nOrb-nR - klc = klc + 1 - - H(1+ija,1+klc) & - = ((eHF(i) + eHF(j) - eHF(a))*Kronecker_delta(j,l)*Kronecker_delta(a,c) & - - 2d0*ERI(j,c,a,l) - 2d0*ERI(j,l,a,c))*Kronecker_delta(i,k) - -! H(1+n2h1p+n2p1h+ija,1+n2h1p+n2p1h+klc) & -! = ((eHF(i) + eHF(j) - eHF(a))*Kronecker_delta(j,l)*Kronecker_delta(a,c) & -! - 2d0*ERI(j,c,a,l))*Kronecker_delta(i,k) - - end do - end do - end do - - end do - end do - end do - - !-------------! - ! Block A2p1h ! - !-------------! - - iab = 0 - do i=nC+1,nO - do a=nO+1,nOrb-nR - do b=nO+1,nOrb-nR - iab = iab + 1 - - kcd = 0 - do k=nC+1,nO - do c=nO+1,nOrb-nR - do d=nO+1,nOrb-nR - kcd = kcd + 1 - - H(1+n2h1p+iab,1+n2h1p+kcd) & - = ((eHF(a) + eHF(b) - eHF(i))*Kronecker_delta(i,k)*Kronecker_delta(a,c) & - + 2d0*ERI(a,k,i,c) + 2d0*ERI(a,c,i,k))*Kronecker_delta(b,d) -! H(1+2*n2h1p+n2p1h+iab,1+2*n2h1p+n2p1h+kcd) & -! = ((eHF(a) + eHF(b) - eHF(i))*Kronecker_delta(i,k)*Kronecker_delta(a,c) & -! + 2d0*ERI(a,k,i,c))*Kronecker_delta(b,d) - - end do - end do - end do - - end do - end do - end do - - !-------------! - ! Block B2h1p ! - !-------------! - -! ija = 0 -! do i=nC+1,nO -! do j=nC+1,nO -! do a=nO+1,nOrb-nR -! ija = ija + 1 - -! kcd = 0 -! do k=nC+1,nO -! do c=nO+1,nOrb-nR -! do d=nO+1,nOrb-nR -! kcd = kcd + 1 -! -! H(1+ija,1+n2h1p+kcd) = - 2d0*ERI(j,k,a,c) -! -! end do -! end do -! end do -! -! end do -! end do -! end do - - !-------------! - ! Block B2p1h ! - !-------------! - -! iab = 0 -! do i=nC+1,nO -! do a=nO+1,nOrb-nR -! do b=nO+1,nOrb-nR -! iab = iab + 1 - -! klc = 0 -! do k=nC+1,nO -! do l=nC+1,nO -! do c=nO+1,nOrb-nR -! klc = klc + 1 - -! H(1+n2h1p+iab,1+klc) = - 2d0*ERI(a,c,i,l) -! -! end do -! end do -! end do -! -! end do -! end do -! end do - - !-------------------------! - ! Diagonalize supermatrix ! - !-------------------------! - - call wall_time(start_timing) - - call diagonalize_general_matrix(nH,H,eGW,cGW) - - do s=1,nH - order(s) = s - end do - - call quick_sort(eGW,order,nH) - call set_order(cGW,order,nH,nH) - - call wall_time(end_timing) - timing = end_timing - start_timing - - write(*,*) - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for construction of supermatrix = ',timing,' seconds' - write(*,*) - - !-----------------! - ! Compute weights ! - !-----------------! - - do s=1,nH - Z(s) = cGW(1,s)**2 - end do - - write(*,*)'-------------------------------------------' - write(*,'(1X,A32,I3,A8)')'| G0W0 energies (eV) for orbital',p,' |' - write(*,*)'-------------------------------------------' - write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X)') & - '|','#','|','e_QP','|','Z','|' - write(*,*)'-------------------------------------------' - - do s=1,nH -! if(eGW(s) < eF .and. eGW(s) > eF - window) then - if(Z(s) > cutoff1) then - write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') & - '|',s,'|',eGW(s)*HaToeV,'|',Z(s),'|' - end if - end do - - write(*,*)'-------------------------------------------' - write(*,*) - - end do ! Loop on the orbital in the e block - -end subroutine diff --git a/src/GW/print_qsRGW.f90 b/src/GW/print_qsRGW.f90 index 9fd695c..e093975 100644 --- a/src/GW/print_qsRGW.f90 +++ b/src/GW/print_qsRGW.f90 @@ -1,8 +1,5 @@ - -! --- - -subroutine print_qsRGW(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, SigC, & - Z, ENuc, ET, EV, EJ, EK, EcGM, EcRPA, EqsGW, dipole) +subroutine print_qsRGW(nBas,nOrb,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC, & + Z,ENuc,ET,EV,EJ,EK,EcGM,EcRPA,EqsGW,dipole) ! Print useful information about qsRGW calculation diff --git a/src/LR/phGLR_A.f90 b/src/LR/phGLR_A.f90 index d23a6b8..a7ba367 100644 --- a/src/LR/phGLR_A.f90 +++ b/src/LR/phGLR_A.f90 @@ -24,6 +24,9 @@ subroutine phGLR_A(dRPA,nOrb,nC,nO,nV,nR,nS,lambda,e,ERI,Aph) double precision,external :: Kronecker_delta integer :: i,j,a,b,ia,jb + integer :: nn,jb0 + logical :: i_eq_j + double precision :: ct1,ct2 ! Output variables @@ -35,22 +38,51 @@ subroutine phGLR_A(dRPA,nOrb,nC,nO,nV,nR,nS,lambda,e,ERI,Aph) if(dRPA) delta_dRPA = 1d0 ! Build A matrix for spin orbitals + nn = nOrb - nR - nO + ct1 = lambda + ct2 = - (1d0 - delta_dRPA) * lambda + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE (i, a, j, b, i_eq_j, ia, jb0, jb) & + !$OMP SHARED (nC, nO, nR, nOrb, nn, ct1, ct2, e, ERI, Aph) + !$OMP DO COLLAPSE(2) + do i = nC+1, nO + do a = nO+1, nOrb-nR + ia = a - nO + (i - nC - 1) * nn - ia = 0 - do i=nC+1,nO - do a=nO+1,nOrb-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nOrb-nR - jb = jb + 1 + do j = nC+1, nO + i_eq_j = i == j + jb0 = (j - nC - 1) * nn - nO + do b = nO+1, nOrb-nR + jb = b + jb0 - Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) + Aph(ia,jb) = ct1 * ERI(b,i,j,a) + ct2 * ERI(b,j,a,i) + if(i_eq_j) then + if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i) + endif + + enddo + enddo + + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + ! ia = 0 + ! do i=nC+1,nO + ! do a=nO+1,nOrb-nR + ! ia = ia + 1 + ! jb = 0 + ! do j=nC+1,nO + ! do b=nO+1,nOrb-nR + ! jb = jb + 1 - end do - end do - end do - end do + ! Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & + ! + lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) -end subroutine + ! end do + ! end do + ! end do + ! end do + +end subroutine diff --git a/src/LR/phGLR_B.f90 b/src/LR/phGLR_B.f90 index acf94ec..0eebf64 100644 --- a/src/LR/phGLR_B.f90 +++ b/src/LR/phGLR_B.f90 @@ -22,7 +22,9 @@ subroutine phGLR_B(dRPA,nOrb,nC,nO,nV,nR,nS,lambda,ERI,Bph) double precision :: delta_dRPA integer :: i,j,a,b,ia,jb - + integer :: nn,jb0 + double precision :: ct1,ct2 + ! Output variables double precision,intent(out) :: Bph(nS,nS) @@ -33,21 +35,46 @@ subroutine phGLR_B(dRPA,nOrb,nC,nO,nV,nR,nS,lambda,ERI,Bph) if(dRPA) delta_dRPA = 1d0 ! Build B matrix for spin orbitals + nn = nOrb - nR - nO + ct1 = lambda + ct2 = - (1d0 - delta_dRPA) * lambda + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE (i, a, j, b, ia, jb0, jb) & + !$OMP SHARED (nC, nO, nR, nOrb, nn, ct1, ct2, ERI, Bph) + !$OMP DO COLLAPSE(2) + do i = nC+1, nO + do a = nO+1, nOrb-nR + ia = a - nO + (i - nC - 1) * nn - ia = 0 - do i=nC+1,nO - do a=nO+1,nOrb-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nOrb-nR - jb = jb + 1 + do j = nC+1, nO + jb0 = (j - nC - 1) * nn - nO + do b = nO+1, nOrb-nR + jb = b + jb0 - Bph(ia,jb) = lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) + Bph(ia,jb) = ct1 * ERI(i,j,a,b) + ct2 * ERI(i,j,b,a) + + enddo + enddo + + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + ! ia = 0 + ! do i=nC+1,nO + ! do a=nO+1,nOrb-nR + ! ia = ia + 1 + ! jb = 0 + ! do j=nC+1,nO + ! do b=nO+1,nOrb-nR + ! jb = jb + 1 - end do - end do - end do - end do + ! Bph(ia,jb) = lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) + + ! end do + ! end do + ! end do + ! end do end subroutine diff --git a/src/LR/phLR_oscillator_strength.f90 b/src/LR/phLR_oscillator_strength.f90 index 796a6a2..02ab718 100644 --- a/src/LR/phLR_oscillator_strength.f90 +++ b/src/LR/phLR_oscillator_strength.f90 @@ -1,6 +1,6 @@ subroutine phLR_oscillator_strength(nOrb,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) -! Compute linear response +! Compute oscillator strength from a ph linear response calculation implicit none include 'parameters.h' diff --git a/src/LR/phLR_transition_vectors.f90 b/src/LR/phLR_transition_vectors.f90 index ac65d39..f416d0e 100644 --- a/src/LR/phLR_transition_vectors.f90 +++ b/src/LR/phLR_transition_vectors.f90 @@ -1,4 +1,4 @@ -subroutine phLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) +subroutine phLR_transition_vectors(spin_allowed,nOrb,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) ! Print transition vectors for linear response calculation @@ -8,13 +8,13 @@ subroutine phLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,O ! Input variables logical,intent(in) :: spin_allowed - 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 :: dipole_int(nBas,nBas,ncart) + double precision :: dipole_int(nOrb,nOrb,ncart) double precision,intent(in) :: Om(nS) double precision,intent(in) :: XpY(nS,nS) double precision,intent(in) :: XmY(nS,nS) @@ -37,7 +37,7 @@ subroutine phLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,O ! Compute oscillator strengths os(:) = 0d0 - if(spin_allowed) call phLR_oscillator_strength(nBas,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) + if(spin_allowed) call phLR_oscillator_strength(nOrb,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) ! Print details about excitations @@ -61,7 +61,7 @@ subroutine phLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,O jb = 0 do j=nC+1,nO - do b=nO+1,nBas-nR + do b=nO+1,nOrb-nR jb = jb + 1 if(abs(X(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' -> ',b,' = ',X(jb)/sqrt(2d0) end do @@ -69,7 +69,7 @@ subroutine phLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,O jb = 0 do j=nC+1,nO - do b=nO+1,nBas-nR + do b=nO+1,nOrb-nR jb = jb + 1 if(abs(Y(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' <- ',b,' = ',Y(jb)/sqrt(2d0) end do diff --git a/src/LR/ppRLR_C.f90 b/src/LR/ppRLR_C.f90 index 658d6c5..e9aec8a 100644 --- a/src/LR/ppRLR_C.f90 +++ b/src/LR/ppRLR_C.f90 @@ -32,8 +32,8 @@ subroutine ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVV,lambda,e,ERI,Cpp) ! Define the chemical potential - eF = e(nO) + e(nO+1) -! eF = 0d0 +! eF = e(nO) + e(nO+1) + eF = 0d0 ! Build C matrix for the singlet manifold diff --git a/src/LR/ppRLR_D.f90 b/src/LR/ppRLR_D.f90 index 6878bf6..bcaca6d 100644 --- a/src/LR/ppRLR_D.f90 +++ b/src/LR/ppRLR_D.f90 @@ -30,8 +30,8 @@ subroutine ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOO,lambda,e,ERI,Dpp) ! Define the chemical potential - eF = e(nO) + e(nO+1) -! eF = 0d0 +! eF = e(nO) + e(nO+1) + eF = 0d0 ! Build the D matrix for the singlet manifold diff --git a/src/LR/print_excitation_energies.f90 b/src/LR/print_excitation_energies.f90 index 8d1448c..fc8b71e 100644 --- a/src/LR/print_excitation_energies.f90 +++ b/src/LR/print_excitation_energies.f90 @@ -14,7 +14,7 @@ subroutine print_excitation_energies(method,manifold,nS,Om) ! Local variables - integer,parameter :: maxS = 10 + integer,parameter :: maxS = 50 integer :: m write(*,*) diff --git a/src/Parquet/GParquet.f90 b/src/Parquet/GParquet.f90 new file mode 100644 index 0000000..c027119 --- /dev/null +++ b/src/Parquet/GParquet.f90 @@ -0,0 +1,595 @@ +subroutine GParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_it_1b,conv_1b,max_it_2b,conv_2b, & + nOrb,nC,nO,nV,nR,nS,EGHF,eHF,ERI) + +! Parquet approximation based on spin orbitals + + implicit none + include 'parameters.h' + +! Hard-coded parameters + + logical :: print_phLR = .true. + logical :: print_ppLR = .true. + +! Input variables + + logical,intent(in) :: TDAeh + logical,intent(in) :: TDApp + integer,intent(in) :: max_diis_1b + integer,intent(in) :: max_diis_2b + logical,intent(in) :: linearize + double precision,intent(in) :: eta + double precision,intent(in) :: ENuc + double precision,intent(in) :: EGHF + integer,intent(in) :: max_it_1b,max_it_2b + double precision,intent(in) :: conv_1b,conv_2b + integer,intent(in) :: nOrb,nC,nO,nV,nR,nS + double precision,intent(in) :: eHF(nOrb) + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + +! Local variables + + integer :: n_it_1b,n_it_2b + double precision :: err_1b,err_2b + double precision :: err_eh, err_pp + double precision :: err_eig_eh,err_eig_pp,err_eig_hh,err_eig_ee + double precision :: start_t,end_t,t + double precision :: start_1b,end_1b,t_1b + double precision :: start_2b,end_2b,t_2b + + integer :: nOO,nVV + + ! eh BSE + double precision :: Ec_eh + double precision,allocatable :: Aph(:,:), Bph(:,:) + double precision,allocatable :: XpY(:,:), XmY(:,:) + double precision,allocatable :: eh_Om(:), old_eh_Om(:) + double precision,allocatable :: eh_Gam_A(:,:),eh_Gam_B(:,:) + ! pp BSE + double precision :: Ec_pp + double precision,allocatable :: Bpp(:,:), Cpp(:,:), Dpp(:,:) + double precision,allocatable :: X1(:,:),Y1(:,:) + double precision,allocatable :: ee_Om(:), old_ee_Om(:) + double precision,allocatable :: X2(:,:),Y2(:,:) + double precision,allocatable :: hh_Om(:), old_hh_Om(:) + double precision,allocatable :: pp_Gam_B(:,:),pp_Gam_C(:,:),pp_Gam_D(:,:) + ! Effective integrals + double precision,allocatable :: eh_rho(:,:,:), ee_rho(:,:,:), hh_rho(:,:,:) + ! Reducible kernels + double precision,allocatable :: eh_Phi(:,:,:,:), pp_Phi(:,:,:,:) + double precision,allocatable :: old_eh_Phi(:,:,:,:), old_pp_Phi(:,:,:,:) + ! One-body quantities + double precision,allocatable :: eQPlin(:),eQP(:),eOld(:) + double precision,allocatable :: SigC(:) + double precision,allocatable :: Z(:) + double precision :: EcGM + ! DIIS + integer :: n_diis_2b + double precision :: rcond + double precision,allocatable :: err_diis_2b(:,:) + double precision,allocatable :: Phi_diis(:,:) + double precision,allocatable :: err(:) + double precision,allocatable :: Phi(:) + double precision :: alpha + + integer :: p,q,r,s,pqrs + + double precision :: mem = 0d0 + double precision :: dp_in_GB = 8d0/(1024d0**3) + +! Output variables +! None + +! Useful parameters + nOO = nO*(nO - 1)/2 + nVV = nV*(nV - 1)/2 + + allocate(eQP(nOrb),eOld(nOrb)) + + mem = mem + size(eQP) + size(eOld) + +! DIIS parameters + + rcond = 1d0 + + allocate(err_diis_2b(2*nOrb**4,max_diis_2b),Phi_diis(2*nOrb**4,max_diis_2b)) + allocate(err(2*nOrb**4),Phi(2*nOrb**4)) + + mem = mem + size(err_diis_2b) + size(Phi_diis) + size(err) + size(Phi) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + err_diis_2b(:,:) = 0d0 + Phi_diis(:,:) = 0d0 + +! Start + + write(*,*) + write(*,*)'***********************************' + write(*,*)'* Generalized Parquet Calculation *' + write(*,*)'***********************************' + write(*,*) + + ! Print parameters + + write(*,*)'---------------------------------------------------------------' + write(*,*)' Parquet parameters for one-body and two-body self-consistency ' + write(*,*)'---------------------------------------------------------------' + write(*,'(1X,A50,1X,I5)') 'Maximum number of one-body iteration:',max_it_1b + write(*,'(1X,A50,1X,E10.5)') 'Convergence threshold for one-body energies:',conv_1b + write(*,'(1X,A50,1X,L5)') 'Linearization of quasiparticle equation?',conv_1b + write(*,'(1X,A50,1X,E10.5)') 'Strenght of SRG regularization:',eta + write(*,'(1X,A50,1X,I5)') 'Maximum length of DIIS expansion:',max_diis_1b + write(*,*)'---------------------------------------------------------------' + write(*,'(1X,A50,1X,I5)') 'Maximum number of two-body iteration:',max_it_2b + write(*,'(1X,A50,1X,E10.5)') 'Convergence threshold for two-body energies:',conv_2b + write(*,'(1X,A50,1X,L5)') 'TDA for eh excitation energies?',TDAeh + write(*,'(1X,A50,1X,L5)') 'TDA for pp excitation energies?',TDApp + write(*,'(1X,A50,1X,I5)') 'Maximum length of DIIS expansion:',max_diis_2b + write(*,*)'---------------------------------------------------------------' + write(*,*) + + ! Memory allocation + + allocate(old_eh_Om(nS),old_ee_Om(nVV),old_hh_Om(nOO)) + allocate(eh_rho(nOrb,nOrb,nS+nS),ee_rho(nOrb,nOrb,nVV),hh_rho(nOrb,nOrb,nOO)) + allocate(old_eh_Phi(nOrb,nOrb,nOrb,nOrb),old_pp_Phi(nOrb,nOrb,nOrb,nOrb)) + + mem = mem + size(old_eh_Om) + size(old_ee_Om) + size(old_hh_Om) + mem = mem + size(eh_rho) + size(ee_rho) + size(hh_rho) + mem = mem + size(old_eh_Phi) + size(old_pp_Phi) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + +! Initialization + + n_it_1b = 0 + err_1b = 1d0 + + eQP(:) = eHF(:) + eOld(:) = eHF(:) + + eh_rho(:,:,:) = 0d0 + ee_rho(:,:,:) = 0d0 + hh_rho(:,:,:) = 0d0 + + old_eh_Om(:) = 0d0 + old_ee_Om(:) = 0d0 + old_hh_Om(:) = 0d0 + + old_eh_Phi(:,:,:,:) = 0d0 + old_pp_Phi(:,:,:,:) = 0d0 + + !-----------------------------------------! + ! Main loop for one-body self-consistency ! + !-----------------------------------------! + + do while(err_1b > conv_1b .and. n_it_1b < max_it_1b) + + n_it_1b = n_it_1b + 1 + call wall_time(start_1b) + + write(*,*) + write(*,*)'=====================================' + write(*,'(1X,A30,1X,I4)') 'One-body iteration #',n_it_1b + write(*,*)'=====================================' + write(*,*) + +! Initialization + + n_it_2b = 0 + err_2b = 1d0 + + !-----------------------------------------! + ! Main loop for two-body self-consistency ! + !-----------------------------------------! + + do while(err_2b > conv_2b .and. n_it_2b < max_it_2b) + + n_it_2b = n_it_2b + 1 + call wall_time(start_2b) + + write(*,*)' ***********************************' + write(*,'(1X,A30,1X,I4)') 'Two-body iteration #',n_it_2b + write(*,*)' ***********************************' + write(*,*) + + !-----------------! + ! eh channel ! + !-----------------! + + write(*,*) 'Diagonalizing eh BSE problem...' + + allocate(Aph(nS,nS),Bph(nS,nS),eh_Om(nS),XpY(nS,nS),XmY(nS,nS),eh_Gam_A(nS,nS),eh_Gam_B(nS,nS)) + + mem = mem + size(Aph) + size(Bph) + size(eh_Om) + size(XpY) + size(XmY) + size(eh_Gam_A) + size(eh_Gam_B) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + Aph(:,:) = 0d0 + Bph(:,:) = 0d0 + + call wall_time(start_t) + + call phGLR_A(.false.,nOrb,nC,nO,nV,nR,nS,1d0,eOld,ERI,Aph) + if(.not.TDAeh) call phGLR_B(.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) + + if(n_it_1b == 1 .and. n_it_2b == 1) then + + eh_Gam_A(:,:) = 0d0 + eh_Gam_B(:,:) = 0d0 + + else + + call G_eh_Gamma_A(nOrb,nC,nO,nR,nS,old_eh_Phi,old_pp_Phi,eh_Gam_A) + if(.not.TDAeh) call G_eh_Gamma_B(nOrb,nC,nO,nR,nS,old_eh_Phi,old_pp_Phi,eh_Gam_B) + + end if + + Aph(:,:) = Aph(:,:) + eh_Gam_A(:,:) + Bph(:,:) = Bph(:,:) + eh_Gam_B(:,:) + + call phGLR(TDAeh,nS,Aph,Bph,Ec_eh,eh_Om,XpY,XmY) + + call wall_time(end_t) + + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for phBSE problem =',t,' seconds' + write(*,*) + + if(print_phLR) call print_excitation_energies('phBSE@Parquet','eh generalized',nS,eh_Om) + + err_eig_eh = maxval(abs(old_eh_Om - eh_Om)) + + deallocate(Aph,Bph,eh_Gam_A,eh_Gam_B) + + mem = mem - size(Aph) - size(Bph) - size(eh_Gam_A) - size(eh_Gam_B) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + !-----------------! + ! pp channel ! + !-----------------! + + write(*,*) 'Diagonalizing pp BSE problem...' + + allocate(Bpp(nVV,nOO),Cpp(nVV,nVV),Dpp(nOO,nOO), & + ee_Om(nVV),X1(nVV,nVV),Y1(nOO,nVV), & + hh_Om(nOO),X2(nVV,nOO),Y2(nOO,nOO), & + pp_Gam_B(nVV,nOO),pp_Gam_C(nVV,nVV),pp_Gam_D(nOO,nOO)) + + mem = mem + size(Bpp) + size(Cpp) + size(Dpp) & + + size(ee_Om) + size(X1) + size(Y1) & + + size(hh_Om) + size(X2) + size(Y2) & + + size(pp_Gam_B) + size(pp_Gam_C) + size(pp_Gam_D) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + + Bpp(:,:) = 0d0 + Cpp(:,:) = 0d0 + Dpp(:,:) = 0d0 + + call wall_time(start_t) + if(.not.TDApp) call ppGLR_B(nOrb,nC,nO,nV,nR,nOO,nVV,1d0,ERI,Bpp) + call ppGLR_C(nOrb,nC,nO,nV,nR,nVV,1d0,eOld,ERI,Cpp) + call ppGLR_D(nOrb,nC,nO,nV,nR,nOO,1d0,eOld,ERI,Dpp) + + if(n_it_1b == 1 .and. n_it_2b == 1) then + + pp_Gam_B(:,:) = 0d0 + pp_Gam_C(:,:) = 0d0 + pp_Gam_D(:,:) = 0d0 + + else + + if(.not.TDApp) call G_pp_Gamma_B(nOrb,nC,nO,nR,nOO,nVV,old_eh_Phi,pp_Gam_B) + call G_pp_Gamma_C(nOrb,nO,nR,nVV,old_eh_Phi,pp_Gam_C) + call G_pp_Gamma_D(nOrb,nC,nO,nOO,old_eh_Phi,pp_Gam_D) + + end if + + Bpp(:,:) = Bpp(:,:) + pp_Gam_B(:,:) + Cpp(:,:) = Cpp(:,:) + pp_Gam_C(:,:) + Dpp(:,:) = Dpp(:,:) + pp_Gam_D(:,:) + + call ppGLR(TDApp,nOO,nVV,Bpp,Cpp,Dpp,ee_Om,X1,Y1,hh_Om,X2,Y2,Ec_pp) + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for ppBSE problem =',t,' seconds' + write(*,*) + + if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2p generalized',nVV,ee_Om) + if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2h generalized',nOO,hh_Om) + + err_eig_ee = maxval(abs(old_ee_Om - ee_Om)) + err_eig_hh = maxval(abs(old_hh_Om - hh_Om)) + err_eig_pp = max(err_eig_ee,err_eig_hh) + + deallocate(Bpp,Cpp,Dpp,pp_Gam_B,pp_Gam_C,pp_Gam_D) + + mem = mem - size(Bpp) - size(Cpp) - size(Dpp) & + - size(pp_Gam_B) - size(pp_Gam_C) - size(pp_Gam_D) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + !----------! + ! Updating ! + !----------! + + old_eh_Om(:) = eh_Om(:) + old_ee_Om(:) = ee_Om(:) + old_hh_Om(:) = hh_Om(:) + + deallocate(eh_Om,ee_Om,hh_Om) + + mem = mem - size(eh_Om) - size(ee_Om) - size(hh_Om) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + !----------------------------! + ! Compute screened integrals ! + !----------------------------! + + ! Free memory + deallocate(eh_rho,ee_rho,hh_rho) + + mem = mem - size(eh_rho) - size(ee_rho) - size(hh_rho) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + ! TODO Once we will compute the blocks of kernel starting from the 4-tensors we can move the freeing up + ! Memory allocation + allocate(eh_rho(nOrb,nOrb,nS+nS)) + allocate(ee_rho(nOrb,nOrb,nVV),hh_rho(nOrb,nOrb,nOO)) + + mem = mem + size(eh_rho) + size(ee_rho) + size(hh_rho) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + ! Build singlet eh integrals + write(*,*) 'Computing eh screened integrals...' + + call wall_time(start_t) + call G_eh_screened_integral(nOrb,nC,nO,nR,nS,ERI,old_eh_Phi,old_pp_Phi,XpY,XmY,eh_rho) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for eh integrals =',t,' seconds' + write(*,*) + + ! Done with eigenvectors and kernel + + deallocate(XpY,XmY) + + mem = mem - size(XpY) - size(XmY) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + ! Build singlet pp integrals + write(*,*) 'Computing pp screened integrals...' + + call wall_time(start_t) + call G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,old_eh_Phi,X1,Y1,ee_rho,X2,Y2,hh_rho) + call wall_time(end_t) + t = end_t - start_t + ! Done with eigenvectors and kernel + + deallocate(X1,Y1,X2,Y2) + + mem = mem - size(X1) - size(Y1) - size(X2) - size(Y2) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for pp integrals =',t,' seconds' + write(*,*) + + !----------------------------! + ! Compute reducible kernels ! + !----------------------------! + + ! Memory allocation + allocate(eh_Phi(nOrb,nOrb,nOrb,nOrb)) + allocate(pp_Phi(nOrb,nOrb,nOrb,nOrb)) + + mem = mem + size(eh_Phi) + size(pp_Phi) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + ! Build eh reducible kernels + write(*,*) 'Computing eh reducible kernel...' + + call wall_time(start_t) + call G_eh_Phi(nOrb,nC,nR,nS,old_eh_Om,eh_rho,eh_Phi) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for eh reducible kernel =',t,' seconds' + write(*,*) + + ! Build pp reducible kernels + write(*,*) 'Computing pp reducible kernel...' + + call wall_time(start_t) + call G_pp_Phi(nOrb,nC,nR,nOO,nVV,old_ee_Om,ee_rho,old_hh_Om,hh_rho,pp_Phi) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for pp reducible kernel =',t,' seconds' + write(*,*) + + err_eh = maxval(abs(eh_Phi - old_eh_Phi)) + err_pp = maxval(abs(pp_Phi - old_pp_Phi)) + +! alpha = 0.05d0 +! eh_Phi(:,:,:,:) = alpha * eh_Phi(:,:,:,:) + (1d0 - alpha) * old_eh_Phi(:,:,:,:) +! pp_Phi(:,:,:,:) = alpha * pp_Phi(:,:,:,:) + (1d0 - alpha) * old_pp_Phi(:,:,:,:) + +! call matout(nOrb**2,nOrb**2,eh_Phi - old_eh_Phi) +! call matout(nOrb**2,nOrb**2,pp_Phi - old_pp_Phi) + + !--------------------! + ! DIIS extrapolation ! + !--------------------! + + pqrs = 0 + do p=1,nOrb + do q=1,nOrb + do r=1,nOrb + do s=1,nOrb + pqrs = pqrs + 1 + + err( pqrs) = eh_Phi(p,q,r,s) - old_eh_Phi(p,q,r,s) + err(nOrb**4+pqrs) = pp_Phi(p,q,r,s) - old_pp_Phi(p,q,r,s) + + Phi( pqrs) = eh_Phi(p,q,r,s) + Phi(nOrb**4+pqrs) = pp_Phi(p,q,r,s) + + end do + end do + end do + end do + + if(max_diis_2b > 1) then + + n_diis_2b = min(n_diis_2b+1,max_diis_2b) + call DIIS_extrapolation(rcond,2*nOrb**4,2*nOrb**4,n_diis_2b,err_diis_2b,Phi_diis,err,Phi) + + end if + + pqrs = 0 + do p=1,nOrb + do q=1,nOrb + do r=1,nOrb + do s=1,nOrb + pqrs = pqrs + 1 + + eh_Phi(p,q,r,s) = Phi( pqrs) + pp_Phi(p,q,r,s) = Phi(nOrb**4+pqrs) + + end do + end do + end do + end do + + old_eh_Phi(:,:,:,:) = eh_Phi(:,:,:,:) + old_pp_Phi(:,:,:,:) = pp_Phi(:,:,:,:) + + ! Free memory + + deallocate(eh_Phi,pp_Phi) + + mem = mem - size(eh_Phi) - size(pp_Phi) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + write(*,*) '------------------------------------------------' + write(*,*) ' Two-body (frequency/kernel) convergence ' + write(*,*) '------------------------------------------------' + write(*,'(1X,A24,F10.6,1X,A1,1X,F10.6)')'Error for eh channel = ',err_eig_eh,'/',err_eh + write(*,'(1X,A24,F10.6,1X,A1,1X,F10.6)')'Error for pp channel = ',err_eig_pp,'/',err_pp + write(*,*) '------------------------------------------------' + write(*,*) + + ! Convergence criteria + err_2b = max(err_eh,err_pp) + + call wall_time(end_2b) + t_2b = end_2b - start_2b + write(*,'(1X,A44,1X,I4,A2,F9.3,A8)') 'Wall time for two-body iteration #',n_it_2b,' =',t_2b,' seconds' + write(*,*) + + end do + !---------------------------------------------! + ! End main loop for two-body self-consistency ! + !---------------------------------------------! + + ! Did it actually converge? + + if(n_it_2b == max_it_2b) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Two-body convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + !stop + + else + + write(*,*) + write(*,*)'****************************************************' + write(*,*)' Two-body convergence success ' + write(*,*)'****************************************************' + write(*,*) + + call print_excitation_energies('phBSE@Parquet','1h1p',nS,old_eh_Om) + call print_excitation_energies('ppBSE@Parquet','2p',nVV,old_ee_Om) + call print_excitation_energies('ppBSE@Parquet','2h',nOO,old_hh_Om) + + end if + + allocate(eQPlin(nOrb),Z(nOrb),SigC(nOrb)) + + mem = mem + size(eQPlin) + size(Z) + size(SigC) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + write(*,*) 'Computing self-energy...' + write(*,*) + + call wall_time(start_t) + call G_Parquet_self_energy(eta,nOrb,nC,nO,nV,nR,nS,nOO,nVV,eOld,ERI, & + eh_rho,old_eh_Om,ee_rho,old_ee_Om,hh_rho,old_hh_Om,EcGM,SigC,Z) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for self energy =',t,' seconds' + write(*,*) + + eQPlin(:) = eHF(:) + Z(:)*SigC(:) + + ! Solve the quasi-particle equation + + if(linearize) then + + eQP(:) = eQPlin(:) + + else + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Newton-Raphson for Dyson equation not implemented ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + stop + + end if + + ! Check one-body converge + + err_1b = maxval(abs(eOld - eQP)) + eOld(:) = eQP(:) + + ! Print for one-body part + + call G_print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,EGHF,EcGM,Ec_eh,Ec_pp) + + deallocate(eQPlin,Z,SigC) + + mem = mem - size(eQPlin) - size(Z) - size(SigC) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in GParquet =',mem*dp_in_GB,' GB' + + call wall_time(end_1b) + t_1b = end_1b - start_1b + write(*,'(1X,A44,1X,I4,A2,F9.3,A8)') 'Wall time for one-body iteration #',n_it_1b,' =',t_1b,' seconds' + + end do + !---------------------------------------------! + ! End main loop for one-body self-consistency ! + !---------------------------------------------! + + ! Did it actually converge? + if(n_it_1b == max_it_1b) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' One-body convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + stop + + else + + write(*,*) + write(*,*)'****************************************************' + write(*,*)' One-body convergence success ' + write(*,*)'****************************************************' + write(*,*) + + end if + +end subroutine diff --git a/src/Parquet/G_Parquet_self_energy.f90 b/src/Parquet/G_Parquet_self_energy.f90 new file mode 100644 index 0000000..d163a42 --- /dev/null +++ b/src/Parquet/G_Parquet_self_energy.f90 @@ -0,0 +1,336 @@ +subroutine G_Parquet_self_energy(eta,nOrb,nC,nO,nV,nR,nS,nOO,nVV,eQP,ERI,& + eh_rho,eh_Om,ee_rho,ee_Om,hh_rho,hh_Om,EcGM,SigC,Z) + +! Compute correlation part of the self-energy coming from irreducible vertices contribution + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nOrb + integer,intent(in) :: nC, nO, nV, nR + integer,intent(in) :: nS, nOO, nVV + double precision,intent(in) :: eQP(nOrb) + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_rho(nOrb,nOrb,nS+nS) + double precision,intent(in) :: eh_Om(nS) + double precision,intent(in) :: ee_rho(nOrb,nOrb,nVV) + double precision,intent(in) :: ee_Om(nVV) + double precision,intent(in) :: hh_rho(nOrb,nOrb,nOO) + double precision,intent(in) :: hh_Om(nOO) + +! Local variables + integer :: i,j,k,a,b,c + integer :: p,n + double precision :: eps,dem1,dem2,reg,reg1,reg2 + double precision :: num + double precision :: start_t,end_t,t + +! Output variables + + double precision,intent(out) :: SigC(nOrb) + double precision,intent(out) :: Z(nOrb) + double precision,intent(out) :: EcGM + +! Initialize + + SigC(:) = 0d0 + Z(:) = 0d0 + EcGM = 0d0 + +!-----------------------------------! +! 2nd-order part of the self-energy ! +!-----------------------------------! + + call wall_time(start_t) + + do p=nC+1,nOrb-nR + ! 2h1p sum + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nOrb-nR + + eps = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg = (1d0 - exp(- 2d0 * eta * eps * eps)) + num = 0.5d0*(ERI(p,a,j,i) - ERI(p,a,i,j))**2 + ! num = ERI(p,a,j,i)**2 + + SigC(p) = SigC(p) + num*reg/eps + Z(p) = Z(p) - num*reg/eps**2 + + end do + end do + end do + ! 2p1h sum + do i=nC+1,nO + do a=nO+1,nOrb-nR + do b=nO+1,nOrb-nR + + eps = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg = (1d0 - exp(- 2d0 * eta * eps * eps)) + num = 0.5d0*(ERI(p,i,b,a) - ERI(p,i,a,b))**2 + ! num = ERI(p,i,b,a)**2 + + SigC(p) = SigC(p) + num*reg/eps + Z(p) = Z(p) - num*reg/eps**2 + + end do + end do + end do + end do + + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building GF(2) self-energy =',t,' seconds' + write(*,*) + +!-----------------------------! +! eh part of the self-energy ! +!-----------------------------! + + call wall_time(start_t) + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,i,a,j,b,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nS,eta,ERI,eQP,eh_rho,eh_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + + do i=nC+1,nO + do a=nO+1,nOrb-nR + + do n=1,nS + !3h2p + do j=nC+1,nO + + num = - (ERI(p,a,j,i) - ERI(p,a,i,j)) * eh_rho(p,j,nS+n) * eh_rho(i,a,nS+n) !& + !+ ERI(p,a,i,j) * eh_rho(a,i,n) * eh_rho(j,p,n) + dem1 = eQP(p) - eQP(j) + eh_Om(n) + dem2 = eQP(p) - eQP(j) + eQP(a) - eQP(i) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) & + - num * (reg1/dem1/dem1) * (reg2/dem2) + + num = - (ERI(p,i,j,a) - ERI(p,i,a,j)) * eh_rho(p,j,nS+n) * eh_rho(a,i,nS+n) !& + !+ ERI(p,i,a,j) * eh_rho(i,a,n) * eh_rho(j,p,n) + + dem1 = eQP(a) - eQP(i) + eh_Om(n) + dem2 = eQP(p) - eQP(j) + eh_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = - (ERI(p,a,j,i) - ERI(p,a,i,j)) * eh_rho(p,j,n) * eh_rho(i,a,n) !& + !+ ERI(p,a,i,j) * eh_rho(a,i,nS+n) * eh_rho(j,p,nS+n) + + dem1 = eQP(a) - eQP(i) + eh_Om(n) + dem2 = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + + end do ! j + !3p2h + do b=nO+1,nOrb-nR + num = (ERI(p,i,b,a) - ERI(p,i,a,b)) * eh_rho(p,b,n) * eh_rho(a,i,n) !& + !- ERI(p,i,a,b) * eh_rho(i,a,nS+n) * eh_rho(b,p,nS+n) + + dem1 = eQP(p) - eQP(b) - eh_Om(n) + dem2 = eQP(p) - eQP(b) - eQP(a) + eQP(i) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) & + - num * (reg1/dem1/dem1) * (reg2/dem2) + + num = - (ERI(p,a,b,i) - ERI(p,a,i,b)) * eh_rho(p,b,n) * eh_rho(i,a,n) !& + !+ ERI(p,a,i,b) * eh_rho(a,i,nS+n) * eh_rho(b,p,nS+n) + + dem1 = eQP(a) - eQP(i) + eh_Om(n) + dem2 = eQP(p) - eQP(b) - eh_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = - (ERI(p,i,b,a) - ERI(p,i,a,b)) * eh_rho(p,b,nS+n) * eh_rho(a,i,nS+n) !& + !+ ERI(p,i,a,b) * eh_rho(i,a,n) * eh_rho(b,p,n) + + dem1 = eQP(a) - eQP(i) + eh_Om(n) + dem2 = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! b + + end do ! n + + end do ! a + end do ! i + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building eh self-energy =',t,' seconds' + write(*,*) + +!-----------------------------! +! pp part of the self-energy ! +!-----------------------------! + + call wall_time(start_t) + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,i,j,k,c,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nOO,nVV,eta,ERI,eQP,ee_rho,ee_Om,hh_rho,hh_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + + do i=nC+1,nO + do j=nC+1,nO + do n=1,nVV + ! 4h1p + do k=nC+1,nO + num = - ERI(p,k,i,j) * ee_rho(i,j,n) * ee_rho(p,k,n) + dem1 = ee_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(k) - ee_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! k + ! 3h2p + do c=nO+1,nOrb-nR + + num = - ERI(p,c,i,j) * ee_rho(i,j,n) * ee_rho(p,c,n) + dem1 = ee_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! a + end do ! n + do n=1,nOO + ! 3h2p + do c=nO+1,nOrb-nR + + num = - ERI(p,c,i,j) * hh_rho(i,j,n) * hh_rho(p,c,n) + dem1 = eQP(p) + eQP(c) - hh_Om(n) + dem2 = eQP(p) + eQP(c) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) & + - num * (reg1/dem1/dem1) * (reg2/dem2) + + end do ! c + end do ! n + end do ! j + end do ! i + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,k,a,b,c,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nOO,nVV,eta,ERI,eQP,ee_rho,ee_Om,hh_rho,hh_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + do a=nO+1,nOrb-nR + do b=nO+1,nOrb-nR + do n=1,nOO + ! 4p1h + do c=nO+1,nOrb-nR + + num = ERI(p,c,a,b) * hh_rho(a,b,n) * hh_rho(p,c,n) + dem1 = hh_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(c) - hh_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + ! 3p2h + do k=nC+1,nO + + num = ERI(p,k,a,b) * hh_rho(a,b,n) * hh_rho(p,k,n) + dem1 = hh_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! k + end do ! n + do n=1,nVV + ! 3p2h + do k=nC+1,nO + + num = ERI(p,k,a,b) * ee_rho(a,b,n) * ee_rho(p,k,n) + dem1 = eQP(p) + eQP(k) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - ee_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) & + - num * (reg1/dem1/dem1) * (reg2/dem2) + + end do ! c + end do ! n + end do ! b + end do ! a + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building pp self-energy =',t,' seconds' + write(*,*) + +!-----------------------------! +! Renormalization factor ! +!-----------------------------! + + Z(:) = 1d0/(1d0 - Z(:)) + +!-------------------------------------! +! Galitskii-Migdal correlation energy ! +!-------------------------------------! + + EcGM = 0d0 + +end subroutine diff --git a/src/Parquet/G_eh_Gam.f90 b/src/Parquet/G_eh_Gam.f90 new file mode 100644 index 0000000..7fe751f --- /dev/null +++ b/src/Parquet/G_eh_Gam.f90 @@ -0,0 +1,77 @@ +subroutine G_eh_Gamma_A(nOrb,nC,nO,nR,nS,eh_Phi,pp_Phi,eh_Gam_A) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,a,j,b + integer :: ia,jb + +! Output variables + double precision, intent(out) :: eh_Gam_A(nS,nS) + +! Initialization + eh_Gam_A(:,:) = 0d0 + + ia = 0 + do i=nC+1,nO + do a=nO+1,nOrb-nR + ia = ia + 1 + + jb = 0 + do j=nC+1,nO + do b=nO+1,norb-nR + jb = jb + 1 + + eh_Gam_A(ia,jb) = - eh_Phi(a,j,b,i) + pp_Phi(a,j,i,b) + + enddo + enddo + enddo + enddo + +end subroutine + +subroutine G_eh_Gamma_B(nOrb,nC,nO,nR,nS,eh_Phi,pp_Phi,eh_Gam_B) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,a,j,b + integer :: ia,jb + +! Output variables + double precision, intent(out) :: eh_Gam_B(nS,nS) + +! Initialization + eh_Gam_B(:,:) = 0d0 + + ia = 0 + do i=nC+1,nO + do a=nO+1,nOrb-nR + ia = ia + 1 + + jb = 0 + do j=nC+1,nO + do b=nO+1,norb-nR + jb = jb + 1 + + eh_Gam_B(ia,jb) = - eh_Phi(a,b,j,i) + pp_Phi(a,b,i,j) + + enddo + enddo + enddo + enddo + +end subroutine diff --git a/src/Parquet/G_eh_Phi.f90 b/src/Parquet/G_eh_Phi.f90 new file mode 100644 index 0000000..d4b2709 --- /dev/null +++ b/src/Parquet/G_eh_Phi.f90 @@ -0,0 +1,43 @@ +subroutine G_eh_Phi(nOrb,nC,nR,nS,eh_Om,eh_rho,eh_Phi) + +! Compute irreducible vertex in the eh channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nR,nS + double precision,intent(in) :: eh_Om(nS) + double precision,intent(in) :: eh_rho(nOrb,nOrb,nS+nS) + +! Local variables + integer :: p,q,r,s + integer :: n + +! Output variables + double precision, intent(out) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + +! Initialization + eh_Phi(:,:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nS, eh_Phi, eh_rho, eh_Om) + !$OMP DO COLLAPSE(2) + do s = nC+1, nOrb-nR + do r = nC+1, nOrb-nR + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + do n=1,nS + eh_Phi(p,q,r,s) = eh_Phi(p,q,r,s) & + - eh_rho(r,p,n)*eh_rho(q,s,n)/eh_Om(n) & + - eh_rho(r,p,nS+n)*eh_rho(q,s,nS+n)/eh_Om(n) + end do + + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/G_pp_Gam.f90 b/src/Parquet/G_pp_Gam.f90 new file mode 100644 index 0000000..03d99f8 --- /dev/null +++ b/src/Parquet/G_pp_Gam.f90 @@ -0,0 +1,134 @@ +subroutine G_pp_Gamma_D(nOrb,nC,nO,nOO,eh_Phi,pp_Gam_D) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nOO + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,j,k,l + integer :: ij,kl + +! Output variables + double precision, intent(out) :: pp_Gam_D(nOO,nOO) + +! Initialization + pp_Gam_D(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(a, b, ab, i, j, ij, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_trip_Gam_B, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ij = 0 + do i=nC+1,nO + do j=i+1,nO + ij = ij + 1 + + kl = 0 + do k=nC+1,nO + do l=k+1,nO + kl = kl +1 + + pp_Gam_D(ij,kl) = eh_Phi(i,j,k,l) - eh_Phi(i,j,l,k) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + +subroutine G_pp_Gamma_C(nOrb,nO,nR,nVV,eh_Phi,pp_Gam_C) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nO,nR,nVV + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: a,b,c,d + integer :: ab,cd + +! Output variables + double precision, intent(out) :: pp_Gam_C(nVV,nVV) + +! Initialization + pp_Gam_C(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(a, b, ab, i, j, ij, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_trip_Gam_B, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ab = 0 + do a=nO+1,nOrb - nR + do b=a+1,nOrb - nR + ab = ab + 1 + + cd = 0 + do c=nO+1,nOrb - nR + do d=c+1,nOrb - nR + cd = cd +1 + + pp_Gam_C(ab,cd) = eh_Phi(a,b,c,d) - eh_Phi(a,b,d,c) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + +subroutine G_pp_Gamma_B(nOrb,nC,nO,nR,nOO,nVV,eh_Phi,pp_Gam_B) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nOO,nVV + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: a,b,i,j + integer :: ab,ij + +! Output variables + double precision, intent(out) :: pp_Gam_B(nVV,nOO) + +! Initialization + pp_Gam_B(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(a, b, ab, i, j, ij, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_trip_Gam_B, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ab = 0 + do a=nO+1,nOrb - nR + do b=a+1,nOrb - nR + ab = ab + 1 + + ij = 0 + do i=nC+1,nO + do j=i+1,nO + ij = ij + 1 + + pp_Gam_B(ab,ij) = eh_Phi(a,b,i,j) - eh_Phi(a,b,j,i) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/G_pp_Phi.f90 b/src/Parquet/G_pp_Phi.f90 new file mode 100644 index 0000000..1fcb813 --- /dev/null +++ b/src/Parquet/G_pp_Phi.f90 @@ -0,0 +1,49 @@ +subroutine G_pp_Phi(nOrb,nC,nR,nOO,nVV,ee_Om,ee_rho,hh_Om,hh_rho,pp_Phi) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nR,nOO,nVV + double precision,intent(in) :: ee_Om(nVV) + double precision,intent(in) :: ee_rho(nOrb,nOrb,nVV) + double precision,intent(in) :: hh_Om(nOO) + double precision,intent(in) :: hh_rho(nOrb,nOrb,nOO) + +! Local variables + integer :: p,q,r,s + integer :: n + +! Output variables + double precision, intent(out) :: pp_Phi(nOrb,nOrb,nOrb,nOrb) + +! Initialization + pp_Phi(:,:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nVV, nOO, pp_Phi, ee_rho, ee_Om, hh_rho, hh_Om) + !$OMP DO COLLAPSE(2) + do s = nC+1, nOrb-nR + do r = nC+1, nOrb-nR + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + do n=1,nVV + pp_Phi(p,q,r,s) = pp_Phi(p,q,r,s) & + - ee_rho(p,q,n)*ee_rho(r,s,n)/ee_Om(n) + end do + + do n=1,nOO + pp_Phi(p,q,r,s) = pp_Phi(p,q,r,s) & + + hh_rho(p,q,n)*hh_rho(r,s,n)/hh_Om(n) + end do + + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/G_print_parquet_1b.f90 b/src/Parquet/G_print_parquet_1b.f90 new file mode 100644 index 0000000..ef71712 --- /dev/null +++ b/src/Parquet/G_print_parquet_1b.f90 @@ -0,0 +1,64 @@ +subroutine G_print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,EGHF,EcGM,Ec_eh,Ec_pp) + +! Print one-electron energies and other stuff for G0F2 + + implicit none + include 'parameters.h' + + integer,intent(in) :: nOrb + integer,intent(in) :: nO + double precision,intent(in) :: eHF(nOrb) + double precision,intent(in) :: SigC(nOrb) + double precision,intent(in) :: eQP(nOrb) + double precision,intent(in) :: Z(nOrb) + integer,intent(in) :: n_it_1b + double precision,intent(in) :: err_1b + double precision,intent(in) :: ENuc + double precision,intent(in) :: EGHF + double precision,intent(in) :: EcGM + double precision,intent(in) :: Ec_eh + double precision,intent(in) :: Ec_pp + + integer :: p + integer :: HOMO + integer :: LUMO + double precision :: Gap + +! HOMO and LUMO + + HOMO = nO + LUMO = HOMO + 1 + Gap = eQP(LUMO) - eQP(HOMO) + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------' + write(*,*)' Parquet self-energy ' + 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)','|','Sig_c (eV)','|','Z','|','e_QP (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,'|',eHF(p)*HaToeV,'|',SigC(p)*HaToeV,'|',Z(p),'|',eQP(p)*HaToeV,'|' + end do + + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,I15)') 'One-body iteration # ',n_it_1b + write(*,'(2X,A60,F15.6)') 'One-body convergence ',err_1b + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,F15.6,A3)') 'Parquet HOMO energy = ',eQP(HOMO)*HaToeV,' eV' + write(*,'(2X,A60,F15.6,A3)') 'Parquet LUMO energy = ',eQP(LUMO)*HaToeV,' eV' + write(*,'(2X,A60,F15.6,A3)') 'Parquet HOMO-LUMO gap = ',Gap*HaToeV,' eV' + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,F15.6,A3)') ' Parquet total energy = ',ENuc + EGHF + EcGM,' au' + write(*,'(2X,A60,F15.6,A3)') ' Parquet correlation energy = ',EcGM,' au' + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,F15.6,A3)') ' eh-RPA correlation energy = ',Ec_eh,' au' + write(*,'(2X,A60,F15.6,A3)') ' pp-RPA correlation energy = ',Ec_pp,' au' + !write(*,'(2X,A60,F15.6,A3)') '(eh+pp)-RPA correlation energy = ',Ec_pp,' au' + write(*,*)'-------------------------------------------------------------------------------' + write(*,*) + +end subroutine diff --git a/src/Parquet/G_screened_integrals.f90 b/src/Parquet/G_screened_integrals.f90 new file mode 100644 index 0000000..efeb6e8 --- /dev/null +++ b/src/Parquet/G_screened_integrals.f90 @@ -0,0 +1,170 @@ +subroutine G_eh_screened_integral(nOrb,nC,nO,nR,nS,ERI,eh_Phi,pp_Phi,XpY,XmY,rho) + +! Compute excitation densities + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: XpY(nS,nS),XmY(nS,nS) + +! Local variables + integer :: ia,jb,p,q,j,b + double precision :: X,Y + +! Output variables + double precision,intent(out) :: rho(nOrb,nOrb,nS+nS) + + rho(:,:,:) = 0d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(q,p,j,b,jb,ia,X,Y) & + !$OMP SHARED(nC,nOrb,nR,nO,nS,rho,ERI,XpY,XmY,eh_Phi,pp_Phi) + !$OMP DO + do q=nC+1,nOrb-nR + do p=nC+1,nOrb-nR + + do ia=1,nS + + jb = 0 + do j=nC+1,nO + do b=nO+1,nOrb-nR + jb = jb + 1 + + X = 0.5d0*(XpY(ia,jb) + XmY(ia,jb)) + Y = 0.5d0*(XpY(ia,jb) - XmY(ia,jb)) + + rho(p,q,ia) = rho(p,q,ia) & + + (ERI(q,j,p,b) - ERI(q,j,b,p)) * X & + !- (eh_Phi(q,j,b,p) + pp_Phi(q,j,p,b)) * X & + + (ERI(q,b,p,j) - ERI(q,b,j,p)) * Y !& + !- (eh_Phi(q,b,j,p) + pp_Phi(q,b,p,j)) * Y + + rho(p,q,nS+ia) = rho(p,q,nS+ia) & + + (ERI(q,j,p,b) - ERI(q,b,j,p)) * X & + !- (eh_Phi(q,j,b,p) + pp_Phi(q,j,p,b)) * X & + + (ERI(q,b,p,j) - ERI(q,j,b,p)) * Y !& + !- (eh_Phi(q,b,j,p) + pp_Phi(q,b,p,j)) * Y + + end do + end do + + end do + + end do + end do + !$OMP END DO + !$OMP END PARALLEL + +end subroutine + +subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2,Y2,rho2) + +! Compute excitation densities in the singlet pp channel + + implicit none + +! Input variables + + integer,intent(in) :: nOrb,nC,nO,nR + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_Phi(nOrb,nOrb,nOrb,nOrb) + integer,intent(in) :: nOO + integer,intent(in) :: nVV + double precision,intent(in) :: X1(nVV,nVV) + double precision,intent(in) :: Y1(nOO,nVV) + double precision,intent(in) :: X2(nVV,nOO) + double precision,intent(in) :: Y2(nOO,nOO) + +! Local variables + + integer :: i,j,k,l + integer :: a,b,c,d + integer :: p,q + integer :: ab,cd,ij,kl + +! Output variables + + double precision,intent(out) :: rho1(nOrb,nOrb,nVV) + double precision,intent(out) :: rho2(nOrb,nOrb,nOO) + + integer :: dim_1, dim_2 + +! Initialization + + rho1(:,:,:) = 0d0 + rho2(:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) & + !$OMP SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, eh_Phi, X1, Y1, X2, Y2) + !$OMP DO COLLAPSE(2) + do q=nC+1,nOrb-nR + do p=nC+1,nOrb-nR + + ab = 0 + do a=nO+1,nOrb-nR + do b=a+1,nOrb-nR + ab = ab + 1 + + cd = 0 + do c=nO+1,nOrb-nR + do d=c+1,nOrb-nR + cd = cd + 1 + + rho1(p,q,ab) = rho1(p,q,ab) + ( ERI(p,q,c,d) - ERI(p,q,d,c)) * X1(cd,ab)! & + !+ (eh_Phi(p,q,c,d) - eh_Phi(p,q,d,c) ) * X1(cd,ab) + + end do + end do + + kl = 0 + do k=nC+1,nO + do l=k+1,nO + kl = kl + 1 + + rho1(p,q,ab) = rho1(p,q,ab) + ( ERI(p,q,k,l) - ERI(p,q,l,k))* Y1(kl,ab) !& + !+ (eh_Phi(p,q,k,l) - eh_Phi(p,q,l,k) ) * Y1(kl,ab) + + end do + end do + + end do + end do + + ij = 0 + do i=nC+1,nO + do j=i+1,nO + ij = ij + 1 + + cd = 0 + do c=nO+1,nOrb-nR + do d=c+1,nOrb-nR + cd = cd + 1 + + rho2(p,q,ij) = rho2(p,q,ij) + ( ERI(p,q,c,d) - ERI(p,q,d,c)) * X2(cd,ij) !& + !+ ( eh_Phi(p,q,c,d) - eh_Phi(p,q,d,c) ) * X2(cd,ij) + + end do + end do + + kl = 0 + do k=nC+1,nO + do l=k+1,nO + kl = kl + 1 + + rho2(p,q,ij) = rho2(p,q,ij) + ( ERI(p,q,k,l) - ERI(p,q,l,k)) * Y2(kl,ij) !& + !+ ( eh_Phi(p,q,k,l) - eh_Phi(p,q,l,k) ) * Y2(kl,ij) + + end do + end do + end do + end do + + end do + end do + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/README.md b/src/Parquet/README.md new file mode 100644 index 0000000..ee1ef1e --- /dev/null +++ b/src/Parquet/README.md @@ -0,0 +1,43 @@ +# Overview of the Parquet implementation + +## Parameters controling the run + +The parameters provided by the user are: +- `max_it_macro` and `max_it_micro` which set the maximum number of iterations of the macro (one-body) and micro (two-body) self-consistent cycles. +- `conv_one_body` and `conv_two_body` which set the convergence threshold of the macro (one-body) and micro (two-body) self-consistent cycles. + +The hard-coded parameters are: +- `linearize` which control whether the quasiparticle equation will be linearized or not. Note that the Newton-Raphson has not been implemented yet. +- `TDA` which control whether the Tamm-Dancoff approximation is enforced for the BSE problems or not. +- `print_phLR` and `print_ppLR` control the print of eigenvalues at each diagonalization. +- + +## Files and their routines + +- `RParquet.f90` is the main file for the restricted Parquet calculation, it is called by `RQuack.f90`. The main task of this file is to control the self-consistent cycles. +- `R_screened_integrals.f90` gathers four subroutines, each one dedicated to the computation of screened integrals in a given channel. +- There are four files dedicated to computed effective interactions in a each channel. For example, `R_eh_singlet_Gam.f90` contains three subroutines: one for the OVOV block, one for the VOVO block and one for the full $N^4$ tensor. + +## TODO list + +### Check +- [x] Initial ppRPA@HF eigenvalues checked with Ne DIP in Table 1 of ppBSE paper +- [ ] Comment m,s,t channels and perform ehBSE@$GW$ and ppBSE@$GW$ +- [ ] Comment d,m channels and perform ehBSE@$GT$ and ppBSE@$GT$ + +### Required + +- [ ] Implement diagonal self-energy +- [ ] Implement screened integrals in every channels + +### Improvement + +- [ ] OpenMP pp Gamma +- [ ] OpenMP eh Gamma +- [ ] DGEMM pp Gamma +- [ ] DGEMM eh Gamma + +### Long-term + +- [ ] Implement Newton-Raphson solution of the quasiparticle equation +- [ ] Implement Galitskii-Migdal self-energy diff --git a/src/Parquet/RParquet.f90 b/src/Parquet/RParquet.f90 new file mode 100644 index 0000000..d7742cb --- /dev/null +++ b/src/Parquet/RParquet.f90 @@ -0,0 +1,786 @@ +subroutine RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_it_1b,conv_1b,max_it_2b,conv_2b, & + nOrb,nC,nO,nV,nR,nS,ERHF,eHF,ERI) + +! Parquet approximation based on restricted orbitals + + implicit none + include 'parameters.h' + +! Hard-coded parameters + + logical :: print_phLR = .true. + logical :: print_ppLR = .true. + +! Input variables + + logical,intent(in) :: TDAeh + logical,intent(in) :: TDApp + integer,intent(in) :: max_diis_1b + integer,intent(in) :: max_diis_2b + logical,intent(in) :: linearize + double precision,intent(in) :: eta + double precision,intent(in) :: ENuc + double precision,intent(in) :: ERHF + integer,intent(in) :: max_it_1b,max_it_2b + double precision,intent(in) :: conv_1b,conv_2b + integer,intent(in) :: nOrb,nC,nO,nV,nR,nS + double precision,intent(in) :: eHF(nOrb) + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + +! Local variables + + integer :: ispin + + integer :: n_it_1b,n_it_2b + double precision :: err_1b,err_2b + double precision :: err_eig_eh_sing,err_eig_eh_trip + double precision :: err_eig_hh_sing,err_eig_hh_trip + double precision :: err_eig_ee_sing,err_eig_ee_trip + double precision :: err_eh_sing, err_eh_trip + double precision :: err_pp_sing, err_pp_trip + double precision :: start_t, end_t, t + double precision :: start_1b, end_1b, t_1b + double precision :: start_2b, end_2b, t_2b + + integer :: nOOs,nOOt + integer :: nVVs,nVVt + + ! eh BSE + double precision :: Ec_eh(nspin) + double precision,allocatable :: Aph(:,:), Bph(:,:) + double precision,allocatable :: sing_XpY(:,:),trip_XpY(:,:) + double precision,allocatable :: sing_XmY(:,:),trip_XmY(:,:) + double precision,allocatable :: eh_sing_Om(:), old_eh_sing_Om(:) + double precision,allocatable :: eh_trip_Om(:), old_eh_trip_Om(:) + double precision,allocatable :: eh_sing_Gam_A(:,:),eh_sing_Gam_B(:,:) + double precision,allocatable :: eh_trip_Gam_A(:,:),eh_trip_Gam_B(:,:) + + ! pp BSE + double precision :: Ec_pp(nspin) + double precision,allocatable :: Bpp(:,:), Cpp(:,:), Dpp(:,:) + double precision,allocatable :: X1s(:,:),X1t(:,:) + double precision,allocatable :: Y1s(:,:),Y1t(:,:) + double precision,allocatable :: ee_sing_Om(:), old_ee_sing_Om(:) + double precision,allocatable :: ee_trip_Om(:), old_ee_trip_Om(:) + double precision,allocatable :: X2s(:,:),X2t(:,:) + double precision,allocatable :: Y2s(:,:),Y2t(:,:) + double precision,allocatable :: hh_sing_Om(:), old_hh_sing_Om(:) + double precision,allocatable :: hh_trip_Om(:), old_hh_trip_Om(:) + double precision,allocatable :: pp_sing_Gam_B(:,:),pp_sing_Gam_C(:,:),pp_sing_Gam_D(:,:) + double precision,allocatable :: pp_trip_Gam_B(:,:),pp_trip_Gam_C(:,:),pp_trip_Gam_D(:,:) + ! Effective integrals + double precision,allocatable :: eh_sing_rho(:,:,:),eh_trip_rho(:,:,:) + double precision,allocatable :: ee_sing_rho(:,:,:),hh_sing_rho(:,:,:) + double precision,allocatable :: ee_trip_rho(:,:,:),hh_trip_rho(:,:,:) + ! Reducible kernels + double precision,allocatable :: eh_sing_Phi(:,:,:,:), eh_trip_Phi(:,:,:,:) + double precision,allocatable :: old_eh_sing_Phi(:,:,:,:), old_eh_trip_Phi(:,:,:,:) + double precision,allocatable :: pp_sing_Phi(:,:,:,:), pp_trip_Phi(:,:,:,:) + double precision,allocatable :: old_pp_sing_Phi(:,:,:,:), old_pp_trip_Phi(:,:,:,:) + ! One-body quantities + double precision,allocatable :: eQPlin(:),eQP(:),eOld(:) + double precision,allocatable :: SigC(:) + double precision,allocatable :: Z(:) + double precision :: EcGM + + double precision :: mem = 0d0 + double precision :: dp_in_GB = 8d0/(1024d0**3) + +! DIIS + integer :: n_diis_1b,n_diis_2b + double precision :: rcond_1b,rcond_2b + double precision,allocatable :: err_diis_1b(:,:) + double precision,allocatable :: eQP_diis(:,:) + +! Output variables +! None + +! Useful parameters + + nOOs = nO*(nO + 1)/2 + nVVs = nV*(nV + 1)/2 + nOOt = nO*(nO - 1)/2 + nVVt = nV*(nV - 1)/2 + + allocate(eQP(nOrb),eOld(nOrb)) + + mem = mem + size(eQP) + size(eOld) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet = ',mem*dp_in_GB,' GB' + + write(*,*) + write(*,*)'**********************************' + write(*,*)'* Restricted Parquet Calculation *' + write(*,*)'**********************************' + write(*,*) + +! Print parameters + + write(*,*)'---------------------------------------------------------------' + write(*,*)' Parquet parameters for one-body and two-body self-consistency ' + write(*,*)'---------------------------------------------------------------' + write(*,'(1X,A50,1X,I5)') 'Maximum number of one-body iteration:',max_it_1b + write(*,'(1X,A50,1X,E10.5)') 'Convergence threshold for one-body energies:',conv_1b + write(*,'(1X,A50,1X,L5)') 'Linearization of quasiparticle equation?',conv_1b + write(*,'(1X,A50,1X,E10.5)') 'Strenght of SRG regularization:',eta + write(*,'(1X,A50,1X,I5)') 'Maximum length of DIIS expansion:',max_diis_1b + write(*,*)'---------------------------------------------------------------' + write(*,'(1X,A50,1X,I5)') 'Maximum number of two-body iteration:',max_it_2b + write(*,'(1X,A50,1X,E10.5)') 'Convergence threshold for two-body energies:',conv_2b + write(*,'(1X,A50,1X,L5)') 'TDA for eh excitation energies?',TDAeh + write(*,'(1X,A50,1X,L5)') 'TDA for pp excitation energies?',TDApp + write(*,'(1X,A50,1X,I5)') 'Maximum length of DIIS expansion:',max_diis_2b + write(*,*)'---------------------------------------------------------------' + write(*,*) + +! Memory allocation + + allocate(old_eh_sing_Om(nS),old_eh_trip_Om(nS)) + allocate(old_ee_sing_Om(nVVs),old_hh_sing_Om(nOOs)) + allocate(old_ee_trip_Om(nVVt),old_hh_trip_Om(nOOt)) + allocate(eh_sing_rho(nOrb,nOrb,nS),eh_trip_rho(nOrb,nOrb,nS)) + allocate(ee_sing_rho(nOrb,nOrb,nVVs),hh_sing_rho(nOrb,nOrb,nOOs)) + allocate(ee_trip_rho(nOrb,nOrb,nVVt),hh_trip_rho(nOrb,nOrb,nOOt)) + allocate(old_eh_sing_Phi(nOrb,nOrb,nOrb,nOrb),old_eh_trip_Phi(nOrb,nOrb,nOrb,nOrb)) + allocate(old_pp_sing_Phi(nOrb,nOrb,nOrb,nOrb),old_pp_trip_Phi(nOrb,nOrb,nOrb,nOrb)) + +! Memory usage + + mem = mem + size(old_eh_sing_Om) + size(old_eh_trip_Om) & + + size(old_ee_sing_Om) + size(old_hh_sing_Om) & + + size(old_ee_trip_Om) + size(old_hh_trip_Om) & + + size(eh_sing_rho) + size(eh_trip_rho) & + + size(ee_sing_rho) + size(hh_sing_rho) & + + size(ee_trip_rho) + size(hh_trip_rho) & + + size(old_eh_sing_Phi) + size(old_eh_trip_Phi) & + + size(old_pp_sing_Phi) + size(old_pp_trip_Phi) + + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet = ',mem*dp_in_GB,' GB' + +! DIIS for one-body part + + allocate(err_diis_1b(nOrb,max_diis_1b),eQP_diis(nOrb,max_diis_1b)) + + mem = mem + size(err_diis_1b) + size(eQP_diis) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet = ',mem*dp_in_GB,' GB' + + rcond_1b = 1d0 + n_diis_1b = 0 + err_diis_1b(:,:) = 0d0 + eQP_diis(:,:) = 0d0 + +! Initialization + + n_it_1b = 0 + err_1b = 1d0 + + eQP(:) = eHF(:) + eOld(:) = eHF(:) + + eh_sing_rho(:,:,:) = 0d0 + eh_trip_rho(:,:,:) = 0d0 + ee_sing_rho(:,:,:) = 0d0 + ee_trip_rho(:,:,:) = 0d0 + hh_sing_rho(:,:,:) = 0d0 + hh_trip_rho(:,:,:) = 0d0 + + old_eh_sing_Om(:) = 0d0 + old_eh_trip_Om(:) = 0d0 + old_ee_sing_Om(:) = 0d0 + old_ee_trip_Om(:) = 0d0 + old_hh_sing_Om(:) = 0d0 + old_hh_trip_Om(:) = 0d0 + + old_eh_sing_Phi(:,:,:,:) = 0d0 + old_eh_trip_Phi(:,:,:,:) = 0d0 + old_pp_sing_Phi(:,:,:,:) = 0d0 + old_pp_trip_Phi(:,:,:,:) = 0d0 + + !-----------------------------------------! + ! Main loop for one-body self-consistency ! + !-----------------------------------------! + + do while(err_1b > conv_1b .and. n_it_1b < max_it_1b) + + n_it_1b = n_it_1b + 1 + call wall_time(start_1b) + + write(*,*) + write(*,*)'=====================================' + write(*,'(1X,A30,1X,I4)') 'One-body iteration #',n_it_1b + write(*,*)'=====================================' + write(*,*) + + ! DIIS for two-body part + + rcond_2b = 0d0 + n_diis_2b = 0 + + ! Initialization + + n_it_2b = 0 + err_2b = 1d0 + + !-----------------------------------------! + ! Main loop for two-body self-consistency ! + !-----------------------------------------! + + do while(err_2b > conv_2b .and. n_it_2b < max_it_2b) + + n_it_2b = n_it_2b + 1 + call wall_time(start_2b) + + write(*,*)' ***********************************' + write(*,'(1X,A30,1X,I4)') 'Two-body iteration #',n_it_2b + write(*,*)' ***********************************' + write(*,*) + + !-----------------! + ! Density channel ! + !-----------------! + + write(*,*) 'Diagonalizing singlet ehBSE problem (density channel)...' + + allocate(Aph(nS,nS),Bph(nS,nS),eh_sing_Om(nS),sing_XpY(nS,nS),sing_XmY(nS,nS),eh_sing_Gam_A(nS,nS),eh_sing_Gam_B(nS,nS)) + + mem = mem + size(Aph) + size(Bph) & + + size(eh_sing_Om) + size(sing_XpY) & + + size(sing_XmY) + size(eh_sing_Gam_A) + size(eh_sing_Gam_B) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet =',mem*dp_in_GB,' GB' + + ispin = 1 + Aph(:,:) = 0d0 + Bph(:,:) = 0d0 + + call wall_time(start_t) + + call phRLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,eOld,ERI,Aph) + if(.not.TDAeh) call phRLR_B(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) + + if(n_it_1b == 1 .and. n_it_2b == 1) then + + eh_sing_Gam_A(:,:) = 0d0 + eh_sing_Gam_B(:,:) = 0d0 + + else + + call R_eh_singlet_Gamma_A(nOrb,nC,nO,nR,nS, & + old_eh_sing_Phi,old_eh_trip_Phi,old_pp_sing_Phi,old_pp_trip_Phi, & + eh_sing_Gam_A) + + if(.not.TDAeh) call R_eh_singlet_Gamma_B(nOrb,nC,nO,nR,nS, & + old_eh_sing_Phi,old_eh_trip_Phi,old_pp_sing_Phi,old_pp_trip_Phi, & + eh_sing_Gam_B) + + end if + + Aph(:,:) = Aph(:,:) + eh_sing_Gam_A(:,:) + Bph(:,:) = Bph(:,:) + eh_sing_Gam_B(:,:) + + + call phRLR(TDAeh,nS,Aph,Bph,Ec_eh(ispin),eh_sing_Om,sing_XpY,sing_XmY) + + call wall_time(end_t) + + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet phBSE problem =',t,' seconds' + write(*,*) + + if(print_phLR) call print_excitation_energies('phBSE@Parquet','singlet',nS,eh_sing_Om) + + err_eig_eh_sing = maxval(abs(old_eh_sing_Om - eh_sing_Om)) + + deallocate(Aph,Bph,eh_sing_Gam_A,eh_sing_Gam_B) + + mem = mem - size(Aph) - size(Bph) - size(eh_sing_Gam_A) - size(eh_sing_Gam_B) + + !------------------! + ! Magnetic channel ! + !------------------! + + write(*,*) 'Diagonalizing triplet ehBSE problem (magnetic channel)...' + + allocate(Aph(nS,nS),Bph(nS,nS),eh_trip_Om(nS),trip_XpY(nS,nS),trip_XmY(nS,nS),eh_trip_Gam_A(nS,nS),eh_trip_Gam_B(nS,nS)) + + mem = mem + size(Aph) + size(Bph) & + + size(eh_trip_Om) + size(trip_XpY) + size(trip_XmY) & + + size(eh_trip_Gam_A) + size(eh_trip_Gam_B) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet =',mem*dp_in_GB,' GB' + + ispin = 2 + Aph(:,:) = 0d0 + Bph(:,:) = 0d0 + + call wall_time(start_t) + + call phRLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,eOld,ERI,Aph) + if(.not.TDAeh) call phRLR_B(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) + + if(n_it_1b == 1 .and. n_it_2b == 1) then + + eh_trip_Gam_A(:,:) = 0d0 + eh_trip_Gam_B(:,:) = 0d0 + + else + + call R_eh_triplet_Gamma_A(nOrb,nC,nO,nR,nS, & + old_eh_sing_Phi,old_eh_trip_Phi,old_pp_sing_Phi,old_pp_trip_Phi, & + eh_trip_Gam_A) + + if(.not.TDAeh) call R_eh_triplet_Gamma_B(nOrb,nC,nO,nR,nS, & + old_eh_sing_Phi,old_eh_trip_Phi,old_pp_sing_Phi,old_pp_trip_Phi, & + eh_trip_Gam_B) + + end if + + Aph(:,:) = Aph(:,:) + eh_trip_Gam_A(:,:) + Bph(:,:) = Bph(:,:) + eh_trip_Gam_B(:,:) + + call phRLR(TDAeh,nS,Aph,Bph,Ec_eh(ispin),eh_trip_Om,trip_XpY,trip_XmY) + + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet phBSE problem =',t,' seconds' + write(*,*) + + if(print_phLR) call print_excitation_energies('phBSE@Parquet','triplet',nS,eh_trip_Om) + + err_eig_eh_trip = maxval(abs(old_eh_trip_Om - eh_trip_Om)) + + deallocate(Aph,Bph,eh_trip_Gam_A,eh_trip_Gam_B) + + mem = mem - size(Aph) - size(Bph) - size(eh_trip_Gam_A) - size(eh_trip_Gam_B) + + !-----------------! + ! Singlet channel ! + !-----------------! + + write(*,*) 'Diagonalizing singlet ppBSE problem (singlet channel)...' + + allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs), & + ee_sing_Om(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), & + hh_sing_Om(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), & + pp_sing_Gam_B(nVVs,nOOs),pp_sing_Gam_C(nVVs,nVVs),pp_sing_Gam_D(nOOs,nOOs)) + + mem = mem + size(Bpp) + size(Cpp) + size(Dpp) & + + size(ee_sing_Om) + size(X1s) + size(Y1s) & + + size(hh_sing_Om) + size(X2s) + size(Y2s) & + + size(pp_sing_Gam_B) + size(pp_sing_Gam_C) + size(pp_sing_Gam_D) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet =',mem*dp_in_GB,' GB' + + + ispin = 1 + Bpp(:,:) = 0d0 + Cpp(:,:) = 0d0 + Dpp(:,:) = 0d0 + + call wall_time(start_t) + if(.not.TDApp) call ppRLR_B(ispin,nOrb,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp) + call ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVVs,1d0,eOld,ERI,Cpp) + call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOs,1d0,eOld,ERI,Dpp) + + if(n_it_1b == 1 .and. n_it_2b == 1) then + + pp_sing_Gam_B(:,:) = 0d0 + pp_sing_Gam_C(:,:) = 0d0 + pp_sing_Gam_D(:,:) = 0d0 + + else + + if(.not.TDApp) call R_pp_singlet_Gamma_B(nOrb,nC,nO,nR,nOOs,nVVs,old_eh_sing_Phi,old_eh_trip_Phi,pp_sing_Gam_B) + call R_pp_singlet_Gamma_C(nOrb,nO,nR,nVVs,old_eh_sing_Phi,old_eh_trip_Phi,pp_sing_Gam_C) + call R_pp_singlet_Gamma_D(nOrb,nC,nO,nOOs,old_eh_sing_Phi,old_eh_trip_Phi,pp_sing_Gam_D) + + end if + + Bpp(:,:) = Bpp(:,:) + pp_sing_Gam_B(:,:) + Cpp(:,:) = Cpp(:,:) + pp_sing_Gam_C(:,:) + Dpp(:,:) = Dpp(:,:) + pp_sing_Gam_D(:,:) + + + call ppRLR(TDApp,nOOs,nVVs,Bpp,Cpp,Dpp,ee_sing_Om,X1s,Y1s,hh_sing_Om,X2s,Y2s,Ec_pp(ispin)) + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet ppBSE =',t,' seconds' + call wall_time(start_t) + + if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2p (singlets)',nVVs,ee_sing_Om) + if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2h (singlets)',nOOs,hh_sing_Om) + + err_eig_ee_sing = maxval(abs(old_ee_sing_Om - ee_sing_Om)) + err_eig_hh_sing = maxval(abs(old_hh_sing_Om - hh_sing_Om)) + + deallocate(Bpp,Cpp,Dpp,pp_sing_Gam_B,pp_sing_Gam_C,pp_sing_Gam_D) + + mem = mem - size(Bpp) - size(Cpp) - size(Dpp) & + - size(pp_sing_Gam_B) - size(pp_sing_Gam_C) - size(pp_sing_Gam_D) + + !-----------------! + ! Triplet channel ! + !-----------------! + + write(*,*) 'Diagonalizing triplet ppBSE problem (triplet channel)...' + + allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt), & + ee_trip_Om(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & + hh_trip_Om(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & + pp_trip_Gam_B(nVVt,nOOt),pp_trip_Gam_C(nVVt,nVVt),pp_trip_Gam_D(nOOt,nOOt)) + + mem = mem + size(Bpp) + size(Cpp) + size(Dpp) & + + size(ee_trip_Om) + size(X1t) + size(Y1t) & + + size(hh_trip_Om) + size(X2t) + size(Y2t) & + + size(pp_trip_Gam_B) + size(pp_trip_Gam_C) + size(pp_trip_Gam_D) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet =',mem*dp_in_GB,' GB' + + ispin = 2 + Bpp(:,:) = 0d0 + Cpp(:,:) = 0d0 + Dpp(:,:) = 0d0 + + call wall_time(start_t) + if(.not.TDApp) call ppRLR_B(ispin,nOrb,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp) + call ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVVt,1d0,eOld,ERI,Cpp) + call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOt,1d0,eOld,ERI,Dpp) + + if(n_it_1b == 1 .and. n_it_2b == 1) then + + pp_trip_Gam_B(:,:) = 0d0 + pp_trip_Gam_C(:,:) = 0d0 + pp_trip_Gam_D(:,:) = 0d0 + + else + + if(.not.TDApp) call R_pp_triplet_Gamma_B(nOrb,nC,nO,nR,nOOt,nVVt,old_eh_sing_Phi,old_eh_trip_Phi,pp_trip_Gam_B) + call R_pp_triplet_Gamma_C(nOrb,nO,nR,nVVt,old_eh_sing_Phi,old_eh_trip_Phi,pp_trip_Gam_C) + call R_pp_triplet_Gamma_D(nOrb,nC,nO,nOOt,old_eh_sing_Phi,old_eh_trip_Phi,pp_trip_Gam_D) + + end if + + Bpp(:,:) = Bpp(:,:) + pp_trip_Gam_B(:,:) + Cpp(:,:) = Cpp(:,:) + pp_trip_Gam_C(:,:) + Dpp(:,:) = Dpp(:,:) + pp_trip_Gam_D(:,:) + + call ppRLR(TDApp,nOOt,nVVt,Bpp,Cpp,Dpp,ee_trip_Om,X1t,Y1t,hh_trip_Om,X2t,Y2t,Ec_pp(ispin)) + + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet ppBSE problem =',t,' seconds' + write(*,*) + + if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2p (triplets)',nVVt,ee_trip_Om) + if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2h (triplets)',nOOt,hh_trip_Om) + + err_eig_ee_trip = maxval(abs(old_ee_trip_Om - ee_trip_Om)) + err_eig_hh_trip = maxval(abs(old_hh_trip_Om - hh_trip_Om)) + + deallocate(Bpp,Cpp,Dpp,pp_trip_Gam_B,pp_trip_Gam_C,pp_trip_Gam_D) + + mem = mem - size(Bpp) - size(Cpp) - size(Dpp) & + - size(pp_trip_Gam_B) - size(pp_trip_Gam_C) - size(pp_trip_Gam_D) + + !----------! + ! Updating ! + !----------! + + old_eh_sing_Om(:) = eh_sing_Om(:) + old_eh_trip_Om(:) = eh_trip_Om(:) + old_ee_sing_Om(:) = ee_sing_Om(:) + old_hh_sing_Om(:) = hh_sing_Om(:) + old_ee_trip_Om(:) = ee_trip_Om(:) + old_hh_trip_Om(:) = hh_trip_Om(:) + + deallocate(eh_sing_Om,eh_trip_Om,ee_sing_Om,hh_sing_Om,ee_trip_Om,hh_trip_Om) + + mem = mem - size(eh_sing_Om) - size(eh_trip_Om) & + - size(ee_sing_Om) - size(hh_sing_Om) & + - size(ee_trip_Om) - size(hh_trip_Om) + + !----------------------------! + ! Compute screened integrals ! + !----------------------------! + + ! Free memory + deallocate(eh_sing_rho,eh_trip_rho,ee_sing_rho,ee_trip_rho,hh_sing_rho,hh_trip_rho) + ! TODO Once we will compute the blocks of kernel starting from the 4-tensors we can move the freeing up + ! Memory allocation + allocate(eh_sing_rho(nOrb,nOrb,nS),eh_trip_rho(nOrb,nOrb,nS)) + allocate(ee_sing_rho(nOrb,nOrb,nVVs),hh_sing_rho(nOrb,nOrb,nOOs)) + allocate(ee_trip_rho(nOrb,nOrb,nVVt),hh_trip_rho(nOrb,nOrb,nOOt)) + + + ! Build singlet eh screened integrals + write(*,*) 'Computing singlet eh screened integrals...' + + call wall_time(start_t) + call R_eh_singlet_screened_integral(nOrb,nC,nO,nR,nS,ERI,old_eh_sing_Phi,old_eh_trip_Phi,old_pp_sing_Phi,old_pp_trip_Phi, & + sing_XpY,sing_XmY,eh_sing_rho) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet eh integrals =',t,' seconds' + write(*,*) + ! Done with eigenvectors and kernel + deallocate(sing_XpY,sing_XmY) + + mem = mem - size(sing_XpY) - size(sing_XmY) + + ! Build triplet eh screened integrals + write(*,*) 'Computing triplet eh screened integrals...' + + call wall_time(start_t) + call R_eh_triplet_screened_integral(nOrb,nC,nO,nR,nS,ERI,old_eh_sing_Phi,old_eh_trip_Phi,old_pp_sing_Phi,old_pp_trip_Phi, & + trip_XpY,trip_XmY,eh_trip_rho) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet eh integrals =',t,' seconds' + write(*,*) + ! Done with eigenvectors and kernel + deallocate(trip_XpY,trip_XmY) + + mem = mem - size(trip_XpY) - size(trip_XmY) + + ! Build singlet pp screened integrals + write(*,*) 'Computing singlet pp screened integrals...' + + call wall_time(start_t) + call R_pp_singlet_screened_integral(nOrb,nC,nO,nR,nOOs,nVVs,ERI,old_eh_sing_Phi,old_eh_trip_Phi, & + X1s,Y1s,ee_sing_rho,X2s,Y2s,hh_sing_rho) + call wall_time(end_t) + t = end_t - start_t + ! Done with eigenvectors and kernel + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet pp integrals =',t,' seconds' + write(*,*) + + deallocate(X1s,Y1s,X2s,Y2s) + + mem = mem - size(X1s) - size(Y1s) - size(X2s) - size(Y2s) + + ! Build triplet pp screened integrals + write(*,*) 'Computing triplet pp screened integrals...' + + call wall_time(start_t) + call R_pp_triplet_screened_integral(nOrb,nC,nO,nR,nOOt,nVVt,ERI,old_eh_sing_Phi,old_eh_trip_Phi, & + X1t,Y1t,ee_trip_rho,X2t,Y2t,hh_trip_rho) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet pp integrals =',t,' seconds' + write(*,*) + ! Done with eigenvectors and kernel + deallocate(X1t,Y1t,X2t,Y2t) + + mem = mem - size(X1t) - size(Y1t) - size(X2t) - size(Y2t) + + !----------------------------! + ! Compute reducible kernels ! + !----------------------------! + + ! Memory allocation + allocate(eh_sing_Phi(nOrb,nOrb,nOrb,nOrb)) + allocate(eh_trip_Phi(nOrb,nOrb,nOrb,nOrb)) + allocate(pp_sing_Phi(nOrb,nOrb,nOrb,nOrb)) + allocate(pp_trip_Phi(nOrb,nOrb,nOrb,nOrb)) + + mem = mem + size(eh_sing_Phi) + size(eh_trip_Phi) + size(pp_sing_Phi) + size(pp_trip_Phi) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet =',mem*dp_in_GB,' GB' + + ! Build singlet eh reducible kernels + write(*,*) 'Computing singlet eh reducible kernel...' + + call wall_time(start_t) + call R_eh_singlet_Phi(nOrb,nC,nR,nS,old_eh_sing_Om,eh_sing_rho,eh_sing_Phi) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet eh reducible kernel =',t,' seconds' + write(*,*) + + ! Build triplet eh reducible kernels + write(*,*) 'Computing triplet eh reducible kernel...' + + call wall_time(start_t) + call R_eh_triplet_Phi(nOrb,nC,nR,nS,old_eh_trip_Om,eh_trip_rho,eh_trip_Phi) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet eh reducible kernel =',t,' seconds' + write(*,*) + + ! Build singlet pp reducible kernels + write(*,*) 'Computing singlet pp reducible kernel...' + + call wall_time(start_t) + call R_pp_singlet_Phi(nOrb,nC,nR,nOOs,nVVs,old_ee_sing_Om,ee_sing_rho,old_hh_sing_Om,hh_sing_rho,pp_sing_Phi) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet pp reducible kernel =',t,' seconds' + write(*,*) + + ! Build triplet pp reducible kernels + write(*,*) 'Computing triplet pp reducible kernel...' + + call wall_time(start_t) + call R_pp_triplet_Phi(nOrb,nC,nR,nOOt,nVVt,old_ee_trip_Om,ee_trip_rho,old_hh_trip_Om,hh_trip_rho,pp_trip_Phi) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet pp reducible kernel =',t,' seconds' + write(*,*) + + err_eh_sing = maxval(abs(old_eh_sing_Phi - eh_sing_Phi)) + err_eh_trip = maxval(abs(old_eh_trip_Phi - eh_trip_Phi)) + err_pp_sing = maxval(abs(old_pp_sing_Phi - pp_sing_Phi)) + err_pp_trip = maxval(abs(old_pp_trip_Phi - pp_trip_Phi)) + + old_eh_sing_Phi(:,:,:,:) = eh_sing_Phi(:,:,:,:) + old_eh_trip_Phi(:,:,:,:) = eh_trip_Phi(:,:,:,:) + old_pp_sing_Phi(:,:,:,:) = pp_sing_Phi(:,:,:,:) + old_pp_trip_Phi(:,:,:,:) = pp_trip_Phi(:,:,:,:) + + ! Free memory + deallocate(eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi) + + mem = mem - size(eh_sing_Phi) - size(eh_trip_Phi) - size(pp_sing_Phi) - size(pp_trip_Phi) + + !--------------------! + ! DIIS extrapolation ! + !--------------------! + + write(*,*) '------------------------------------------------------' + write(*,*) ' Two-body (frequency/kernel) convergence ' + write(*,*) '------------------------------------------------------' + write(*,'(1X,A30,F10.6,1X,A1,1X,F10.6)')'Error for density channel = ',err_eig_eh_sing,'/',err_eh_sing + write(*,'(1X,A30,F10.6,1X,A1,1X,F10.6)')'Error for magnetic channel = ',err_eig_eh_trip,'/',err_eh_trip + write(*,'(1X,A30,F10.6,1X,A1,1X,F10.6)')'Error for singlet channel = ',max(err_eig_ee_sing,err_eig_hh_sing),'/',err_pp_sing + write(*,'(1X,A30,F10.6,1X,A1,1X,F10.6)')'Error for triplet channel = ',max(err_eig_ee_trip,err_eig_hh_trip),'/',err_pp_sing + write(*,*) '------------------------------------------------------' + write(*,*) + + ! Convergence criteria + err_2b = max(err_eh_sing,err_eh_trip,err_pp_sing,err_pp_trip) + + call wall_time(end_2b) + t_2b = end_2b - start_2b + write(*,'(1X,A44,1X,I4,A2,F9.3,A8)') 'Wall time for two-body iteration #',n_it_2b,' =',t_2b,' seconds' + write(*,*) + + end do + !---------------------------------------------! + ! End main loop for two-body self-consistency ! + !---------------------------------------------! + + ! Did it actually converge? + + if(n_it_2b == max_it_2b) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Two-body convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + !stop + + else + + write(*,*) + write(*,*)'****************************************************' + write(*,*)' Two-body convergence success ' + write(*,*)'****************************************************' + write(*,*) + + call print_excitation_energies('phBSE@Parquet','singlet',nS,old_eh_sing_Om) + call print_excitation_energies('phBSE@Parquet','triplet',nS,old_eh_trip_Om) + call print_excitation_energies('ppBSE@Parquet','2p (singlets)',nVVs,old_ee_sing_Om) + call print_excitation_energies('ppBSE@Parquet','2h (singlets)',nOOs,old_hh_sing_Om) + call print_excitation_energies('ppBSE@Parquet','2p (triplets)',nVVt,old_ee_trip_Om) + call print_excitation_energies('ppBSE@Parquet','2h (triplets)',nOOt,old_hh_trip_Om) + + end if + + allocate(eQPlin(nOrb),Z(nOrb),SigC(nOrb)) + + mem = mem + size(eQPlin) + size(Z) + size(SigC) + write(*,'(1X,A50,4X,F6.3,A3)') 'Memory usage in RParquet =',mem*dp_in_GB,' GB' + + write(*,*) 'Computing self-energy...' + write(*,*) + + call wall_time(start_t) + call R_Parquet_self_energy(eta,nOrb,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt,eOld,ERI, & + eh_sing_rho,old_eh_sing_Om,eh_trip_rho,old_eh_trip_Om, & + ee_sing_rho,old_ee_sing_Om,ee_trip_rho,old_ee_trip_Om, & + hh_sing_rho,old_hh_sing_Om,hh_trip_rho,old_hh_trip_Om, & + EcGM,SigC,Z) + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for self energy =',t,' seconds' + write(*,*) + + eQPlin(:) = eHF(:) + Z(:)*SigC(:) + + ! Solve the quasi-particle equation + + if(linearize) then + + eQP(:) = eQPlin(:) + + else + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Newton-Raphson for Dyson equation not implemented ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + stop + + end if + + ! DIIS for one-body part + + if(max_diis_1b > 1) then + + n_diis_1b = min(n_diis_1b+1,max_diis_1b) + call DIIS_extrapolation(rcond_1b,nOrb,nOrb,n_diis_1b,err_diis_1b,eQP_diis,eQP-eOld,eQP) + + end if + + ! Check one-body converge + + err_1b = maxval(abs(eOld - eQP)) + eOld(:) = eQP(:) + + ! Print for one-body part + + call R_print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,ERHF,EcGM,Ec_eh,Ec_pp) + + deallocate(eQPlin,Z,SigC) + + mem = mem - size(eQPlin) - size(Z) - size(SigC) + + call wall_time(end_1b) + t_1b = end_1b - start_1b + write(*,'(1X,A44,1X,I4,A2,F9.3,A8)') 'Wall time for one-body iteration #',n_it_1b,' =',t_1b,' seconds' + + end do + !---------------------------------------------! + ! End main loop for one-body self-consistency ! + !---------------------------------------------! + + ! Did it actually converge? + if(n_it_1b == max_it_1b) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' One-body convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + stop + + else + + write(*,*) + write(*,*)'****************************************************' + write(*,*)' One-body convergence success ' + write(*,*)'****************************************************' + write(*,*) + + end if + +end subroutine diff --git a/src/Parquet/R_Parquet_self_energy.f90 b/src/Parquet/R_Parquet_self_energy.f90 new file mode 100644 index 0000000..948771c --- /dev/null +++ b/src/Parquet/R_Parquet_self_energy.f90 @@ -0,0 +1,626 @@ +subroutine R_Parquet_self_energy(eta,nOrb,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt,eQP,ERI, & + eh_sing_rho,eh_sing_Om,eh_trip_rho,eh_trip_Om, & + ee_sing_rho,ee_sing_Om,ee_trip_rho,ee_trip_Om, & + hh_sing_rho,hh_sing_Om,hh_trip_rho,hh_trip_Om, & + EcGM,SigC,Z) + +! Compute correlation part of the self-energy with only irreducible vertices contribution + implicit none + include 'parameters.h' + +! Input variables + double precision,intent(in) :: eta + integer,intent(in) :: nOrb,nC,nO,nV,nR + integer,intent(in) :: nS,nOOs,nVVs,nOOt,nVVt + double precision,intent(in) :: eQP(nOrb) + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_sing_rho(nOrb,nOrb,nS) + double precision,intent(in) :: eh_sing_Om(nS) + double precision,intent(in) :: eh_trip_rho(nOrb,nOrb,nS) + double precision,intent(in) :: eh_trip_Om(nS) + double precision,intent(in) :: ee_sing_rho(nOrb,nOrb,nVVs) + double precision,intent(in) :: ee_sing_Om(nVVs) + double precision,intent(in) :: ee_trip_rho(nOrb,nOrb,nVVt) + double precision,intent(in) :: ee_trip_Om(nVVt) + double precision,intent(in) :: hh_sing_rho(nOrb,nOrb,nOOs) + double precision,intent(in) :: hh_sing_Om(nOOs) + double precision,intent(in) :: hh_trip_rho(nOrb,nOrb,nOOt) + double precision,intent(in) :: hh_trip_Om(nOOt) + +! Local variables + integer :: i,j,k,a,b,c + integer :: p,n + double precision :: eps,dem1,dem2,reg,reg1,reg2 + double precision :: num + double precision :: start_t,end_t,t + +! Output variables + double precision,intent(out) :: EcGM + double precision,intent(out) :: SigC(nOrb) + double precision,intent(out) :: Z(nOrb) + +! Initialize + + SigC(:) = 0d0 + Z(:) = 0d0 + EcGM = 0d0 + +!-----------------------------------! +! 2nd-order part of the self-energy ! +!-----------------------------------! + call wall_time(start_t) + do p=nC+1,nOrb-nR + ! 2h1p sum + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nOrb-nR + + eps = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg = (1d0 - exp(- 2d0 * eta * eps * eps)) + num = ERI(p,a,j,i)*(2d0*ERI(j,i,p,a) - ERI(j,i,a,p)) + + SigC(p) = SigC(p) + num*reg/eps + Z(p) = Z(p) - num*reg/eps**2 + + end do + end do + end do + ! 2p1h sum + do i=nC+1,nO + do a=nO+1,nOrb-nR + do b=nO+1,nOrb-nR + + eps = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg = (1d0 - exp(- 2d0 * eta * eps * eps)) + num = ERI(p,i,b,a)*(2d0*ERI(b,a,p,i) - ERI(b,a,i,p)) + + SigC(p) = SigC(p) + num*reg/eps + Z(p) = Z(p) - num*reg/eps**2 + + end do + end do + end do + end do + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for 2nd-order self-energy =',t,' seconds' + write(*,*) +!-------------------------------------! +! singlet eh part of the self-energy ! +!-------------------------------------! + call wall_time(start_t) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,i,a,j,b,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nS,eta,ERI,eQP,eh_sing_rho,eh_sing_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + + do i=nC+1,nO + do a=nO+1,nOrb-nR + + do n=1,nS + !3h2p + do j=nC+1,nO + num = ( - ERI(p,a,j,i) + 0.5d0*ERI(p,a,i,j))* & + eh_sing_rho(a,i,n) * eh_sing_rho(j,p,n) + + dem1 = eQP(a) - eQP(i) - eh_sing_Om(n) + dem2 = eQP(p) - eQP(j) + eh_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = (ERI(p,a,j,i) - 0.5d0*ERI(p,a,i,j))* & + eh_sing_rho(a,i,n) * eh_sing_rho(j,p,n) + + dem1 = eQP(a) - eQP(i) - eh_sing_Om(n) + dem2 = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = (- ERI(p,i,j,a) + 0.5d0*ERI(p,i,a,j)) * & + eh_sing_rho(j,p,n) * eh_sing_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_sing_Om(n) + dem2 = eQP(p) - eQP(j) + eh_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = (- ERI(p,a,j,i) + 0.5d0*ERI(p,a,i,j))* & + eh_sing_rho(p,j,n) * eh_sing_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_sing_Om(n) + dem2 = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + + end do ! j + !3p2h + do b=nO+1,nOrb-nR + num = (- ERI(p,a,b,i) + 0.5d0*ERI(p,a,i,b)) * & + eh_sing_rho(p,b,n) * eh_sing_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_sing_Om(n) + dem2 = eQP(p) - eQP(b) - eh_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = (- ERI(p,i,b,a) + 0.5d0*ERI(p,i,a,b)) * & + eh_sing_rho(b,p,n) * eh_sing_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_sing_Om(n) + dem2 = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = (- ERI(p,i,b,a) + 0.5d0*ERI(p,i,a,b)) * & + eh_sing_rho(p,b,n) * eh_sing_rho(a,i,n) + + dem1 = eQP(a) - eQP(i) - eh_sing_Om(n) + dem2 = eQP(p) - eQP(b) - eh_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = (ERI(p,i,b,a) - 0.5d0*ERI(p,i,a,b)) * & + eh_sing_rho(p,b,n) * eh_sing_rho(a,i,n) + + dem1 = eQP(a) - eQP(i) - eh_sing_Om(n) + dem2 = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! b + + end do ! n + + end do ! a + end do ! i + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet eh self-energy =',t,' seconds' + write(*,*) +!-------------------------------------! +! triplet eh part of the self-energy ! +!-------------------------------------! + call wall_time(start_t) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,i,a,j,b,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nS,eta,ERI,eQP,eh_trip_rho,eh_trip_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + + do i=nC+1,nO + do a=nO+1,nOrb-nR + + do n=1,nS + !3h2p + do j=nC+1,nO + num = ( + 1.5d0*ERI(p,a,i,j))* & + eh_trip_rho(a,i,n) * eh_trip_rho(j,p,n) + + dem1 = eQP(a) - eQP(i) - eh_trip_Om(n) + dem2 = eQP(p) - eQP(j) + eh_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = ( - 1.5d0*ERI(p,a,i,j))* & + eh_trip_rho(a,i,n) * eh_trip_rho(j,p,n) + + dem1 = eQP(a) - eQP(i) - eh_trip_Om(n) + dem2 = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = ( + 1.5d0*ERI(p,i,a,j)) * & + eh_trip_rho(j,p,n) * eh_trip_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_trip_Om(n) + dem2 = eQP(p) - eQP(j) + eh_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = ( + 1.5d0*ERI(p,a,i,j))* & + eh_trip_rho(p,j,n) * eh_trip_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_trip_Om(n) + dem2 = eQP(p) + eQP(a) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + + end do ! j + !3p2h + do b=nO+1,nOrb-nR + num = ( + 1.5d0*ERI(p,a,i,b)) * & + eh_trip_rho(p,b,n) * eh_trip_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_trip_Om(n) + dem2 = eQP(p) - eQP(b) - eh_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = ( + 1.5d0*ERI(p,i,a,b)) * & + eh_trip_rho(b,p,n) * eh_trip_rho(i,a,n) + + dem1 = eQP(a) - eQP(i) + eh_trip_Om(n) + dem2 = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = ( + 1.5d0*ERI(p,i,a,b)) * & + eh_trip_rho(p,b,n) * eh_trip_rho(a,i,n) + + dem1 = eQP(a) - eQP(i) - eh_trip_Om(n) + dem2 = eQP(p) - eQP(b) - eh_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = ( - 1.5d0*ERI(p,i,a,b)) * & + eh_trip_rho(p,b,n) * eh_trip_rho(a,i,n) + + dem1 = eQP(a) - eQP(i) - eh_trip_Om(n) + dem2 = eQP(p) + eQP(i) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! b + + end do ! n + + end do ! a + end do ! i + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet eh self-energy =',t,' seconds' + write(*,*) + +!-------------------------------------! +! singlet pp part of the self-energy ! +!-------------------------------------! + call wall_time(start_t) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,i,j,k,c,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nOOs,nVVs,eta,ERI,eQP,ee_sing_rho,ee_sing_Om,hh_sing_rho,hh_sing_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + + do i=nC+1,nO + do j=nC+1,nO + do n=1,nVVs + ! 4h1p + do k=nC+1,nO + num = - 0.5d0 * ERI(p,k,i,j) * ee_sing_rho(i,j,n) * ee_sing_rho(p,k,n) + dem1 = ee_sing_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(k) - ee_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! k + ! 3h2p + do c=nO+1,nOrb-nR + + num = - 0.5d0*ERI(p,c,i,j) * ee_sing_rho(i,j,n) * ee_sing_rho(p,c,n) + dem1 = ee_sing_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! a + end do ! n + do n=1,nOOs + ! 3h2p + do c=nO+1,nOrb-nR + + num = - 0.5d0*ERI(p,c,i,j) * hh_sing_rho(i,j,n) * hh_sing_rho(p,c,n) + dem1 = hh_sing_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - hh_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = 0.5d0*ERI(p,c,i,j) * hh_sing_rho(i,j,n) * hh_sing_rho(p,c,n) + dem1 = hh_sing_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + end do ! n + end do ! j + end do ! i + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,k,a,b,c,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nOOs,nVVs,eta,ERI,eQP,ee_sing_rho,ee_sing_Om,hh_sing_rho,hh_sing_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + do a=nO+1,nOrb-nR + do b=nO+1,nOrb-nR + do n=1,nOOs + ! 4p1h + do c=nO+1,nOrb-nR + + num = 0.5d0*ERI(p,c,a,b) * hh_sing_rho(a,b,n) * hh_sing_rho(p,c,n) + dem1 = hh_sing_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(c) - hh_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + ! 3p2h + do k=nC+1,nO + + num = 0.5d0*ERI(p,k,a,b) * hh_sing_rho(a,b,n) * hh_sing_rho(p,k,n) + dem1 = hh_sing_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! k + end do ! n + do n=1,nVVs + ! 3p2h + do k=nC+1,nO + + num = 0.5d0*ERI(p,k,a,b) * ee_sing_rho(a,b,n) * ee_sing_rho(p,k,n) + dem1 = ee_sing_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - ee_sing_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = - 0.5d0*ERI(p,k,a,b) * ee_sing_rho(a,b,n) * ee_sing_rho(p,k,n) + dem1 = ee_sing_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + end do ! n + end do ! b + end do ! a + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + call wall_time(end_t) + t = end_t - start_t + + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for singlet pp self-energy =',t,' seconds' + write(*,*) +!-------------------------------------! +! triplet pp part of the self-energy ! +!-------------------------------------! + call wall_time(start_t) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,i,j,k,c,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nOOt,nVVt,eta,ERI,eQP,ee_trip_rho,ee_trip_Om,hh_trip_rho,hh_trip_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + + do i=nC+1,nO + do j=nC+1,nO + do n=1,nVVt + ! 4h1p + do k=nC+1,nO + num = - 1.5d0 * ERI(p,k,i,j) * ee_trip_rho(i,j,n) * ee_trip_rho(p,k,n) + dem1 = ee_trip_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(k) - ee_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! k + ! 3h2p + do c=nO+1,nOrb-nR + + num = - 1.5d0 * ERI(p,c,i,j) * ee_trip_rho(i,j,n) * ee_trip_rho(p,c,n) + dem1 = ee_trip_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! a + end do ! n + do n=1,nOOt + ! 3h2p + do c=nO+1,nOrb-nR + + num = - 1.5d0 * ERI(p,c,i,j) * hh_trip_rho(i,j,n) * hh_trip_rho(p,c,n) + dem1 = hh_trip_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - hh_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = 1.5d0 * ERI(p,c,i,j) * hh_trip_rho(i,j,n) * hh_trip_rho(p,c,n) + dem1 = hh_trip_Om(n) - eQP(i) - eQP(j) + dem2 = eQP(p) + eQP(c) - eQP(i) - eQP(j) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + end do ! n + end do ! j + end do ! i + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p,k,a,b,c,n,num,dem1,dem2,reg1,reg2) & + !$OMP SHARED(nC,nO,nOrb,nR,nOOt,nVVt,eta,ERI,eQP,ee_trip_rho,ee_trip_Om,hh_trip_rho,hh_trip_Om,SigC,Z) + !$OMP DO COLLAPSE(2) + do p=nC+1,nOrb-nR + do a=nO+1,nOrb-nR + do b=nO+1,nOrb-nR + do n=1,nOOt + ! 4p1h + do c=nO+1,nOrb-nR + + num = 1.5d0 * ERI(p,c,a,b) * hh_trip_rho(a,b,n) * hh_trip_rho(p,c,n) + dem1 = hh_trip_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(c) - hh_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + ! 3p2h + do k=nC+1,nO + + num = 1.5d0 * ERI(p,k,a,b) * hh_trip_rho(a,b,n) * hh_trip_rho(p,k,n) + dem1 = hh_trip_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! k + end do ! n + do n=1,nVVt + ! 3p2h + do k=nC+1,nO + + num = 1.5d0 * ERI(p,k,a,b) * ee_trip_rho(a,b,n) * ee_trip_rho(p,k,n) + dem1 = ee_trip_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - ee_trip_Om(n) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + num = - 1.5d0 * ERI(p,k,a,b) * ee_trip_rho(a,b,n) * ee_trip_rho(p,k,n) + dem1 = ee_trip_Om(n) - eQP(a) - eQP(b) + dem2 = eQP(p) + eQP(k) - eQP(a) - eQP(b) + reg1 = (1d0 - exp(- 2d0 * eta * dem1 * dem1)) + reg2 = (1d0 - exp(- 2d0 * eta * dem2 * dem2)) + + SigC(p) = SigC(p) + num * (reg1/dem1) * (reg2/dem2) + Z(p) = Z(p) - num * (reg1/dem1) * (reg2/dem2/dem2) + + end do ! c + end do ! n + end do ! b + end do ! a + + end do ! p + !$OMP END DO + !$OMP END PARALLEL + call wall_time(end_t) + t = end_t - start_t + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for triplet pp self-energy =',t,' seconds' + write(*,*) + +!-----------------------------! +! Renormalization factor ! +!-----------------------------! + + Z(:) = 1d0/(1d0 - Z(:)) + +!-------------------------------------! +! Galitskii-Migdal correlation energy ! +!-------------------------------------! + + EcGM = 0d0 + +end subroutine diff --git a/src/Parquet/R_eh_singlet_Gam.f90 b/src/Parquet/R_eh_singlet_Gam.f90 new file mode 100644 index 0000000..02dcc02 --- /dev/null +++ b/src/Parquet/R_eh_singlet_Gam.f90 @@ -0,0 +1,86 @@ +subroutine R_eh_singlet_Gamma_A(nOrb,nC,nO,nR,nS,eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi,eh_sing_Gam_A) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,a,j,b + integer :: ia,jb +! Output variables + double precision, intent(out) :: eh_sing_Gam_A(nS,nS) + +! Initialization + eh_sing_Gam_A(:,:) = 0d0 + + ia = 0 + do i=nC+1,nO + do a=nO+1,nOrb-nR + ia = ia + 1 + + jb = 0 + do j=nC+1,nO + do b=nO+1,norb-nR + jb = jb + 1 + + eh_sing_Gam_A(ia,jb) = - 0.5d0*eh_sing_Phi(a,j,b,i) - 1.5d0*eh_trip_Phi(a,j,b,i) & + + 0.5d0*pp_sing_Phi(a,j,i,b) + 1.5d0*pp_trip_Phi(a,j,i,b) + + enddo + enddo + + enddo + enddo + +end subroutine + +subroutine R_eh_singlet_Gamma_B(nOrb,nC,nO,nR,nS,eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi,eh_sing_Gam_B) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,a,j,b + integer :: ia,jb + +! Output variables + double precision, intent(out) :: eh_sing_Gam_B(nS,nS) + +! Initialization + eh_sing_Gam_B(:,:) = 0d0 + + ia = 0 + do i=nC+1,nO + do a=nO+1,nOrb-nR + ia = ia + 1 + + jb = 0 + do j=nC+1,nO + do b=nO+1,norb-nR + jb = jb + 1 + + eh_sing_Gam_B(ia,jb) = - 0.5d0*eh_sing_Phi(a,b,j,i) - 1.5d0*eh_trip_Phi(a,b,j,i) & + + 0.5d0*pp_sing_Phi(a,b,i,j) + 1.5d0*pp_trip_Phi(a,b,i,j) + + enddo + enddo + + enddo + enddo + +end subroutine diff --git a/src/Parquet/R_eh_singlet_Phi.f90 b/src/Parquet/R_eh_singlet_Phi.f90 new file mode 100644 index 0000000..f02d518 --- /dev/null +++ b/src/Parquet/R_eh_singlet_Phi.f90 @@ -0,0 +1,44 @@ +subroutine R_eh_singlet_Phi(nOrb,nC,nR,nS,eh_sing_Om,eh_sing_rho,eh_sing_Phi) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nR,nS + double precision,intent(in) :: eh_sing_Om(nS) + double precision,intent(in) :: eh_sing_rho(nOrb,nOrb,nS) + +! Local variables + integer :: p,q,r,s + integer :: n + +! Output variables + double precision,intent(out) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + +! Initialization + eh_sing_Phi(:,:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nS, eh_sing_Phi, eh_sing_rho, eh_sing_Om) + !$OMP DO COLLAPSE(2) + do s = nC+1, nOrb-nR + do r = nC+1, nOrb-nR + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + do n=1,nS + eh_sing_Phi(p,q,r,s) = eh_sing_Phi(p,q,r,s) & + - eh_sing_rho(r,p,n)*eh_sing_rho(q,s,n)/eh_sing_Om(n) & + - eh_sing_rho(p,r,n)*eh_sing_rho(s,q,n)/eh_sing_Om(n) + end do + + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/R_eh_triplet_Gam.f90 b/src/Parquet/R_eh_triplet_Gam.f90 new file mode 100644 index 0000000..d8fc0a5 --- /dev/null +++ b/src/Parquet/R_eh_triplet_Gam.f90 @@ -0,0 +1,86 @@ +subroutine R_eh_triplet_Gamma_A(nOrb,nC,nO,nR,nS,eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi,eh_trip_Gam_A) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,a,j,b + integer :: ia,jb + +! Output variables + double precision, intent(out) :: eh_trip_Gam_A(nS,nS) + +! Initialization + eh_trip_Gam_A(:,:) = 0d0 + + ia = 0 + do i=nC+1,nO + do a=nO+1,nOrb-nR + ia = ia + 1 + + jb = 0 + do j=nC+1,nO + do b=nO+1,norb-nR + jb = jb + 1 + + eh_trip_Gam_A(ia,jb) = - 0.5d0*eh_sing_Phi(a,j,b,i) + 0.5d0*eh_trip_Phi(a,j,b,i) & + - 0.5d0*pp_sing_Phi(a,j,i,b) + 0.5d0*pp_trip_Phi(a,j,i,b) + + enddo + enddo + + enddo + enddo + +end subroutine + +subroutine R_eh_triplet_Gamma_B(nOrb,nC,nO,nR,nS,eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi,eh_trip_Gam_B) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,a,j,b + integer :: ia,jb + +! Output variables + double precision, intent(out) :: eh_trip_Gam_B(nS,nS) + +! Initialization + eh_trip_Gam_B(:,:) = 0d0 + + ia = 0 + do i=nC+1,nO + do a=nO+1,nOrb-nR + ia = ia + 1 + + jb = 0 + do j=nC+1,nO + do b=nO+1,norb-nR + jb = jb + 1 + + eh_trip_Gam_B(ia,jb) = - 0.5d0*eh_sing_Phi(a,b,j,i) + 0.5d0*eh_trip_Phi(a,b,j,i) & + - 0.5d0*pp_sing_Phi(a,b,i,j) + 0.5d0*pp_trip_Phi(a,b,i,j) + + enddo + enddo + + enddo + enddo + +end subroutine diff --git a/src/Parquet/R_eh_triplet_Phi.f90 b/src/Parquet/R_eh_triplet_Phi.f90 new file mode 100644 index 0000000..9e7b2e9 --- /dev/null +++ b/src/Parquet/R_eh_triplet_Phi.f90 @@ -0,0 +1,44 @@ +subroutine R_eh_triplet_Phi(nOrb,nC,nR,nS,eh_trip_Om,eh_trip_rho,eh_trip_Phi) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nR,nS + double precision,intent(in) :: eh_trip_Om(nS) + double precision,intent(in) :: eh_trip_rho(nOrb,nOrb,nS) + +! Local variables + integer :: p,q,r,s + integer :: n + +! Output variables + double precision,intent(out) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Initialization + eh_trip_Phi(:,:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nS, eh_trip_Phi, eh_trip_rho, eh_trip_Om) + !$OMP DO COLLAPSE(2) + do s = nC+1, nOrb-nR + do r = nC+1, nOrb-nR + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + do n=1,nS + eh_trip_Phi(p,q,r,s) = eh_trip_Phi(p,q,r,s) & + - eh_trip_rho(r,p,n)*eh_trip_rho(q,s,n)/eh_trip_Om(n) & + - eh_trip_rho(p,r,n)*eh_trip_rho(s,q,n)/eh_trip_Om(n) + end do + + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/R_pp_singlet_Gam.f90 b/src/Parquet/R_pp_singlet_Gam.f90 new file mode 100644 index 0000000..206a577 --- /dev/null +++ b/src/Parquet/R_pp_singlet_Gam.f90 @@ -0,0 +1,149 @@ +subroutine R_pp_singlet_Gamma_D(nOrb,nC,nO,nOOs,eh_sing_Phi,eh_trip_Phi,pp_sing_Gam_D) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nOOs + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,j,k,l + integer :: ij,kl + double precision,external :: Kronecker_delta + +! Output variables + double precision, intent(out) :: pp_sing_Gam_D(nOOs,nOOs) + +! Initialization + pp_sing_Gam_D(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(i, j, ij, k, l, kl, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_sing_Gam_D, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ij = 0 + do i=nC+1,nO + do j=i,nO + ij = ij + 1 + + kl = 0 + do k=nC+1,nO + do l=k,nO + kl = kl +1 + + pp_sing_Gam_D(ij,kl) = 0.5d0*eh_sing_Phi(i,j,k,l) - 1.5d0*eh_trip_Phi(i,j,k,l) & + + 0.5d0*eh_sing_Phi(i,j,l,k) - 1.5d0*eh_trip_Phi(i,j,l,k) + + pp_sing_Gam_D(ij,kl) = pp_sing_Gam_D(ij,kl)/sqrt((1d0 + Kronecker_delta(i,j))*(1d0 + Kronecker_delta(k,l))) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + +subroutine R_pp_singlet_Gamma_C(nOrb,nO,nR,nVVs,eh_sing_Phi,eh_trip_Phi,pp_sing_Gam_C) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nO,nR,nVVs + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: a,b,c,d + integer :: ab,cd,aa,a0 + double precision,external :: Kronecker_delta + +! Output variables + double precision, intent(out) :: pp_sing_Gam_C(nVVs,nVVs) + +! Initialization + pp_sing_Gam_C(:,:) = 0d0 + + a0 = nOrb - nR - nO + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(a, b, aa, ab, c, d, cd) & + !$OMP SHARED(nO, nOrb, nR, a0, pp_sing_Gam_C, eh_sing_Phi, eh_trip_Phi) + !$OMP DO + do a = nO+1, nOrb-nR + aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO + do b = a, nOrb-nR + ab = aa + b + + cd = 0 + do c=nO+1,nOrb - nR + do d=c,nOrb - nR + cd = cd +1 + + pp_sing_Gam_C(ab,cd) = 0.5d0*eh_sing_Phi(a,b,c,d) - 1.5d0*eh_trip_Phi(a,b,c,d) & + + 0.5d0*eh_sing_Phi(a,b,d,c) - 1.5d0*eh_trip_Phi(a,b,d,c) + + pp_sing_Gam_C(ab,cd) = pp_sing_Gam_C(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d))) + + end do + end do + end do + end do + !$OMP END DO + !$OMP END PARALLEL + +end subroutine + +subroutine R_pp_singlet_Gamma_B(nOrb,nC,nO,nR,nOOs,nVVs,eh_sing_Phi,eh_trip_Phi,pp_sing_Gam_B) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nOOs,nVVs + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: a,b,i,j + integer :: ab,ij + double precision,external :: Kronecker_delta + +! Output variables + double precision, intent(out) :: pp_sing_Gam_B(nVVs,nOOs) + +! Initialization + pp_sing_Gam_B(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(a, b, ab, i, j, ij, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_sing_Gam_B, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ab = 0 + do a=nO+1,nOrb - nR + do b=a,nOrb - nR + ab = ab + 1 + + ij = 0 + do i=nC+1,nO + do j=i,nO + ij = ij +1 + + pp_sing_Gam_B(ab,ij) = 0.5d0*eh_sing_Phi(a,b,i,j) - 1.5d0*eh_trip_Phi(a,b,i,j) & + + 0.5d0*eh_sing_Phi(a,b,j,i) - 1.5d0*eh_trip_Phi(a,b,j,i) + + pp_sing_Gam_B(ab,ij) = pp_sing_Gam_B(ab,ij)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j))) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/R_pp_singlet_Phi.f90 b/src/Parquet/R_pp_singlet_Phi.f90 new file mode 100644 index 0000000..eaa275f --- /dev/null +++ b/src/Parquet/R_pp_singlet_Phi.f90 @@ -0,0 +1,50 @@ +subroutine R_pp_singlet_Phi(nOrb,nC,nR,nOO,nVV,ee_sing_Om,ee_sing_rho,hh_sing_Om,hh_sing_rho,pp_sing_Phi) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nR,nOO,nVV + double precision,intent(in) :: ee_sing_Om(nVV) + double precision,intent(in) :: ee_sing_rho(nOrb,nOrb,nVV) + double precision,intent(in) :: hh_sing_Om(nOO) + double precision,intent(in) :: hh_sing_rho(nOrb,nOrb,nOO) + +! Local variables + integer :: p,q,r,s + integer :: n + +! Output variables + double precision,intent(out) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + +! Initialization + pp_sing_Phi(:,:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nVV, nOO, pp_sing_Phi, ee_sing_rho, ee_sing_Om, hh_sing_rho, hh_sing_Om) + !$OMP DO COLLAPSE(2) + do s = nC+1, nOrb-nR + do r = nC+1, nOrb-nR + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + do n=1,nVV + pp_sing_Phi(p,q,r,s) = pp_sing_Phi(p,q,r,s) & + - ee_sing_rho(p,q,n)*ee_sing_rho(r,s,n)/ee_sing_Om(n) + end do + + do n=1,nOO + pp_sing_Phi(p,q,r,s) = pp_sing_Phi(p,q,r,s) & + + hh_sing_rho(p,q,n)*hh_sing_rho(r,s,n)/hh_sing_Om(n) + end do + + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/R_pp_triplet_Gam.f90 b/src/Parquet/R_pp_triplet_Gam.f90 new file mode 100644 index 0000000..75bdc24 --- /dev/null +++ b/src/Parquet/R_pp_triplet_Gam.f90 @@ -0,0 +1,144 @@ +subroutine R_pp_triplet_Gamma_D(nOrb,nC,nO,nOOt,eh_sing_Phi,eh_trip_Phi,pp_trip_Gam_D) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nOOt + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: i,j,k,l + integer :: ij,kl + integer :: n + +! Output variables + double precision, intent(out) :: pp_trip_Gam_D(nOOt,nOOt) + +! Initialization + pp_trip_Gam_D(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(i, j, ij, k, l, kl, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_trip_Gam_D, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ij = 0 + do i=nC+1,nO + do j=i+1,nO + ij = ij + 1 + + kl = 0 + do k=nC+1,nO + do l=k+1,nO + kl = kl +1 + + pp_trip_Gam_D(ij,kl) = 0.5d0*eh_sing_Phi(i,j,k,l) + 0.5d0*eh_trip_Phi(i,j,k,l) & + - 0.5d0*eh_sing_Phi(i,j,l,k) - 0.5d0*eh_trip_Phi(i,j,l,k) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + +subroutine R_pp_triplet_Gamma_C(nOrb,nO,nR,nVVt,eh_sing_Phi,eh_trip_Phi,pp_trip_Gam_C) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nO,nR,nVVt + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: a,b,c,d + integer :: ab,cd + integer :: n + +! Output variables + double precision, intent(out) :: pp_trip_Gam_C(nVVt,nVVt) + +! Initialization + pp_trip_Gam_C(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(a, b, ab, c, d, cd, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_trip_Gam_C, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ab = 0 + do a=nO+1,nOrb - nR + do b=a+1,nOrb - nR + ab = ab + 1 + + cd = 0 + do c=nO+1,nOrb - nR + do d=c+1,nOrb - nR + cd = cd +1 + + pp_trip_Gam_C(ab,cd) = 0.5d0*eh_sing_Phi(a,b,c,d) + 0.5d0*eh_trip_Phi(a,b,c,d) & + - 0.5d0*eh_sing_Phi(a,b,d,c) - 0.5d0*eh_trip_Phi(a,b,d,c) + + end do + end do + + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + +subroutine R_pp_triplet_Gamma_B(nOrb,nC,nO,nR,nOOt,nVVt,eh_sing_Phi,eh_trip_Phi,pp_trip_Gam_B) + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nOOt,nVVt + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Local variables + integer :: a,b,i,j + integer :: ab,ij + integer :: n + +! Output variables + double precision, intent(out) :: pp_trip_Gam_B(nVVt,nOOt) + +! Initialization + pp_trip_Gam_B(:,:) = 0d0 + +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(a, b, ab, i, j, ij, n) & +! !$OMP SHARED(nC, nOrb, nO, nS, pp_trip_Gam_B, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) +! !$OMP DO COLLAPSE(2) + + ab = 0 + do a=nO+1,nOrb - nR + do b=a+1,nOrb - nR + ab = ab + 1 + + ij = 0 + do i=nC+1,nO + do j=i+1,nO + ij = ij +1 + + pp_trip_Gam_B(ab,ij) = 0.5d0*eh_sing_Phi(a,b,i,j) + 0.5d0*eh_trip_Phi(a,b,i,j) & + - 0.5d0*eh_sing_Phi(a,b,j,i) - 0.5d0*eh_trip_Phi(a,b,j,i) + + end do + end do + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/R_pp_triplet_Phi.f90 b/src/Parquet/R_pp_triplet_Phi.f90 new file mode 100644 index 0000000..8d4990d --- /dev/null +++ b/src/Parquet/R_pp_triplet_Phi.f90 @@ -0,0 +1,50 @@ +subroutine R_pp_triplet_Phi(nOrb,nC,nR,nOO,nVV,ee_trip_Om,ee_trip_rho,hh_trip_Om,hh_trip_rho,pp_trip_Phi) + + +! Compute irreducible vertex in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nR,nOO,nVV + double precision,intent(in) :: ee_trip_Om(nVV) + double precision,intent(in) :: ee_trip_rho(nOrb,nOrb,nVV) + double precision,intent(in) :: hh_trip_Om(nOO) + double precision,intent(in) :: hh_trip_rho(nOrb,nOrb,nOO) + +! Local variables + integer :: p,q,r,s + integer :: n + +! Output variables + double precision,intent(out) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + +! Initialization + pp_trip_Phi(:,:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nVV, nOO, pp_trip_Phi, ee_trip_rho, ee_trip_Om, hh_trip_rho, hh_trip_Om) + !$OMP DO COLLAPSE(2) + do s = nC+1, nOrb-nR + do r = nC+1, nOrb-nR + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + do n=1,nVV + pp_trip_Phi(p,q,r,s) = pp_trip_Phi(p,q,r,s) & + - ee_trip_rho(p,q,n)*ee_trip_rho(r,s,n)/ee_trip_Om(n) + end do + + do n=1,nOO + pp_trip_Phi(p,q,r,s) = pp_trip_Phi(p,q,r,s) & + + hh_trip_rho(p,q,n)*hh_trip_rho(r,s,n)/hh_trip_Om(n) + end do + + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/Parquet/R_print_parquet_1b.f90 b/src/Parquet/R_print_parquet_1b.f90 new file mode 100644 index 0000000..76a6e3d --- /dev/null +++ b/src/Parquet/R_print_parquet_1b.f90 @@ -0,0 +1,64 @@ +subroutine R_print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,EGHF,EcGM,Ec_eh,Ec_pp) + +! Print one-electron energies and other stuff for G0F2 + + implicit none + include 'parameters.h' + + integer,intent(in) :: nOrb + integer,intent(in) :: nO + double precision,intent(in) :: eHF(nOrb) + double precision,intent(in) :: SigC(nOrb) + double precision,intent(in) :: eQP(nOrb) + double precision,intent(in) :: Z(nOrb) + integer,intent(in) :: n_it_1b + double precision,intent(in) :: err_1b + double precision,intent(in) :: ENuc + double precision,intent(in) :: EGHF + double precision,intent(in) :: EcGM + double precision,intent(in) :: Ec_eh(nspin) + double precision,intent(in) :: Ec_pp(nspin) + + integer :: p + integer :: HOMO + integer :: LUMO + double precision :: Gap + +! HOMO and LUMO + + HOMO = nO + LUMO = HOMO + 1 + Gap = eQP(LUMO) - eQP(HOMO) + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------' + write(*,*)' Parquet self-energy ' + 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)','|','Sig_c (eV)','|','Z','|','e_QP (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,'|',eHF(p)*HaToeV,'|',SigC(p)*HaToeV,'|',Z(p),'|',eQP(p)*HaToeV,'|' + end do + + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,I15)') 'One-body iteration # ',n_it_1b + write(*,'(2X,A60,F15.6)') 'One-body convergence ',err_1b + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,F15.6,A3)') 'Parquet HOMO energy = ',eQP(HOMO)*HaToeV,' eV' + write(*,'(2X,A60,F15.6,A3)') 'Parquet LUMO energy = ',eQP(LUMO)*HaToeV,' eV' + write(*,'(2X,A60,F15.6,A3)') 'Parquet HOMO-LUMO gap = ',Gap*HaToeV,' eV' + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,F15.6,A3)') ' Parquet total energy = ',ENuc + EGHF + EcGM,' au' + write(*,'(2X,A60,F15.6,A3)') ' Parquet correlation energy = ',EcGM,' au' + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A60,F15.6,A3)') ' eh-RPA correlation energy = ',Ec_eh(1)+3d0*Ec_eh(2),' au' + write(*,'(2X,A60,F15.6,A3)') ' pp-RPA correlation energy = ',Ec_pp(1)+3d0*Ec_pp(2),' au' + !write(*,'(2X,A60,F15.6,A3)') '(eh+pp)-RPA correlation energy = ',Ec_pp,' au' + write(*,*)'-------------------------------------------------------------------------------' + write(*,*) + +end subroutine diff --git a/src/Parquet/R_screened_integrals.f90 b/src/Parquet/R_screened_integrals.f90 new file mode 100644 index 0000000..9999e75 --- /dev/null +++ b/src/Parquet/R_screened_integrals.f90 @@ -0,0 +1,350 @@ +subroutine R_eh_singlet_screened_integral(nOrb,nC,nO,nR,nS,ERI,eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi,XpY,XmY,rho) + +! Compute excitation densities + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: XpY(nS,nS),XmY(nS,nS) + +! Local variables + integer :: ia,jb,p,q,j,b + double precision :: X,Y + +! Output variables + double precision,intent(out) :: rho(nOrb,nOrb,nS) + + rho(:,:,:) = 0d0 +! !$OMP PARALLEL & +! !$OMP SHARED(nC,nOrb,nR,nO,nS,rho,ERI,XpY,eh_sing_Gam) & +! !$OMP PRIVATE(q,p,jb,ia) & +! !$OMP DEFAULT(NONE) +! !$OMP DO + do q=nC+1,nOrb-nR + do p=nC+1,nOrb-nR + + do ia=1,nS + + jb = 0 + do j=nC+1,nO + do b=nO+1,nOrb-nR + jb = jb + 1 + + X = 0.5d0*(XpY(ia,jb) + XmY(ia,jb)) + Y = 0.5d0*(XpY(ia,jb) - XmY(ia,jb)) + + rho(p,q,ia) = rho(p,q,ia) + (2d0*ERI(q,j,p,b) - ERI(q,j,b,p))*X ! & + !(- 0d0*0.5d0*eh_sing_Phi(q,j,b,p) - 0d0*1.5d0*eh_trip_Phi(q,j,b,p) & + !+ 0d0*0.5d0*pp_sing_Phi(q,j,p,b) + 0d0*1.5d0*pp_trip_Phi(q,j,p,b)) * X & + !+ (2d0*ERI(q,b,p,j) - ERI(q,b,j,p))*Y & + !(- 0d0*0.5d0*eh_sing_Phi(q,b,j,p) - 0d0*1.5d0*eh_trip_Phi(q,b,j,p) & + !+ 0d0*0.5d0*pp_sing_Phi(q,b,p,j) + 0d0*1.5d0*pp_trip_Phi(q,b,p,j)) * Y + + end do + + end do + end do + + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + +subroutine R_eh_triplet_screened_integral(nOrb,nC,nO,nR,nS,ERI,eh_sing_Phi,eh_trip_Phi,pp_sing_Phi,pp_trip_Phi,XpY,XmY,rho) + +! Compute excitation densities + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR,nS + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: pp_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: XpY(nS,nS),XmY(nS,nS) + +! Local variables + integer :: ia,jb,p,q,j,b + double precision :: X,Y + +! Output variables + double precision,intent(out) :: rho(nOrb,nOrb,nS) + + rho(:,:,:) = 0d0 +! !$OMP PARALLEL & +! !$OMP SHARED(nC,nOrb,nR,nO,nS,rho,ERI,XpY,eh_trip_Gam) & +! !$OMP PRIVATE(q,p,jb,ia) & +! !$OMP DEFAULT(NONE) +! !$OMP DO + do q=nC+1,nOrb-nR + do p=nC+1,nOrb-nR + + do ia=1,nS + + jb = 0 + do j=nC+1,nO + do b=nO+1,nOrb-nR + jb = jb + 1 + + X = 0.5d0*(XpY(ia,jb) + XmY(ia,jb)) + Y = 0.5d0*(XpY(ia,jb) - XmY(ia,jb)) + + rho(p,q,ia) = rho(p,q,ia) - ERI(q,j,b,p) * X ! & + ! (- 0d0*0.5d0*eh_sing_Phi(q,j,b,p) + 0d0*0.5d0*eh_trip_Phi(q,j,b,p) & + ! - 0d0*0.5d0*pp_sing_Phi(q,j,p,b) + 0d0*0.5d0*pp_trip_Phi(q,j,p,b)) * X & + ! + (- ERI(q,b,j,p) & + ! - 0d0*0.5d0*eh_sing_Phi(q,b,j,p) + 0d0*0.5d0*eh_trip_Phi(q,b,j,p) & + ! - 0d0*0.5d0*pp_sing_Phi(q,b,p,j) + 0d0*0.5d0*pp_trip_Phi(q,b,p,j)) * Y + + + end do + end do + + end do + + end do + end do +! !$OMP END DO +! !$OMP END PARALLEL + +end subroutine + + +subroutine R_pp_singlet_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_sing_Phi,eh_trip_Phi,X1,Y1,rho1,X2,Y2,rho2) + +! Compute excitation densities in the singlet pp channel + + implicit none + +! Input variables + + + integer,intent(in) :: nOrb,nC,nO,nR + integer,intent(in) :: nOO,nVV + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: X1(nVV,nVV) + double precision,intent(in) :: Y1(nOO,nVV) + double precision,intent(in) :: X2(nVV,nOO) + double precision,intent(in) :: Y2(nOO,nOO) + +! Local variables + + integer :: i,j,k,l + integer :: a,b,c,d + integer :: p,q + integer :: ab,cd,ij,kl + double precision,external :: Kronecker_delta + +! Output variables + + double precision,intent(out) :: rho1(nOrb,nOrb,nVV) + double precision,intent(out) :: rho2(nOrb,nOrb,nOO) + + integer :: dim_1, dim_2 + +! Initialization + + rho1(:,:,:) = 0d0 + rho2(:,:,:) = 0d0 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) & + !$OMP SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, eh_sing_Phi, eh_trip_Phi, X1, Y1, X2, Y2) + !$OMP DO COLLAPSE(2) + do q=nC+1,nOrb-nR + do p=nC+1,nOrb-nR + + ab=0 + do a = nO+1, nOrb-nR + do b = a, nOrb-nR + ab = ab + 1 + + cd = 0 + do c = nO+1, nOrb-nR + do d = c, nOrb-nR + cd = cd + 1 + + rho1(p,q,ab) = rho1(p,q,ab) + (ERI(p,q,c,d) + ERI(p,q,d,c)) & + !+ 0d0*0.5d0*eh_sing_Phi(p,q,c,d) - 0d0*1.5d0*eh_trip_Phi(p,q,c,d) & + !+ 0d0*0.5d0*eh_sing_Phi(p,q,d,c) - 0d0*1.5d0*eh_trip_Phi(p,q,d,c))& + *X1(cd,ab)/sqrt(1d0 + Kronecker_delta(c,d)) + + end do ! d + end do ! c + + ! kl = 0 + ! do k = nC+1, nO + ! do l = k, nO + + ! kl = kl + 1 + + ! rho1(p,q,ab) = rho1(p,q,ab) + (ERI(p,q,k,l) + ERI(p,q,l,k) & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,k,l) - 0d0*1.5d0*eh_trip_Phi(p,q,k,l) & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,l,k) - 0d0*1.5d0*eh_trip_Phi(p,q,l,k))& + ! *Y1(kl,ab)/sqrt(1d0 + Kronecker_delta(k,l)) + ! end do ! l + ! end do ! k + end do ! b + end do ! a + + ij = 0 + do i = nC+1, nO + do j = i, nO + ij = ij + 1 + + ! cd = 0 + ! do c = nO+1, nOrb-nR + ! do d = c, nOrb-nR + ! cd = cd + 1 + + ! rho2(p,q,ij) = rho2(p,q,ij) + (ERI(p,q,c,d) + ERI(p,q,d,c) & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,c,d) - 0d0*1.5d0*eh_trip_Phi(p,q,c,d) & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,d,c) - 0d0*1.5d0*eh_trip_Phi(p,q,d,c))& + ! *X2(cd,ij)/sqrt(1d0 + Kronecker_delta(c,d)) + ! end do ! d + ! end do ! c + + kl = 0 + do k = nC+1, nO + do l = k, nO + kl = kl + 1 + + rho2(p,q,ij) = rho2(p,q,ij) + (ERI(p,q,k,l) + ERI(p,q,l,k)) & + !+ 0d0*0.5d0*eh_sing_Phi(p,q,k,l) - 0d0*1.5d0*eh_trip_Phi(p,q,k,l) & + !+ 0d0*0.5d0*eh_sing_Phi(p,q,l,k) - 0d0*1.5d0*eh_trip_Phi(p,q,l,k))& + *Y2(kl,ij)/sqrt(1d0 + Kronecker_delta(k,l)) + end do ! l + end do ! k + + end do ! j + end do ! i + + end do + end do + !$OMP END DO + !$OMP END PARALLEL + +end subroutine + + + + +subroutine R_pp_triplet_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_sing_Phi,eh_trip_Phi,X1,Y1,rho1,X2,Y2,rho2) + +! Compute excitation densities in the triplet pp channel + implicit none + +! Input variables + integer,intent(in) :: nOrb,nC,nO,nR + integer,intent(in) :: nOO,nVV + double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_sing_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: eh_trip_Phi(nOrb,nOrb,nOrb,nOrb) + double precision,intent(in) :: X1(nVV,nVV) + double precision,intent(in) :: Y1(nOO,nVV) + double precision,intent(in) :: X2(nVV,nOO) + double precision,intent(in) :: Y2(nOO,nOO) + +! Local variables + integer :: i,j,k,l + integer :: a,b,c,d + integer :: p,q + integer :: ab,cd,ij,kl + double precision,external :: Kronecker_delta + +! Output variables + double precision,intent(out) :: rho1(nOrb,nOrb,nVV) + double precision,intent(out) :: rho2(nOrb,nOrb,nOO) + integer :: dim_1, dim_2 + +! Initialization + rho1(:,:,:) = 0d0 + rho2(:,:,:) = 0d0 + + dim_1 = (nOrb - nO) * (nOrb - nO - 1) / 2 + dim_2 = nO * (nO - 1) / 2 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) & + !$OMP SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, eh_sing_Phi, eh_trip_Phi, X1, Y1, X2, Y2) + !$OMP DO COLLAPSE(2) + do q = nC+1, nOrb-nR + do p = nC+1, nOrb-nR + + ab = 0 + do a = nO+1, nOrb-nR + do b = a+1, nOrb-nR + ab = ab + 1 + + cd = 0 + do c = nO+1, nOrb-nR + do d = c+1, nOrb-nR + cd = cd + 1 + + rho1(p,q,ab) = rho1(p,q,ab) + (ERI(p,q,c,d) - ERI(p,q,d,c))*X1(cd,ab)! & + !+ 0d0*0.5d0*eh_sing_Phi(p,q,c,d) + 0d0*0.5d0*eh_trip_Phi(p,q,c,d) & + !- 0d0*0.5d0*eh_sing_Phi(p,q,d,c) - 0d0*0.5d0*eh_trip_Phi(p,q,d,c) )*X1(cd,ab) + + end do ! d + end do ! c + + ! kl = 0 + ! do k = nC+1, nO + ! do l = k+1, nO + + ! kl = kl + 1 + + ! rho1(p,q,ab) = rho1(p,q,ab) + (ERI(p,q,k,l) - ERI(p,q,l,k) & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,k,l) + 0d0*0.5d0*eh_trip_Phi(p,q,k,l) & + ! - 0d0*0.5d0*eh_sing_Phi(p,q,l,k) - 0d0*0.5d0*eh_trip_Phi(p,q,l,k) )*Y1(kl,ab) + ! end do ! l + ! end do ! k + end do ! b + end do ! a + + ij = 0 + do i = nC+1, nO + do j = i+1, nO + ij = ij + 1 + + ! cd = 0 + ! do c = nO+1, nOrb-nR + ! do d = c+1, nOrb-nR + ! cd = cd + 1 + + ! rho2(p,q,ij) = rho2(p,q,ij) + (ERI(p,q,c,d) - ERI(p,q,d,c) & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,c,d) + 0d0*0.5d0*eh_trip_Phi(p,q,c,d) & + ! - 0d0*0.5d0*eh_sing_Phi(p,q,d,c) - 0d0*0.5d0*eh_trip_Phi(p,q,d,c) )*X2(cd,ij) + ! end do ! d + ! end do ! c + + kl = 0 + do k = nC+1, nO + do l = k+1, nO + kl = kl + 1 + + rho2(p,q,ij) = rho2(p,q,ij) + (ERI(p,q,k,l) - ERI(p,q,l,k))*Y2(kl,ij)! & + ! + 0d0*0.5d0*eh_sing_Phi(p,q,k,l) + 0d0*0.5d0*eh_trip_Phi(p,q,k,l) & + ! - 0d0*0.5d0*eh_sing_Phi(p,q,l,k) - 0d0*0.5d0*eh_trip_Phi(p,q,l,k) )*Y2(kl,ij) + end do ! l + end do ! k + + end do ! j + end do ! i + + end do ! p + end do ! q + !$OMP END DO + !$OMP END PARALLEL + +end subroutine diff --git a/src/QuAcK/GQuAcK.f90 b/src/QuAcK/GQuAcK.f90 index b82f134..9555608 100644 --- a/src/QuAcK/GQuAcK.f90 +++ b/src/QuAcK/GQuAcK.f90 @@ -1,13 +1,14 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, & dodrCCD,dorCCD,docrCCD,dolCCD,dophRPA,dophRPAx,docrRPA,doppRPA, & - doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2,doG0T0pp,doevGTpp,doqsGTpp, & + doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2,doG0T0pp,doevGTpp,doqsGTpp,doParquet,& nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc,S,T,V,Hc,X,dipole_int_AO, & maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, & maxSCF_CC,max_diis_CC,thresh_CC, & TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, & maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, & maxSCF_GT,max_diis_GT,thresh_GT,TDA_T,lin_GT,reg_GT,eta_GT, & - dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS) + dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS, & + TDAeh,TDApp,max_diis_1b,max_diis_2b,max_it_1b,conv_1b,max_it_2b,conv_2b,lin_parquet,reg_parquet) implicit none include 'parameters.h' @@ -27,6 +28,7 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop logical,intent(in) :: doG0F2,doevGF2,doqsGF2 logical,intent(in) :: doG0W0,doevGW,doqsGW logical,intent(in) :: doG0T0pp,doevGTpp,doqsGTpp + logical,intent(in) :: doParquet integer,intent(in) :: nNuc,nBas integer,intent(in) :: nC @@ -73,6 +75,13 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop logical,intent(in) :: dophBSE,dophBSE2,doppBSE,dBSE,dTDA logical,intent(in) :: doACFDT,exchange_kernel,doXBS + integer,intent(in) :: max_it_1b,max_it_2b + double precision,intent(in) :: conv_1b,conv_2b + integer,intent(in) :: max_diis_1b,max_diis_2b + logical,intent(in) :: TDAeh,TDApp + double precision,intent(in) :: reg_parquet + logical,intent(in) :: lin_parquet + ! Local variables logical :: doMP,doCC,doRPA,doGF,doGW,doGT @@ -86,6 +95,7 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop double precision :: start_GF ,end_GF ,t_GF double precision :: start_GW ,end_GW ,t_GW double precision :: start_GT ,end_GT ,t_GT + double precision :: start_Parquet,end_Parquet ,t_Parquet double precision :: start_int, end_int, t_int double precision,allocatable :: cHF(:,:),eHF(:),PHF(:,:),FHF(:,:) @@ -100,6 +110,8 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop integer :: nBas2 integer :: nS + double precision,allocatable :: eGW(:) + write(*,*) write(*,*) '*******************************' write(*,*) '* Generalized Branch of QuAcK *' @@ -115,6 +127,7 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop allocate(cHF(nBas2,nBas2),eHF(nBas2),PHF(nBas2,nBas2),FHF(nBas2,nBas2), & dipole_int_MO(nBas2,nBas2,ncart),ERI_MO(nBas2,nBas2,nBas2,nBas2)) + allocate(eGW(nBas2)) allocate(ERI_AO(nBas,nBas,nBas,nBas)) call wall_time(start_int) @@ -301,9 +314,10 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop if(doGW) then call wall_time(start_GW) - call GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT,exchange_kernel,doXBS, & - dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc, & - nBas,nBas2,nC,nO,nV,nR,nS,EGHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + call GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT,exchange_kernel,doXBS, & + dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc, & + nBas,nBas2,nC,nO,nV,nR,nS,EGHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF, & + eGW) call wall_time(end_GW) t_GW = end_GW - start_GW @@ -331,6 +345,22 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GT = ',t_GT,' seconds' write(*,*) + end if + +!------------------------! +! Parquet module ! +!------------------------! + + if(doParquet) then + call wall_time(start_Parquet) + call GParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,lin_parquet,reg_parquet,ENuc,max_it_1b,conv_1b,max_it_2b,conv_2b, & + nBas2,nC,nO,nV,nR,nS,EGHF,eHF,ERI_MO) + call wall_time(end_Parquet) + + t_Parquet = end_Parquet - start_Parquet + write(*,'(A65,1X,F9.3,A8)') 'Total wall time for Parquet module = ',t_Parquet,' seconds' + write(*,*) + end if end subroutine diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 5ab9b6e..1d2ba5f 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -16,6 +16,7 @@ program QuAcK logical :: docG0W0,docG0F2 logical :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh logical :: doCAP + logical :: doParquet integer :: nNuc integer :: nBas @@ -82,14 +83,22 @@ program QuAcK logical :: restart_hfb double precision :: temperature,sigma + integer :: max_it_1b,max_it_2b + double precision :: conv_1b,conv_2b + integer :: max_diis_1b,max_diis_2b + logical :: TDAeh,TDApp + double precision :: reg_parquet + logical :: lin_parquet + character(len=256) :: working_dir ! Check if the right number of arguments is provided + if(command_argument_count() < 1) then print *, "No working directory provided." stop else - call get_command_argument(1, working_dir) + call get_command_argument(1,working_dir) endif !-------------! @@ -129,6 +138,7 @@ program QuAcK doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp, & doG0T0eh,doevGTeh,doqsGTeh, & docG0W0,docG0F2, & + doParquet, & doRtest,doUtest,doGtest) doCAP = docG0W0 .or. docG0F2 .or. docRHF ! Add different cases if they need CAP docG0W0 = docG0W0 .or. (doG0W0 .and. docRHF) @@ -147,7 +157,8 @@ program QuAcK maxSCF_GT,thresh_GT,max_diis_GT,lin_GT,eta_GT,reg_GT,TDA_T, & doACFDT,exchange_kernel,doXBS, & dophBSE,dophBSE2,doppBSE,dBSE,dTDA, & - temperature,sigma,chem_pot_hf,restart_hfb) + temperature,sigma,chem_pot_hf,restart_hfb, & + TDAeh,TDApp,max_diis_1b,max_diis_2b,max_it_1b,conv_1b,max_it_2b,conv_2b,lin_parquet,reg_parquet) !------------------! ! Hardware ! @@ -262,7 +273,7 @@ program QuAcK call RQuAcK(working_dir,use_gpu,doRtest,doRHF,doROHF,docRHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, & dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, & doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW, & - doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, & + doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh,doParquet & docG0W0,docG0F2, & doCAP, & nNuc,nBas,nOrb,nC,nO,nV,nR,ENuc,ZNuc,rNuc, & @@ -270,7 +281,8 @@ program QuAcK guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,spin_conserved,spin_flip,TDA, & maxSCF_GF,max_diis_GF,renorm_GF,thresh_GF,lin_GF,reg_GF,eta_GF,maxSCF_GW,max_diis_GW,thresh_GW, & TDA_W,lin_GW,reg_GW,eta_GW,maxSCF_GT,max_diis_GT,thresh_GT,TDA_T,lin_GT,reg_GT,eta_GT, & - dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS) + dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS, & + TDAeh,TDApp,max_diis_1b,max_diis_2b,max_it_1b,conv_1b,max_it_2b,conv_2b,lin_parquet,reg_parquet) endif endif @@ -282,7 +294,7 @@ program QuAcK call UQuAcK(working_dir,doUtest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, & dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, & doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW, & - doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, & + doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh,doParquet, & nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc, & S,T,V,Hc,X,dipole_int_AO,maxSCF_HF,max_diis_HF,thresh_HF,level_shift, & guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,spin_conserved,spin_flip,TDA, & @@ -296,14 +308,14 @@ program QuAcK if(doGQuAcK) & call GQuAcK(working_dir,doGtest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, & dodrCCD,dorCCD,docrCCD,dolCCD,dophRPA,dophRPAx,docrRPA,doppRPA, & - doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2,doG0T0pp,doevGTpp,doqsGTpp, & + doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2,doG0T0pp,doevGTpp,doqsGTpp,doParquet, & nNuc,nBas,sum(nC),sum(nO),sum(nV),sum(nR),ENuc,ZNuc,rNuc,S,T,V,Hc,X,dipole_int_AO, & maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, & maxSCF_CC,max_diis_CC,thresh_CC,TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, & maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, & maxSCF_GT,max_diis_GT,thresh_GT,TDA_T,lin_GT,reg_GT,eta_GT, & - dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS) - + dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS, & + TDAeh,TDApp,max_diis_1b,max_diis_2b,max_it_1b,conv_1b,max_it_2b,conv_2b,lin_parquet,reg_parquet) !--------------------------! ! Bogoliubov QuAcK branch ! diff --git a/src/QuAcK/RQuAcK.f90 b/src/QuAcK/RQuAcK.f90 index 056e5e5..c3c1ed4 100644 --- a/src/QuAcK/RQuAcK.f90 +++ b/src/QuAcK/RQuAcK.f90 @@ -2,7 +2,7 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, & dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, & doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW, & - doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, & + doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh,doParquet & docG0W0,docG0F2, & doCAP, & nNuc,nBas,nOrb,nC,nO,nV,nR,ENuc,ZNuc,rNuc, & @@ -10,7 +10,8 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,singlet,triplet,TDA, & maxSCF_GF,max_diis_GF,renorm_GF,thresh_GF,lin_GF,reg_GF,eta_GF,maxSCF_GW,max_diis_GW,thresh_GW, & TDA_W,lin_GW,reg_GW,eta_GW,maxSCF_GT,max_diis_GT,thresh_GT,TDA_T,lin_GT,reg_GT,eta_GT, & - dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS) + dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS, & + TDAeh,TDApp,max_diis_1b,max_diis_2b,max_it_1b,conv_1b,max_it_2b,conv_2b,lin_parquet,reg_parquet) ! Restricted branch of QuAcK @@ -37,6 +38,7 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, logical,intent(in) :: doG0T0eh,doevGTeh,doqsGTeh logical,intent(in) :: docG0W0,docG0F2 logical,intent(in) :: doCAP + logical,intent(in) :: doParquet integer,intent(in) :: nNuc,nBas,nOrb integer,intent(in) :: nC @@ -86,6 +88,13 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, logical,intent(in) :: dophBSE,dophBSE2,doppBSE,dBSE,dTDA logical,intent(in) :: doACFDT,exchange_kernel,doXBS + integer,intent(in) :: max_it_1b,max_it_2b + double precision,intent(in) :: conv_1b,conv_2b + integer,intent(in) :: max_diis_1b,max_diis_2b + logical,intent(in) :: TDAeh,TDApp + double precision,intent(in) :: reg_parquet + logical,intent(in) :: lin_parquet + ! Local variables logical :: doMP,doCC,doCI,doRPA,doGF,doGW,doGT @@ -100,6 +109,7 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, double precision :: start_GF ,end_GF ,t_GF double precision :: start_GW ,end_GW ,t_GW double precision :: start_GT ,end_GT ,t_GT + double precision :: start_Parquet,end_Parquet ,t_Parquet double precision :: start_int, end_int, t_int double precision,allocatable :: eHF(:) @@ -121,6 +131,7 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, complex*16,allocatable :: complex_ERI_MO(:,:,:,:) integer :: ixyz integer :: nS + double precision,allocatable :: eGW(:) write(*,*) write(*,*) '******************************' @@ -161,6 +172,8 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, end if end if + allocate(eGW(nOrb)) + allocate(ERI_AO(nBas,nBas,nBas,nBas)) call wall_time(start_int) call read_2e_integrals(working_dir,nBas,ERI_AO) @@ -223,6 +236,11 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF, write(*,*) if (docRHF) then + ! Read and transform dipole-related integrals + + do ixyz=1,ncart + call AOtoMO(nBas,nOrb,cHF,dipole_int_AO(1,1,ixyz),dipole_int_MO(1,1,ixyz)) + end do ! Transform from to complex MOs @@ -414,7 +432,7 @@ doGF = doG0F2 .or. doevGF2 .or. doqsGF2 .or. doufG0F02 .or. doG0F3 .or. doevGF3 call RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,docG0W0,maxSCF_GW,thresh_GW,max_diis_GW, & doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, & lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc,nBas,nOrb,nC,nO,nV,nR,nS,ERHF,S,X,T, & - V,Hc,ERI_AO,ERI_MO,CAP_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + V,Hc,ERI_AO,ERI_MO,CAP_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF,eGW) call wall_time(end_GW) t_GW = end_GW - start_GW @@ -463,6 +481,22 @@ doGF = doG0F2 .or. doevGF2 .or. doqsGF2 .or. doufG0F02 .or. doG0F3 .or. doevGF3 end if +!------------------------! +! Parquet module ! +!------------------------! + + if(doParquet) then + call wall_time(start_Parquet) + call RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,lin_parquet,reg_parquet,ENuc,max_it_1b,conv_1b,max_it_2b,conv_2b, & + nOrb,nC,nO,nV,nR,nS,ERHF,eHF,ERI_MO) + call wall_time(end_Parquet) + + t_Parquet = end_Parquet - start_Parquet + write(*,'(A65,1X,F9.3,A8)') 'Total wall time for Parquet module = ', t_Parquet, ' seconds' + write(*,*) + + end if + ! Memory deallocation if (allocated(eHF)) deallocate(eHF) diff --git a/src/QuAcK/UQuAcK.f90 b/src/QuAcK/UQuAcK.f90 index 0ff1759..cb408da 100644 --- a/src/QuAcK/UQuAcK.f90 +++ b/src/QuAcK/UQuAcK.f90 @@ -1,7 +1,7 @@ subroutine UQuAcK(working_dir,dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, & dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, & doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW, & - doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, & + doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh,doParquet, & nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc, & S,T,V,Hc,X,dipole_int_AO,maxSCF_HF,max_diis_HF,thresh_HF,level_shift, & guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,spin_conserved,spin_flip,TDA, & @@ -28,6 +28,7 @@ subroutine UQuAcK(working_dir,dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dop logical,intent(in) :: doG0W0,doevGW,doqsGW,doufG0W0,doufGW logical,intent(in) :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp logical,intent(in) :: doG0T0eh,doevGTeh,doqsGTeh + logical,intent(in) :: doParquet integer,intent(in) :: nNuc,nBas integer,intent(in) :: nC(nspin) @@ -90,6 +91,7 @@ subroutine UQuAcK(working_dir,dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dop double precision :: start_GF ,end_GF ,t_GF double precision :: start_GW ,end_GW ,t_GW double precision :: start_GT ,end_GT ,t_GT + double precision :: start_Parquet,end_Parquet ,t_Parquet double precision :: start_int, end_int, t_int double precision,allocatable :: cHF(:,:,:),eHF(:,:),PHF(:,:,:),FHF(:,:,:) @@ -367,4 +369,22 @@ subroutine UQuAcK(working_dir,dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dop end if +!------------------------! +! Parquet module ! +!------------------------! + + if(doParquet) then + call wall_time(start_Parquet) +! call RParquet(max_it_macro,conv_one_body,max_it_micro,conv_two_body, & +! nOrb,nC,nO,nV,nR,nS, & +! eHF,ERI_MO) + write(*,*) 'Unrestricted version of parquet not yet implemented. Sorry.' + call wall_time(end_Parquet) + + t_Parquet = end_Parquet - start_Parquet + write(*,'(A65,1X,F9.3,A8)') 'Total wall time for Parquet module = ', t_Parquet, ' seconds' + write(*,*) + + end if + end subroutine diff --git a/src/QuAcK/read_methods.f90 b/src/QuAcK/read_methods.f90 index e85a7c5..873abb0 100644 --- a/src/QuAcK/read_methods.f90 +++ b/src/QuAcK/read_methods.f90 @@ -11,6 +11,7 @@ subroutine read_methods(working_dir, & doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp, & doG0T0eh,doevGTeh,doqsGTeh, & docG0W0,docG0F2, & + doParquet, & doRtest,doUtest,doGtest) ! Read desired methods @@ -34,6 +35,7 @@ subroutine read_methods(working_dir, & logical,intent(out) :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp logical,intent(out) :: doG0T0eh,doevGTeh,doqsGTeh logical,intent(out) :: docG0W0,docG0F2 + logical,intent(out) :: doParquet logical,intent(out) :: doRtest,doUtest,doGtest @@ -204,6 +206,7 @@ subroutine read_methods(working_dir, & if(ans1 == 'T') doG0T0eh = .true. if(ans2 == 'T') doevGTeh = .true. if(ans3 == 'T') doqsGTeh = .true. + ! Read Complex methods @@ -215,6 +218,14 @@ subroutine read_methods(working_dir, & if(ans1 == 'T') docG0W0 = .true. if(ans2 == 'T') docG0F2 = .true. + ! Read coupled channels methods + + doParquet = .false. + + read(1,*) + read(1,*) ans1 + if(ans1 == 'T') doParquet = .true. + ! Read test doRtest = .false. diff --git a/src/QuAcK/read_options.f90 b/src/QuAcK/read_options.f90 index 65b9354..028fa64 100644 --- a/src/QuAcK/read_options.f90 +++ b/src/QuAcK/read_options.f90 @@ -8,7 +8,8 @@ subroutine read_options(working_dir, maxSCF_GT,thresh_GT,max_diis_GT,lin_GT,eta_GT,reg_GT,TDA_T, & doACFDT,exchange_kernel,doXBS, & dophBSE,dophBSE2,doppBSE,dBSE,dTDA, & - temperature,sigma,chem_pot_hf,restart_hfb) + temperature,sigma,chem_pot_hf,restart_hfb, & + TDAeh,TDApp,max_diis_1b,max_diis_2b,max_it_1b,conv_1b,max_it_2b,conv_2b,lin_parquet,reg_parquet) ! Read desired methods @@ -78,6 +79,13 @@ subroutine read_options(working_dir, double precision,intent(out) :: temperature double precision,intent(out) :: sigma + integer,intent(out) :: max_it_1b,max_it_2b + double precision,intent(out) :: conv_1b,conv_2b + integer,intent(out) :: max_diis_1b,max_diis_2b + logical,intent(out) :: TDAeh,TDApp + double precision,intent(out) :: reg_parquet + logical,intent(out) :: lin_parquet + ! Local variables character(len=1) :: ans1,ans2,ans3,ans4,ans5 @@ -235,10 +243,31 @@ subroutine read_options(working_dir, if(ans1 == 'T') chem_pot_hf = .true. if(ans2 == 'T') restart_hfb = .true. + + ! Options for Parquet module + + TDAeh = .false. + TDApp = .false. + max_diis_1b = 1 + max_diis_2b = 1 + max_it_1b = 1 + conv_1b = 1d-2 + max_it_2b = 1 + conv_2b = 1d-2 + lin_parquet = .false. + reg_parquet = 0d0 + read(1,*) + read(1,*) ans1,ans2,max_it_1b,conv_1b,max_it_2b,conv_2b,max_diis_1b,max_diis_2b,ans3,reg_parquet + + if(ans1 == 'T') TDAeh = .true. + if(ans2 == 'T') TDApp = .true. + if(ans3 == 'T') lin_parquet = .true. + endif ! Close file with options + close(unit=1) end subroutine diff --git a/src/utils/non_sym_diag.f90 b/src/utils/non_sym_diag.f90 index 82d368d..3f11abe 100644 --- a/src/utils/non_sym_diag.f90 +++ b/src/utils/non_sym_diag.f90 @@ -1,6 +1,3 @@ - -! --- - subroutine diagonalize_nonsym_matrix(N, A, L, e_re, thr_d, thr_nd, thr_deg, imp_bio, verbose) ! Diagonalize a non-symmetric matrix A @@ -626,5 +623,3 @@ subroutine svd_local(A, LDA, U, LDU, D, Vt, LDVt, m, n) enddo end - - diff --git a/src/utils/read_dipole_integrals.f90 b/src/utils/read_dipole_integrals.f90 index e3ea558..ec80a1b 100644 --- a/src/utils/read_dipole_integrals.f90 +++ b/src/utils/read_dipole_integrals.f90 @@ -39,7 +39,8 @@ subroutine read_dipole_integrals(working_dir,nBas,R) else do - read(21, '(I7, I7, E25.17)', iostat=ios) mu, nu, Dip + read(21, *, iostat=ios) mu, nu, Dip +! read(21, '(I7, I7, E25.17)', iostat=ios) mu, nu, Dip if(ios /= 0) exit R(mu,nu,1) = Dip R(nu,mu,1) = Dip @@ -62,7 +63,8 @@ subroutine read_dipole_integrals(working_dir,nBas,R) else do - read(22, '(I7, I7, E25.17)', iostat=ios) mu, nu, Dip + read(22, *, iostat=ios) mu, nu, Dip +! read(22, '(I7, I7, E25.17)', iostat=ios) mu, nu, Dip if(ios /= 0) exit R(mu,nu,2) = Dip R(nu,mu,2) = Dip @@ -85,7 +87,8 @@ subroutine read_dipole_integrals(working_dir,nBas,R) else do - read(23, '(I7, I7, E25.17)', iostat=ios) mu, nu, Dip + read(23, *, iostat=ios) mu, nu, Dip +! read(23, '(I7, I7, E25.17)', iostat=ios) mu, nu, Dip if(ios /= 0) exit R(mu,nu,3) = Dip R(nu,mu,3) = Dip diff --git a/tests/inp/methods.RHF b/tests/inp/methods.RHF index 2ddb2bb..f449c96 100644 --- a/tests/inp/methods.RHF +++ b/tests/inp/methods.RHF @@ -1,5 +1,5 @@ -# RHF UHF GHF ROHF - T F F F +# RHF UHF GHF ROHF HFB + T F F F F # MP2 MP3 T T # CCD pCCD DCD CCSD CCSD(T) @@ -12,11 +12,13 @@ T T T T # G0F2 evGF2 qsGF2 ufGF2 G0F3 evGF3 T F F F F F -# G0W0 evGW qsGW SRG-qsGW ufG0W0 ufGW - T T F F F F +# G0W0 evGW qsGW ufG0W0 ufGW + T T F F F # G0T0pp evGTpp qsGTpp ufG0T0pp T F F F # G0T0eh evGTeh qsGTeh F F F +# Parquet + F # Rtest Utest Gtest T F F diff --git a/tests/inp/options.RHF b/tests/inp/options.RHF index 92084cd..07c570a 100644 --- a/tests/inp/options.RHF +++ b/tests/inp/options.RHF @@ -1,11 +1,11 @@ -# HF: maxSCF thresh DIIS guess mix shift stab search - 10000 0.0000001 5 1 0.0 0.0 F F +# HF: maxSCF thresh DIIS guess mix shift stab search + 10000 0.0000001 5 1 0.0 0.0 F F # MP: reg F # CC: maxSCF thresh DIIS 64 0.0000001 5 -# spin: TDA singlet triplet - F T T +# 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 @@ -16,3 +16,7 @@ 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 +# Parquet: TDAeh TDApp max_it_1b conv_1b max_it_2b conv_2b DIIS_1b DIIS_2b lin reg + T T 10 0.00001 10 0.00001 2 2 T 100.0 diff --git a/utils/create_function.sh b/utils/create_function.sh index 1c124ff..387809e 100755 --- a/utils/create_function.sh +++ b/utils/create_function.sh @@ -34,7 +34,7 @@ echo "function ${NAME}() result(${RES}) ! Initalization -end function ${NAME}" > ${NAME}.f90 +end function " > ${NAME}.f90 fi diff --git a/utils/create_subroutine.sh b/utils/create_subroutine.sh index e2f2a49..ca4ef81 100755 --- a/utils/create_subroutine.sh +++ b/utils/create_subroutine.sh @@ -34,7 +34,7 @@ echo "subroutine ${NAME}() ! Initalization -end subroutine ${NAME}" > ${NAME}.f90 +end subroutine" > ${NAME}.f90 fi diff --git a/utils/fsplit b/utils/fsplit deleted file mode 100755 index e967b15..0000000 Binary files a/utils/fsplit and /dev/null differ