merge conflicts

GoHu

@@ -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

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}

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.
 
 <img src="https://lcpq.github.io/PTEROSOR/img/ERC.png" width="200" />
 

input/basis.Hu

@@ -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

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

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

input/molecule.Hu

@@ -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

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

input/sph

@@ -1,2 +0,0 @@
-# rs 
- 1.0

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

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

scripts/PyDuck

@@ -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)

scripts/PyOptions.json

@@ -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 
-        }
-      }
-    }
-}

scripts/PyOptions.template.json

@@ -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 
-        }
-      }
-    }
-}

scripts/extract.sh

@@ -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 
-

scripts/run_sph.sh

@@ -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
-

scripts/scan_w.sh

@@ -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
-

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))
 

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 

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 

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 

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

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 !
 !-------------------------------------!

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)

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

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

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 !
 !---------------------------!

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

src/GW/eomRG0W0.f90

@@ -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 

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
 

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

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 

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'

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

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
 

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
 

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(*,*)

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 

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 

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 

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 

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

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 

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 

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 

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

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 

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 

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 

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 

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 

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 

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

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 

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

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 

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 

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 

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

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 !

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)

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

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.

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 

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
-
-

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

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

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

utils/create_function.sh

@@ -34,7 +34,7 @@ echo "function ${NAME}() result(${RES})
 
 ! Initalization
 
-end function ${NAME}" > ${NAME}.f90
+end function " > ${NAME}.f90
 
 fi
 

utils/create_subroutine.sh

@@ -34,7 +34,7 @@ echo "subroutine ${NAME}()
 
 ! Initalization
 
-end subroutine ${NAME}" > ${NAME}.f90
+end subroutine" > ${NAME}.f90
 
 fi