diff --git a/external/Python/docopt.py b/external/Python/docopt.py
new file mode 100644
index 00000000..7b927e2f
--- /dev/null
+++ b/external/Python/docopt.py
@@ -0,0 +1,579 @@
+"""Pythonic command-line interface parser that will make you smile.
+
+ * http://docopt.org
+ * Repository and issue-tracker: https://github.com/docopt/docopt
+ * Licensed under terms of MIT license (see LICENSE-MIT)
+ * Copyright (c) 2013 Vladimir Keleshev, vladimir@keleshev.com
+
+"""
+import sys
+import re
+
+
+__all__ = ['docopt']
+__version__ = '0.6.2'
+
+
+class DocoptLanguageError(Exception):
+
+    """Error in construction of usage-message by developer."""
+
+
+class DocoptExit(SystemExit):
+
+    """Exit in case user invoked program with incorrect arguments."""
+
+    usage = ''
+
+    def __init__(self, message=''):
+        SystemExit.__init__(self, (message + '\n' + self.usage).strip())
+
+
+class Pattern(object):
+
+    def __eq__(self, other):
+        return repr(self) == repr(other)
+
+    def __hash__(self):
+        return hash(repr(self))
+
+    def fix(self):
+        self.fix_identities()
+        self.fix_repeating_arguments()
+        return self
+
+    def fix_identities(self, uniq=None):
+        """Make pattern-tree tips point to same object if they are equal."""
+        if not hasattr(self, 'children'):
+            return self
+        uniq = list(set(self.flat())) if uniq is None else uniq
+        for i, c in enumerate(self.children):
+            if not hasattr(c, 'children'):
+                assert c in uniq
+                self.children[i] = uniq[uniq.index(c)]
+            else:
+                c.fix_identities(uniq)
+
+    def fix_repeating_arguments(self):
+        """Fix elements that should accumulate/increment values."""
+        either = [list(c.children) for c in self.either.children]
+        for case in either:
+            for e in [c for c in case if case.count(c) > 1]:
+                if type(e) is Argument or type(e) is Option and e.argcount:
+                    if e.value is None:
+                        e.value = []
+                    elif type(e.value) is not list:
+                        e.value = e.value.split()
+                if type(e) is Command or type(e) is Option and e.argcount == 0:
+                    e.value = 0
+        return self
+
+    @property
+    def either(self):
+        """Transform pattern into an equivalent, with only top-level Either."""
+        # Currently the pattern will not be equivalent, but more "narrow",
+        # although good enough to reason about list arguments.
+        ret = []
+        groups = [[self]]
+        while groups:
+            children = groups.pop(0)
+            types = [type(c) for c in children]
+            if Either in types:
+                either = [c for c in children if type(c) is Either][0]
+                children.pop(children.index(either))
+                for c in either.children:
+                    groups.append([c] + children)
+            elif Required in types:
+                required = [c for c in children if type(c) is Required][0]
+                children.pop(children.index(required))
+                groups.append(list(required.children) + children)
+            elif Optional in types:
+                optional = [c for c in children if type(c) is Optional][0]
+                children.pop(children.index(optional))
+                groups.append(list(optional.children) + children)
+            elif AnyOptions in types:
+                optional = [c for c in children if type(c) is AnyOptions][0]
+                children.pop(children.index(optional))
+                groups.append(list(optional.children) + children)
+            elif OneOrMore in types:
+                oneormore = [c for c in children if type(c) is OneOrMore][0]
+                children.pop(children.index(oneormore))
+                groups.append(list(oneormore.children) * 2 + children)
+            else:
+                ret.append(children)
+        return Either(*[Required(*e) for e in ret])
+
+
+class ChildPattern(Pattern):
+
+    def __init__(self, name, value=None):
+        self.name = name
+        self.value = value
+
+    def __repr__(self):
+        return '%s(%r, %r)' % (self.__class__.__name__, self.name, self.value)
+
+    def flat(self, *types):
+        return [self] if not types or type(self) in types else []
+
+    def match(self, left, collected=None):
+        collected = [] if collected is None else collected
+        pos, match = self.single_match(left)
+        if match is None:
+            return False, left, collected
+        left_ = left[:pos] + left[pos + 1:]
+        same_name = [a for a in collected if a.name == self.name]
+        if type(self.value) in (int, list):
+            if type(self.value) is int:
+                increment = 1
+            else:
+                increment = ([match.value] if type(match.value) is str
+                             else match.value)
+            if not same_name:
+                match.value = increment
+                return True, left_, collected + [match]
+            same_name[0].value += increment
+            return True, left_, collected
+        return True, left_, collected + [match]
+
+
+class ParentPattern(Pattern):
+
+    def __init__(self, *children):
+        self.children = list(children)
+
+    def __repr__(self):
+        return '%s(%s)' % (self.__class__.__name__,
+                           ', '.join(repr(a) for a in self.children))
+
+    def flat(self, *types):
+        if type(self) in types:
+            return [self]
+        return sum([c.flat(*types) for c in self.children], [])
+
+
+class Argument(ChildPattern):
+
+    def single_match(self, left):
+        for n, p in enumerate(left):
+            if type(p) is Argument:
+                return n, Argument(self.name, p.value)
+        return None, None
+
+    @classmethod
+    def parse(class_, source):
+        name = re.findall('(<\S*?>)', source)[0]
+        value = re.findall('\[default: (.*)\]', source, flags=re.I)
+        return class_(name, value[0] if value else None)
+
+
+class Command(Argument):
+
+    def __init__(self, name, value=False):
+        self.name = name
+        self.value = value
+
+    def single_match(self, left):
+        for n, p in enumerate(left):
+            if type(p) is Argument:
+                if p.value == self.name:
+                    return n, Command(self.name, True)
+                else:
+                    break
+        return None, None
+
+
+class Option(ChildPattern):
+
+    def __init__(self, short=None, long=None, argcount=0, value=False):
+        assert argcount in (0, 1)
+        self.short, self.long = short, long
+        self.argcount, self.value = argcount, value
+        self.value = None if value is False and argcount else value
+
+    @classmethod
+    def parse(class_, option_description):
+        short, long, argcount, value = None, None, 0, False
+        options, _, description = option_description.strip().partition('  ')
+        options = options.replace(',', ' ').replace('=', ' ')
+        for s in options.split():
+            if s.startswith('--'):
+                long = s
+            elif s.startswith('-'):
+                short = s
+            else:
+                argcount = 1
+        if argcount:
+            matched = re.findall('\[default: (.*)\]', description, flags=re.I)
+            value = matched[0] if matched else None
+        return class_(short, long, argcount, value)
+
+    def single_match(self, left):
+        for n, p in enumerate(left):
+            if self.name == p.name:
+                return n, p
+        return None, None
+
+    @property
+    def name(self):
+        return self.long or self.short
+
+    def __repr__(self):
+        return 'Option(%r, %r, %r, %r)' % (self.short, self.long,
+                                           self.argcount, self.value)
+
+
+class Required(ParentPattern):
+
+    def match(self, left, collected=None):
+        collected = [] if collected is None else collected
+        l = left
+        c = collected
+        for p in self.children:
+            matched, l, c = p.match(l, c)
+            if not matched:
+                return False, left, collected
+        return True, l, c
+
+
+class Optional(ParentPattern):
+
+    def match(self, left, collected=None):
+        collected = [] if collected is None else collected
+        for p in self.children:
+            m, left, collected = p.match(left, collected)
+        return True, left, collected
+
+
+class AnyOptions(Optional):
+
+    """Marker/placeholder for [options] shortcut."""
+
+
+class OneOrMore(ParentPattern):
+
+    def match(self, left, collected=None):
+        assert len(self.children) == 1
+        collected = [] if collected is None else collected
+        l = left
+        c = collected
+        l_ = None
+        matched = True
+        times = 0
+        while matched:
+            # could it be that something didn't match but changed l or c?
+            matched, l, c = self.children[0].match(l, c)
+            times += 1 if matched else 0
+            if l_ == l:
+                break
+            l_ = l
+        if times >= 1:
+            return True, l, c
+        return False, left, collected
+
+
+class Either(ParentPattern):
+
+    def match(self, left, collected=None):
+        collected = [] if collected is None else collected
+        outcomes = []
+        for p in self.children:
+            matched, _, _ = outcome = p.match(left, collected)
+            if matched:
+                outcomes.append(outcome)
+        if outcomes:
+            return min(outcomes, key=lambda outcome: len(outcome[1]))
+        return False, left, collected
+
+
+class TokenStream(list):
+
+    def __init__(self, source, error):
+        self += source.split() if hasattr(source, 'split') else source
+        self.error = error
+
+    def move(self):
+        return self.pop(0) if len(self) else None
+
+    def current(self):
+        return self[0] if len(self) else None
+
+
+def parse_long(tokens, options):
+    """long ::= '--' chars [ ( ' ' | '=' ) chars ] ;"""
+    long, eq, value = tokens.move().partition('=')
+    assert long.startswith('--')
+    value = None if eq == value == '' else value
+    similar = [o for o in options if o.long == long]
+    if tokens.error is DocoptExit and similar == []:  # if no exact match
+        similar = [o for o in options if o.long and o.long.startswith(long)]
+    if len(similar) > 1:  # might be simply specified ambiguously 2+ times?
+        raise tokens.error('%s is not a unique prefix: %s?' %
+                           (long, ', '.join(o.long for o in similar)))
+    elif len(similar) < 1:
+        argcount = 1 if eq == '=' else 0
+        o = Option(None, long, argcount)
+        options.append(o)
+        if tokens.error is DocoptExit:
+            o = Option(None, long, argcount, value if argcount else True)
+    else:
+        o = Option(similar[0].short, similar[0].long,
+                   similar[0].argcount, similar[0].value)
+        if o.argcount == 0:
+            if value is not None:
+                raise tokens.error('%s must not have an argument' % o.long)
+        else:
+            if value is None:
+                if tokens.current() is None:
+                    raise tokens.error('%s requires argument' % o.long)
+                value = tokens.move()
+        if tokens.error is DocoptExit:
+            o.value = value if value is not None else True
+    return [o]
+
+
+def parse_shorts(tokens, options):
+    """shorts ::= '-' ( chars )* [ [ ' ' ] chars ] ;"""
+    token = tokens.move()
+    assert token.startswith('-') and not token.startswith('--')
+    left = token.lstrip('-')
+    parsed = []
+    while left != '':
+        short, left = '-' + left[0], left[1:]
+        similar = [o for o in options if o.short == short]
+        if len(similar) > 1:
+            raise tokens.error('%s is specified ambiguously %d times' %
+                               (short, len(similar)))
+        elif len(similar) < 1:
+            o = Option(short, None, 0)
+            options.append(o)
+            if tokens.error is DocoptExit:
+                o = Option(short, None, 0, True)
+        else:  # why copying is necessary here?
+            o = Option(short, similar[0].long,
+                       similar[0].argcount, similar[0].value)
+            value = None
+            if o.argcount != 0:
+                if left == '':
+                    if tokens.current() is None:
+                        raise tokens.error('%s requires argument' % short)
+                    value = tokens.move()
+                else:
+                    value = left
+                    left = ''
+            if tokens.error is DocoptExit:
+                o.value = value if value is not None else True
+        parsed.append(o)
+    return parsed
+
+
+def parse_pattern(source, options):
+    tokens = TokenStream(re.sub(r'([\[\]\(\)\|]|\.\.\.)', r' \1 ', source),
+                         DocoptLanguageError)
+    result = parse_expr(tokens, options)
+    if tokens.current() is not None:
+        raise tokens.error('unexpected ending: %r' % ' '.join(tokens))
+    return Required(*result)
+
+
+def parse_expr(tokens, options):
+    """expr ::= seq ( '|' seq )* ;"""
+    seq = parse_seq(tokens, options)
+    if tokens.current() != '|':
+        return seq
+    result = [Required(*seq)] if len(seq) > 1 else seq
+    while tokens.current() == '|':
+        tokens.move()
+        seq = parse_seq(tokens, options)
+        result += [Required(*seq)] if len(seq) > 1 else seq
+    return [Either(*result)] if len(result) > 1 else result
+
+
+def parse_seq(tokens, options):
+    """seq ::= ( atom [ '...' ] )* ;"""
+    result = []
+    while tokens.current() not in [None, ']', ')', '|']:
+        atom = parse_atom(tokens, options)
+        if tokens.current() == '...':
+            atom = [OneOrMore(*atom)]
+            tokens.move()
+        result += atom
+    return result
+
+
+def parse_atom(tokens, options):
+    """atom ::= '(' expr ')' | '[' expr ']' | 'options'
+             | long | shorts | argument | command ;
+    """
+    token = tokens.current()
+    result = []
+    if token in '([':
+        tokens.move()
+        matching, pattern = {'(': [')', Required], '[': [']', Optional]}[token]
+        result = pattern(*parse_expr(tokens, options))
+        if tokens.move() != matching:
+            raise tokens.error("unmatched '%s'" % token)
+        return [result]
+    elif token == 'options':
+        tokens.move()
+        return [AnyOptions()]
+    elif token.startswith('--') and token != '--':
+        return parse_long(tokens, options)
+    elif token.startswith('-') and token not in ('-', '--'):
+        return parse_shorts(tokens, options)
+    elif token.startswith('<') and token.endswith('>') or token.isupper():
+        return [Argument(tokens.move())]
+    else:
+        return [Command(tokens.move())]
+
+
+def parse_argv(tokens, options, options_first=False):
+    """Parse command-line argument vector.
+
+    If options_first:
+        argv ::= [ long | shorts ]* [ argument ]* [ '--' [ argument ]* ] ;
+    else:
+        argv ::= [ long | shorts | argument ]* [ '--' [ argument ]* ] ;
+
+    """
+    parsed = []
+    while tokens.current() is not None:
+        if tokens.current() == '--':
+            return parsed + [Argument(None, v) for v in tokens]
+        elif tokens.current().startswith('--'):
+            parsed += parse_long(tokens, options)
+        elif tokens.current().startswith('-') and tokens.current() != '-':
+            parsed += parse_shorts(tokens, options)
+        elif options_first:
+            return parsed + [Argument(None, v) for v in tokens]
+        else:
+            parsed.append(Argument(None, tokens.move()))
+    return parsed
+
+
+def parse_defaults(doc):
+    # in python < 2.7 you can't pass flags=re.MULTILINE
+    split = re.split('\n *(<\S+?>|-\S+?)', doc)[1:]
+    split = [s1 + s2 for s1, s2 in zip(split[::2], split[1::2])]
+    options = [Option.parse(s) for s in split if s.startswith('-')]
+    #arguments = [Argument.parse(s) for s in split if s.startswith('<')]
+    #return options, arguments
+    return options
+
+
+def printable_usage(doc):
+    # in python < 2.7 you can't pass flags=re.IGNORECASE
+    usage_split = re.split(r'([Uu][Ss][Aa][Gg][Ee]:)', doc)
+    if len(usage_split) < 3:
+        raise DocoptLanguageError('"usage:" (case-insensitive) not found.')
+    if len(usage_split) > 3:
+        raise DocoptLanguageError('More than one "usage:" (case-insensitive).')
+    return re.split(r'\n\s*\n', ''.join(usage_split[1:]))[0].strip()
+
+
+def formal_usage(printable_usage):
+    pu = printable_usage.split()[1:]  # split and drop "usage:"
+    return '( ' + ' '.join(') | (' if s == pu[0] else s for s in pu[1:]) + ' )'
+
+
+def extras(help, version, options, doc):
+    if help and any((o.name in ('-h', '--help')) and o.value for o in options):
+        print(doc.strip("\n"))
+        sys.exit()
+    if version and any(o.name == '--version' and o.value for o in options):
+        print(version)
+        sys.exit()
+
+
+class Dict(dict):
+    def __repr__(self):
+        return '{%s}' % ',\n '.join('%r: %r' % i for i in sorted(self.items()))
+
+
+def docopt(doc, argv=None, help=True, version=None, options_first=False):
+    """Parse `argv` based on command-line interface described in `doc`.
+
+    `docopt` creates your command-line interface based on its
+    description that you pass as `doc`. Such description can contain
+    --options, <positional-argument>, commands, which could be
+    [optional], (required), (mutually | exclusive) or repeated...
+
+    Parameters
+    ----------
+    doc : str
+        Description of your command-line interface.
+    argv : list of str, optional
+        Argument vector to be parsed. sys.argv[1:] is used if not
+        provided.
+    help : bool (default: True)
+        Set to False to disable automatic help on -h or --help
+        options.
+    version : any object
+        If passed, the object will be printed if --version is in
+        `argv`.
+    options_first : bool (default: False)
+        Set to True to require options preceed positional arguments,
+        i.e. to forbid options and positional arguments intermix.
+
+    Returns
+    -------
+    args : dict
+        A dictionary, where keys are names of command-line elements
+        such as e.g. "--verbose" and "<path>", and values are the
+        parsed values of those elements.
+
+    Example
+    -------
+    >>> from docopt import docopt
+    >>> doc = '''
+    Usage:
+        my_program tcp <host> <port> [--timeout=<seconds>]
+        my_program serial <port> [--baud=<n>] [--timeout=<seconds>]
+        my_program (-h | --help | --version)
+
+    Options:
+        -h, --help  Show this screen and exit.
+        --baud=<n>  Baudrate [default: 9600]
+    '''
+    >>> argv = ['tcp', '127.0.0.1', '80', '--timeout', '30']
+    >>> docopt(doc, argv)
+    {'--baud': '9600',
+     '--help': False,
+     '--timeout': '30',
+     '--version': False,
+     '<host>': '127.0.0.1',
+     '<port>': '80',
+     'serial': False,
+     'tcp': True}
+
+    See also
+    --------
+    * For video introduction see http://docopt.org
+    * Full documentation is available in README.rst as well as online
+      at https://github.com/docopt/docopt#readme
+
+    """
+    if argv is None:
+        argv = sys.argv[1:]
+    DocoptExit.usage = printable_usage(doc)
+    options = parse_defaults(doc)
+    pattern = parse_pattern(formal_usage(DocoptExit.usage), options)
+    # [default] syntax for argument is disabled
+    #for a in pattern.flat(Argument):
+    #    same_name = [d for d in arguments if d.name == a.name]
+    #    if same_name:
+    #        a.value = same_name[0].value
+    argv = parse_argv(TokenStream(argv, DocoptExit), list(options),
+                      options_first)
+    pattern_options = set(pattern.flat(Option))
+    for ao in pattern.flat(AnyOptions):
+        doc_options = parse_defaults(doc)
+        ao.children = list(set(doc_options) - pattern_options)
+        #if any_options:
+        #    ao.children += [Option(o.short, o.long, o.argcount)
+        #                    for o in argv if type(o) is Option]
+    extras(help, version, argv, doc)
+    matched, left, collected = pattern.fix().match(argv)
+    if matched and left == []:  # better error message if left?
+        return Dict((a.name, a.value) for a in (pattern.flat() + collected))
+    raise DocoptExit()
diff --git a/include/f77_zmq.h b/include/f77_zmq.h
new file mode 100644
index 00000000..b19bb707
--- /dev/null
+++ b/include/f77_zmq.h
@@ -0,0 +1,617 @@
+      integer EADDRINUSE
+      integer EADDRNOTAVAIL
+      integer EAFNOSUPPORT
+      integer ECONNABORTED
+      integer ECONNREFUSED
+      integer ECONNRESET
+      integer EFSM
+      integer EHOSTUNREACH
+      integer EINPROGRESS
+      integer EMSGSIZE
+      integer EMTHREAD
+      integer ENETDOWN
+      integer ENETRESET
+      integer ENETUNREACH
+      integer ENOBUFS
+      integer ENOCOMPATPROTO
+      integer ENOTCONN
+      integer ENOTSOCK
+      integer ENOTSUP
+      integer EPROTONOSUPPORT
+      integer ETERM
+      integer ETIMEDOUT
+      integer ZMQ_AFFINITY
+      integer ZMQ_BACKLOG
+      integer ZMQ_BINDTODEVICE
+      integer ZMQ_BLOCKY
+      integer ZMQ_CHANNEL
+      integer ZMQ_CLIENT
+      integer ZMQ_CONFLATE
+      integer ZMQ_CONNECT_RID
+      integer ZMQ_CONNECT_ROUTING_ID
+      integer ZMQ_CONNECT_TIMEOUT
+      integer ZMQ_CURRENT_EVENT_VERSION
+      integer ZMQ_CURRENT_EVENT_VERSION_DRAFT
+      integer ZMQ_CURVE
+      integer ZMQ_CURVE_PUBLICKEY
+      integer ZMQ_CURVE_SECRETKEY
+      integer ZMQ_CURVE_SERVER
+      integer ZMQ_CURVE_SERVERKEY
+      integer ZMQ_DEALER
+      integer ZMQ_DEFINED_STDINT
+      integer ZMQ_DELAY_ATTACH_ON_CONNECT
+      integer ZMQ_DGRAM
+      integer ZMQ_DISCONNECT_MSG
+      integer ZMQ_DISH
+      integer ZMQ_DONTWAIT
+      integer ZMQ_EVENTS
+      integer ZMQ_EVENT_ACCEPTED
+      integer ZMQ_EVENT_ACCEPT_FAILED
+      integer ZMQ_EVENT_ALL
+      integer ZMQ_EVENT_ALL_V1
+      integer ZMQ_EVENT_ALL_V2
+      integer ZMQ_EVENT_BIND_FAILED
+      integer ZMQ_EVENT_CLOSED
+      integer ZMQ_EVENT_CLOSE_FAILED
+      integer ZMQ_EVENT_CONNECTED
+      integer ZMQ_EVENT_CONNECT_DELAYED
+      integer ZMQ_EVENT_CONNECT_RETRIED
+      integer ZMQ_EVENT_DISCONNECTED
+      integer ZMQ_EVENT_HANDSHAKE_FAILED_AUTH
+      integer ZMQ_EVENT_HANDSHAKE_FAILED_NO_DETAIL
+      integer ZMQ_EVENT_HANDSHAKE_FAILED_PROTOCOL
+      integer ZMQ_EVENT_HANDSHAKE_SUCCEEDED
+      integer ZMQ_EVENT_LISTENING
+      integer ZMQ_EVENT_MONITOR_STOPPED
+      integer ZMQ_EVENT_PIPES_STATS
+      integer ZMQ_FAIL_UNROUTABLE
+      integer ZMQ_FD
+      integer ZMQ_FORWARDER
+      integer ZMQ_GATHER
+      integer ZMQ_GROUP_MAX_LENGTH
+      integer ZMQ_GSSAPI
+      integer ZMQ_GSSAPI_NT_HOSTBASED
+      integer ZMQ_GSSAPI_NT_KRB5_PRINCIPAL
+      integer ZMQ_GSSAPI_NT_USER_NAME
+      integer ZMQ_GSSAPI_PLAINTEXT
+      integer ZMQ_GSSAPI_PRINCIPAL
+      integer ZMQ_GSSAPI_PRINCIPAL_NAMETYPE
+      integer ZMQ_GSSAPI_SERVER
+      integer ZMQ_GSSAPI_SERVICE_PRINCIPAL
+      integer ZMQ_GSSAPI_SERVICE_PRINCIPAL_NAMETYPE
+      integer ZMQ_HANDSHAKE_IVL
+      integer ZMQ_HAS_CAPABILITIES
+      integer ZMQ_HAUSNUMERO
+      integer ZMQ_HEARTBEAT_IVL
+      integer ZMQ_HEARTBEAT_TIMEOUT
+      integer ZMQ_HEARTBEAT_TTL
+      integer ZMQ_HELLO_MSG
+      integer ZMQ_IDENTITY
+      integer ZMQ_IMMEDIATE
+      integer ZMQ_INVERT_MATCHING
+      integer ZMQ_IN_BATCH_SIZE
+      integer ZMQ_IO_THREADS
+      integer ZMQ_IO_THREADS_DFLT
+      integer ZMQ_IPC_FILTER_GID
+      integer ZMQ_IPC_FILTER_PID
+      integer ZMQ_IPC_FILTER_UID
+      integer ZMQ_IPV4ONLY
+      integer ZMQ_IPV6
+      integer ZMQ_LAST_ENDPOINT
+      integer ZMQ_LINGER
+      integer ZMQ_LOOPBACK_FASTPATH
+      integer ZMQ_MAXMSGSIZE
+      integer ZMQ_MAX_MSGSZ
+      integer ZMQ_MAX_SOCKETS
+      integer ZMQ_MAX_SOCKETS_DFLT
+      integer ZMQ_MECHANISM
+      integer ZMQ_METADATA
+      integer ZMQ_MORE
+      integer ZMQ_MSG_T_SIZE
+      integer ZMQ_MULTICAST_HOPS
+      integer ZMQ_MULTICAST_LOOP
+      integer ZMQ_MULTICAST_MAXTPDU
+      integer ZMQ_NOBLOCK
+      integer ZMQ_NOTIFY_CONNECT
+      integer ZMQ_NOTIFY_DISCONNECT
+      integer ZMQ_NULL
+      integer ZMQ_ONLY_FIRST_SUBSCRIBE
+      integer ZMQ_OUT_BATCH_SIZE
+      integer ZMQ_PAIR
+      integer ZMQ_PEER
+      integer ZMQ_PLAIN
+      integer ZMQ_PLAIN_PASSWORD
+      integer ZMQ_PLAIN_SERVER
+      integer ZMQ_PLAIN_USERNAME
+      integer ZMQ_POLLERR
+      integer ZMQ_POLLIN
+      integer ZMQ_POLLITEMS_DFLT
+      integer ZMQ_POLLOUT
+      integer ZMQ_POLLPRI
+      integer ZMQ_PRIORITY
+      integer ZMQ_PROBE_ROUTER
+      integer ZMQ_PROTOCOL_ERROR_WS_UNSPECIFIED
+      integer ZMQ_PROTOCOL_ERROR_ZAP_BAD_REQUEST_ID
+      integer ZMQ_PROTOCOL_ERROR_ZAP_BAD_VERSION
+      integer ZMQ_PROTOCOL_ERROR_ZAP_INVALID_METADATA
+      integer ZMQ_PROTOCOL_ERROR_ZAP_INVALID_STATUS_CODE
+      integer ZMQ_PROTOCOL_ERROR_ZAP_MALFORMED_REPLY
+      integer ZMQ_PROTOCOL_ERROR_ZAP_UNSPECIFIED
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_CRYPTOGRAPHIC
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_METADATA
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_SEQUENCE
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_KEY_EXCHANGE
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_ERROR
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_HELLO
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_INITIATE
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_MESSAGE
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_READY
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_UNSPECIFIED
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_WELCOME
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_MECHANISM_MISMATCH
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_UNEXPECTED_COMMAND
+      integer ZMQ_PROTOCOL_ERROR_ZMTP_UNSPECIFIED
+      integer ZMQ_PTR
+      integer ZMQ_PUB
+      integer ZMQ_PULL
+      integer ZMQ_PUSH
+      integer ZMQ_QUEUE
+      integer ZMQ_RADIO
+      integer ZMQ_RATE
+      integer ZMQ_RCVBUF
+      integer ZMQ_RCVHWM
+      integer ZMQ_RCVMORE
+      integer ZMQ_RCVTIMEO
+      integer ZMQ_RECONNECT_IVL
+      integer ZMQ_RECONNECT_IVL_MAX
+      integer ZMQ_RECONNECT_STOP
+      integer ZMQ_RECONNECT_STOP_AFTER_DISCONNECT
+      integer ZMQ_RECONNECT_STOP_CONN_REFUSED
+      integer ZMQ_RECONNECT_STOP_HANDSHAKE_FAILED
+      integer ZMQ_RECOVERY_IVL
+      integer ZMQ_REP
+      integer ZMQ_REQ
+      integer ZMQ_REQ_CORRELATE
+      integer ZMQ_REQ_RELAXED
+      integer ZMQ_ROUTER
+      integer ZMQ_ROUTER_BEHAVIOR
+      integer ZMQ_ROUTER_HANDOVER
+      integer ZMQ_ROUTER_MANDATORY
+      integer ZMQ_ROUTER_NOTIFY
+      integer ZMQ_ROUTER_RAW
+      integer ZMQ_ROUTING_ID
+      integer ZMQ_SCATTER
+      integer ZMQ_SERVER
+      integer ZMQ_SHARED
+      integer ZMQ_SNDBUF
+      integer ZMQ_SNDHWM
+      integer ZMQ_SNDMORE
+      integer ZMQ_SNDTIMEO
+      integer ZMQ_SOCKET_LIMIT
+      integer ZMQ_SOCKS_PASSWORD
+      integer ZMQ_SOCKS_PROXY
+      integer ZMQ_SOCKS_USERNAME
+      integer ZMQ_SRCFD
+      integer ZMQ_STREAM
+      integer ZMQ_STREAMER
+      integer ZMQ_STREAM_NOTIFY
+      integer ZMQ_SUB
+      integer ZMQ_SUBSCRIBE
+      integer ZMQ_TCP_ACCEPT_FILTER
+      integer ZMQ_TCP_KEEPALIVE
+      integer ZMQ_TCP_KEEPALIVE_CNT
+      integer ZMQ_TCP_KEEPALIVE_IDLE
+      integer ZMQ_TCP_KEEPALIVE_INTVL
+      integer ZMQ_TCP_MAXRT
+      integer ZMQ_THREAD_AFFINITY_CPU_ADD
+      integer ZMQ_THREAD_AFFINITY_CPU_REMOVE
+      integer ZMQ_THREAD_NAME_PREFIX
+      integer ZMQ_THREAD_PRIORITY
+      integer ZMQ_THREAD_PRIORITY_DFLT
+      integer ZMQ_THREAD_SAFE
+      integer ZMQ_THREAD_SCHED_POLICY
+      integer ZMQ_THREAD_SCHED_POLICY_DFLT
+      integer ZMQ_TOS
+      integer ZMQ_TYPE
+      integer ZMQ_UNSUBSCRIBE
+      integer ZMQ_USE_FD
+      integer ZMQ_VERSION
+      integer ZMQ_VERSION_MAJOR
+      integer ZMQ_VERSION_MINOR
+      integer ZMQ_VERSION_PATCH
+      integer ZMQ_VMCI_BUFFER_MAX_SIZE
+      integer ZMQ_VMCI_BUFFER_MIN_SIZE
+      integer ZMQ_VMCI_BUFFER_SIZE
+      integer ZMQ_VMCI_CONNECT_TIMEOUT
+      integer ZMQ_WSS_CERT_PEM
+      integer ZMQ_WSS_HOSTNAME
+      integer ZMQ_WSS_KEY_PEM
+      integer ZMQ_WSS_TRUST_PEM
+      integer ZMQ_WSS_TRUST_SYSTEM
+      integer ZMQ_XPUB
+      integer ZMQ_XPUB_MANUAL
+      integer ZMQ_XPUB_MANUAL_LAST_VALUE
+      integer ZMQ_XPUB_NODROP
+      integer ZMQ_XPUB_VERBOSE
+      integer ZMQ_XPUB_VERBOSER
+      integer ZMQ_XPUB_WELCOME_MSG
+      integer ZMQ_XREP
+      integer ZMQ_XREQ
+      integer ZMQ_XSUB
+      integer ZMQ_ZAP_DOMAIN
+      integer ZMQ_ZAP_ENFORCE_DOMAIN
+      integer ZMQ_ZERO_COPY_RECV
+      parameter(EADDRINUSE=156384717)
+      parameter(EADDRNOTAVAIL=156384718)
+      parameter(EAFNOSUPPORT=156384723)
+      parameter(ECONNABORTED=156384725)
+      parameter(ECONNREFUSED=156384719)
+      parameter(ECONNRESET=156384726)
+      parameter(EFSM=156384763)
+      parameter(EHOSTUNREACH=156384729)
+      parameter(EINPROGRESS=156384720)
+      parameter(EMSGSIZE=156384722)
+      parameter(EMTHREAD=156384766)
+      parameter(ENETDOWN=156384716)
+      parameter(ENETRESET=156384730)
+      parameter(ENETUNREACH=156384724)
+      parameter(ENOBUFS=156384715)
+      parameter(ENOCOMPATPROTO=156384764)
+      parameter(ENOTCONN=156384727)
+      parameter(ENOTSOCK=156384721)
+      parameter(ENOTSUP=156384713)
+      parameter(EPROTONOSUPPORT=156384714)
+      parameter(ETERM=156384765)
+      parameter(ETIMEDOUT=156384728)
+      parameter(ZMQ_AFFINITY=4)
+      parameter(ZMQ_BACKLOG=19)
+      parameter(ZMQ_BINDTODEVICE=92)
+      parameter(ZMQ_BLOCKY=70)
+      parameter(ZMQ_CHANNEL=20)
+      parameter(ZMQ_CLIENT=13)
+      parameter(ZMQ_CONFLATE=54)
+      parameter(ZMQ_CONNECT_RID=61)
+      parameter(ZMQ_CONNECT_ROUTING_ID=61)
+      parameter(ZMQ_CONNECT_TIMEOUT=79)
+      parameter(ZMQ_CURRENT_EVENT_VERSION=1)
+      parameter(ZMQ_CURRENT_EVENT_VERSION_DRAFT=2)
+      parameter(ZMQ_CURVE=2)
+      parameter(ZMQ_CURVE_PUBLICKEY=48)
+      parameter(ZMQ_CURVE_SECRETKEY=49)
+      parameter(ZMQ_CURVE_SERVER=47)
+      parameter(ZMQ_CURVE_SERVERKEY=50)
+      parameter(ZMQ_DEALER=5)
+      parameter(ZMQ_DEFINED_STDINT=1)
+      parameter(ZMQ_DELAY_ATTACH_ON_CONNECT=39)
+      parameter(ZMQ_DGRAM=18)
+      parameter(ZMQ_DISCONNECT_MSG=111)
+      parameter(ZMQ_DISH=15)
+      parameter(ZMQ_DONTWAIT=1)
+      parameter(ZMQ_EVENTS=15)
+      parameter(ZMQ_EVENT_ACCEPTED=32)
+      parameter(ZMQ_EVENT_ACCEPT_FAILED=64)
+      parameter(ZMQ_EVENT_ALL=65535)
+      parameter(ZMQ_EVENT_ALL_V1=65535)
+      parameter(ZMQ_EVENT_ALL_V2=131071)
+      parameter(ZMQ_EVENT_BIND_FAILED=16)
+      parameter(ZMQ_EVENT_CLOSED=128)
+      parameter(ZMQ_EVENT_CLOSE_FAILED=256)
+      parameter(ZMQ_EVENT_CONNECTED=1)
+      parameter(ZMQ_EVENT_CONNECT_DELAYED=2)
+      parameter(ZMQ_EVENT_CONNECT_RETRIED=4)
+      parameter(ZMQ_EVENT_DISCONNECTED=512)
+      parameter(ZMQ_EVENT_HANDSHAKE_FAILED_AUTH=16384)
+      parameter(ZMQ_EVENT_HANDSHAKE_FAILED_NO_DETAIL=2048)
+      parameter(ZMQ_EVENT_HANDSHAKE_FAILED_PROTOCOL=8192)
+      parameter(ZMQ_EVENT_HANDSHAKE_SUCCEEDED=4096)
+      parameter(ZMQ_EVENT_LISTENING=8)
+      parameter(ZMQ_EVENT_MONITOR_STOPPED=1024)
+      parameter(ZMQ_EVENT_PIPES_STATS=65536)
+      parameter(ZMQ_FAIL_UNROUTABLE=33)
+      parameter(ZMQ_FD=14)
+      parameter(ZMQ_FORWARDER=2)
+      parameter(ZMQ_GATHER=16)
+      parameter(ZMQ_GROUP_MAX_LENGTH=255)
+      parameter(ZMQ_GSSAPI=3)
+      parameter(ZMQ_GSSAPI_NT_HOSTBASED=0)
+      parameter(ZMQ_GSSAPI_NT_KRB5_PRINCIPAL=2)
+      parameter(ZMQ_GSSAPI_NT_USER_NAME=1)
+      parameter(ZMQ_GSSAPI_PLAINTEXT=65)
+      parameter(ZMQ_GSSAPI_PRINCIPAL=63)
+      parameter(ZMQ_GSSAPI_PRINCIPAL_NAMETYPE=90)
+      parameter(ZMQ_GSSAPI_SERVER=62)
+      parameter(ZMQ_GSSAPI_SERVICE_PRINCIPAL=64)
+      parameter(ZMQ_GSSAPI_SERVICE_PRINCIPAL_NAMETYPE=91)
+      parameter(ZMQ_HANDSHAKE_IVL=66)
+      parameter(ZMQ_HAS_CAPABILITIES=1)
+      parameter(ZMQ_HAUSNUMERO=156384712)
+      parameter(ZMQ_HEARTBEAT_IVL=75)
+      parameter(ZMQ_HEARTBEAT_TIMEOUT=77)
+      parameter(ZMQ_HEARTBEAT_TTL=76)
+      parameter(ZMQ_HELLO_MSG=110)
+      parameter(ZMQ_IDENTITY=5)
+      parameter(ZMQ_IMMEDIATE=39)
+      parameter(ZMQ_INVERT_MATCHING=74)
+      parameter(ZMQ_IN_BATCH_SIZE=101)
+      parameter(ZMQ_IO_THREADS=1)
+      parameter(ZMQ_IO_THREADS_DFLT=1)
+      parameter(ZMQ_IPC_FILTER_GID=60)
+      parameter(ZMQ_IPC_FILTER_PID=58)
+      parameter(ZMQ_IPC_FILTER_UID=59)
+      parameter(ZMQ_IPV4ONLY=31)
+      parameter(ZMQ_IPV6=42)
+      parameter(ZMQ_LAST_ENDPOINT=32)
+      parameter(ZMQ_LINGER=17)
+      parameter(ZMQ_LOOPBACK_FASTPATH=94)
+      parameter(ZMQ_MAXMSGSIZE=22)
+      parameter(ZMQ_MAX_MSGSZ=5)
+      parameter(ZMQ_MAX_SOCKETS=2)
+      parameter(ZMQ_MAX_SOCKETS_DFLT=1023)
+      parameter(ZMQ_MECHANISM=43)
+      parameter(ZMQ_METADATA=95)
+      parameter(ZMQ_MORE=1)
+      parameter(ZMQ_MSG_T_SIZE=6)
+      parameter(ZMQ_MULTICAST_HOPS=25)
+      parameter(ZMQ_MULTICAST_LOOP=96)
+      parameter(ZMQ_MULTICAST_MAXTPDU=84)
+      parameter(ZMQ_NOBLOCK=1)
+      parameter(ZMQ_NOTIFY_CONNECT=1)
+      parameter(ZMQ_NOTIFY_DISCONNECT=2)
+      parameter(ZMQ_NULL=0)
+      parameter(ZMQ_ONLY_FIRST_SUBSCRIBE=108)
+      parameter(ZMQ_OUT_BATCH_SIZE=102)
+      parameter(ZMQ_PAIR=0)
+      parameter(ZMQ_PEER=19)
+      parameter(ZMQ_PLAIN=1)
+      parameter(ZMQ_PLAIN_PASSWORD=46)
+      parameter(ZMQ_PLAIN_SERVER=44)
+      parameter(ZMQ_PLAIN_USERNAME=45)
+      parameter(ZMQ_POLLERR=4)
+      parameter(ZMQ_POLLIN=1)
+      parameter(ZMQ_POLLITEMS_DFLT=16)
+      parameter(ZMQ_POLLOUT=2)
+      parameter(ZMQ_POLLPRI=8)
+      parameter(ZMQ_PRIORITY=112)
+      parameter(ZMQ_PROBE_ROUTER=51)
+      parameter(ZMQ_PROTOCOL_ERROR_WS_UNSPECIFIED=805306368)
+      parameter(ZMQ_PROTOCOL_ERROR_ZAP_BAD_REQUEST_ID=536870914)
+      parameter(ZMQ_PROTOCOL_ERROR_ZAP_BAD_VERSION=536870915)
+      parameter(ZMQ_PROTOCOL_ERROR_ZAP_INVALID_METADATA=536870917)
+      parameter(ZMQ_PROTOCOL_ERROR_ZAP_INVALID_STATUS_CODE=536870916)
+      parameter(ZMQ_PROTOCOL_ERROR_ZAP_MALFORMED_REPLY=536870913)
+      parameter(ZMQ_PROTOCOL_ERROR_ZAP_UNSPECIFIED=536870912)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_CRYPTOGRAPHIC=285212673)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_METADATA=268435480)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_SEQUENCE=268435458)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_KEY_EXCHANGE=268435459)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_ERROR=268435477)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_HELLO=268435475)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_INITIATE=268435476)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_MESSAGE=268435474)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_READY=268435478)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_UNSPECIFIED=268435473)
+      parameter(
+     & ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_WELCOME=268435479)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_MECHANISM_MISMATCH=285212674)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_UNEXPECTED_COMMAND=268435457)
+      parameter(ZMQ_PROTOCOL_ERROR_ZMTP_UNSPECIFIED=268435456)
+      parameter(ZMQ_PTR=8)
+      parameter(ZMQ_PUB=1)
+      parameter(ZMQ_PULL=7)
+      parameter(ZMQ_PUSH=8)
+      parameter(ZMQ_QUEUE=3)
+      parameter(ZMQ_RADIO=14)
+      parameter(ZMQ_RATE=8)
+      parameter(ZMQ_RCVBUF=12)
+      parameter(ZMQ_RCVHWM=24)
+      parameter(ZMQ_RCVMORE=13)
+      parameter(ZMQ_RCVTIMEO=27)
+      parameter(ZMQ_RECONNECT_IVL=18)
+      parameter(ZMQ_RECONNECT_IVL_MAX=21)
+      parameter(ZMQ_RECONNECT_STOP=109)
+      parameter(ZMQ_RECONNECT_STOP_AFTER_DISCONNECT=3)
+      parameter(ZMQ_RECONNECT_STOP_CONN_REFUSED=1)
+      parameter(ZMQ_RECONNECT_STOP_HANDSHAKE_FAILED=2)
+      parameter(ZMQ_RECOVERY_IVL=9)
+      parameter(ZMQ_REP=4)
+      parameter(ZMQ_REQ=3)
+      parameter(ZMQ_REQ_CORRELATE=52)
+      parameter(ZMQ_REQ_RELAXED=53)
+      parameter(ZMQ_ROUTER=6)
+      parameter(ZMQ_ROUTER_BEHAVIOR=33)
+      parameter(ZMQ_ROUTER_HANDOVER=56)
+      parameter(ZMQ_ROUTER_MANDATORY=33)
+      parameter(ZMQ_ROUTER_NOTIFY=97)
+      parameter(ZMQ_ROUTER_RAW=41)
+      parameter(ZMQ_ROUTING_ID=5)
+      parameter(ZMQ_SCATTER=17)
+      parameter(ZMQ_SERVER=12)
+      parameter(ZMQ_SHARED=3)
+      parameter(ZMQ_SNDBUF=11)
+      parameter(ZMQ_SNDHWM=23)
+      parameter(ZMQ_SNDMORE=2)
+      parameter(ZMQ_SNDTIMEO=28)
+      parameter(ZMQ_SOCKET_LIMIT=3)
+      parameter(ZMQ_SOCKS_PASSWORD=100)
+      parameter(ZMQ_SOCKS_PROXY=68)
+      parameter(ZMQ_SOCKS_USERNAME=99)
+      parameter(ZMQ_SRCFD=2)
+      parameter(ZMQ_STREAM=11)
+      parameter(ZMQ_STREAMER=1)
+      parameter(ZMQ_STREAM_NOTIFY=73)
+      parameter(ZMQ_SUB=2)
+      parameter(ZMQ_SUBSCRIBE=6)
+      parameter(ZMQ_TCP_ACCEPT_FILTER=38)
+      parameter(ZMQ_TCP_KEEPALIVE=34)
+      parameter(ZMQ_TCP_KEEPALIVE_CNT=35)
+      parameter(ZMQ_TCP_KEEPALIVE_IDLE=36)
+      parameter(ZMQ_TCP_KEEPALIVE_INTVL=37)
+      parameter(ZMQ_TCP_MAXRT=80)
+      parameter(ZMQ_THREAD_AFFINITY_CPU_ADD=7)
+      parameter(ZMQ_THREAD_AFFINITY_CPU_REMOVE=8)
+      parameter(ZMQ_THREAD_NAME_PREFIX=9)
+      parameter(ZMQ_THREAD_PRIORITY=3)
+      parameter(ZMQ_THREAD_PRIORITY_DFLT=-1)
+      parameter(ZMQ_THREAD_SAFE=81)
+      parameter(ZMQ_THREAD_SCHED_POLICY=4)
+      parameter(ZMQ_THREAD_SCHED_POLICY_DFLT=-1)
+      parameter(ZMQ_TOS=57)
+      parameter(ZMQ_TYPE=16)
+      parameter(ZMQ_UNSUBSCRIBE=7)
+      parameter(ZMQ_USE_FD=89)
+      parameter(ZMQ_VERSION=40304)
+      parameter(ZMQ_VERSION_MAJOR=4)
+      parameter(ZMQ_VERSION_MINOR=3)
+      parameter(ZMQ_VERSION_PATCH=4)
+      parameter(ZMQ_VMCI_BUFFER_MAX_SIZE=87)
+      parameter(ZMQ_VMCI_BUFFER_MIN_SIZE=86)
+      parameter(ZMQ_VMCI_BUFFER_SIZE=85)
+      parameter(ZMQ_VMCI_CONNECT_TIMEOUT=88)
+      parameter(ZMQ_WSS_CERT_PEM=104)
+      parameter(ZMQ_WSS_HOSTNAME=106)
+      parameter(ZMQ_WSS_KEY_PEM=103)
+      parameter(ZMQ_WSS_TRUST_PEM=105)
+      parameter(ZMQ_WSS_TRUST_SYSTEM=107)
+      parameter(ZMQ_XPUB=9)
+      parameter(ZMQ_XPUB_MANUAL=71)
+      parameter(ZMQ_XPUB_MANUAL_LAST_VALUE=98)
+      parameter(ZMQ_XPUB_NODROP=69)
+      parameter(ZMQ_XPUB_VERBOSE=40)
+      parameter(ZMQ_XPUB_VERBOSER=78)
+      parameter(ZMQ_XPUB_WELCOME_MSG=72)
+      parameter(ZMQ_XREP=6)
+      parameter(ZMQ_XREQ=5)
+      parameter(ZMQ_XSUB=10)
+      parameter(ZMQ_ZAP_DOMAIN=55)
+      parameter(ZMQ_ZAP_ENFORCE_DOMAIN=93)
+      parameter(ZMQ_ZERO_COPY_RECV=10)
+      integer              f77_zmq_bind
+      external             f77_zmq_bind
+      integer              f77_zmq_close
+      external             f77_zmq_close
+      integer              f77_zmq_connect
+      external             f77_zmq_connect
+      integer              f77_zmq_ctx_destroy
+      external             f77_zmq_ctx_destroy
+      integer              f77_zmq_ctx_get
+      external             f77_zmq_ctx_get
+      integer*8            f77_zmq_ctx_new
+      external             f77_zmq_ctx_new
+      integer              f77_zmq_ctx_set
+      external             f77_zmq_ctx_set
+      integer              f77_zmq_ctx_shutdown
+      external             f77_zmq_ctx_shutdown
+      integer              f77_zmq_ctx_term
+      external             f77_zmq_ctx_term
+      integer              f77_zmq_disconnect
+      external             f77_zmq_disconnect
+      integer              f77_zmq_errno
+      external             f77_zmq_errno
+      integer              f77_zmq_getsockopt
+      external             f77_zmq_getsockopt
+      integer              f77_zmq_microsleep
+      external             f77_zmq_microsleep
+      integer              f77_zmq_msg_close
+      external             f77_zmq_msg_close
+      integer              f77_zmq_msg_copy
+      external             f77_zmq_msg_copy
+      integer              f77_zmq_msg_copy_from_data
+      external             f77_zmq_msg_copy_from_data
+      integer              f77_zmq_msg_copy_to_data
+      external             f77_zmq_msg_copy_to_data
+      integer              f77_zmq_msg_copy_to_data8
+      external             f77_zmq_msg_copy_to_data8
+      integer*8            f77_zmq_msg_data
+      external             f77_zmq_msg_data
+      integer*8            f77_zmq_msg_data_new
+      external             f77_zmq_msg_data_new
+      integer              f77_zmq_msg_destroy
+      external             f77_zmq_msg_destroy
+      integer              f77_zmq_msg_destroy_data
+      external             f77_zmq_msg_destroy_data
+      integer              f77_zmq_msg_get
+      external             f77_zmq_msg_get
+      character*(64)       f77_zmq_msg_gets
+      external             f77_zmq_msg_gets
+      integer              f77_zmq_msg_init
+      external             f77_zmq_msg_init
+      integer              f77_zmq_msg_init_data
+      external             f77_zmq_msg_init_data
+      integer              f77_zmq_msg_init_size
+      external             f77_zmq_msg_init_size
+      integer              f77_zmq_msg_more
+      external             f77_zmq_msg_more
+      integer              f77_zmq_msg_move
+      external             f77_zmq_msg_move
+      integer*8            f77_zmq_msg_new
+      external             f77_zmq_msg_new
+      integer              f77_zmq_msg_recv
+      external             f77_zmq_msg_recv
+      integer*8            f77_zmq_msg_recv8
+      external             f77_zmq_msg_recv8
+      integer              f77_zmq_msg_send
+      external             f77_zmq_msg_send
+      integer*8            f77_zmq_msg_send8
+      external             f77_zmq_msg_send8
+      integer              f77_zmq_msg_set
+      external             f77_zmq_msg_set
+      integer              f77_zmq_msg_size
+      external             f77_zmq_msg_size
+      integer*8            f77_zmq_msg_size8
+      external             f77_zmq_msg_size8
+      integer              f77_zmq_poll
+      external             f77_zmq_poll
+      integer              f77_zmq_pollitem_destroy
+      external             f77_zmq_pollitem_destroy
+      integer*8            f77_zmq_pollitem_new
+      external             f77_zmq_pollitem_new
+      integer              f77_zmq_pollitem_revents
+      external             f77_zmq_pollitem_revents
+      integer              f77_zmq_pollitem_set_events
+      external             f77_zmq_pollitem_set_events
+      integer              f77_zmq_pollitem_set_socket
+      external             f77_zmq_pollitem_set_socket
+      integer              f77_zmq_proxy
+      external             f77_zmq_proxy
+      integer              f77_zmq_proxy_steerable
+      external             f77_zmq_proxy_steerable
+      integer              f77_zmq_recv
+      external             f77_zmq_recv
+      integer*8            f77_zmq_recv8
+      external             f77_zmq_recv8
+      integer              f77_zmq_send
+      external             f77_zmq_send
+      integer*8            f77_zmq_send8
+      external             f77_zmq_send8
+      integer              f77_zmq_send_const
+      external             f77_zmq_send_const
+      integer*8            f77_zmq_send_const8
+      external             f77_zmq_send_const8
+      integer              f77_zmq_setsockopt
+      external             f77_zmq_setsockopt
+      integer*8            f77_zmq_socket
+      external             f77_zmq_socket
+      integer              f77_zmq_socket_monitor
+      external             f77_zmq_socket_monitor
+      character*(64)       f77_zmq_strerror
+      external             f77_zmq_strerror
+      integer              f77_zmq_term
+      external             f77_zmq_term
+      integer              f77_zmq_unbind
+      external             f77_zmq_unbind
+      integer              f77_zmq_version
+      external             f77_zmq_version
+      integer              pthread_create
+      external             pthread_create
+      integer              pthread_create_arg
+      external             pthread_create_arg
+      integer              pthread_detach
+      external             pthread_detach
+      integer              pthread_join
+      external             pthread_join
diff --git a/ocaml/Command_line.ml b/ocaml/Command_line.ml
index 602315c6..1dd57892 100644
--- a/ocaml/Command_line.ml
+++ b/ocaml/Command_line.ml
@@ -1,5 +1,3 @@
-exception Error of string
-
 type short_opt     = char
 type long_opt      = string 
 type optional      = Mandatory | Optional 
@@ -183,16 +181,15 @@ let set_specs specs_in =
     Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
 
     if show_help () then
-        help ()
-    else
-        (* Check that all mandatory arguments are set *)
-        List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
-        |> List.iter (fun x -> 
-            match get x.long with
-            | Some _ -> ()
-            | None -> raise (Error ("--"^x.long^" option is missing."))
-            )
+        (help () ; exit 0);
 
+    (* Check that all mandatory arguments are set *)
+    List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
+    |> List.iter (fun x -> 
+        match get x.long with
+        | Some _ -> ()
+        | None -> failwith ("Error: --"^x.long^" option is missing.")
+        )
 ;;
 
 
diff --git a/ocaml/Command_line.mli b/ocaml/Command_line.mli
index 5ad4ee08..9f6e7022 100644
--- a/ocaml/Command_line.mli
+++ b/ocaml/Command_line.mli
@@ -59,8 +59,6 @@ let () =
 *)
 
 
-exception Error of string
-
 type short_opt = char
 
 type long_opt = string
diff --git a/ocaml/Input_ao_two_e_eff_pot.ml b/ocaml/Input_ao_two_e_eff_pot.ml
new file mode 100644
index 00000000..e4e2c059
--- /dev/null
+++ b/ocaml/Input_ao_two_e_eff_pot.ml
@@ -0,0 +1,113 @@
+(* =~=~ *)
+(* Init *)
+(* =~=~ *)
+
+open Qptypes;;
+open Qputils;;
+open Sexplib.Std;;
+
+module Ao_two_e_eff_pot : sig
+(* Generate type *)
+   type t = 
+     {
+       adjoint_tc_h                   : bool;
+       grad_squared                   : bool;
+     } [@@deriving sexp]
+   ;;
+  val read  : unit -> t option
+  val write : t-> unit
+  val to_string : t -> string
+  val to_rst : t -> Rst_string.t
+  val of_rst : Rst_string.t -> t option
+end = struct
+(* Generate type *)
+   type t = 
+     {
+       adjoint_tc_h                   : bool;
+       grad_squared                   : bool;
+     } [@@deriving sexp]
+   ;;
+
+  let get_default = Qpackage.get_ezfio_default "ao_two_e_eff_pot";;
+
+(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
+(* Generate Special Function *)
+(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
+
+(* Read snippet for adjoint_tc_h *)
+  let read_adjoint_tc_h () =
+    if not (Ezfio.has_ao_two_e_eff_pot_adjoint_tc_h ()) then
+       get_default "adjoint_tc_h"
+       |> bool_of_string
+       |> Ezfio.set_ao_two_e_eff_pot_adjoint_tc_h
+    ;
+    Ezfio.get_ao_two_e_eff_pot_adjoint_tc_h ()
+  ;;
+(* Write snippet for adjoint_tc_h *)
+  let write_adjoint_tc_h =
+     Ezfio.set_ao_two_e_eff_pot_adjoint_tc_h
+  ;;
+
+(* Read snippet for grad_squared *)
+  let read_grad_squared () =
+    if not (Ezfio.has_ao_two_e_eff_pot_grad_squared ()) then
+       get_default "grad_squared"
+       |> bool_of_string
+       |> Ezfio.set_ao_two_e_eff_pot_grad_squared
+    ;
+    Ezfio.get_ao_two_e_eff_pot_grad_squared ()
+  ;;
+(* Write snippet for grad_squared *)
+  let write_grad_squared =
+     Ezfio.set_ao_two_e_eff_pot_grad_squared
+  ;;
+
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+(* Generate Global Function *)
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+
+(* Read all *)
+   let read() = 
+     Some
+     {
+       adjoint_tc_h                   = read_adjoint_tc_h ();
+       grad_squared                   = read_grad_squared ();
+     }
+   ;;
+(* Write all *)
+   let write{ 
+              adjoint_tc_h;
+              grad_squared;
+            } =
+     write_adjoint_tc_h                   adjoint_tc_h;
+     write_grad_squared                   grad_squared;
+   ;;
+(* to_string*)
+   let to_string b =
+     Printf.sprintf "
+   adjoint_tc_h = %s
+   grad_squared = %s
+   "
+       (string_of_bool b.adjoint_tc_h)
+       (string_of_bool b.grad_squared)
+   ;;
+(* to_rst*)
+   let to_rst b =
+     Printf.sprintf "
+   If |true|, you compute the adjoint of the transcorrelated Hamiltonian ::
+   
+     adjoint_tc_h = %s
+   
+   If |true|, you compute also the square of the gradient of the correlation factor ::
+   
+     grad_squared = %s
+   
+   "
+       (string_of_bool b.adjoint_tc_h)
+       (string_of_bool b.grad_squared)
+   |> Rst_string.of_string
+   ;;
+  include Generic_input_of_rst;;
+  let of_rst = of_rst t_of_sexp;;
+
+end
\ No newline at end of file
diff --git a/ocaml/Input_bi_ortho_mos.ml b/ocaml/Input_bi_ortho_mos.ml
new file mode 100644
index 00000000..5523a589
--- /dev/null
+++ b/ocaml/Input_bi_ortho_mos.ml
@@ -0,0 +1,87 @@
+(* =~=~ *)
+(* Init *)
+(* =~=~ *)
+
+open Qptypes;;
+open Qputils;;
+open Sexplib.Std;;
+
+module Bi_ortho_mos : sig
+(* Generate type *)
+   type t = 
+     {
+       bi_ortho                       : bool;
+     } [@@deriving sexp]
+   ;;
+  val read  : unit -> t option
+  val write : t-> unit
+  val to_string : t -> string
+  val to_rst : t -> Rst_string.t
+  val of_rst : Rst_string.t -> t option
+end = struct
+(* Generate type *)
+   type t = 
+     {
+       bi_ortho                       : bool;
+     } [@@deriving sexp]
+   ;;
+
+  let get_default = Qpackage.get_ezfio_default "bi_ortho_mos";;
+
+(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
+(* Generate Special Function *)
+(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
+
+(* Read snippet for bi_ortho *)
+  let read_bi_ortho () =
+    if not (Ezfio.has_bi_ortho_mos_bi_ortho ()) then
+       get_default "bi_ortho"
+       |> bool_of_string
+       |> Ezfio.set_bi_ortho_mos_bi_ortho
+    ;
+    Ezfio.get_bi_ortho_mos_bi_ortho ()
+  ;;
+(* Write snippet for bi_ortho *)
+  let write_bi_ortho =
+     Ezfio.set_bi_ortho_mos_bi_ortho
+  ;;
+
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+(* Generate Global Function *)
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+
+(* Read all *)
+   let read() = 
+     Some
+     {
+       bi_ortho                       = read_bi_ortho ();
+     }
+   ;;
+(* Write all *)
+   let write{ 
+              bi_ortho;
+            } =
+     write_bi_ortho                       bi_ortho;
+   ;;
+(* to_string*)
+   let to_string b =
+     Printf.sprintf "
+   bi_ortho = %s
+   "
+       (string_of_bool b.bi_ortho)
+   ;;
+(* to_rst*)
+   let to_rst b =
+     Printf.sprintf "
+   If |true|, the MO basis is assumed to be bi-orthonormal ::
+   
+     bi_ortho = %s
+   
+   "
+       (string_of_bool b.bi_ortho)
+   |> Rst_string.of_string
+   ;;
+  include Generic_input_of_rst;;
+  let of_rst = of_rst t_of_sexp;;
+
+end
\ No newline at end of file
diff --git a/ocaml/Input_cassd.ml b/ocaml/Input_cassd.ml
new file mode 100644
index 00000000..03416f42
--- /dev/null
+++ b/ocaml/Input_cassd.ml
@@ -0,0 +1,113 @@
+(* =~=~ *)
+(* Init *)
+(* =~=~ *)
+
+open Qptypes;;
+open Qputils;;
+open Sexplib.Std;;
+
+module Cassd : sig
+(* Generate type *)
+   type t = 
+     {
+       do_ddci                        : bool;
+       do_only_1h1p                   : bool;
+     } [@@deriving sexp]
+   ;;
+  val read  : unit -> t option
+  val write : t-> unit
+  val to_string : t -> string
+  val to_rst : t -> Rst_string.t
+  val of_rst : Rst_string.t -> t option
+end = struct
+(* Generate type *)
+   type t = 
+     {
+       do_ddci                        : bool;
+       do_only_1h1p                   : bool;
+     } [@@deriving sexp]
+   ;;
+
+  let get_default = Qpackage.get_ezfio_default "cassd";;
+
+(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
+(* Generate Special Function *)
+(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
+
+(* Read snippet for do_ddci *)
+  let read_do_ddci () =
+    if not (Ezfio.has_cassd_do_ddci ()) then
+       get_default "do_ddci"
+       |> bool_of_string
+       |> Ezfio.set_cassd_do_ddci
+    ;
+    Ezfio.get_cassd_do_ddci ()
+  ;;
+(* Write snippet for do_ddci *)
+  let write_do_ddci =
+     Ezfio.set_cassd_do_ddci
+  ;;
+
+(* Read snippet for do_only_1h1p *)
+  let read_do_only_1h1p () =
+    if not (Ezfio.has_cassd_do_only_1h1p ()) then
+       get_default "do_only_1h1p"
+       |> bool_of_string
+       |> Ezfio.set_cassd_do_only_1h1p
+    ;
+    Ezfio.get_cassd_do_only_1h1p ()
+  ;;
+(* Write snippet for do_only_1h1p *)
+  let write_do_only_1h1p =
+     Ezfio.set_cassd_do_only_1h1p
+  ;;
+
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+(* Generate Global Function *)
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+
+(* Read all *)
+   let read() = 
+     Some
+     {
+       do_ddci                        = read_do_ddci ();
+       do_only_1h1p                   = read_do_only_1h1p ();
+     }
+   ;;
+(* Write all *)
+   let write{ 
+              do_ddci;
+              do_only_1h1p;
+            } =
+     write_do_ddci                        do_ddci;
+     write_do_only_1h1p                   do_only_1h1p;
+   ;;
+(* to_string*)
+   let to_string b =
+     Printf.sprintf "
+   do_ddci = %s
+   do_only_1h1p = %s
+   "
+       (string_of_bool b.do_ddci)
+       (string_of_bool b.do_only_1h1p)
+   ;;
+(* to_rst*)
+   let to_rst b =
+     Printf.sprintf "
+   If true, remove purely inactive double excitations ::
+   
+     do_ddci = %s
+   
+   If true, do only one hole/one particle excitations ::
+   
+     do_only_1h1p = %s
+   
+   "
+       (string_of_bool b.do_ddci)
+       (string_of_bool b.do_only_1h1p)
+   |> Rst_string.of_string
+   ;;
+  include Generic_input_of_rst;;
+  let of_rst = of_rst t_of_sexp;;
+
+end
\ No newline at end of file
diff --git a/ocaml/Input_cipsi_deb.ml b/ocaml/Input_cipsi_deb.ml
new file mode 100644
index 00000000..9849b0e2
--- /dev/null
+++ b/ocaml/Input_cipsi_deb.ml
@@ -0,0 +1,243 @@
+(* =~=~ *)
+(* Init *)
+(* =~=~ *)
+
+open Qptypes;;
+open Qputils;;
+open Sexplib.Std;;
+
+module Cipsi_deb : sig
+(* Generate type *)
+   type t = 
+     {
+       pert_2rdm                      : bool;
+       save_wf_after_selection        : bool;
+       seniority_max                  : int;
+       excitation_ref                 : int;
+       excitation_max                 : int;
+       excitation_alpha_max           : int;
+       excitation_beta_max            : int;
+     } [@@deriving sexp]
+   ;;
+  val read  : unit -> t option
+  val write : t-> unit
+  val to_string : t -> string
+  val to_rst : t -> Rst_string.t
+  val of_rst : Rst_string.t -> t option
+end = struct
+(* Generate type *)
+   type t = 
+     {
+       pert_2rdm                      : bool;
+       save_wf_after_selection        : bool;
+       seniority_max                  : int;
+       excitation_ref                 : int;
+       excitation_max                 : int;
+       excitation_alpha_max           : int;
+       excitation_beta_max            : int;
+     } [@@deriving sexp]
+   ;;
+
+  let get_default = Qpackage.get_ezfio_default "cipsi_deb";;
+
+(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
+(* Generate Special Function *)
+(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
+
+(* Read snippet for excitation_alpha_max *)
+  let read_excitation_alpha_max () =
+    if not (Ezfio.has_cipsi_deb_excitation_alpha_max ()) then
+       get_default "excitation_alpha_max"
+       |> int_of_string
+       |> Ezfio.set_cipsi_deb_excitation_alpha_max
+    ;
+    Ezfio.get_cipsi_deb_excitation_alpha_max ()
+  ;;
+(* Write snippet for excitation_alpha_max *)
+  let write_excitation_alpha_max =
+     Ezfio.set_cipsi_deb_excitation_alpha_max
+  ;;
+
+(* Read snippet for excitation_beta_max *)
+  let read_excitation_beta_max () =
+    if not (Ezfio.has_cipsi_deb_excitation_beta_max ()) then
+       get_default "excitation_beta_max"
+       |> int_of_string
+       |> Ezfio.set_cipsi_deb_excitation_beta_max
+    ;
+    Ezfio.get_cipsi_deb_excitation_beta_max ()
+  ;;
+(* Write snippet for excitation_beta_max *)
+  let write_excitation_beta_max =
+     Ezfio.set_cipsi_deb_excitation_beta_max
+  ;;
+
+(* Read snippet for excitation_max *)
+  let read_excitation_max () =
+    if not (Ezfio.has_cipsi_deb_excitation_max ()) then
+       get_default "excitation_max"
+       |> int_of_string
+       |> Ezfio.set_cipsi_deb_excitation_max
+    ;
+    Ezfio.get_cipsi_deb_excitation_max ()
+  ;;
+(* Write snippet for excitation_max *)
+  let write_excitation_max =
+     Ezfio.set_cipsi_deb_excitation_max
+  ;;
+
+(* Read snippet for excitation_ref *)
+  let read_excitation_ref () =
+    if not (Ezfio.has_cipsi_deb_excitation_ref ()) then
+       get_default "excitation_ref"
+       |> int_of_string
+       |> Ezfio.set_cipsi_deb_excitation_ref
+    ;
+    Ezfio.get_cipsi_deb_excitation_ref ()
+  ;;
+(* Write snippet for excitation_ref *)
+  let write_excitation_ref =
+     Ezfio.set_cipsi_deb_excitation_ref
+  ;;
+
+(* Read snippet for pert_2rdm *)
+  let read_pert_2rdm () =
+    if not (Ezfio.has_cipsi_deb_pert_2rdm ()) then
+       get_default "pert_2rdm"
+       |> bool_of_string
+       |> Ezfio.set_cipsi_deb_pert_2rdm
+    ;
+    Ezfio.get_cipsi_deb_pert_2rdm ()
+  ;;
+(* Write snippet for pert_2rdm *)
+  let write_pert_2rdm =
+     Ezfio.set_cipsi_deb_pert_2rdm
+  ;;
+
+(* Read snippet for save_wf_after_selection *)
+  let read_save_wf_after_selection () =
+    if not (Ezfio.has_cipsi_deb_save_wf_after_selection ()) then
+       get_default "save_wf_after_selection"
+       |> bool_of_string
+       |> Ezfio.set_cipsi_deb_save_wf_after_selection
+    ;
+    Ezfio.get_cipsi_deb_save_wf_after_selection ()
+  ;;
+(* Write snippet for save_wf_after_selection *)
+  let write_save_wf_after_selection =
+     Ezfio.set_cipsi_deb_save_wf_after_selection
+  ;;
+
+(* Read snippet for seniority_max *)
+  let read_seniority_max () =
+    if not (Ezfio.has_cipsi_deb_seniority_max ()) then
+       get_default "seniority_max"
+       |> int_of_string
+       |> Ezfio.set_cipsi_deb_seniority_max
+    ;
+    Ezfio.get_cipsi_deb_seniority_max ()
+  ;;
+(* Write snippet for seniority_max *)
+  let write_seniority_max =
+     Ezfio.set_cipsi_deb_seniority_max
+  ;;
+
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+(* Generate Global Function *)
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+
+(* Read all *)
+   let read() = 
+     Some
+     {
+       pert_2rdm                      = read_pert_2rdm ();
+       save_wf_after_selection        = read_save_wf_after_selection ();
+       seniority_max                  = read_seniority_max ();
+       excitation_ref                 = read_excitation_ref ();
+       excitation_max                 = read_excitation_max ();
+       excitation_alpha_max           = read_excitation_alpha_max ();
+       excitation_beta_max            = read_excitation_beta_max ();
+     }
+   ;;
+(* Write all *)
+   let write{ 
+              pert_2rdm;
+              save_wf_after_selection;
+              seniority_max;
+              excitation_ref;
+              excitation_max;
+              excitation_alpha_max;
+              excitation_beta_max;
+            } =
+     write_pert_2rdm                      pert_2rdm;
+     write_save_wf_after_selection        save_wf_after_selection;
+     write_seniority_max                  seniority_max;
+     write_excitation_ref                 excitation_ref;
+     write_excitation_max                 excitation_max;
+     write_excitation_alpha_max           excitation_alpha_max;
+     write_excitation_beta_max            excitation_beta_max;
+   ;;
+(* to_string*)
+   let to_string b =
+     Printf.sprintf "
+   pert_2rdm = %s
+   save_wf_after_selection = %s
+   seniority_max = %s
+   excitation_ref = %s
+   excitation_max = %s
+   excitation_alpha_max = %s
+   excitation_beta_max = %s
+   "
+       (string_of_bool b.pert_2rdm)
+       (string_of_bool b.save_wf_after_selection)
+       (string_of_int b.seniority_max)
+       (string_of_int b.excitation_ref)
+       (string_of_int b.excitation_max)
+       (string_of_int b.excitation_alpha_max)
+       (string_of_int b.excitation_beta_max)
+   ;;
+(* to_rst*)
+   let to_rst b =
+     Printf.sprintf "
+   If true, computes the one- and two-body rdms with perturbation theory ::
+   
+     pert_2rdm = %s
+   
+   If true, saves the wave function after the selection, before the diagonalization ::
+   
+     save_wf_after_selection = %s
+   
+   Maximum number of allowed open shells. Using -1 selects all determinants ::
+   
+     seniority_max = %s
+   
+   1: Hartree-Fock determinant, 2:All determinants of the dominant configuration ::
+   
+     excitation_ref = %s
+   
+   Maximum number of excitation with respect to the Hartree-Fock determinant. Using -1 selects all determinants ::
+   
+     excitation_max = %s
+   
+   Maximum number of excitation for alpha determinants with respect to the Hartree-Fock determinant. Using -1 selects all determinants ::
+   
+     excitation_alpha_max = %s
+   
+   Maximum number of excitation for beta determinants with respect to the Hartree-Fock determinant. Using -1 selects all determinants ::
+   
+     excitation_beta_max = %s
+   
+   "
+       (string_of_bool b.pert_2rdm)
+       (string_of_bool b.save_wf_after_selection)
+       (string_of_int b.seniority_max)
+       (string_of_int b.excitation_ref)
+       (string_of_int b.excitation_max)
+       (string_of_int b.excitation_alpha_max)
+       (string_of_int b.excitation_beta_max)
+   |> Rst_string.of_string
+   ;;
+  include Generic_input_of_rst;;
+  let of_rst = of_rst t_of_sexp;;
+
+end
\ No newline at end of file
diff --git a/ocaml/Input_tc_h_clean.ml b/ocaml/Input_tc_h_clean.ml
new file mode 100644
index 00000000..2fd145fa
--- /dev/null
+++ b/ocaml/Input_tc_h_clean.ml
@@ -0,0 +1,351 @@
+(* =~=~ *)
+(* Init *)
+(* =~=~ *)
+
+open Qptypes;;
+open Qputils;;
+open Sexplib.Std;;
+
+module Tc_h_clean : sig
+(* Generate type *)
+   type t = 
+     {
+       read_rl_eigv                   : bool;
+       comp_left_eigv                 : bool;
+       three_body_h_tc                : bool;
+       pure_three_body_h_tc           : bool;
+       double_normal_ord              : bool;
+       core_tc_op                     : bool;
+       full_tc_h_solver               : bool;
+       thresh_it_dav                  : Threshold.t;
+       max_it_dav                     : int;
+       thresh_psi_r                   : Threshold.t;
+       thresh_psi_r_norm              : bool;
+     } [@@deriving sexp]
+   ;;
+  val read  : unit -> t option
+  val write : t-> unit
+  val to_string : t -> string
+  val to_rst : t -> Rst_string.t
+  val of_rst : Rst_string.t -> t option
+end = struct
+(* Generate type *)
+   type t = 
+     {
+       read_rl_eigv                   : bool;
+       comp_left_eigv                 : bool;
+       three_body_h_tc                : bool;
+       pure_three_body_h_tc           : bool;
+       double_normal_ord              : bool;
+       core_tc_op                     : bool;
+       full_tc_h_solver               : bool;
+       thresh_it_dav                  : Threshold.t;
+       max_it_dav                     : int;
+       thresh_psi_r                   : Threshold.t;
+       thresh_psi_r_norm              : bool;
+     } [@@deriving sexp]
+   ;;
+
+  let get_default = Qpackage.get_ezfio_default "tc_h_clean";;
+
+(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
+(* Generate Special Function *)
+(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
+
+(* Read snippet for comp_left_eigv *)
+  let read_comp_left_eigv () =
+    if not (Ezfio.has_tc_h_clean_comp_left_eigv ()) then
+       get_default "comp_left_eigv"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_comp_left_eigv
+    ;
+    Ezfio.get_tc_h_clean_comp_left_eigv ()
+  ;;
+(* Write snippet for comp_left_eigv *)
+  let write_comp_left_eigv =
+     Ezfio.set_tc_h_clean_comp_left_eigv
+  ;;
+
+(* Read snippet for core_tc_op *)
+  let read_core_tc_op () =
+    if not (Ezfio.has_tc_h_clean_core_tc_op ()) then
+       get_default "core_tc_op"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_core_tc_op
+    ;
+    Ezfio.get_tc_h_clean_core_tc_op ()
+  ;;
+(* Write snippet for core_tc_op *)
+  let write_core_tc_op =
+     Ezfio.set_tc_h_clean_core_tc_op
+  ;;
+
+(* Read snippet for double_normal_ord *)
+  let read_double_normal_ord () =
+    if not (Ezfio.has_tc_h_clean_double_normal_ord ()) then
+       get_default "double_normal_ord"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_double_normal_ord
+    ;
+    Ezfio.get_tc_h_clean_double_normal_ord ()
+  ;;
+(* Write snippet for double_normal_ord *)
+  let write_double_normal_ord =
+     Ezfio.set_tc_h_clean_double_normal_ord
+  ;;
+
+(* Read snippet for full_tc_h_solver *)
+  let read_full_tc_h_solver () =
+    if not (Ezfio.has_tc_h_clean_full_tc_h_solver ()) then
+       get_default "full_tc_h_solver"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_full_tc_h_solver
+    ;
+    Ezfio.get_tc_h_clean_full_tc_h_solver ()
+  ;;
+(* Write snippet for full_tc_h_solver *)
+  let write_full_tc_h_solver =
+     Ezfio.set_tc_h_clean_full_tc_h_solver
+  ;;
+
+(* Read snippet for max_it_dav *)
+  let read_max_it_dav () =
+    if not (Ezfio.has_tc_h_clean_max_it_dav ()) then
+       get_default "max_it_dav"
+       |> int_of_string
+       |> Ezfio.set_tc_h_clean_max_it_dav
+    ;
+    Ezfio.get_tc_h_clean_max_it_dav ()
+  ;;
+(* Write snippet for max_it_dav *)
+  let write_max_it_dav =
+     Ezfio.set_tc_h_clean_max_it_dav
+  ;;
+
+(* Read snippet for pure_three_body_h_tc *)
+  let read_pure_three_body_h_tc () =
+    if not (Ezfio.has_tc_h_clean_pure_three_body_h_tc ()) then
+       get_default "pure_three_body_h_tc"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_pure_three_body_h_tc
+    ;
+    Ezfio.get_tc_h_clean_pure_three_body_h_tc ()
+  ;;
+(* Write snippet for pure_three_body_h_tc *)
+  let write_pure_three_body_h_tc =
+     Ezfio.set_tc_h_clean_pure_three_body_h_tc
+  ;;
+
+(* Read snippet for read_rl_eigv *)
+  let read_read_rl_eigv () =
+    if not (Ezfio.has_tc_h_clean_read_rl_eigv ()) then
+       get_default "read_rl_eigv"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_read_rl_eigv
+    ;
+    Ezfio.get_tc_h_clean_read_rl_eigv ()
+  ;;
+(* Write snippet for read_rl_eigv *)
+  let write_read_rl_eigv =
+     Ezfio.set_tc_h_clean_read_rl_eigv
+  ;;
+
+(* Read snippet for three_body_h_tc *)
+  let read_three_body_h_tc () =
+    if not (Ezfio.has_tc_h_clean_three_body_h_tc ()) then
+       get_default "three_body_h_tc"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_three_body_h_tc
+    ;
+    Ezfio.get_tc_h_clean_three_body_h_tc ()
+  ;;
+(* Write snippet for three_body_h_tc *)
+  let write_three_body_h_tc =
+     Ezfio.set_tc_h_clean_three_body_h_tc
+  ;;
+
+(* Read snippet for thresh_it_dav *)
+  let read_thresh_it_dav () =
+    if not (Ezfio.has_tc_h_clean_thresh_it_dav ()) then
+       get_default "thresh_it_dav"
+       |> float_of_string
+       |> Ezfio.set_tc_h_clean_thresh_it_dav
+    ;
+    Ezfio.get_tc_h_clean_thresh_it_dav ()
+      |> Threshold.of_float
+  ;;
+(* Write snippet for thresh_it_dav *)
+  let write_thresh_it_dav var = 
+    Threshold.to_float var
+    |> Ezfio.set_tc_h_clean_thresh_it_dav
+  ;;
+
+(* Read snippet for thresh_psi_r *)
+  let read_thresh_psi_r () =
+    if not (Ezfio.has_tc_h_clean_thresh_psi_r ()) then
+       get_default "thresh_psi_r"
+       |> float_of_string
+       |> Ezfio.set_tc_h_clean_thresh_psi_r
+    ;
+    Ezfio.get_tc_h_clean_thresh_psi_r ()
+      |> Threshold.of_float
+  ;;
+(* Write snippet for thresh_psi_r *)
+  let write_thresh_psi_r var = 
+    Threshold.to_float var
+    |> Ezfio.set_tc_h_clean_thresh_psi_r
+  ;;
+
+(* Read snippet for thresh_psi_r_norm *)
+  let read_thresh_psi_r_norm () =
+    if not (Ezfio.has_tc_h_clean_thresh_psi_r_norm ()) then
+       get_default "thresh_psi_r_norm"
+       |> bool_of_string
+       |> Ezfio.set_tc_h_clean_thresh_psi_r_norm
+    ;
+    Ezfio.get_tc_h_clean_thresh_psi_r_norm ()
+  ;;
+(* Write snippet for thresh_psi_r_norm *)
+  let write_thresh_psi_r_norm =
+     Ezfio.set_tc_h_clean_thresh_psi_r_norm
+  ;;
+
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+(* Generate Global Function *)
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+
+(* Read all *)
+   let read() = 
+     Some
+     {
+       read_rl_eigv                   = read_read_rl_eigv ();
+       comp_left_eigv                 = read_comp_left_eigv ();
+       three_body_h_tc                = read_three_body_h_tc ();
+       pure_three_body_h_tc           = read_pure_three_body_h_tc ();
+       double_normal_ord              = read_double_normal_ord ();
+       core_tc_op                     = read_core_tc_op ();
+       full_tc_h_solver               = read_full_tc_h_solver ();
+       thresh_it_dav                  = read_thresh_it_dav ();
+       max_it_dav                     = read_max_it_dav ();
+       thresh_psi_r                   = read_thresh_psi_r ();
+       thresh_psi_r_norm              = read_thresh_psi_r_norm ();
+     }
+   ;;
+(* Write all *)
+   let write{ 
+              read_rl_eigv;
+              comp_left_eigv;
+              three_body_h_tc;
+              pure_three_body_h_tc;
+              double_normal_ord;
+              core_tc_op;
+              full_tc_h_solver;
+              thresh_it_dav;
+              max_it_dav;
+              thresh_psi_r;
+              thresh_psi_r_norm;
+            } =
+     write_read_rl_eigv                   read_rl_eigv;
+     write_comp_left_eigv                 comp_left_eigv;
+     write_three_body_h_tc                three_body_h_tc;
+     write_pure_three_body_h_tc           pure_three_body_h_tc;
+     write_double_normal_ord              double_normal_ord;
+     write_core_tc_op                     core_tc_op;
+     write_full_tc_h_solver               full_tc_h_solver;
+     write_thresh_it_dav                  thresh_it_dav;
+     write_max_it_dav                     max_it_dav;
+     write_thresh_psi_r                   thresh_psi_r;
+     write_thresh_psi_r_norm              thresh_psi_r_norm;
+   ;;
+(* to_string*)
+   let to_string b =
+     Printf.sprintf "
+   read_rl_eigv = %s
+   comp_left_eigv = %s
+   three_body_h_tc = %s
+   pure_three_body_h_tc = %s
+   double_normal_ord = %s
+   core_tc_op = %s
+   full_tc_h_solver = %s
+   thresh_it_dav = %s
+   max_it_dav = %s
+   thresh_psi_r = %s
+   thresh_psi_r_norm = %s
+   "
+       (string_of_bool b.read_rl_eigv)
+       (string_of_bool b.comp_left_eigv)
+       (string_of_bool b.three_body_h_tc)
+       (string_of_bool b.pure_three_body_h_tc)
+       (string_of_bool b.double_normal_ord)
+       (string_of_bool b.core_tc_op)
+       (string_of_bool b.full_tc_h_solver)
+       (Threshold.to_string b.thresh_it_dav)
+       (string_of_int b.max_it_dav)
+       (Threshold.to_string b.thresh_psi_r)
+       (string_of_bool b.thresh_psi_r_norm)
+   ;;
+(* to_rst*)
+   let to_rst b =
+     Printf.sprintf "
+   If |true|, read the right/left eigenvectors from ezfio ::
+   
+     read_rl_eigv = %s
+   
+   If |true|, computes also the left-eigenvector ::
+   
+     comp_left_eigv = %s
+   
+   If |true|, three-body terms are included ::
+   
+     three_body_h_tc = %s
+   
+   If |true|, pure triple excitation three-body terms are included ::
+   
+     pure_three_body_h_tc = %s
+   
+   If |true|, contracted double excitation three-body terms are included ::
+   
+     double_normal_ord = %s
+   
+   If |true|, takes the usual Hamiltonian for core orbitals (assumed to be doubly occupied) ::
+   
+     core_tc_op = %s
+   
+   If |true|, you diagonalize the full TC H matrix ::
+   
+     full_tc_h_solver = %s
+   
+   Thresholds on the energy for iterative Davidson used in TC ::
+   
+     thresh_it_dav = %s
+   
+   nb max of iteration in Davidson used in TC ::
+   
+     max_it_dav = %s
+   
+   Thresholds on the coefficients of the right-eigenvector. Used for PT2 computation. ::
+   
+     thresh_psi_r = %s
+   
+   If |true|, you prune the WF to compute the PT1 coef based on the norm. If False, the pruning is done through the amplitude on the right-coefficient. ::
+   
+     thresh_psi_r_norm = %s
+   
+   "
+       (string_of_bool b.read_rl_eigv)
+       (string_of_bool b.comp_left_eigv)
+       (string_of_bool b.three_body_h_tc)
+       (string_of_bool b.pure_three_body_h_tc)
+       (string_of_bool b.double_normal_ord)
+       (string_of_bool b.core_tc_op)
+       (string_of_bool b.full_tc_h_solver)
+       (Threshold.to_string b.thresh_it_dav)
+       (string_of_int b.max_it_dav)
+       (Threshold.to_string b.thresh_psi_r)
+       (string_of_bool b.thresh_psi_r_norm)
+   |> Rst_string.of_string
+   ;;
+  include Generic_input_of_rst;;
+  let of_rst = of_rst t_of_sexp;;
+
+end
\ No newline at end of file
diff --git a/ocaml/Input_tc_scf.ml b/ocaml/Input_tc_scf.ml
new file mode 100644
index 00000000..2a709716
--- /dev/null
+++ b/ocaml/Input_tc_scf.ml
@@ -0,0 +1,143 @@
+(* =~=~ *)
+(* Init *)
+(* =~=~ *)
+
+open Qptypes;;
+open Qputils;;
+open Sexplib.Std;;
+
+module Tc_scf : sig
+(* Generate type *)
+   type t = 
+     {
+       bi_ortho                       : bool;
+       thresh_tcscf                   : Threshold.t;
+       n_it_tcscf_max                 : Strictly_positive_int.t;
+     } [@@deriving sexp]
+   ;;
+  val read  : unit -> t option
+  val write : t-> unit
+  val to_string : t -> string
+  val to_rst : t -> Rst_string.t
+  val of_rst : Rst_string.t -> t option
+end = struct
+(* Generate type *)
+   type t = 
+     {
+       bi_ortho                       : bool;
+       thresh_tcscf                   : Threshold.t;
+       n_it_tcscf_max                 : Strictly_positive_int.t;
+     } [@@deriving sexp]
+   ;;
+
+  let get_default = Qpackage.get_ezfio_default "tc_scf";;
+
+(* =~=~=~=~=~=~==~=~=~=~=~=~ *)
+(* Generate Special Function *)
+(* =~=~=~==~=~~=~=~=~=~=~=~=~ *)
+
+(* Read snippet for bi_ortho *)
+  let read_bi_ortho () =
+    if not (Ezfio.has_tc_scf_bi_ortho ()) then
+       get_default "bi_ortho"
+       |> bool_of_string
+       |> Ezfio.set_tc_scf_bi_ortho
+    ;
+    Ezfio.get_tc_scf_bi_ortho ()
+  ;;
+(* Write snippet for bi_ortho *)
+  let write_bi_ortho =
+     Ezfio.set_tc_scf_bi_ortho
+  ;;
+
+(* Read snippet for n_it_tcscf_max *)
+  let read_n_it_tcscf_max () =
+    if not (Ezfio.has_tc_scf_n_it_tcscf_max ()) then
+       get_default "n_it_tcscf_max"
+       |> int_of_string
+       |> Ezfio.set_tc_scf_n_it_tcscf_max
+    ;
+    Ezfio.get_tc_scf_n_it_tcscf_max ()
+      |> Strictly_positive_int.of_int
+  ;;
+(* Write snippet for n_it_tcscf_max *)
+  let write_n_it_tcscf_max var = 
+    Strictly_positive_int.to_int var
+    |> Ezfio.set_tc_scf_n_it_tcscf_max
+  ;;
+
+(* Read snippet for thresh_tcscf *)
+  let read_thresh_tcscf () =
+    if not (Ezfio.has_tc_scf_thresh_tcscf ()) then
+       get_default "thresh_tcscf"
+       |> float_of_string
+       |> Ezfio.set_tc_scf_thresh_tcscf
+    ;
+    Ezfio.get_tc_scf_thresh_tcscf ()
+      |> Threshold.of_float
+  ;;
+(* Write snippet for thresh_tcscf *)
+  let write_thresh_tcscf var = 
+    Threshold.to_float var
+    |> Ezfio.set_tc_scf_thresh_tcscf
+  ;;
+
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+(* Generate Global Function *)
+(* =~=~=~=~=~=~=~=~=~=~=~=~ *)
+
+(* Read all *)
+   let read() = 
+     Some
+     {
+       bi_ortho                       = read_bi_ortho ();
+       thresh_tcscf                   = read_thresh_tcscf ();
+       n_it_tcscf_max                 = read_n_it_tcscf_max ();
+     }
+   ;;
+(* Write all *)
+   let write{ 
+              bi_ortho;
+              thresh_tcscf;
+              n_it_tcscf_max;
+            } =
+     write_bi_ortho                       bi_ortho;
+     write_thresh_tcscf                   thresh_tcscf;
+     write_n_it_tcscf_max                 n_it_tcscf_max;
+   ;;
+(* to_string*)
+   let to_string b =
+     Printf.sprintf "
+   bi_ortho = %s
+   thresh_tcscf = %s
+   n_it_tcscf_max = %s
+   "
+       (string_of_bool b.bi_ortho)
+       (Threshold.to_string b.thresh_tcscf)
+       (Strictly_positive_int.to_string b.n_it_tcscf_max)
+   ;;
+(* to_rst*)
+   let to_rst b =
+     Printf.sprintf "
+   If |true|, the MO basis is assumed to be bi-orthonormal ::
+   
+     bi_ortho = %s
+   
+   Threshold on the convergence of the Hartree Fock energy. ::
+   
+     thresh_tcscf = %s
+   
+   Maximum number of SCF iterations ::
+   
+     n_it_tcscf_max = %s
+   
+   "
+       (string_of_bool b.bi_ortho)
+       (Threshold.to_string b.thresh_tcscf)
+       (Strictly_positive_int.to_string b.n_it_tcscf_max)
+   |> Rst_string.of_string
+   ;;
+  include Generic_input_of_rst;;
+  let of_rst = of_rst t_of_sexp;;
+
+end
\ No newline at end of file
diff --git a/ocaml/Molecule.ml b/ocaml/Molecule.ml
index 603244c8..9b01ac3a 100644
--- a/ocaml/Molecule.ml
+++ b/ocaml/Molecule.ml
@@ -101,7 +101,7 @@ let to_string_general ~f m =
   |> String.concat "\n"
 
 let to_string =
-  to_string_general ~f:(fun x -> Atom.to_string ~units:Units.Angstrom x)
+  to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
 
 let to_xyz =
   to_string_general ~f:Atom.to_xyz
@@ -113,7 +113,7 @@ let of_xyz_string
     s =
   let l = String_ext.split s ~on:'\n'
        |> List.filter (fun x -> x <> "")
-       |> list_map (fun x -> Atom.of_string ~units x)
+       |> list_map (fun x -> Atom.of_string units x)
   in
   let ne = ( get_charge {
         nuclei=l ;
diff --git a/ocaml/Qputils.ml b/ocaml/Qputils.ml
index 752a65a0..270e069f 100644
--- a/ocaml/Qputils.ml
+++ b/ocaml/Qputils.ml
@@ -56,7 +56,3 @@ let string_of_string s = s
 let list_map f l =
   List.rev_map f l
   |> List.rev
-
-let socket_convert socket =
-    ((Obj.magic (Obj.repr socket)) : [ `Xsub ] Zmq.Socket.t )
-
diff --git a/ocaml/qp_create_ezfio.ml b/ocaml/qp_create_ezfio.ml
index 4583b118..a4865e2b 100644
--- a/ocaml/qp_create_ezfio.ml
+++ b/ocaml/qp_create_ezfio.ml
@@ -91,7 +91,7 @@ let run ?o b au c d m p cart xyz_file =
       | Element e -> Element.to_string e
       | Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i)  (Element.to_string e)
     in
-    Hashtbl.find basis_table key
+    Hashtbl.find basis_table key 
   in
 
   let temp_filename =
@@ -132,7 +132,7 @@ let run ?o b au c d m p cart xyz_file =
               Element.to_string elem.Atom.element
             in
             Hashtbl.add basis_table key new_channel
-          ) nuclei
+          ) nuclei 
         end
       | Some (key, basis) -> (*Aux basis *)
         begin
@@ -277,16 +277,6 @@ let run ?o b au c d m p cart xyz_file =
           ) nuclei
       in
 
-      let z_core =
-         List.map (fun x ->
-                Positive_int.to_int x.Pseudo.n_elec
-                |> float_of_int
-                ) pseudo
-      in
-      let nucl_num = (List.length z_core) in
-      Ezfio.set_pseudo_nucl_charge_remove (Ezfio.ezfio_array_of_list
-        ~rank:1 ~dim:[| nucl_num |] ~data:z_core);
-
       let molecule =
         let n_elec_to_remove =
           List.fold_left (fun accu x ->
@@ -303,13 +293,13 @@ let run ?o b au c d m p cart xyz_file =
           Molecule.nuclei =
             let charges =
               list_map (fun x -> Positive_int.to_int x.Pseudo.n_elec
-                |> Float.of_int) pseudo
+                |> Float.of_int) pseudo 
               |> Array.of_list
             in
             List.mapi (fun i x ->
               { x with Atom.charge = (Charge.to_float x.Atom.charge) -. charges.(i)
                 |> Charge.of_float }
-            ) molecule.Molecule.nuclei
+            ) molecule.Molecule.nuclei 
         }
       in
       let nuclei =
@@ -366,11 +356,11 @@ let run ?o b au c d m p cart xyz_file =
               in
               if (x > accu) then x
               else accu
-            ) 0 x.Pseudo.non_local
+            ) 0 x.Pseudo.non_local 
           in
           if (x > accu) then x
           else accu
-        ) 0 pseudo
+        ) 0 pseudo 
       in
 
      let kmax =
@@ -378,10 +368,10 @@ let run ?o b au c d m p cart xyz_file =
             list_map (fun x ->
                 List.filter (fun (y,_) ->
                     (Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i)
-                  x.Pseudo.non_local
-                |> List.length ) pseudo
+                  x.Pseudo.non_local 
+                |> List.length ) pseudo 
             |> List.fold_left (fun accu x ->
-                if accu > x then accu else x) 0
+                if accu > x then accu else x) 0 
           )
         |> Array.fold_left (fun accu i ->
             if i > accu then i else accu) 0
@@ -406,11 +396,11 @@ let run ?o b au c d m p cart xyz_file =
             in
             tmp_array_dz_k.(i).(j) <- y;
             tmp_array_n_k.(i).(j)  <- z;
-          ) x.Pseudo.local
+          ) x.Pseudo.local 
         ) pseudo ;
         let concat_2d tmp_array =
           let data =
-            Array.map Array.to_list tmp_array
+            Array.map Array.to_list tmp_array 
             |> Array.to_list
             |> List.concat
           in
@@ -448,14 +438,14 @@ let run ?o b au c d m p cart xyz_file =
             tmp_array_dz_kl.(k).(i).(j) <- y;
             tmp_array_n_kl.(k).(i).(j)  <- z;
             last_idx.(k) <- i+1;
-           ) x.Pseudo.non_local
+           ) x.Pseudo.non_local 
         ) pseudo ;
         let concat_3d tmp_array =
           let data =
             Array.map (fun x ->
               Array.map Array.to_list x
               |> Array.to_list
-              |> List.concat) tmp_array
+              |> List.concat) tmp_array 
             |> Array.to_list
             |> List.concat
           in
@@ -523,8 +513,8 @@ let run ?o b au c d m p cart xyz_file =
       Ezfio.set_ao_basis_ao_num ao_num;
       Ezfio.set_ao_basis_ao_basis b;
       Ezfio.set_basis_basis b;
-      let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis
-      and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis
+      let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis 
+      and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis 
       and ao_power=
         let l = list_map (fun (x,_,_) -> x) long_basis in
         (list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.x)) l)@
@@ -536,7 +526,7 @@ let run ?o b au c d m p cart xyz_file =
         else s) 0 ao_prim_num
       in
       let gtos =
-        list_map (fun (_,x,_) -> x) long_basis
+        list_map (fun (_,x,_) -> x) long_basis 
       in
 
       let create_expo_coef ec =
@@ -544,10 +534,10 @@ let run ?o b au c d m p cart xyz_file =
             begin match ec with
             | `Coefs -> list_map (fun x->
               list_map (fun (_,coef) ->
-                AO_coef.to_float coef) x.Gto.lc) gtos
+                AO_coef.to_float coef) x.Gto.lc) gtos 
             | `Expos -> list_map (fun x->
               list_map (fun (prim,_) -> AO_expo.to_float
-              prim.GaussianPrimitive.expo) x.Gto.lc) gtos
+              prim.GaussianPrimitive.expo) x.Gto.lc) gtos 
             end
           in
           let rec get_n n accu = function
@@ -577,7 +567,7 @@ let run ?o b au c d m p cart xyz_file =
              list_map ( fun (g,_) -> g.Gto.lc ) basis
         in
         let ang_mom =
-          list_map (fun (l : (GaussianPrimitive.t * Qptypes.AO_coef.t) list)  ->
+          list_map (fun (l : (GaussianPrimitive.t * Qptypes.AO_coef.t) list)  -> 
             let x, _ = List.hd l in
             Angmom.to_l x.GaussianPrimitive.sym |> Qptypes.Positive_int.to_int
              ) lc
@@ -587,7 +577,7 @@ let run ?o b au c d m p cart xyz_file =
           |> List.concat
         in
         let coef =
-          list_map (fun l ->
+          list_map (fun l -> 
             list_map (fun (_,x) -> Qptypes.AO_coef.to_float x) l
              ) lc
           |> List.concat
@@ -595,16 +585,12 @@ let run ?o b au c d m p cart xyz_file =
         let shell_prim_num =
           list_map List.length  lc
         in
-        let shell_idx =
-          let rec make_list n accu = function
-          | 0 -> accu
-          | i -> make_list n (n :: accu) (i-1)
-          in
+        let shell_prim_idx =
           let rec aux count accu = function
           | [] -> List.rev accu
           | l::rest ->
-            let new_l = make_list count accu (List.length l) in
-            aux (count+1) new_l rest
+            let newcount = count+(List.length l) in
+            aux newcount (count::accu) rest
           in
           aux 1 [] lc
         in
@@ -616,18 +602,26 @@ let run ?o b au c d m p cart xyz_file =
           ~rank:1 ~dim:[| shell_num |] ~data:shell_prim_num);
         Ezfio.set_basis_shell_ang_mom (Ezfio.ezfio_array_of_list
           ~rank:1 ~dim:[| shell_num |] ~data:ang_mom ) ;
-        Ezfio.set_basis_shell_index (Ezfio.ezfio_array_of_list
-          ~rank:1 ~dim:[| prim_num |] ~data:shell_idx) ;
+        Ezfio.set_basis_shell_prim_index (Ezfio.ezfio_array_of_list
+          ~rank:1 ~dim:[| shell_num |] ~data:shell_prim_idx) ;
         Ezfio.set_basis_basis_nucleus_index (Ezfio.ezfio_array_of_list
-          ~rank:1 ~dim:[| shell_num |]
-          ~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis)
-          ) ;
+          ~rank:1 ~dim:[| nucl_num |]
+          ~data:(
+          list_map (fun (_,n) -> Nucl_number.to_int n) basis
+          |> List.fold_left (fun accu i -> 
+            match accu with 
+            | [] -> []
+            | (h,j) :: rest -> if j == i then ((h+1,j)::rest) else ((h+1,i)::(h+1,j)::rest)
+          ) [(0,0)]
+          |> List.rev
+          |> List.map fst
+          )) ;
         Ezfio.set_basis_nucleus_shell_num(Ezfio.ezfio_array_of_list
           ~rank:1 ~dim:[| nucl_num |]
           ~data:(
           list_map (fun (_,n) -> Nucl_number.to_int n) basis
-          |> List.fold_left (fun accu i ->
-            match accu with
+          |> List.fold_left (fun accu i -> 
+            match accu with 
             | [] -> [(1,i)]
             | (h,j) :: rest -> if j == i then ((h+1,j)::rest) else ((1,i)::(h,j)::rest)
           ) []
@@ -677,7 +671,6 @@ let run ?o b au c d m p cart xyz_file =
 
 let () =
 
-  try (
 
   let open Command_line in
   begin
@@ -724,7 +717,7 @@ If a file with the same name as the basis set exists, this file will be read.  O
 
       anonymous "FILE" Mandatory "Input file in xyz format or z-matrix.";
     ]
-    |> set_specs
+    |> set_specs 
   end;
 
 
@@ -735,7 +728,7 @@ If a file with the same name as the basis set exists, this file will be read.  O
 
   let basis =
     match Command_line.get "basis" with
-    | None -> ""
+    | None -> assert false
     | Some x -> x
   in
 
@@ -748,7 +741,7 @@ If a file with the same name as the basis set exists, this file will be read.  O
     | None -> 0
     | Some x -> ( if x.[0] = 'm' then
                     ~- (int_of_string (String.sub x 1 (String.length x - 1)))
-                  else
+                  else                                                                                                                                                       
                     int_of_string x )
   in
 
@@ -774,14 +767,10 @@ If a file with the same name as the basis set exists, this file will be read.  O
 
   let xyz_filename =
     match Command_line.anon_args () with
-    | []  -> failwith "input file is missing"
-    | x::_ -> x
+    | [x] -> x
+    | _ -> (Command_line.help () ; failwith "input file is missing")
   in
 
   run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
-  )
-  with
-  | Failure txt  -> Printf.eprintf "Fatal error: %s\n%!" txt
-  | Command_line.Error txt  -> Printf.eprintf "Command line error: %s\n%!" txt
 
 
diff --git a/ocaml/qp_run.ml b/ocaml/qp_run.ml
index dfbab167..d096b15b 100644
--- a/ocaml/qp_run.ml
+++ b/ocaml/qp_run.ml
@@ -110,7 +110,7 @@ let run slave ?prefix exe ezfio_file =
   let task_thread =
      let thread =
       Thread.create ( fun () ->
-         TaskServer.run ~port:port_number )
+         TaskServer.run port_number )
      in
      thread ();
   in
diff --git a/ocaml/qp_tunnel.ml b/ocaml/qp_tunnel.ml
index 6885db73..84e50eb5 100644
--- a/ocaml/qp_tunnel.ml
+++ b/ocaml/qp_tunnel.ml
@@ -2,7 +2,7 @@ open Qputils
 open Qptypes
 
 type ezfio_or_address = EZFIO of string | ADDRESS of string
-type req_or_sub = REQ | SUB
+type req_or_sub = REQ | SUB 
 
 let localport = 42379
 
@@ -29,7 +29,7 @@ let () =
   end;
 
   let arg =
-    let x =
+    let x = 
       match Command_line.anon_args () with
       | [x] -> x
       | _ -> begin
@@ -44,7 +44,7 @@ let () =
   in
 
 
-  let localhost =
+  let localhost = 
      Lazy.force TaskServer.ip_address
   in
 
@@ -52,28 +52,28 @@ let () =
   let long_address  =
     match arg with
     | ADDRESS x -> x
-    | EZFIO   x ->
-	let ic =
+    | EZFIO   x -> 
+	let ic = 
 	  Filename.concat  (Qpackage.ezfio_work x)  "qp_run_address"
           |> open_in
 	in
-        let result =
+        let result = 
           input_line ic
           |> String.trim
         in
         close_in ic;
         result
   in
-
+  
   let protocol, address, port =
     match String.split_on_char ':' long_address with
     | t :: a :: p :: [] -> t, a, int_of_string p
-    | _ -> failwith @@
+    | _ -> failwith @@ 
            Printf.sprintf "%s : Malformed address" long_address
   in
 
 
-  let zmq_context =
+  let zmq_context = 
     Zmq.Context.create ()
   in
 
@@ -105,10 +105,10 @@ let () =
 
 
   let create_socket  sock_type  bind_or_connect  addr =
-    let socket =
+    let socket = 
       Zmq.Socket.create zmq_context sock_type
     in
-    let () =
+    let () = 
       try
         bind_or_connect socket addr
       with
@@ -131,64 +131,37 @@ let () =
   Sys.set_signal  Sys.sigint   handler;
 
 
-  let new_thread_req addr_in addr_out =
+  let new_thread req_or_sub addr_in addr_out =
     let socket_in, socket_out =
+      match req_or_sub with
+      | REQ ->
           create_socket  Zmq.Socket.router  Zmq.Socket.bind     addr_in,
           create_socket  Zmq.Socket.dealer  Zmq.Socket.connect  addr_out
-    in
-
-
-    let action_in =
-        fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out
-    in
-
-    let action_out =
-        fun () -> Zmq.Socket.recv_all  socket_out |> Zmq.Socket.send_all  socket_in
-    in
-
-    let pollitem =
-      Zmq.Poll.mask_of
-        [| (socket_convert socket_in,  Zmq.Poll.In) ; (socket_convert socket_out, Zmq.Poll.In) |]
-    in
-
-    while !run_status do
-
-        let polling =
-          Zmq.Poll.poll  ~timeout:1000  pollitem
-        in
-
-        match polling with
-          | [| Some Zmq.Poll.In ; Some Zmq.Poll.In |]     -> ( action_out () ; action_in () )
-          | [| _                ; Some Zmq.Poll.In |]     ->   action_out ()
-          | [| Some Zmq.Poll.In ; _                |]     ->   action_in  ()
-          | _                    -> ()
-    done;
-
-    Zmq.Socket.close  socket_in;
-    Zmq.Socket.close  socket_out;
-  in
-
-  let new_thread_sub addr_in addr_out =
-    let socket_in, socket_out =
+      | SUB ->
           create_socket  Zmq.Socket.sub  Zmq.Socket.connect  addr_in,
           create_socket  Zmq.Socket.pub  Zmq.Socket.bind     addr_out
     in
 
-    Zmq.Socket.subscribe  socket_in  "";
+    if req_or_sub = SUB then
+        Zmq.Socket.subscribe  socket_in  "";
 
 
 
-   let action_in =
-        fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out
+   let action_in = 
+      match req_or_sub with
+        | REQ -> (fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out)
+        | SUB -> (fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out)
     in
 
-    let action_out =
-        fun () -> ()
+    let action_out = 
+      match req_or_sub with
+        | REQ -> (fun () -> Zmq.Socket.recv_all  socket_out |> Zmq.Socket.send_all  socket_in )
+        | SUB -> (fun () -> () )
     in
 
     let pollitem =
       Zmq.Poll.mask_of
-        [| (socket_convert socket_in,  Zmq.Poll.In) ; (socket_convert socket_out, Zmq.Poll.In) |]
+        [| (socket_in,  Zmq.Poll.In) ; (socket_out, Zmq.Poll.In) |]
     in
 
 
@@ -200,8 +173,8 @@ let () =
 
         match polling with
           | [| Some Zmq.Poll.In ; Some Zmq.Poll.In |]     -> ( action_out () ; action_in () )
-          | [| _                ; Some Zmq.Poll.In |]     ->   action_out ()
-          | [| Some Zmq.Poll.In ; _                |]     ->   action_in  ()
+          | [| _                ; Some Zmq.Poll.In |]     ->   action_out () 
+          | [| Some Zmq.Poll.In ; _                |]     ->   action_in  () 
           | _                    -> ()
     done;
 
@@ -220,8 +193,8 @@ let () =
       Printf.sprintf "tcp://*:%d"  localport
     in
 
-    let f () =
-      new_thread_req  addr_in  addr_out
+    let f () = 
+      new_thread  REQ  addr_in  addr_out
     in
 
     (Thread.create f) ()
@@ -238,8 +211,8 @@ let () =
       Printf.sprintf "tcp://*:%d" (localport+2)
     in
 
-    let f () =
-      new_thread_req  addr_in  addr_out
+    let f () = 
+      new_thread  REQ  addr_in  addr_out
     in
     (Thread.create f) ()
   in
@@ -254,8 +227,8 @@ let () =
       Printf.sprintf "tcp://*:%d" (localport+1)
     in
 
-    let f () =
-      new_thread_sub  addr_in  addr_out
+    let f () = 
+      new_thread  SUB  addr_in  addr_out
     in
     (Thread.create f) ()
   in
@@ -263,7 +236,7 @@ let () =
 
 
   let input_thread =
-    let f () =
+    let f () = 
       let addr_out =
         match arg with
         | EZFIO _ -> None
@@ -275,22 +248,22 @@ let () =
         Printf.sprintf "tcp://*:%d"  (localport+9)
       in
 
-      let socket_in =
+      let socket_in = 
         create_socket  Zmq.Socket.rep  Zmq.Socket.bind     addr_in
       in
 
       let socket_out =
-        match addr_out with
+        match addr_out with 
         | Some addr_out -> Some (
             create_socket  Zmq.Socket.req  Zmq.Socket.connect  addr_out)
         | None -> None
       in
 
-      let temp_file =
+      let temp_file = 
         Filename.temp_file "qp_tunnel" ".tar.gz"
       in
 
-      let get_ezfio_filename () =
+      let get_ezfio_filename () = 
         match arg with
         | EZFIO x -> x
         | ADDRESS _ ->
@@ -304,9 +277,9 @@ let () =
           end
       in
 
-      let get_input () =
+      let get_input () = 
         match arg with
-        | EZFIO x ->
+        | EZFIO x -> 
           begin
             Printf.sprintf "tar --exclude=\"*.gz.*\" -zcf %s %s" temp_file x
             |> Sys.command |> ignore;
@@ -318,11 +291,11 @@ let () =
             in
             ignore @@ Unix.lseek  fd  0  Unix.SEEK_SET ;
             let bstr =
-                Unix.map_file  fd  Bigarray.char
+                Unix.map_file  fd  Bigarray.char 
                   Bigarray.c_layout false [| len |]
                 |> Bigarray.array1_of_genarray
             in
-            let result =
+            let result = 
               String.init len (fun i -> bstr.{i}) ;
             in
             Unix.close fd;
@@ -340,7 +313,7 @@ let () =
           end
       in
 
-      let () =
+      let () = 
         match socket_out with
         | None -> ()
         | Some socket_out ->
@@ -356,7 +329,7 @@ let () =
           | ADDRESS _ ->
             begin
               Printf.printf "Getting input... %!";
-              let ezfio_filename =
+              let ezfio_filename = 
                 get_ezfio_filename ()
               in
               Printf.printf "%s%!" ezfio_filename;
@@ -370,7 +343,7 @@ let () =
               |> Sys.command |> ignore ;
               let oc =
                 Filename.concat  (Qpackage.ezfio_work ezfio_filename)  "qp_run_address"
-                |> open_out
+                |> open_out 
               in
               Printf.fprintf oc "tcp://%s:%d\n"  localhost  localport;
               close_out oc;
@@ -386,9 +359,9 @@ let () =
       let action () =
         match Zmq.Socket.recv socket_in with
         | "get_input" -> get_input ()
-                        |> Zmq.Socket.send socket_in
+                        |> Zmq.Socket.send socket_in 
         | "get_ezfio_filename" -> get_ezfio_filename ()
-                        |> Zmq.Socket.send socket_in
+                        |> Zmq.Socket.send socket_in 
         | "test" -> Zmq.Socket.send socket_in "OK"
         | x -> Printf.sprintf "Message '%s' not understood" x
                |> Zmq.Socket.send socket_in
@@ -399,7 +372,7 @@ On remote hosts, create ssh tunnel using:
  ssh -L %d:%s:%d -L %d:%s:%d -L %d:%s:%d -L %d:%s:%d %s &
 Or from this host connect to clients using:
  ssh -R %d:localhost:%d -R %d:localhost:%d -R %d:localhost:%d -R %d:localhost:%d <host> &
-%!"
+%!" 
                 (port  ) localhost (localport  )
                 (port+1) localhost (localport+1)
                 (port+2) localhost (localport+2)
@@ -419,12 +392,12 @@ Or from this host connect to clients using:
           match polling.(0) with
             | Some Zmq.Poll.In     -> action ()
             | None                 -> ()
-            | Some Zmq.Poll.In_out
+            | Some Zmq.Poll.In_out 
             | Some Zmq.Poll.Out    -> ()
 
       done;
 
-      let () =
+      let () = 
         match socket_out with
         | Some socket_out -> Zmq.Socket.close  socket_out
         | None -> ()
@@ -442,7 +415,7 @@ Or from this host connect to clients using:
   Thread.join ocaml_thread;
   Zmq.Context.terminate zmq_context;
   Printf.printf "qp_tunnel exited properly.\n"
-
+  
 
 
 
diff --git a/src/ao_basis/EZFIO.cfg b/src/ao_basis/EZFIO.cfg
index 51d726da..b4b4b1d9 100644
--- a/src/ao_basis/EZFIO.cfg
+++ b/src/ao_basis/EZFIO.cfg
@@ -17,7 +17,7 @@ interface: ezfio, provider
 [ao_prim_num_max]
 type: integer
 doc: Maximum number of primitives
-default: =maxval(ao_basis.ao_prim_num)
+#default: =maxval(ao_basis.ao_prim_num)
 interface: ezfio
 
 [ao_nucl]
diff --git a/src/ao_basis/aos.irp.f b/src/ao_basis/aos.irp.f
index 1cbd3976..553543b9 100644
--- a/src/ao_basis/aos.irp.f
+++ b/src/ao_basis/aos.irp.f
@@ -1,11 +1,20 @@
+
+! ---
+
 BEGIN_PROVIDER [ integer, ao_prim_num_max ]
- implicit none
+
  BEGIN_DOC
  ! Max number of primitives.
  END_DOC
- ao_prim_num_max = maxval(ao_prim_num)
+
+  implicit none
+  ao_prim_num_max = maxval(ao_prim_num)
+  call ezfio_set_ao_basis_ao_prim_num_max(ao_prim_num_max)
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
  implicit none
  BEGIN_DOC
@@ -21,21 +30,6 @@ BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ]
    enddo
  enddo
 
-END_PROVIDER
-
-BEGIN_PROVIDER [ integer, ao_first_of_shell, (shell_num) ]
- implicit none
- BEGIN_DOC
- ! Index of the shell to which the AO corresponds
- END_DOC
- integer :: i, j, k, n
- k=1
- do i=1,shell_num
-   ao_first_of_shell(i) = k
-   n = shell_ang_mom(i)+1
-   k = k+(n*(n+1))/2
- enddo
-
 END_PROVIDER
 
  BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num,ao_prim_num_max) ]
diff --git a/src/ao_basis/aos_in_r.irp.f b/src/ao_basis/aos_in_r.irp.f
index 902827eb..7fcb980a 100644
--- a/src/ao_basis/aos_in_r.irp.f
+++ b/src/ao_basis/aos_in_r.irp.f
@@ -12,21 +12,21 @@ double precision function ao_value(i,r)
  integer :: power_ao(3)
  double precision :: accu,dx,dy,dz,r2
  num_ao = ao_nucl(i)
-! power_ao(1:3)= ao_power(i,1:3)
-! center_ao(1:3) = nucl_coord(num_ao,1:3)
-! dx = (r(1) - center_ao(1))
-! dy = (r(2) - center_ao(2))
-! dz = (r(3) - center_ao(3))
-! r2 = dx*dx + dy*dy + dz*dz
-! dx = dx**power_ao(1)
-! dy = dy**power_ao(2)
-! dz = dz**power_ao(3)
+ power_ao(1:3)= ao_power(i,1:3)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dx = (r(1) - center_ao(1))
+ dy = (r(2) - center_ao(2))
+ dz = (r(3) - center_ao(3))
+ r2 = dx*dx + dy*dy + dz*dz
+ dx = dx**power_ao(1)
+ dy = dy**power_ao(2)
+ dz = dz**power_ao(3)
 
  accu = 0.d0
-! do m=1,ao_prim_num(i)
-!   beta = ao_expo_ordered_transp(m,i)
-!   accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
-! enddo
+ do m=1,ao_prim_num(i)
+   beta = ao_expo_ordered_transp(m,i)
+   accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
+ enddo
  ao_value = accu * dx * dy * dz
 
 end
diff --git a/src/ao_basis/spherical_to_cartesian.irp.f b/src/ao_basis/spherical_to_cartesian.irp.f
index 336161f8..33a3bc89 100644
--- a/src/ao_basis/spherical_to_cartesian.irp.f
+++ b/src/ao_basis/spherical_to_cartesian.irp.f
@@ -1,7 +1,7 @@
 ! Spherical to cartesian transformation matrix obtained with
 ! Horton (http://theochem.github.com/horton/, 2015)
 
-! First index is the index of the cartesian AO, obtained by ao_power_index
+! First index is the index of the carteisan AO, obtained by ao_power_index
 ! Second index is the index of the spherical AO
 
 BEGIN_PROVIDER [ double precision, cart_to_sphe_0, (1,1) ]
diff --git a/src/ao_one_e_ints/NEED b/src/ao_one_e_ints/NEED
index 61d23b1e..b9caaf5d 100644
--- a/src/ao_one_e_ints/NEED
+++ b/src/ao_one_e_ints/NEED
@@ -1,2 +1,3 @@
 ao_basis
 pseudo
+cosgtos_ao_int
diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f
index d9061d67..86fa7cd4 100644
--- a/src/ao_one_e_ints/ao_overlap.irp.f
+++ b/src/ao_one_e_ints/ao_overlap.irp.f
@@ -1,75 +1,99 @@
- BEGIN_PROVIDER [ double precision, ao_overlap,(ao_num,ao_num) ]
-&BEGIN_PROVIDER [ double precision, ao_overlap_x,(ao_num,ao_num) ]
-&BEGIN_PROVIDER [ double precision, ao_overlap_y,(ao_num,ao_num) ]
-&BEGIN_PROVIDER [ double precision, ao_overlap_z,(ao_num,ao_num) ]
-  implicit none
+
+! ---
+
+ BEGIN_PROVIDER [ double precision, ao_overlap  , (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_x, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_y, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_z, (ao_num, ao_num) ]
+
   BEGIN_DOC
-! Overlap between atomic basis functions:
-!
-! :math:`\int \chi_i(r) \chi_j(r) dr`
+  ! Overlap between atomic basis functions:
+  !
+  ! :math:`\int \chi_i(r) \chi_j(r) dr`
   END_DOC
-  integer :: i,j,n,l
-  double precision :: f
-  integer :: dim1
+
+  implicit none
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
   double precision :: overlap, overlap_x, overlap_y, overlap_z
   double precision :: alpha, beta, c
   double precision :: A_center(3), B_center(3)
-  integer :: power_A(3), power_B(3)
-  ao_overlap = 0.d0
+
+  ao_overlap   = 0.d0
   ao_overlap_x = 0.d0
   ao_overlap_y = 0.d0
   ao_overlap_z = 0.d0
-  if (read_ao_integrals_overlap) then
-     call ezfio_get_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
-     print *,  'AO overlap integrals read from disk'
+
+  if(read_ao_integrals_overlap) then
+
+    call ezfio_get_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
+    print *,  'AO overlap integrals read from disk'
+
   else
 
-    dim1=100
-    !$OMP PARALLEL DO SCHEDULE(GUIDED) &
-    !$OMP DEFAULT(NONE) &
-    !$OMP PRIVATE(A_center,B_center,power_A,power_B,&
-    !$OMP  overlap_x,overlap_y, overlap_z, overlap, &
-    !$OMP  alpha, beta,i,j,c) &
-    !$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
-    !$OMP  ao_overlap_x,ao_overlap_y,ao_overlap_z,ao_overlap,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, &
-    !$OMP  ao_expo_ordered_transp,dim1)
-    do j=1,ao_num
-    A_center(1) = nucl_coord( ao_nucl(j), 1 )
-    A_center(2) = nucl_coord( ao_nucl(j), 2 )
-    A_center(3) = nucl_coord( ao_nucl(j), 3 )
-    power_A(1)  = ao_power( j, 1 )
-    power_A(2)  = ao_power( j, 2 )
-    power_A(3)  = ao_power( j, 3 )
-    do i= 1,ao_num
-      B_center(1) = nucl_coord( ao_nucl(i), 1 )
-      B_center(2) = nucl_coord( ao_nucl(i), 2 )
-      B_center(3) = nucl_coord( ao_nucl(i), 3 )
-      power_B(1)  = ao_power( i, 1 )
-      power_B(2)  = ao_power( i, 2 )
-      power_B(3)  = ao_power( i, 3 )
-      do n = 1,ao_prim_num(j)
-      alpha = ao_expo_ordered_transp(n,j)
-      do l = 1, ao_prim_num(i)
-        beta = ao_expo_ordered_transp(l,i)
-        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
-        c = ao_coef_normalized_ordered_transp(n,j) * ao_coef_normalized_ordered_transp(l,i)
-        ao_overlap(i,j) += c * overlap
-        if(isnan(ao_overlap(i,j)))then
-         print*,'i,j',i,j
-         print*,'l,n',l,n
-         print*,'c,overlap',c,overlap
-         print*,overlap_x,overlap_y,overlap_z
-         stop
-        endif
-        ao_overlap_x(i,j) += c * overlap_x
-        ao_overlap_y(i,j) += c * overlap_y
-        ao_overlap_z(i,j) += c * overlap_z
+    if(use_cosgtos) then
+      !print*, ' use_cosgtos for ao_overlap ?', use_cosgtos
+
+      do j = 1, ao_num
+        do i = 1, ao_num
+          ao_overlap  (i,j) = ao_overlap_cosgtos  (i,j) 
+          ao_overlap_x(i,j) = ao_overlap_cosgtos_x(i,j)
+          ao_overlap_y(i,j) = ao_overlap_cosgtos_y(i,j)
+          ao_overlap_z(i,j) = ao_overlap_cosgtos_z(i,j)
+        enddo
+      enddo
+
+    else
+
+      dim1=100
+      !$OMP PARALLEL DO SCHEDULE(GUIDED) &
+      !$OMP DEFAULT(NONE) &
+      !$OMP PRIVATE(A_center,B_center,power_A,power_B,&
+      !$OMP  overlap_x,overlap_y, overlap_z, overlap, &
+      !$OMP  alpha, beta,i,j,c) &
+      !$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
+      !$OMP  ao_overlap_x,ao_overlap_y,ao_overlap_z,ao_overlap,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, &
+      !$OMP  ao_expo_ordered_transp,dim1)
+      do j=1,ao_num
+      A_center(1) = nucl_coord( ao_nucl(j), 1 )
+      A_center(2) = nucl_coord( ao_nucl(j), 2 )
+      A_center(3) = nucl_coord( ao_nucl(j), 3 )
+      power_A(1)  = ao_power( j, 1 )
+      power_A(2)  = ao_power( j, 2 )
+      power_A(3)  = ao_power( j, 3 )
+      do i= 1,ao_num
+        B_center(1) = nucl_coord( ao_nucl(i), 1 )
+        B_center(2) = nucl_coord( ao_nucl(i), 2 )
+        B_center(3) = nucl_coord( ao_nucl(i), 3 )
+        power_B(1)  = ao_power( i, 1 )
+        power_B(2)  = ao_power( i, 2 )
+        power_B(3)  = ao_power( i, 3 )
+        do n = 1,ao_prim_num(j)
+        alpha = ao_expo_ordered_transp(n,j)
+        do l = 1, ao_prim_num(i)
+          beta = ao_expo_ordered_transp(l,i)
+          call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
+          c = ao_coef_normalized_ordered_transp(n,j) * ao_coef_normalized_ordered_transp(l,i)
+          ao_overlap(i,j) += c * overlap
+          if(isnan(ao_overlap(i,j)))then
+           print*,'i,j',i,j
+           print*,'l,n',l,n
+           print*,'c,overlap',c,overlap
+           print*,overlap_x,overlap_y,overlap_z
+           stop
+          endif
+          ao_overlap_x(i,j) += c * overlap_x
+          ao_overlap_y(i,j) += c * overlap_y
+          ao_overlap_z(i,j) += c * overlap_z
+        enddo
+        enddo
       enddo
       enddo
-    enddo
-    enddo
-    !$OMP END PARALLEL DO
+      !$OMP END PARALLEL DO
+
+    endif
+
   endif
+
   if (write_ao_integrals_overlap) then
      call ezfio_set_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
      print *,  'AO overlap integrals written to disk'
@@ -77,6 +101,8 @@
 
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
  implicit none
  BEGIN_DOC
@@ -85,6 +111,8 @@ BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
  ao_overlap_imag = 0.d0
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
   implicit none
   BEGIN_DOC
@@ -98,37 +126,39 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
   enddo
 END_PROVIDER
 
+! ---
 
+BEGIN_PROVIDER [ double precision, ao_overlap_abs, (ao_num, ao_num) ]
 
-
-BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
-  implicit none
   BEGIN_DOC
-! Overlap between absolute values of atomic basis functions:
-!
-! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
+  ! Overlap between absolute values of atomic basis functions:
+  !
+  ! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
   END_DOC
-  integer :: i,j,n,l
-  double precision :: f
-  integer :: dim1
-  double precision :: overlap, overlap_x, overlap_y, overlap_z
+
+  implicit none
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
+  double precision :: overlap_x, overlap_y, overlap_z
   double precision :: alpha, beta
   double precision :: A_center(3), B_center(3)
-  integer :: power_A(3), power_B(3)
   double precision :: lower_exp_val, dx
-  if (is_periodic) then
-    do j=1,ao_num
-      do i= 1,ao_num
-        ao_overlap_abs(i,j)= cdabs(ao_overlap_complex(i,j))
+
+  if(is_periodic) then
+
+    do j = 1, ao_num
+      do i = 1, ao_num
+        ao_overlap_abs(i,j) = cdabs(ao_overlap_complex(i,j))
       enddo
     enddo
+
   else
+
     dim1=100
     lower_exp_val = 40.d0
     !$OMP PARALLEL DO SCHEDULE(GUIDED)                               &
         !$OMP DEFAULT(NONE)                                          &
         !$OMP PRIVATE(A_center,B_center,power_A,power_B,             &
-        !$OMP  overlap_x,overlap_y, overlap_z, overlap,              &
+        !$OMP  overlap_x,overlap_y, overlap_z,                       &
         !$OMP  alpha, beta,i,j,dx)                                   &
         !$OMP SHARED(nucl_coord,ao_power,ao_prim_num,                &
         !$OMP  ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
@@ -161,9 +191,13 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
       enddo
     enddo
     !$OMP END PARALLEL DO
+
   endif
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
  implicit none
  BEGIN_DOC
diff --git a/src/ao_one_e_ints/kin_ao_ints.irp.f b/src/ao_one_e_ints/kin_ao_ints.irp.f
index 4f117deb..a5ee0670 100644
--- a/src/ao_one_e_ints/kin_ao_ints.irp.f
+++ b/src/ao_one_e_ints/kin_ao_ints.irp.f
@@ -1,7 +1,10 @@
- BEGIN_PROVIDER [ double precision, ao_deriv2_x,(ao_num,ao_num) ]
-&BEGIN_PROVIDER [ double precision, ao_deriv2_y,(ao_num,ao_num) ]
-&BEGIN_PROVIDER [ double precision, ao_deriv2_z,(ao_num,ao_num) ]
-  implicit none
+
+! ---
+
+ BEGIN_PROVIDER [ double precision, ao_deriv2_x, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_deriv2_y, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_deriv2_z, (ao_num, ao_num) ]
+
   BEGIN_DOC
   ! Second derivative matrix elements in the |AO| basis.
   !
@@ -11,114 +14,131 @@
   !   \langle \chi_i(x,y,z) | \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
   !
   END_DOC
-  integer :: i,j,n,l
-  double precision :: f
-  integer :: dim1
+
+  implicit none
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
   double precision :: overlap, overlap_y, overlap_z
   double precision :: overlap_x0, overlap_y0, overlap_z0
   double precision :: alpha, beta, c
   double precision :: A_center(3), B_center(3)
-  integer :: power_A(3), power_B(3)
   double precision :: d_a_2,d_2
-  dim1=100
 
-  ! -- Dummy call to provide everything
-   A_center(:) = 0.d0
-   B_center(:) = 1.d0
-   alpha = 1.d0
-   beta  = .1d0
-   power_A = 1
-   power_B = 0
-  call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,d_a_2,overlap_z,overlap,dim1)
-  ! --
+  if(use_cosgtos) then
+    !print*, 'use_cosgtos for ao_kinetic_integrals ?', use_cosgtos
 
-  !$OMP PARALLEL DO SCHEDULE(GUIDED) &
-  !$OMP DEFAULT(NONE) &
-  !$OMP PRIVATE(A_center,B_center,power_A,power_B,&
-  !$OMP  overlap_y, overlap_z, overlap, &
-  !$OMP  alpha, beta,i,j,c,d_a_2,d_2,deriv_tmp, &
-  !$OMP  overlap_x0,overlap_y0,overlap_z0) &
-  !$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
-  !$OMP  ao_deriv2_x,ao_deriv2_y,ao_deriv2_z,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, &
-  !$OMP  ao_expo_ordered_transp,dim1)
-  do j=1,ao_num
-   A_center(1) = nucl_coord( ao_nucl(j), 1 )
-   A_center(2) = nucl_coord( ao_nucl(j), 2 )
-   A_center(3) = nucl_coord( ao_nucl(j), 3 )
-   power_A(1)  = ao_power( j, 1 )
-   power_A(2)  = ao_power( j, 2 )
-   power_A(3)  = ao_power( j, 3 )
-   do i= 1,ao_num
-    ao_deriv2_x(i,j)= 0.d0
-    ao_deriv2_y(i,j)= 0.d0
-    ao_deriv2_z(i,j)= 0.d0
-    B_center(1) = nucl_coord( ao_nucl(i), 1 )
-    B_center(2) = nucl_coord( ao_nucl(i), 2 )
-    B_center(3) = nucl_coord( ao_nucl(i), 3 )
-    power_B(1)  = ao_power( i, 1 )
-    power_B(2)  = ao_power( i, 2 )
-    power_B(3)  = ao_power( i, 3 )
-    do n = 1,ao_prim_num(j)
-     alpha = ao_expo_ordered_transp(n,j)
-     do l = 1, ao_prim_num(i)
-      beta = ao_expo_ordered_transp(l,i)
-      call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x0,overlap_y0,overlap_z0,overlap,dim1)
-      c = ao_coef_normalized_ordered_transp(n,j) * ao_coef_normalized_ordered_transp(l,i)
+    do j = 1, ao_num
+      do i = 1, ao_num
+        ao_deriv2_x(i,j) = ao_deriv2_cosgtos_x(i,j)
+        ao_deriv2_y(i,j) = ao_deriv2_cosgtos_y(i,j)
+        ao_deriv2_z(i,j) = ao_deriv2_cosgtos_z(i,j)
+      enddo
+    enddo
 
-      power_A(1) = power_A(1)-2
-      if (power_A(1)>-1) then
-        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,d_a_2,overlap_y,overlap_z,overlap,dim1)
-      else
-        d_a_2 = 0.d0
-      endif
-      power_A(1) = power_A(1)+4
-      call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,d_2,overlap_y,overlap_z,overlap,dim1)
-      power_A(1) = power_A(1)-2
+  else
 
-      double precision :: deriv_tmp
-      deriv_tmp = (-2.d0 * alpha * (2.d0 * power_A(1) +1.d0) * overlap_x0 &
-      +power_A(1) * (power_A(1)-1.d0) * d_a_2 &
-      +4.d0 * alpha * alpha * d_2   )*overlap_y0*overlap_z0
+    dim1=100
 
-      ao_deriv2_x(i,j) += c*deriv_tmp
-      power_A(2) = power_A(2)-2
-      if (power_A(2)>-1) then
-        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,d_a_2,overlap_z,overlap,dim1)
-      else
-        d_a_2 = 0.d0
-      endif
-      power_A(2) = power_A(2)+4
-      call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,d_2,overlap_z,overlap,dim1)
-      power_A(2) = power_A(2)-2
+    ! -- Dummy call to provide everything
+    A_center(:) = 0.d0
+    B_center(:) = 1.d0
+    alpha = 1.d0
+    beta  = .1d0
+    power_A = 1
+    power_B = 0
+    call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,d_a_2,overlap_z,overlap,dim1)
+    ! --
 
-      deriv_tmp = (-2.d0 * alpha * (2.d0 * power_A(2) +1.d0 ) * overlap_y0 &
-      +power_A(2) * (power_A(2)-1.d0) * d_a_2 &
-      +4.d0 * alpha * alpha * d_2   )*overlap_x0*overlap_z0
-      ao_deriv2_y(i,j) += c*deriv_tmp
+    !$OMP PARALLEL DO SCHEDULE(GUIDED) &
+    !$OMP DEFAULT(NONE) &
+    !$OMP PRIVATE(A_center,B_center,power_A,power_B,&
+    !$OMP  overlap_y, overlap_z, overlap, &
+    !$OMP  alpha, beta,i,j,c,d_a_2,d_2,deriv_tmp, &
+    !$OMP  overlap_x0,overlap_y0,overlap_z0) &
+    !$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
+    !$OMP  ao_deriv2_x,ao_deriv2_y,ao_deriv2_z,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, &
+    !$OMP  ao_expo_ordered_transp,dim1)
+    do j=1,ao_num
+     A_center(1) = nucl_coord( ao_nucl(j), 1 )
+     A_center(2) = nucl_coord( ao_nucl(j), 2 )
+     A_center(3) = nucl_coord( ao_nucl(j), 3 )
+     power_A(1)  = ao_power( j, 1 )
+     power_A(2)  = ao_power( j, 2 )
+     power_A(3)  = ao_power( j, 3 )
+     do i= 1,ao_num
+      ao_deriv2_x(i,j)= 0.d0
+      ao_deriv2_y(i,j)= 0.d0
+      ao_deriv2_z(i,j)= 0.d0
+      B_center(1) = nucl_coord( ao_nucl(i), 1 )
+      B_center(2) = nucl_coord( ao_nucl(i), 2 )
+      B_center(3) = nucl_coord( ao_nucl(i), 3 )
+      power_B(1)  = ao_power( i, 1 )
+      power_B(2)  = ao_power( i, 2 )
+      power_B(3)  = ao_power( i, 3 )
+      do n = 1,ao_prim_num(j)
+       alpha = ao_expo_ordered_transp(n,j)
+       do l = 1, ao_prim_num(i)
+        beta = ao_expo_ordered_transp(l,i)
+        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x0,overlap_y0,overlap_z0,overlap,dim1)
+        c = ao_coef_normalized_ordered_transp(n,j) * ao_coef_normalized_ordered_transp(l,i)
 
-      power_A(3) = power_A(3)-2
-      if (power_A(3)>-1) then
-        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,overlap_z,d_a_2,overlap,dim1)
-      else
-        d_a_2 = 0.d0
-      endif
-      power_A(3) = power_A(3)+4
-      call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,overlap_z,d_2,overlap,dim1)
-      power_A(3) = power_A(3)-2
+        power_A(1) = power_A(1)-2
+        if (power_A(1)>-1) then
+          call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,d_a_2,overlap_y,overlap_z,overlap,dim1)
+        else
+          d_a_2 = 0.d0
+        endif
+        power_A(1) = power_A(1)+4
+        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,d_2,overlap_y,overlap_z,overlap,dim1)
+        power_A(1) = power_A(1)-2
 
-      deriv_tmp = (-2.d0 * alpha * (2.d0 * power_A(3) +1.d0 ) * overlap_z0 &
-      +power_A(3) * (power_A(3)-1.d0) * d_a_2 &
-      +4.d0 * alpha * alpha * d_2   )*overlap_x0*overlap_y0
-      ao_deriv2_z(i,j) += c*deriv_tmp
+        double precision :: deriv_tmp
+        deriv_tmp = (-2.d0 * alpha * (2.d0 * power_A(1) +1.d0) * overlap_x0 &
+        +power_A(1) * (power_A(1)-1.d0) * d_a_2 &
+        +4.d0 * alpha * alpha * d_2   )*overlap_y0*overlap_z0
 
+        ao_deriv2_x(i,j) += c*deriv_tmp
+        power_A(2) = power_A(2)-2
+        if (power_A(2)>-1) then
+          call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,d_a_2,overlap_z,overlap,dim1)
+        else
+          d_a_2 = 0.d0
+        endif
+        power_A(2) = power_A(2)+4
+        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,d_2,overlap_z,overlap,dim1)
+        power_A(2) = power_A(2)-2
+
+        deriv_tmp = (-2.d0 * alpha * (2.d0 * power_A(2) +1.d0 ) * overlap_y0 &
+        +power_A(2) * (power_A(2)-1.d0) * d_a_2 &
+        +4.d0 * alpha * alpha * d_2   )*overlap_x0*overlap_z0
+        ao_deriv2_y(i,j) += c*deriv_tmp
+
+        power_A(3) = power_A(3)-2
+        if (power_A(3)>-1) then
+          call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,overlap_z,d_a_2,overlap,dim1)
+        else
+          d_a_2 = 0.d0
+        endif
+        power_A(3) = power_A(3)+4
+        call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_y,overlap_z,d_2,overlap,dim1)
+        power_A(3) = power_A(3)-2
+
+        deriv_tmp = (-2.d0 * alpha * (2.d0 * power_A(3) +1.d0 ) * overlap_z0 &
+        +power_A(3) * (power_A(3)-1.d0) * d_a_2 &
+        +4.d0 * alpha * alpha * d_2   )*overlap_x0*overlap_y0
+        ao_deriv2_z(i,j) += c*deriv_tmp
+
+       enddo
+      enddo
      enddo
     enddo
-   enddo
-  enddo
-  !$OMP END PARALLEL DO
+    !$OMP END PARALLEL DO
+
+  endif
 
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
   implicit none
   BEGIN_DOC
diff --git a/src/ao_one_e_ints/pot_ao_ints.irp.f b/src/ao_one_e_ints/pot_ao_ints.irp.f
index 4108ce71..2b6a4d05 100644
--- a/src/ao_one_e_ints/pot_ao_ints.irp.f
+++ b/src/ao_one_e_ints/pot_ao_ints.irp.f
@@ -1,4 +1,8 @@
+
+! ---
+
 BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
+
   BEGIN_DOC
   !  Nucleus-electron interaction, in the |AO| basis set.
   !
@@ -6,78 +10,103 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
   !
   !  These integrals also contain the pseudopotential integrals.
   END_DOC
+
   implicit none
-  double precision               :: alpha, beta, gama, delta
-  integer                        :: num_A,num_B
-  double precision               :: A_center(3),B_center(3),C_center(3)
-  integer                        :: power_A(3),power_B(3)
-  integer                        :: i,j,k,l,n_pt_in,m
-  double precision               :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
+  integer          :: num_A, num_B, power_A(3), power_B(3)
+  integer          :: i, j, k, l, n_pt_in, m
+  double precision :: alpha, beta
+  double precision :: A_center(3),B_center(3),C_center(3)
+  double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
 
   if (read_ao_integrals_n_e) then
+
     call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
     print *,  'AO N-e integrals read from disk'
+
   else
 
-    ao_integrals_n_e = 0.d0
+    if(use_cosgtos) then
+      !print *, " use_cosgtos for ao_integrals_n_e ?", use_cosgtos
 
-    !        _
-    ! /|  / |_)
-    !  | /  | \
-    !
+      do j = 1, ao_num
+        do i = 1, ao_num
+          ao_integrals_n_e(i,j) = ao_integrals_n_e_cosgtos(i,j)
+        enddo
+      enddo
 
-    !$OMP PARALLEL                                                   &
-        !$OMP DEFAULT (NONE)                                         &
-        !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
-        !$OMP          num_A,num_B,Z,c,n_pt_in)                      &
-        !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,&
-        !$OMP         n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
+    else
 
-    n_pt_in = n_pt_max_integrals
+      ao_integrals_n_e = 0.d0
 
-    !$OMP DO SCHEDULE (dynamic)
+      !        _
+      ! /|  / |_)
+      !  | /  | \
+      !
 
-    do j = 1, ao_num
-      num_A = ao_nucl(j)
-      power_A(1:3)= ao_power(j,1:3)
-      A_center(1:3) = nucl_coord(num_A,1:3)
+      !$OMP PARALLEL                                                   &
+          !$OMP DEFAULT (NONE)                                         &
+          !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
+          !$OMP          num_A,num_B,Z,c,c1,n_pt_in)                      &
+          !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,&
+          !$OMP         n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
 
-      do i = 1, ao_num
+      n_pt_in = n_pt_max_integrals
 
-        num_B = ao_nucl(i)
-        power_B(1:3)= ao_power(i,1:3)
-        B_center(1:3) = nucl_coord(num_B,1:3)
+      !$OMP DO SCHEDULE (dynamic)
 
-        do l=1,ao_prim_num(j)
-          alpha = ao_expo_ordered_transp(l,j)
+      do j = 1, ao_num
+        num_A = ao_nucl(j)
+        power_A(1:3)= ao_power(j,1:3)
+        A_center(1:3) = nucl_coord(num_A,1:3)
 
-          do m=1,ao_prim_num(i)
-            beta = ao_expo_ordered_transp(m,i)
+        do i = 1, ao_num
 
-            double precision               :: c
-            c = 0.d0
+          num_B = ao_nucl(i)
+          power_B(1:3)= ao_power(i,1:3)
+          B_center(1:3) = nucl_coord(num_B,1:3)
 
-            do  k = 1, nucl_num
-              double precision               :: Z
-              Z = nucl_charge(k)
+          do l=1,ao_prim_num(j)
+            alpha = ao_expo_ordered_transp(l,j)
 
-              C_center(1:3) = nucl_coord(k,1:3)
+            do m=1,ao_prim_num(i)
+              beta = ao_expo_ordered_transp(m,i)
 
-              c = c - Z * NAI_pol_mult(A_center,B_center,            &
-                  power_A,power_B,alpha,beta,C_center,n_pt_in)
+              double precision               :: c, c1
+              c = 0.d0
 
+              do  k = 1, nucl_num
+                double precision               :: Z
+                Z = nucl_charge(k)
+
+                C_center(1:3) = nucl_coord(k,1:3)
+
+                !print *, ' '
+                !print *, A_center, B_center, C_center, power_A, power_B
+                !print *, alpha, beta
+
+                c1 = NAI_pol_mult( A_center, B_center, power_A, power_B &
+                                 , alpha, beta, C_center, n_pt_in )
+
+                !print *, ' c1 = ', c1
+
+                c = c - Z * c1
+
+              enddo
+              ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j)  &
+                  + ao_coef_normalized_ordered_transp(l,j)             &
+                  * ao_coef_normalized_ordered_transp(m,i) * c
             enddo
-            ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j)  &
-                + ao_coef_normalized_ordered_transp(l,j)             &
-                * ao_coef_normalized_ordered_transp(m,i) * c
           enddo
         enddo
       enddo
-    enddo
 
     !$OMP END DO
     !$OMP END PARALLEL
-    IF (DO_PSEUDO) THEN
+
+    endif
+
+
+    IF(DO_PSEUDO) THEN
        ao_integrals_n_e += ao_pseudo_integrals
     ENDIF
 
@@ -98,7 +127,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)]
   !  :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
   END_DOC
   implicit none
-  double precision               :: alpha, beta, gama, delta
+  double precision               :: alpha, beta
   integer                        :: num_A,num_B
   double precision               :: A_center(3),B_center(3),C_center(3)
   integer                        :: power_A(3),power_B(3)
@@ -121,7 +150,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
 ! :math:`\langle \chi_i | -\frac{1}{|r-R_A|} | \chi_j \rangle`
   END_DOC
   implicit none
-  double precision               :: alpha, beta, gama, delta
+  double precision               :: alpha, beta
   integer                        :: i_c,num_A,num_B
   double precision               :: A_center(3),B_center(3),C_center(3)
   integer                        :: power_A(3),power_B(3)
@@ -259,11 +288,14 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
   ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
   do i =0 ,n_pt_out,2
     accu +=  d(i) * rint(i/2,const)
+
+!    print *, i/2, const, d(i), rint(shiftr(i, 1), const)
   enddo
   NAI_pol_mult = accu * coeff
 
 end
 
+! ---
 
 subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out)
   implicit none
@@ -575,61 +607,3 @@ double precision function V_r(n,alpha)
 end
 
 
-double precision function V_phi(n,m)
-  implicit none
-  BEGIN_DOC
-  ! Computes the angular $\phi$ part of the nuclear attraction integral:
-  !
-  ! $\int_{0}^{2 \pi} \cos(\phi)^n \sin(\phi)^m d\phi$.
-  END_DOC
-  integer                        :: n,m, i
-  double precision               :: prod, Wallis
-  prod = 1.d0
-  do i = 0,shiftr(n,1)-1
-    prod = prod/ (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
-  enddo
-  V_phi = 4.d0 * prod * Wallis(m)
-end
-
-
-double precision function V_theta(n,m)
-  implicit none
-  BEGIN_DOC
-  ! Computes the angular $\theta$ part of the nuclear attraction integral:
-  !
-  ! $\int_{0}^{\pi} \cos(\theta)^n \sin(\theta)^m d\theta$
-  END_DOC
-  integer                        :: n,m,i
-  double precision               :: Wallis, prod
-  include 'utils/constants.include.F'
-  V_theta = 0.d0
-  prod = 1.d0
-  do i = 0,shiftr(n,1)-1
-    prod = prod / (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
-  enddo
-  V_theta = (prod+prod) * Wallis(m)
-end
-
-
-double precision function Wallis(n)
-  implicit none
-  BEGIN_DOC
-  ! Wallis integral:
-  !
-  ! $\int_{0}^{\pi} \cos(\theta)^n d\theta$.
-  END_DOC
-  double precision               :: fact
-  integer                        :: n,p
-  include 'utils/constants.include.F'
-  if(iand(n,1).eq.0)then
-    Wallis = fact(shiftr(n,1))
-    Wallis = pi * fact(n) / (dble(ibset(0_8,n)) * (Wallis+Wallis)*Wallis)
-  else
-    p = shiftr(n,1)
-    Wallis = fact(p)
-    Wallis = dble(ibset(0_8,p+p)) * Wallis*Wallis / fact(p+p+1)
-  endif
-
-end
-
-
diff --git a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f
index e75ca056..24f43311 100644
--- a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f
+++ b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f
@@ -28,7 +28,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)]
 END_PROVIDER
 
 BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
-  use omp_lib
   implicit none
   BEGIN_DOC
   ! Local pseudo-potential
@@ -43,6 +42,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
 
   double precision               :: wall_1, wall_2, wall_0
   integer                        :: thread_num
+  integer                        :: omp_get_thread_num
   double precision               :: c
   double precision               :: Z
 
@@ -158,7 +158,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
 
 
  BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_non_local, (ao_num,ao_num)]
-  use omp_lib
   implicit none
   BEGIN_DOC
   ! Non-local pseudo-potential
@@ -170,6 +169,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
   integer                        :: power_A(3),power_B(3)
   integer                        :: i,j,k,l,m
   double precision               :: Vloc, Vpseudo
+  integer                        :: omp_get_thread_num
 
   double precision               :: wall_1, wall_2, wall_0
   integer                        :: thread_num
diff --git a/src/ao_two_e_ints/EZFIO.cfg b/src/ao_two_e_ints/EZFIO.cfg
index b18c65d1..dfceddb5 100644
--- a/src/ao_two_e_ints/EZFIO.cfg
+++ b/src/ao_two_e_ints/EZFIO.cfg
@@ -4,13 +4,6 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
 interface: ezfio,provider,ocaml
 default: None
 
-[ao_integrals_threshold]
-type: Threshold
-doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
-interface: ezfio,provider,ocaml
-default: 1.e-15
-ezfio_name: threshold_ao
-
 [do_direct_integrals]
 type: logical
 doc: Compute integrals on the fly (very slow, only for debugging)
diff --git a/src/ao_two_e_ints/gauss_legendre.irp.f b/src/ao_two_e_ints/gauss_legendre.irp.f
deleted file mode 100644
index 4bdadb6e..00000000
--- a/src/ao_two_e_ints/gauss_legendre.irp.f
+++ /dev/null
@@ -1,57 +0,0 @@
- BEGIN_PROVIDER [ double precision, gauleg_t2, (n_pt_max_integrals,n_pt_max_integrals/2) ]
-&BEGIN_PROVIDER [ double precision, gauleg_w, (n_pt_max_integrals,n_pt_max_integrals/2) ]
-   implicit none
-   BEGIN_DOC
-   ! t_w(i,1,k) = w(i)
-   ! t_w(i,2,k) = t(i)
-   END_DOC
-   integer                        :: i,j,l
-   l=0
-   do i = 2,n_pt_max_integrals,2
-     l = l+1
-     call gauleg(0.d0,1.d0,gauleg_t2(1,l),gauleg_w(1,l),i)
-     do j=1,i
-       gauleg_t2(j,l) *= gauleg_t2(j,l)
-     enddo
-   enddo
-
-END_PROVIDER
-
-subroutine gauleg(x1,x2,x,w,n)
-   implicit none
-   BEGIN_DOC
-   ! Gauss-Legendre
-   END_DOC
-   integer, intent(in)            :: n
-   double precision, intent(in)   :: x1, x2
-   double precision, intent (out) :: x(n),w(n)
-   double precision, parameter    :: eps=3.d-14
-
-   integer                        :: m,i,j
-   double precision               :: xm, xl, z, z1, p1, p2, p3, pp, dn
-   m=(n+1)/2
-   xm=0.5d0*(x2+x1)
-   xl=0.5d0*(x2-x1)
-   dn = dble(n)
-   do i=1,m
-     z=dcos(3.141592654d0*(dble(i)-.25d0)/(dble(n)+.5d0))
-     z1 = z+1.d0
-     do while (dabs(z-z1) > eps)
-       p1=1.d0
-       p2=0.d0
-       do j=1,n
-         p3=p2
-         p2=p1
-         p1=(dble(j+j-1)*z*p2-dble(j-1)*p3)/j
-       enddo
-       pp=dn*(z*p1-p2)/(z*z-1.d0)
-       z1=z
-       z=z1-p1/pp
-     end do
-     x(i)=xm-xl*z
-     x(n+1-i)=xm+xl*z
-     w(i)=(xl+xl)/((1.d0-z*z)*pp*pp)
-     w(n+1-i)=w(i)
-   enddo
-end
-
diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f
index c3b206e1..55b2d5e2 100644
--- a/src/ao_two_e_ints/map_integrals.irp.f
+++ b/src/ao_two_e_ints/map_integrals.irp.f
@@ -327,8 +327,6 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
   implicit none
   BEGIN_DOC
   ! Gets one AO bi-electronic integral from the AO map
-  !
-  ! i,j,k,l in physicist notation <ij|kl>
   END_DOC
   integer, intent(in)            :: i,j,k,l
   integer(key_kind)              :: idx
diff --git a/src/ao_two_e_ints/test_cosgtos_1e.irp.f b/src/ao_two_e_ints/test_cosgtos_1e.irp.f
new file mode 100644
index 00000000..9c1a7215
--- /dev/null
+++ b/src/ao_two_e_ints/test_cosgtos_1e.irp.f
@@ -0,0 +1,191 @@
+
+! ---
+
+program test_cosgtos
+
+  implicit none
+  integer :: i, j
+
+  call init_expo()
+
+!  call test_coef()
+  call test_1e_kin()
+  call test_1e_coul()
+
+  i = 1
+  j = 1
+!  call test_1e_coul_real(i, j)
+!  call test_1e_coul_cpx (i, j)
+
+end
+
+! ---
+
+subroutine init_expo()
+
+  implicit none
+
+  integer                       :: i, j
+  double precision, allocatable :: expo_im(:,:)
+
+  allocate(expo_im(ao_num, ao_prim_num_max))
+
+  do j = 1, ao_prim_num_max
+    do i = 1, ao_num
+      ao_expoim_cosgtos(i,j) = 0.d0
+    enddo
+  enddo
+
+  call ezfio_set_cosgtos_ao_int_ao_expoim_cosgtos(expo_im)
+
+  deallocate(expo_im)
+
+end subroutine init_expo
+
+! ---
+
+subroutine test_coef()
+
+  implicit none
+
+  integer          :: i, j
+  double precision :: coef, coef_gtos, coef_cosgtos 
+  double precision :: delta, accu_abs
+
+  print*, ' check coefs' 
+
+  accu_abs = 0.d0
+  accu_abs = 0.d0
+  do i = 1, ao_num
+    do j = 1, ao_prim_num(i)
+
+      coef         = ao_coef(i,j)
+      coef_gtos    = 1.d0 * ao_coef_normalized_ordered_transp(j,i)
+      coef_cosgtos = 2.d0 * ao_coef_norm_ord_transp_cosgtos  (j,i)
+
+      delta = dabs(coef_gtos - coef_cosgtos)
+      accu_abs += delta
+
+      if(delta .gt. 1.d-10) then
+        print*, ' problem on: '
+        print*, i, j
+        print*, coef_gtos, coef_cosgtos, delta
+        print*, coef 
+        stop
+      endif
+
+    enddo
+  enddo
+
+  print*, 'accu_abs = ', accu_abs 
+
+end subroutine test_coef
+
+! ---
+
+subroutine test_1e_kin()
+
+  implicit none
+
+  integer          :: i, j
+  double precision :: integral_gtos, integral_cosgtos
+  double precision :: delta, accu_abs
+
+  print*, ' check kin 1e integrals' 
+
+  accu_abs = 0.d0
+  accu_abs = 0.d0
+
+  do j = 1, ao_num
+    do i = 1, ao_num
+
+      integral_gtos    = ao_kinetic_integrals        (i,j) 
+      integral_cosgtos = ao_kinetic_integrals_cosgtos(i,j) 
+
+
+      delta = dabs(integral_gtos - integral_cosgtos)
+      accu_abs += delta
+
+      if(delta .gt. 1.d-7) then
+        print*, ' problem on: '
+        print*, i, j
+        print*, integral_gtos, integral_cosgtos, delta
+        !stop
+      endif
+
+    enddo
+  enddo
+
+ print*,'accu_abs = ', accu_abs
+
+end subroutine test_1e_kin
+
+! ---
+
+subroutine test_1e_coul()
+
+  implicit none
+
+  integer          :: i, j
+  double precision :: integral_gtos, integral_cosgtos
+  double precision :: delta, accu_abs
+
+  print*, ' check Coulomb 1e integrals' 
+
+  accu_abs = 0.d0
+  accu_abs = 0.d0
+
+  do j = 1, ao_num
+    do i = 1, ao_num
+
+      integral_gtos    = ao_integrals_n_e        (i,j) 
+      integral_cosgtos = ao_integrals_n_e_cosgtos(i,j) 
+
+      delta = dabs(integral_gtos - integral_cosgtos)
+      accu_abs += delta
+
+      if(delta .gt. 1.d-7) then
+        print*, ' problem on: '
+        print*, i, j
+        print*, integral_gtos, integral_cosgtos, delta
+        !stop
+      endif
+
+    enddo
+  enddo
+
+ print*,'accu_abs = ', accu_abs
+
+end subroutine test_1e_coul
+
+! ---
+
+subroutine test_1e_coul_cpx(i, j)
+
+  implicit none
+
+  integer, intent(in) :: i, j
+  double precision    :: integral
+
+  integral = ao_integrals_n_e_cosgtos(i,j) 
+
+  print*, ' cpx Coulomb 1e integrals', integral
+
+end subroutine test_1e_coul_cpx
+
+! ---
+
+subroutine test_1e_coul_real(i, j)
+
+  implicit none
+
+  integer, intent(in) :: i, j
+  double precision    :: integral
+
+  integral = ao_integrals_n_e(i,j) 
+
+  print*, ' real Coulomb 1e integrals', integral
+
+end subroutine test_1e_coul_real
+
+! ---
diff --git a/src/ao_two_e_ints/test_cosgtos_2e.irp.f b/src/ao_two_e_ints/test_cosgtos_2e.irp.f
new file mode 100644
index 00000000..de991dd1
--- /dev/null
+++ b/src/ao_two_e_ints/test_cosgtos_2e.irp.f
@@ -0,0 +1,165 @@
+
+! ---
+
+program test_cosgtos
+
+  implicit none
+  integer :: iao, jao, kao, lao
+
+  call init_expo()
+
+!  call test_coef()
+  call test_2e()
+
+  iao = 1
+  jao = 1
+  kao = 1
+  lao = 21
+!  call test_2e_cpx (iao, jao, kao, lao)
+!  call test_2e_real(iao, jao, kao, lao)
+
+end
+
+! ---
+
+subroutine init_expo()
+
+  implicit none
+
+  integer                       :: i, j
+  double precision, allocatable :: expo_im(:,:)
+
+  allocate(expo_im(ao_num, ao_prim_num_max))
+
+  do j = 1, ao_prim_num_max
+    do i = 1, ao_num
+      ao_expoim_cosgtos(i,j) = 0.d0
+    enddo
+  enddo
+
+  call ezfio_set_cosgtos_ao_int_ao_expoim_cosgtos(expo_im)
+
+  deallocate(expo_im)
+
+end subroutine init_expo
+
+! ---
+
+subroutine test_coef()
+
+  implicit none
+
+  integer          :: i, j
+  double precision :: coef, coef_gtos, coef_cosgtos 
+  double precision :: delta, accu_abs
+
+  print*, ' check coefs' 
+
+  accu_abs = 0.d0
+  accu_abs = 0.d0
+  do i = 1, ao_num
+    do j = 1, ao_prim_num(i)
+
+      coef         = ao_coef(i,j)
+      coef_gtos    = 1.d0 * ao_coef_normalized_ordered_transp(j,i)
+      coef_cosgtos = 2.d0 * ao_coef_norm_ord_transp_cosgtos  (j,i)
+
+      delta = dabs(coef_gtos - coef_cosgtos)
+      accu_abs += delta
+
+      if(delta .gt. 1.d-10) then
+        print*, ' problem on: '
+        print*, i, j
+        print*, coef_gtos, coef_cosgtos, delta
+        print*, coef 
+        stop
+      endif
+
+    enddo
+  enddo
+
+  print*, 'accu_abs = ', accu_abs 
+
+end subroutine test_coef
+
+
+! ---
+
+subroutine test_2e()
+
+  implicit none
+
+  integer          :: iao, jao, kao, lao
+  double precision :: integral_gtos, integral_cosgtos
+  double precision :: delta, accu_abs
+
+  double precision :: ao_two_e_integral, ao_two_e_integral_cosgtos
+
+  print*, ' check integrals' 
+
+  accu_abs = 0.d0
+  accu_abs = 0.d0
+
+ ! iao = 1
+ ! jao = 1
+ ! kao = 1
+ ! lao = 24
+
+  do iao = 1, ao_num ! r1
+    do jao = 1, ao_num ! r2
+      do kao = 1, ao_num ! r1
+        do lao = 1, ao_num ! r2
+
+          integral_gtos    = ao_two_e_integral        (iao, kao, jao, lao)
+          integral_cosgtos = ao_two_e_integral_cosgtos(iao, kao, jao, lao)
+
+          delta = dabs(integral_gtos - integral_cosgtos)
+          accu_abs += delta
+
+          if(delta .gt. 1.d-7) then
+            print*, ' problem on: '
+            print*, iao, jao, kao, lao
+            print*, integral_gtos, integral_cosgtos, delta
+            !stop
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+ print*,'accu_abs = ', accu_abs
+
+end subroutine test_2e
+
+! ---
+
+subroutine test_2e_cpx(iao, jao, kao, lao)
+
+  implicit none
+  integer, intent(in) :: iao, jao, kao, lao
+  double precision    :: integral
+  double precision    :: ao_two_e_integral_cosgtos
+
+  integral = ao_two_e_integral_cosgtos(iao, kao, jao, lao)
+  print *, ' cosgtos: ', integral
+
+end subroutine test_2e_cpx
+
+! ---
+
+subroutine test_2e_real(iao, jao, kao, lao)
+
+  implicit none
+  integer, intent(in) :: iao, jao, kao, lao
+  double precision    :: integral
+  double precision    :: ao_two_e_integral
+
+  integral = ao_two_e_integral(iao, kao, jao, lao)
+  print *, ' gtos: ', integral
+
+end subroutine test_2e_real
+
+! ---
+
+
diff --git a/src/ao_two_e_ints/two_e_integrals.irp.f b/src/ao_two_e_ints/two_e_integrals.irp.f
index 8032bd92..e60e6eeb 100644
--- a/src/ao_two_e_ints/two_e_integrals.irp.f
+++ b/src/ao_two_e_ints/two_e_integrals.irp.f
@@ -1,108 +1,132 @@
+
+! ---
+
 double precision function ao_two_e_integral(i,j,k,l)
-  implicit none
+
   BEGIN_DOC
   !  integral of the AO basis <ik|jl> or (ij|kl)
   !     i(r1) j(r1) 1/r12 k(r2) l(r2)
   END_DOC
 
-  integer,intent(in)             :: i,j,k,l
-  integer                        :: p,q,r,s
-  double precision               :: I_center(3),J_center(3),K_center(3),L_center(3)
-  integer                        :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
-  double precision               :: integral
+  implicit none
   include 'utils/constants.include.F'
+
+  integer, intent(in)            :: i, j, k, l
+
+  integer                        :: p, q, r, s
+  integer                        :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
+  integer                        :: iorder_p(3), iorder_q(3)
+  double precision               :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision               :: integral
   double precision               :: P_new(0:max_dim,3),P_center(3),fact_p,pp
   double precision               :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
-  integer                        :: iorder_p(3), iorder_q(3)
+
   double precision               :: ao_two_e_integral_schwartz_accel
 
-   if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
-     ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
-   else
+  double precision               :: ao_two_e_integral_cosgtos
 
-    dim1 = n_pt_max_integrals
 
-    num_i = ao_nucl(i)
-    num_j = ao_nucl(j)
-    num_k = ao_nucl(k)
-    num_l = ao_nucl(l)
-    ao_two_e_integral = 0.d0
+  if(use_cosgtos) then
+    !print *, ' use_cosgtos for ao_two_e_integral ?', use_cosgtos
 
-    if (num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k)then
-      do p = 1, 3
-        I_power(p) = ao_power(i,p)
-        J_power(p) = ao_power(j,p)
-        K_power(p) = ao_power(k,p)
-        L_power(p) = ao_power(l,p)
-        I_center(p) = nucl_coord(num_i,p)
-        J_center(p) = nucl_coord(num_j,p)
-        K_center(p) = nucl_coord(num_k,p)
-        L_center(p) = nucl_coord(num_l,p)
-      enddo
+    ao_two_e_integral = ao_two_e_integral_cosgtos(i,j,k,l)
 
-      double precision               :: coef1, coef2, coef3, coef4
-      double precision               :: p_inv,q_inv
-      double precision               :: general_primitive_integral
+  else
 
-      do p = 1, ao_prim_num(i)
-        coef1 = ao_coef_normalized_ordered_transp(p,i)
-        do q = 1, ao_prim_num(j)
-          coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
-          call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
-              ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),                 &
-              I_power,J_power,I_center,J_center,dim1)
-          p_inv = 1.d0/pp
-          do r = 1, ao_prim_num(k)
-            coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
-            do s = 1, ao_prim_num(l)
-              coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
-              call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
-                  ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),             &
-                  K_power,L_power,K_center,L_center,dim1)
-              q_inv = 1.d0/qq
-              integral = general_primitive_integral(dim1,              &
-                  P_new,P_center,fact_p,pp,p_inv,iorder_p,             &
-                  Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
-              ao_two_e_integral = ao_two_e_integral +  coef4 * integral
-            enddo ! s
-          enddo  ! r
-        enddo   ! q
-      enddo    ! p
+    if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
+
+       ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
 
     else
 
-      do p = 1, 3
-        I_power(p) = ao_power(i,p)
-        J_power(p) = ao_power(j,p)
-        K_power(p) = ao_power(k,p)
-        L_power(p) = ao_power(l,p)
-      enddo
-      double  precision              :: ERI
+      dim1 = n_pt_max_integrals
 
-      do p = 1, ao_prim_num(i)
-        coef1 = ao_coef_normalized_ordered_transp(p,i)
-        do q = 1, ao_prim_num(j)
-          coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
-          do r = 1, ao_prim_num(k)
-            coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
-            do s = 1, ao_prim_num(l)
-              coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
-              integral = ERI(                                          &
-                  ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),&
-                  I_power(1),J_power(1),K_power(1),L_power(1),         &
-                  I_power(2),J_power(2),K_power(2),L_power(2),         &
-                  I_power(3),J_power(3),K_power(3),L_power(3))
-              ao_two_e_integral = ao_two_e_integral + coef4 * integral
-            enddo ! s
-          enddo  ! r
-        enddo   ! q
-      enddo    ! p
+      num_i = ao_nucl(i)
+      num_j = ao_nucl(j)
+      num_k = ao_nucl(k)
+      num_l = ao_nucl(l)
+      ao_two_e_integral = 0.d0
+
+      if (num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k)then
+        do p = 1, 3
+          I_power(p) = ao_power(i,p)
+          J_power(p) = ao_power(j,p)
+          K_power(p) = ao_power(k,p)
+          L_power(p) = ao_power(l,p)
+          I_center(p) = nucl_coord(num_i,p)
+          J_center(p) = nucl_coord(num_j,p)
+          K_center(p) = nucl_coord(num_k,p)
+          L_center(p) = nucl_coord(num_l,p)
+        enddo
+
+        double precision               :: coef1, coef2, coef3, coef4
+        double precision               :: p_inv,q_inv
+        double precision               :: general_primitive_integral
+
+        do p = 1, ao_prim_num(i)
+          coef1 = ao_coef_normalized_ordered_transp(p,i)
+          do q = 1, ao_prim_num(j)
+            coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
+            call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
+                ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),                 &
+                I_power,J_power,I_center,J_center,dim1)
+            p_inv = 1.d0/pp
+            do r = 1, ao_prim_num(k)
+              coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
+              do s = 1, ao_prim_num(l)
+                coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
+                call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
+                    ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),             &
+                    K_power,L_power,K_center,L_center,dim1)
+                q_inv = 1.d0/qq
+                integral = general_primitive_integral(dim1,              &
+                    P_new,P_center,fact_p,pp,p_inv,iorder_p,             &
+                    Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
+                ao_two_e_integral = ao_two_e_integral +  coef4 * integral
+              enddo ! s
+            enddo  ! r
+          enddo   ! q
+        enddo    ! p
+
+      else
+
+        do p = 1, 3
+          I_power(p) = ao_power(i,p)
+          J_power(p) = ao_power(j,p)
+          K_power(p) = ao_power(k,p)
+          L_power(p) = ao_power(l,p)
+        enddo
+        double  precision              :: ERI
+
+        do p = 1, ao_prim_num(i)
+          coef1 = ao_coef_normalized_ordered_transp(p,i)
+          do q = 1, ao_prim_num(j)
+            coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
+            do r = 1, ao_prim_num(k)
+              coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
+              do s = 1, ao_prim_num(l)
+                coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
+                integral = ERI(                                          &
+                    ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),&
+                    I_power(1),J_power(1),K_power(1),L_power(1),         &
+                    I_power(2),J_power(2),K_power(2),L_power(2),         &
+                    I_power(3),J_power(3),K_power(3),L_power(3))
+                ao_two_e_integral = ao_two_e_integral + coef4 * integral
+              enddo ! s
+            enddo  ! r
+          enddo   ! q
+        enddo    ! p
+
+      endif
 
     endif
 
   endif
+
 end
 
+! ---
+
 double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
   implicit none
   BEGIN_DOC
@@ -575,7 +599,10 @@ double precision function general_primitive_integral(dim,            &
   !DIR$ FORCEINLINE
   call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
   double precision               :: rint_sum
+
   accu = accu + rint_sum(n_pt_out,const,d1)
+!  print *, n_pt_out, d1(0:n_pt_out)
+!  print *, accu
 
   general_primitive_integral = fact_p * fact_q * accu *pi_5_2*p_inv*q_inv/dsqrt(p+q)
 end
@@ -840,6 +867,15 @@ subroutine give_polynom_mult_center_x(P_center,Q_center,a_x,d_x,p,q,n_pt_in,pq_i
   !DIR$ FORCEINLINE
   call I_x1_pol_mult(a_x,d_x,B10,B01,B00,C00,D00,d,n_pt1,n_pt_in)
   n_pt_out = n_pt1
+
+!  print *, ' '
+!  print *, a_x, d_x
+!  print *, B10, B01, B00, C00, D00
+!  print *, n_pt1, d(0:n_pt1)
+!  print *, ' '
+
+
+
   if(n_pt1<0)then
     n_pt_out = -1
     do i = 0,n_pt_in
diff --git a/src/basis/EZFIO.cfg b/src/basis/EZFIO.cfg
index a6864418..7f2ede4c 100644
--- a/src/basis/EZFIO.cfg
+++ b/src/basis/EZFIO.cfg
@@ -37,16 +37,16 @@ doc: Number of primitives in a shell
 size: (basis.shell_num)
 interface: ezfio, provider
 
-[shell_index]
+[shell_prim_index]
 type: integer
-doc: Index of the shell for each primitive
-size: (basis.prim_num)
+doc: Max number of primitives in a shell
+size: (basis.shell_num)
 interface: ezfio, provider
 
 [basis_nucleus_index]
 type: integer
-doc: Nucleus on which the shell is centered
-size: (basis.shell_num)
+doc: Index of the nucleus on which the shell is centered
+size: (nuclei.nucl_num)
 interface: ezfio, provider
 
 [prim_normalization_factor]
diff --git a/src/basis/basis.irp.f b/src/basis/basis.irp.f
index b750d75a..6a406e28 100644
--- a/src/basis/basis.irp.f
+++ b/src/basis/basis.irp.f
@@ -30,10 +30,8 @@ BEGIN_PROVIDER [ double precision, shell_normalization_factor , (shell_num) ]
         powA(3) = 0
 
         norm = 0.d0
-        do k=1, prim_num
-          if (shell_index(k) /= i) cycle
-          do j=1, prim_num
-            if (shell_index(j) /= i) cycle
+        do k=shell_prim_index(i),shell_prim_index(i)+shell_prim_num(i)-1
+          do j=shell_prim_index(i),shell_prim_index(i)+shell_prim_num(i)-1
             call overlap_gaussian_xyz(C_A,C_A,prim_expo(j),prim_expo(k), &
               powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
             norm = norm+c*prim_coef(j)*prim_coef(k) * prim_normalization_factor(j) * prim_normalization_factor(k)
@@ -93,8 +91,7 @@ BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ]
         powA(2) = 0
         powA(3) = 0
 
-        do k=1, prim_num
-          if (shell_index(k) /= i) cycle
+        do k=shell_prim_index(i),shell_prim_index(i)+shell_prim_num(i)-1
             call overlap_gaussian_xyz(C_A,C_A,prim_expo(k),prim_expo(k), &
               powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
             prim_normalization_factor(k) = 1.d0/dsqrt(norm)
diff --git a/src/basis_correction/print_routine.irp.f b/src/basis_correction/print_routine.irp.f
index 67c5c6c2..05fbbf60 100644
--- a/src/basis_correction/print_routine.irp.f
+++ b/src/basis_correction/print_routine.irp.f
@@ -38,7 +38,7 @@ subroutine print_basis_correction
     write(*, '(A29,X,I3,X,A3,X,F16.10)') '  ECMD PBE-UEG       , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate)
    enddo
 
-  else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then
+  else if(mu_of_r_potential.EQ."cas_ful")then
    print*, ''
    print*,'Using a CAS-like two-body density to define mu(r)'
    print*,'This assumes that the CAS is a qualitative representation of the wave function ' 
diff --git a/src/becke_numerical_grid/grid_becke_vector.irp.f b/src/becke_numerical_grid/grid_becke_vector.irp.f
index 343bd054..a72200f7 100644
--- a/src/becke_numerical_grid/grid_becke_vector.irp.f
+++ b/src/becke_numerical_grid/grid_becke_vector.irp.f
@@ -58,17 +58,3 @@ END_PROVIDER
   enddo
 
 END_PROVIDER
-
-BEGIN_PROVIDER [double precision, final_grid_points_transp, (n_points_final_grid,3)]
-  implicit none
-  BEGIN_DOC
-! Transposed final_grid_points
-  END_DOC
-
-  integer :: i,j
-  do j=1,3
-    do i=1,n_points_final_grid
-      final_grid_points_transp(i,j) = final_grid_points(j,i)
-    enddo
-  enddo
-END_PROVIDER
diff --git a/src/bitmask/bitmasks_routines.irp.f b/src/bitmask/bitmasks_routines.irp.f
index 9c6f4f0c..c34d54dc 100644
--- a/src/bitmask/bitmasks_routines.irp.f
+++ b/src/bitmask/bitmasks_routines.irp.f
@@ -268,21 +268,6 @@ subroutine print_spindet(string,Nint)
 
 end
 
-subroutine print_det_one_dimension(string,Nint)
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Subroutine to print the content of a determinant using the '+-' notation
-  END_DOC
-  integer, intent(in)            :: Nint
-  integer(bit_kind), intent(in)  :: string(Nint)
-  character*(2048)                :: output(1)
-
-  call bitstring_to_str( output(1), string, Nint )
-  print *,  trim(output(1))
-
-end
-
 logical function is_integer_in_string(bite,string,Nint)
   use bitmasks
  implicit none
diff --git a/src/cipsi/EZFIO.cfg b/src/cipsi/EZFIO.cfg
index e01359c5..19b45ac1 100644
--- a/src/cipsi/EZFIO.cfg
+++ b/src/cipsi/EZFIO.cfg
@@ -1,3 +1,9 @@
+[pert_2rdm]
+type: logical
+doc: If true, computes the one- and two-body rdms with perturbation theory
+interface: ezfio,provider,ocaml
+default: False
+
 [save_wf_after_selection]
 type: logical
 doc: If true, saves the wave function after the selection, before the diagonalization
@@ -34,9 +40,3 @@ doc: Maximum number of excitation for beta determinants with respect to the Hart
 interface: ezfio,ocaml,provider
 default: -1
 
-[twice_hierarchy_max]
-type: integer
-doc: Twice the maximum hierarchy parameter (excitation degree plus half the seniority number). Using -1 selects all determinants
-interface: ezfio,ocaml,provider
-default: -1
-
diff --git a/src/cipsi/NEED b/src/cipsi/NEED
index 85d01f79..bfbc559a 100644
--- a/src/cipsi/NEED
+++ b/src/cipsi/NEED
@@ -2,4 +2,5 @@ perturbation
 zmq
 mpi
 iterations
+two_body_rdm
 csf
diff --git a/src/cipsi/cipsi.irp.f b/src/cipsi/cipsi.irp.f
index da77a527..6e715531 100644
--- a/src/cipsi/cipsi.irp.f
+++ b/src/cipsi/cipsi.irp.f
@@ -70,8 +70,8 @@ subroutine run_cipsi
 
   do while (                                                         &
         (N_det < N_det_max) .and.                                    &
-        (sum(abs(pt2_data % pt2(1:N_states)) * state_average_weight(1:N_states)) > pt2_max) .and.               &
-        (sum(abs(pt2_data % variance(1:N_states)) * state_average_weight(1:N_states)) > variance_max) .and.     &
+        (maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max) .and.               &
+        (maxval(abs(pt2_data % variance(1:N_states))) > variance_max) .and.     &
         (correlation_energy_ratio <= correlation_energy_ratio_max)   &
         )
       write(*,'(A)')  '--------------------------------------------------------------------------------'
diff --git a/src/cipsi/pert_rdm_providers.irp.f b/src/cipsi/pert_rdm_providers.irp.f
new file mode 100644
index 00000000..eca8decc
--- /dev/null
+++ b/src/cipsi/pert_rdm_providers.irp.f
@@ -0,0 +1,183 @@
+
+use bitmasks
+use omp_lib
+
+BEGIN_PROVIDER [ integer(omp_lock_kind), pert_2rdm_lock]
+  use f77_zmq
+  implicit none
+  call omp_init_lock(pert_2rdm_lock)
+END_PROVIDER
+
+BEGIN_PROVIDER [integer, n_orb_pert_rdm]
+ implicit none
+ n_orb_pert_rdm = n_act_orb
+END_PROVIDER 
+
+BEGIN_PROVIDER [integer, list_orb_reverse_pert_rdm, (mo_num)]
+ implicit none
+ list_orb_reverse_pert_rdm = list_act_reverse
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [integer, list_orb_pert_rdm, (n_orb_pert_rdm)]
+ implicit none
+ list_orb_pert_rdm = list_act
+
+END_PROVIDER
+
+BEGIN_PROVIDER [double precision, pert_2rdm_provider, (n_orb_pert_rdm,n_orb_pert_rdm,n_orb_pert_rdm,n_orb_pert_rdm)]
+ implicit none
+ pert_2rdm_provider = 0.d0
+
+END_PROVIDER
+
+subroutine fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf, psi_det_connection, psi_coef_connection_reverse, n_det_connection)
+  use bitmasks
+  use selection_types
+  implicit none
+  
+  integer, intent(in)           :: n_det_connection
+  double precision, intent(in)  :: psi_coef_connection_reverse(N_states,n_det_connection)
+  integer(bit_kind), intent(in) :: psi_det_connection(N_int,2,n_det_connection)
+  integer, intent(in) :: i_generator, sp, h1, h2
+  double precision, intent(in) :: mat(N_states, mo_num, mo_num)
+  logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num)
+  double precision, intent(in)           :: fock_diag_tmp(mo_num)
+  double precision, intent(in)    :: E0(N_states)
+  type(pt2_type), intent(inout)   :: pt2_data
+  type(selection_buffer), intent(inout) :: buf
+  logical :: ok
+  integer :: s1, s2, p1, p2, ib, j, istate, jstate
+  integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
+  double precision :: e_pert, delta_E, val, Hii, sum_e_pert, tmp, alpha_h_psi, coef(N_states)
+  double precision, external :: diag_H_mat_elem_fock
+  double precision :: E_shift
+
+  logical, external :: detEq
+  double precision, allocatable :: values(:)
+  integer, allocatable          :: keys(:,:)
+  integer                       :: nkeys
+  integer :: sze_buff
+  sze_buff = 5 * mo_num ** 2 
+  allocate(keys(4,sze_buff),values(sze_buff))
+  nkeys = 0
+  if(sp == 3) then
+    s1 = 1
+    s2 = 2
+  else
+    s1 = sp
+    s2 = sp
+  end if
+  call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int)
+  E_shift = 0.d0
+
+  if (h0_type == 'CFG') then
+    j = det_to_configuration(i_generator)
+    E_shift = psi_det_Hii(i_generator) - psi_configuration_Hii(j)
+  endif
+
+  do p1=1,mo_num
+    if(bannedOrb(p1, s1)) cycle
+    ib = 1
+    if(sp /= 3) ib = p1+1
+
+    do p2=ib,mo_num
+
+! -----
+! /!\ Generating only single excited determinants doesn't work because a
+! determinant generated by a single excitation may be doubly excited wrt
+! to a determinant of the future. In that case, the determinant will be
+! detected as already generated when generating in the future with a
+! double excitation.
+!     
+!      if (.not.do_singles) then
+!        if ((h1 == p1) .or. (h2 == p2)) then
+!          cycle
+!        endif
+!      endif
+!
+!      if (.not.do_doubles) then
+!        if ((h1 /= p1).and.(h2 /= p2)) then
+!          cycle
+!        endif
+!      endif
+! -----
+
+      if(bannedOrb(p2, s2)) cycle
+      if(banned(p1,p2)) cycle
+
+
+      if( sum(abs(mat(1:N_states, p1, p2))) == 0d0) cycle
+      call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
+
+      if (do_only_cas) then
+        integer, external :: number_of_holes, number_of_particles
+        if (number_of_particles(det)>0) then
+          cycle
+        endif
+        if (number_of_holes(det)>0) then
+          cycle
+        endif
+      endif
+
+      if (do_ddci) then
+        logical, external  :: is_a_two_holes_two_particles
+        if (is_a_two_holes_two_particles(det)) then
+          cycle
+        endif
+      endif
+
+      if (do_only_1h1p) then
+        logical, external :: is_a_1h1p
+        if (.not.is_a_1h1p(det)) cycle
+      endif
+
+
+      Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
+
+      sum_e_pert = 0d0
+      integer :: degree
+      call get_excitation_degree(det,HF_bitmask,degree,N_int)
+      if(degree == 2)cycle
+      do istate=1,N_states
+        delta_E = E0(istate) - Hii + E_shift
+        alpha_h_psi = mat(istate, p1, p2)
+        val = alpha_h_psi + alpha_h_psi
+        tmp = dsqrt(delta_E * delta_E + val * val)
+        if (delta_E < 0.d0) then
+            tmp = -tmp
+        endif
+        e_pert = 0.5d0 * (tmp - delta_E)
+        coef(istate) = e_pert / alpha_h_psi
+        print*,e_pert,coef,alpha_h_psi
+        pt2_data % pt2(istate) += e_pert
+        pt2_data % variance(istate) += alpha_h_psi * alpha_h_psi
+      enddo
+
+      do istate=1,N_states
+        alpha_h_psi = mat(istate, p1, p2)
+        e_pert = coef(istate) * alpha_h_psi
+        do jstate=1,N_states
+          pt2_data % overlap(jstate,jstate) = coef(istate) * coef(jstate)
+        enddo
+
+        if (weight_selection /= 5) then
+          ! Energy selection
+          sum_e_pert = sum_e_pert + e_pert * selection_weight(istate)
+
+        else
+          ! Variance selection
+          sum_e_pert = sum_e_pert - alpha_h_psi * alpha_h_psi * selection_weight(istate)
+        endif
+      end do
+      call give_2rdm_pert_contrib(det,coef,psi_det_connection,psi_coef_connection_reverse,n_det_connection,nkeys,keys,values,sze_buff)
+
+      if(sum_e_pert <= buf%mini) then
+        call add_to_selection_buffer(buf, det, sum_e_pert)
+      end if
+    end do
+  end do
+  call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
+end
+
+
diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f
index 1328e7a0..b366a268 100644
--- a/src/cipsi/pt2_stoch_routines.irp.f
+++ b/src/cipsi/pt2_stoch_routines.irp.f
@@ -117,6 +117,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
 
   integer(ZMQ_PTR)               :: zmq_to_qp_run_socket, zmq_socket_pull
   integer, intent(in)            :: N_in
+!  integer, intent(inout)         :: N_in
   double precision, intent(in)   :: relative_error, E(N_states)
   type(pt2_type), intent(inout)  :: pt2_data, pt2_data_err
 !
@@ -131,8 +132,8 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
   PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
   PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted
   PROVIDE psi_det_hii selection_weight pseudo_sym
-  PROVIDE list_act list_inact list_core list_virt list_del seniority_max
-  PROVIDE excitation_beta_max  excitation_alpha_max excitation_max
+  PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
+  PROVIDE pert_2rdm excitation_beta_max  excitation_alpha_max excitation_max
 
   if (h0_type == 'CFG') then
     PROVIDE psi_configuration_hii det_to_configuration
@@ -287,16 +288,12 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
       call write_int(6,nproc_target,'Number of threads for PT2')
       call write_double(6,mem,'Memory (Gb)')
 
-      call set_multiple_levels_omp(.False.)
+      call omp_set_max_active_levels(1)
 
 
-      ! old
-      !print '(A)', '========== ======================= ===================== ===================== ==========='
-      !print '(A)', ' Samples          Energy                Variance               Norm^2            Seconds'
-      !print '(A)', '========== ======================= ===================== ===================== ==========='
-      print '(A)', '========== ==================== ================ ================ ================ ============= ==========='
-      print '(A)', ' Samples           Energy             PT2            Variance          Norm^2       Convergence    Seconds'
-      print '(A)', '========== ==================== ================ ================ ================ ============= ==========='
+      print '(A)', '========== ======================= ===================== ===================== ==========='
+      print '(A)', ' Samples          Energy                Variance               Norm^2          Seconds'
+      print '(A)', '========== ======================= ===================== ===================== ==========='
 
       PROVIDE global_selection_buffer
 
@@ -318,17 +315,14 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
       endif
       !$OMP END PARALLEL
       call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
-      call set_multiple_levels_omp(.True.)
+      call omp_set_max_active_levels(8)
 
-      ! old
-      !print '(A)', '========== ======================= ===================== ===================== ==========='
-      print '(A)', '========== ==================== ================ ================ ================ ============= ==========='
+      print '(A)', '========== ======================= ===================== ===================== ==========='
 
-
-      do k=1,N_states
-        pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate)
-      enddo
-      SOFT_TOUCH pt2_overlap
+    do k=1,N_states
+      pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate)
+    enddo
+    SOFT_TOUCH pt2_overlap
 
     enddo
     FREE pt2_stoch_istate
@@ -421,17 +415,6 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
   double precision :: rss
   double precision, external :: memory_of_double, memory_of_int
 
-  character(len=20) :: format_str1, str_error1, format_str2, str_error2
-  character(len=20) :: format_str3, str_error3, format_str4, str_error4
-  character(len=20) :: format_value1, format_value2, format_value3, format_value4
-  character(len=20) :: str_value1, str_value2, str_value3, str_value4
-  character(len=20) :: str_conv
-  double precision  :: value1, value2, value3, value4
-  double precision  :: error1, error2, error3, error4
-  integer           :: size1,size2,size3,size4
-
-  double precision :: conv_crit
-
   sending =.False.
 
   rss  = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2)
@@ -541,74 +524,28 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
         ! 1/(N-1.5) : see  Brugger, The American Statistician (23) 4 p. 32 (1969)
         if(c > 2) then
           eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
-          eqt = dsqrt(eqt / (dble(c) - 1.5d0))
+          eqt = sqrt(eqt / (dble(c) - 1.5d0))
           pt2_data_err % pt2(pt2_stoch_istate) = eqt
 
           eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
-          eqt = dsqrt(eqt / (dble(c) - 1.5d0))
+          eqt = sqrt(eqt / (dble(c) - 1.5d0))
           pt2_data_err % variance(pt2_stoch_istate) = eqt
 
           eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability
-          eqta(:) = dsqrt(eqta(:) / (dble(c) - 1.5d0))
+          eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0))
           pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:)
 
 
           if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then
             time1 = time
-
-            value1 =  pt2_data     % pt2(pt2_stoch_istate) + E
-            error1 =  pt2_data_err % pt2(pt2_stoch_istate)           
-            value2 =  pt2_data     % pt2(pt2_stoch_istate)
-            error2 =  pt2_data_err % pt2(pt2_stoch_istate)           
-            value3 =  pt2_data     % variance(pt2_stoch_istate)           
-            error3 =  pt2_data_err % variance(pt2_stoch_istate)           
-            value4 =  pt2_data     % overlap(pt2_stoch_istate,pt2_stoch_istate)           
-            error4 =  pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate)           
-            
-            ! Max size of the values (FX.Y) with X=size
-            size1 = 15
-            size2 = 12
-            size3 = 12
-            size4 = 12
-
-            ! To generate the format: number(error)
-            call format_w_error(value1,error1,size1,8,format_value1,str_error1)
-            call format_w_error(value2,error2,size2,8,format_value2,str_error2)
-            call format_w_error(value3,error3,size3,8,format_value3,str_error3)
-            call format_w_error(value4,error4,size4,8,format_value4,str_error4)
-
-            ! value > string with the right format
-            write(str_value1,'('//format_value1//')') value1
-            write(str_value2,'('//format_value2//')') value2
-            write(str_value3,'('//format_value3//')') value3
-            write(str_value4,'('//format_value4//')') value4
-
-            ! Convergence criterion
-            conv_crit = dabs(pt2_data_err % pt2(pt2_stoch_istate)) /    &
-                  (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) )
-            write(str_conv,'(G10.3)') conv_crit
-
-            write(*,'(I10,X,X,A20,X,A16,X,A16,X,A16,X,A12,X,F10.1)') c,&
-            adjustl(adjustr(str_value1)//'('//str_error1(1:1)//')'),&
-            adjustl(adjustr(str_value2)//'('//str_error2(1:1)//')'),&
-            adjustl(adjustr(str_value3)//'('//str_error3(1:1)//')'),&
-            adjustl(adjustr(str_value4)//'('//str_error4(1:1)//')'),&
-            adjustl(str_conv),& 
-            time-time0
-
-            ! Old print
-            !print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.1,1pE16.6,1pE16.6)', c, &
-            !  pt2_data     % pt2(pt2_stoch_istate) +E, &
-            !  pt2_data_err % pt2(pt2_stoch_istate), &
-            !  pt2_data     % variance(pt2_stoch_istate), &
-            !  pt2_data_err % variance(pt2_stoch_istate), &
-            !  pt2_data     % overlap(pt2_stoch_istate,pt2_stoch_istate), &
-            !  pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), &
-            !  time-time0, &
-            !  pt2_data     % pt2(pt2_stoch_istate), &
-            !  dabs(pt2_data_err % pt2(pt2_stoch_istate)) /    &
-            !      (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) )
-
+            print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, &
+              pt2_data     % pt2(pt2_stoch_istate) +E, &
+              pt2_data_err % pt2(pt2_stoch_istate), &
+              pt2_data     % variance(pt2_stoch_istate), &
+              pt2_data_err % variance(pt2_stoch_istate), &
+              pt2_data     % overlap(pt2_stoch_istate,pt2_stoch_istate), &
+              pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), &
+              time-time0
             if (stop_now .or. (                                      &
                   (do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) /    &
                   (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then
@@ -639,11 +576,11 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
       endif
       do i=1,n_tasks
         if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then
-          print*,'PB !!!'
-          print*,'If you see this, send a bug report with the following content'
-          print*,irp_here
-          print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1)
-          stop -1
+         print*,'PB !!!'
+         print*,'If you see this, send a bug report with the following content'
+         print*,irp_here
+         print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1)
+         stop -1
         endif
         call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i))
         f(index(i)) -= 1
@@ -906,8 +843,9 @@ END_PROVIDER
    do t=1, pt2_N_teeth
      tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t))
      if (tooth_width == 0.d0) then
-       tooth_width = max(1.d-15,sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1))))
+       tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))
      endif
+     ASSERT(tooth_width > 0.d0)
      do i=pt2_n_0(t)+1, pt2_n_0(t+1)
        pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width
      end do
diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f
index 30fc7ce0..a72d3dbb 100644
--- a/src/cipsi/run_pt2_slave.irp.f
+++ b/src/cipsi/run_pt2_slave.irp.f
@@ -31,11 +31,12 @@ subroutine run_pt2_slave(thread,iproc,energy)
 
   double precision, intent(in)    :: energy(N_states_diag)
   integer,  intent(in)            :: thread, iproc
-  if (N_det > 100000 ) then
-    call run_pt2_slave_large(thread,iproc,energy)
-  else
-    call run_pt2_slave_small(thread,iproc,energy)
-  endif
+  call run_pt2_slave_large(thread,iproc,energy)
+!  if (N_det > nproc*(elec_alpha_num * (mo_num-elec_alpha_num))**2) then
+!    call run_pt2_slave_large(thread,iproc,energy)
+!  else
+!    call run_pt2_slave_small(thread,iproc,energy)
+!  endif
 end
 
 subroutine run_pt2_slave_small(thread,iproc,energy)
@@ -66,6 +67,7 @@ subroutine run_pt2_slave_small(thread,iproc,energy)
 
   double precision, external :: memory_of_double, memory_of_int
   integer :: bsize ! Size of selection buffers
+!  logical :: sending
 
   allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max))
   allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max))
@@ -83,6 +85,7 @@ subroutine run_pt2_slave_small(thread,iproc,energy)
   buffer_ready = .False.
   n_tasks = 1
 
+!  sending = .False.
   done = .False.
   do while (.not.done)
 
@@ -116,13 +119,14 @@ subroutine run_pt2_slave_small(thread,iproc,energy)
     do k=1,n_tasks
       call pt2_alloc(pt2_data(k),N_states)
       b%cur = 0
-!      double precision :: time2
-!      call wall_time(time2)
+!double precision :: time2
+!call wall_time(time2)
       call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k)))
-!      call wall_time(time1)
-!      print *,  i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1))
+!call wall_time(time1)
+!print *,  i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1))
     enddo
     call wall_time(time1)
+!print *,  '-->', i_generator(1), time1-time0, n_tasks
 
     integer, external :: tasks_done_to_taskserver
     if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then
@@ -160,11 +164,6 @@ end subroutine
 subroutine run_pt2_slave_large(thread,iproc,energy)
  use selection_types
  use f77_zmq
- BEGIN_DOC
-! This subroutine can miss important determinants when the PT2 is completely
-! computed. It should be called only for large workloads where the PT2 is
-! interrupted before the end
- END_DOC
   implicit none
 
   double precision, intent(in)    :: energy(N_states_diag)
@@ -190,12 +189,8 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
 
   integer :: bsize ! Size of selection buffers
   logical :: sending
-  double precision :: time_shift
-
   PROVIDE global_selection_buffer global_selection_buffer_lock
 
-  call random_number(time_shift)
-  time_shift = time_shift*15.d0
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
 
@@ -213,9 +208,6 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
 
   sending = .False.
   done = .False.
-  double precision :: time0, time1
-  call wall_time(time0)
-  time0 = time0+time_shift
   do while (.not.done)
 
     integer, external :: get_tasks_from_taskserver
@@ -242,28 +234,25 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
       ASSERT (b%N == bsize)
     endif
 
+    double precision :: time0, time1
+    call wall_time(time0)
     call pt2_alloc(pt2_data,N_states)
     b%cur = 0
     call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator))
+    call wall_time(time1)
 
     integer, external :: tasks_done_to_taskserver
     if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then
       done = .true.
     endif
     call sort_selection_buffer(b)
-
-    call wall_time(time1)
-!    if (time1-time0 > 15.d0) then
-      call omp_set_lock(global_selection_buffer_lock)
-      global_selection_buffer%mini = b%mini
-      call merge_selection_buffers(b,global_selection_buffer)
-      b%cur=0
-      call omp_unset_lock(global_selection_buffer_lock)
-      call wall_time(time0)
-!    endif
-
     call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
-    if ( iproc == 1 .or. i_generator < 100 .or. done) then
+    call omp_set_lock(global_selection_buffer_lock)
+    global_selection_buffer%mini = b%mini
+    call merge_selection_buffers(b,global_selection_buffer)
+    b%cur=0
+    call omp_unset_lock(global_selection_buffer_lock)
+    if ( iproc == 1 ) then
       call omp_set_lock(global_selection_buffer_lock)
       call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending)
       global_selection_buffer%cur = 0
diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f
index de7c209c..91bd3a38 100644
--- a/src/cipsi/run_selection_slave.irp.f
+++ b/src/cipsi/run_selection_slave.irp.f
@@ -61,14 +61,10 @@ subroutine run_selection_slave(thread,iproc,energy)
         if (N /= buf%N) then
           print *, 'N=', N
           print *, 'buf%N=', buf%N
-          print *, 'In ', irp_here, ': N /= buf%N'
-          stop -1
+          print *, 'bug in ', irp_here
+          stop '-1'
         end if
       end if
-      if (i_generator > N_det_generators) then
-          print *, 'In ', irp_here, ': i_generator > N_det_generators'
-          stop -1
-      endif
       call select_connected(i_generator,energy,pt2_data,buf,subset,pt2_F(i_generator))
     endif
 
diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f
index ec60c606..eda9642c 100644
--- a/src/cipsi/selection.irp.f
+++ b/src/cipsi/selection.irp.f
@@ -195,10 +195,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
 
   integer                        :: l_a, nmax, idx
   integer, allocatable           :: indices(:), exc_degree(:), iorder(:)
-
-  ! Removed to avoid introducing determinants already presents in the wf
-  !double precision, parameter :: norm_thr = 1.d-16
-
+  double precision, parameter :: norm_thr = 1.d-16
   allocate (indices(N_det),                                          &
       exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
 
@@ -218,11 +215,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
       i = psi_bilinear_matrix_rows(l_a)
       if (nt + exc_degree(i) <= 4) then
         idx = psi_det_sorted_order(psi_bilinear_matrix_order(l_a))
-        ! Removed to avoid introducing determinants already presents in the wf
-        !if (psi_average_norm_contrib_sorted(idx) > norm_thr) then
+        if (psi_average_norm_contrib_sorted(idx) > norm_thr) then
           indices(k) = idx
           k=k+1
-        !endif
+        endif
       endif
     enddo
   enddo
@@ -246,11 +242,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
         idx = psi_det_sorted_order(                                  &
             psi_bilinear_matrix_order(                               &
             psi_bilinear_matrix_transp_order(l_a)))
-        ! Removed to avoid introducing determinants already presents in the wf
-        !if (psi_average_norm_contrib_sorted(idx) > norm_thr) then
+        if (psi_average_norm_contrib_sorted(idx) > norm_thr) then
           indices(k) = idx
           k=k+1
-        !endif
+        endif
       endif
     enddo
   enddo
@@ -258,6 +253,8 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
   deallocate(exc_degree)
   nmax=k-1
 
+  call isort_noidx(indices,nmax)
+
   ! Start with 32 elements. Size will double along with the filtering.
   allocate(preinteresting(0:32), prefullinteresting(0:32),     &
       interesting(0:32), fullinteresting(0:32))
@@ -467,21 +464,27 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
 
       allocate (fullminilist (N_int, 2, fullinteresting(0)), &
                     minilist (N_int, 2,     interesting(0)) )
-!      if(pert_2rdm)then
-!        allocate(coef_fullminilist_rev(N_states,fullinteresting(0)))
-!        do i=1,fullinteresting(0)
-!          do j = 1, N_states
-!            coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j)
-!          enddo
-!        enddo
-!      endif
+      if(pert_2rdm)then
+        allocate(coef_fullminilist_rev(N_states,fullinteresting(0)))
+        do i=1,fullinteresting(0)
+          do j = 1, N_states
+            coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j)
+          enddo
+        enddo
+      endif
 
       do i=1,fullinteresting(0)
-        fullminilist(:,:,i) = psi_det_sorted(:,:,fullinteresting(i))
+        do k=1,N_int
+          fullminilist(k,1,i) = psi_det_sorted(k,1,fullinteresting(i))
+          fullminilist(k,2,i) = psi_det_sorted(k,2,fullinteresting(i))
+        enddo
       enddo
 
       do i=1,interesting(0)
-        minilist(:,:,i) = psi_det_sorted(:,:,interesting(i))
+        do k=1,N_int
+          minilist(k,1,i) = psi_det_sorted(k,1,interesting(i))
+          minilist(k,2,i) = psi_det_sorted(k,2,interesting(i))
+        enddo
       enddo
 
       do s2=s1,2
@@ -528,19 +531,19 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
 
             call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
 
-!            if(.not.pert_2rdm)then
+            if(.not.pert_2rdm)then
              call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf)
-!            else
-!             call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0))
-!            endif
+            else
+             call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0))
+            endif
           end if
         enddo
         if(s1 /= s2) monoBdo = .false.
       enddo
       deallocate(fullminilist,minilist)
-!      if(pert_2rdm)then
-!        deallocate(coef_fullminilist_rev)
-!      endif
+      if(pert_2rdm)then
+        deallocate(coef_fullminilist_rev)
+      endif
     enddo
   enddo
   deallocate(preinteresting, prefullinteresting, interesting, fullinteresting)
@@ -569,7 +572,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
   double precision, external :: diag_H_mat_elem_fock
   double precision :: E_shift
   double precision :: s_weight(N_states,N_states)
-  logical, external :: is_in_wavefunction
   PROVIDE dominant_dets_of_cfgs N_dominant_dets_of_cfgs
   do jstate=1,N_states
     do istate=1,N_states
@@ -711,25 +713,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
         if (do_cycle) cycle
       endif
 
-      if (twice_hierarchy_max >= 0) then
-        s = 0
-        do k=1,N_int
-          s = s + popcnt(ieor(det(k,1),det(k,2)))
-        enddo
-        if ( mod(s,2)>0 ) stop 'For now, hierarchy CI is defined only for an even number of electrons'
-        if (excitation_ref == 1) then
-          call get_excitation_degree(HF_bitmask,det(1,1),degree,N_int)
-        else if (excitation_ref == 2) then
-          stop 'For now, hierarchy CI is defined only for a single reference determinant'
-!         do k=1,N_dominant_dets_of_cfgs
-!           call get_excitation_degree(dominant_dets_of_cfgs(1,1,k),det(1,1),degree,N_int)
-!         enddo
-        endif
-        integer :: twice_hierarchy
-        twice_hierarchy = degree + s/2
-        if (twice_hierarchy > twice_hierarchy_max) cycle
-      endif
-
       Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
 
       w = 0d0
@@ -800,9 +783,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
 
         alpha_h_psi = mat(istate, p1, p2)
 
-        do k=1,N_states
-          pt2_data % overlap(k,istate) = pt2_data % overlap(k,istate) + coef(k) * coef(istate)
-        end do
+        pt2_data % overlap(:,istate) = pt2_data % overlap(:,istate) + coef(:) * coef(istate)
         pt2_data % variance(istate)  = pt2_data % variance(istate) + alpha_h_psi * alpha_h_psi
         pt2_data % pt2(istate)       = pt2_data % pt2(istate)      + e_pert(istate)
 
@@ -853,27 +834,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
             endif
 
         end select
-
-        ! To force the inclusion of determinants with a positive pt2 contribution
-        if (e_pert(istate) > 1d-8) then
-          w = -huge(1.0)
-        endif
-
       end do
 
-!!!BEGIN_DEBUG
-!      ! To check if the pt2 is taking determinants already in the wf
-!      if (is_in_wavefunction(det(N_int,1),N_int)) then
-!        print*, 'A determinant contributing to the pt2 is already in'
-!        print*, 'the wave function:'
-!        call  print_det(det(N_int,1),N_int)
-!        print*,'contribution to the pt2 for the states:', e_pert(:)
-!        print*,'error in the filtering in'
-!        print*, 'cipsi/selection.irp.f sub:  selecte_singles_and_doubles'
-!        print*, 'abort'
-!        call abort
-!      endif
-!!!END_DEBUG
 
       integer(bit_kind) :: occ(N_int,2), n
       if (h0_type == 'CFG') then
@@ -1594,7 +1556,7 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint)
   use bitmasks
   implicit none
   BEGIN_DOC
-  ! Gives the indices(+1) of the bits set to 1 in the bit string
+  ! Gives the inidices(+1) of the bits set to 1 in the bit string
   END_DOC
   integer, intent(in)            :: Nint
   integer(bit_kind), intent(in)  :: string(Nint)
diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi/selection_buffer.irp.f
index 1f743e0e..10132086 100644
--- a/src/cipsi/selection_buffer.irp.f
+++ b/src/cipsi/selection_buffer.irp.f
@@ -60,7 +60,6 @@ subroutine add_to_selection_buffer(b, det, val)
     b%val(b%cur) = val
     if(b%cur == size(b%val)) then
       call sort_selection_buffer(b)
-      b%cur = b%cur-1
     end if
   end if
 end subroutine
@@ -87,56 +86,43 @@ subroutine merge_selection_buffers(b1, b2)
   double precision :: rss
   double precision, external :: memory_of_double
   sze = max(size(b1%val), size(b2%val))
-!  rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze)
-!  call check_mem(rss,irp_here)
+  rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze)
+  call check_mem(rss,irp_here)
   allocate(val(sze), detmp(N_int, 2, sze))
   i1=1
   i2=1
-
-  select case (N_int)
-BEGIN_TEMPLATE 
-  case $case
-    do i=1,nmwen
-      if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then
-        exit
-      else if (i1 > b1%cur) then
-          val(i) = b2%val(i2)
-          detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2)
-          detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2)
-          i2=i2+1
-      else if (i2 > b2%cur) then
-          val(i) = b1%val(i1)
-          detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1)
-          detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1)
-          i1=i1+1
+  do i=1,nmwen
+    if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then
+      exit
+    else if (i1 > b1%cur) then
+        val(i) = b2%val(i2)
+        detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2)
+        detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2)
+        i2=i2+1
+    else if (i2 > b2%cur) then
+        val(i) = b1%val(i1)
+        detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1)
+        detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1)
+        i1=i1+1
+    else
+      if (b1%val(i1) <= b2%val(i2)) then
+        val(i) = b1%val(i1)
+        detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1)
+        detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1)
+        i1=i1+1
       else
-        if (b1%val(i1) <= b2%val(i2)) then
-          val(i) = b1%val(i1)
-          detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1)
-          detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1)
-          i1=i1+1
-        else
-          val(i) = b2%val(i2)
-          detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2)
-          detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2)
-          i2=i2+1
-        endif
+        val(i) = b2%val(i2)
+        detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2)
+        detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2)
+        i2=i2+1
       endif
-    enddo
-    do i=nmwen+1,b2%N
-      val(i) = 0.d0
-!      detmp(1:$N_int,1,i) = 0_bit_kind
-!      detmp(1:$N_int,2,i) = 0_bit_kind
-    enddo
-SUBST [ case, N_int ]
-(1); 1;;
-(2); 2;;
-(3); 3;;
-(4); 4;;
-default; N_int;;
-END_TEMPLATE
-  end select
+    endif
+  enddo
   deallocate(b2%det, b2%val)
+  do i=nmwen+1,b2%N
+    val(i) = 0.d0
+    detmp(1:N_int,1:2,i) = 0_bit_kind
+  enddo
   b2%det => detmp
   b2%val => val
   b2%mini = min(b2%mini,b2%val(b2%N))
@@ -158,8 +144,8 @@ subroutine sort_selection_buffer(b)
 
   double precision :: rss
   double precision, external :: memory_of_double, memory_of_int
-!  rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3))
-!  call check_mem(rss,irp_here)
+  rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3))
+  call check_mem(rss,irp_here)
   allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)))
   do i=1,b%cur
     iorder(i) = i
@@ -239,14 +225,14 @@ subroutine make_selection_buffer_s2(b)
       endif
       dup = .True.
       do k=1,N_int
-        if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) .or. &
-             (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
+        if ( (tmp_array(k,1,i) /= tmp_array(k,1,j))                   &
+              .or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
           dup = .False.
           exit
         endif
       enddo
       if (dup) then
-        val(i) = min(val(i), val(j))
+        val(i) = max(val(i), val(j))
         duplicate(j) = .True.
       endif
       j+=1
@@ -296,6 +282,9 @@ subroutine make_selection_buffer_s2(b)
     call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int)
     n_d = n_d + sze
     if (n_d > b%cur) then
+!      if (n_d - b%cur > b%cur - n_d + sze) then
+!        n_d = n_d - sze
+!      endif
       exit
     endif
   enddo
@@ -340,11 +329,10 @@ subroutine remove_duplicates_in_selection_buffer(b)
   integer(bit_kind), allocatable :: tmp_array(:,:,:)
   logical, allocatable           :: duplicate(:)
 
+  n_d = b%cur
   logical                        :: found_duplicates
   double precision               :: rss
   double precision, external     :: memory_of_double
-
-  n_d = b%cur
   rss = (4*N_int+4)*memory_of_double(n_d)
   call check_mem(rss,irp_here)
 
diff --git a/src/cipsi/selection_weight.irp.f b/src/cipsi/selection_weight.irp.f
index 756c65a1..3c09e59a 100644
--- a/src/cipsi/selection_weight.irp.f
+++ b/src/cipsi/selection_weight.irp.f
@@ -38,11 +38,11 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st)
 
   avg = sum(pt2(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero
 
-  dt = 4.d0 !* selection_factor
+  dt = 8.d0 !* selection_factor
   do k=1,N_st
-    element = pt2(k) !exp(dt*(pt2(k)/avg - 1.d0))
-!    element = min(2.0d0 , element)
-!    element = max(0.5d0 , element)
+    element = exp(dt*(pt2(k)/avg - 1.d0))
+    element = min(2.0d0 , element)
+    element = max(0.5d0 , element)
     pt2_match_weight(k) *= element
   enddo
 
@@ -50,9 +50,9 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st)
   avg = sum(variance(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero
 
   do k=1,N_st
-    element = variance(k) ! exp(dt*(variance(k)/avg -1.d0))
-!    element = min(2.0d0 , element)
-!    element = max(0.5d0 , element)
+    element = exp(dt*(variance(k)/avg -1.d0))
+    element = min(2.0d0 , element)
+    element = max(0.5d0 , element)
     variance_match_weight(k) *= element
   enddo
 
@@ -62,9 +62,6 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st)
     variance_match_weight(:) = 1.d0
   endif
 
-  pt2_match_weight(:) = pt2_match_weight(:)/sum(pt2_match_weight(:))
-  variance_match_weight(:) = variance_match_weight(:)/sum(variance_match_weight(:))
-
   threshold_davidson_pt2 = min(1.d-6, &
      max(threshold_davidson, 1.e-1 * PT2_relative_error * minval(abs(pt2(1:N_states)))) )
 
@@ -90,7 +87,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
       selection_weight(1:N_states) = c0_weight(1:N_states)
 
      case (2)
-      print *,  'Using PT2-matching weight in selection'
+      print *,  'Using pt2-matching weight in selection'
       selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states)
       print *, '# PT2 weight ', real(pt2_match_weight(:),4)
 
@@ -100,7 +97,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
       print *, '# var weight ', real(variance_match_weight(:),4)
 
      case (4)
-      print *,  'Using variance- and PT2-matching weights in selection'
+      print *,  'Using variance- and pt2-matching weights in selection'
       selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states))
       print *, '# PT2 weight ', real(pt2_match_weight(:),4)
       print *, '# var weight ', real(variance_match_weight(:),4)
@@ -115,7 +112,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
       selection_weight(1:N_states) = c0_weight(1:N_states)
 
      case (7)
-      print *,  'Input weights multiplied by variance- and PT2-matching'
+      print *,  'Input weights multiplied by variance- and pt2-matching'
       selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)) * state_average_weight(1:N_states)
       print *, '# PT2 weight ', real(pt2_match_weight(:),4)
       print *, '# var weight ', real(variance_match_weight(:),4)
@@ -131,7 +128,6 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
       print *, '# var weight ', real(variance_match_weight(:),4)
 
     end select
-     selection_weight(:) = selection_weight(:)/sum(selection_weight(:))
      print *, '# Total weight ', real(selection_weight(:),4)
 
 END_PROVIDER
diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f
index f96aaa6a..510c667b 100644
--- a/src/cipsi/slave_cipsi.irp.f
+++ b/src/cipsi/slave_cipsi.irp.f
@@ -4,7 +4,7 @@ subroutine run_slave_cipsi
 ! Helper program for distributed parallelism
   END_DOC
 
-  call set_multiple_levels_omp(.False.)
+  call omp_set_max_active_levels(1)
   distributed_davidson = .False.
   read_wf = .False.
   SOFT_TOUCH read_wf distributed_davidson
@@ -171,9 +171,9 @@ subroutine run_slave_main
       call write_double(6,(t1-t0),'Broadcast time')
 
       !---
-      call set_multiple_levels_omp(.True.)
+      call omp_set_max_active_levels(8)
       call davidson_slave_tcp(0)
-      call set_multiple_levels_omp(.False.)
+      call omp_set_max_active_levels(1)
       print *,  mpi_rank, ': Davidson done'
       !---
 
@@ -311,7 +311,7 @@ subroutine run_slave_main
           if (mpi_master) then
             print *,  'Running PT2'
           endif
-          !$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target)
+          !$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target+1)
           i = omp_get_thread_num()
           call run_pt2_slave(0,i,pt2_e0_denominator)
           !$OMP END PARALLEL
diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f
index 5fc9db0f..781fcda6 100644
--- a/src/cipsi/stochastic_cipsi.irp.f
+++ b/src/cipsi/stochastic_cipsi.irp.f
@@ -69,8 +69,8 @@ subroutine run_stochastic_cipsi
 
   do while (                                                         &
         (N_det < N_det_max) .and.                                    &
-        (sum(abs(pt2_data % pt2(1:N_states)) * state_average_weight(1:N_states)) > pt2_max) .and.               &
-        (sum(abs(pt2_data % variance(1:N_states)) * state_average_weight(1:N_states)) > variance_max) .and.     &
+        (maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max) .and.               &
+        (maxval(abs(pt2_data % variance(1:N_states))) > variance_max) .and.     &
         (correlation_energy_ratio <= correlation_energy_ratio_max)   &
         )
       write(*,'(A)')  '--------------------------------------------------------------------------------'
diff --git a/src/cipsi/update_2rdm.irp.f b/src/cipsi/update_2rdm.irp.f
new file mode 100644
index 00000000..260c48fd
--- /dev/null
+++ b/src/cipsi/update_2rdm.irp.f
@@ -0,0 +1,223 @@
+use bitmasks
+
+subroutine give_2rdm_pert_contrib(det,coef,psi_det_connection,psi_coef_connection_reverse,n_det_connection,nkeys,keys,values,sze_buff)
+ implicit none
+ integer, intent(in) :: n_det_connection,sze_buff
+ double precision, intent(in) :: coef(N_states)
+ integer(bit_kind), intent(in) :: det(N_int,2)
+ integer(bit_kind), intent(in) :: psi_det_connection(N_int,2,n_det_connection) 
+ double precision, intent(in)  :: psi_coef_connection_reverse(N_states,n_det_connection)
+ integer,           intent(inout) :: keys(4,sze_buff),nkeys
+ double precision,  intent(inout) :: values(sze_buff)
+ integer :: i,j
+ integer                        :: exc(0:2,2,2)
+ integer                        :: degree
+ double precision               :: phase, contrib
+ do i = 1, n_det_connection
+  call get_excitation(det,psi_det_connection(1,1,i),exc,degree,phase,N_int) 
+  if(degree.gt.2)cycle
+  contrib = 0.d0
+  do j = 1, N_states
+   contrib += state_average_weight(j) * psi_coef_connection_reverse(j,i) * phase * coef(j)
+  enddo
+  ! case of single excitations 
+  if(degree == 1)then
+   if (nkeys + 6 * elec_alpha_num .ge. sze_buff)then
+    call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
+    nkeys = 0
+   endif
+   call update_buffer_single_exc_rdm(det,psi_det_connection(1,1,i),exc,phase,contrib,nkeys,keys,values,sze_buff)
+  else 
+ !! case of double excitations 
+ ! if (nkeys + 4 .ge. sze_buff)then
+ !  call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
+ !  nkeys = 0
+ ! endif
+ ! call update_buffer_double_exc_rdm(exc,phase,contrib,nkeys,keys,values,sze_buff)
+  endif
+ enddo
+!call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock)
+!nkeys = 0
+
+end
+
+subroutine update_buffer_single_exc_rdm(det1,det2,exc,phase,contrib,nkeys,keys,values,sze_buff)
+ implicit none
+ integer, intent(in) :: sze_buff
+ integer(bit_kind), intent(in) :: det1(N_int,2)
+ integer(bit_kind), intent(in) :: det2(N_int,2)
+ integer,intent(in)             :: exc(0:2,2,2)
+ double precision,intent(in)    :: phase, contrib
+ integer, intent(inout)         :: nkeys, keys(4,sze_buff)
+ double precision, intent(inout):: values(sze_buff)
+ 
+ integer                        :: occ(N_int*bit_kind_size,2)
+ integer                        :: n_occ_ab(2),ispin,other_spin
+ integer :: h1,h2,p1,p2,i
+ call bitstring_to_list_ab(det1, occ, n_occ_ab, N_int)
+  
+ if (exc(0,1,1) == 1) then
+  ! Mono alpha
+  h1 = exc(1,1,1)
+  p1 = exc(1,2,1)
+  ispin = 1
+  other_spin = 2
+ else
+  ! Mono beta
+  h1 = exc(1,1,2)
+  p1 = exc(1,2,2)
+  ispin = 2
+  other_spin = 1
+ endif
+ if(list_orb_reverse_pert_rdm(h1).lt.0)return
+ h1 = list_orb_reverse_pert_rdm(h1)
+ if(list_orb_reverse_pert_rdm(p1).lt.0)return
+ p1 = list_orb_reverse_pert_rdm(p1)
+ !update the alpha/beta part
+ do i = 1, n_occ_ab(other_spin)
+  h2 = occ(i,other_spin)
+  if(list_orb_reverse_pert_rdm(h2).lt.0)return
+  h2 = list_orb_reverse_pert_rdm(h2)
+
+  nkeys += 1
+  values(nkeys) = 0.5d0 * contrib * phase
+  keys(1,nkeys) = h1
+  keys(2,nkeys) = h2
+  keys(3,nkeys) = p1
+  keys(4,nkeys) = h2
+  nkeys += 1
+  values(nkeys) = 0.5d0 * contrib * phase
+  keys(1,nkeys) = h2
+  keys(2,nkeys) = h1
+  keys(3,nkeys) = h2
+  keys(4,nkeys) = p1
+ enddo 
+ !update the same spin part 
+!do i = 1, n_occ_ab(ispin)
+! h2 = occ(i,ispin)
+! if(list_orb_reverse_pert_rdm(h2).lt.0)return
+! h2 = list_orb_reverse_pert_rdm(h2)
+
+! nkeys += 1
+! values(nkeys) = 0.5d0 * contrib * phase
+! keys(1,nkeys) = h1
+! keys(2,nkeys) = h2
+! keys(3,nkeys) = p1
+! keys(4,nkeys) = h2
+
+! nkeys += 1
+! values(nkeys) = - 0.5d0 * contrib * phase
+! keys(1,nkeys) = h1
+! keys(2,nkeys) = h2
+! keys(3,nkeys) = h2
+! keys(4,nkeys) = p1
+!
+! nkeys += 1
+! values(nkeys) = 0.5d0 * contrib * phase
+! keys(1,nkeys) = h2
+! keys(2,nkeys) = h1
+! keys(3,nkeys) = h2
+! keys(4,nkeys) = p1
+
+! nkeys += 1
+! values(nkeys) = - 0.5d0 * contrib * phase
+! keys(1,nkeys) = h2
+! keys(2,nkeys) = h1
+! keys(3,nkeys) = p1
+! keys(4,nkeys) = h2
+!enddo 
+
+end
+
+subroutine update_buffer_double_exc_rdm(exc,phase,contrib,nkeys,keys,values,sze_buff)
+ implicit none
+ integer, intent(in) :: sze_buff
+ integer,intent(in)             :: exc(0:2,2,2)
+ double precision,intent(in)    :: phase, contrib
+ integer, intent(inout)         :: nkeys, keys(4,sze_buff)
+ double precision, intent(inout):: values(sze_buff)
+ integer :: h1,h2,p1,p2
+
+ if (exc(0,1,1) == 1) then
+  ! Double alpha/beta
+  h1 = exc(1,1,1) 
+  h2 = exc(1,1,2) 
+  p1 = exc(1,2,1)
+  p2 = exc(1,2,2)
+  ! check if the orbitals involved are within the orbital range
+  if(list_orb_reverse_pert_rdm(h1).lt.0)return
+  h1 = list_orb_reverse_pert_rdm(h1)
+  if(list_orb_reverse_pert_rdm(h2).lt.0)return
+  h2 = list_orb_reverse_pert_rdm(h2)
+  if(list_orb_reverse_pert_rdm(p1).lt.0)return
+  p1 = list_orb_reverse_pert_rdm(p1)
+  if(list_orb_reverse_pert_rdm(p2).lt.0)return
+  p2 = list_orb_reverse_pert_rdm(p2)
+  nkeys += 1
+  values(nkeys) = 0.5d0 * contrib * phase
+  keys(1,nkeys) = h1
+  keys(2,nkeys) = h2
+  keys(3,nkeys) = p1
+  keys(4,nkeys) = p2
+  nkeys += 1
+  values(nkeys) = 0.5d0 * contrib * phase
+  keys(1,nkeys) = p1
+  keys(2,nkeys) = p2
+  keys(3,nkeys) = h1
+  keys(4,nkeys) = h2 
+
+ else 
+  if (exc(0,1,1) == 2) then
+    ! Double alpha/alpha
+   h1 =  exc(1,1,1)
+   h2 =  exc(2,1,1)
+   p1 =  exc(1,2,1)
+   p2 =  exc(2,2,1)
+  else if (exc(0,1,2) == 2) then
+   ! Double beta
+   h1 = exc(1,1,2)
+   h2 = exc(2,1,2)
+   p1 = exc(1,2,2)
+   p2 = exc(2,2,2)
+  endif
+  ! check if the orbitals involved are within the orbital range
+  if(list_orb_reverse_pert_rdm(h1).lt.0)return
+  h1 = list_orb_reverse_pert_rdm(h1)
+  if(list_orb_reverse_pert_rdm(h2).lt.0)return
+  h2 = list_orb_reverse_pert_rdm(h2)
+  if(list_orb_reverse_pert_rdm(p1).lt.0)return
+  p1 = list_orb_reverse_pert_rdm(p1)
+  if(list_orb_reverse_pert_rdm(p2).lt.0)return
+  p2 = list_orb_reverse_pert_rdm(p2)
+  nkeys += 1
+  values(nkeys) = 0.5d0 * contrib * phase
+  keys(1,nkeys) = h1
+  keys(2,nkeys) = h2
+  keys(3,nkeys) = p1
+  keys(4,nkeys) = p2
+ 
+  nkeys += 1
+  values(nkeys) = - 0.5d0 * contrib * phase
+  keys(1,nkeys) = h1
+  keys(2,nkeys) = h2
+  keys(3,nkeys) = p2
+  keys(4,nkeys) = p1
+                                        
+  nkeys += 1
+  values(nkeys) = 0.5d0 * contrib * phase
+  keys(1,nkeys) = h2
+  keys(2,nkeys) = h1
+  keys(3,nkeys) = p2
+  keys(4,nkeys) = p1
+ 
+  nkeys += 1
+  values(nkeys) = - 0.5d0 * contrib * phase
+  keys(1,nkeys) = h2
+  keys(2,nkeys) = h1
+  keys(3,nkeys) = p1
+  keys(4,nkeys) = p2
+ endif
+ 
+end
+
+
diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f
index 1bfe87c0..58630709 100644
--- a/src/cipsi/zmq_selection.irp.f
+++ b/src/cipsi/zmq_selection.irp.f
@@ -22,7 +22,7 @@ subroutine ZMQ_selection(N_in, pt2_data)
     PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
     PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym
     PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
-    PROVIDE excitation_beta_max  excitation_alpha_max excitation_max
+    PROVIDE pert_2rdm excitation_beta_max  excitation_alpha_max excitation_max
 
     call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
 
diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f
index 2b16a5f7..acec29c2 100644
--- a/src/cis/cis.irp.f
+++ b/src/cis/cis.irp.f
@@ -62,7 +62,6 @@ subroutine run
   else
    call H_apply_cis
   endif
-  print*,''
   print *,  'N_det = ', N_det
   print*,'******************************'
   print *,  'Energies  of the states:'
@@ -70,18 +69,16 @@ subroutine run
     print *,  i, CI_energy(i)
   enddo
   if (N_states > 1) then
-    print*,''
-    print*,'******************************************************'
-    print*,'Excitation energies (au)                     (eV)'
+    print*,'******************************'
+    print*,'Excitation energies '
     do i = 2, N_states
-      print*, i ,CI_energy(i) - CI_energy(1), (CI_energy(i) - CI_energy(1)) * ha_to_ev
+      print*, i ,CI_energy(i) - CI_energy(1)
     enddo
-    print*,''
   endif
 
   call ezfio_set_cis_energy(CI_energy)
   psi_coef = ci_eigenvectors
   SOFT_TOUCH psi_coef
-  call save_wavefunction_truncated(save_threshold)
+  call save_wavefunction_truncated(1.d-12)
 
 end
diff --git a/src/cis_read/EZFIO.cfg b/src/cis_read/EZFIO.cfg
deleted file mode 100644
index 955d1bef..00000000
--- a/src/cis_read/EZFIO.cfg
+++ /dev/null
@@ -1,7 +0,0 @@
-[energy]
-type: double precision
-doc: Variational |CIS| energy
-interface: ezfio
-size: (determinants.n_states)
-
-
diff --git a/src/cis_read/NEED b/src/cis_read/NEED
deleted file mode 100644
index 42992ac6..00000000
--- a/src/cis_read/NEED
+++ /dev/null
@@ -1,3 +0,0 @@
-selectors_full
-generators_full
-davidson_undressed
diff --git a/src/cis_read/README.rst b/src/cis_read/README.rst
deleted file mode 100644
index 31648636..00000000
--- a/src/cis_read/README.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-===
-cis_read
-===
-
-Reads the input WF and performs all singles on top of it.
diff --git a/src/cis_read/cis_read.irp.f b/src/cis_read/cis_read.irp.f
deleted file mode 100644
index 055b5e15..00000000
--- a/src/cis_read/cis_read.irp.f
+++ /dev/null
@@ -1,88 +0,0 @@
-program cis
-  implicit none
-  BEGIN_DOC
-!
-! Configuration Interaction with Single excitations.
-!
-! This program takes a reference Slater determinant of ROHF-like
-! occupancy, and performs all single excitations on top of it.
-! Disregarding spatial symmetry, it computes the `n_states` lowest
-! eigenstates of that CI matrix. (see :option:`determinants n_states`)
-!
-! This program can be useful in many cases:
-!
-!
-! 1. Ground state calculation
-!
-!    To be sure to have the lowest |SCF| solution, perform an :ref:`scf`
-!    (see the :ref:`module_hartree_fock` module), then a :ref:`cis`, save the
-!    natural orbitals (see :ref:`save_natorb`) and re-run an :ref:`scf`
-!    optimization from this |MO| guess.
-!
-!
-! 2. Excited states calculations
-!
-!    The lowest excited states are much likely to be dominated by
-!    single-excitations. Therefore, running a :ref:`cis` will save the
-!    `n_states` lowest states within the |CIS| space in the |EZFIO|
-!    directory, which can afterwards be used as guess wave functions for
-!    a further multi-state |FCI| calculation if :option:`determinants
-!    read_wf` is set to |true| before running the :ref:`fci` executable.
-!
-!
-! If :option:`determinants s2_eig` is set to |true|, the |CIS|
-! will only retain states having the expected |S^2| value (see
-! :option:`determinants expected_s2`). Otherwise, the |CIS| will take
-! the lowest :option:`determinants n_states`, whatever multiplicity
-! they are.
-!
-! .. note::
-!
-!   To discard some orbitals, use the :ref:`qp_set_mo_class` 
-!   command to specify:
-!
-!   * *core* orbitals which will be always doubly occupied
-!
-!   * *act* orbitals where an electron can be either excited from or to
-!
-!   * *del* orbitals which will be never occupied
-!
-  END_DOC
-  read_wf = .True.
-  TOUCH read_wf
-  call run
-end
-
-subroutine run
-  implicit none
-  integer                        :: i
-
-
-  if(pseudo_sym)then
-   call H_apply_cis_sym
-  else
-   call H_apply_cis
-  endif
-  print*,''
-  print *,  'N_det = ', N_det
-  print*,'******************************'
-  print *,  'Energies  of the states:'
-  do i = 1,N_states
-    print *,  i, CI_energy(i)
-  enddo
-  if (N_states > 1) then
-    print*,''
-    print*,'******************************************************'
-    print*,'Excitation energies (au)                     (eV)'
-    do i = 2, N_states
-      print*, i ,CI_energy(i) - CI_energy(1), (CI_energy(i) - CI_energy(1))/0.0367502d0
-    enddo
-    print*,''
-  endif
-
-  call ezfio_set_cis_energy(CI_energy)
-  psi_coef = ci_eigenvectors
-  SOFT_TOUCH psi_coef
-  call save_wavefunction_truncated(save_threshold)
-
-end
diff --git a/src/cis_read/h_apply.irp.f b/src/cis_read/h_apply.irp.f
deleted file mode 100644
index 14389bed..00000000
--- a/src/cis_read/h_apply.irp.f
+++ /dev/null
@@ -1,14 +0,0 @@
-! Generates subroutine H_apply_cis
-! --------------------------------
-
-BEGIN_SHELL [ /usr/bin/env python3 ]
-from generate_h_apply import H_apply
-H = H_apply("cis",do_double_exc=False)
-print(H)
-
-H = H_apply("cis_sym",do_double_exc=False)
-H.filter_only_connected_to_hf()
-print(H)
-
-END_SHELL
-
diff --git a/src/cisd/cisd.irp.f b/src/cisd/cisd.irp.f
index 3e1e8d97..6c55e2ff 100644
--- a/src/cisd/cisd.irp.f
+++ b/src/cisd/cisd.irp.f
@@ -47,37 +47,6 @@ program cisd
   PROVIDE N_states
   read_wf = .False.
   SOFT_TOUCH read_wf
-
-  integer :: i,k
-
-  if(pseudo_sym)then
-   call H_apply_cisd_sym
-  else
-   call H_apply_cisd
-  endif
-  double precision :: r1, r2
-  double precision, allocatable :: U_csf(:,:)
-
-  allocate(U_csf(N_csf,N_states))
-  U_csf = 0.d0
-  U_csf(1,1) = 1.d0
-  do k=2,N_states
-    do i=1,N_csf
-        call random_number(r1)
-        call random_number(r2)
-        r1 = dsqrt(-2.d0*dlog(r1))
-        r2 = dacos(-1.d0)*2.d0*r2
-        U_csf(i,k) = r1*dcos(r2)
-    enddo
-    U_csf(k,k) = U_csf(k,k) +100.d0
-  enddo
-  do k=1,N_states
-    call normalize(U_csf(1,k),N_csf)
-  enddo
-  call convertWFfromCSFtoDET(N_states,U_csf(1,1),psi_coef(1,1))
-  deallocate(U_csf)
-  SOFT_TOUCH psi_coef
-
   call run
 end
 
@@ -87,16 +56,20 @@ subroutine run
   double precision               :: cisdq(N_states), delta_e
   double precision,external      :: diag_h_mat_elem
 
+  if(pseudo_sym)then
+   call H_apply_cisd_sym
+  else
+   call H_apply_cisd
+  endif
   psi_coef = ci_eigenvectors
-  call save_wavefunction_truncated(save_threshold)
+  SOFT_TOUCH psi_coef
+  call save_wavefunction
   call ezfio_set_cisd_energy(CI_energy)
 
   do i = 1,N_states
     k = maxloc(dabs(psi_coef_sorted(1:N_det,i)),dim=1)
     delta_E  = CI_electronic_energy(i) - diag_h_mat_elem(psi_det_sorted(1,1,k),N_int)
-    if (elec_alpha_num + elec_beta_num >= 4) then
-      cisdq(i) = CI_energy(i) + delta_E * (1.d0 - psi_coef_sorted(k,i)**2)
-    endif
+    cisdq(i) = CI_energy(i) + delta_E * (1.d0 - psi_coef_sorted(k,i)**2)
   enddo
   print *,  'N_det = ', N_det
   print*,''
@@ -105,43 +78,26 @@ subroutine run
   do i = 1,N_states
     print *,  i, CI_energy(i)
   enddo
-  if (elec_alpha_num + elec_beta_num >= 4) then
+  print*,''
+  print*,'******************************'
+  print *,  'CISD+Q Energies'
+  do i = 1,N_states
+    print *,  i, cisdq(i)
+  enddo
+  if (N_states > 1) then
     print*,''
     print*,'******************************'
-    print *,  'CISD+Q Energies'
-    do i = 1,N_states
-      print *,  i, cisdq(i)
+    print*,'Excitation energies (au)    (CISD+Q)'
+    do i = 2, N_states
+      print*, i ,CI_energy(i) - CI_energy(1), cisdq(i) - cisdq(1)
+    enddo
+    print*,''
+    print*,'******************************'
+    print*,'Excitation energies (eV)    (CISD+Q)'
+    do i = 2, N_states
+      print*, i ,(CI_energy(i) - CI_energy(1))/0.0367502d0, &
+        (cisdq(i) - cisdq(1)) / 0.0367502d0
     enddo
-  endif
-  if (N_states > 1) then
-    if (elec_alpha_num + elec_beta_num >= 4) then
-      print*,''
-      print*,'******************************'
-      print*,'Excitation energies (au)    (CISD+Q)'
-      do i = 2, N_states
-        print*, i ,CI_energy(i) - CI_energy(1), cisdq(i) - cisdq(1)
-      enddo
-      print*,''
-      print*,'******************************'
-      print*,'Excitation energies (eV)    (CISD+Q)'
-      do i = 2, N_states
-        print*, i ,(CI_energy(i) - CI_energy(1)) * ha_to_ev, &
-          (cisdq(i) - cisdq(1)) * ha_to_ev
-      enddo
-    else
-      print*,''
-      print*,'******************************'
-      print*,'Excitation energies (au)    (CISD)'
-      do i = 2, N_states
-        print*, i ,CI_energy(i) - CI_energy(1)
-      enddo
-      print*,''
-      print*,'******************************'
-      print*,'Excitation energies (eV)    (CISD)'
-      do i = 2, N_states
-        print*, i ,(CI_energy(i) - CI_energy(1)) * ha_to_ev
-      enddo
-    endif
   endif
 
 end
diff --git a/src/csf/configurations.irp.f b/src/csf/configurations.irp.f
index ce5d48ab..8e2a513c 100644
--- a/src/csf/configurations.irp.f
+++ b/src/csf/configurations.irp.f
@@ -779,7 +779,6 @@ subroutine binary_search_cfg(cfgInp,addcfg)
 end subroutine
 
  BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det, (2,N_configuration) ]
-&BEGIN_PROVIDER [ integer, psi_configuration_n_det, (N_configuration) ]
 &BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det_data, (N_det) ]
 
  implicit none
@@ -868,29 +867,6 @@ end subroutine
  enddo
 
  deallocate(dets, old_order)
- integer :: ndet_conf
- do i = 1, N_configuration
-  ndet_conf = psi_configuration_to_psi_det(2,i) - psi_configuration_to_psi_det(1,i) + 1
-  psi_configuration_n_det(i) = ndet_conf
- enddo
 
 END_PROVIDER
 
-
-BEGIN_PROVIDER [ integer, n_elec_alpha_for_psi_configuration, (N_configuration)]
- implicit none
- integer :: i,j,k,l
- integer(bit_kind) :: det_tmp(N_int,2),det_alpha(N_int)
- n_elec_alpha_for_psi_configuration = 0
- do i = 1, N_configuration
-  j = psi_configuration_to_psi_det(2,i) 
-  det_tmp(:,:) = psi_det(:,:,j)
-  k = 0
-  do l = 1, N_int
-   det_alpha(N_int) = iand(det_tmp(l,1),psi_configuration(l,1,i))
-   k += popcnt(det_alpha(l))
-  enddo
-  n_elec_alpha_for_psi_configuration(i) = k
- enddo
-
-END_PROVIDER 
diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f
index 75f6e539..fecc6123 100644
--- a/src/csf/conversion.irp.f
+++ b/src/csf/conversion.irp.f
@@ -1,15 +1,3 @@
-BEGIN_PROVIDER [ double precision, psi_csf_coef, (N_csf, N_states) ]
- implicit none
- BEGIN_DOC
- ! Wafe function in CSF basis
- END_DOC
-
- double precision, allocatable :: buffer(:,:)
- allocate ( buffer(N_det, N_states) )
- buffer(1:N_det, 1:N_states) = psi_coef(1:N_det, 1:N_states)
- call convertWFfromDETtoCSF(N_states, buffer, psi_csf_coef)
-END_PROVIDER
-
 subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out)
   use cfunctions
   use bitmasks
@@ -38,8 +26,6 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out)
 
   integer s, bfIcfg
   integer countcsf
-  integer MS
-  MS = elec_alpha_num-elec_beta_num
   countcsf = 0
   phasedet = 1.0d0
   do i = 1,N_configuration
@@ -58,17 +44,12 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out)
       enddo
     enddo
 
-    s = 0 ! s == total number of SOMOs
+    s = 0
     do k=1,N_int
       if (psi_configuration(k,1,i) == 0_bit_kind) cycle
       s = s + popcnt(psi_configuration(k,1,i))
     enddo
-
-    if(iand(s,1) .EQ. 0) then
-      bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1))))
-    else
-      bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
-    endif
+    bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
 
     ! perhaps blocking with CFGs of same seniority
     ! can be more efficient
diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f
index 5aaba9a3..85ed5f84 100644
--- a/src/csf/sigma_vector.irp.f
+++ b/src/csf/sigma_vector.irp.f
@@ -1,12 +1,9 @@
  real*8 function logabsgamma(x)
  implicit none
  real*8, intent(in) :: x
- logabsgamma = 1.d32  ! Avoid floating point exception
- if (x>0.d0) then
-   logabsgamma = log(abs(gamma(x)))
- endif
+ logabsgamma = log(abs(gamma(x)))
  end function logabsgamma
-
+  
   BEGIN_PROVIDER [ integer, NSOMOMax]
  &BEGIN_PROVIDER [ integer, NCSFMax]
  &BEGIN_PROVIDER [ integer*8, NMO]
@@ -51,60 +48,42 @@
       if(cfg_seniority_index(i+2) > ncfgpersomo) then
           ncfgpersomo = cfg_seniority_index(i+2)
       else
-        ! l = i+k+2 
-        ! Loop over l with a constraint to ensure that l <= size(cfg_seniority_index,1)-1
-        ! Old version commented just below
-        do l = min(size(cfg_seniority_index,1)-1, i+2), size(cfg_seniority_index,1)-1, 2
-          if (cfg_seniority_index(l) >= ncfgpersomo) then
-            ncfgpersomo = cfg_seniority_index(l)
-          endif
+        k = 0
+        do while(cfg_seniority_index(i+2+k) < ncfgpersomo)
+          k = k + 2
+          ncfgpersomo = cfg_seniority_index(i+2+k)
         enddo
-        !k = 0
-        !if ((i+2+k) < size(cfg_seniority_index,1)) then
-        !  do while(cfg_seniority_index(i+2+k) < ncfgpersomo)
-        !    k = k + 2
-        !    if ((i+2+k) >= size(cfg_seniority_index,1)) then
-        !      exit
-        !    endif
-        !    ncfgpersomo = cfg_seniority_index(i+2+k)
-        !  enddo
-        !endif
       endif
     endif
     ncfg = ncfgpersomo - ncfgprev
-    if(i .EQ. 0 .OR. i .EQ. 1) then
-      dimcsfpercfg = 1
-    elseif( i .EQ. 3) then
-      dimcsfpercfg = 2
+    if(iand(MS,1) .EQ. 0) then
+      !dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1))))
+      binom1 = dexp(logabsgamma(1.0d0*(i+1))                            &
+                  - logabsgamma(1.0d0*((i/2)+1))                        &
+                  - logabsgamma(1.0d0*(i-((i/2))+1)));
+      binom2 = dexp(logabsgamma(1.0d0*(i+1))                            &
+                  - logabsgamma(1.0d0*(((i/2)+1)+1))                    &
+                  - logabsgamma(1.0d0*(i-((i/2)+1)+1)));
+      dimcsfpercfg = max(1,nint(binom1 - binom2))
     else
-      if(iand(MS,1) .EQ. 0) then
-        dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1))))
-      else
-        dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2))))
-      endif
+      !dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2))))
+      binom1 = dexp(logabsgamma(1.0d0*(i+1))                            &
+                  - logabsgamma(1.0d0*(((i+1)/2)+1))                    &
+                  - logabsgamma(1.0d0*(i-(((i+1)/2))+1)));
+      binom2 = dexp(logabsgamma(1.0d0*(i+1))                            &
+                  - logabsgamma(1.0d0*((((i+3)/2)+1)+1))                &
+                  - logabsgamma(1.0d0*(i-(((i+3)/2)+1)+1)));
+      dimcsfpercfg = max(1,nint(binom1 - binom2))
     endif
     n_CSF += ncfg * dimcsfpercfg
     if(cfg_seniority_index(i+2) > ncfgprev) then
       ncfgprev = cfg_seniority_index(i+2)
     else
-      ! l = i+k+2 
-      ! Loop over l with a constraint to ensure that l <= size(cfg_seniority_index,1)-1
-      ! Old version commented just below
-      do l = min(size(cfg_seniority_index,1)-1, i+2), size(cfg_seniority_index,1)-1, 2
-        if (cfg_seniority_index(l) >= ncfgprev) then
-          ncfgprev = cfg_seniority_index(l)
-        endif
+      k = 0
+      do while(cfg_seniority_index(i+2+k) < ncfgprev)
+        k = k + 2
+        ncfgprev = cfg_seniority_index(i+2+k)
       enddo
-      !k = 0
-      !if ((i+2+k) < size(cfg_seniority_index,1)) then
-      !  do while(cfg_seniority_index(i+2+k) < ncfgprev)
-      !    k = k + 2
-      !    if ((i+2+k) >= size(cfg_seniority_index,1)) then
-      !      exit
-      !    endif
-      !    ncfgprev = cfg_seniority_index(i+2+k)
-      !  enddo
-      !endif
     endif
   enddo
 END_PROVIDER
diff --git a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f
index 243e9995..2f3d7f80 100644
--- a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f
+++ b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f
@@ -1,5 +1,5 @@
 
-subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc)
+subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc)
   use mmap_module
   implicit none
   BEGIN_DOC
@@ -412,6 +412,36 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
   FREE nthreads_davidson
 end
 
+subroutine hcalc_template(v,u,N_st,sze)
+  use bitmasks
+  implicit none
+  BEGIN_DOC
+  ! Template of routine for the application of H
+  !
+  ! Here, it is done with the Hamiltonian matrix 
+  !
+  ! on the set of determinants of psi_det 
+  !
+  ! Computes $v = H | u \rangle$ 
+  !
+  END_DOC
+  integer, intent(in)              :: N_st,sze
+  double precision, intent(in)     :: u(sze,N_st)
+  double precision, intent(inout)  :: v(sze,N_st)
+  integer :: i,j,istate
+  v = 0.d0
+  do istate = 1, N_st
+   do i = 1, sze
+    do j = 1, sze
+      v(i,istate) += H_matrix_all_dets(j,i) * u(j,istate)
+    enddo
+   enddo
+   do i = 1, sze
+    v(i,istate) += u(i,istate) * nuclear_repulsion
+   enddo
+  enddo
+end
+
 subroutine dressing_diag_uv(v,u,dress_diag,N_st,sze)
   implicit none
   BEGIN_DOC
diff --git a/src/dav_general_mat/dav_ext_rout.irp.f b/src/dav_general_mat/dav_ext_rout.irp.f
index 868d928b..aee4ba09 100644
--- a/src/dav_general_mat/dav_ext_rout.irp.f
+++ b/src/dav_general_mat/dav_ext_rout.irp.f
@@ -247,8 +247,8 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
       if (state_following) then
 
         overlap = -1.d0
-        do k=1,shift2
-          do i=1,shift2
+        do i=1,shift2
+          do k=1,shift2
             overlap(k,i) = dabs(y(k,i))
           enddo
         enddo
diff --git a/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f b/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f
new file mode 100644
index 00000000..c5127861
--- /dev/null
+++ b/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f
@@ -0,0 +1,608 @@
+
+! ---
+
+subroutine davidson_general_ext_rout_nonsym_b1space(u_in, H_jj, energies, sze, N_st, N_st_diag_in, converged, hcalc)
+
+  use mmap_module
+
+  BEGIN_DOC
+  ! Generic modified-Davidson diagonalization 
+  !
+  ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson
+  !
+  ! u_in : guess coefficients on the various states. Overwritten on exit by right eigenvectors
+  !
+  ! sze : Number of determinants
+  !
+  ! N_st : Number of eigenstates
+  !
+  ! N_st_diag_in : Number of states in which H is diagonalized. Assumed > N_st
+  !
+  ! Initial guess vectors are not necessarily orthonormal
+  !
+  ! hcalc subroutine to compute W = H U (see routine hcalc_template for template of input/output)
+  END_DOC
+
+  implicit none
+
+  integer,           intent(in)   :: sze, N_st, N_st_diag_in
+  double precision,  intent(in)   :: H_jj(sze)
+  logical,          intent(inout) :: converged
+  double precision, intent(inout) :: u_in(sze,N_st_diag_in)
+  double precision, intent(out)   :: energies(N_st)
+  external                           hcalc
+
+  character*(16384)               :: write_buffer
+  integer                         :: iter, N_st_diag
+  integer                         :: i, j, k, m
+  integer                         :: iter2, itertot
+  logical                         :: disk_based
+  integer                         :: shift, shift2, itermax
+  integer                         :: nproc_target
+  integer                         :: order(N_st_diag_in)
+  double precision                :: to_print(2,N_st)
+  double precision                :: r1, r2, alpha
+  double precision                :: cpu, wall
+  double precision                :: cmax
+  double precision                :: energy_shift(N_st_diag_in*davidson_sze_max)
+  double precision, allocatable   :: U(:,:)
+  double precision, allocatable   :: y(:,:), h(:,:), lambda(:)
+  double precision, allocatable   :: residual_norm(:)
+
+  integer                         :: i_omax
+  double precision                :: lambda_tmp
+  double precision, allocatable   :: U_tmp(:), overlap(:)
+
+  double precision, allocatable :: W(:,:)
+  !double precision, pointer       :: W(:,:)
+  double precision, external      :: u_dot_v, u_dot_u
+
+
+  include 'constants.include.F'
+
+  N_st_diag = N_st_diag_in 
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, y, h, lambda
+  if(N_st_diag*3 > sze) then
+    print *,  'error in Davidson :'
+    print *,  'Increase n_det_max_full to ', N_st_diag*3
+    stop -1
+  endif
+
+  itermax = max(2, min(davidson_sze_max, sze/N_st_diag)) + 1
+
+  provide threshold_nonsym_davidson 
+  call write_time(6)
+  write(6,'(A)') ''
+  write(6,'(A)') 'Davidson Diagonalization'
+  write(6,'(A)') '------------------------'
+  write(6,'(A)') ''
+
+
+  ! Find max number of cores to fit in memory
+  ! -----------------------------------------
+
+  nproc_target = nproc
+  double precision :: rss
+  integer :: maxab
+  maxab = sze 
+
+  m=1
+  disk_based = .False.
+  call resident_memory(rss)
+  do
+    r1 = 8.d0 *                                   &! bytes
+         ( dble(sze)*(N_st_diag*itermax)          &! U
+         + 1.d0*dble(sze*m)*(N_st_diag*itermax)   &! W
+         + 2.d0*(N_st_diag*itermax)**2            &! h,y
+         + 2.d0*(N_st_diag*itermax)               &! s2,lambda
+         + 1.d0*(N_st_diag)                       &! residual_norm
+                                                   ! In H_S2_u_0_nstates_zmq
+         + 3.d0*(N_st_diag*N_det)                 &! u_t, v_t, s_t on collector
+         + 3.d0*(N_st_diag*N_det)                 &! u_t, v_t, s_t on slave
+         + 0.5d0*maxab                            &! idx0 in H_S2_u_0_nstates_openmp_work_*
+         + nproc_target *                         &! In OMP section
+           ( 1.d0*(N_int*maxab)                   &! buffer
+           + 3.5d0*(maxab) )                      &! singles_a, singles_b, doubles, idx
+         ) / 1024.d0**3
+
+    if(nproc_target == 0) then
+      call check_mem(r1, irp_here)
+      nproc_target = 1
+      exit
+    endif
+
+    if(r1+rss < qp_max_mem) then
+      exit
+    endif
+
+    if(itermax > 4) then
+      itermax = itermax - 1
+    else if (m==1.and.disk_based_davidson) then
+      m = 0
+      disk_based = .True.
+      itermax = 6
+    else
+      nproc_target = nproc_target - 1
+    endif
+
+  enddo
+
+  nthreads_davidson = nproc_target
+  TOUCH nthreads_davidson
+
+  call write_int(6, N_st, 'Number of states')
+  call write_int(6, N_st_diag, 'Number of states in diagonalization')
+  call write_int(6, sze, 'Number of basis functions')
+  call write_int(6, nproc_target, 'Number of threads for diagonalization')
+  call write_double(6, r1, 'Memory(Gb)')
+  if(disk_based) then
+    print *, 'Using swap space to reduce RAM'
+  endif
+
+  !---------------
+
+  write(6,'(A)') ''
+  write_buffer = '====='
+  do i=1,N_st
+    write_buffer = trim(write_buffer)//' ================  ==========='
+  enddo
+  write(6,'(A)') write_buffer(1:6+41*N_st)
+  write_buffer = 'Iter'
+  do i=1,N_st
+    write_buffer = trim(write_buffer)//'       Energy         Residual '
+  enddo
+  write(6,'(A)') write_buffer(1:6+41*N_st)
+  write_buffer = '====='
+  do i=1,N_st
+    write_buffer = trim(write_buffer)//' ================  ==========='
+  enddo
+  write(6,'(A)') write_buffer(1:6+41*N_st)
+
+  ! ---
+
+
+  allocate( W(sze,N_st_diag*itermax) )
+
+  allocate(                                                          &
+      ! Large
+      U(sze,N_st_diag*itermax),                                      &
+      ! Small
+      h(N_st_diag*itermax,N_st_diag*itermax),                        &
+      y(N_st_diag*itermax,N_st_diag*itermax),                        &
+      lambda(N_st_diag*itermax),                                     & 
+      residual_norm(N_st_diag)                                       &
+  )
+
+  U = 0.d0
+  h = 0.d0
+  y = 0.d0
+  lambda = 0.d0
+  residual_norm = 0.d0
+
+
+  ASSERT (N_st > 0)
+  ASSERT (N_st_diag >= N_st)
+  ASSERT (sze > 0)
+
+  ! Davidson iterations
+  ! ===================
+
+  converged = .False.
+
+  ! Initialize from N_st to N_st_diag with gaussian random numbers
+  ! to be sure to have overlap with any eigenvectors
+  do k = N_st+1, N_st_diag
+    u_in(k,k) = 10.d0
+    do i = 1, sze
+      call random_number(r1)
+      call random_number(r2)
+      r1 = dsqrt(-2.d0*dlog(r1))
+      r2 = dtwo_pi*r2
+      u_in(i,k) = r1*dcos(r2)
+    enddo
+  enddo
+  ! Normalize all states 
+  do k = 1, N_st_diag
+    call normalize(u_in(1,k), sze)
+  enddo
+
+  ! Copy from the guess input "u_in" to the working vectors "U"
+  do k = 1, N_st_diag
+    do i = 1, sze
+      U(i,k) = u_in(i,k)
+    enddo
+  enddo
+
+  ! ---
+
+  itertot = 0
+
+  do while (.not.converged)
+
+    itertot = itertot + 1
+    if(itertot == 8) then
+      exit
+    endif
+
+    do iter = 1, itermax-1
+
+      shift  = N_st_diag * (iter-1)
+      shift2 = N_st_diag * iter
+
+      if( (iter > 1) .or. (itertot == 1) ) then
+
+        ! Gram-Schmidt to orthogonalize all new guess with the previous vectors 
+        call ortho_qr(U, size(U, 1), sze, shift2)
+        call ortho_qr(U, size(U, 1), sze, shift2)
+
+        ! W = H U
+        call hcalc(W(1,shift+1), U(1,shift+1), N_st_diag, sze)
+
+      else
+
+        ! Already computed in update below
+        continue
+      endif
+
+      ! Compute h_kl = <u_k | W_l> = <u_k| H |u_l>
+      ! -------------------------------------------
+      call dgemm( 'T', 'N', shift2, shift2, sze, 1.d0 &
+                , U, size(U, 1), W, size(W, 1)        &
+                , 0.d0, h, size(h, 1) )
+
+
+      ! Diagonalize h y = lambda y
+      ! ---------------------------
+      call diag_nonsym_right(shift2, h(1,1), size(h, 1), y(1,1), size(y, 1), lambda(1), size(lambda, 1))
+
+
+      ! Express eigenvectors of h in the determinant basis:
+      ! ---------------------------------------------------
+
+      ! y(:,k) = rk
+      ! U(:,k) = Bk 
+      ! U(:,shift2+k) = Rk = Bk x rk
+      call dgemm( 'N', 'N', sze, N_st_diag, shift2, 1.d0 &
+                , U, size(U, 1), y, size(y, 1)           & 
+                , 0.d0, U(1,shift2+1), size(U, 1) )
+
+      do k = 1, N_st_diag
+        call normalize(U(1,shift2+k), sze)
+      enddo
+
+      ! ---
+      ! select the max overlap
+
+      !
+      ! start test ------------------------------------------------------------------------
+      !
+      !double precision, allocatable :: Utest(:,:), Otest(:)
+      !allocate( Utest(sze,shift2), Otest(shift2) )
+
+      !call dgemm( 'N', 'N', sze, shift2, shift2, 1.d0 &
+      !          , U, size(U, 1), y, size(y, 1), 0.d0, Utest(1,1), size(Utest, 1) )
+      !do k = 1, shift2
+      !  call normalize(Utest(1,k), sze)
+      !enddo
+      !do j = 1, sze
+      !  write(455, '(100(1X, F16.10))') (Utest(j,k), k=1,shift2)
+      !enddo
+
+      !do k = 1, shift2 
+      !  Otest(k) = 0.d0
+      !  do i = 1, sze
+      !    Otest(k) += Utest(i,k) * u_in(i,1)
+      !  enddo
+      !  Otest(k) = dabs(Otest(k))
+      !  print *, ' Otest =', k, Otest(k), lambda(k)
+      !enddo
+     
+      !deallocate(Utest, Otest)
+      !
+      ! end test ------------------------------------------------------------------------
+      !
+
+
+      allocate( overlap(N_st_diag) )
+
+      do k = 1, N_st_diag
+        overlap(k) = 0.d0
+        do i = 1, sze
+          overlap(k) = overlap(k) + U(i,shift2+k) * u_in(i,1)
+        enddo
+        overlap(k) = dabs(overlap(k))
+        !print *, ' overlap =', k, overlap(k)
+      enddo
+
+      lambda_tmp = 0.d0 
+      do k = 1, N_st_diag
+        if(overlap(k) .gt. lambda_tmp) then 
+          i_omax = k
+          lambda_tmp = overlap(k)
+        endif
+      enddo
+      deallocate(overlap)
+      if( lambda_tmp .lt. 0.8d0) then
+        print *, ' very small overlap..'
+        print*, ' max overlap = ', lambda_tmp, i_omax
+        stop
+      endif
+
+!      lambda_tmp     = lambda(1)
+!      lambda(1)      = lambda(i_omax)
+!      lambda(i_omax) = lambda_tmp
+!
+!      allocate( U_tmp(sze) )
+!      do i = 1, sze
+!        U_tmp(i)           = U(i,shift2+1)
+!        U(i,shift2+1)      = U(i,shift2+i_omax)
+!        U(i,shift2+i_omax) = U_tmp(i)
+!      enddo
+!      deallocate(U_tmp)
+!
+!      allocate( U_tmp(N_st_diag*itermax) )
+!      do i = 1, shift2
+!        U_tmp(i)    = y(i,1)
+!        y(i,1)      = y(i,i_omax)
+!        y(i,i_omax) = U_tmp(i)
+!      enddo
+!      deallocate(U_tmp)
+
+      ! ---
+
+      !do k = 1, N_st_diag
+      !  call normalize(U(1,shift2+k), sze)
+      !enddo
+
+      ! ---
+
+      ! y(:,k) = rk
+      ! W(:,k) = H x Bk 
+      ! W(:,shift2+k) = H x Bk x rk
+      !               = Wk
+      call dgemm( 'N', 'N', sze, N_st_diag, shift2, 1.d0 &
+                , W, size(W, 1), y, size(y, 1)           &
+                , 0.d0, W(1,shift2+1), size(W, 1) )
+
+      ! ---
+
+      ! Compute residual vector and davidson step
+      ! -----------------------------------------
+
+      !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k)
+      do k = 1, N_st_diag
+        do i = 1, sze
+          U(i,shift2+k) = (lambda(k) * U(i,shift2+k) - W(i,shift2+k)) / max(H_jj(i)-lambda(k), 1.d-2)
+        enddo
+        !if(k <= N_st) then
+        !  residual_norm(k) = u_dot_u(U(1,shift2+k), sze)
+        !  to_print(1,k) = lambda(k) 
+        !  to_print(2,k) = residual_norm(k)
+        !endif
+      enddo
+      !$OMP END PARALLEL DO
+      residual_norm(1) = u_dot_u(U(1,shift2+i_omax), sze)
+      to_print(1,1) = lambda(i_omax) 
+      to_print(2,1) = residual_norm(1)
+
+
+      if( (itertot > 1) .and. (iter == 1) ) then
+        !don't print 
+        continue
+      else
+        write(*, '(1X, I3, 1X, 100(1X, F16.10, 1X, F16.10, 1X, F16.10))') iter-1, to_print(1:2,1:N_st)
+      endif
+
+      ! Check convergence
+      if(iter > 1) then
+        converged = dabs(maxval(residual_norm(1:N_st))) < threshold_nonsym_davidson
+      endif   
+      
+      do k = 1, N_st
+        if(residual_norm(k) > 1.e8) then
+          print *, 'Davidson failed'
+          stop -1
+        endif
+      enddo
+      if(converged) then
+        exit
+      endif
+
+      logical, external :: qp_stop
+      if(qp_stop()) then
+        converged = .True.
+        exit
+      endif
+
+    enddo ! loop over iter
+
+
+    ! Re-contract U and update W
+    ! --------------------------------
+
+    call dgemm( 'N', 'N', sze, N_st_diag, shift2, 1.d0  &
+              , W, size(W, 1), y, size(y, 1)            &
+              , 0.d0, u_in, size(u_in, 1) )
+    do k = 1, N_st_diag
+      do i = 1, sze
+        W(i,k) = u_in(i,k)
+      enddo
+    enddo
+
+    call dgemm( 'N', 'N', sze, N_st_diag, shift2, 1.d0 &
+              , U, size(U, 1), y, size(y, 1)           &
+              , 0.d0, u_in, size(u_in, 1) )
+    do k = 1, N_st_diag
+      do i = 1, sze
+        U(i,k) = u_in(i,k)
+      enddo
+    enddo
+
+    call ortho_qr(U, size(U, 1), sze, N_st_diag)
+    call ortho_qr(U, size(U, 1), sze, N_st_diag)
+    do j = 1, N_st_diag
+      k = 1
+      do while( (k < sze) .and. (U(k,j) == 0.d0) )
+        k = k+1
+      enddo
+      if(U(k,j) * u_in(k,j) < 0.d0) then
+        do i = 1, sze
+          W(i,j) = -W(i,j)
+        enddo
+      endif
+    enddo
+
+  enddo ! loop over while
+
+  ! ---
+
+  do k = 1, N_st
+    energies(k) = lambda(k)
+  enddo
+  write_buffer = '====='
+  do i = 1, N_st
+    write_buffer = trim(write_buffer)//' ================  ==========='
+  enddo
+  write(6,'(A)') trim(write_buffer)
+  write(6,'(A)') ''
+  call write_time(6)
+
+  deallocate(W)
+  deallocate(U, h, y, lambda, residual_norm)
+
+  FREE nthreads_davidson
+
+end subroutine davidson_general_ext_rout_nonsym_b1space
+
+! ---
+
+subroutine diag_nonsym_right(n, A, A_ldim, V, V_ldim, energy, E_ldim)
+
+  implicit none
+
+  integer,          intent(in)  :: n, A_ldim, V_ldim, E_ldim
+  double precision, intent(in)  :: A(A_ldim,n)
+  double precision, intent(out) :: energy(E_ldim), V(V_ldim,n)
+
+  character*1                   :: JOBVL, JOBVR, BALANC, SENSE
+  integer                       :: i, j
+  integer                       :: ILO, IHI, lda, ldvl, ldvr, LWORK, INFO
+  double precision              :: ABNRM
+  integer,          allocatable :: iorder(:), IWORK(:)
+  double precision, allocatable :: WORK(:), SCALE_array(:), RCONDE(:), RCONDV(:)
+  double precision, allocatable :: Atmp(:,:), WR(:), WI(:), VL(:,:), VR(:,:), Vtmp(:)
+  double precision, allocatable :: energy_loc(:), V_loc(:,:)
+
+  allocate( Atmp(n,n), WR(n), WI(n), VL(1,1), VR(n,n) )
+  do i = 1, n
+    do j = 1, n
+      Atmp(j,i) = A(j,i)
+    enddo
+  enddo
+
+  JOBVL  = "N" ! computes the left  eigenvectors 
+  JOBVR  = "V" ! computes the right eigenvectors 
+  BALANC = "B" ! Diagonal scaling and Permutation for optimization
+  SENSE  = "V" ! Determines which reciprocal condition numbers are computed
+  lda  = n 
+  ldvr = n 
+  ldvl = 1
+
+  allocate( WORK(1), SCALE_array(n), RCONDE(n), RCONDV(n), IWORK(2*n-2) )
+
+  LWORK = -1 ! to ask for the optimal size of WORK
+  call dgeevx( BALANC, JOBVL, JOBVR, SENSE                  & ! CHARACTERS 
+             , n, Atmp, lda                                 & ! MATRIX TO DIAGONALIZE
+             , WR, WI                                       & ! REAL AND IMAGINARY PART OF EIGENVALUES 
+             , VL, ldvl, VR, ldvr                           & ! LEFT AND RIGHT EIGENVECTORS 
+             , ILO, IHI, SCALE_array, ABNRM, RCONDE, RCONDV & ! OUTPUTS OF OPTIMIZATION
+             , WORK, LWORK, IWORK, INFO )
+
+  if(INFO .ne. 0) then
+    print*, 'dgeevx failed !!', INFO
+    stop
+  endif
+
+  LWORK = max(int(work(1)), 1) ! this is the optimal size of WORK 
+  deallocate(WORK)
+  allocate(WORK(LWORK))
+  call dgeevx( BALANC, JOBVL, JOBVR, SENSE                  &
+             , n, Atmp, lda                                 &
+             , WR, WI                                       &
+             , VL, ldvl, VR, ldvr                           &
+             , ILO, IHI, SCALE_array, ABNRM, RCONDE, RCONDV &
+             , WORK, LWORK, IWORK, INFO )
+  if(INFO .ne. 0) then
+    print*, 'dgeevx failed !!', INFO
+    stop
+  endif
+
+  deallocate( WORK, SCALE_array, RCONDE, RCONDV, IWORK )
+  deallocate( VL, Atmp )
+
+
+  allocate( energy_loc(n), V_loc(n,n) )
+  energy_loc = 0.d0
+  V_loc = 0.d0
+
+  i = 1
+  do while(i .le. n)
+
+!    print*, i, WR(i), WI(i)
+
+    if( dabs(WI(i)) .gt. 1e-7 ) then
+
+      print*, ' Found an imaginary component to eigenvalue'
+      print*, ' Re(i) + Im(i)', i, WR(i), WI(i)
+
+      energy_loc(i) = WR(i)
+      do j = 1, n 
+        V_loc(j,i) = WR(i) * VR(j,i) - WI(i) * VR(j,i+1)
+      enddo
+      energy_loc(i+1) = WI(i)
+      do j = 1, n
+        V_loc(j,i+1) = WR(i) * VR(j,i+1) + WI(i) * VR(j,i)
+      enddo
+      i = i + 2
+
+    else
+
+      energy_loc(i) = WR(i)
+      do j = 1, n 
+        V_loc(j,i) = VR(j,i)
+      enddo
+      i = i + 1
+
+    endif
+
+  enddo
+
+  deallocate(WR, WI, VR)
+
+
+  ! ordering
+!  do j = 1, n
+!    write(444, '(100(1X, F16.10))') (V_loc(j,i), i=1,5)
+!  enddo
+  allocate( iorder(n) )
+  do i = 1, n
+    iorder(i) = i
+  enddo
+  call dsort(energy_loc, iorder, n)
+  do i = 1, n
+    energy(i) = energy_loc(i)
+    do j = 1, n 
+      V(j,i) = V_loc(j,iorder(i))
+    enddo
+  enddo
+  deallocate(iorder)
+!  do j = 1, n
+!    write(445, '(100(1X, F16.10))') (V_loc(j,i), i=1,5)
+!  enddo
+  deallocate(V_loc, energy_loc)
+
+end subroutine diag_nonsym_right
+
+! ---
+
diff --git a/src/dav_general_mat/dav_general.irp.f b/src/dav_general_mat/dav_general.irp.f
index aa4a2eb3..39cb68bb 100644
--- a/src/dav_general_mat/dav_general.irp.f
+++ b/src/dav_general_mat/dav_general.irp.f
@@ -258,8 +258,8 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
       if (state_following) then
 
         overlap = -1.d0
-        do k=1,shift2
-          do i=1,shift2
+        do i=1,shift2
+          do k=1,shift2
             overlap(k,i) = dabs(y(k,i))
           enddo
         enddo
diff --git a/src/davidson/EZFIO.cfg b/src/davidson/EZFIO.cfg
index 92c41b4c..de814b94 100644
--- a/src/davidson/EZFIO.cfg
+++ b/src/davidson/EZFIO.cfg
@@ -4,6 +4,12 @@ doc: Thresholds of Davidson's algorithm if threshold_davidson_from_pt2 is false.
 interface: ezfio,provider,ocaml
 default: 1.e-10
 
+[threshold_nonsym_davidson]
+type: Threshold
+doc: Thresholds of non-symetric Davidson's algorithm 
+interface: ezfio,provider,ocaml
+default: 1.e-5
+
 [threshold_davidson_from_pt2]
 type: logical
 doc: Thresholds of Davidson's algorithm is set to E(rPT2)*threshold_davidson_from_pt2
diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f
index e627dfc9..8fd023da 100644
--- a/src/davidson/davidson_parallel.irp.f
+++ b/src/davidson/davidson_parallel.irp.f
@@ -508,7 +508,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   endif
 
 
-  call set_multiple_levels_omp(.True.)
+  call omp_set_max_active_levels(5)
 
   !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread)
   ithread = omp_get_thread_num()
diff --git a/src/davidson/davidson_parallel_csf.irp.f b/src/davidson/davidson_parallel_csf.irp.f
index d8e9bffa..fe651b1d 100644
--- a/src/davidson/davidson_parallel_csf.irp.f
+++ b/src/davidson/davidson_parallel_csf.irp.f
@@ -464,8 +464,7 @@ subroutine H_u_0_nstates_zmq(v_0,u_0,N_st,sze)
     print *,  irp_here, ': Failed in zmq_set_running'
   endif
 
-  call set_multiple_levels_omp(.True.)
-
+  call omp_set_max_active_levels(4)
   !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread)
   ithread = omp_get_thread_num()
   if (ithread == 0 ) then
diff --git a/src/davidson/davidson_parallel_nos2.irp.f b/src/davidson/davidson_parallel_nos2.irp.f
index 597b001f..84cbe3af 100644
--- a/src/davidson/davidson_parallel_nos2.irp.f
+++ b/src/davidson/davidson_parallel_nos2.irp.f
@@ -464,8 +464,7 @@ subroutine H_u_0_nstates_zmq(v_0,u_0,N_st,sze)
     print *,  irp_here, ': Failed in zmq_set_running'
   endif
 
-  call set_multiple_levels_omp(.True.)
-
+  call omp_set_max_active_levels(4)
   !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread)
   ithread = omp_get_thread_num()
   if (ithread == 0 ) then
diff --git a/src/davidson/diagonalization_hcsf_dressed.irp.f b/src/davidson/diagonalization_hcsf_dressed.irp.f
index 7aaaa842..b6f438a0 100644
--- a/src/davidson/diagonalization_hcsf_dressed.irp.f
+++ b/src/davidson/diagonalization_hcsf_dressed.irp.f
@@ -124,7 +124,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
     stop -1
   endif
 
-  itermax = max(2,min(davidson_sze_max, sze_csf/N_st_diag))+1
+  itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1
   itertot = 0
 
   if (state_following) then
@@ -263,20 +263,29 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
   ! ===================
 
   converged = .False.
-  call convertWFfromDETtoCSF(N_st_diag,u_in(1,1),U_csf(1,1))
+
   do k=N_st+1,N_st_diag
-    do i=1,sze_csf
+    do i=1,sze
         call random_number(r1)
         call random_number(r2)
         r1 = dsqrt(-2.d0*dlog(r1))
         r2 = dtwo_pi*r2
-        U_csf(i,k) = r1*dcos(r2) * u_csf(i,k-N_st)
+        u_in(i,k) = r1*dcos(r2) * u_in(i,k-N_st)
     enddo
-    U_csf(k,k) = u_csf(k,k) + 10.d0
+    u_in(k,k) = u_in(k,k) + 10.d0
   enddo
   do k=1,N_st_diag
-    call normalize(U_csf(1,k),sze_csf)
+    call normalize(u_in(1,k),sze)
   enddo
+
+  do k=1,N_st_diag
+    do i=1,sze
+      U(i,k) = u_in(i,k)
+    enddo
+  enddo
+
+  ! Make random verctors eigenstates of S2
+  call convertWFfromDETtoCSF(N_st_diag,U(1,1),U_csf(1,1))
   call convertWFfromCSFtoDET(N_st_diag,U_csf(1,1),U(1,1))
 
   do while (.not.converged)
@@ -290,7 +299,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
       shift  = N_st_diag*(iter-1)
       shift2 = N_st_diag*iter
 
-!      if ((iter > 1).or.(itertot == 1)) then
+      if ((iter > 1).or.(itertot == 1)) then
         ! Compute |W_k> = \sum_i |i><i|H|u_k>
         ! -----------------------------------
 
@@ -300,10 +309,10 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
         else
             call H_u_0_nstates_openmp(W,U,N_st_diag,sze)
         endif
-!      else
-!         ! Already computed in update below
-!         continue
-!      endif
+      else
+         ! Already computed in update below
+         continue
+      endif
 
       if (dressing_state > 0) then
 
@@ -499,8 +508,17 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
 
     enddo
 
-    ! Re-contract U
-    ! -------------
+    ! Re-contract U and update W
+    ! --------------------------------
+
+    call dgemm('N','N', sze_csf, N_st_diag, shift2, 1.d0,      &
+        W_csf, size(W_csf,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
+    do k=1,N_st_diag
+      do i=1,sze_csf
+        W_csf(i,k) = u_in(i,k)
+      enddo
+    enddo
+    call convertWFfromCSFtoDET(N_st_diag,W_csf,W)
 
     call dgemm('N','N', sze_csf, N_st_diag, shift2, 1.d0,      &
         U_csf, size(U_csf,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f
index d37b7386..1a27a75e 100644
--- a/src/davidson/diagonalization_hs2_dressed.irp.f
+++ b/src/davidson/diagonalization_hs2_dressed.irp.f
@@ -349,7 +349,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
       shift  = N_st_diag*(iter-1)
       shift2 = N_st_diag*iter
 
-!      if ((iter > 1).or.(itertot == 1)) then
+      if ((iter > 1).or.(itertot == 1)) then
         ! Compute |W_k> = \sum_i |i><i|H|u_k>
         ! -----------------------------------
 
@@ -359,10 +359,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
             call H_S2_u_0_nstates_openmp(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze)
         endif
         S(1:sze,shift+1:shift+N_st_diag) = real(S_d(1:sze,1:N_st_diag))
-!      else
-!         ! Already computed in update below
-!         continue
-!      endif
+      else
+         ! Already computed in update below
+         continue
+      endif
 
       if (dressing_state > 0) then
 
diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f
index 6930cc07..fb991b65 100644
--- a/src/davidson/diagonalize_ci.irp.f
+++ b/src/davidson/diagonalize_ci.irp.f
@@ -1,19 +1,9 @@
-BEGIN_PROVIDER [ character*(3), sigma_vector_algorithm ]
- implicit none
- BEGIN_DOC
- ! If 'det', use <Psi_det|H|Psi_det> in Davidson
- !
- ! If 'cfg', use <Psi_csf|H|Psi_csf> in Davidson
- END_DOC
- sigma_vector_algorithm = 'det'
-END_PROVIDER
 
 BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ]
   implicit none
   BEGIN_DOC
   ! :c:data:`n_states` lowest eigenvalues of the |CI| matrix
   END_DOC
-  PROVIDE distributed_davidson
 
   integer                        :: j
   character*(8)                  :: st
@@ -71,18 +61,9 @@ END_PROVIDER
    if (diag_algorithm == "Davidson") then
 
      if (do_csf) then
-       if (sigma_vector_algorithm == 'det') then
-         call davidson_diag_H_csf(psi_det,CI_eigenvectors, &
-           size(CI_eigenvectors,1),CI_electronic_energy,               &
-           N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
-!       else if (sigma_vector_algorithm == 'cfg') then
-!       call davidson_diag_H_csf(psi_det,CI_eigenvectors, &
-!         size(CI_eigenvectors,1),CI_electronic_energy,               &
-!         N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
-!       else
-!         print *, irp_here
-!         stop 'bug'
-       endif
+       call davidson_diag_H_csf(psi_det,CI_eigenvectors, &
+         size(CI_eigenvectors,1),CI_electronic_energy,               &
+         N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
      else
        call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_s2, &
          size(CI_eigenvectors,1),CI_electronic_energy,               &
@@ -266,7 +247,6 @@ subroutine diagonalize_CI
 !  eigenstates of the |CI| matrix.
   END_DOC
   integer                        :: i,j
-  PROVIDE distributed_davidson
   do j=1,N_states
     do i=1,N_det
       psi_coef(i,j) = CI_eigenvectors(i,j)
diff --git a/src/two_body_rdm/print_e_components.irp.f b/src/davidson/print_e_components.irp.f
similarity index 100%
rename from src/two_body_rdm/print_e_components.irp.f
rename to src/davidson/print_e_components.irp.f
diff --git a/src/davidson/u0_hs2_u0.irp.f b/src/davidson/u0_hs2_u0.irp.f
index 38fb56bd..8f7bf06b 100644
--- a/src/davidson/u0_hs2_u0.irp.f
+++ b/src/davidson/u0_hs2_u0.irp.f
@@ -203,7 +203,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend,
   integer, allocatable           :: doubles(:)
   integer, allocatable           :: singles_a(:)
   integer, allocatable           :: singles_b(:)
-  integer, allocatable           :: idx(:), buffer_lrow(:), idx0(:)
+  integer, allocatable           :: idx(:), idx0(:)
   integer                        :: maxab, n_singles_a, n_singles_b, kcol_prev
   integer*8                      :: k8
   logical                        :: compute_singles
@@ -253,7 +253,7 @@ compute_singles=.True.
       !$OMP   PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i,     &
       !$OMP          lcol, lrow, l_a, l_b, utl, kk, u_is_sparse,     &
       !$OMP          buffer, doubles, n_doubles, umax,               &
-      !$OMP          tmp_det2, hij, sij, idx, buffer_lrow, l, kcol_prev,          &
+      !$OMP          tmp_det2, hij, sij, idx, l, kcol_prev,          &
       !$OMP          singles_a, n_singles_a, singles_b, ratio,       &
       !$OMP          n_singles_b, k8, last_found,left,right,right_max)
 
@@ -264,7 +264,7 @@ compute_singles=.True.
       singles_a(maxab),                                              &
       singles_b(maxab),                                              &
       doubles(maxab),                                                &
-      idx(maxab), buffer_lrow(maxab), utl(N_st,block_size))
+      idx(maxab), utl(N_st,block_size))
 
   kcol_prev=-1
 
@@ -332,20 +332,18 @@ compute_singles=.True.
         l_a = psi_bilinear_matrix_columns_loc(lcol)
         ASSERT (l_a <= N_det)
 
+        !DIR$ UNROLL(8)
+        !DIR$ LOOP COUNT avg(50000)
         do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol)
           lrow = psi_bilinear_matrix_rows(l_a)
           ASSERT (lrow <= N_det_alpha_unique)
 
-          buffer_lrow(j) = lrow
+          buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow)  ! hot spot
 
           ASSERT (l_a <= N_det)
           idx(j) = l_a
           l_a = l_a+1
         enddo
-
-        do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol)
-          buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, buffer_lrow(j))  ! hot spot
-        enddo
         j = j-1
 
         call get_all_spin_singles_$N_int(                              &
@@ -791,7 +789,7 @@ compute_singles=.True.
 
   end do
   !$OMP END DO
-  deallocate(buffer, singles_a, singles_b, doubles, idx, buffer_lrow, utl)
+  deallocate(buffer, singles_a, singles_b, doubles, idx, utl)
   !$OMP END PARALLEL
 
 end
diff --git a/src/davidson_dressed/diagonalize_ci.irp.f b/src/davidson_dressed/diagonalize_ci.irp.f
index b58ce9c0..7619532a 100644
--- a/src/davidson_dressed/diagonalize_ci.irp.f
+++ b/src/davidson_dressed/diagonalize_ci.irp.f
@@ -12,7 +12,7 @@ BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ]
   enddo
   do j=1,min(N_det,N_states)
     write(st,'(I4)') j
-    call write_double(6,CI_energy_dressed(j),'Energy dressed of state '//trim(st))
+    call write_double(6,CI_energy_dressed(j),'Energy of state '//trim(st))
     call write_double(6,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st))
   enddo
 
@@ -21,201 +21,133 @@ END_PROVIDER
  BEGIN_PROVIDER [ double precision, CI_electronic_energy_dressed, (N_states_diag) ]
 &BEGIN_PROVIDER [ double precision, CI_eigenvectors_dressed, (N_det,N_states_diag) ]
 &BEGIN_PROVIDER [ double precision, CI_eigenvectors_s2_dressed, (N_states_diag) ]
-   BEGIN_DOC
-   ! Eigenvectors/values of the CI matrix
-   END_DOC
-   implicit none
-   double precision               :: ovrlp,u_dot_v
-   integer                        :: i_good_state
-   integer, allocatable           :: index_good_state_array(:)
-   logical, allocatable           :: good_state_array(:)
-   double precision, allocatable  :: s2_values_tmp(:)
-   integer                        :: i_other_state
-   double precision, allocatable  :: eigenvectors(:,:), eigenvectors_s2(:,:), eigenvalues(:)
-   integer                        :: i_state
-   double precision               :: e_0
-   integer                        :: i,j,k,mrcc_state
-   double precision, allocatable  :: s2_eigvalues(:)
-   double precision, allocatable  :: e_array(:)
-   integer, allocatable           :: iorder(:)
-    logical                        :: converged
-    logical                        :: do_csf
-  
-   PROVIDE threshold_davidson nthreads_davidson
-   ! Guess values for the "N_states" states of the CI_eigenvectors_dressed
-   do j=1,min(N_states,N_det)
-     do i=1,N_det
-       CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
-     enddo
-   enddo
-  
-   do j=min(N_states,N_det)+1,N_states_diag
-     do i=1,N_det
-       CI_eigenvectors_dressed(i,j) = 0.d0
-     enddo
-   enddo
-  
-   do_csf = s2_eig .and. only_expected_s2 .and. csf_based
-  
-   if (diag_algorithm == "Davidson") then
-  
-     do j=1,min(N_states,N_det)
-       do i=1,N_det
-         CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
+  BEGIN_DOC
+  ! Eigenvectors/values of the CI matrix
+  END_DOC
+  implicit none
+  double precision               :: ovrlp,u_dot_v
+  integer                        :: i_good_state
+  integer, allocatable           :: index_good_state_array(:)
+  logical, allocatable           :: good_state_array(:)
+  double precision, allocatable  :: s2_values_tmp(:)
+  integer                        :: i_other_state
+  double precision, allocatable  :: eigenvectors(:,:), eigenvectors_s2(:,:), eigenvalues(:)
+  integer                        :: i_state
+  double precision               :: e_0
+  integer                        :: i,j,k,mrcc_state
+  double precision, allocatable  :: s2_eigvalues(:)
+  double precision, allocatable  :: e_array(:)
+  integer, allocatable           :: iorder(:)
+
+  PROVIDE threshold_davidson nthreads_davidson
+  ! Guess values for the "N_states" states of the CI_eigenvectors_dressed
+  do j=1,min(N_states,N_det)
+    do i=1,N_det
+      CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
+    enddo
+  enddo
+
+  do j=min(N_states,N_det)+1,N_states_diag
+    do i=1,N_det
+      CI_eigenvectors_dressed(i,j) = 0.d0
+    enddo
+  enddo
+
+  if (diag_algorithm == "Davidson") then
+
+    do j=1,min(N_states,N_det)
+      do i=1,N_det
+        CI_eigenvectors_dressed(i,j) = psi_coef(i,j)
+      enddo
+    enddo
+    logical :: converged
+    converged = .False.
+    call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,&
+        size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,&
+        N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged)
+
+  else if (diag_algorithm == "Lapack") then
+
+    allocate (eigenvectors(size(H_matrix_dressed,1),N_det))
+    allocate (eigenvalues(N_det))
+
+    call lapack_diag(eigenvalues,eigenvectors,                         &
+        H_matrix_dressed,size(H_matrix_dressed,1),N_det)
+     CI_electronic_energy_dressed(:) = 0.d0
+     if (s2_eig) then
+       i_state = 0
+       allocate (s2_eigvalues(N_det))
+       allocate(index_good_state_array(N_det),good_state_array(N_det))
+       good_state_array = .False.
+
+       call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,&
+                  N_det,size(eigenvectors,1))
+       do j=1,N_det
+         ! Select at least n_states states with S^2 values closed to "expected_s2"
+         if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then
+           i_state +=1
+           index_good_state_array(i_state) = j
+           good_state_array(j) = .True.
+         endif
+         if(i_state.eq.N_states) then
+           exit
+         endif
        enddo
-     enddo
-     converged = .False.
-     if (do_csf) then
-       call davidson_diag_H_csf(psi_det,CI_eigenvectors_dressed, &
-         size(CI_eigenvectors_dressed,1),CI_electronic_energy_dressed, &
-         N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged)
+       if(i_state .ne.0)then
+         ! Fill the first "i_state" states that have a correct S^2 value
+         do j = 1, i_state
+           do i=1,N_det
+             CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j))
+           enddo
+           CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j))
+           CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j))
+         enddo
+         i_other_state = 0
+         do j = 1, N_det
+           if(good_state_array(j))cycle
+           i_other_state +=1
+           if(i_state+i_other_state.gt.n_states_diag)then
+             exit
+           endif
+           do i=1,N_det
+             CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j)
+           enddo
+           CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j)
+           CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
+         enddo
+       else
+         print*,''
+         print*,'!!!!!!!!   WARNING  !!!!!!!!!'
+         print*,'  Within the ',N_det,'determinants selected'
+         print*,'  and the ',N_states_diag,'states requested'
+         print*,'  We did not find any state with S^2 values close to ',expected_s2
+         print*,'  We will then set the first N_states eigenvectors of the H matrix'
+         print*,'  as the CI_eigenvectors_dressed'
+         print*,'  You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space'
+         print*,''
+         do j=1,min(N_states_diag,N_det)
+           do i=1,N_det
+             CI_eigenvectors_dressed(i,j) = eigenvectors(i,j)
+           enddo
+           CI_electronic_energy_dressed(j) = eigenvalues(j)
+           CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j)
+         enddo
+       endif
+       deallocate(index_good_state_array,good_state_array)
+       deallocate(s2_eigvalues)
      else
-       call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,&
-         size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,&
-         N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged)
+       call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,&
+          min(N_det,N_states_diag),size(eigenvectors,1))
+       ! Select the "N_states_diag" states of lowest energy
+       do j=1,min(N_det,N_states_diag)
+         do i=1,N_det
+           CI_eigenvectors_dressed(i,j) = eigenvectors(i,j)
+         enddo
+         CI_electronic_energy_dressed(j) = eigenvalues(j)
+       enddo
      endif
-
-     integer :: N_states_diag_save
-     N_states_diag_save = N_states_diag
-     do while (.not.converged)
-        double precision, allocatable :: CI_electronic_energy_tmp (:)
-        double precision, allocatable :: CI_eigenvectors_tmp (:,:)
-        double precision, allocatable :: CI_s2_tmp (:)
-
-        N_states_diag  *= 2
-        TOUCH N_states_diag
-
-        if (do_csf) then
-
-          allocate (CI_electronic_energy_tmp (N_states_diag) )
-          allocate (CI_eigenvectors_tmp (N_det,N_states_diag) )
-
-          CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy_dressed(1:N_states_diag_save)
-          CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save)
-
-          call davidson_diag_H_csf(psi_det,CI_eigenvectors_tmp, &
-            size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp,               &
-            N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged)
-
-          CI_electronic_energy_dressed(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save)
-          CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save)
-
-          deallocate (CI_electronic_energy_tmp)
-          deallocate (CI_eigenvectors_tmp)
-
-        else
-
-          allocate (CI_electronic_energy_tmp (N_states_diag) )
-          allocate (CI_eigenvectors_tmp (N_det,N_states_diag) )
-          allocate (CI_s2_tmp (N_states_diag) )
-
-          CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy_dressed(1:N_states_diag_save)
-          CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save)
-          CI_s2_tmp(1:N_states_diag_save) = CI_eigenvectors_s2_dressed(1:N_states_diag_save)
-
-          call davidson_diag_HS2(psi_det,CI_eigenvectors_tmp, CI_s2_tmp, &
-            size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp,               &
-            N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged)
-
-          CI_electronic_energy_dressed(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save)
-          CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save)
-          CI_eigenvectors_s2_dressed(1:N_states_diag_save) = CI_s2_tmp(1:N_states_diag_save)
-
-          deallocate (CI_electronic_energy_tmp)
-          deallocate (CI_eigenvectors_tmp)
-          deallocate (CI_s2_tmp)
-
-        endif
-
-     enddo
-     if (N_states_diag > N_states_diag_save) then
-       N_states_diag = N_states_diag_save
-       TOUCH N_states_diag
-     endif
-  
-   else if (diag_algorithm == "Lapack") then
-  
-     print *,  'Diagonalization of H using Lapack'
-     allocate (eigenvectors(size(H_matrix_dressed,1),N_det))
-     allocate (eigenvalues(N_det))
-  
-     call lapack_diag(eigenvalues,eigenvectors,                         &
-         H_matrix_dressed,size(H_matrix_dressed,1),N_det)
-      CI_electronic_energy_dressed(:) = 0.d0
-      if (s2_eig) then
-        i_state = 0
-        allocate (s2_eigvalues(N_det))
-        allocate(index_good_state_array(N_det),good_state_array(N_det))
-        good_state_array = .False.
-  
-        call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,&
-                   N_det,size(eigenvectors,1))
-        do j=1,N_det
-          ! Select at least n_states states with S^2 values closed to "expected_s2"
-          if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then
-            i_state +=1
-            index_good_state_array(i_state) = j
-            good_state_array(j) = .True.
-          endif
-          if(i_state.eq.N_states) then
-            exit
-          endif
-        enddo
-        if(i_state .ne.0)then
-          ! Fill the first "i_state" states that have a correct S^2 value
-          do j = 1, i_state
-            do i=1,N_det
-              CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j))
-            enddo
-            CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j))
-            CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j))
-          enddo
-          i_other_state = 0
-          do j = 1, N_det
-            if(good_state_array(j))cycle
-            i_other_state +=1
-            if(i_state+i_other_state.gt.n_states_diag)then
-              exit
-            endif
-            do i=1,N_det
-              CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j)
-            enddo
-            CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j)
-            CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
-          enddo
-        else
-          print*,''
-          print*,'!!!!!!!!   WARNING  !!!!!!!!!'
-          print*,'  Within the ',N_det,'determinants selected'
-          print*,'  and the ',N_states_diag,'states requested'
-          print*,'  We did not find any state with S^2 values close to ',expected_s2
-          print*,'  We will then set the first N_states eigenvectors of the H matrix'
-          print*,'  as the CI_eigenvectors_dressed'
-          print*,'  You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space'
-          print*,''
-          do j=1,min(N_states_diag,N_det)
-            do i=1,N_det
-              CI_eigenvectors_dressed(i,j) = eigenvectors(i,j)
-            enddo
-            CI_electronic_energy_dressed(j) = eigenvalues(j)
-            CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j)
-          enddo
-        endif
-        deallocate(index_good_state_array,good_state_array)
-        deallocate(s2_eigvalues)
-      else
-        call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,&
-           min(N_det,N_states_diag),size(eigenvectors,1))
-        ! Select the "N_states_diag" states of lowest energy
-        do j=1,min(N_det,N_states_diag)
-          do i=1,N_det
-            CI_eigenvectors_dressed(i,j) = eigenvectors(i,j)
-          enddo
-          CI_electronic_energy_dressed(j) = eigenvalues(j)
-        enddo
-      endif
-     deallocate(eigenvectors,eigenvalues)
-   endif
+    deallocate(eigenvectors,eigenvalues)
+  endif
 
 END_PROVIDER
 
diff --git a/src/determinants/EZFIO.cfg b/src/determinants/EZFIO.cfg
index 9eefa66c..662c6fbb 100644
--- a/src/determinants/EZFIO.cfg
+++ b/src/determinants/EZFIO.cfg
@@ -42,13 +42,13 @@ default: 2
 
 [weight_selection]
 type: integer
-doc: Weight used in the selection. 0: input state-average weight, 1: 1./(c_0^2), 2: PT2 matching, 3: variance matching, 4: variance and PT2 matching, 5: variance minimization and matching, 6: CI coefficients 7: input state-average multiplied by variance and PT2 matching 8: input state-average multiplied by PT2 matching 9: input state-average multiplied by variance matching
+doc: Weight used in the selection. 0: input state-average weight, 1: 1./(c_0^2), 2: rPT2 matching, 3: variance matching, 4: variance and rPT2 matching, 5: variance minimization and matching, 6: CI coefficients 7: input state-average multiplied by variance and rPT2 matching 8: input state-average multiplied by rPT2 matching 9: input state-average multiplied by variance matching
 interface: ezfio,provider,ocaml
 default: 1
 
 [threshold_generators]
 type: Threshold
-doc: Thresholds on generators (fraction of the square of the norm)
+doc: Thresholds on generators (fraction of the square of the norm) 
 interface: ezfio,provider,ocaml
 default: 0.999
 
@@ -80,7 +80,7 @@ type: integer
 [psi_coef]
 interface: ezfio
 doc: Coefficients of the wave function
-type: double precision
+type: double precision 
 size: (determinants.n_det,determinants.n_states)
 
 [psi_det]
@@ -92,7 +92,7 @@ size: (determinants.n_int*determinants.bit_kind/8,2,determinants.n_det)
 [psi_coef_qp_edit]
 interface: ezfio
 doc: Coefficients of the wave function
-type: double precision
+type: double precision 
 size: (determinants.n_det_qp_edit,determinants.n_states)
 
 [psi_det_qp_edit]
@@ -126,18 +126,13 @@ default: 1.
 
 [thresh_sym]
 type: Threshold
-doc: Thresholds to check if a determinant is connected with HF
+doc: Thresholds to check if a determinant is connected with HF 
 interface: ezfio,provider,ocaml
 default: 1.e-15
 
 [pseudo_sym]
 type: logical
-doc: If |true|, discard any Slater determinants with an interaction smaller than thresh_sym with HF.
+doc: If |true|, discard any Slater determinants with an interaction smaller than thresh_sym with HF. 
 interface: ezfio,provider,ocaml
 default: False
 
-[save_threshold]
-type: Threshold
-doc: Cut-off to apply to the CI coefficients when the wave function is stored
-interface: ezfio,provider,ocaml
-default: 1.e-14
diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f
index 1a1d92b5..7c4a7fec 100644
--- a/src/determinants/density_matrix.irp.f
+++ b/src/determinants/density_matrix.irp.f
@@ -262,86 +262,17 @@ subroutine set_natural_mos
      iorb = list_virt(i)
      do j = 1, n_core_inact_act_orb
       jorb = list_core_inact_act(j)
+      if(one_e_dm_mo(iorb,jorb).ne. 0.d0)then
+        print*,'AHAHAH'
+        print*,iorb,jorb,one_e_dm_mo(iorb,jorb)
+        stop
+      endif
      enddo
     enddo
    call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label)
    soft_touch mo_occ
+
 end
-
-
-subroutine save_natural_mos_canon_label
-   implicit none
-   BEGIN_DOC
-   ! Save natural orbitals, obtained by diagonalization of the one-body density matrix in
-   ! the |MO| basis
-   END_DOC
-   call set_natural_mos_canon_label
-   call nullify_small_elements(ao_num,mo_num,mo_coef,size(mo_coef,1),1.d-10)
-   call orthonormalize_mos
-   call save_mos
-end
-
-subroutine set_natural_mos_canon_label
-   implicit none
-   BEGIN_DOC
-   ! Set natural orbitals, obtained by diagonalization of the one-body density matrix
-   ! in the |MO| basis
-   END_DOC
-   character*(64)                 :: label
-   double precision, allocatable  :: tmp(:,:)
-
-   label = "Canonical"
-    integer :: i,j,iorb,jorb
-    do i = 1, n_virt_orb
-     iorb = list_virt(i)
-     do j = 1, n_core_inact_act_orb
-      jorb = list_core_inact_act(j)
-     enddo
-    enddo
-   call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label)
-   soft_touch mo_occ
-end
-
-
-
-
-
-subroutine set_natorb_no_ov_rot
-   implicit none
-   BEGIN_DOC
-   ! Set natural orbitals, obtained by diagonalization of the one-body density matrix
-   ! in the |MO| basis
-   END_DOC
-   character*(64)                 :: label
-   double precision, allocatable  :: tmp(:,:)
-   allocate(tmp(mo_num, mo_num))
-   label = "Natural"
-   tmp = one_e_dm_mo
-    integer :: i,j,iorb,jorb
-    do i = 1, n_virt_orb
-     iorb = list_virt(i)
-     do j = 1, n_core_inact_act_orb
-      jorb = list_core_inact_act(j)
-      tmp(iorb, jorb) = 0.d0
-      tmp(jorb, iorb) = 0.d0
-     enddo
-    enddo
-   call mo_as_svd_vectors_of_mo_matrix_eig(tmp,size(tmp,1),mo_num,mo_num,mo_occ,label)
-   soft_touch mo_occ
-end
-
-subroutine save_natural_mos_no_ov_rot
-   implicit none
-   BEGIN_DOC
-   ! Save natural orbitals, obtained by diagonalization of the one-body density matrix in
-   ! the |MO| basis
-   END_DOC
-   call set_natorb_no_ov_rot
-   call nullify_small_elements(ao_num,mo_num,mo_coef,size(mo_coef,1),1.d-10)
-   call orthonormalize_mos
-   call save_mos
-end
-
 subroutine save_natural_mos
    implicit none
    BEGIN_DOC
@@ -368,12 +299,12 @@ BEGIN_PROVIDER [ double precision, c0_weight, (N_states) ]
        c = maxval(psi_coef(:,i) * psi_coef(:,i))
        c0_weight(i) = 1.d0/(c+1.d-20)
      enddo
-     c = 1.d0/sum(c0_weight(:))
+     c = 1.d0/minval(c0_weight(:))
      do i=1,N_states
        c0_weight(i) = c0_weight(i) * c
      enddo
    else
-     c0_weight(:) = 1.d0
+     c0_weight = 1.d0
    endif
 
 END_PROVIDER
@@ -390,7 +321,7 @@ BEGIN_PROVIDER [ double precision, state_average_weight, (N_states) ]
    if (weight_one_e_dm == 0) then
      state_average_weight(:) = c0_weight(:)
    else if (weight_one_e_dm == 1) then
-     state_average_weight(:) = 1.d0/N_states
+     state_average_weight(:) = 1./N_states
    else
      call ezfio_has_determinants_state_average_weight(exists)
      if (exists) then
@@ -453,14 +384,6 @@ END_PROVIDER
 
 END_PROVIDER
 
-BEGIN_PROVIDER [ double precision, one_e_dm_ao, (ao_num, ao_num)]
- implicit none
-   BEGIN_DOC
-   !  one_e_dm_ao = one_e_dm_ao_alpha + one_e_dm_ao_beta 
-   END_DOC
-    one_e_dm_ao = one_e_dm_ao_alpha + one_e_dm_ao_beta 
-END_PROVIDER 
-
 
 subroutine get_occupation_from_dets(istate,occupation)
   implicit none
diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f
index e1c14bfe..5b12a6d9 100644
--- a/src/determinants/determinants.irp.f
+++ b/src/determinants/determinants.irp.f
@@ -77,31 +77,28 @@ BEGIN_PROVIDER [ integer, psi_det_size ]
   END_DOC
   PROVIDE ezfio_filename
   logical                        :: exists
-  psi_det_size = N_states
-  PROVIDE mpi_master
-  if (read_wf) then
-    if (mpi_master) then
-      call ezfio_has_determinants_n_det(exists)
-      if (exists) then
-        call ezfio_get_determinants_n_det(psi_det_size)
-      else
-        psi_det_size = N_states
-      endif
-      call write_int(6,psi_det_size,'Dimension of the psi arrays')
+  if (mpi_master) then
+    call ezfio_has_determinants_n_det(exists)
+    if (exists) then
+      call ezfio_get_determinants_n_det(psi_det_size)
+    else
+      psi_det_size = 1
     endif
-    IRP_IF MPI_DEBUG
-      print *,  irp_here, mpi_rank
-      call MPI_BARRIER(MPI_COMM_WORLD, ierr)
-    IRP_ENDIF
-    IRP_IF MPI
-      include 'mpif.h'
-      integer                        :: ierr
-      call MPI_BCAST( psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
-      if (ierr /= MPI_SUCCESS) then
-        stop 'Unable to read psi_det_size with MPI'
-      endif
-    IRP_ENDIF
+    call write_int(6,psi_det_size,'Dimension of the psi arrays')
   endif
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+  IRP_IF MPI
+    include 'mpif.h'
+    integer                        :: ierr
+    call MPI_BCAST( psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      stop 'Unable to read psi_det_size with MPI'
+    endif
+  IRP_ENDIF
+
 
 END_PROVIDER
 
@@ -542,7 +539,7 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
   integer                        :: i,j,k, ndet_qp_edit
 
   if (mpi_master) then
-    ndet_qp_edit = min(ndet,10000)
+    ndet_qp_edit = min(ndet,N_det_qp_edit)
 
     call ezfio_set_determinants_N_int(N_int)
     call ezfio_set_determinants_bit_kind(bit_kind)
@@ -590,6 +587,71 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
 end
 
 
+subroutine save_wavefunction_general_unormalized(ndet,nstates,psidet,dim_psicoef,psicoef)
+  implicit none
+  BEGIN_DOC
+  !  Save the wave function into the |EZFIO| file
+  END_DOC
+  use bitmasks
+  include 'constants.include.F'
+  integer, intent(in)            :: ndet,nstates,dim_psicoef
+  integer(bit_kind), intent(in)  :: psidet(N_int,2,ndet)
+  double precision, intent(in)   :: psicoef(dim_psicoef,nstates)
+  integer*8, allocatable         :: psi_det_save(:,:,:)
+  double precision, allocatable  :: psi_coef_save(:,:)
+
+  double precision               :: accu_norm
+  integer                        :: i,j,k, ndet_qp_edit
+
+  if (mpi_master) then
+    ndet_qp_edit = min(ndet,N_det_qp_edit)
+
+    call ezfio_set_determinants_N_int(N_int)
+    call ezfio_set_determinants_bit_kind(bit_kind)
+    call ezfio_set_determinants_N_det(ndet)
+    call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit)
+    call ezfio_set_determinants_n_states(nstates)
+    call ezfio_set_determinants_mo_label(mo_label)
+
+    allocate (psi_det_save(N_int,2,ndet))
+    do i=1,ndet
+      do j=1,2
+        do k=1,N_int
+          psi_det_save(k,j,i) = transfer(psidet(k,j,i),1_8)
+        enddo
+      enddo
+    enddo
+    call ezfio_set_determinants_psi_det(psi_det_save)
+    call ezfio_set_determinants_psi_det_qp_edit(psi_det_save)
+    deallocate (psi_det_save)
+
+    allocate (psi_coef_save(ndet,nstates))
+    do k=1,nstates
+      do i=1,ndet
+        psi_coef_save(i,k) = psicoef(i,k)
+      enddo
+    enddo
+
+    call ezfio_set_determinants_psi_coef(psi_coef_save)
+    deallocate (psi_coef_save)
+
+    allocate (psi_coef_save(ndet_qp_edit,nstates))
+    do k=1,nstates
+      do i=1,ndet_qp_edit
+        psi_coef_save(i,k) = psicoef(i,k)
+      enddo
+    enddo
+
+    call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save)
+    deallocate (psi_coef_save)
+
+    call write_int(6,ndet,'Saved determinants')
+  endif
+end
+
+
+
+
 
 subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,index_det_save)
   implicit none
diff --git a/src/determinants/dipole_moments.irp.f b/src/determinants/dipole_moments.irp.f
index b411dda4..8a5f1a2d 100644
--- a/src/determinants/dipole_moments.irp.f
+++ b/src/determinants/dipole_moments.irp.f
@@ -9,7 +9,7 @@
  double precision :: weight, r(3)  
  double precision :: cpu0,cpu1,nuclei_part_z,nuclei_part_y,nuclei_part_x
 
-! call cpu_time(cpu0)
+ call cpu_time(cpu0)
  z_dipole_moment = 0.d0
  y_dipole_moment = 0.d0
  x_dipole_moment = 0.d0
@@ -26,10 +26,10 @@
   enddo
  enddo
  
-! print*,'electron part for z_dipole = ',z_dipole_moment
-! print*,'electron part for y_dipole = ',y_dipole_moment
-! print*,'electron part for x_dipole = ',x_dipole_moment
-! 
+ print*,'electron part for z_dipole = ',z_dipole_moment
+ print*,'electron part for y_dipole = ',y_dipole_moment
+ print*,'electron part for x_dipole = ',x_dipole_moment
+ 
  nuclei_part_z = 0.d0
  nuclei_part_y = 0.d0
  nuclei_part_x = 0.d0
@@ -38,43 +38,28 @@
   nuclei_part_y += nucl_charge(i) * nucl_coord(i,2) 
   nuclei_part_x += nucl_charge(i) * nucl_coord(i,1) 
  enddo
-! print*,'nuclei   part for z_dipole = ',nuclei_part_z
-! print*,'nuclei   part for y_dipole = ',nuclei_part_y
-! print*,'nuclei   part for x_dipole = ',nuclei_part_x
-!
+ print*,'nuclei   part for z_dipole = ',nuclei_part_z
+ print*,'nuclei   part for y_dipole = ',nuclei_part_y
+ print*,'nuclei   part for x_dipole = ',nuclei_part_x
+
  do istate = 1, N_states
   z_dipole_moment(istate) += nuclei_part_z
   y_dipole_moment(istate) += nuclei_part_y
   x_dipole_moment(istate) += nuclei_part_x
  enddo
 
-! call cpu_time(cpu1)
-! print*,'Time to provide the dipole moment :',cpu1-cpu0
+ call cpu_time(cpu1)
+ print*,'Time to provide the dipole moment :',cpu1-cpu0
 END_PROVIDER
 
 
 
 
- subroutine print_dipole_moments
+ subroutine print_z_dipole_moment_only
  implicit none
-  integer :: i
   print*, ''
   print*, ''
   print*,  '****************************************'
-  write(*,'(A10)',advance='no') ' State :  '
-  do i = 1,N_states
-    write(*,'(i16)',advance='no') i
-  end do
-  write(*,*) ''
-  write(*,'(A23,100(1pE16.8))') 'x_dipole_moment (au) = ',x_dipole_moment
-  write(*,'(A23,100(1pE16.8))') 'y_dipole_moment (au) = ',y_dipole_moment
-  write(*,'(A23,100(1pE16.8))') 'z_dipole_moment (au) = ',z_dipole_moment
-  write(*,*) ''
-  write(*,'(A23,100(1pE16.8))') 'x_dipole_moment (D) = ',x_dipole_moment * au_to_D
-  write(*,'(A23,100(1pE16.8))') 'y_dipole_moment (D) = ',y_dipole_moment * au_to_D
-  write(*,'(A23,100(1pE16.8))') 'z_dipole_moment (D) = ',z_dipole_moment * au_to_D
-  !print*, 'x_dipole_moment                  = ',x_dipole_moment
-  !print*, 'y_dipole_moment                  = ',y_dipole_moment
-  !print*, 'z_dipole_moment                  = ',z_dipole_moment
+  print*, 'z_dipole_moment                  = ',z_dipole_moment
   print*,  '****************************************'
  end
diff --git a/src/determinants/h_apply.irp.f b/src/determinants/h_apply.irp.f
index d01ad1c7..98fafb4a 100644
--- a/src/determinants/h_apply.irp.f
+++ b/src/determinants/h_apply.irp.f
@@ -322,7 +322,10 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
     ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
   enddo
   do i=1,n_selected
-    H_apply_buffer(iproc)%det(:,:,i+H_apply_buffer(iproc)%N_det) = det_buffer(:,:,i)
+    do j=1,N_int
+      H_apply_buffer(iproc)%det(j,1,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,1,i)
+      H_apply_buffer(iproc)%det(j,2,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,2,i)
+    enddo
     ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num)
     ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num)
   enddo
diff --git a/src/determinants/s2.irp.f b/src/determinants/s2.irp.f
index 2c1a8757..d73b2dbf 100644
--- a/src/determinants/s2.irp.f
+++ b/src/determinants/s2.irp.f
@@ -103,17 +103,13 @@ BEGIN_PROVIDER [ double precision, expected_s2]
 
 END_PROVIDER
 
- BEGIN_PROVIDER [ double precision, s2_values, (N_states) ]
-&BEGIN_PROVIDER [ double precision, s_values, (N_states) ]
+BEGIN_PROVIDER [ double precision, s2_values, (N_states) ]
  implicit none
  BEGIN_DOC
 ! array of the averaged values of the S^2 operator on the various states
  END_DOC
  integer :: i
  call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size)
- do i = 1, N_states
-  s_values(i) = 0.5d0 *(-1.d0 + dsqrt(1.d0 + 4 * s2_values(i)))
- enddo
 
 END_PROVIDER
 
diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f
index 897607a9..04cf861f 100644
--- a/src/determinants/slater_rules.irp.f
+++ b/src/determinants/slater_rules.irp.f
@@ -438,7 +438,7 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint)
   use bitmasks
   implicit none
   BEGIN_DOC
-  ! Gives the indices(+1) of the bits set to 1 in the bit string
+  ! Gives the inidices(+1) of the bits set to 1 in the bit string
   ! For alpha/beta determinants.
   END_DOC
   integer, intent(in)            :: Nint
@@ -472,35 +472,6 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint)
 
 end
 
-!subroutine bitstring_to_list( string, list, n_elements, Nint)
-!  use bitmasks
-!  implicit none
-!  BEGIN_DOC
-!  ! Gives the indices(+1) of the bits set to 1 in the bit string
-!  END_DOC
-!  integer, intent(in)            :: Nint
-!  integer(bit_kind), intent(in)  :: string(Nint)
-!  integer, intent(out)           :: list(Nint*bit_kind_size)
-!  integer, intent(out)           :: n_elements
-!
-!  integer                        :: i, j, ishift
-!  integer(bit_kind)              :: l
-!
-!  n_elements = 0
-!  ishift = 1
-!  do i=1,Nint
-!    l = string(i)
-!    do while (l /= 0_bit_kind)
-!      j = trailz(l)
-!      n_elements = n_elements + 1
-!      l = ibclr(l,j)
-!      list(n_elements) = ishift+j
-!    enddo
-!    ishift = ishift + bit_kind_size
-!  enddo
-!
-!end
-
 
 subroutine i_H_j_s2(key_i,key_j,Nint,hij,s2)
   use bitmasks
@@ -623,8 +594,7 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
   integer                        :: occ(Nint*bit_kind_size,2)
   double precision               :: diag_H_mat_elem, phase
   integer                        :: n_occ_ab(2)
-  PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals 
-  PROVIDE ao_one_e_integrals mo_one_e_integrals
+  PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals
 
   ASSERT (Nint > 0)
   ASSERT (Nint == N_int)
@@ -682,6 +652,7 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
     case (1)
       call get_single_excitation(key_i,key_j,exc,phase,Nint)
       !DIR$ FORCEINLINE
+      call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
       if (exc(0,1,1) == 1) then
         ! Single alpha
         m = exc(1,1,1)
@@ -700,6 +671,10 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
   end select
 end
 
+
+
+
+
 subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble,phase)
   use bitmasks
   implicit none
@@ -1034,6 +1009,7 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
 
 end
 
+
 subroutine i_H_psi_minilist(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
   use bitmasks
   implicit none
diff --git a/src/determinants/slater_rules_wee_mono.irp.f b/src/determinants/slater_rules_wee_mono.irp.f
index 7c2ad148..4c1c9330 100644
--- a/src/determinants/slater_rules_wee_mono.irp.f
+++ b/src/determinants/slater_rules_wee_mono.irp.f
@@ -282,7 +282,9 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij)
   double precision               :: get_two_e_integral
   integer                        :: m,n,p,q
   integer                        :: i,j,k
+  integer                        :: occ(Nint*bit_kind_size,2)
   double precision               :: diag_H_mat_elem, phase,phase_2
+  integer                        :: n_occ_ab(2)
   PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals ref_bitmask_two_e_energy
 
   ASSERT (Nint > 0)
@@ -340,6 +342,7 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij)
     case (1)
       call get_single_excitation(key_i,key_j,exc,phase,Nint)
       !DIR$ FORCEINLINE
+      call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
       if (exc(0,1,1) == 1) then
         ! Mono alpha
         m = exc(1,1,1)
diff --git a/src/determinants/spindeterminants.ezfio_config b/src/determinants/spindeterminants.ezfio_config
index 39ccb82b..dd4c9b0c 100644
--- a/src/determinants/spindeterminants.ezfio_config
+++ b/src/determinants/spindeterminants.ezfio_config
@@ -11,6 +11,8 @@ spindeterminants
   psi_coef_matrix_columns integer (spindeterminants_n_det)
   psi_coef_matrix_values  double precision (spindeterminants_n_det,spindeterminants_n_states)
   n_svd_coefs     integer
+  n_svd_alpha     integer
+  n_svd_beta      integer
   psi_svd_alpha   double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states)
   psi_svd_beta    double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states)
   psi_svd_coefs   double precision (spindeterminants_n_svd_coefs,spindeterminants_n_states)
diff --git a/src/determinants/spindeterminants.irp.f b/src/determinants/spindeterminants.irp.f
index dd55e112..dea4a566 100644
--- a/src/determinants/spindeterminants.irp.f
+++ b/src/determinants/spindeterminants.irp.f
@@ -585,7 +585,7 @@ END_PROVIDER
   enddo
   !$OMP ENDDO
   !$OMP END PARALLEL
-  call i8sort(to_sort, psi_bilinear_matrix_transp_order, N_det)
+  call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1)
   call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det)
   call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det)
   !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l)
diff --git a/src/determinants/utils.irp.f b/src/determinants/utils.irp.f
index 7b75d985..957e74d5 100644
--- a/src/determinants/utils.irp.f
+++ b/src/determinants/utils.irp.f
@@ -6,10 +6,9 @@ BEGIN_PROVIDER [ double precision, H_matrix_all_dets,(N_det,N_det) ]
  END_DOC
  integer :: i,j,k
  double precision :: hij
- integer :: degree(N_det),idx(0:N_det)
  call  i_H_j(psi_det(1,1,1),psi_det(1,1,1),N_int,hij)
  print*,'Providing the H_matrix_all_dets ...'
- !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,j,hij,degree,idx,k) &
+ !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,j,hij,k) &
  !$OMP SHARED (N_det, psi_det, N_int,H_matrix_all_dets)
  do i =1,N_det
    do j = i, N_det
@@ -30,15 +29,16 @@ BEGIN_PROVIDER [ double precision, H_matrix_diag_all_dets,(N_det) ]
  END_DOC
  integer :: i
  double precision :: hij
- integer :: degree(N_det)
+
  call  i_H_j(psi_det(1,1,1),psi_det(1,1,1),N_int,hij)
- !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,hij,degree) &
+ !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,hij) &
  !$OMP SHARED (N_det, psi_det, N_int,H_matrix_diag_all_dets)
  do i =1,N_det
    call  i_H_j(psi_det(1,1,i),psi_det(1,1,i),N_int,hij)
    H_matrix_diag_all_dets(i) = hij
  enddo
  !$OMP END PARALLEL DO
+
 END_PROVIDER
 
 
@@ -50,9 +50,8 @@ BEGIN_PROVIDER [ double precision, S2_matrix_all_dets,(N_det,N_det) ]
  END_DOC
  integer :: i,j,k
  double precision :: sij
- integer :: degree(N_det),idx(0:N_det)
  call get_s2(psi_det(1,1,1),psi_det(1,1,1),N_int,sij)
- !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,j,sij,degree,idx,k) &
+ !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,j,sij,k) &
  !$OMP SHARED (N_det, psi_det, N_int,S2_matrix_all_dets)
  do i =1,N_det
    do j = i, N_det
@@ -63,4 +62,3 @@ BEGIN_PROVIDER [ double precision, S2_matrix_all_dets,(N_det,N_det) ]
  enddo
  !$OMP END PARALLEL DO
 END_PROVIDER
-
diff --git a/src/dft_one_e/NEED b/src/dft_one_e/NEED
index 615ee97e..3a942f28 100644
--- a/src/dft_one_e/NEED
+++ b/src/dft_one_e/NEED
@@ -6,4 +6,3 @@ ao_one_e_ints
 ao_two_e_ints
 mo_two_e_erf_ints
 ao_two_e_erf_ints
-mu_of_r
diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f
index 0b870564..53effcb6 100644
--- a/src/dft_one_e/mu_erf_dft.irp.f
+++ b/src/dft_one_e/mu_erf_dft.irp.f
@@ -8,73 +8,3 @@ BEGIN_PROVIDER [double precision, mu_erf_dft]
  mu_erf_dft = mu_erf
 
 END_PROVIDER
-
-BEGIN_PROVIDER [double precision, mu_of_r_dft, (n_points_final_grid)]
- implicit none
- integer :: i
- if(mu_dft_type == "Read")then
-   call ezfio_get_mu_of_r_mu_of_r_disk(mu_of_r_dft)
- else
-  do i = 1, n_points_final_grid
-   if(mu_dft_type == "cst")then
-    mu_of_r_dft(i) = mu_erf_dft
-   else if(mu_dft_type == "hf")then
-    mu_of_r_dft(i) = mu_of_r_hf(i)
-   else if(mu_dft_type == "rsc")then
-    mu_of_r_dft(i) = mu_rsc_of_r(i)
-   else if(mu_dft_type == "grad_rho")then
-    mu_of_r_dft(i) = mu_grad_rho(i)
-   else 
-    print*,'mu_dft_type is not of good type = ',mu_dft_type
-    print*,'it must be of type Read, cst, hf, rsc'
-    print*,'Stopping ...'
-    stop
-   endif
-  enddo
- endif
-END_PROVIDER 
-
-BEGIN_PROVIDER [double precision, mu_rsc_of_r, (n_points_final_grid)]
- implicit none
- integer :: i
- double precision :: mu_rs_c,rho,r(3), dm_a, dm_b
- do i = 1, n_points_final_grid
-  r(1) = final_grid_points(1,i)
-  r(2) = final_grid_points(2,i)
-  r(3) = final_grid_points(3,i)
-  call dm_dft_alpha_beta_at_r(r,dm_a,dm_b)
-  rho = dm_a + dm_b
-  mu_rsc_of_r(i) = mu_rs_c(rho)
- enddo
-END_PROVIDER
-
-BEGIN_PROVIDER [double precision, mu_grad_rho, (n_points_final_grid)]
- implicit none
- integer :: i
- double precision :: mu_grad_rho_func, r(3)
- do i = 1, n_points_final_grid
-  r(1) = final_grid_points(1,i)
-  r(2) = final_grid_points(2,i)
-  r(3) = final_grid_points(3,i)
-  mu_grad_rho(i) = mu_grad_rho_func(r)
- enddo
-END_PROVIDER 
-
-
-BEGIN_PROVIDER [double precision, mu_of_r_dft_average]
- implicit none
- integer :: i
- double precision :: mu_rs_c,rho,r(3), dm_a, dm_b
- mu_of_r_dft_average = 0.d0
- do i = 1, n_points_final_grid
-  r(1) = final_grid_points(1,i)
-  r(2) = final_grid_points(2,i)
-  r(3) = final_grid_points(3,i)
-  call dm_dft_alpha_beta_at_r(r,dm_a,dm_b)
-  rho = dm_a + dm_b
-  if(mu_of_r_dft(i).gt.1.d+3)cycle
-  mu_of_r_dft_average += rho * mu_of_r_dft(i) * final_weight_at_r_vector(i)
- enddo
- mu_of_r_dft_average = mu_of_r_dft_average / dble(elec_alpha_num + elec_beta_num)
- print*,'mu_of_r_dft_average = ',mu_of_r_dft_average
-END_PROVIDER 
diff --git a/src/dft_utils_func/mu_of_r_dft.irp.f b/src/dft_utils_func/mu_of_r_dft.irp.f
deleted file mode 100644
index 0e9a0f1b..00000000
--- a/src/dft_utils_func/mu_of_r_dft.irp.f
+++ /dev/null
@@ -1,37 +0,0 @@
-double precision function mu_rs_c(rho)
- implicit none
- double precision, intent(in) :: rho
- include 'constants.include.F'
- double precision :: cst_rs,alpha_rs,rs
- cst_rs   = (4.d0 * dacos(-1.d0)/3.d0)**(-1.d0/3.d0)
- alpha_rs = 2.d0 * dsqrt((9.d0 * dacos(-1.d0)/4.d0)**(-1.d0/3.d0)) / sqpi
-  
- rs = cst_rs * rho**(-1.d0/3.d0)
- mu_rs_c =  alpha_rs/dsqrt(rs)
-
-end
-
-double precision function mu_grad_rho_func(r)
- implicit none
- double precision , intent(in) :: r(3)
- integer :: m
- double precision :: rho, dm_a, dm_b, grad_dm_a(3), grad_dm_b(3)
- double precision :: eta, grad_rho(3), grad_sqr
-  eta = mu_erf
-  call density_and_grad_alpha_beta(r,dm_a,dm_b, grad_dm_a, grad_dm_b)  
-  rho = dm_a + dm_b
-  do m = 1,3
-   grad_rho(m) = grad_dm_a(m) + grad_dm_b(m)
-  enddo
-  grad_sqr=0.d0
-  do m = 1,3
-   grad_sqr=grad_sqr+grad_rho(m)*grad_rho(m)
-  enddo
-  grad_sqr = dsqrt(grad_sqr)
-  if (rho<1.d-12) then
-   mu_grad_rho_func = 1.d-10
-  else
-   mu_grad_rho_func = eta * grad_sqr / rho
-  endif
-  
-end
diff --git a/src/dft_utils_func/mu_rsc.irp.f b/src/dft_utils_func/mu_rsc.irp.f
new file mode 100644
index 00000000..cda444d4
--- /dev/null
+++ b/src/dft_utils_func/mu_rsc.irp.f
@@ -0,0 +1,13 @@
+double precision function mu_rs_c(rho)
+ implicit none
+ double precision, intent(in) :: rho
+ include 'constants.include.F'
+ double precision :: cst_rs,alpha_rs,rs
+ cst_rs   = (4.d0 * dacos(-1.d0)/3.d0)**(-1.d0/3.d0)
+ alpha_rs = 2.d0 * dsqrt((9.d0 * dacos(-1.d0)/4.d0)**(-1.d0/3.d0)) / sqpi
+
+ rs = cst_rs * rho**(-1.d0/3.d0)
+ mu_rs_c =  alpha_rs/dsqrt(rs)
+
+end
+
diff --git a/src/dft_utils_func/on_top_from_ueg.irp.f b/src/dft_utils_func/on_top_from_ueg.irp.f
index 5b964a03..717081a7 100644
--- a/src/dft_utils_func/on_top_from_ueg.irp.f
+++ b/src/dft_utils_func/on_top_from_ueg.irp.f
@@ -37,15 +37,13 @@ double precision function g0_UEG_mu_inf(rho_a,rho_b)
   rs = (3d0 / (4d0*pi*rho))**(1d0/3d0) ! JT: serious bug fixed 20/03/19
   x = -d2*rs
   if(dabs(x).lt.50.d0)then
-!   g0_UEG_mu_inf= 0.5d0 * (1d0- B*rs + C*rs**2 + D*rs**3 + E*rs**4)*dexp(x)
-   g0_UEG_mu_inf= 0.5d0 * (1d0+ rs* (-B + rs*(C + rs*(D + rs*E))))*dexp(x)
+   g0_UEG_mu_inf= 0.5d0 * (1d0- B*rs + C*rs**2 + D*rs**3 + E*rs**4)*dexp(x)
   else
    g0_UEG_mu_inf= 0.d0
   endif
  else
   g0_UEG_mu_inf= 0.d0
  endif
- g0_UEG_mu_inf = max(g0_UEG_mu_inf,1.d-14)
 
 end
 
diff --git a/src/dft_utils_in_r/ao_in_r.irp.f b/src/dft_utils_in_r/ao_in_r.irp.f
index 38478d21..6fa6a4c7 100644
--- a/src/dft_utils_in_r/ao_in_r.irp.f
+++ b/src/dft_utils_in_r/ao_in_r.irp.f
@@ -91,19 +91,7 @@
  enddo
  END_PROVIDER
 
- BEGIN_PROVIDER [double precision, aos_lapl_in_r_array_transp, (ao_num, n_points_final_grid,3)]
- implicit none
- integer :: i,j,m
- do i = 1, n_points_final_grid
-  do j = 1, ao_num
-   do m = 1, 3
-    aos_lapl_in_r_array_transp(j,i,m) =  aos_lapl_in_r_array(m,j,i)
-   enddo
-  enddo
- enddo
- END_PROVIDER 
-
- BEGIN_PROVIDER [double precision, aos_lapl_in_r_array, (3,ao_num,n_points_final_grid)]
+ BEGIN_PROVIDER[double precision, aos_lapl_in_r_array, (ao_num,n_points_final_grid,3)]
  implicit none
  BEGIN_DOC
  ! aos_lapl_in_r_array(i,j,k)   = value of the kth component of the laplacian of jth ao on the ith grid point
@@ -112,20 +100,20 @@
  END_DOC
  integer :: i,j,m
  double precision :: aos_array(ao_num), r(3)
- double precision :: aos_grad_array(3,ao_num)
- double precision :: aos_lapl_array(3,ao_num)
+ double precision :: aos_grad_array(ao_num,3)
+ double precision :: aos_lapl_array(ao_num,3)
  !$OMP PARALLEL DO &
  !$OMP DEFAULT (NONE)  &
  !$OMP PRIVATE (i,r,aos_array,aos_grad_array,aos_lapl_array,j,m) & 
  !$OMP SHARED(aos_lapl_in_r_array,n_points_final_grid,ao_num,final_grid_points)
- do i = 1, n_points_final_grid
-  r(1) = final_grid_points(1,i)
-  r(2) = final_grid_points(2,i)
-  r(3) = final_grid_points(3,i)
-  call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array)
-  do j = 1, ao_num
-   do m = 1, 3
-    aos_lapl_in_r_array(m,j,i) = aos_lapl_array(m,j)
+ do m = 1, 3
+  do i = 1, n_points_final_grid
+   r(1) = final_grid_points(1,i)
+   r(2) = final_grid_points(2,i)
+   r(3) = final_grid_points(3,i)
+   call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array)
+   do j = 1, ao_num
+    aos_lapl_in_r_array(j,i,m) = aos_lapl_array(j,m)
    enddo
   enddo
  enddo
diff --git a/src/dft_utils_in_r/ints_grad.irp.f b/src/dft_utils_in_r/ints_grad.irp.f
deleted file mode 100644
index 239fe554..00000000
--- a/src/dft_utils_in_r/ints_grad.irp.f
+++ /dev/null
@@ -1,39 +0,0 @@
- BEGIN_PROVIDER [ double precision, mo_grad_ints, (mo_num, mo_num,3)]
- implicit none
- BEGIN_DOC
-! mo_grad_ints(i,j,m) = <phi_i^MO | d/dx | phi_j^MO>
- END_DOC
- integer :: i,j,ipoint,m
- double precision :: weight
- mo_grad_ints = 0.d0
- do m = 1, 3
-  do ipoint = 1, n_points_final_grid
-   weight = final_weight_at_r_vector(ipoint)
-   do j = 1, mo_num
-    do i = 1, mo_num
-     mo_grad_ints(i,j,m) += mos_grad_in_r_array(j,ipoint,m) * mos_in_r_array(i,ipoint) * weight
-    enddo
-   enddo
-  enddo
- enddo
-
-
-END_PROVIDER 
-
- BEGIN_PROVIDER [ double precision, mo_grad_ints_transp, (3,mo_num, mo_num)]
- implicit none
- BEGIN_DOC
-! mo_grad_ints(i,j,m) = <phi_i^MO | d/dx | phi_j^MO>
- END_DOC
- integer :: i,j,ipoint,m
- double precision :: weight
- do m = 1, 3
-  do j = 1, mo_num
-   do i = 1, mo_num
-    mo_grad_ints_transp(m,i,j) = mo_grad_ints(i,j,m)
-   enddo
-  enddo
- enddo
-
-
-END_PROVIDER 
diff --git a/src/dft_utils_in_r/mo_in_r.irp.f b/src/dft_utils_in_r/mo_in_r.irp.f
index 192cb25a..0a8b4d52 100644
--- a/src/dft_utils_in_r/mo_in_r.irp.f
+++ b/src/dft_utils_in_r/mo_in_r.irp.f
@@ -138,7 +138,7 @@
  integer :: m
  mos_lapl_in_r_array = 0.d0
  do m=1,3
-  call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_lapl_in_r_array_transp(1,1,m),ao_num,0.d0,mos_lapl_in_r_array(1,1,m),mo_num)
+  call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_lapl_in_r_array(1,1,m),ao_num,0.d0,mos_lapl_in_r_array(1,1,m),mo_num)
  enddo
  END_PROVIDER
 
diff --git a/src/dressing/alpha_factory.irp.f b/src/dressing/alpha_factory.irp.f
index c7adffe3..5eeeb1a6 100644
--- a/src/dressing/alpha_factory.irp.f
+++ b/src/dressing/alpha_factory.irp.f
@@ -1179,7 +1179,7 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint)
   use bitmasks
   implicit none
   BEGIN_DOC
-  ! Gives the indices(+1) of the bits set to 1 in the bit string
+  ! Gives the inidices(+1) of the bits set to 1 in the bit string
   END_DOC
   integer, intent(in)            :: Nint
   integer(bit_kind), intent(in)  :: string(Nint)
diff --git a/src/dressing/run_dress_slave.irp.f b/src/dressing/run_dress_slave.irp.f
index 08b654c9..a33fb1dd 100644
--- a/src/dressing/run_dress_slave.irp.f
+++ b/src/dressing/run_dress_slave.irp.f
@@ -72,7 +72,7 @@ subroutine run_dress_slave(thread,iproce,energy)
   provide psi_energy
   ending = dress_N_cp+1
   ntask_tbd = 0
-  call set_multiple_levels_omp(.True.)
+  call omp_set_max_active_levels(8)
 
   !$OMP PARALLEL DEFAULT(SHARED) &
   !$OMP PRIVATE(interesting, breve_delta_m, task_id) &
@@ -84,7 +84,7 @@ subroutine run_dress_slave(thread,iproce,energy)
   zmq_socket_push      = new_zmq_push_socket(thread)
   integer, external :: connect_to_taskserver
   !$OMP CRITICAL
-  call set_multiple_levels_omp(.False.)
+  call omp_set_max_active_levels(1)
   if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
     print *,  irp_here, ': Unable to connect to task server'
     stop -1
@@ -296,7 +296,7 @@ subroutine run_dress_slave(thread,iproce,energy)
   !$OMP END CRITICAL
 
   !$OMP END PARALLEL
-  call set_multiple_levels_omp(.False.)
+  call omp_set_max_active_levels(1)
 !  do i=0,dress_N_cp+1
 !    call omp_destroy_lock(lck_sto(i))
 !  end do
diff --git a/src/ezfio_files/output.irp.f b/src/ezfio_files/output.irp.f
index 7b2663a0..48512f92 100644
--- a/src/ezfio_files/output.irp.f
+++ b/src/ezfio_files/output.irp.f
@@ -25,7 +25,7 @@ subroutine write_time(iunit)
   ct = ct - output_cpu_time_0
   call wall_time(wt)
   wt = wt - output_wall_time_0
-  write(6,'(A,F14.2,A,F14.2,A)') &
+  write(6,'(A,F14.6,A,F14.6,A)') &
     '.. >>>>> [ WALL TIME: ', wt, '  s ] [ CPU  TIME: ', ct, '  s ] <<<<< ..'
   write(6,*)
 end
diff --git a/src/functionals/sr_lda.irp.f b/src/functionals/sr_lda.irp.f
index bd062a02..965a744c 100644
--- a/src/functionals/sr_lda.irp.f
+++ b/src/functionals/sr_lda.irp.f
@@ -21,9 +21,7 @@
    weight = final_weight_at_r_vector(i)
    rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate)
    rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate)
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
-   call ex_lda_sr(mu_local,rhoa(istate),rhob(istate),e_x,vx_a,vx_b)
+   call ex_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_x,vx_a,vx_b)
    energy_x_sr_lda(istate) += weight * e_x
   enddo
  enddo
@@ -50,9 +48,7 @@
    weight = final_weight_at_r_vector(i)
    rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate)
    rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate)
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
-   call ec_lda_sr(mu_local,rhoa(istate),rhob(istate),e_c,vc_a,vc_b)
+   call ec_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_c,vc_a,vc_b)
    energy_c_sr_lda(istate) += weight * e_c
   enddo
  enddo
@@ -126,10 +122,8 @@ END_PROVIDER
    weight = final_weight_at_r_vector(i)
    rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate)
    rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate)
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
-   call ec_lda_sr(mu_local,rhoa(istate),rhob(istate),e_c,sr_vc_a,sr_vc_b)
-   call ex_lda_sr(mu_local,rhoa(istate),rhob(istate),e_x,sr_vx_a,sr_vx_b)
+   call ec_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_c,sr_vc_a,sr_vc_b)
+   call ex_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_x,sr_vx_a,sr_vx_b)
    do j =1, ao_num
     aos_sr_vc_alpha_lda_w(j,i,istate) = sr_vc_a * aos_in_r_array(j,i)*weight
     aos_sr_vc_beta_lda_w(j,i,istate)  = sr_vc_b * aos_in_r_array(j,i)*weight
@@ -153,6 +147,8 @@ END_PROVIDER
  double precision :: mu,weight
  double precision :: e_c,sr_vc_a,sr_vc_b,e_x,sr_vx_a,sr_vx_b
  double precision, allocatable :: rhoa(:),rhob(:)
+ double precision :: mu_local
+ mu_local = mu_erf_dft
  allocate(rhoa(N_states), rhob(N_states))
  do istate = 1, N_states
   do i = 1, n_points_final_grid
@@ -162,8 +158,6 @@ END_PROVIDER
    weight = final_weight_at_r_vector(i)
    rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate)
    rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate)
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
    call ec_lda_sr(mu_local,rhoa(istate),rhob(istate),e_c,sr_vc_a,sr_vc_b)
    call ex_lda_sr(mu_local,rhoa(istate),rhob(istate),e_x,sr_vx_a,sr_vx_b)
    do j =1, ao_num
diff --git a/src/functionals/sr_pbe.irp.f b/src/functionals/sr_pbe.irp.f
index 7053cfb6..93c51067 100644
--- a/src/functionals/sr_pbe.irp.f
+++ b/src/functionals/sr_pbe.irp.f
@@ -35,11 +35,9 @@
     grad_rho_b_2 += grad_rho_b(m) * grad_rho_b(m)
     grad_rho_a_b += grad_rho_a(m) * grad_rho_b(m)
    enddo
-   
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
+
                              ! inputs
-   call GGA_sr_type_functionals(mu_local,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,                 &  ! outputs exchange
+   call GGA_sr_type_functionals(mu_erf_dft,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,                 &  ! outputs exchange
                              ex,vx_rho_a,vx_rho_b,vx_grad_rho_a_2,vx_grad_rho_b_2,vx_grad_rho_a_b, &  ! outputs correlation
                              ec,vc_rho_a,vc_rho_b,vc_grad_rho_a_2,vc_grad_rho_b_2,vc_grad_rho_a_b  )
    energy_x_sr_pbe(istate) += ex * weight
@@ -137,10 +135,8 @@ END_PROVIDER
     grad_rho_a_b += grad_rho_a(m) * grad_rho_b(m)
    enddo
 
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
                              ! inputs
-   call GGA_sr_type_functionals(mu_local,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,                 &  ! outputs exchange
+   call GGA_sr_type_functionals(mu_erf_dft,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,                 &  ! outputs exchange
                              ex,vx_rho_a,vx_rho_b,vx_grad_rho_a_2,vx_grad_rho_b_2,vx_grad_rho_a_b, &  ! outputs correlation
                              ec,vc_rho_a,vc_rho_b,vc_grad_rho_a_2,vc_grad_rho_b_2,vc_grad_rho_a_b  )
    vx_rho_a *= weight
@@ -296,10 +292,8 @@ END_PROVIDER
     grad_rho_a_b += grad_rho_a(m) * grad_rho_b(m)
    enddo
 
-   double precision :: mu_local
-   mu_local = mu_of_r_dft(i)
                              ! inputs
-   call GGA_sr_type_functionals(mu_local,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,                 &  ! outputs exchange
+   call GGA_sr_type_functionals(mu_erf_dft,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b,                 &  ! outputs exchange
                              ex,vx_rho_a,vx_rho_b,vx_grad_rho_a_2,vx_grad_rho_b_2,vx_grad_rho_a_b, &  ! outputs correlation
                              ec,vc_rho_a,vc_rho_b,vc_grad_rho_a_2,vc_grad_rho_b_2,vc_grad_rho_a_b  )
    vx_rho_a *= weight
diff --git a/src/iterations/print_extrapolation.irp.f b/src/iterations/print_extrapolation.irp.f
index 7c6dbb9b..cb46fb67 100644
--- a/src/iterations/print_extrapolation.irp.f
+++ b/src/iterations/print_extrapolation.irp.f
@@ -35,13 +35,12 @@ subroutine print_extrapolated_energy
     do k=2,min(N_iter,8)
       write(*,'(F11.4,X,3(X,F18.8))') pt2_iterations(i,N_iter+1-k), extrapolated_energy(k,i), &
           extrapolated_energy(k,i) - extrapolated_energy(k,1), &
-          (extrapolated_energy(k,i) - extrapolated_energy(k,1) ) * ha_to_ev
+          (extrapolated_energy(k,i) - extrapolated_energy(k,1) ) * 27.211396641308d0
     enddo
     write(*,*)  '=========== ', '=================== ', '=================== ', '==================='
   enddo
 
   print *,  ''
-  call ezfio_set_fci_energy_extrapolated(extrapolated_energy(min(N_iter,3),1:N_states))
 
 end subroutine
 
diff --git a/src/iterations/print_summary.irp.f b/src/iterations/print_summary.irp.f
index a0db3534..641ee209 100644
--- a/src/iterations/print_summary.irp.f
+++ b/src/iterations/print_summary.irp.f
@@ -36,7 +36,7 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_configuration_,n_st,s
   write(*,fmt) '# E          ', e_(1:N_states_p)
   if (N_states_p > 1) then
     write(*,fmt) '# Excit. (au)', e_(1:N_states_p)-e_(1)
-    write(*,fmt) '# Excit. (eV)', (e_(1:N_states_p)-e_(1))*ha_to_ev
+    write(*,fmt) '# Excit. (eV)', (e_(1:N_states_p)-e_(1))*27.211396641308d0
   endif
   write(fmt,*) '(A13,', 2*N_states_p, '(1X,F14.8))'
   write(*,fmt) '# PT2 '//pt2_string, (pt2_data % pt2(k), pt2_data_err % pt2(k), k=1,N_states_p)
@@ -47,8 +47,8 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_configuration_,n_st,s
   if (N_states_p > 1) then
     write(*,fmt) '# Excit. (au)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1)), &
       dsqrt(pt2_data_err % pt2(k)*pt2_data_err % pt2(k)+pt2_data_err % pt2(1)*pt2_data_err % pt2(1)), k=1,N_states_p)
-    write(*,fmt) '# Excit. (eV)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1))*ha_to_ev, &
-      dsqrt(pt2_data_err % pt2(k)*pt2_data_err % pt2(k)+pt2_data_err % pt2(1)*pt2_data_err % pt2(1))*ha_to_ev, k=1,N_states_p)
+    write(*,fmt) '# Excit. (eV)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1))*27.211396641308d0, &
+      dsqrt(pt2_data_err % pt2(k)*pt2_data_err % pt2(k)+pt2_data_err % pt2(1)*pt2_data_err % pt2(1))*27.211396641308d0, k=1,N_states_p)
   endif
   write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))'
   write(*,fmt)
@@ -82,23 +82,23 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_configuration_,n_st,s
     print *, 'Variational Energy difference (au | eV)'
     do i=2, N_states_p
       print*,'Delta E = ', (e_(i) - e_(1)), &
-        (e_(i) - e_(1)) * ha_to_ev
+        (e_(i) - e_(1)) * 27.211396641308d0
     enddo
     print *,  '-----'
     print*, 'Variational + perturbative Energy difference (au | eV)'
     do i=2, N_states_p
       print*,'Delta E = ', (e_(i)+ pt2_data % pt2(i) - (e_(1) + pt2_data % pt2(1))), &
-        (e_(i)+ pt2_data % pt2(i) - (e_(1) + pt2_data % pt2(1))) * ha_to_ev
+        (e_(i)+ pt2_data % pt2(i) - (e_(1) + pt2_data % pt2(1))) * 27.211396641308d0
     enddo
     print *,  '-----'
     print*, 'Variational + renormalized perturbative Energy difference (au | eV)'
     do i=2, N_states_p
       print*,'Delta E = ', (e_(i)+ pt2_data % rpt2(i) - (e_(1) + pt2_data % rpt2(1))), &
-        (e_(i)+ pt2_data % rpt2(i) - (e_(1) + pt2_data % rpt2(1))) * ha_to_ev
+        (e_(i)+ pt2_data % rpt2(i) - (e_(1) + pt2_data % rpt2(1))) * 27.211396641308d0
     enddo
   endif
 
-!  call print_energy_components()
+  call print_energy_components()
 
 end subroutine
 
diff --git a/src/kohn_sham_rs/rs_ks_scf.irp.f b/src/kohn_sham_rs/rs_ks_scf.irp.f
index 84b85136..5d23544e 100644
--- a/src/kohn_sham_rs/rs_ks_scf.irp.f
+++ b/src/kohn_sham_rs/rs_ks_scf.irp.f
@@ -17,7 +17,7 @@ program rs_ks_scf
   print*, '**************************'
   print*, 'mu_erf_dft = ',mu_erf_dft
   print*, '**************************'
-! call check_coherence_functional
+  call check_coherence_functional
   call create_guess
   call orthonormalize_mos
   call run
diff --git a/src/mo_basis/mos_in_r.irp.f b/src/mo_basis/mos_in_r.irp.f
index e5d3b243..ee2795d0 100644
--- a/src/mo_basis/mos_in_r.irp.f
+++ b/src/mo_basis/mos_in_r.irp.f
@@ -1,9 +1,6 @@
 
 subroutine give_all_mos_at_r(r,mos_array)
  implicit none
- BEGIN_DOC
-! mos_array(i) = ith MO function evaluated at "r"
- END_DOC
  double precision, intent(in) :: r(3)
  double precision, intent(out) :: mos_array(mo_num)
  double precision :: aos_array(ao_num)
diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f
index fcbdde49..cbf23a9a 100644
--- a/src/mo_guess/h_core_guess_routine.irp.f
+++ b/src/mo_guess/h_core_guess_routine.irp.f
@@ -7,7 +7,7 @@ subroutine hcore_guess
   label = 'Guess'
   call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals,          &
                                      size(mo_one_e_integrals,1),  &
-                                     size(mo_one_e_integrals,2),label,1,.true.)
+                                     size(mo_one_e_integrals,2),label,1,.false.)
   call nullify_small_elements(ao_num, mo_num, mo_coef, size(mo_coef,1), 1.d-12 )
   call save_mos
   TOUCH mo_coef mo_label
diff --git a/src/mo_two_e_erf_ints/map_integrals_erf.irp.f b/src/mo_two_e_erf_ints/map_integrals_erf.irp.f
index 3405ec2b..73050ec5 100644
--- a/src/mo_two_e_erf_ints/map_integrals_erf.irp.f
+++ b/src/mo_two_e_erf_ints/map_integrals_erf.irp.f
@@ -235,11 +235,11 @@ subroutine get_mo_two_e_integrals_erf_ij(k,l,sze,out_array,map)
 
   logical :: integral_is_in_map
   if (key_kind == 8) then
-    call i8sort(hash,iorder,kk)
+    call i8radix_sort(hash,iorder,kk,-1)
   else if (key_kind == 4) then
-    call isort(hash,iorder,kk)
+    call iradix_sort(hash,iorder,kk,-1)
   else if (key_kind == 2) then
-    call i2sort(hash,iorder,kk)
+    call i2radix_sort(hash,iorder,kk,-1)
   endif
 
   call map_get_many(mo_integrals_erf_map, hash, tmp_val, kk)
@@ -290,11 +290,11 @@ subroutine get_mo_two_e_integrals_erf_i1j1(k,l,sze,out_array,map)
 
   logical :: integral_is_in_map
   if (key_kind == 8) then
-    call i8sort(hash,iorder,kk)
+    call i8radix_sort(hash,iorder,kk,-1)
   else if (key_kind == 4) then
-    call isort(hash,iorder,kk)
+    call iradix_sort(hash,iorder,kk,-1)
   else if (key_kind == 2) then
-    call i2sort(hash,iorder,kk)
+    call i2radix_sort(hash,iorder,kk,-1)
   endif
 
   call map_get_many(mo_integrals_erf_map, hash, tmp_val, kk)
diff --git a/src/mo_two_e_ints/core_quantities.irp.f b/src/mo_two_e_ints/core_quantities.irp.f
index b764a1a6..3642365e 100644
--- a/src/mo_two_e_ints/core_quantities.irp.f
+++ b/src/mo_two_e_ints/core_quantities.irp.f
@@ -53,7 +53,7 @@ BEGIN_PROVIDER [ double precision, h_core_ri, (mo_num, mo_num) ]
    enddo
    do k=1,mo_num
      do i=1,mo_num
-       h_core_ri(i,j) = h_core_ri(i,j) - 0.5 * big_array_exchange_integrals(k,i,j)
+       h_core_ri(i,j) = h_core_ri(i,j) - 0.5d0 * big_array_exchange_integrals(k,i,j)
      enddo
    enddo
  enddo
diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f
index 272916e3..9f73d518 100644
--- a/src/mo_two_e_ints/map_integrals.irp.f
+++ b/src/mo_two_e_ints/map_integrals.irp.f
@@ -302,21 +302,21 @@ end
  integer(key_kind)              :: idx
  double precision :: tmp
 
-!icount = 1 ! Avoid division by zero
-!do j=1,mo_num
-!  do i=1,j-1
-!   call two_e_integrals_index(i,j,j,i,idx)
-!   !DIR$ FORCEINLINE
-!   call map_get(mo_integrals_map,idx,tmp)
-!   banned_excitation(i,j) = dabs(tmp) < 1.d-14
-!   banned_excitation(j,i) = banned_excitation(i,j)
-!   if (banned_excitation(i,j)) icount = icount+2
-! enddo
-!enddo
-!use_banned_excitation =  (mo_num*mo_num) / icount <= 100  !1%
-!if (use_banned_excitation) then
-!  print *, 'Using sparsity of exchange integrals'
-!endif
+ icount = 1 ! Avoid division by zero
+ do j=1,mo_num
+   do i=1,j-1
+    call two_e_integrals_index(i,j,j,i,idx)
+    !DIR$ FORCEINLINE
+    call map_get(mo_integrals_map,idx,tmp)
+    banned_excitation(i,j) = dabs(tmp) < 1.d-14
+    banned_excitation(j,i) = banned_excitation(i,j)
+    if (banned_excitation(i,j)) icount = icount+2
+  enddo
+ enddo
+ use_banned_excitation =  (mo_num*mo_num) / icount <= 100  !1%
+ if (use_banned_excitation) then
+   print *, 'Using sparsity of exchange integrals'
+ endif
 
 END_PROVIDER
 
diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f
index 6f4c5c17..d58932ce 100644
--- a/src/mo_two_e_ints/mo_bi_integrals.irp.f
+++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f
@@ -53,11 +53,7 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ]
 !    call four_idx_novvvv
     call four_idx_novvvv_old
   else
-    if (32.d-9*dble(ao_num)**4 < dble(qp_max_mem)) then
-      call four_idx_dgemm
-    else
-      call add_integrals_to_map(full_ijkl_bitmask_4)
-    endif
+    call add_integrals_to_map(full_ijkl_bitmask_4)
   endif
 
   call wall_time(wall_2)
@@ -81,94 +77,6 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ]
 
 END_PROVIDER
 
-subroutine four_idx_dgemm
-  implicit none
-  integer :: p,q,r,s,i,j,k,l
-  double precision, allocatable :: a1(:,:,:,:)
-  double precision, allocatable :: a2(:,:,:,:)
-
-  allocate (a1(ao_num,ao_num,ao_num,ao_num))
-
-  print *, 'Getting AOs'
-  !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(q,r,s)
-  do s=1,ao_num
-    do r=1,ao_num
-      do q=1,ao_num
-        call get_ao_two_e_integrals(q,r,s,ao_num,a1(1,q,r,s))
-      enddo
-    enddo
-  enddo
-  !$OMP END PARALLEL DO
-
-  print *, '1st transformation'
-  ! 1st transformation
-  allocate (a2(ao_num,ao_num,ao_num,mo_num))
-  call dgemm('T','N', (ao_num*ao_num*ao_num), mo_num, ao_num, 1.d0, a1, ao_num, mo_coef, ao_num, 0.d0, a2, (ao_num*ao_num*ao_num))
-
-  ! 2nd transformation
-  print *, '2nd transformation'
-  deallocate (a1)
-  allocate (a1(ao_num,ao_num,mo_num,mo_num))
-  call dgemm('T','N', (ao_num*ao_num*mo_num), mo_num, ao_num, 1.d0, a2, ao_num, mo_coef, ao_num, 0.d0, a1, (ao_num*ao_num*mo_num))
-
-  ! 3rd transformation
-  print *, '3rd transformation'
-  deallocate (a2)
-  allocate (a2(ao_num,mo_num,mo_num,mo_num))
-  call dgemm('T','N', (ao_num*mo_num*mo_num), mo_num, ao_num, 1.d0, a1, ao_num, mo_coef, ao_num, 0.d0, a2, (ao_num*mo_num*mo_num))
-
-  ! 4th transformation
-  print *, '4th transformation'
-  deallocate (a1)
-  allocate (a1(mo_num,mo_num,mo_num,mo_num))
-  call dgemm('T','N', (mo_num*mo_num*mo_num), mo_num, ao_num, 1.d0, a2, ao_num, mo_coef, ao_num, 0.d0, a1, (mo_num*mo_num*mo_num))
-
-  deallocate (a2)
-
-  integer :: n_integrals, size_buffer
-  integer(key_kind)  , allocatable :: buffer_i(:)
-  real(integral_kind), allocatable :: buffer_value(:)
-  size_buffer = min(ao_num*ao_num*ao_num,16000000)
-
-  !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,buffer_value,buffer_i,n_integrals)
-  allocate ( buffer_i(size_buffer), buffer_value(size_buffer) )
-
-  n_integrals = 0
-  !$OMP DO
-  do l=1,mo_num
-    do k=1,mo_num
-      do j=1,l
-        do i=1,k
-            if (abs(a1(i,j,k,l)) < mo_integrals_threshold) then
-              cycle
-            endif
-            n_integrals += 1
-            buffer_value(n_integrals) = a1(i,j,k,l)
-            !DIR$ FORCEINLINE
-            call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals))
-            if (n_integrals == size_buffer) then
-              call map_append(mo_integrals_map, buffer_i, buffer_value, n_integrals)
-              n_integrals = 0
-            endif
-        enddo
-      enddo
-    enddo
-  enddo
-  !$OMP END DO
-
-  call map_append(mo_integrals_map, buffer_i, buffer_value, n_integrals)
-
-  deallocate(buffer_i, buffer_value)
-  !$OMP END PARALLEL
-
-  deallocate (a1)
-
-  call map_unique(mo_integrals_map)
-
-  integer*8                      :: get_mo_map_size, mo_map_size
-  mo_map_size = get_mo_map_size()
-
-end subroutine
 
 subroutine add_integrals_to_map(mask_ijkl)
   use bitmasks
diff --git a/src/mu_of_r/basis_def.irp.f b/src/mu_of_r/basis_def.irp.f
index fff9f581..4da27cb0 100644
--- a/src/mu_of_r/basis_def.irp.f
+++ b/src/mu_of_r/basis_def.irp.f
@@ -76,11 +76,7 @@ BEGIN_PROVIDER [integer, n_basis_orb]
  !
  ! It corresponds to all MOs except those defined as "deleted" 
  END_DOC
- if(mu_of_r_potential == "pure_act")then
-  n_basis_orb = n_act_orb
- else
-  n_basis_orb = n_all_but_del_orb
- endif
+ n_basis_orb = n_all_but_del_orb
 END_PROVIDER 
 
 BEGIN_PROVIDER [integer, list_basis, (n_basis_orb)]
@@ -93,15 +89,9 @@ BEGIN_PROVIDER [integer, list_basis, (n_basis_orb)]
  ! It corresponds to all MOs except those defined as "deleted" 
  END_DOC
  integer :: i
- if(mu_of_r_potential == "pure_act")then
-  do i = 1, n_act_orb
-   list_basis(i) = list_act(i)
-  enddo
- else
-  do i = 1, n_all_but_del_orb
-    list_basis(i) = list_all_but_del_orb(i)
-  enddo
- endif
+ do i = 1, n_all_but_del_orb
+   list_basis(i) = list_all_but_del_orb(i)
+ enddo
 END_PROVIDER 
 
 BEGIN_PROVIDER [double precision, basis_mos_in_r_array, (n_basis_orb,n_points_final_grid)]
diff --git a/src/mu_of_r/mu_of_r_conditions.irp.f b/src/mu_of_r/mu_of_r_conditions.irp.f
index 5c41acdc..148c65b3 100644
--- a/src/mu_of_r/mu_of_r_conditions.irp.f
+++ b/src/mu_of_r/mu_of_r_conditions.irp.f
@@ -26,7 +26,7 @@
   do ipoint = 1, n_points_final_grid
    if(mu_of_r_potential.EQ."hf")then
     mu_of_r_prov(ipoint,istate) =  mu_of_r_hf(ipoint)
-   else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then
+   else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated")then
     mu_of_r_prov(ipoint,istate) =  mu_of_r_psi_cas(ipoint,istate)
    else 
     print*,'you requested the following mu_of_r_potential'
diff --git a/src/scf_utils/scf_density_matrix_ao.irp.f b/src/scf_utils/scf_density_matrix_ao.irp.f
index 55fa8e7c..639855b3 100644
--- a/src/scf_utils/scf_density_matrix_ao.irp.f
+++ b/src/scf_utils/scf_density_matrix_ao.irp.f
@@ -9,6 +9,17 @@ BEGIN_PROVIDER [double precision, SCF_density_matrix_ao_alpha, (ao_num,ao_num) ]
         mo_coef, size(mo_coef,1), 0.d0, &
         SCF_density_matrix_ao_alpha, size(SCF_density_matrix_ao_alpha,1))
 
+!  integer          :: i, j
+!  double precision :: trace_density
+!  trace_density = 0.d0
+!  do i = 1, ao_num !elec_alpha_num
+!    do j = 1, ao_num !elec_alpha_num
+!      trace_density = trace_density &
+!                    + SCF_density_matrix_ao_alpha(j,i) * ao_overlap(j,i)
+!    enddo
+!  enddo
+!  print *, ' trace of SCF_density_matrix_ao_alpha =', trace_density
+
 END_PROVIDER
 
 BEGIN_PROVIDER [ double precision, SCF_density_matrix_ao_beta,  (ao_num,ao_num) ]
diff --git a/src/tools/NEED b/src/tools/NEED
index 0f4e17b0..c07c9109 100644
--- a/src/tools/NEED
+++ b/src/tools/NEED
@@ -2,4 +2,3 @@ fci
 mo_two_e_erf_ints
 aux_quantities
 hartree_fock
-two_body_rdm
diff --git a/src/tools/molden.irp.f b/src/tools/molden.irp.f
index 830a141e..417b25ad 100644
--- a/src/tools/molden.irp.f
+++ b/src/tools/molden.irp.f
@@ -52,8 +52,8 @@ program molden
         l += 1
         if (l > ao_num) exit
       enddo
+      write(i_unit_output,*)''
     enddo
-    write(i_unit_output,*)''
   enddo
 
 
diff --git a/src/tools/print_dipole.irp.f b/src/tools/print_dipole.irp.f
index 8db9aa09..8351308e 100644
--- a/src/tools/print_dipole.irp.f
+++ b/src/tools/print_dipole.irp.f
@@ -1,7 +1,5 @@
 program print_dipole
  implicit none
- read_wf = .True.
- TOUCH read_wf
- call print_dipole_moments
+ call print_z_dipole_moment_only
 
 end
diff --git a/src/tools/print_wf.irp.f b/src/tools/print_wf.irp.f
index 64eb1a1f..7e51caaf 100644
--- a/src/tools/print_wf.irp.f
+++ b/src/tools/print_wf.irp.f
@@ -32,9 +32,8 @@ subroutine routine
  double precision :: norm_mono_a,norm_mono_b
  double precision :: norm_mono_a_2,norm_mono_b_2
  double precision :: norm_mono_a_pert_2,norm_mono_b_pert_2
- double precision :: norm_mono_a_pert,norm_mono_b_pert,norm_double_1
+ double precision :: norm_mono_a_pert,norm_mono_b_pert
  double precision :: delta_e,coef_2_2
-
  norm_mono_a = 0.d0
  norm_mono_b = 0.d0
  norm_mono_a_2 = 0.d0
@@ -43,7 +42,6 @@ subroutine routine
  norm_mono_b_pert = 0.d0
  norm_mono_a_pert_2 = 0.d0
  norm_mono_b_pert_2 = 0.d0
- norm_double_1 = 0.d0
  do i = 1, min(N_det_print_wf,N_det)
   print*,''
   print*,'i = ',i
@@ -95,7 +93,6 @@ subroutine routine
     print*,'h1,p1 = ',h1,p1
     print*,'s2',s2
     print*,'h2,p2 = ',h2,p2
-    norm_double_1 += dabs(psi_coef_sorted(i,1)/psi_coef_sorted(1,1))
    endif
 
    print*,'<Ref| H |D_I> = ',hij
@@ -112,7 +109,6 @@ subroutine routine
  print*,''
  print*,'L1 norm of mono alpha = ',norm_mono_a
  print*,'L1 norm of mono beta  = ',norm_mono_b
- print*,'L1 norm of double exc = ',norm_double_1
  print*, '---'
  print*,'L2 norm of mono alpha = ',norm_mono_a_2
  print*,'L2 norm of mono beta  = ',norm_mono_b_2
diff --git a/src/tools/save_natorb_no_ov_rot.irp.f b/src/tools/save_natorb_no_ov_rot.irp.f
deleted file mode 100644
index e5b69fbf..00000000
--- a/src/tools/save_natorb_no_ov_rot.irp.f
+++ /dev/null
@@ -1,25 +0,0 @@
-program save_natorb
-  implicit none
-  BEGIN_DOC
-! Save natural |MOs| into the |EZFIO|.
-!
-! This program reads the wave function stored in the |EZFIO| directory,
-! extracts the corresponding natural orbitals and setd them as the new
-! |MOs|.
-!
-! If this is a multi-state calculation, the density matrix that produces
-! the natural orbitals is obtained from an average of the density
-! matrices of each state with the corresponding
-! :option:`determinants state_average_weight`
-  END_DOC
-  read_wf = .True.
-  touch read_wf
-  call save_natural_mos_no_ov_rot
-  call save_ref_determinant
-  call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('None')
-  call ezfio_set_mo_one_e_ints_io_mo_one_e_integrals('None')
-  call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('None')
-  call ezfio_set_mo_one_e_ints_io_mo_integrals_n_e('None')
-  call ezfio_set_mo_one_e_ints_io_mo_integrals_pseudo('None')
-end
-
diff --git a/src/tools/save_natorb_no_ref.irp.f b/src/tools/save_natorb_no_ref.irp.f
deleted file mode 100644
index 9d253fa0..00000000
--- a/src/tools/save_natorb_no_ref.irp.f
+++ /dev/null
@@ -1,24 +0,0 @@
-program save_natorb
-  implicit none
-  BEGIN_DOC
-! Save natural |MOs| into the |EZFIO|.
-!
-! This program reads the wave function stored in the |EZFIO| directory,
-! extracts the corresponding natural orbitals and setd them as the new
-! |MOs|.
-!
-! If this is a multi-state calculation, the density matrix that produces
-! the natural orbitals is obtained from an average of the density
-! matrices of each state with the corresponding
-! :option:`determinants state_average_weight`
-  END_DOC
-  read_wf = .True.
-  touch read_wf
-  call save_natural_mos_canon_label
-  call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('None')
-  call ezfio_set_mo_one_e_ints_io_mo_one_e_integrals('None')
-  call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('None')
-  call ezfio_set_mo_one_e_ints_io_mo_integrals_n_e('None')
-  call ezfio_set_mo_one_e_ints_io_mo_integrals_pseudo('None')
-end
-
diff --git a/src/tools/truncate_wf.irp.f b/src/tools/truncate_wf.irp.f
deleted file mode 100644
index 64c15bf7..00000000
--- a/src/tools/truncate_wf.irp.f
+++ /dev/null
@@ -1,110 +0,0 @@
-program truncate_wf
- implicit none
- BEGIN_DOC
-! Truncate the wave function
- END_DOC
- read_wf = .True.
- if (s2_eig) then
-  call routine_s2
- else
-  call routine
- endif
-end
-
-subroutine routine
- implicit none
- integer :: ndet_max
- print*, 'Max number of determinants ?'
- read(5,*) ndet_max
- integer(bit_kind), allocatable :: psi_det_tmp(:,:,:)
- double precision, allocatable :: psi_coef_tmp(:,:)
- allocate(psi_det_tmp(N_int,2,ndet_max),psi_coef_tmp(ndet_max, N_states))
- 
- integer :: i,j
- double precision :: accu(N_states)
- accu = 0.d0
- do i = 1, ndet_max
-  do j = 1, N_int
-   psi_det_tmp(j,1,i) = psi_det_sorted(j,1,i)
-   psi_det_tmp(j,2,i) = psi_det_sorted(j,2,i)
-  enddo
-  do j = 1, N_states
-   psi_coef_tmp(i,j) = psi_coef_sorted(i,j)
-   accu(j) += psi_coef_tmp(i,j) **2
-  enddo
- enddo
- do j = 1, N_states
-  accu(j) = 1.d0/dsqrt(accu(j))
- enddo
- do j = 1, N_states
-  do i = 1, ndet_max
-   psi_coef_tmp(i,j) = psi_coef_tmp(i,j) * accu(j)
-  enddo
- enddo
-
- call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp)
- 
-end
-
-subroutine routine_s2
- implicit none
- integer :: ndet_max
- double precision :: wmin
- integer(bit_kind), allocatable :: psi_det_tmp(:,:,:)
- double precision, allocatable :: psi_coef_tmp(:,:)
- integer :: i,j,k
- double precision :: accu(N_states)
- integer :: weights(0:16), ix
- double precision :: x
-
- weights(:) = 0
- do i=1,N_det
-   x = -dlog(1.d-32+sum(weight_configuration(det_to_configuration(i),:)))/dlog(10.d0)
-   ix = min(int(x), 16)
-   weights(ix) += 1
- enddo
-
- print *,  'Histogram of the weights of the CFG'
- do i=0,15
-   print *, '  10^{-', i, '}   ', weights(i) 
- end do
- print *, '< 10^{-', 15, '}   ', weights(16) 
-
-
- print*, 'Min weight of the configuration?'
- read(5,*) wmin
-
- ndet_max = 0
- do i=1,N_det
-   if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle
-   ndet_max = ndet_max+1
- enddo
-
- allocate(psi_det_tmp(N_int,2,ndet_max),psi_coef_tmp(ndet_max, N_states))
- 
- accu = 0.d0
- k=0
- do i = 1, N_det
-  if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle
-  k = k+1
-  do j = 1, N_int
-   psi_det_tmp(j,1,k) = psi_det(j,1,i)
-   psi_det_tmp(j,2,k) = psi_det(j,2,i)
-  enddo
-  do j = 1, N_states
-   psi_coef_tmp(k,j) = psi_coef(i,j)
-   accu(j) += psi_coef_tmp(k,j)**2
-  enddo
- enddo
- do j = 1, N_states
-  accu(j) = 1.d0/dsqrt(accu(j))
- enddo
- do j = 1, N_states
-  do i = 1, ndet_max
-   psi_coef_tmp(i,j) = psi_coef_tmp(i,j) * accu(j)
-  enddo
- enddo
-
- call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp)
- 
-end
diff --git a/src/two_body_rdm/two_e_dm_mo.irp.f b/src/two_body_rdm/two_e_dm_mo.irp.f
index a4dea15f..4dadd2e6 100644
--- a/src/two_body_rdm/two_e_dm_mo.irp.f
+++ b/src/two_body_rdm/two_e_dm_mo.irp.f
@@ -1,8 +1,9 @@
 BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)]
    implicit none
    BEGIN_DOC
-   ! \sum_{\sigma \sigma'}
-   ! <Psi| a^{\dagger}_{i \sigma} a^{\dagger}_{j \sigma'} a_{l \sigma'} a_{k \sigma} |Psi>
+   ! two_e_dm_bb_mo(i,j,k,l,istate) =  STATE SPECIFIC physicist notation for 2RDM of beta/beta electrons
+   !
+   ! <Psi| a^{\dagger}_{i \beta} a^{\dagger}_{j \beta} a_{l \beta} a_{k \beta} |Psi>
    !
    ! where the indices (i,j,k,l) belong to all MOs.
    !
@@ -11,7 +12,7 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)]
    !  !!!!! WARNING !!!!! IF "no_core_density" then all elements involving at least one CORE MO are set to zero
    ! The state-averaged two-electron energy :
    !
-   !   \sum_{i,j,k,l = 1, mo_num} two_e_dm_mo(i,j,k,l) * < kk ll | ii jj >
+   !   \sum_{i,j,k,l = 1, mo_num} two_e_dm_mo(i,j,k,l) * < ii jj | kk ll >
    END_DOC
    two_e_dm_mo = 0.d0
    integer                        :: i,j,k,l,iorb,jorb,korb,lorb,istate
diff --git a/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f b/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f
index 26ed5ae6..eb247dea 100644
--- a/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f
+++ b/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f
@@ -529,14 +529,10 @@ subroutine orb_range_2_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,list_
        c_average += c_1(l) * c_1(l) * state_weights(l) 
      enddo
      
-     if (nkeys > 0) then
-       call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm)
-     endif
+     call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm)
      nkeys = 0
      call orb_range_diag_to_all_2_rdm_dm_buffer(tmp_det,c_average,orb_bitmask,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
-     if (nkeys > 0) then
-       call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm)
-     endif
+     call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm)
      nkeys = 0
      
    end do
diff --git a/src/utils/EZFIO.cfg b/src/utils/EZFIO.cfg
index 7d367f0c..9e9a62f1 100644
--- a/src/utils/EZFIO.cfg
+++ b/src/utils/EZFIO.cfg
@@ -3,3 +3,4 @@ type: logical
 doc: If true, try to find symmetry in the MO coefficient matrices
 interface: ezfio,provider,ocaml
 default: False
+
diff --git a/src/utils/cgtos_one_e.irp.f b/src/utils/cgtos_one_e.irp.f
new file mode 100644
index 00000000..43ca8224
--- /dev/null
+++ b/src/utils/cgtos_one_e.irp.f
@@ -0,0 +1,120 @@
+
+! ---
+
+complex*16 function overlap_cgaussian_x(A_center, B_center, alpha, beta, power_A, power_B, dim)
+
+  BEGIN_DOC
+  !
+  ! \int_{-infty}^{+infty} (x-A_x)^ax (x-B_x)^bx exp(-alpha (x-A_x)^2) exp(- beta(x-B_X)^2) dx
+  ! with complex arguments
+  !
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in) :: dim, power_A, power_B 
+  complex*16, intent(in) :: A_center, B_center, alpha, beta
+
+  integer                :: i, iorder_p
+  double precision       :: fact_p_mod
+  complex*16             :: P_new(0:max_dim), P_center, fact_p, p, inv_sq_p
+
+  complex*16             :: Fc_integral
+
+
+  call give_explicit_cpoly_and_cgaussian_x( P_new, P_center, p, fact_p, iorder_p &
+                                          , alpha, beta, power_A, power_B, A_center, B_center, dim)
+ 
+  fact_p_mod = dsqrt(real(fact_p)*real(fact_p) + aimag(fact_p)*aimag(fact_p))
+  if(fact_p_mod .lt. 1.d-14) then
+    overlap_cgaussian_x = (0.d0, 0.d0)
+    return
+  endif
+
+
+  inv_sq_p = (1.d0, 0.d0) / zsqrt(p)
+
+  overlap_cgaussian_x = (0.d0, 0.d0)
+  do i = 0, iorder_p
+    overlap_cgaussian_x += P_new(i) * Fc_integral(i, inv_sq_p)
+  enddo
+
+  overlap_cgaussian_x *= fact_p
+
+end function overlap_cgaussian_x
+
+! ---
+
+subroutine overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                , overlap_x, overlap_y, overlap_z, overlap, dim )
+
+  BEGIN_DOC
+  !
+  !   S_x = \int (x-A_x)^{a_x} exp(-\alpha(x-A_x)^2)  (x-B_x)^{b_x} exp(-beta(x-B_x)^2) dx
+  !   S = S_x S_y S_z
+  !   for  complex arguments
+  !
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in)  :: dim, power_A(3), power_B(3)
+  complex*16, intent(in)  :: A_center(3), B_center(3), alpha, beta
+  complex*16, intent(out) :: overlap_x, overlap_y, overlap_z, overlap
+
+  integer                 :: i, nmax, iorder_p(3)
+  double precision        :: fact_p_mod
+  complex*16              :: P_new(0:max_dim,3), P_center(3), fact_p, p, inv_sq_p
+  complex*16              :: F_integral_tab(0:max_dim)
+
+  complex*16              :: Fc_integral
+
+  call give_explicit_cpoly_and_cgaussian(P_new, P_center, p, fact_p, iorder_p, alpha, beta, power_A, power_B, A_center, B_center, dim)
+
+  fact_p_mod = dsqrt(real(fact_p)*real(fact_p) + aimag(fact_p)*aimag(fact_p))
+  if(fact_p_mod .lt. 1.d-14) then
+    overlap_x = (1.d-10, 0.d0)
+    overlap_y = (1.d-10, 0.d0)
+    overlap_z = (1.d-10, 0.d0)
+    overlap   = (1.d-10, 0.d0)
+    return
+  endif
+
+  nmax = maxval(iorder_p)
+
+  inv_sq_p = (1.d0, 0.d0) / zsqrt(p)
+  do i = 0, nmax
+    F_integral_tab(i) = Fc_integral(i, inv_sq_p)
+  enddo
+
+  overlap_x = P_new(0,1) * F_integral_tab(0)
+  overlap_y = P_new(0,2) * F_integral_tab(0)
+  overlap_z = P_new(0,3) * F_integral_tab(0)
+
+  do i = 1, iorder_p(1)
+    overlap_x = overlap_x + P_new(i,1) * F_integral_tab(i)
+  enddo
+  call cgaussian_product_x(alpha, A_center(1), beta, B_center(1), fact_p, p, P_center(1))
+  overlap_x *= fact_p
+
+  do i = 1, iorder_p(2)
+    overlap_y = overlap_y + P_new(i,2) * F_integral_tab(i)
+  enddo
+  call cgaussian_product_x(alpha, A_center(2), beta, B_center(2), fact_p, p, P_center(2))
+  overlap_y *= fact_p
+
+  do i = 1, iorder_p(3)
+    overlap_z = overlap_z + P_new(i,3) * F_integral_tab(i)
+  enddo
+  call cgaussian_product_x(alpha, A_center(3), beta, B_center(3), fact_p, p, P_center(3))
+  overlap_z *= fact_p
+
+  overlap = overlap_x * overlap_y * overlap_z
+
+end subroutine overlap_cgaussian_xyz
+
+! ---
+
+
diff --git a/src/utils/cgtos_utils.irp.f b/src/utils/cgtos_utils.irp.f
new file mode 100644
index 00000000..a820d5f2
--- /dev/null
+++ b/src/utils/cgtos_utils.irp.f
@@ -0,0 +1,780 @@
+
+! ---
+
+subroutine give_explicit_cpoly_and_cgaussian_x(P_new, P_center, p, fact_k, iorder, alpha, beta, a, b, A_center, B_center, dim)
+
+  BEGIN_DOC
+  ! Transform the product of
+  !          (x-x_A)^a (x-x_B)^b exp(-(r-A)^2 alpha) exp(-(r-B)^2 beta)
+  ! into
+  !        fact_k \sum_{i=0}^{iorder} (x-x_P)^i exp(-p(r-P)^2)
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in)  :: dim
+  integer,    intent(in)  :: a, b 
+  complex*16, intent(in)  :: alpha, beta, A_center, B_center          
+  integer,    intent(out) :: iorder            
+  complex*16, intent(out) :: p, P_center, fact_k          
+  complex*16, intent(out) :: P_new(0:max_dim)  
+
+  integer                 :: n_new, i, j
+  double precision        :: tmp_mod
+  complex*16              :: P_a(0:max_dim), P_b(0:max_dim)
+  complex*16              :: p_inv, ab, d_AB, tmp
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: P_a, P_b
+
+  P_new = (0.d0, 0.d0)
+
+  ! new exponent
+  p = alpha + beta
+
+  ! new center
+  p_inv    = (1.d0, 0.d0) / p
+  ab       = alpha * beta
+  P_center = (alpha * A_center + beta * B_center) * p_inv
+
+  ! get the factor
+  d_AB    = (A_center - B_center) * (A_center - B_center)
+  tmp     = ab * p_inv * d_AB
+  tmp_mod = dsqrt(REAL(tmp)*REAL(tmp) + AIMAG(tmp)*AIMAG(tmp))
+  if(tmp_mod .lt. 50.d0) then
+    fact_k = zexp(-tmp)
+  else
+    fact_k = (0.d0, 0.d0)
+  endif
+
+  ! Recenter the polynomials P_a and P_b on P_center
+  !DIR$ FORCEINLINE
+  call recentered_cpoly2(P_a(0), A_center, P_center, a, P_b(0), B_center, P_center, b)
+  n_new = 0
+
+  !DIR$ FORCEINLINE
+  call multiply_cpoly(P_a(0), a, P_b(0), b, P_new(0), n_new)
+  iorder = a + b
+
+end subroutine give_explicit_cpoly_and_cgaussian_x
+
+! ---
+
+subroutine give_explicit_cpoly_and_cgaussian(P_new, P_center, p, fact_k, iorder, alpha, beta, a, b, A_center, B_center, dim)
+
+  BEGIN_DOC
+  ! Transforms the product of
+  !          (x-x_A)^a(1) (x-x_B)^b(1) (y-y_A)^a(2) (y-y_B)^b(2) (z-z_A)^a(3) (z-z_B)^b(3) exp(-(r-A)^2 alpha) exp(-(r-B)^2 beta)
+  ! into
+  !        fact_k * [ sum (l_x = 0,i_order(1)) P_new(l_x,1) * (x-P_center(1))^l_x ] exp (- p (x-P_center(1))^2 )
+  !               * [ sum (l_y = 0,i_order(2)) P_new(l_y,2) * (y-P_center(2))^l_y ] exp (- p (y-P_center(2))^2 )
+  !               * [ sum (l_z = 0,i_order(3)) P_new(l_z,3) * (z-P_center(3))^l_z ] exp (- p (z-P_center(3))^2 )
+  !
+  ! WARNING ::: IF fact_k is too smal then: 
+  ! returns a "s" function centered in zero
+  ! with an inifinite exponent and a zero polynom coef
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in)  :: dim, a(3), b(3)
+  complex*16, intent(in)  :: alpha, beta, A_center(3), B_center(3)      
+  integer,    intent(out) :: iorder(3)         
+  complex*16, intent(out) :: p, P_center(3), fact_k, P_new(0:max_dim,3)
+
+  integer                 :: n_new, i, j
+  double precision        :: tmp_mod
+  complex*16              :: P_a(0:max_dim,3), P_b(0:max_dim,3)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: P_a, P_b
+
+  iorder(1) = 0
+  iorder(2) = 0
+  iorder(3) = 0
+
+  P_new(0,1) = (0.d0, 0.d0)
+  P_new(0,2) = (0.d0, 0.d0)
+  P_new(0,3) = (0.d0, 0.d0)
+
+  !DIR$ FORCEINLINE
+  call cgaussian_product(alpha, A_center, beta, B_center, fact_k, p, P_center)
+
+  ! IF fact_k is too smal then: returns a "s" function centered in zero
+  ! with an inifinite exponent and a zero polynom coef
+  tmp_mod = dsqrt(REAL(fact_k)*REAL(fact_k) + AIMAG(fact_k)*AIMAG(fact_k))
+  if(tmp_mod < 1d-14) then
+    iorder               = 0
+    p                    = (1.d+14, 0.d0)
+    fact_k               = (0.d0  , 0.d0)
+    P_new(0:max_dim,1:3) = (0.d0  , 0.d0)
+    P_center(1:3)        = (0.d0  , 0.d0)
+    return
+  endif
+
+  !DIR$ FORCEINLINE
+  call recentered_cpoly2(P_a(0,1), A_center(1), P_center(1), a(1), P_b(0,1), B_center(1), P_center(1), b(1))
+  iorder(1) = a(1) + b(1)
+  do i = 0, iorder(1)
+    P_new(i,1) = 0.d0
+  enddo
+  n_new = 0
+  !DIR$ FORCEINLINE
+  call multiply_cpoly(P_a(0,1), a(1), P_b(0,1), b(1), P_new(0,1), n_new)
+
+  !DIR$ FORCEINLINE
+  call recentered_cpoly2(P_a(0,2), A_center(2), P_center(2), a(2), P_b(0,2), B_center(2), P_center(2), b(2))
+  iorder(2) = a(2) + b(2)
+  do i = 0, iorder(2)
+    P_new(i,2) = 0.d0
+  enddo
+  n_new = 0
+  !DIR$ FORCEINLINE
+  call multiply_cpoly(P_a(0,2), a(2), P_b(0,2), b(2), P_new(0,2), n_new)
+
+  !DIR$ FORCEINLINE
+  call recentered_cpoly2(P_a(0,3), A_center(3), P_center(3), a(3), P_b(0,3), B_center(3), P_center(3), b(3))
+  iorder(3) = a(3) + b(3)
+  do i = 0, iorder(3)
+    P_new(i,3) = 0.d0
+  enddo
+  n_new = 0
+  !DIR$ FORCEINLINE
+  call multiply_cpoly(P_a(0,3), a(3), P_b(0,3), b(3), P_new(0,3), n_new)
+
+end subroutine give_explicit_cpoly_and_cgaussian
+
+! ---
+
+!subroutine give_explicit_poly_and_gaussian_double(P_new,P_center,p,fact_k,iorder,alpha,beta,gama,a,b,A_center,B_center,Nucl_center,dim)
+!  BEGIN_DOC
+!  ! Transforms the product of
+!  !          (x-x_A)^a(1) (x-x_B)^b(1) (x-x_A)^a(2) (y-y_B)^b(2) (z-z_A)^a(3) (z-z_B)^b(3)
+!  !          exp(-(r-A)^2 alpha) exp(-(r-B)^2 beta) exp(-(r-Nucl_center)^2 gama
+!  !
+!  ! into
+!  !        fact_k * [ sum (l_x = 0,i_order(1)) P_new(l_x,1) * (x-P_center(1))^l_x ] exp (- p (x-P_center(1))^2 )
+!  !               * [ sum (l_y = 0,i_order(2)) P_new(l_y,2) * (y-P_center(2))^l_y ] exp (- p (y-P_center(2))^2 )
+!  !               * [ sum (l_z = 0,i_order(3)) P_new(l_z,3) * (z-P_center(3))^l_z ] exp (- p (z-P_center(3))^2 )
+!  END_DOC
+!  implicit none
+!  include 'constants.include.F'
+!  integer, intent(in)            :: dim
+!  integer, intent(in)            :: a(3),b(3)         ! powers : (x-xa)**a_x = (x-A(1))**a(1)
+!  double precision, intent(in)   :: alpha, beta, gama ! exponents
+!  double precision, intent(in)   :: A_center(3)       ! A center
+!  double precision, intent(in)   :: B_center (3)      ! B center
+!  double precision, intent(in)   :: Nucl_center(3)    ! B center
+!  double precision, intent(out)  :: P_center(3)       ! new center
+!  double precision, intent(out)  :: p                 ! new exponent
+!  double precision, intent(out)  :: fact_k            ! constant factor
+!  double precision, intent(out)  :: P_new(0:max_dim,3)! polynomial
+!  integer         , intent(out)  :: iorder(3)         ! i_order(i) = order of the polynomials
+!
+!  double precision  :: P_center_tmp(3)       ! new center
+!  double precision  :: p_tmp                 ! new exponent
+!  double precision  :: fact_k_tmp,fact_k_bis ! constant factor
+!  double precision  :: P_new_tmp(0:max_dim,3)! polynomial
+!  integer :: i,j
+!  double precision :: binom_func
+!
+!  ! First you transform the two primitives into a sum of primitive with the same center P_center_tmp and gaussian exponent p_tmp
+!  call give_explicit_cpoly_and_cgaussian(P_new_tmp,P_center_tmp,p_tmp,fact_k_tmp,iorder,alpha,beta,a,b,A_center,B_center,dim)
+!  ! Then you create the new gaussian from the product of the new one per the Nuclei one
+!  call cgaussian_product(p_tmp,P_center_tmp,gama,Nucl_center,fact_k_bis,p,P_center)
+!  fact_k = fact_k_bis * fact_k_tmp
+!
+!  ! Then you build the coefficient of the new polynom
+!  do i = 0, iorder(1)
+!   P_new(i,1) = 0.d0
+!   do j = i,iorder(1)
+!    P_new(i,1) = P_new(i,1) + P_new_tmp(j,1) * binom_func(j,j-i) * (P_center(1) - P_center_tmp(1))**(j-i)
+!   enddo
+!  enddo
+!  do i = 0, iorder(2)
+!   P_new(i,2) = 0.d0
+!   do j = i,iorder(2)
+!    P_new(i,2) = P_new(i,2) + P_new_tmp(j,2) * binom_func(j,j-i) * (P_center(2) - P_center_tmp(2))**(j-i)
+!   enddo
+!  enddo
+!  do i = 0, iorder(3)
+!   P_new(i,3) = 0.d0
+!   do j = i,iorder(3)
+!    P_new(i,3) = P_new(i,3) + P_new_tmp(j,3) * binom_func(j,j-i) * (P_center(3) - P_center_tmp(3))**(j-i)
+!   enddo
+!  enddo
+!
+!end
+
+! ---
+
+subroutine cgaussian_product(a, xa, b, xb, k, p, xp)
+
+  BEGIN_DOC
+  ! complex Gaussian product
+  ! e^{-a (r-r_A)^2} e^{-b (r-r_B)^2} = k e^{-p (r-r_P)^2}
+  END_DOC
+
+  implicit none
+  complex*16, intent(in)   :: a, b, xa(3), xb(3) 
+  complex*16, intent(out)  :: p, k, xp(3)      
+
+  double precision         :: tmp_mod
+  complex*16               :: p_inv, xab(3), ab
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xab
+
+  ASSERT (REAL(a) > 0.)
+  ASSERT (REAL(b) > 0.)
+
+  ! new exponent
+  p = a + b
+
+  xab(1) = xa(1) - xb(1)
+  xab(2) = xa(2) - xb(2)
+  xab(3) = xa(3) - xb(3)
+
+  p_inv = (1.d0, 0.d0) / p
+  ab    = a * b * p_inv
+
+  k       = ab * (xab(1)*xab(1) + xab(2)*xab(2) + xab(3)*xab(3))
+  tmp_mod = dsqrt(REAL(k)*REAL(k) + AIMAG(k)*AIMAG(k))
+  if(tmp_mod .gt. 40.d0) then
+    k       = (0.d0, 0.d0)
+    xp(1:3) = (0.d0, 0.d0)
+    return
+  endif
+
+  k = zexp(-k)
+  xp(1) = ( a * xa(1) + b * xb(1) ) * p_inv
+  xp(2) = ( a * xa(2) + b * xb(2) ) * p_inv
+  xp(3) = ( a * xa(3) + b * xb(3) ) * p_inv
+
+end subroutine cgaussian_product
+
+! ---
+
+subroutine cgaussian_product_x(a, xa, b, xb, k, p, xp)
+
+  BEGIN_DOC
+  ! complex Gaussian product in 1D.
+  ! e^{-a (x-x_A)^2} e^{-b (x-x_B)^2} = K e^{-p (x-x_P)^2}
+  END_DOC
+
+  implicit none
+  complex*16, intent(in)  :: a, b, xa, xb
+  complex*16, intent(out) :: p, k, xp
+
+  double precision        :: tmp_mod
+  complex*16              :: p_inv
+  complex*16              :: xab, ab
+
+  ASSERT (REAL(a) > 0.)
+  ASSERT (REAL(b) > 0.)
+
+  ! new center
+  p = a + b
+
+  xab = xa - xb
+
+  p_inv = (1.d0, 0.d0) / p
+  ab    = a * b * p_inv
+
+  k       = ab * xab*xab
+  tmp_mod = dsqrt(REAL(k)*REAL(k) + AIMAG(k)*AIMAG(k))
+  if(tmp_mod > 40.d0) then
+    k  = (0.d0, 0.d0)
+    xp = (0.d0, 0.d0)
+    return
+  endif
+
+  k  = zexp(-k)
+  xp = (a*xa + b*xb) * p_inv
+
+end subroutine cgaussian_product_x
+
+! ---
+
+subroutine multiply_cpoly(b, nb, c, nc, d, nd)
+
+  BEGIN_DOC
+  ! Multiply two complex polynomials
+  ! D(t) += B(t) * C(t)
+  END_DOC
+
+  implicit none
+
+  integer,    intent(in)    :: nb, nc
+  complex*16, intent(in)    :: b(0:nb), c(0:nc)
+  complex*16, intent(inout) :: d(0:nb+nc)
+  integer,    intent(out)   :: nd
+
+  integer                   :: ndtmp, ib, ic
+  double precision          :: tmp_mod
+  complex*16                :: tmp
+
+  if(ior(nc, nb) >= 0) then ! True if nc>=0 and nb>=0
+    continue
+  else
+    return
+  endif
+
+  ndtmp = nb + nc
+
+  do ic = 0, nc
+    d(ic) = d(ic) + c(ic) * b(0)
+  enddo
+
+  do ib = 1, nb
+    d(ib) = d(ib) + c(0) * b(ib)
+    do ic = 1, nc
+      d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
+    enddo
+  enddo
+
+  do nd = ndtmp, 0, -1
+    tmp     = d(nd)
+    tmp_mod = dsqrt(REAL(tmp)*REAL(tmp) + AIMAG(tmp)*AIMAG(tmp))
+    if(tmp_mod .lt. 1.d-15) cycle
+    exit
+  enddo
+
+end subroutine multiply_cpoly
+
+! ---
+
+subroutine add_cpoly(b, nb, c, nc, d, nd)
+
+  BEGIN_DOC
+  ! Add two complex polynomials
+  ! D(t) += B(t) + C(t)
+  END_DOC
+
+  implicit none
+  complex*16, intent(in)    :: b(0:nb), c(0:nc)
+  integer,    intent(inout) :: nb, nc
+  integer,    intent(out)   :: nd
+  complex*16, intent(out)   :: d(0:nb+nc)
+
+  integer                   :: ib
+  double precision          :: tmp_mod
+  complex*16                :: tmp
+
+  nd = nb + nc
+  do ib = 0, max(nb, nc)
+    d(ib) = d(ib) + c(ib) + b(ib)
+  enddo
+
+  tmp     = d(nd)
+  tmp_mod = dsqrt(REAL(tmp)*REAL(tmp) + AIMAG(tmp)*AIMAG(tmp))
+  do while( (tmp_mod .lt. 1.d-15) .and. (nd >= 0) )
+    nd -= 1
+    tmp     = d(nd)
+    tmp_mod = dsqrt(REAL(tmp)*REAL(tmp) + AIMAG(tmp)*AIMAG(tmp))
+    if(nd < 0) exit
+  enddo
+
+end subroutine add_cpoly
+
+! ---
+
+subroutine add_cpoly_multiply(b, nb, cst, d, nd)
+
+  BEGIN_DOC
+  ! Add a complex polynomial multiplied by a complex constant
+  ! D(t) += cst * B(t)
+  END_DOC
+
+  implicit none
+
+  integer,    intent(in)    :: nb
+  complex*16, intent(in)    :: b(0:nb), cst
+  integer,    intent(inout) :: nd
+  complex*16, intent(inout) :: d(0:max(nb, nd))
+
+  integer                   :: ib 
+  double precision          :: tmp_mod
+  complex*16                :: tmp
+
+  nd = max(nd, nb)
+  if(nd /= -1) then
+
+    do ib = 0, nb
+      d(ib) = d(ib) + cst * b(ib)
+    enddo
+
+    tmp     = d(nd)
+    tmp_mod = dsqrt(REAL(tmp)*REAL(tmp) + AIMAG(tmp)*AIMAG(tmp))
+    do while(tmp_mod .lt. 1.d-15)
+      nd -= 1
+      if(nd < 0) exit
+      tmp     = d(nd)
+      tmp_mod = dsqrt(REAL(tmp)*REAL(tmp) + AIMAG(tmp)*AIMAG(tmp))
+    enddo
+
+  endif
+
+end subroutine add_cpoly_multiply
+
+! ---
+
+subroutine recentered_cpoly2(P_A, x_A, x_P, a, P_B, x_B, x_Q, b)
+
+  BEGIN_DOC
+  !
+  ! write two complex polynomials (x-x_A)^a (x-x_B)^b 
+  ! as P_A(x-x_P) and P_B(x-x_Q)
+  !
+  END_DOC
+
+  implicit none
+
+  integer,    intent(in)  :: a, b
+  complex*16, intent(in)  :: x_A, x_P, x_B, x_Q
+  complex*16, intent(out) :: P_A(0:a), P_B(0:b)
+
+  integer                 :: i, minab, maxab
+  complex*16              :: pows_a(-2:a+b+4), pows_b(-2:a+b+4)
+
+  double precision        :: binom_func
+
+  if((a<0) .or. (b<0)) return
+
+  maxab = max(a, b)
+  minab = max(min(a, b), 0)
+
+  pows_a(0) = (1.d0, 0.d0)
+  pows_a(1) = x_P - x_A
+
+  pows_b(0) = (1.d0, 0.d0)
+  pows_b(1) = x_Q - x_B
+
+  do i = 2, maxab
+    pows_a(i) = pows_a(i-1) * pows_a(1)
+    pows_b(i) = pows_b(i-1) * pows_b(1)
+  enddo
+
+  P_A(0) = pows_a(a)
+  P_B(0) = pows_b(b)
+
+  do i = 1, min(minab, 20)
+    P_A(i) = binom_transp(a-i,a) * pows_a(a-i)
+    P_B(i) = binom_transp(b-i,b) * pows_b(b-i)
+  enddo
+
+  do i = minab+1, min(a, 20)
+    P_A(i) = binom_transp(a-i,a) * pows_a(a-i)
+  enddo
+  do i = minab+1, min(b, 20)
+    P_B(i) = binom_transp(b-i,b) * pows_b(b-i)
+  enddo
+
+  do i = 101, a
+    P_A(i) = binom_func(a,a-i) * pows_a(a-i)
+  enddo
+  do i = 101, b
+    P_B(i) = binom_func(b,b-i) * pows_b(b-i)
+  enddo
+
+end subroutine recentered_cpoly2
+
+! ---
+
+complex*16 function Fc_integral(n, inv_sq_p)
+
+  BEGIN_DOC
+  ! function that calculates the following integral
+  ! \int_{\-infty}^{+\infty} x^n \exp(-p x^2) dx
+  ! for complex valued p
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in) :: n
+  complex*16, intent(in) :: inv_sq_p 
+
+  ! (n)! 
+  double precision       :: fact
+
+  if(n < 0) then
+    Fc_integral = (0.d0, 0.d0)
+    return
+  endif
+
+  ! odd n
+  if(iand(n, 1) .ne. 0) then
+    Fc_integral = (0.d0, 0.d0)
+    return
+  endif
+
+  if(n == 0) then
+    Fc_integral = sqpi * inv_sq_p
+    return
+  endif
+
+  Fc_integral = sqpi * 0.5d0**n * inv_sq_p**dble(n+1) * fact(n) / fact(shiftr(n, 1))
+
+end function Fc_integral
+
+! ---
+
+complex*16 function crint(n, rho)
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in)  :: n
+  complex*16, intent(in)  :: rho
+
+  integer                 :: i, mmax
+  double precision        :: rho_mod, rho_re, rho_im 
+  double precision        :: sq_rho_re, sq_rho_im
+  double precision        :: n_tmp
+  complex*16              :: sq_rho, rho_inv, rho_exp
+
+  complex*16              :: crint_smallz, cpx_erf
+
+  rho_re  = REAL (rho)
+  rho_im  = AIMAG(rho)
+  rho_mod = dsqrt(rho_re*rho_re + rho_im*rho_im)
+
+  if(rho_mod < 10.d0) then
+    ! small z
+
+    if(rho_mod .lt. 1.d-10) then
+      crint = 1.d0 / dble(n + n + 1)
+    else
+      crint = crint_smallz(n, rho)
+    endif
+
+  else
+    ! large z
+
+    if(rho_mod .gt. 40.d0) then
+
+      n_tmp = dble(n) + 0.5d0
+      crint = 0.5d0 * gamma(n_tmp) / (rho**n_tmp)
+
+    else
+
+      ! get \sqrt(rho)
+      sq_rho_re = sq_op5 * dsqrt(rho_re + rho_mod)
+      sq_rho_im = 0.5d0 * rho_im / sq_rho_re 
+      sq_rho    = sq_rho_re + (0.d0, 1.d0) * sq_rho_im
+
+      rho_exp = 0.5d0 * zexp(-rho)
+      rho_inv = (1.d0, 0.d0) / rho
+
+      crint = 0.5d0 * sqpi * cpx_erf(sq_rho_re, sq_rho_im) / sq_rho
+      mmax = n
+      if(mmax .gt. 0) then
+        do i = 0, mmax-1
+          crint = ((dble(i) + 0.5d0) * crint - rho_exp) * rho_inv
+        enddo
+      endif
+
+      ! ***
+      
+    endif
+
+  endif
+
+!  print *, n, real(rho), real(crint)
+
+end function crint
+
+! ---
+
+complex*16 function crint_sum(n_pt_out, rho, d1)
+
+  implicit none
+  include 'constants.include.F'
+
+  integer,    intent(in)  :: n_pt_out
+  complex*16, intent(in)  :: rho, d1(0:n_pt_out)
+
+  integer                 :: n, i, mmax
+  double precision        :: rho_mod, rho_re, rho_im 
+  double precision        :: sq_rho_re, sq_rho_im
+  complex*16              :: sq_rho, F0
+  complex*16              :: rho_tmp, rho_inv, rho_exp
+  complex*16, allocatable :: Fm(:)
+
+  complex*16              :: crint_smallz, cpx_erf
+
+  rho_re  = REAL (rho)
+  rho_im  = AIMAG(rho)
+  rho_mod = dsqrt(rho_re*rho_re + rho_im*rho_im)
+
+  if(rho_mod < 10.d0) then
+    ! small z
+
+    if(rho_mod .lt. 1.d-10) then
+
+!      print *, ' 111'
+!      print *, ' rho = ', rho
+
+      crint_sum = d1(0)
+!      print *, 0, 1
+
+      do i = 2, n_pt_out, 2
+
+        n = shiftr(i, 1)
+        crint_sum = crint_sum + d1(i) / dble(n+n+1)
+
+!        print *, n, 1.d0 / dble(n+n+1)
+      enddo
+
+      ! ***
+
+    else
+
+!      print *, ' 222'
+!      print *, ' rho = ', real(rho)
+!      if(abs(aimag(rho)) .gt. 1d-15) then
+!        print *, ' complex rho', rho
+!        stop
+!      endif
+
+      crint_sum = d1(0) * crint_smallz(0, rho)
+
+!      print *, 0, real(d1(0)), real(crint_smallz(0, rho))
+!      if(abs(aimag(d1(0))) .gt. 1d-15) then
+!        print *, ' complex d1(0)', d1(0)
+!        stop
+!      endif
+
+      do i = 2, n_pt_out, 2
+        n = shiftr(i, 1)
+        crint_sum = crint_sum + d1(i) * crint_smallz(n, rho)
+
+!        print *, n, real(d1(i)), real(crint_smallz(n, rho))
+!        if(abs(aimag(d1(i))) .gt. 1d-15) then
+!          print *, ' complex d1(i)', i, d1(i)
+!          stop
+!        endif
+
+      enddo
+
+!      print *, 'sum = ', real(crint_sum)
+!      if(abs(aimag(crint_sum)) .gt. 1d-15) then
+!        print *, ' complex crint_sum', crint_sum
+!        stop
+!      endif
+
+      ! ***
+
+    endif
+
+  else
+    ! large z
+
+    if(rho_mod .gt. 40.d0) then
+
+!      print *, ' 333'
+!      print *, ' rho = ', rho
+
+      rho_inv   = (1.d0, 0.d0) / rho
+      rho_tmp   = 0.5d0 * sqpi * zsqrt(rho_inv)
+      crint_sum = rho_tmp * d1(0)
+!      print *, 0, rho_tmp
+
+      do i = 2, n_pt_out, 2
+        n = shiftr(i, 1)
+        rho_tmp   = rho_tmp * (dble(n) + 0.5d0) * rho_inv
+        crint_sum = crint_sum + rho_tmp * d1(i)
+!        print *, n, rho_tmp
+      enddo
+
+      ! ***
+
+    else
+
+!      print *, ' 444'
+!      print *, ' rho = ', rho
+
+      ! get \sqrt(rho)
+      sq_rho_re = sq_op5 * dsqrt(rho_re + rho_mod)
+      sq_rho_im = 0.5d0 * rho_im / sq_rho_re 
+      sq_rho    = sq_rho_re + (0.d0, 1.d0) * sq_rho_im
+      !sq_rho = zsqrt(rho)
+
+
+      F0        = 0.5d0 * sqpi * cpx_erf(sq_rho_re, sq_rho_im) / sq_rho
+      crint_sum = F0 * d1(0)
+!      print *, 0, F0
+
+      rho_exp = 0.5d0 * zexp(-rho)
+      rho_inv = (1.d0, 0.d0) / rho
+
+      mmax = shiftr(n_pt_out, 1)
+      if(mmax .gt. 0) then
+
+        allocate( Fm(mmax) )
+        Fm(1:mmax) = (0.d0, 0.d0)
+
+        do n = 0, mmax-1
+          F0      = ((dble(n) + 0.5d0) * F0 - rho_exp) * rho_inv
+          Fm(n+1) = F0
+!          print *, n, F0
+        enddo
+    
+        do i = 2, n_pt_out, 2
+          n = shiftr(i, 1)
+          crint_sum = crint_sum + Fm(n) * d1(i)
+        enddo
+        deallocate(Fm)
+      endif
+
+      ! ***
+      
+    endif
+
+  endif
+
+end function crint_sum
+
+! ---
+
+complex*16 function crint_smallz(n, rho)
+
+  BEGIN_DOC
+  ! Standard version of rint
+  END_DOC
+
+  implicit none
+  integer,    intent(in)      :: n
+  complex*16, intent(in)      :: rho
+
+  integer,          parameter :: kmax = 40
+  double precision, parameter :: eps = 1.d-13
+
+  integer                     :: k
+  double precision            :: delta_mod
+  complex*16                  :: rho_k, ct, delta_k
+
+  ct           = 0.5d0 * zexp(-rho) * gamma(dble(n) + 0.5d0)
+  rho_k        = (1.d0, 0.d0)
+  crint_smallz = ct * rho_k / gamma(dble(n) + 1.5d0)
+
+  do k = 1, kmax
+
+    rho_k        = rho_k * rho
+    delta_k      = ct * rho_k / gamma(dble(n+k) + 1.5d0)
+    crint_smallz = crint_smallz + delta_k
+
+    delta_mod = dsqrt(REAL(delta_k)*REAL(delta_k) + AIMAG(delta_k)*AIMAG(delta_k))
+    if(delta_mod .lt. eps) return
+  enddo
+
+  if(delta_mod > eps) then
+    write(*,*) ' pb in crint_smallz !'
+    write(*,*) ' n, rho    = ', n, rho
+    write(*,*) ' delta_mod = ', delta_mod
+    stop 1
+  endif
+
+end function crint_smallz
+
+! ---
+
diff --git a/src/utils/constants.include.F b/src/utils/constants.include.F
index 297a839e..a96fabe6 100644
--- a/src/utils/constants.include.F
+++ b/src/utils/constants.include.F
@@ -16,4 +16,5 @@ double precision, parameter :: c_2_4_3 = 2.5198420997897464d0
 double precision, parameter :: cst_lda = -0.93052573634909996d0
 double precision, parameter :: c_4_3 = 1.3333333333333333d0
 double precision, parameter :: c_1_3 = 0.3333333333333333d0
-
+double precision, parameter :: sq_op5 = dsqrt(0.5d0)
+double precision, parameter :: dlog_2pi =  dlog(2.d0*dacos(-1.d0))
diff --git a/src/utils/cpx_erf.irp.f b/src/utils/cpx_erf.irp.f
new file mode 100644
index 00000000..61f81055
--- /dev/null
+++ b/src/utils/cpx_erf.irp.f
@@ -0,0 +1,204 @@
+
+! ---
+
+complex*16 function cpx_erf(x, y)
+
+  BEGIN_DOC
+  !
+  ! compute erf(z) for z = x + i y
+  !
+  ! REF: Abramowitz and Stegun
+  !
+  END_DOC
+
+  implicit none
+  
+  double precision, intent(in) :: x, y
+
+  double precision             :: yabs
+  complex*16                   :: erf_tmp1, erf_tmp2, erf_tmp3, erf_tot
+
+  double precision             :: erf_F 
+  complex*16                   :: erf_E, erf_G, erf_H
+
+  yabs = dabs(y)
+
+  if(yabs .lt. 1.d-15) then
+
+    cpx_erf = (1.d0, 0.d0) * derf(x)
+    return
+
+  else
+
+    erf_tmp1 = (1.d0, 0.d0) * derf(x)
+    erf_tmp2 = erf_E(x, yabs) + erf_F(x, yabs)
+    erf_tmp3 = zexp(-(0.d0, 2.d0) * x * yabs) * ( erf_G(x, yabs) + erf_H(x, yabs) )
+    erf_tot  = erf_tmp1 + erf_tmp2 - erf_tmp3
+
+  endif
+
+  if(y .gt. 0.d0) then
+    cpx_erf = erf_tot
+  else
+    cpx_erf = CONJG(erf_tot)
+  endif
+
+end function cpx_erf
+
+! ---
+
+complex*16 function erf_E(x, yabs)
+ 
+  implicit none
+  include 'constants.include.F'
+
+  double precision, intent(in) :: x, yabs
+
+  if( (dabs(x).gt.6.d0) .or. (x==0.d0) ) then
+    erf_E = (0.d0, 0.d0)
+    return
+  endif
+
+  if(dabs(x) .lt. 1.d-7) then
+
+    erf_E = -inv_pi * (0.d0, 1.d0) * yabs
+
+  else
+
+    erf_E = 0.5d0 * inv_pi * dexp(-x*x) &
+          * ((1.d0, 0.d0) - zexp(-(2.d0, 0.d0) * x * yabs)) / x
+
+  endif
+
+end function erf_E
+
+! ---
+
+double precision function erf_F(x, yabs)
+ 
+  implicit none
+  include 'constants.include.F'
+
+  double precision, intent(in) :: x, yabs
+
+  integer, parameter           :: Nmax = 13
+
+  integer                      :: i
+  double precision             :: tmp1, tmp2, x2, ct 
+
+
+  if(dabs(x) .gt. 5.8d0) then
+
+    erf_F = 0.d0
+
+  else
+
+    x2 = x * x
+    ct = x * inv_pi
+
+    erf_F = 0.d0
+    do i = 1, Nmax
+
+      tmp1  = 0.25d0 * dble(i) * dble(i) + x2
+      tmp2  = dexp(-tmp1) / tmp1
+      erf_F = erf_F + tmp2
+
+      if(dabs(tmp2) .lt. 1d-15) exit
+    enddo
+    erf_F = ct * erf_F
+
+  endif 
+
+end function erf_F
+
+! ---
+
+complex*16 function erf_G(x, yabs)
+
+  implicit none
+  include 'constants.include.F'
+
+  double precision, intent(in) :: x, yabs
+
+  integer, parameter           :: Nmax = 13
+
+  integer                      :: i, tmpi, imin, imax
+  double precision             :: tmp0, tmp1, x2, idble
+  complex*16                   :: tmp2
+
+  if(x .eq. 0.d0) then
+    erf_G = (0.d0, 0.d0)
+    return
+  endif
+
+  tmpi = int(2.d0 * yabs)
+  imin = max(1, tmpi-Nmax)
+  imax = tmpi + Nmax
+
+  x2 = x * x
+
+  erf_G = 0.d0
+  do i = imin, imax
+
+    idble = dble(i)
+    tmp0  = 0.5d0 * idble
+    tmp1  = tmp0 * tmp0 + x2
+    tmp2  = dexp( idble * yabs - tmp1 - dlog(tmp1) - dlog_2pi) * (x - (0.d0, 1.d0)*tmp0)
+
+    erf_G = erf_G + tmp2
+
+  enddo
+
+end function erf_G
+
+! ---
+
+complex*16 function erf_H(x, yabs)
+ 
+  implicit none
+  include 'constants.include.F'
+
+  double precision, intent(in) :: x, yabs
+
+  integer, parameter           :: Nmax = 13
+
+  integer                      :: i
+  double precision             :: tmp0, tmp1, tmp_mod, x2, ct, idble
+  complex*16                   :: tmp2
+
+  if(x .eq. 0.d0) then
+    erf_H = (0.d0, 0.d0)
+    return
+  endif
+
+
+  if( (dabs(x) .lt. 10d0) .and. (yabs .lt. 6.1d0) ) then
+
+    x2 = x * x
+    ct = 0.5d0 * inv_pi
+
+    erf_H = 0.d0
+    do i = 1, Nmax
+
+      idble = dble(i)
+      tmp0  = 0.5d0 * idble
+      tmp1  = tmp0 * tmp0 + x2
+      tmp2  = dexp(-tmp1-idble*yabs) * (x + (0.d0, 1.d0)*tmp0) / tmp1
+      erf_H = erf_H + tmp2
+
+      tmp_mod = dsqrt(REAL(tmp2)*REAL(tmp2) + AIMAG(tmp2)*AIMAG(tmp2))
+      if(tmp_mod .lt. 1d-15) exit
+    enddo
+    erf_H = ct * erf_H
+
+  else
+
+    erf_H = (0.d0, 0.d0)
+
+  endif 
+
+end function erf_H
+
+! ---
+
+
diff --git a/src/utils/format_w_error.irp.f b/src/utils/format_w_error.irp.f
deleted file mode 100644
index 1378d367..00000000
--- a/src/utils/format_w_error.irp.f
+++ /dev/null
@@ -1,71 +0,0 @@
-subroutine format_w_error(value,error,size_nb,max_nb_digits,format_value,str_error)
-
-  implicit none
- 
-  BEGIN_DOC
-  ! Format for double precision, value(error)
-  END_DOC
-
-  ! in
-  ! | value         | double precision | value...      |
-  ! | error         | double precision | error...      |
-  ! | size_nb       | integer          | X in FX.Y     |
-  ! | max_nb_digits | integer          | Max Y in FX.Y |
-
-  ! out
-  ! | format_value  | character | string FX.Y for the format |
-  ! | str_error     | character | string of the error |
-
-  ! internal
-  ! | str_size      | character | size in string format                             |
-  ! | nb_digits     | integer   | number of digits Y in FX.Y depending of the error |
-  ! | str_nb_digits | character | nb_digits in string format                        |
-  ! | str_exp       | character | string of the value in exponential format         |
-
-  ! in
-  double precision, intent(in)   :: error, value
-  integer, intent(in)            :: size_nb, max_nb_digits
-
-  ! out
-  character(len=20), intent(out) :: str_error, format_value
-
-  ! internal
-  character(len=20)              :: str_size, str_nb_digits, str_exp
-  integer                        :: nb_digits
-
-  ! max_nb_digit: Y max
-  ! size_nb = Size of the double: X (FX.Y)
-  write(str_size,'(I3)') size_nb
-
-  ! Error
-  write(str_exp,'(1pE20.0)') error
-  str_error = trim(adjustl(str_exp))
-  
-  ! Number of digit: Y (FX.Y) from the exponent
-  str_nb_digits = str_exp(19:20)
-  read(str_nb_digits,*) nb_digits
- 
-  ! If the error is 0d0
-  if (error <= 1d-16) then 
-    write(str_nb_digits,*) max_nb_digits
-  endif
-
-  ! If the error is too small 
-  if (nb_digits > max_nb_digits) then
-      write(str_nb_digits,*) max_nb_digits
-      str_error(1:1) = '0'
-  endif
-
-  ! If the error is too big (>= 0.5)
-  if (error >= 0.5d0) then
-    str_nb_digits = '1'
-    str_error(1:1) = '*'
-  endif
-
-  ! FX.Y,A1,A1,A1 for value(str_error)
-  !string = 'F'//trim(adjustl(str_size))//'.'//trim(adjustl(str_nb_digits))//',A1,A1,A1'
-
-  ! FX.Y just for the value 
-  format_value = 'F'//trim(adjustl(str_size))//'.'//trim(adjustl(str_nb_digits))
-
-end
diff --git a/src/utils/integration.irp.f b/src/utils/integration.irp.f
index 38e198dc..fe4418ac 100644
--- a/src/utils/integration.irp.f
+++ b/src/utils/integration.irp.f
@@ -443,14 +443,16 @@ end
 
 
 
-double precision function rint(n,rho)
-  implicit none
+double precision function rint(n, rho)
+
   BEGIN_DOC
-!.. math::
-!
-!  \int_0^1 dx \exp(-p x^2) x^n
-!
+  !.. math::
+  !
+  !  \int_0^1 dx \exp(-p x^2) x^n
+  !
   END_DOC
+
+  implicit none
   include 'constants.include.F'
   double precision               :: rho,u,rint1,v,val0,rint_large_n,u_inv
   integer                        :: n,k
@@ -464,6 +466,7 @@ double precision function rint(n,rho)
       u=rho*u_inv
       rint=0.5d0*u_inv*sqpi*derf(u)
     endif
+!    print *, n, rho, rint
     return
   endif
   if(rho.lt.1.d0)then
@@ -487,6 +490,7 @@ double precision function rint(n,rho)
       rint=rint_large_n(n,rho)
     endif
   endif
+!  print *, n, rho, rint
 end
 
 
@@ -503,20 +507,24 @@ double precision function rint_sum(n_pt_out,rho,d1)
   integer                        :: n,k,i
   double precision               :: two_rho_inv, rint_tmp, di
 
+!  print *, ' rho = ', rho
 
   if(rho < 1.d0)then
 
     if(rho == 0.d0)then
       rint_sum=d1(0)
+!      print *, 0, d1(0), 1
     else
       u_inv=1.d0/dsqrt(rho)
       u=rho*u_inv
       rint_sum=0.5d0*u_inv*sqpi*derf(u) *d1(0)
+!      print *, 0, d1(0), 0.5d0*u_inv*sqpi*derf(u) 
     endif
 
     do i=2,n_pt_out,2
       n = shiftr(i,1)
       rint_sum = rint_sum + d1(i)*rint1(n,rho)
+!      print *, n, d1(i), rint1(n,rho)
     enddo
 
   else
@@ -532,19 +540,25 @@ double precision function rint_sum(n_pt_out,rho,d1)
     two_rho_inv = 0.5d0*u_inv*u_inv
     val0=0.5d0*u_inv*sqpi*derf(u)
     rint_sum=val0*d1(0)
+!    print *, 0, d1(0), val0
+
     rint_tmp=(val0-v)*two_rho_inv
     di = 3.d0
     do i=2,min(n_pt_out,40),2
       rint_sum = rint_sum + d1(i)*rint_tmp
+!      print *, i, d1(i), rint_tmp
       rint_tmp = (rint_tmp*di-v)*two_rho_inv
       di = di+2.d0
     enddo
     do i=42,n_pt_out,2
       n = shiftr(i,1)
       rint_sum = rint_sum + d1(i)*rint_large_n(n,rho)
+!      print *, i, d1(i), rint_large_n(n, rho)
     enddo
 
   endif
+
+!  print *, 'sum = ', rint_sum
 end
 
 double precision function hermite(n,x)
@@ -627,3 +641,94 @@ double precision function rint1(n,rho)
   write(*,*)'pb in rint1 k too large!'
   stop 1
 end
+
+! ---
+
+double precision function V_phi(n, m)
+
+  BEGIN_DOC
+  ! Computes the angular $\phi$ part of the nuclear attraction integral:
+  !
+  ! $\int_{0}^{2 \pi} \cos(\phi)^n \sin(\phi)^m d\phi$.
+  END_DOC
+
+  implicit none
+  integer, intent(in) :: n, m
+
+  integer             :: i
+  double precision    :: prod
+
+  double precision    :: Wallis
+
+  prod = 1.d0
+  do i = 0, shiftr(n, 1)-1
+    prod = prod/ (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
+  enddo
+  V_phi = 4.d0 * prod * Wallis(m)
+
+end function V_phi
+
+! ---
+
+double precision function V_theta(n, m)
+
+  BEGIN_DOC
+  ! Computes the angular $\theta$ part of the nuclear attraction integral:
+  !
+  ! $\int_{0}^{\pi} \cos(\theta)^n \sin(\theta)^m d\theta$
+  END_DOC
+
+  implicit none
+  include 'utils/constants.include.F'
+  integer, intent(in) :: n, m
+
+  integer             :: i
+  double precision    :: prod
+
+  double precision    :: Wallis
+
+  V_theta = 0.d0
+  prod = 1.d0
+  do i = 0, shiftr(n, 1)-1
+    prod = prod / (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
+  enddo
+  V_theta = (prod + prod) * Wallis(m)
+
+end function V_theta
+
+! ---
+
+double precision function Wallis(n)
+
+  BEGIN_DOC
+  ! Wallis integral:
+  !
+  ! $\int_{0}^{\pi} \cos(\theta)^n d\theta$.
+  END_DOC
+
+  implicit none
+  include 'utils/constants.include.F'
+
+  integer, intent(in) :: n
+
+  integer             :: p
+
+  double precision    :: fact
+
+  if(iand(n, 1) .eq. 0) then
+
+    Wallis = fact(shiftr(n, 1))
+    Wallis = pi * fact(n) / (dble(ibset(0_8, n)) * (Wallis + Wallis) * Wallis)
+
+  else
+
+    p = shiftr(n, 1)
+    Wallis = fact(p)
+    Wallis = dble(ibset(0_8, p+p)) * Wallis * Wallis / fact(p+p+1)
+
+  endif
+
+end function Wallis
+
+! ---
+
diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f
index 405d2d20..ae0bb8e5 100644
--- a/src/utils/linear_algebra.irp.f
+++ b/src/utils/linear_algebra.irp.f
@@ -1649,3 +1649,103 @@ subroutine restore_symmetry(m,n,A,LDA,thresh)
   enddo
 
 end
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+!subroutine svd_s(A, LDA, U, LDU, D, Vt, LDVt, m, n)
+!  implicit none
+!  BEGIN_DOC
+!  ! !!!
+!  ! DGESVD computes the singular value decomposition (SVD) of a real
+!  ! M-by-N matrix A, optionally computing the left and/or right singular
+!  ! vectors. The SVD is written:
+!  !      A = U * SIGMA * transpose(V)
+!  ! where SIGMA is an M-by-N matrix which is zero except for its
+!  ! min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+!  ! V is an N-by-N orthogonal matrix.  The diagonal elements of SIGMA
+!  ! are the singular values of A; they are real and non-negative, and
+!  ! are returned in descending order.  The first min(m,n) columns of
+!  ! U and V are the left and right singular vectors of A.
+!  !
+!  ! Note that the routine returns V**T, not V.
+!  ! !!!
+!  END_DOC
+!
+!  integer, intent(in)             :: LDA, LDU, LDVt, m, n
+!  double precision, intent(in)    :: A(LDA,n)
+!  double precision, intent(out)   :: U(LDU,m), Vt(LDVt,n), D(min(m,n))
+!  double precision,allocatable    :: work(:), A_tmp(:,:)
+!  integer                         :: info, lwork, i, j, k
+!
+!
+!   allocate (A_tmp(LDA,n))
+!   do k=1,n
+!     do i=1,m
+!       !A_tmp(i,k) = A(i,k) + 1d-16
+!       A_tmp(i,k) = A(i,k)
+!     enddo
+!   enddo
+! 
+!   ! Find optimal size for temp arrays
+!   allocate(work(1))
+!   lwork = -1
+!   ! 'A': all M columns of U are returned in array U
+!   ! 'A': all N rows of V**T are returned in the array VT
+!   call dgesvd('A', 'A', m, n, A_tmp, LDA, D, U, LDU, Vt, LDVt, work, lwork, info)
+!   ! /!\ int(WORK(1)) becomes negative when WORK(1) > 2147483648
+!   if( info.ne.0 ) then
+!     print *, ' problem in first call DGESVD !!!!'
+!     print *, ' info = ', info
+!     print *, '  < 0 : if INFO = -i, the i-th argument had an illegal value.'
+!     print *, '  > 0 : if DBDSQR did not converge, INFO specifies how many  '
+!     print *, '        superdiagonals of an intermediate bidiagonal form B  '
+!     print *, '        did not converge to zero. See the description of WORK'
+!     print *, '        above for details.                                   '
+!     stop
+!   endif
+!   lwork = max(int(work(1)), 5*MIN(M,N))
+!   deallocate(work)
+!
+!   allocate(work(lwork))
+!
+!   call dgesvd('A', 'A', m, n, A_tmp, LDA, D, U, LDU, Vt, LDVt, work, lwork, info)
+!   if( info.ne.0 ) then
+!     print *, ' problem in second call DGESVD !!!!'
+!     print *, ' info = ', info
+!     print *, '  < 0 : if INFO = -i, the i-th argument had an illegal value.'
+!     print *, '  > 0 : if DBDSQR did not converge, INFO specifies how many  '
+!     print *, '        superdiagonals of an intermediate bidiagonal form B  '
+!     print *, '        did not converge to zero. See the description of WORK'
+!     print *, '        above for details.                                   '
+!     stop
+!   endif
+!
+!   deallocate(A_tmp,work)
+! 
+!   !do j=1, m
+!   !  do i=1, LDU
+!   !    if (dabs(U(i,j)) < 1.d-14)  U(i,j) = 0.d0
+!   !  enddo
+!   !enddo
+!   !do j = 1, n
+!   !  do i = 1, LDVt
+!   !    if (dabs(Vt(i,j)) < 1.d-14) Vt(i,j) = 0.d0
+!   !  enddo
+!   !enddo
+! 
+!end
+!
diff --git a/src/utils/map_module.f90 b/src/utils/map_module.f90
index ceaec874..98e73470 100644
--- a/src/utils/map_module.f90
+++ b/src/utils/map_module.f90
@@ -238,11 +238,11 @@ subroutine cache_map_sort(map)
       iorder(i) = i
     enddo
     if (cache_key_kind == 2) then
-      call i2sort(map%key,iorder,map%n_elements,-1)
+      call i2radix_sort(map%key,iorder,map%n_elements,-1)
     else if (cache_key_kind == 4) then
-      call isort(map%key,iorder,map%n_elements,-1)
+      call iradix_sort(map%key,iorder,map%n_elements,-1)
     else if (cache_key_kind == 8) then
-      call i8sort(map%key,iorder,map%n_elements,-1)
+      call i8radix_sort(map%key,iorder,map%n_elements,-1)
     endif
     if (integral_kind == 4) then
       call set_order(map%value,iorder,map%n_elements)
diff --git a/src/utils/memory.irp.f b/src/utils/memory.irp.f
index d5a066a1..3ea242b0 100644
--- a/src/utils/memory.irp.f
+++ b/src/utils/memory.irp.f
@@ -114,7 +114,7 @@ subroutine print_memory_usage()
   call resident_memory(rss)
   call total_memory(mem)
 
-  write(*,'(A,F14.3,A,F14.3,A)') &
+  write(*,'(A,F14.6,A,F14.6,A)') &
     '.. >>>>> [ RES  MEM : ', rss , &
         ' GB ] [ VIRT MEM : ', mem, ' GB ] <<<<< ..'
 end
diff --git a/src/utils/qsort.c b/src/utils/qsort.c
deleted file mode 100644
index c011b35a..00000000
--- a/src/utils/qsort.c
+++ /dev/null
@@ -1,373 +0,0 @@
-/* [[file:~/qp2/src/utils/qsort.org::*Generated%20C%20file][Generated C file:1]] */
-#include <stdlib.h>
-#include <stdint.h>
-
-struct int16_t_comp {
-  int16_t    x;
-  int32_t i;
-};
-
-int compare_int16_t( const void * l, const void * r )
-{
-  const int16_t * restrict _l= l;
-  const int16_t * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_int16_t(int16_t* restrict A_in, int32_t* restrict iorder, int32_t isize) {
-  struct int16_t_comp* A = malloc(isize * sizeof(struct int16_t_comp));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct int16_t_comp), compare_int16_t);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_int16_t_noidx(int16_t* A, int32_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(int16_t), compare_int16_t);
-}
-
-
-struct int16_t_comp_big {
-  int16_t    x;
-  int64_t i;
-};
-
-int compare_int16_t_big( const void * l, const void * r )
-{
-  const int16_t * restrict _l= l;
-  const int16_t * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_int16_t_big(int16_t* restrict A_in, int64_t* restrict iorder, int64_t isize) {
-  struct int16_t_comp_big* A = malloc(isize * sizeof(struct int16_t_comp_big));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct int16_t_comp_big), compare_int16_t_big);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_int16_t_noidx_big(int16_t* A, int64_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(int16_t), compare_int16_t_big);
-}
-
-
-struct int32_t_comp {
-  int32_t    x;
-  int32_t i;
-};
-
-int compare_int32_t( const void * l, const void * r )
-{
-  const int32_t * restrict _l= l;
-  const int32_t * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_int32_t(int32_t* restrict A_in, int32_t* restrict iorder, int32_t isize) {
-  struct int32_t_comp* A = malloc(isize * sizeof(struct int32_t_comp));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct int32_t_comp), compare_int32_t);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_int32_t_noidx(int32_t* A, int32_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(int32_t), compare_int32_t);
-}
-
-
-struct int32_t_comp_big {
-  int32_t    x;
-  int64_t i;
-};
-
-int compare_int32_t_big( const void * l, const void * r )
-{
-  const int32_t * restrict _l= l;
-  const int32_t * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_int32_t_big(int32_t* restrict A_in, int64_t* restrict iorder, int64_t isize) {
-  struct int32_t_comp_big* A = malloc(isize * sizeof(struct int32_t_comp_big));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct int32_t_comp_big), compare_int32_t_big);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_int32_t_noidx_big(int32_t* A, int64_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(int32_t), compare_int32_t_big);
-}
-
-
-struct int64_t_comp {
-  int64_t    x;
-  int32_t i;
-};
-
-int compare_int64_t( const void * l, const void * r )
-{
-  const int64_t * restrict _l= l;
-  const int64_t * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_int64_t(int64_t* restrict A_in, int32_t* restrict iorder, int32_t isize) {
-  struct int64_t_comp* A = malloc(isize * sizeof(struct int64_t_comp));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct int64_t_comp), compare_int64_t);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_int64_t_noidx(int64_t* A, int32_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(int64_t), compare_int64_t);
-}
-
-
-struct int64_t_comp_big {
-  int64_t    x;
-  int64_t i;
-};
-
-int compare_int64_t_big( const void * l, const void * r )
-{
-  const int64_t * restrict _l= l;
-  const int64_t * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_int64_t_big(int64_t* restrict A_in, int64_t* restrict iorder, int64_t isize) {
-  struct int64_t_comp_big* A = malloc(isize * sizeof(struct int64_t_comp_big));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct int64_t_comp_big), compare_int64_t_big);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_int64_t_noidx_big(int64_t* A, int64_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(int64_t), compare_int64_t_big);
-}
-
-
-struct double_comp {
-  double    x;
-  int32_t i;
-};
-
-int compare_double( const void * l, const void * r )
-{
-  const double * restrict _l= l;
-  const double * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_double(double* restrict A_in, int32_t* restrict iorder, int32_t isize) {
-  struct double_comp* A = malloc(isize * sizeof(struct double_comp));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct double_comp), compare_double);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_double_noidx(double* A, int32_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(double), compare_double);
-}
-
-
-struct double_comp_big {
-  double    x;
-  int64_t i;
-};
-
-int compare_double_big( const void * l, const void * r )
-{
-  const double * restrict _l= l;
-  const double * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_double_big(double* restrict A_in, int64_t* restrict iorder, int64_t isize) {
-  struct double_comp_big* A = malloc(isize * sizeof(struct double_comp_big));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct double_comp_big), compare_double_big);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_double_noidx_big(double* A, int64_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(double), compare_double_big);
-}
-
-
-struct float_comp {
-  float    x;
-  int32_t i;
-};
-
-int compare_float( const void * l, const void * r )
-{
-  const float * restrict _l= l;
-  const float * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_float(float* restrict A_in, int32_t* restrict iorder, int32_t isize) {
-  struct float_comp* A = malloc(isize * sizeof(struct float_comp));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct float_comp), compare_float);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_float_noidx(float* A, int32_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(float), compare_float);
-}
-
-
-struct float_comp_big {
-  float    x;
-  int64_t i;
-};
-
-int compare_float_big( const void * l, const void * r )
-{
-  const float * restrict _l= l;
-  const float * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_float_big(float* restrict A_in, int64_t* restrict iorder, int64_t isize) {
-  struct float_comp_big* A = malloc(isize * sizeof(struct float_comp_big));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct float_comp_big), compare_float_big);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_float_noidx_big(float* A, int64_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(float), compare_float_big);
-}
-/* Generated C file:1 ends here */
diff --git a/src/utils/qsort.org b/src/utils/qsort.org
deleted file mode 100644
index abf0d54a..00000000
--- a/src/utils/qsort.org
+++ /dev/null
@@ -1,169 +0,0 @@
-#+TITLE: Quick sort binding for Fortran
-
-* C template
-
-#+NAME: c_template
-#+BEGIN_SRC c
-struct TYPE_comp_big {
-  TYPE    x;
-  int32_t i;
-};
-
-int compare_TYPE_big( const void * l, const void * r )
-{
-  const TYPE * restrict _l= l;
-  const TYPE * restrict _r= r;
-  if( *_l > *_r ) return 1;
-  if( *_l < *_r ) return -1;
-  return 0;
-}
-
-void qsort_TYPE_big(TYPE* restrict A_in, int32_t* restrict iorder, int32_t isize) {
-  struct TYPE_comp_big* A = malloc(isize * sizeof(struct TYPE_comp_big));
-  if (A == NULL) return;
-
-  for (int i=0 ; i<isize ; ++i) {
-    A[i].x = A_in[i];
-    A[i].i = iorder[i];
-  }
-
-  qsort( (void*) A, (size_t) isize, sizeof(struct TYPE_comp_big), compare_TYPE_big);
-
-  for (int i=0 ; i<isize ; ++i) {
-    A_in[i] = A[i].x;
-    iorder[i] = A[i].i;
-  }
-  free(A);
-}
-
-void qsort_TYPE_noidx_big(TYPE* A, int32_t isize) {
-  qsort( (void*) A, (size_t) isize, sizeof(TYPE), compare_TYPE_big);
-}
-#+END_SRC
-
-* Fortran template
-
-#+NAME:f_template
-#+BEGIN_SRC f90
-subroutine Lsort_big_c(A, iorder, isize) bind(C, name="qsort_TYPE_big")
-  use iso_c_binding
-  integer(c_int32_t), value :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  real   (c_TYPE)         :: A(isize)
-end subroutine Lsort_big_c
-
-subroutine Lsort_noidx_big_c(A, isize) bind(C, name="qsort_TYPE_noidx_big")
-  use iso_c_binding
-  integer(c_int32_t), value :: isize
-  real   (c_TYPE)         :: A(isize)
-end subroutine Lsort_noidx_big_c
-
-#+END_SRC
-
-#+NAME:f_template2
-#+BEGIN_SRC f90
-subroutine Lsort_big(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int32_t)        :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  real   (c_TYPE)         :: A(isize)
-  call Lsort_big_c(A, iorder, isize)
-end subroutine Lsort_big
-
-subroutine Lsort_noidx_big(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int32_t) :: isize
-  real   (c_TYPE)    :: A(isize)
-  call Lsort_noidx_big_c(A, isize)
-end subroutine Lsort_noidx_big
-
-#+END_SRC
-
-* Python scripts for type replacements
-
-#+NAME: replaced
-#+begin_src python :results output :noweb yes
-data = """
-<<c_template>>
-"""
-for typ in ["int16_t", "int32_t", "int64_t", "double", "float"]:
-    print( data.replace("TYPE", typ).replace("_big", "") )
-    print( data.replace("int32_t", "int64_t").replace("TYPE", typ) )
-#+end_src
-
-#+NAME: replaced_f
-#+begin_src python :results output :noweb yes
-data = """
-<<f_template>>
-"""
-c1 = {
-    "int16_t": "i2",
-    "int32_t": "i",
-    "int64_t": "i8",
-    "double": "d",
-    "float": ""
-}
-c2 = {
-    "int16_t": "integer",
-    "int32_t": "integer",
-    "int64_t": "integer",
-    "double": "real",
-    "float": "real"
-}
-
-for typ in ["int16_t", "int32_t", "int64_t", "double", "float"]:
-    print( data.replace("real",c2[typ]).replace("L",c1[typ]).replace("TYPE", typ).replace("_big", "") )
-    print( data.replace("real",c2[typ]).replace("L",c1[typ]).replace("int32_t", "int64_t").replace("TYPE", typ) )
-#+end_src
-
-#+NAME: replaced_f2
-#+begin_src python :results output :noweb yes
-data = """
-<<f_template2>>
-"""
-c1 = {
-    "int16_t": "i2",
-    "int32_t": "i",
-    "int64_t": "i8",
-    "double": "d",
-    "float": ""
-}
-c2 = {
-    "int16_t": "integer",
-    "int32_t": "integer",
-    "int64_t": "integer",
-    "double": "real",
-    "float": "real"
-}
-
-for typ in ["int16_t", "int32_t", "int64_t", "double", "float"]:
-    print( data.replace("real",c2[typ]).replace("L",c1[typ]).replace("TYPE", typ).replace("_big", "") )
-    print( data.replace("real",c2[typ]).replace("L",c1[typ]).replace("int32_t", "int64_t").replace("TYPE", typ) )
-#+end_src
-
-* Generated C file
-  
-#+BEGIN_SRC c :comments link :tangle qsort.c :noweb yes
-#include <stdlib.h>
-#include <stdint.h>
-<<replaced()>>
-#+END_SRC
-
-* Generated Fortran file
-
-#+BEGIN_SRC f90 :tangle qsort_module.f90 :noweb yes
-module qsort_module
-  use iso_c_binding
-  
-  interface
-     <<replaced_f()>>
-  end interface
-
-end module qsort_module
-
-<<replaced_f2()>>
-
-#+END_SRC
-
diff --git a/src/utils/qsort_module.f90 b/src/utils/qsort_module.f90
deleted file mode 100644
index a72a4f9e..00000000
--- a/src/utils/qsort_module.f90
+++ /dev/null
@@ -1,347 +0,0 @@
-module qsort_module
-  use iso_c_binding
-  
-  interface
-     
-     subroutine i2sort_c(A, iorder, isize) bind(C, name="qsort_int16_t")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer(c_int32_t)        :: iorder(isize)
-       integer   (c_int16_t)         :: A(isize)
-     end subroutine i2sort_c
-     
-     subroutine i2sort_noidx_c(A, isize) bind(C, name="qsort_int16_t_noidx")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer   (c_int16_t)         :: A(isize)
-     end subroutine i2sort_noidx_c
-     
-     
-     
-     subroutine i2sort_big_c(A, iorder, isize) bind(C, name="qsort_int16_t_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer(c_int64_t)        :: iorder(isize)
-       integer   (c_int16_t)         :: A(isize)
-     end subroutine i2sort_big_c
-     
-     subroutine i2sort_noidx_big_c(A, isize) bind(C, name="qsort_int16_t_noidx_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer   (c_int16_t)         :: A(isize)
-     end subroutine i2sort_noidx_big_c
-     
-     
-     
-     subroutine isort_c(A, iorder, isize) bind(C, name="qsort_int32_t")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer(c_int32_t)        :: iorder(isize)
-       integer   (c_int32_t)         :: A(isize)
-     end subroutine isort_c
-     
-     subroutine isort_noidx_c(A, isize) bind(C, name="qsort_int32_t_noidx")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer   (c_int32_t)         :: A(isize)
-     end subroutine isort_noidx_c
-     
-     
-     
-     subroutine isort_big_c(A, iorder, isize) bind(C, name="qsort_int32_t_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer(c_int64_t)        :: iorder(isize)
-       integer   (c_int32_t)         :: A(isize)
-     end subroutine isort_big_c
-     
-     subroutine isort_noidx_big_c(A, isize) bind(C, name="qsort_int32_t_noidx_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer   (c_int32_t)         :: A(isize)
-     end subroutine isort_noidx_big_c
-     
-     
-     
-     subroutine i8sort_c(A, iorder, isize) bind(C, name="qsort_int64_t")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer(c_int32_t)        :: iorder(isize)
-       integer   (c_int64_t)         :: A(isize)
-     end subroutine i8sort_c
-     
-     subroutine i8sort_noidx_c(A, isize) bind(C, name="qsort_int64_t_noidx")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer   (c_int64_t)         :: A(isize)
-     end subroutine i8sort_noidx_c
-     
-     
-     
-     subroutine i8sort_big_c(A, iorder, isize) bind(C, name="qsort_int64_t_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer(c_int64_t)        :: iorder(isize)
-       integer   (c_int64_t)         :: A(isize)
-     end subroutine i8sort_big_c
-     
-     subroutine i8sort_noidx_big_c(A, isize) bind(C, name="qsort_int64_t_noidx_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer   (c_int64_t)         :: A(isize)
-     end subroutine i8sort_noidx_big_c
-     
-     
-     
-     subroutine dsort_c(A, iorder, isize) bind(C, name="qsort_double")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer(c_int32_t)        :: iorder(isize)
-       real   (c_double)         :: A(isize)
-     end subroutine dsort_c
-     
-     subroutine dsort_noidx_c(A, isize) bind(C, name="qsort_double_noidx")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       real   (c_double)         :: A(isize)
-     end subroutine dsort_noidx_c
-     
-     
-     
-     subroutine dsort_big_c(A, iorder, isize) bind(C, name="qsort_double_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer(c_int64_t)        :: iorder(isize)
-       real   (c_double)         :: A(isize)
-     end subroutine dsort_big_c
-     
-     subroutine dsort_noidx_big_c(A, isize) bind(C, name="qsort_double_noidx_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       real   (c_double)         :: A(isize)
-     end subroutine dsort_noidx_big_c
-     
-     
-     
-     subroutine sort_c(A, iorder, isize) bind(C, name="qsort_float")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       integer(c_int32_t)        :: iorder(isize)
-       real   (c_float)         :: A(isize)
-     end subroutine sort_c
-     
-     subroutine sort_noidx_c(A, isize) bind(C, name="qsort_float_noidx")
-       use iso_c_binding
-       integer(c_int32_t), value :: isize
-       real   (c_float)         :: A(isize)
-     end subroutine sort_noidx_c
-     
-     
-     
-     subroutine sort_big_c(A, iorder, isize) bind(C, name="qsort_float_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       integer(c_int64_t)        :: iorder(isize)
-       real   (c_float)         :: A(isize)
-     end subroutine sort_big_c
-     
-     subroutine sort_noidx_big_c(A, isize) bind(C, name="qsort_float_noidx_big")
-       use iso_c_binding
-       integer(c_int64_t), value :: isize
-       real   (c_float)         :: A(isize)
-     end subroutine sort_noidx_big_c
-     
-     
-     
-  end interface
-
-end module qsort_module
-
-
-subroutine i2sort(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int32_t)        :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  integer   (c_int16_t)         :: A(isize)
-  call i2sort_c(A, iorder, isize)
-end subroutine i2sort
-
-subroutine i2sort_noidx(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int32_t) :: isize
-  integer   (c_int16_t)    :: A(isize)
-  call i2sort_noidx_c(A, isize)
-end subroutine i2sort_noidx
-
-
-
-subroutine i2sort_big(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int64_t)        :: isize
-  integer(c_int64_t)        :: iorder(isize)
-  integer   (c_int16_t)         :: A(isize)
-  call i2sort_big_c(A, iorder, isize)
-end subroutine i2sort_big
-
-subroutine i2sort_noidx_big(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int64_t) :: isize
-  integer   (c_int16_t)    :: A(isize)
-  call i2sort_noidx_big_c(A, isize)
-end subroutine i2sort_noidx_big
-
-
-
-subroutine isort(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int32_t)        :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  integer   (c_int32_t)         :: A(isize)
-  call isort_c(A, iorder, isize)
-end subroutine isort
-
-subroutine isort_noidx(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int32_t) :: isize
-  integer   (c_int32_t)    :: A(isize)
-  call isort_noidx_c(A, isize)
-end subroutine isort_noidx
-
-
-
-subroutine isort_big(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int64_t)        :: isize
-  integer(c_int64_t)        :: iorder(isize)
-  integer   (c_int32_t)         :: A(isize)
-  call isort_big_c(A, iorder, isize)
-end subroutine isort_big
-
-subroutine isort_noidx_big(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int64_t) :: isize
-  integer   (c_int32_t)    :: A(isize)
-  call isort_noidx_big_c(A, isize)
-end subroutine isort_noidx_big
-
-
-
-subroutine i8sort(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int32_t)        :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  integer   (c_int64_t)         :: A(isize)
-  call i8sort_c(A, iorder, isize)
-end subroutine i8sort
-
-subroutine i8sort_noidx(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int32_t) :: isize
-  integer   (c_int64_t)    :: A(isize)
-  call i8sort_noidx_c(A, isize)
-end subroutine i8sort_noidx
-
-
-
-subroutine i8sort_big(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int64_t)        :: isize
-  integer(c_int64_t)        :: iorder(isize)
-  integer   (c_int64_t)         :: A(isize)
-  call i8sort_big_c(A, iorder, isize)
-end subroutine i8sort_big
-
-subroutine i8sort_noidx_big(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int64_t) :: isize
-  integer   (c_int64_t)    :: A(isize)
-  call i8sort_noidx_big_c(A, isize)
-end subroutine i8sort_noidx_big
-
-
-
-subroutine dsort(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int32_t)        :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  real   (c_double)         :: A(isize)
-  call dsort_c(A, iorder, isize)
-end subroutine dsort
-
-subroutine dsort_noidx(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int32_t) :: isize
-  real   (c_double)    :: A(isize)
-  call dsort_noidx_c(A, isize)
-end subroutine dsort_noidx
-
-
-
-subroutine dsort_big(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int64_t)        :: isize
-  integer(c_int64_t)        :: iorder(isize)
-  real   (c_double)         :: A(isize)
-  call dsort_big_c(A, iorder, isize)
-end subroutine dsort_big
-
-subroutine dsort_noidx_big(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int64_t) :: isize
-  real   (c_double)    :: A(isize)
-  call dsort_noidx_big_c(A, isize)
-end subroutine dsort_noidx_big
-
-
-
-subroutine sort(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int32_t)        :: isize
-  integer(c_int32_t)        :: iorder(isize)
-  real   (c_float)         :: A(isize)
-  call sort_c(A, iorder, isize)
-end subroutine sort
-
-subroutine sort_noidx(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int32_t) :: isize
-  real   (c_float)    :: A(isize)
-  call sort_noidx_c(A, isize)
-end subroutine sort_noidx
-
-
-
-subroutine sort_big(A, iorder, isize) 
-  use qsort_module
-  use iso_c_binding
-  integer(c_int64_t)        :: isize
-  integer(c_int64_t)        :: iorder(isize)
-  real   (c_float)         :: A(isize)
-  call sort_big_c(A, iorder, isize)
-end subroutine sort_big
-
-subroutine sort_noidx_big(A, isize)
-  use iso_c_binding
-  use qsort_module
-  integer(c_int64_t) :: isize
-  real   (c_float)    :: A(isize)
-  call sort_noidx_big_c(A, isize)
-end subroutine sort_noidx_big
diff --git a/src/utils/set_multiple_levels_omp.irp.f b/src/utils/set_multiple_levels_omp.irp.f
deleted file mode 100644
index 572a13f4..00000000
--- a/src/utils/set_multiple_levels_omp.irp.f
+++ /dev/null
@@ -1,26 +0,0 @@
-subroutine set_multiple_levels_omp(activate)
-
-  BEGIN_DOC
-! If true, activate OpenMP nested parallelism. If false, deactivate.
-  END_DOC
-
-  implicit none
-  logical, intent(in) :: activate
-
-  if (activate) then
-    call omp_set_max_active_levels(3)
-
-    IRP_IF SET_NESTED
-      call omp_set_nested(.True.)
-    IRP_ENDIF
-
-  else
-
-    call omp_set_max_active_levels(1)
-
-    IRP_IF SET_NESTED
-      call omp_set_nested(.False.)
-    IRP_ENDIF
-  end if
-
-end
diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f
index 089c3871..a63eb4a3 100644
--- a/src/utils/sort.irp.f
+++ b/src/utils/sort.irp.f
@@ -1,4 +1,222 @@
 BEGIN_TEMPLATE
+ subroutine insertion_$Xsort (x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize) using the insertion sort algorithm.
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  $type                          :: xtmp
+  integer                        :: i, i0, j, jmax
+
+  do i=2,isize
+    xtmp = x(i)
+    i0 = iorder(i)
+    j=i-1
+    do while (j>0)
+      if ((x(j) <= xtmp)) exit
+      x(j+1) = x(j)
+      iorder(j+1) = iorder(j)
+      j=j-1
+    enddo
+    x(j+1) = xtmp
+    iorder(j+1) = i0
+  enddo
+ end subroutine insertion_$Xsort
+
+ subroutine quick_$Xsort(x, iorder, isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize) using the quicksort algorithm.
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  integer, external              :: omp_get_num_threads
+  call rec_$X_quicksort(x,iorder,isize,1,isize,nproc)
+ end
+
+ recursive subroutine rec_$X_quicksort(x, iorder, isize, first, last, level)
+  implicit none
+  integer, intent(in)            :: isize, first, last, level
+  integer,intent(inout)          :: iorder(isize)
+  $type, intent(inout)           :: x(isize)
+  $type                          :: c, tmp
+  integer                        :: itmp
+  integer                        :: i, j
+
+  if(isize<2)return
+
+  c = x( shiftr(first+last,1) )
+  i = first
+  j = last
+  do
+    do while (x(i) < c)
+      i=i+1
+    end do
+    do while (c < x(j))
+      j=j-1
+    end do
+    if (i >= j) exit
+    tmp  = x(i)
+    x(i) = x(j)
+    x(j) = tmp
+    itmp      = iorder(i)
+    iorder(i) = iorder(j)
+    iorder(j) = itmp
+    i=i+1
+    j=j-1
+  enddo
+  if ( ((i-first <= 10000).and.(last-j <= 10000)).or.(level<=0) ) then
+    if (first < i-1) then
+      call rec_$X_quicksort(x, iorder, isize, first, i-1,level/2)
+    endif
+    if (j+1 < last) then
+      call rec_$X_quicksort(x, iorder, isize, j+1, last,level/2)
+    endif
+  else
+    if (first < i-1) then
+      call rec_$X_quicksort(x, iorder, isize, first, i-1,level/2)
+    endif
+    if (j+1 < last) then
+      call rec_$X_quicksort(x, iorder, isize, j+1, last,level/2)
+    endif
+  endif
+ end
+
+ subroutine heap_$Xsort(x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize) using the heap sort algorithm.
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+
+  integer                        :: i, k, j, l, i0
+  $type                          :: xtemp
+
+  l = isize/2+1
+  k = isize
+  do while (.True.)
+    if (l>1) then
+      l=l-1
+      xtemp = x(l)
+      i0 = iorder(l)
+    else
+      xtemp = x(k)
+      i0 = iorder(k)
+      x(k) = x(1)
+      iorder(k) = iorder(1)
+      k = k-1
+      if (k == 1) then
+        x(1) = xtemp
+        iorder(1) = i0
+        exit
+      endif
+    endif
+    i=l
+    j = shiftl(l,1)
+    do while (j<k)
+      if ( x(j) < x(j+1) ) then
+        j=j+1
+      endif
+      if (xtemp < x(j)) then
+        x(i) = x(j)
+        iorder(i) = iorder(j)
+        i = j
+        j = shiftl(j,1)
+      else
+        j = k+1
+      endif
+    enddo
+    if (j==k) then
+      if (xtemp < x(j)) then
+        x(i) = x(j)
+        iorder(i) = iorder(j)
+        i = j
+        j = shiftl(j,1)
+      else
+        j = k+1
+      endif
+    endif
+    x(i) = xtemp
+    iorder(i) = i0
+  enddo
+ end subroutine heap_$Xsort
+
+ subroutine heap_$Xsort_big(x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize) using the heap sort algorithm.
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  ! This is a version for very large arrays where the indices need
+  ! to be in integer*8 format
+  END_DOC
+  integer*8,intent(in)           :: isize
+  $type,intent(inout)            :: x(isize)
+  integer*8,intent(inout)        :: iorder(isize)
+
+  integer*8                      :: i, k, j, l, i0
+  $type                          :: xtemp
+
+  l = isize/2+1
+  k = isize
+  do while (.True.)
+    if (l>1) then
+      l=l-1
+      xtemp = x(l)
+      i0 = iorder(l)
+    else
+      xtemp = x(k)
+      i0 = iorder(k)
+      x(k) = x(1)
+      iorder(k) = iorder(1)
+      k = k-1
+      if (k == 1) then
+        x(1) = xtemp
+        iorder(1) = i0
+        exit
+      endif
+    endif
+    i=l
+    j = shiftl(l,1)
+    do while (j<k)
+      if ( x(j) < x(j+1) ) then
+        j=j+1
+      endif
+      if (xtemp < x(j)) then
+        x(i) = x(j)
+        iorder(i) = iorder(j)
+        i = j
+        j = shiftl(j,1)
+      else
+        j = k+1
+      endif
+    enddo
+    if (j==k) then
+      if (xtemp < x(j)) then
+        x(i) = x(j)
+        iorder(i) = iorder(j)
+        i = j
+        j = shiftl(j,1)
+      else
+        j = k+1
+      endif
+    endif
+    x(i) = xtemp
+    iorder(i) = i0
+  enddo
+
+ end subroutine heap_$Xsort_big
 
  subroutine sorted_$Xnumber(x,isize,n)
   implicit none
@@ -32,6 +250,220 @@ SUBST [ X, type ]
 END_TEMPLATE
 
 
+!---------------------- INTEL
+IRP_IF INTEL
+
+BEGIN_TEMPLATE
+ subroutine $Xsort(x,iorder,isize)
+  use intel
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  integer                        :: n
+  character, allocatable         :: tmp(:)
+  if (isize < 2) return
+  call ippsSortRadixIndexGetBufferSize(isize, $ippsz, n)
+  allocate(tmp(n))
+  call ippsSortRadixIndexAscend_$ityp(x, $n, iorder, isize, tmp)
+  deallocate(tmp)
+  iorder(1:isize) = iorder(1:isize)+1
+  call $Xset_order(x,iorder,isize)
+ end
+
+ subroutine $Xsort_noidx(x,isize)
+  use intel
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer                        :: n
+  character, allocatable         :: tmp(:)
+  if (isize < 2) return
+  call ippsSortRadixIndexGetBufferSize(isize, $ippsz, n)
+  allocate(tmp(n))
+  call ippsSortRadixAscend_$ityp_I(x, isize, tmp)
+  deallocate(tmp)
+ end
+
+SUBST [ X, type, ityp, n, ippsz ]
+   ; real ; 32f ; 4 ; 13 ;;
+ i ; integer ; 32s ; 4 ; 11 ;;
+ i2 ; integer*2 ; 16s ; 2 ; 7 ;;
+END_TEMPLATE
+
+BEGIN_TEMPLATE
+
+ subroutine $Xsort(x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  integer                        :: n
+  if (isize < 2) then
+    return
+  endif
+!  call sorted_$Xnumber(x,isize,n)
+!  if (isize == n) then
+!    return
+!  endif
+  if ( isize < 32) then
+    call insertion_$Xsort(x,iorder,isize)
+  else
+!    call heap_$Xsort(x,iorder,isize)
+    call quick_$Xsort(x,iorder,isize)
+  endif
+ end subroutine $Xsort
+
+SUBST [ X, type ]
+ d ; double precision ;;
+END_TEMPLATE
+
+BEGIN_TEMPLATE
+
+ subroutine $Xsort(x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  integer                        :: n
+  if (isize < 2) then
+    return
+  endif
+  call sorted_$Xnumber(x,isize,n)
+  if (isize == n) then
+    return
+  endif
+  if ( isize < 32) then
+    call insertion_$Xsort(x,iorder,isize)
+  else
+    call $Xradix_sort(x,iorder,isize,-1)
+  endif
+ end subroutine $Xsort
+
+SUBST [ X, type ]
+ i8 ; integer*8 ;;
+END_TEMPLATE
+
+!---------------------- END INTEL
+IRP_ELSE
+!---------------------- NON-INTEL
+BEGIN_TEMPLATE
+
+ subroutine $Xsort_noidx(x,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer, allocatable           :: iorder(:)
+  integer                        :: i
+  allocate(iorder(isize))
+  do i=1,isize
+   iorder(i)=i
+  enddo
+  call $Xsort(x,iorder,isize)
+  deallocate(iorder)
+ end subroutine $Xsort_noidx
+
+SUBST [ X, type ]
+   ; real ;;
+ d ; double precision ;;
+ i ; integer ;;
+ i8 ; integer*8 ;;
+ i2 ; integer*2 ;;
+END_TEMPLATE
+
+BEGIN_TEMPLATE
+
+ subroutine $Xsort(x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  integer                        :: n
+  if (isize < 2) then
+    return
+  endif
+!  call sorted_$Xnumber(x,isize,n)
+!  if (isize == n) then
+!    return
+!  endif
+  if ( isize < 32) then
+    call insertion_$Xsort(x,iorder,isize)
+  else
+!    call heap_$Xsort(x,iorder,isize)
+    call quick_$Xsort(x,iorder,isize)
+  endif
+ end subroutine $Xsort
+
+SUBST [ X, type ]
+   ; real ;;
+ d ; double precision ;;
+END_TEMPLATE
+
+BEGIN_TEMPLATE
+
+ subroutine $Xsort(x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize).
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  END_DOC
+  integer,intent(in)             :: isize
+  $type,intent(inout)            :: x(isize)
+  integer,intent(inout)          :: iorder(isize)
+  integer                        :: n
+  if (isize < 2) then
+    return
+  endif
+  call sorted_$Xnumber(x,isize,n)
+  if (isize == n) then
+    return
+  endif
+  if ( isize < 32) then
+    call insertion_$Xsort(x,iorder,isize)
+  else
+    call $Xradix_sort(x,iorder,isize,-1)
+  endif
+ end subroutine $Xsort
+
+SUBST [ X, type ]
+ i ; integer ;;
+ i8 ; integer*8 ;;
+ i2 ; integer*2 ;;
+END_TEMPLATE
+
+IRP_ENDIF
+!---------------------- END NON-INTEL
+
+
 
 BEGIN_TEMPLATE
  subroutine $Xset_order(x,iorder,isize)
@@ -57,6 +489,47 @@ BEGIN_TEMPLATE
   deallocate(xtmp)
  end
 
+SUBST [ X, type ]
+   ; real ;;
+ d ; double precision ;;
+ i ; integer ;;
+ i8; integer*8 ;;
+ i2; integer*2 ;;
+END_TEMPLATE
+
+
+BEGIN_TEMPLATE
+ subroutine insertion_$Xsort_big (x,iorder,isize)
+  implicit none
+  BEGIN_DOC
+  ! Sort array x(isize) using the insertion sort algorithm.
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  ! This is a version for very large arrays where the indices need
+  ! to be in integer*8 format
+  END_DOC
+  integer*8,intent(in)           :: isize
+  $type,intent(inout)            :: x(isize)
+  integer*8,intent(inout)        :: iorder(isize)
+  $type                          :: xtmp
+  integer*8                      :: i, i0, j, jmax
+
+  do i=2_8,isize
+    xtmp = x(i)
+    i0 = iorder(i)
+    j = i-1_8
+    do while (j>0_8)
+      if (x(j)<=xtmp) exit
+      x(j+1_8) = x(j)
+      iorder(j+1_8) = iorder(j)
+      j = j-1_8
+    enddo
+    x(j+1_8) = xtmp
+    iorder(j+1_8) = i0
+  enddo
+
+ end subroutine insertion_$Xsort_big
+
  subroutine $Xset_order_big(x,iorder,isize)
   implicit none
   BEGIN_DOC
@@ -90,3 +563,223 @@ SUBST [ X, type ]
 END_TEMPLATE
 
 
+BEGIN_TEMPLATE
+
+recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix)
+  implicit none
+
+  BEGIN_DOC
+  ! Sort integer array x(isize) using the radix sort algorithm.
+  ! iorder in input should be (1,2,3,...,isize), and in output
+  ! contains the new order of the elements.
+  ! iradix should be -1 in input.
+  END_DOC
+  integer*$int_type, intent(in)  :: isize
+  integer*$int_type, intent(inout) :: iorder(isize)
+  integer*$type, intent(inout)   :: x(isize)
+  integer, intent(in)            :: iradix
+  integer                        :: iradix_new
+  integer*$type, allocatable     :: x2(:), x1(:)
+  integer*$type                  :: i4               ! data type
+  integer*$int_type, allocatable :: iorder1(:),iorder2(:)
+  integer*$int_type              :: i0, i1, i2, i3, i ! index type
+  integer*$type                  :: mask
+  integer                        :: err
+  !DIR$ ATTRIBUTES ALIGN : 128   :: iorder1,iorder2, x2, x1
+
+  if (isize < 2) then
+    return
+  endif
+
+  if (iradix == -1) then ! Sort Positive and negative
+
+    allocate(x1(isize),iorder1(isize), x2(isize),iorder2(isize),stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to allocate arrays'
+      stop
+    endif
+
+    i1=1_$int_type
+    i2=1_$int_type
+    do i=1_$int_type,isize
+      if (x(i) < 0_$type) then
+        iorder1(i1) = iorder(i)
+        x1(i1) = -x(i)
+        i1 = i1+1_$int_type
+      else
+        iorder2(i2) = iorder(i)
+        x2(i2) = x(i)
+        i2 = i2+1_$int_type
+      endif
+    enddo
+    i1=i1-1_$int_type
+    i2=i2-1_$int_type
+
+    do i=1_$int_type,i2
+      iorder(i1+i) = iorder2(i)
+      x(i1+i) = x2(i)
+    enddo
+    deallocate(x2,iorder2,stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to deallocate arrays x2, iorder2'
+      stop
+    endif
+
+
+    if (i1 > 1_$int_type) then
+      call $Xradix_sort$big(x1,iorder1,i1,-2)
+      do i=1_$int_type,i1
+        x(i) = -x1(1_$int_type+i1-i)
+        iorder(i) = iorder1(1_$int_type+i1-i)
+      enddo
+    endif
+
+    if (i2>1_$int_type) then
+      call $Xradix_sort$big(x(i1+1_$int_type),iorder(i1+1_$int_type),i2,-2)
+    endif
+
+    deallocate(x1,iorder1,stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to deallocate arrays x1, iorder1'
+      stop
+    endif
+    return
+
+  else if (iradix == -2) then ! Positive
+
+    ! Find most significant bit
+
+    i0 = 0_$int_type
+    i4 = maxval(x)
+
+    iradix_new = max($integer_size-1-leadz(i4),1)
+    mask = ibset(0_$type,iradix_new)
+
+    allocate(x1(isize),iorder1(isize), x2(isize),iorder2(isize),stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to allocate arrays'
+      stop
+    endif
+
+    i1=1_$int_type
+    i2=1_$int_type
+
+    do i=1_$int_type,isize
+      if (iand(mask,x(i)) == 0_$type) then
+        iorder1(i1) = iorder(i)
+        x1(i1) = x(i)
+        i1 = i1+1_$int_type
+      else
+        iorder2(i2) = iorder(i)
+        x2(i2) = x(i)
+        i2 = i2+1_$int_type
+      endif
+    enddo
+    i1=i1-1_$int_type
+    i2=i2-1_$int_type
+
+    do i=1_$int_type,i1
+      iorder(i0+i) = iorder1(i)
+      x(i0+i) = x1(i)
+    enddo
+    i0 = i0+i1
+    i3 = i0
+    deallocate(x1,iorder1,stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to deallocate arrays x1, iorder1'
+      stop
+    endif
+
+
+    do i=1_$int_type,i2
+      iorder(i0+i) = iorder2(i)
+      x(i0+i) = x2(i)
+    enddo
+    i0 = i0+i2
+    deallocate(x2,iorder2,stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to deallocate arrays x2, iorder2'
+      stop
+    endif
+
+
+    if (i3>1_$int_type) then
+      call $Xradix_sort$big(x,iorder,i3,iradix_new-1)
+    endif
+
+    if (isize-i3>1_$int_type) then
+      call $Xradix_sort$big(x(i3+1_$int_type),iorder(i3+1_$int_type),isize-i3,iradix_new-1)
+    endif
+
+    return
+  endif
+
+  ASSERT (iradix >= 0)
+
+  if (isize < 48) then
+    call insertion_$Xsort$big(x,iorder,isize)
+    return
+  endif
+
+
+  allocate(x2(isize),iorder2(isize),stat=err)
+  if (err /= 0) then
+    print *,  irp_here, ': Unable to allocate arrays x1, iorder1'
+    stop
+  endif
+
+
+  mask = ibset(0_$type,iradix)
+  i0=1_$int_type
+  i1=1_$int_type
+
+  do i=1_$int_type,isize
+    if (iand(mask,x(i)) == 0_$type) then
+      iorder(i0) = iorder(i)
+      x(i0) = x(i)
+      i0 = i0+1_$int_type
+    else
+      iorder2(i1) = iorder(i)
+      x2(i1) = x(i)
+      i1 = i1+1_$int_type
+    endif
+  enddo
+  i0=i0-1_$int_type
+  i1=i1-1_$int_type
+
+  do i=1_$int_type,i1
+    iorder(i0+i) = iorder2(i)
+    x(i0+i) = x2(i)
+  enddo
+
+  deallocate(x2,iorder2,stat=err)
+  if (err /= 0) then
+    print *,  irp_here, ': Unable to allocate arrays x2, iorder2'
+    stop
+  endif
+
+
+  if (iradix == 0) then
+    return
+  endif
+
+
+  if (i1>1_$int_type) then
+    call $Xradix_sort$big(x(i0+1_$int_type),iorder(i0+1_$int_type),i1,iradix-1)
+  endif
+  if (i0>1) then
+    call $Xradix_sort$big(x,iorder,i0,iradix-1)
+  endif
+
+ end
+
+SUBST [ X, type, integer_size, is_big, big, int_type ]
+ i  ; 4 ; 32 ; .False. ;      ; 4 ;;
+ i8 ; 8 ; 64 ; .False. ;      ; 4 ;;
+ i2 ; 2 ; 16 ; .False. ;      ; 4 ;;
+ i  ; 4 ; 32 ; .True.  ; _big ; 8 ;;
+ i8 ; 8 ; 64 ; .True.  ; _big ; 8 ;;
+END_TEMPLATE
+
+
+
diff --git a/src/utils/units.irp.f b/src/utils/units.irp.f
deleted file mode 100644
index 1850b28b..00000000
--- a/src/utils/units.irp.f
+++ /dev/null
@@ -1,22 +0,0 @@
-BEGIN_PROVIDER [double precision, ha_to_ev]
-
-  implicit none
-  BEGIN_DOC
-  ! Converstion from Hartree to eV
-  END_DOC
-
-  ha_to_ev = 27.211396641308d0
-
-END_PROVIDER
-
-BEGIN_PROVIDER [double precision, au_to_D]
-
-  implicit none
-  BEGIN_DOC
-  ! Converstion from au to Debye
-  END_DOC
-
-  au_to_D = 2.5415802529d0
-
-END_PROVIDER
-
diff --git a/src/utils/util.irp.f b/src/utils/util.irp.f
index 84593031..184d8052 100644
--- a/src/utils/util.irp.f
+++ b/src/utils/util.irp.f
@@ -37,10 +37,6 @@ double precision function binom_func(i,j)
   else
     binom_func = dexp( logfact(i)-logfact(j)-logfact(i-j) )
   endif
-
-  ! To avoid .999999 numbers
-  binom_func = floor(binom_func + 0.5d0)
-
 end
 
 
@@ -136,7 +132,7 @@ double precision function logfact(n)
   enddo
 end function
 
-
+! ---
 
 BEGIN_PROVIDER [ double precision, fact_inv, (128) ]
   implicit none
@@ -150,6 +146,29 @@ BEGIN_PROVIDER [ double precision, fact_inv, (128) ]
   enddo
 END_PROVIDER
 
+! ---
+
+BEGIN_PROVIDER [ double precision, shiftfact_op5_inv, (128) ]
+
+  BEGIN_DOC
+  !
+  ! 1 / Gamma(n + 0.5)
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i
+  double precision :: tmp
+
+  do i = 1, size(shiftfact_op5_inv)
+    !tmp = dgamma(dble(i) + 0.5d0)
+    tmp = gamma(dble(i) + 0.5d0)
+    shiftfact_op5_inv(i) = 1.d0 / tmp
+  enddo
+
+END_PROVIDER
+
+! ---
 
 double precision function dble_fact(n)
   implicit none
@@ -304,12 +323,12 @@ subroutine wall_time(t)
 end
 
 BEGIN_PROVIDER [ integer, nproc ]
-  use omp_lib
   implicit none
   BEGIN_DOC
   ! Number of current OpenMP threads
   END_DOC
 
+  integer                        :: omp_get_num_threads
   nproc = 1
   !$OMP PARALLEL
   !$OMP MASTER