mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-22 03:23:29 +01:00
forked v
This commit is contained in:
Abdallah Ammar
parent
069d673e0a
commit
d919d6ce7d
579
external/Python/docopt.py
vendored
Normal file
579
external/Python/docopt.py
vendored
Normal file
@ -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()
|
||||
617
include/f77_zmq.h
Normal file
617
include/f77_zmq.h
Normal file
@ -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
|
||||
@ -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.")
|
||||
)
|
||||
;;
|
||||
|
||||
|
||||
|
||||
@ -59,8 +59,6 @@ let () =
|
||||
*)
|
||||
|
||||
|
||||
exception Error of string
|
||||
|
||||
type short_opt = char
|
||||
|
||||
type long_opt = string
|
||||
|
||||
113
ocaml/Input_ao_two_e_eff_pot.ml
Normal file
113
ocaml/Input_ao_two_e_eff_pot.ml
Normal file
@ -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
|
||||
87
ocaml/Input_bi_ortho_mos.ml
Normal file
87
ocaml/Input_bi_ortho_mos.ml
Normal file
@ -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
|
||||
113
ocaml/Input_cassd.ml
Normal file
113
ocaml/Input_cassd.ml
Normal file
@ -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
|
||||
243
ocaml/Input_cipsi_deb.ml
Normal file
243
ocaml/Input_cipsi_deb.ml
Normal file
@ -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
|
||||
351
ocaml/Input_tc_h_clean.ml
Normal file
351
ocaml/Input_tc_h_clean.ml
Normal file
@ -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
|
||||
143
ocaml/Input_tc_scf.ml
Normal file
143
ocaml/Input_tc_scf.ml
Normal file
@ -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
|
||||
@ -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 ;
|
||||
|
||||
@ -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 )
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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) ]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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) ]
|
||||
|
||||
@ -1,2 +1,3 @@
|
||||
ao_basis
|
||||
pseudo
|
||||
cosgtos_ao_int
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
191
src/ao_two_e_ints/test_cosgtos_1e.irp.f
Normal file
191
src/ao_two_e_ints/test_cosgtos_1e.irp.f
Normal file
@ -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
|
||||
|
||||
! ---
|
||||
165
src/ao_two_e_ints/test_cosgtos_2e.irp.f
Normal file
165
src/ao_two_e_ints/test_cosgtos_2e.irp.f
Normal file
@ -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
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 '
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -2,4 +2,5 @@ perturbation
|
||||
zmq
|
||||
mpi
|
||||
iterations
|
||||
two_body_rdm
|
||||
csf
|
||||
|
||||
@ -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)') '--------------------------------------------------------------------------------'
|
||||
|
||||
183
src/cipsi/pert_rdm_providers.irp.f
Normal file
183
src/cipsi/pert_rdm_providers.irp.f
Normal file
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)') '--------------------------------------------------------------------------------'
|
||||
|
||||
223
src/cipsi/update_2rdm.irp.f
Normal file
223
src/cipsi/update_2rdm.irp.f
Normal file
@ -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
|
||||
|
||||
|
||||
@ -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')
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,7 +0,0 @@
|
||||
[energy]
|
||||
type: double precision
|
||||
doc: Variational |CIS| energy
|
||||
interface: ezfio
|
||||
size: (determinants.n_states)
|
||||
|
||||
|
||||
@ -1,3 +0,0 @@
|
||||
selectors_full
|
||||
generators_full
|
||||
davidson_undressed
|
||||
@ -1,5 +0,0 @@
|
||||
===
|
||||
cis_read
|
||||
===
|
||||
|
||||
Reads the input WF and performs all singles on top of it.
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
608
src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f
Normal file
608
src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f
Normal file
@ -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
|
||||
|
||||
! ---
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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()
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
13
src/dft_utils_func/mu_rsc.irp.f
Normal file
13
src/dft_utils_func/mu_rsc.irp.f
Normal file
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user