LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

Merge pull request #55 from scemama/master 

merge
This commit is contained in:
Emmanuel Giner 2019-01-14 23:16:33 +01:00 committed by GitHub
parent 7d4690a669 fedca82f17
commit 1e2ad83cee
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
293 changed files with 6136 additions and 5548 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
configure vendored
View File

@ -3,59 +3,76 @@
# Quantum Package configuration script
#
TEMP=`getopt -o c:i:h -l config:,install:,help -n $0 -- "$@"` || exit 1
eval set -- "$TEMP"
export QP_ROOT="$( cd "$(dirname "$0")" ; pwd -P )"
echo "QP_ROOT="$QP_ROOT
help()
function help()
{
cat <<EOF
Quantum Package configuration script.
Usage:
configure -c <file> | --config <file>
configure -h | --help
configure -i <package> | --install <package>
$(basename $0) -c <file> | --config=<file>
$(basename $0) -h | --help
$(basename $0) -i <package> | --install=<package>
Options:
-c <file>, --config <file> define a configuration file, in
"${QP_ROOT}/config/".
-h, --help print the help message
-i <package>, --install <package> install <package>. Use at your own
risk: no support will be provided
for the installation of dependencies.
-c, --config=<file> Define a configuration file, in "${QP_ROOT}/config/".
-h, --help Print the help message
-i, --install=<package> Install <package>. Use at your own risk:
no support will be provided for the installation of dependencies.
Example:
./configure -c config/gfortran.cfg
./$(basename $0) -c config/gfortran.cfg
Note:
- Users are encouraged to create their own configuration files instead of
modifying the existing ones.
Users are encouraged to create their own configuration files instead of
modifying the existing ones.
EOF
exit
}
function error() {
>&2 echo "$(basename $0): $@"
exit 2
}
PACKAGES=""
OCAML_PACKAGES="ocamlbuild cryptokit zmq core sexplib ppx_sexp_conv ppx_deriving getopt"
while : ; do
while true : ; do
case "$1" in
"")
break;;
-c|--config)
CONFIG="$2"
shift;;
-c|--config)
case "$2" in
"") help ; break;;
*) if [[ -f $2 ]] ; then
CONFIG="$2"
else
error "error: configuration file not accessible"
exit 1
fi
esac
shift 2;;
-i|--install)
PACKAGES="${PACKAGE} $2"
shift;;
-h|-help|--help)
help;;
case "$2" in
"") help ; break;;
*) PACKAGES="${PACKAGE} $2"
esac
shift 2;;
-h|-help|--help)
help
exit 0;;
--) shift ; break ;;
*)
echo "unknown option $1, try --help"
error $(basename $0)": unknown option $1, try --help"
exit 2;;
esac
shift
done
# Trim leading and trailing spaces
@ -78,21 +95,20 @@ function success() {
exit 1
}
function error() {
echo "Error : $1"
exit 2
}
function download() {
wget --no-check-certificate $1 --output-document=$2 || error "Unable to download $1"
}
function not_found() {
echo 'not_found'
}
function find_exe() {
which $1 2> /dev/null || echo 'not_found'
which $1 2> /dev/null || not_found
}
function find_python_lib() {
python2 -c "import $1" &> /dev/null && echo "$1" || echo 'not_found'
python2 -c "import $1" &> /dev/null && echo "$1" || not_found
}
function find_lib() {
@ -103,7 +119,7 @@ function find_lib() {
echo "$lib"
else
rm "${QP_ROOT}"/external/tmp.c
echo "not_found"
not_found
fi
}
@ -111,7 +127,7 @@ function find_dir() {
if [[ -d $1 ]] ; then
echo "$1"
else
echo "not_found"
not_found
fi
}
@ -216,7 +232,10 @@ EOF
else
# Conventional commands
export OPAMROOT=${OPAMROOT:-${QP_ROOT}/external/opam}
echo "QP>> Please install it here: " ${QP_ROOT}/bin
echo "======================================================== "
echo ""
echo "|QP> Please install it here: " ${QP_ROOT}/bin
echo ""
sh ${QP_ROOT}/external/opam_installer.sh
fi
source ${OPAMROOT}/opam-init/init.sh > /dev/null 2> /dev/null || true
@ -301,62 +320,62 @@ done
NINJA=$(find_exe ninja)
if [[ ${NINJA} = not_found ]] ; then
echo "ninja is not installed."
if [[ ${NINJA} = $(not_found) ]] ; then
error "Ninja is not installed."
fail
fi
IRPF90=$(find_exe irpf90)
if [[ ${IRPF90} = not_found ]] ; then
echo "irpf90 is not installed."
if [[ ${IRPF90} = $(not_found) ]] ; then
error "IRPf90 is not installed."
fail
fi
ZEROMQ=$(find_lib -lzmq)
if [[ ${ZEROMQ} = not_found ]] ; then
echo "zeromq is not installed."
if [[ ${ZEROMQ} = $(not_found) ]] ; then
error "ZeroMQ is not installed."
fail
fi
F77ZMQ=$(find_lib -lzmq -lf77zmq)
if [[ ${F77ZMQ} = not_found ]] ; then
echo "Fortran binding of ZeroMQ (f77zmq) is not installed."
if [[ ${F77ZMQ} = $(not_found) ]] ; then
error "Fortran binding of ZeroMQ (f77zmq) is not installed."
fail
fi
OPAM=$(find_exe opam)
if [[ ${OPAM} = not_found ]] ; then
echo "OPAM (ocaml) package manager is not installed."
if [[ ${OPAM} = $(not_found) ]] ; then
error "OPAM (ocaml) package manager is not installed."
fail
fi
OCAML=$(find_exe ocaml)
if [[ ${OCAML} = not_found ]] ; then
echo "OCaml compiler is not installed."
if [[ ${OCAML} = $(not_found) ]] ; then
error "OCaml compiler is not installed."
fail
fi
EZFIO=$(find_dir "${QP_ROOT}"/external/ezfio)
if [[ ${EZFIO} = not_found ]] ; then
echo "ezfio is not installed."
if [[ ${EZFIO} = $(not_found) ]] ; then
error "EZFIO is not installed."
fail
fi
EMSL=$(find_dir "${QP_ROOT}"/external/emsl)
if [[ ${EMSL} = not_found ]] ; then
echo "emsl is not installed."
if [[ ${EMSL} = $(not_found) ]] ; then
error "EMSL is not installed."
fail
fi
DOCOPT=$(find_python_lib docopt)
if [[ ${DOCOPT} = not_found ]] ; then
echo "docopt is not installed."
if [[ ${DOCOPT} = $(not_found) ]] ; then
error "docopt is not installed."
fail
fi
RESULTSFILE=$(find_python_lib resultsFile)
if [[ ${RESULTSFILE} = not_found ]] ; then
echo "resultsFile is not installed."
if [[ ${RESULTSFILE} = $(not_found) ]] ; then
error "resultsFile is not installed."
fail
fi

98
docs/source/programmers_guide/conventions.rst Normal file
View File

@ -0,0 +1,98 @@
==================
Coding conventions
==================
General conventions
===================
All executable files should have a name with lowercase.
Tabs are forbidden everywhere.
Try to set the maximum line length to 80 characters. Long lines can be
automatically reformatted in vim by pressing :kbd:`gqj`.
Use blank lines between blocks to improve readability.
For existing files, stay faithful to the existing indentation.
Shell scripts
=============
Executables should have no extension. To know if the file is binary, or in
what shell scripting language it was written, the :command:`file` command can
be used. In addition, all the shell scripts should be under
:file:`${QP_ROOT}/scripts/`.
The exit code of the script should be 0 upon success only.
Bash and Python2 are the only shell scripting language permitted for
executables.
Bash
----
* Bash scripts should start with ``#!/bin/bash``
* All error messages should go to standard error, and should be prefixed with
the name of the command. For example, in Bash use
.. code:: bash
function echo_err() {
2>& echo $(basename $0)": error"
}
* The command-line options should be handled with ``getopt``.
* The script should check that the command-line arguments are consistent.
* Long options should be preferred to short options.
* Always quote strings containing variables, command substitutions, spaces or
shell meta characters, unless careful unquoted expansion is required.
* Use ``"$@"`` unless you have a specific reason to use ``$*``.
* Use ``$(command)`` instead of backticks, because they can be easily nested.
* ``[[ ... ]]`` is preferred over ``[``, ``test`` and ``/usr/bin/[``.
* Declare function-specific variables with local. Declaration and assignment
should be on different lines.
* Pipelines should be split one per line if they don't all fit on one line.
* Put ``; do`` and ``; then`` on the same line as the ``while``, ``for`` or ``if``.
Python
------
Only Python2 is supported. The reason is that some dependencies use Python2,
and we do not want yet to add an extra dependency to Python3.
Python scripts should start with ``#!/usr/bin/env python2`` to mention
explicitly that Python2 has to be used.
:command:`pylint` should be used to increase the quality of the source code.
IRPF90
======
The code can be automatically indented with :command:`irp_indent`.
Mathematical formulas in the `BEGIN_DOC...END_DOC` sections sould be written
in LaTeX format, between `$` symbols.
Providers should never be present in the same file as a main program.

21
docs/source/users_guide/qp_convert_output_to_ezfio.rst
View File

@ -6,27 +6,32 @@ qp_convert_output_to_ezfio
.. program:: qp_convert_output_to_ezfio
This Python script uses the `resultsFile`_ Python library to gather the
geometry, |AOs| and |MOs| from output files of |GAMESS| or Gaussian, and
puts this data in an |EZFIO| database. Some constraints are necessary in the
output file : the run needs to be a single point |HF|, |DFT| or |CAS| |SCF|.
geometry, |AOs| and |MOs| from output files of |GAMESS| or Gaussian, and puts
this data in an |EZFIO| database. Some constraints are necessary in the output
file : the run needs to be a single point |HF|, |DFT| or |CAS| |SCF|.
Usage
-----
.. code:: bash
qp_convert_output_to_ezfio <FILE.out> [-o <EZFIO_DIRECTORY>]
qp_convert_output_to_ezfio [-o EZFIO_DIR] FILE
.. option:: -o <EZFIO_DIRECTORY>
.. option:: -o, --output=EZFIO_DIR
Renames the |EZFIO| directory. If this option is not present, the default
name fill be :file:`<FILE.out>.ezfio`
Renames the |EZFIO| directory. If this option is not present, the default
name fill be :file:`FILE.ezfio`
.. note::
The following keywords are necessary for Gaussian ::
All the parameters of the wave functgion need to be presente in the output
file : complete description of the |AO| basis set, full set of molecular
orbitals, etc.
The following keywords are necessary for GAU$$IAN ::
GFPRINT pop=Full
Example
-------

75
docs/source/users_guide/qp_create_ezfio_from_xyz.rst
View File

@ -13,12 +13,16 @@ Usage
.. code:: bash
qp_create_ezfio_from_xyz [FLAGS] (<xyz_file> | <zmt_file>)
Flags :
-b [-au] [-c int] [-cart] [-d float]
[-m int] [-o file] [-p string] [-help]
qp_create_ezfio_from_xyz [-a] -b <string> [-c <int>] [-d <float>]
[-h] [-m <int>] [-o EZFIO_DIR] [-p <string>] [-x] [--] FILE
.. option:: -b <basis_name>
.. option:: -a, --au
If present, input geometry is in atomic units.
.. option:: -b, --basis=<string>
Name of basis set. The basis set is defined as a single string if all the
atoms are taken from the same basis set, otherwise specific elements can be
@ -28,39 +32,45 @@ Usage
-b "cc-pvtz | 1,H:sto-3g | 3,H:6-31g"
By default, the basis set is obtained from the local database of the |qp|.
This option is mandatory.
If ``<string>`` is set to ``show``, the list of all available basis sets is
displayed.
.. option:: -au
If present, input geometry is in atomic units.
.. option:: -c <float>
.. option:: -c, --charge=<int>
Total charge of the molecule. Default is 0.
.. option:: -cart
Compute |AOs| in the Cartesian basis set (6d, 10f, ...)
.. option:: -d, --dummy=<float>
.. option:: -d <float>
Add dummy atoms (X) between atoms when the distance between two atoms
is less than :math:`x \times \sum R_\mathrm{cov}`, the covalent radii
of the atoms. The default is x=0, so no dummy atom is added.
Add dummy atoms. x * (covalent radii of the atoms)
.. option:: -m <int>
.. option:: -h, --help
Spin multiplicity (2S+1) of the molecule. Default is 1.
Print the help text and exit
.. option:: -o <EZFIO_DIRECTORY>
.. option:: -m, --multiplicity=<int>
Spin multiplicity :math:`2S+1` of the molecule. Default is 1.
.. option:: -o, --output=EZFIO_DIR
Name of the created |EZFIO| directory.
.. option:: -p <string>
.. option:: -p <string>, --pseudo=<string>
Name of the pseudo-potential
Name of the pseudo-potential. Follows the same conventions as the basis set.
.. option:: -help, -?
.. option:: -x, --cart
Print the help text and exit
Compute |AOs| in the Cartesian basis set (6d, 10f, ...)
Using custom atomic basis sets
@ -73,8 +83,8 @@ and the *xyz* geometry is in ``molecule.xyz``, the following should be used::
qp_create_ezfio_from_xyz -b custom.basis molecule.xyz
Basis set files should be given in |GAMESS| format, where the full names of the
atoms are given, and the basis sets for each element are separated by a blank line.
Here is an example ::
atoms are given, and the basis sets for each element are separated by a blank
line. Here is an example ::
HYDROGEN
S 3
@ -121,22 +131,21 @@ Using custom pseudo-potentials
------------------------------
As for the basis set, if a file with the same name as the pseudo-potential
exists, this file will be read.
For example, if the file containing the custom pseudo-potential is named
``custom.pseudo``, the basis set is named ``custom.basis``, and the *xyz*
geometry is in ``molecule.xyz``, the following command should be used
exists, this file will be read. For example, if the file containing the custom
pseudo-potential is named ``custom.pseudo``, the basis set is named
``custom.basis``, and the *xyz* geometry is in ``molecule.xyz``, the following
command should be used
.. code:: bash
qp_create_ezfio_from_xyz -b custom.basis -p custom.pseudo molecule.xyz
Pseudo-potential files should be given in a format very close to |GAMESS|
format. The first line should be formatted as ``%s GEN %d %d`` where the
first string is the chemical symbol, the first integer is the number of
core electrons to be removed and the second integer is LMAX+1 as in |GAMESS|
format.
The pseudo-potential for each element are separated by a blank line.
Here is an example ::
format. The first line should be formatted as ``%s GEN %d %d`` where the first
string is the chemical symbol, the first integer is the number of core
electrons to be removed and the second integer is LMAX+1 as in |GAMESS| format.
The pseudo-potential for each element are separated by a blank line. Here is
an example ::
Ne GEN 2 1
3

48
docs/source/users_guide/qp_edit.rst
View File

@ -8,14 +8,15 @@ qp_edit
This command reads the content of the |EZFIO| directory and creates a temporary
file containing the data. The data is presented as a *ReStructured Text* (rst)
document, where each section corresponds to the corresponding |qp| module.
The content of the file can be modified to change the input parameters. When
the text editor is closed, the updated data is saved into the |EZFIO| directory.
file containing the data. The data is presented as a *ReStructured Text* (rst)
document, where each section corresponds to the corresponding |qp| module. The
content of the file can be modified to change the input parameters. When the
text editor is closed, the updated data is saved into the |EZFIO| directory.
.. note::
The text editor which will be opened is defined by the :envvar:`EDITOR`
environment variable.
environment variable. If this variable is not set, the :command:`vi`
text editor will be used by default.
.. warning::
When the wave function is too large (more than 10 000 determinants), the
@ -26,36 +27,33 @@ Usage
.. code:: bash
qp_edit [FLAGS] <EZFIO_DIRECTORY>
Flags :
[-c] [-ndet int]
[-state int] [-help]
qp_edit [-c] [-h] [-n <int>] [-s <range>] [--] EZFIO_DIR
.. option:: -c
.. option:: -c, --check
Checks the input data
.. option:: -ndet <int>
Truncates the wavefunction to the target number of determinants
.. option:: -state <int>
Pick the target state as a new wavefunction.
.. option:: -help
.. option:: -h, --help
Print the help text and exits
.. option:: -n, --ndet=<int>
Here is a short list of important control parameters :
Truncates the wavefunction to the target number of determinants
.. option:: read_wf
.. option:: -s, --state=<range>
If ``false``, initialize the calculation with a single-determinant wave
function. If ``true``, initialize the calculation with the wave function stored
in the |EZFIO| directory.
Select the states to extract from the |EZFIO| directory, using the same conventions
as :ref:`qp_set_mo_class`. See example below.
Example
-------
.. code:: bash
qp_edit --state="[1,3-5]" test.ezfio
Removes all states except states 1,3,4 and 5 from :file:`test.ezfio`. The
resulting |EZFIO| directory has 4 states.

19
docs/source/users_guide/qp_export_as_tgz.rst
View File

@ -4,22 +4,27 @@ qp_export_as_tgz
.. program:: qp_export_as_tgz
In some HPC facilities, the access to the internet is limited for security reasons.
In such an environment, the installation of |QP| is sometimes very painful because
the OCaml compiler and the libraries can't be installed by a non-root user.
In some HPC facilities, the access to the internet is limited for security
reasons. In such an environment, the installation of |QP| is sometimes very
painful because the OCaml compiler and the libraries can't be installed by a
non-root user.
This command creates a self-contained binary distribution in the form of a `tar.gz` file
that can be copied on another machine.
This command creates a self-contained binary distribution in the form of a
`tar.gz` file that can be copied on another machine.
Usage
-----
.. code:: bash
qp_export_as_tgz
qp_export_as_tgz [-h|--help]
.. option:: -h, --help
Prints the help message
.. note::
There can be conflicts due to the version of Glibc. The machine on which |QP| is
There can be conflicts due to the version of glibc. The machine on which |QP| is
compiled should be the oldest one.

52
docs/source/users_guide/qp_plugins.rst
View File

@ -6,34 +6,34 @@ qp_plugins
.. program:: qp_plugins
This command deals with all external plugins of |qp|. Plugin repositories can
This command deals with all external plugins of |qp|. Plugin repositories can
be downloaded, and the plugins in these repositories can be
installed/uninstalled of created.
installed/uninstalled or created.
Usage
-----
.. code:: bash
qp_plugins list [ -i | -u | -q ]
qp_plugins list [-i] [-u] [-q]
qp_plugins download <url>
qp_plugins install <name>...
qp_plugins uninstall <name>
qp_plugins create -n <name> [-r <repository>] [<needed_modules>...]
qp_plugins create -n <name> [-r <repo>] [<needed_modules>...]
.. option:: list
List all the available plugins.
.. option:: -i
.. option:: -i, --installed
List all the *installed* plugins.
.. option:: -u
.. option:: -u, --uninstalled
List all the *uninstalled* plugins.
.. option:: -q
.. option:: -q, --repositories
List all the downloaded repositories.
@ -53,11 +53,11 @@ Usage
Uninstall the plugin ``plugin_name``.
.. option:: -n <plugin_name>
.. option:: -n, --name=<plugin_name>
Create a new plugin named ``plugin_name`` (in local repository by default).
.. option:: -r <repository>
.. option:: -r, --repository=<repo>
Specify in which repository the new plugin will be created.
@ -66,45 +66,49 @@ Usage
Example
-------
Let us download, install and compile some specific external plugins from `<https://gitlab.com/eginer/qp_plugins_eginer>`_ .
Let us download, install and compile some specific external plugins from
`<https://gitlab.com/eginer/qp_plugins_eginer>`_ .
First, download the git repo associated to these plugins. To do so, first go to the `plugins` directory in the |QP| and execute:
First, download the git repo associated to these plugins. To do so, first go
to the `plugins` directory in the |QP| and execute:
.. code:: bash
qp_plugins download https://gitlab.com/eginer/qp_plugins_eginer
This will create in the directory `plugins` a local copy of the git repo located at the URL you indicated.
Then, go in `qp_plugins_eginer/stable/`
This will create in the directory `plugins` a local copy of the git repo
located at the URL you indicated. Then, go in `qp_plugins_eginer/stable/`
.. code:: bash
cd qp_plugins_eginer/stable/
In the directory `stable`, there are many directories which all correspond to a specific plugin that have been developed
by the person in charge of the git repo. All these plugins might use some global variables and routines contained
In the directory `stable`, there are many directories which all correspond to a
specific plugin that have been developed by the person in charge of the git
repo. All these plugins might use some global variables and routines contained
in the core modules of the |QP|.
Now let us install the plugin `rsdft_cipsi`:
.. code:: bash
qp_plugins install rsdft_cipsi
This will link this directory to the |QP| which means that when the code will be compiled, this plugin will be compiled to and therefore
all the executables/scripts/input keywords contained in this module will be available as if there were part of the core of the |QP|.
This will link this directory to the |QP| which means that when the code will
be compiled, this plugin will be compiled to and therefore all the
executables/scripts/input keywords contained in this module will be available
as if there were part of the core of the |QP|.
Then, to compile the new plugin, just recompile the |QP| as usual by going at the root of the |QP| directory:
Then, to compile the new plugin, just recompile the |QP| as usual by going at
the root of the |QP| directory:
.. code:: bash
cd $QP_ROOT
ninja
Then, if you go back to the plugin directory you just installed, you should see all the executables/scripts which have been created and
which are now available with the `qp_run` command.
Finally, if you go back to the plugin directory you just installed, you should see
all the executables/scripts which have been created and which are now available
with the `qp_run` command.

4
docs/source/users_guide/qp_run.rst
View File

@ -1,5 +1,6 @@
.. _qp_run:
======
qp_run
======
@ -14,8 +15,7 @@ Usage
.. code:: bash
qp_run [-h|--help] [-p <string>|--prefix=<string>] [-s|--slave] [--]
PROGRAM EZFIO_DIR
qp_run [-h] [-p <string>] [-s] [--] PROGRAM EZFIO_DIR
``PROGRAM`` is the name of the |QP| program to be run, and ``EZFIO_DIR`` is
the name of the |EZFIO| directory containing the data.

2
docs/source/users_guide/qp_set_frozen_core.rst
View File

@ -21,7 +21,7 @@ Usage
.. code:: bash
qp_set_frozen_core [-q] <EZFIO_DIRECTORY>
qp_set_frozen_core [-q] EZFIO_DIR
.. option:: -q

24
docs/source/users_guide/qp_set_mo_class.rst
View File

@ -38,38 +38,32 @@ Usage
.. code:: bash
qp_set_mo_class [FLAGS] <EZFIO_DIRECTORY>
Flags:
[-act range] [-core range] [-del range]
[-inact range] [-q] [-virt range]
[-help]
qp_set_mo_class [-a <range>] [-c <range>] [-d <range>] [-h] [-i <range>]
[-q] [-v <range>] [--] EZFIO_DIR
.. option:: -act <range>
.. option:: -a, --act=<range>
Range of active orbitals
.. option:: -core <range>
.. option:: -c, --core=<range>
Range of core orbitals
.. option:: -del <range>
.. option:: -d, --del=<range>
Range of deleted orbitals
.. option:: -inact <range>
.. option:: -i, --inact=<range>
Range of inactive orbitals
.. option:: -q
.. option:: -q, --query
Query: print the current masks
Print the |MO| classes
.. option:: -virt <range>
.. option:: -v, --virt=<range>
Range of virtual orbitals
.. option:: -help, -?

8
etc/autocomplete.rc Normal file
View File

@ -0,0 +1,8 @@
# Required for completion with zsh
if [[ "$(ps -p $$ -ocomm=)" == "zsh" ]] ; then
autoload bashcompinit
bashcompinit
fi

35
etc/configure.rc Normal file
View File

@ -0,0 +1,35 @@
# Completion for the configrue command with possible configurations
source ${QP_ROOT}/etc/autocomplete.rc
_Complete()
{
local cur
COMPREPLY=()
cur="${COMP_WORDS[COMP_CWORD]}"
prev="${COMP_WORDS[COMP_CWORD-1]}"
case "${prev}" in
-h|--help)
COMPREPLY=( $(compgen -W "" -- $cur ) )
return 0
;;
-i)
COMPREPLY=( $(compgen -W "bats docopt emsl ezfio f77zmq irpf90 ninja\
ocaml resultsFile zeromq" -- $cur ) )
return 0
;;
-c)
COMPREPLY=( $(compgen -W "$(echo config/*.cfg ./*.cfg)" -- $cur ) )
return 0
;;
*)
COMPREPLY=( $(compgen -W "-h --help -c -i" -- $cur ) )
return 0
;;
esac
}
complete -F _Complete configure

10
etc/ezfio.rc
View File

@ -2,15 +2,13 @@
export QP_EZFIO=${QP_ROOT}/external/ezfio
function source_if_exists() {
if [[ -f $1 ]]; then
if [[ "$(ps -p $$ -ocomm=)" == "zsh" ]] ; then
autoload bashcompinit
bashcompinit
fi
source $1
fi
cd $(dirname $1) ; source $(basename $1) ; cd -
fi &> /dev/null
}
source ${QP_ROOT}/etc/autocomplete.rc
source_if_exists "${QP_EZFIO}/Bash/ezfio.sh"

10
etc/irpf90.rc
View File

@ -8,14 +8,12 @@ export IRPF90=${IRPF90_PATH}/bin/irpf90
function source_if_exists() {
if [[ -f $1 ]]; then
if [[ "$(ps -p $$ -ocomm=)" == "zsh" ]] ; then
autoload bashcompinit
bashcompinit
fi
source $1
fi
cd $(dirname $1) ; source $(basename $1) ; cd -
fi &> /dev/null
}
source ${QP_ROOT}/etc/autocomplete.rc
source_if_exists "${IRPF90_PATH}/irpman-completions.bash"

169
etc/qp.rc
View File

@ -20,23 +20,20 @@ Usage:
qp set DIRECTORY ITEM : Array values read from stdin
qp run PROGRAM
qp man PROGRAM
qp srun PROGRAM
qp mpirun PROGRAM
qp set_frozen_core
qp create_ezfio_from_xyz --help
qp convert_output_to_ezfio --help
qp set_mo_class --help
qp create_ezfio_from_xyz
qp convert_output_to_ezfio
qp update
qp set_mo_class
qp plugins
"
}
#function test_ezfio()
#{
# if [[ ! -d ${EZFIO_FILE} ]] ; then
# echo "qp: cannot access ${EZFIO_FILE}: No such file or directory"
# return 1
# fi
#}
function qp()
{
@ -52,13 +49,22 @@ function qp()
"create_ezfio_from_xyz")
shift
NAME=$(qp_create_ezfio_from_xyz "$@")
# Replace ':' by spaces
for arg in $@ ; do
if [[ $arg =~ -* ]] ; then
_ARGS+=("\"${arg//:/ }\"")
else
_ARGS+=("${arg}")
fi
done
NAME=$(eval "qp_create_ezfio_from_xyz ${_ARGS}")
if [[ -d $NAME ]] ; then
[[ -d $EZFIO_FILE ]] && ezfio unset_file
ezfio set_file $NAME
else
echo $NAME | more
fi
unset _ARGS
;;
"convert_output_to_ezfio")
@ -105,10 +111,19 @@ function qp()
printf "\e[0;31m|${EZFIO_FILE}>\e[m"
fi
}
# PS1="${PS1%\\\$ } \$(_check_ezfio) $ "
PS1="\$(_check_ezfio)\n$PS1"
;;
"plugins")
shift
qp_plugins $@
;;
"update")
shift
qp_update $@
;;
*)
_qp_usage
;;
@ -117,60 +132,144 @@ function qp()
}
function _get_basis_sets () {
( qp_create_ezfio_from_xyz -b show \
| tr ' ' ':' \
| while IFS= read -r LINE ; do
printf '%s\n' ${LINE}
done
(cd ~/quantum_package/data/basis/ ; \ls)
) | sort | uniq
}
_Complete()
{
local cur
COMPREPLY=()
cur="${COMP_WORDS[COMP_CWORD]}"
first="${COMP_WORDS[1]}"
prev="${COMP_WORDS[COMP_CWORD-1]}"
prev2="${COMP_WORDS[COMP_CWORD-2]}"
case "${first}" in
update)
COMPREPLY=( $(compgen -W "-h" -- $cur ) )
return 0
;;
man)
COMPREPLY=( $(compgen -W "$(cd ${QP_ROOT}/man ; \ls | sed 's/\.1//')" -- $cur ) )
return 0
;;
convert_output_to_ezfio)
COMPREPLY=( $(compgen -W "-o $(\ls)" -- ${cur} ) )
return 0
;;
create_ezfio_from_xyz)
case "${prev}" in
create_ezfio_from_xyz)
COMPREPLY=( $(compgen -W "-b -a -c -d -h -m -o -p -x" -- $cur ) )
return 0
;;
-m|-d|-c)
COMPREPLY=( $(compgen -W "" -- $cur ) )
return 0;;
-b)
for iter in $(_get_basis_sets); do
if [[ $iter =~ ^$cur ]]; then
COMPREPLY+=( "${iter}" )
fi
done;
return 0
;;
-p)
COMPREPLY=( $(compgen -W "$(cd ~/quantum_package/data/pseudo ; \ls)" -- $cur ) )
return 0
;;
*)
COMPREPLY=( $(compgen -W "-b -a -c -d -h -m -o -p -x $(\ls)" -- $cur ) )
return 0
;;
esac;;
plugins)
case "${prev}" in
plugins)
COMPREPLY=( $(compgen -W "list download install uninstall create" -- $cur ) )
return 0
;;
list)
COMPREPLY=( $(compgen -W "-i -u -q" -- $cur ) )
return 0;;
download)
COMPREPLY=( $(compgen -W "http:// git@github.com: git@gitlab.com: " -- $cur ) )
return 0;;
install)
COMPREPLY=( $(compgen -W "$(qp_plugins list -u)" -- $cur ) )
return 0;;
uninstall)
COMPREPLY=( $(compgen -W "$(qp_plugins list -i)" -- $cur ) )
return 0;;
create)
COMPREPLY=( $(compgen -W "-n " -- $cur ) )
return 0;;
*)
COMPREPLY=( $(compgen -W "$( \ls ; cd ~/quantum_package/src ; \ls )" -- $cur ) )
return 0
;;
esac;;
*)
COMPREPLY=( $(compgen -W 'plugins \
man \
create_ezfio_from_xyz \
convert_output_to_ezfio \
-h update' -- $cur ) )
esac
if [[ -n ${EZFIO_FILE} && -d ${EZFIO_FILE} ]]
then
case "${prev2}" in
"set"|has|get)
if [[ ${prev} == "qp" ]] ; then
COMPREPLY=( $(compgen -W "set set_frozen_core set_mo_class" -- $cur ) )
COMPREPLY=( $(compgen -W "plugins set set_frozen_core set_mo_class" -- $cur ) )
elif [[ ! -d ${EZFIO_FILE}/${prev} ]] ; then
COMPREPLY=( $(compgen -W "" -- $cur ) )
else
COMPREPLY=( $(compgen -W "$(cd ${EZFIO_FILE}/${prev} ; ls | sed 's/\.gz//' )" -- $cur ) )
COMPREPLY=( $(compgen -W "$(cd ${EZFIO_FILE}/${prev} ; \ls | sed 's/\.gz//' )" -- $cur ) )
fi
return 0
;;
*)
COMPREPLY=( $(compgen -W "$(\ls)" -- $cur ) )
esac
case "${prev}" in
case "${first}" in
run|srun|mpirun)
COMPREPLY=( $(compgen -W "$(cat ${QP_ROOT}/data/executables | cut -d ' ' -f 1)" -- $cur ) )
COMPREPLY=( $(compgen -W "-h $(cat ${QP_ROOT}/data/executables | cut -d ' ' -f 1)" -- $cur ) )
return 0
;;
unset_file|edit|set_frozen_core)
unset_file|set_frozen_core)
COMPREPLY=()
return 0
;;
set_mo_class)
COMPREPLY=( $(compgen -W "-h -core -inact -act -virt -del" -- $cur ) )
return 0
;;
man)
COMPREPLY=( $(compgen -W "$(cd ${QP_ROOT}/man ; \ls | sed '/\.[1-9] / /')" -- $cur ) )
COMPREPLY=( $(compgen -W "-h -c -i -a -v -d -q" -- $cur ) )
return 0
;;
set|has|get)
COMPREPLY=( $(compgen -W "$(cd ${EZFIO_FILE} ; \ls -d */ | sed 's|/||g')" -- $cur ) )
return 0
;;
edit)
COMPREPLY=( $(compgen -W "-h -c -n -s" -- $cur ) )
return 0
;;
*)
COMPREPLY=( $(compgen -W 'has get set unset_file edit \
COMPREPLY+=( $(compgen -W 'has get set unset_file edit \
run srun mpirun set_frozen_core \
set_mo_class create_ezfio_from_xyz \
convert_output_to_ezfio \
-h' -- $cur ) )
set_mo_class ' \
-- $cur ) )
return 0
;;
esac
@ -178,24 +277,12 @@ _Complete()
else
case "${prev}" in
man)
COMPREPLY=( $(compgen -W "$(cd ${QP_ROOT}/man ; echo * | sed 's|\.[1-9] | |g')" -- $cur ) )
return 0
;;
set_file)
COMPREPLY=( $(compgen -W "$(\ls -d */ | sed 's|/||g')" -- ${cur} ) )
return 0
;;
convert_output_to_ezfio|create_ezfio_from_xyz)
COMPREPLY=( $(compgen -W "$(\ls)" -- ${cur} ) )
return 0
;;
*)
COMPREPLY=( $(compgen -W 'set_file \
man \
create_ezfio_from_xyz \
convert_output_to_ezfio \
-h' -- $cur ) )
COMPREPLY+=( $(compgen -W "set_file" -- $cur ) )
return 0
;;
esac

12
ocaml/Address.ml
View File

@ -1,8 +1,8 @@
module Tcp : sig
type t
type t
val of_string : string -> t
val to_string : t -> string
val to_string : t -> string
val create : host:string -> port:int -> t
end = struct
type t = string
@ -18,9 +18,9 @@ end = struct
end
module Ipc : sig
type t
type t
val of_string : string -> t
val to_string : t -> string
val to_string : t -> string
val create : string -> t
end = struct
type t = string
@ -33,9 +33,9 @@ end = struct
end
module Inproc : sig
type t
type t
val of_string : string -> t
val to_string : t -> string
val to_string : t -> string
val create : string -> t
end = struct
type t = string

4
ocaml/Atom.ml
View File

@ -28,7 +28,7 @@ let of_string ~units s =
}
| _ -> raise (AtomError s)
let to_string ~units a =
[ Element.to_string a.element ;
Charge.to_string a.charge ;
@ -37,7 +37,7 @@ let to_string ~units a =
let to_xyz a =
Printf.sprintf "%-3s %s"
Printf.sprintf "%-3s %s"
(Element.to_string a.element)
(Point3d.to_string ~units:Units.Angstrom a.coord)

2
ocaml/Atom.mli
View File

@ -1,6 +1,6 @@
exception AtomError of string
type t = { element : Element.t; charge : Charge.t; coord : Point3d.t; }
type t = { element : Element.t; charge : Charge.t; coord : Point3d.t; }
val t_of_sexp : Sexplib.Sexp.t -> t
val sexp_of_t : t -> Sexplib.Sexp.t

10
ocaml/Basis.ml
View File

@ -11,7 +11,7 @@ let read in_channel at_number =
read ( (gto,at_number)::result)
with
| Gto.End_Of_Basis -> List.rev result
in read []
in read []
(** Find an element in the basis set file *)
@ -32,22 +32,22 @@ let find in_channel element =
(** Read an element from the file *)
let read_element in_channel at_number element =
ignore (find in_channel element) ;
read in_channel at_number
read in_channel at_number
let to_string_general ~fmt ~atom_sep ?ele_array b =
let new_nucleus n =
let new_nucleus n =
match ele_array with
| None -> Printf.sprintf "Atom %d" n
| Some x -> Printf.sprintf "%s" (Element.to_string x.(n-1))
in
let rec do_work accu current_nucleus = function
| [] -> List.rev accu
| (g,n)::tail ->
| (g,n)::tail ->
let n = Nucl_number.to_int n
in
let accu =
let accu =
if (n <> current_nucleus) then
(new_nucleus n)::atom_sep::accu
else

12
ocaml/Bit.ml
View File

@ -1,16 +1,16 @@
open Core;;
(*
Type for bits
Type for bits
==============
Zero | One
*)
type t =
| One
| Zero
type t =
| One
| Zero
[@@deriving sexp]
let to_string = function
@ -18,14 +18,14 @@ let to_string = function
| One -> "1"
;;
let and_operator a b =
let and_operator a b =
match a, b with
| Zero, _ -> Zero
| _, Zero -> Zero
| _, _ -> One
;;
let or_operator a b =
let or_operator a b =
match a, b with
| One, _ -> One
| _, One -> One

50
ocaml/Bitlist.ml
View File

@ -11,7 +11,7 @@ list of Bits
type t = Bit.t list
(* String representation *)
let to_string b =
let to_string b =
let rec do_work accu = function
| [] -> accu
| head :: tail ->
@ -33,28 +33,28 @@ let of_string_mp s =
|> List.rev_map ~f:(function
| '-' -> Bit.Zero
| '+' -> Bit.One
| _ -> failwith ("Error in bitstring ") )
| _ -> failwith ("Error in bitstring ") )
(* Create a bit list from an int64 *)
let of_int64 i =
let of_int64 i =
let rec do_work accu = function
| 0L -> Bit.Zero :: accu |> List.rev
| 1L -> Bit.One :: accu |> List.rev
| i ->
| i ->
let b =
match (Int64.bit_and i 1L ) with
| 0L -> Bit.Zero
| 1L -> Bit.One
| _ -> raise (Failure "i land 1 not in (0,1)")
| 1L -> Bit.One
| _ -> raise (Failure "i land 1 not in (0,1)")
in
do_work (b :: accu) (Int64.shift_right_logical i 1)
in
let adjust_length result =
let adjust_length result =
let rec do_work accu = function
| 64 -> List.rev accu
| 64 -> List.rev accu
| i when i>64 -> raise (Failure "Error in of_int64 > 64")
| i when i<0 -> raise (Failure "Error in of_int64 < 0")
| i -> do_work (Bit.Zero :: accu) (i+1)
@ -75,13 +75,13 @@ let to_int64 l =
(* Create a bit list from a list of int64 *)
let of_int64_list l =
List.map ~f:of_int64 l
let of_int64_list l =
List.map ~f:of_int64 l
|> List.concat
(* Create a bit list from an array of int64 *)
let of_int64_array l =
Array.map ~f:of_int64 l
let of_int64_array l =
Array.map ~f:of_int64 l
|> Array.to_list
|> List.concat
@ -102,13 +102,13 @@ let zero n_int =
(* Create an int64 list from a bit list *)
let to_int64_list l =
let rec do_work accu buf counter = function
| [] ->
| [] ->
begin
match buf with
| [] -> accu
| _ -> (List.rev buf)::accu
end
| i::tail ->
| i::tail ->
if (counter < 64) then
do_work accu (i::buf) (counter+1) tail
else
@ -124,7 +124,7 @@ let to_int64_array l =
|> Array.of_list
(* Create a bit list from a list of MO indices *)
let of_mo_number_list n_int l =
let of_mo_number_list n_int l =
let n_int = N_int_number.to_int n_int in
let length = n_int*64 in
let a = Array.create length (Bit.Zero) in
@ -139,10 +139,10 @@ let to_mo_number_list l =
| 0 -> accu
| i ->
begin
let new_accu =
let new_accu =
match a.(i-1) with
| Bit.One -> (MO_number.of_int ~max:mo_num i)::accu
| Bit.Zero -> accu
| Bit.One -> (MO_number.of_int ~max:mo_num i)::accu
| Bit.Zero -> accu
in
do_work new_accu (i-1)
end
@ -154,11 +154,11 @@ let to_mo_number_list l =
(* logical operations on bit_list *)
let logical_operator2 op a b =
let rec do_work_binary result a b =
let rec do_work_binary result a b =
match a, b with
| [], [] -> result
| [], _ | _ , [] -> raise (Failure "Lists should have same length")
| (ha::ta), (hb::tb) ->
| (ha::ta), (hb::tb) ->
let newbit = op ha hb
in do_work_binary (newbit::result) ta tb
in
@ -166,10 +166,10 @@ let logical_operator2 op a b =
let logical_operator1 op b =
let rec do_work_unary result b =
let rec do_work_unary result b =
match b with
| [] -> result
| (hb::tb) ->
| (hb::tb) ->
let newbit = op hb
in do_work_unary (newbit::result) tb
in
@ -182,11 +182,11 @@ let or_operator a b = logical_operator2 Bit.or_operator a b
let not_operator b = logical_operator1 Bit.not_operator b
let popcnt b =
let popcnt b =
List.fold_left b ~init:0 ~f:(fun accu -> function
| Bit.One -> accu+1
| Bit.Zero -> accu
)
)

2
ocaml/Charge.ml
View File

@ -9,7 +9,7 @@ let of_string s = Float.of_string s
let to_float x = x
let to_int x = Float.to_int x
let to_string x =
let to_string x =
if x >= 0. then
Printf.sprintf "+%f" x
else

2
ocaml/Charge.mli
View File

@ -9,5 +9,5 @@ val to_int : t -> int
val of_int : int -> t
(** String conversion functions *)
val to_string: t -> string
val to_string: t -> string
val of_string: string -> t

292
ocaml/Command_line.ml
View File

@ -1,161 +1,199 @@
type argument = With_arg | Without_arg | With_opt_arg
type short_opt = char
type long_opt = string
type optional = Mandatory | Optional
type documentation = string
type argument = With_arg of string | Without_arg | With_opt_arg of string
let anon_args = ref []
type description = {
short: short_opt ;
long : long_opt ;
opt : optional ;
doc : documentation ;
arg : argument ;
}
let anon_args = ref []
and header_doc = ref ""
and description_doc = ref ""
and footer_doc = ref ""
and specs = ref []
and specs = ref []
let set_header_doc s = header_doc := s
let set_description_doc s = description_doc := s
let set_footer_doc s = footer_doc := s
let dict =
let d = Hashtbl.create 67 in
d
(* Hash table containing all the options *)
let dict = Hashtbl.create 67
let get x =
try Some (Hashtbl.find dict x)
with Not_found -> None
let get_bool x = Hashtbl.mem dict x
let get_bool x =
Hashtbl.mem dict x
let show_help () = get_bool "help"
let show_help () =
get_bool "help"
let get x =
try Some (Hashtbl.find dict x)
with Not_found -> None
let anonymous name opt doc =
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
let output_text t =
Format.printf "@[<v 0>";
begin
match Str.split (Str.regexp "\n") t with
| x :: [] -> Format.printf "@[<hov 0>";
Str.split (Str.regexp " ") x
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
Format.printf "@]"
| t -> List.iter (fun x ->
Format.printf "@[<hov 0>";
Str.split (Str.regexp " ") x
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
Format.printf "@]@;") t
end;
Format.printf "@]"
;;
let output_short x =
match x.short, x.opt, x.arg with
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
| ' ', Optional , _ -> Format.printf "@[[%s]@]" x.long
| _ , Mandatory, Without_arg -> Format.printf "@[-%c@]" x.short
| _ , Optional , Without_arg -> Format.printf "@[[-%c]@]" x.short
| _ , Mandatory, With_arg arg -> Format.printf "@[-%c %s@]" x.short arg
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
let output_long max_width x =
let arg =
match x.short, x.arg with
| ' ' , _ -> x.long
| _ , Without_arg -> x.long
| _ , With_arg arg -> Printf.sprintf "%s=%s" x.long arg
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
in
let long =
let l = String.length arg in
arg^(String.make (max_width-l) ' ')
in
Format.printf "@[<v 0>";
begin
match x.short with
| ' ' -> Format.printf "@[%s @]" long
| short -> Format.printf "@[-%c --%s @]" short long
end;
Format.printf "@]";
output_text x.doc
let anonymous ?(optional=false) name doc =
( ' ', name, doc,
if optional then With_opt_arg else Without_arg
)
let help () =
Format.printf "@[%s@]@.@." !header_doc;
let get_param_from_doc doc =
match Str.split (Str.regexp "[ \n\r\x0c\t]+") doc with
| param :: doc -> param, (String.concat " " doc)
| _ -> failwith "Bad format for documentation"
in
(* Print the header *)
output_text !header_doc;
Format.printf "@.@.";
let anon =
List.filter (fun (x,_,_,_) -> x = ' ') !specs
|> List.map (fun x ->
match x with
| (_,name,doc,Without_arg) -> (name,doc,false)
| (_,name,doc,_) -> (name,doc,true)
)
in
(* Find the anonymous arguments *)
let anon =
List.filter (fun x -> x.short = ' ') !specs
in
let options =
List.filter (fun (x,_,_,_) -> x <> ' ') !specs
|> List.sort (fun (x,_,_,_) (y,_,_,_) -> Char.compare x y)
|> List.map (fun x ->
match x with
| (short,long,doc,With_arg) -> (* with arg *)
let param, doc = get_param_from_doc doc in
(Printf.sprintf "-%c %s" short param,
Printf.sprintf "--%s=%s" long param,
doc)
| (short,long,doc,Without_arg) -> (* without arg *)
(Printf.sprintf "-%c" short,
Printf.sprintf "--%s" long,
doc)
| (short,long,doc,With_opt_arg) -> (* with or without arg *)
let param, doc = get_param_from_doc doc in
(Printf.sprintf "-%c [%s]" short param,
Printf.sprintf "--%s[=%s]" long param,
doc)
)
in
let max_short =
List.map (fun (x,_,_) -> String.length x) options
|> List.fold_left max 0
in
(* Find the options *)
let options =
List.filter (fun x -> x.short <> ' ') !specs
|> List.sort (fun x y -> Char.compare x.short y.short)
in
let max_long =
List.map (fun (_,x,_) -> String.length x) options
|> List.fold_left max 0
in
let fmt_opt max_w o =
let l = String.length o in
o^(String.make (max_w-l) ' ')
in
(* Find column lengths *)
let max_width =
List.map (fun x ->
( match x.arg with
| Without_arg -> String.length x.long
| With_arg arg -> String.length x.long + String.length arg
| With_opt_arg arg -> String.length x.long + String.length arg + 2
)
+ ( if x.opt = Optional then 2 else 0)
) !specs
|> List.fold_left max 0
in
let output_option ?(fixed_width=false) (short, long, doc) =
if fixed_width then
Format.printf "@[%s %s@]"
(fmt_opt max_short short) (fmt_opt max_long long)
else
Format.printf "@[%s|%s@]" short long
in
(* Print usage *)
Format.printf "@[<v>@[<v 2>Usage:@,@,@[<hov 4>@[%s@]" Sys.argv.(0);
List.iter (fun x -> Format.printf "@ "; output_short x) options;
Format.printf "@ @[[--]@]";
List.iter (fun x -> Format.printf "@ "; output_short x;) anon;
Format.printf "@]@,@]@,";
let output_anon ?(fixed_width=false) (name, doc, optional) =
if optional then
Format.printf "@[[%s]@]" name
else
Format.printf "@[%s@]" name
in
Format.printf "@[<v>@[<v 2>Usage:@,@,@[<hov 4>@[%s@]" Sys.argv.(0);
List.iter (fun x ->
Format.printf "@ @[[";
output_option ~fixed_width:false x;
Format.printf "]@]"
) options;
Format.printf "@ @[[--]@]";
List.iter (fun x ->
Format.printf "@ @[";
output_anon ~fixed_width:false x;
Format.printf "@]"
) anon;
Format.printf "@]@]@,@,";
Format.printf "@[<v>Arguments:@,";
(* Print arguments and doc *)
Format.printf "@[<v 2>Arguments:@,";
Format.printf "@[<v 0>" ;
List.iter (fun x -> Format.printf "@ "; output_long max_width x) anon;
Format.printf "@]@,@]@,";
Format.printf "@[<v 2>@," ;
List.iter (fun (name,doc,optional) ->
Format.printf "@[<h>";
output_anon ~fixed_width:true (name,doc,optional);
Format.printf "@ @[<v 0>%s@]@]@," doc
) anon;
Format.printf "@]@;";
Format.printf "@[<v>Options:@,";
(* Print options and doc *)
Format.printf "@[<v 2>Options:@,";
Format.printf "@[<v 0>" ;
List.iter (fun x -> Format.printf "@ "; output_long max_width x) options;
Format.printf "@]@,@]@,";
(* Print footer *)
if !description_doc <> "" then
begin
Format.printf "@[<v 2>Description:@,@,";
output_text !description_doc;
Format.printf "@,"
end;
(* Print footer *)
output_text !footer_doc;
Format.printf "@."
Format.printf "@[<v 2>@," ;
List.iter (fun (short,long,doc) ->
Format.printf "@[<h>";
output_option ~fixed_width:true (short,long,doc);
Format.printf "@ @[<v 0>%s@]@]@," doc
) options;
Format.printf "@]@;";
Format.printf "@[%s@]@." !footer_doc
let set_specs specs_in =
specs := ( 'h', "help", "Prints the help message", Without_arg) :: specs_in;
specs := { short='h' ;
long ="help" ;
doc ="Prints the help message." ;
arg =Without_arg ;
opt =Optional ;
} :: specs_in;
let specs =
List.filter (fun (x,_,_,_) -> x != ' ') !specs
|> List.map (fun x ->
match x with
| (short, long, doc, With_arg) ->
(short, long, None, Some (fun x -> Hashtbl.replace dict long x) )
| (short, long, doc, Without_arg) ->
(short, long, Some (fun () -> Hashtbl.replace dict long ""), None)
| (short, long, doc, With_opt_arg) ->
(short, long, Some (fun () -> Hashtbl.replace dict long ""),
Some (fun x -> Hashtbl.replace dict long x) )
)
in
let cmd_specs =
List.filter (fun x -> x.short != ' ') !specs
|> List.map (fun { short ; long ; opt ; doc ; arg } ->
match arg with
| With_arg _ ->
(short, long, None, Some (fun x -> Hashtbl.replace dict long x) )
| Without_arg ->
(short, long, Some (fun () -> Hashtbl.replace dict long ""), None)
| With_opt_arg _ ->
(short, long, Some (fun () -> Hashtbl.replace dict long ""),
Some (fun x -> Hashtbl.replace dict long x) )
)
in
Getopt.parse_cmdline specs (fun x -> anon_args := !anon_args @ [x]);
Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
if show_help () then
(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.")
)
;;
if show_help () then
(help () ; exit 0)
let anon_args () = !anon_args

126
ocaml/Command_line.mli Normal file
View File

@ -0,0 +1,126 @@
(** Handles command-line arguments, using getopt.
Example:
let () =
(* Command-line specs *)
let open Command_line in
begin
set_header_doc (Sys.argv.(0) ^ " - quantum_package command");
set_description_doc
"Opens a text editor to edit the parameters of an EZFIO directory.";
[ { short='c'; long="check"; opt=Optional;
doc="Checks the input data";
arg=Without_arg; };
{ short='n'; long="ndet"; opt=Optional;
doc="Truncate the wavefunction to the target number of determinants";
arg=With_arg "<int>"; };
{ short='s'; long="state"; opt=Optional;
doc="Extract selected states, for example \"[1,3-5]\"";
arg=With_arg "<range>"; };
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
]
|> set_specs ;
end;
(* Handle options *)
let ndet =
match Command_line.get "ndet" with
| None -> None
| Some s -> (try Some (int_of_string s)
with _ -> failwith "[-n|--ndet] expects an integer")
in
let state =
match Command_line.get "state" with
| None -> None
| Some s -> (try Some (Range.of_string s)
with _ -> failwith "[-s|--state] expects a range")
in
let c = Command_line.get_bool "check" in
let filename =
match Command_line.anon_args () with
| [x] -> x
| _ -> (Command_line.help () ; failwith "EZFIO_DIR is missing")
in
(* Run the program *)
run c ?ndet ?state filename
*)
type short_opt = char
type long_opt = string
type optional = Mandatory
| Optional
type documentation = string
type argument = With_arg of string
| Without_arg
| With_opt_arg of string
type description =
{
short : short_opt;
long : long_opt;
opt : optional;
doc : documentation;
arg : argument;
}
(** Sets the header of the help message. *)
val set_header_doc : string -> unit
(** Sets the description of the help message. *)
val set_description_doc : string -> unit
(** Sets the footer of the help message. *)
val set_footer_doc : string -> unit
(** Gets the value of an option. If the option is not set, returns [None]. If
the option is set, returns Some <string>. *)
val get : string -> string option
(** Gets the value of an option with no argument. If the option is set, returns [true]. *)
val get_bool : string -> bool
(** True if the '-h' or "--help" option was found. *)
val show_help : unit -> bool
(** Creates a specification of an anonymous argument. *)
val anonymous : long_opt -> optional -> documentation -> description
(** Prints the help message *)
val help : unit -> unit
(** Sets the specification list as a list of tuples:
( short option, long option, documentation, argument ) *)
val set_specs : description list -> unit
(** Returns the list of anonymous arguments *)
val anon_args : unit -> string list

20
ocaml/Determinant.ml
View File

@ -6,7 +6,7 @@ type t = int64 array [@@deriving sexp]
let to_int64_array (x:t) = (x:int64 array)
let to_alpha_beta x =
let to_alpha_beta x =
let x = to_int64_array x in
let n_int = (Array.length x)/2 in
( Array.init n_int (fun i -> x.(i)) ,
@ -18,30 +18,30 @@ let to_bitlist_couple x =
let xa =
to_int64_array xa
|> Bitlist.of_int64_array
and xb =
and xb =
to_int64_array xb
|> Bitlist.of_int64_array
in (xa,xb)
let bitlist_to_string ~mo_num x =
let len =
let len =
MO_number.to_int mo_num
in
let s =
let s =
List.map (function
| Bit.Zero -> "-"
| Bit.One -> "+"
| Bit.One -> "+"
) x
|> String.concat ""
in
String.sub s 0 len
String.sub s 0 len
let of_int64_array ~n_int ~alpha ~beta x =
assert ((Array.length x) = (N_int_number.to_int n_int)*2) ;
let (a,b) = to_bitlist_couple x
let (a,b) = to_bitlist_couple x
and alpha = Elec_alpha_number.to_int alpha
and beta = Elec_beta_number.to_int beta
in
@ -66,8 +66,8 @@ let of_int64_array_no_check x = x
let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) =
let ba, bb =
Bitlist.to_int64_array xa ,
Bitlist.to_int64_array xb
and n_int =
Bitlist.to_int64_array xb
and n_int =
match n_int with
| Some x -> x
| None -> Bitlist.n_int_of_mo_num (List.length xa)
@ -75,7 +75,7 @@ let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) =
of_int64_array ~n_int ~alpha ~beta (Array.concat [ba;bb])
let to_string ~mo_num x =
let to_string ~mo_num x =
let (xa,xb) = to_bitlist_couple x in
[ " " ; bitlist_to_string ~mo_num xa ; "\n" ;
" " ; bitlist_to_string ~mo_num xb ]

8
ocaml/Determinant.mli
View File

@ -10,11 +10,11 @@ type t = int64 array [@@deriving sexp]
(** Transform to an int64 array *)
val to_int64_array : t -> int64 array
(** Create from an int64 array, checking the number of alpha
(** Create from an int64 array, checking the number of alpha
* and beta electrons *)
val of_int64_array : n_int:Qptypes.N_int_number.t ->
val of_int64_array : n_int:Qptypes.N_int_number.t ->
alpha:Qptypes.Elec_alpha_number.t ->
beta:Qptypes.Elec_beta_number.t ->
beta:Qptypes.Elec_beta_number.t ->
int64 array -> t
(** Split into an alpha-only and a beta-only determinant *)
@ -26,7 +26,7 @@ val to_bitlist_couple : t -> Bitlist.t * Bitlist.t
(** Create from a bit list *)
val of_bitlist_couple : ?n_int:Qptypes.N_int_number.t ->
alpha:Qptypes.Elec_alpha_number.t ->
beta:Qptypes.Elec_beta_number.t ->
beta:Qptypes.Elec_beta_number.t ->
Bitlist.t * Bitlist.t -> t
(** String representation *)

90
ocaml/Element.ml
View File

@ -10,10 +10,10 @@ type t =
|Na|Mg |Al|Si|P |S |Cl|Ar
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|Pt
|Pt
[@@deriving sexp]
let of_string x =
let of_string x =
match (String.capitalize (String.lowercase x)) with
| "X" | "Dummy" -> X
| "H" | "Hydrogen" -> H
@ -192,7 +192,7 @@ let to_long_string = function
| Pt -> "Platinum"
let to_charge c =
let to_charge c =
let result = match c with
| X -> 0
| H -> 1
@ -254,43 +254,43 @@ let to_charge c =
let of_charge c = match (Charge.to_int c) with
| 0 -> X
| 1 -> H
| 2 -> He
| 3 -> Li
| 4 -> Be
| 5 -> B
| 6 -> C
| 7 -> N
| 8 -> O
| 9 -> F
| 10 -> Ne
| 11 -> Na
| 12 -> Mg
| 13 -> Al
| 14 -> Si
| 15 -> P
| 16 -> S
| 17 -> Cl
| 18 -> Ar
| 19 -> K
| 20 -> Ca
| 21 -> Sc
| 22 -> Ti
| 23 -> V
| 24 -> Cr
| 25 -> Mn
| 26 -> Fe
| 27 -> Co
| 28 -> Ni
| 29 -> Cu
| 30 -> Zn
| 31 -> Ga
| 32 -> Ge
| 33 -> As
| 34 -> Se
| 35 -> Br
| 36 -> Kr
| 0 -> X
| 1 -> H
| 2 -> He
| 3 -> Li
| 4 -> Be
| 5 -> B
| 6 -> C
| 7 -> N
| 8 -> O
| 9 -> F
| 10 -> Ne
| 11 -> Na
| 12 -> Mg
| 13 -> Al
| 14 -> Si
| 15 -> P
| 16 -> S
| 17 -> Cl
| 18 -> Ar
| 19 -> K
| 20 -> Ca
| 21 -> Sc
| 22 -> Ti
| 23 -> V
| 24 -> Cr
| 25 -> Mn
| 26 -> Fe
| 27 -> Co
| 28 -> Ni
| 29 -> Cu
| 30 -> Zn
| 31 -> Ga
| 32 -> Ge
| 33 -> As
| 34 -> Se
| 35 -> Br
| 36 -> Kr
| 37 -> Rb
| 38 -> Sr
| 39 -> Y
@ -313,7 +313,7 @@ let of_charge c = match (Charge.to_int c) with
| x -> raise (ElementError ("Element of charge "^(string_of_int x)^" unknown"))
let covalent_radius x =
let covalent_radius x =
let result = function
| X -> 0.
| H -> 0.37
@ -354,13 +354,13 @@ let covalent_radius x =
| Kr -> 1.91
| Rb -> 2.20
| Sr -> 1.95
| Y -> 1.90
| Y -> 1.90
| Zr -> 1.75
| Nb -> 1.64
| Mo -> 1.54
| Tc -> 1.47
| Ru -> 1.46
| Rh -> 1.42
| Ru -> 1.46
| Rh -> 1.42
| Pd -> 1.39
| Ag -> 1.45
| Cd -> 1.44
@ -375,7 +375,7 @@ let covalent_radius x =
Units.angstrom_to_bohr *. (result x)
|> Positive_float.of_float
let vdw_radius x =
let vdw_radius x =
let result = function
| X -> 0.
| H -> 1.20

74
ocaml/Gamess.ml
View File

@ -33,7 +33,7 @@ let make_contrl ?(maxit=100) ?(ispher=1) ?(mplevl=0) ~mult ~charge scftyp =
(** Vec *)
type vec_t =
type vec_t =
| Canonical of string
| Natural of string
@ -69,20 +69,20 @@ let read_mos guide filename =
Str.search_forward re_eol text i
in
String.sub text start (finish-start)
let read_until_found f tries =
let result =
let result =
List.fold_left (fun accu x ->
match accu with
| Some mos -> Some mos
| None ->
begin
begin
try
Some (read_mos x f)
with Caml.Not_found ->
None
end
) None tries
) None tries
in
match result with
| Some mos -> mos
@ -94,7 +94,7 @@ let read_natural_mos f =
"MP2 NATURAL ORBITALS" ]
in
read_until_found f tries
let read_canonical_mos f =
let tries = [
"--- OPTIMIZED MCSCF MO-S ---" ;
@ -103,7 +103,7 @@ let read_canonical_mos f =
]
in
read_until_found f tries
let string_of_vec = function
| Natural filename -> read_natural_mos filename
| Canonical filename -> read_canonical_mos filename
@ -111,7 +111,7 @@ let string_of_vec = function
(** GUESS *)
type guess_t =
| Huckel
| Hcore
| Hcore
| Canonical of (int*string)
| Natural of (int*string)
@ -123,7 +123,7 @@ let guess_of_string s =
let string_of_guess g =
[
" $GUESS\n" ; " GUESS=" ;
" $GUESS\n" ; " GUESS=" ;
begin
match g with
| Hcore -> "HCORE\n"
@ -143,11 +143,11 @@ let string_of_guess g =
let string_of_basis =
Printf.sprintf " $BASIS
GBASIS=%s
$END"
$END"
(** DATA *)
type coord_t =
type coord_t =
| Atom of Element.t
| Diatomic_homo of (Element.t*float)
| Diatomic of (Element.t*Element.t*float)
@ -214,7 +214,7 @@ let data_of_xyz l =
List.map (fun (e,x,y,z) -> Printf.sprintf "%s %f %f %f %f"
(Element.to_string e) (Element.to_charge e)
x y z) l ) ;
nucl_charge = List.fold_left (fun accu (e,_,_,_) ->
nucl_charge = List.fold_left (fun accu (e,_,_,_) ->
accu + (int_of_float @@ Element.to_charge e) ) 0 l
}
@ -229,7 +229,7 @@ let string_of_data d =
d.title ;
Sym.to_data d.sym ;
] ^ d.xyz ^ "\n $END"
(** GUGDM *)
type gugdm2_t = int
@ -250,7 +250,7 @@ let string_of_gugdm2 = function
" s
type gugdia_t =
type gugdia_t =
{ nstate : int ;
itermx : int ;
}
@ -275,7 +275,7 @@ let make_gugdia ?(itermx=500) nstate =
type mcscf_t = FULLNR | SOSCF | FOCAS
let string_of_mcscf m =
" $MCSCF\n" ^
" $MCSCF\n" ^
begin
match m with
| FOCAS -> " FOCAS=.T. SOSCF=.F. FULLNR=.F."
@ -287,7 +287,7 @@ let string_of_mcscf m =
$END"
type drt_t =
type drt_t =
{ nmcc: int ;
ndoc: int ;
nalp: int ;
@ -303,9 +303,9 @@ let make_drt ?(istsym=1) n_elec_alpha n_elec_beta n_e n_act =
let nmcc =
(n_elec_tot - n_e)/2
in
let ndoc =
let ndoc =
n_elec_beta - nmcc
in
in
let nalp =
(n_elec_alpha - nmcc - ndoc)
in
@ -327,7 +327,7 @@ let string_of_drt drt sym =
MXNINT= 600000
NPRT=2
$END"
drt.nmcc drt.ndoc drt.nalp drt.nval drt.istsym
drt.nmcc drt.ndoc drt.nalp drt.nval drt.istsym
(** MP2 *)
let string_of_mp2 = " $MP2
@ -342,26 +342,26 @@ type system =
{ mult: int ; charge: int ; basis: string ; coord: coord_t }
let n_elec system =
let data =
let data =
make_data system.coord
in
data.nucl_charge - system.charge
let n_elec_alpha_beta system =
let n =
n_elec system
and m =
let n =
n_elec system
and m =
system.mult
in
let alpha =
let alpha =
(n+m-1)/2
in
let beta =
let beta =
n - alpha
in
(alpha, beta)
let create_single_det_input ~mp2 ~guess ?(vecfile="") s =
let scftyp =
match s.mult with
@ -369,14 +369,14 @@ let create_single_det_input ~mp2 ~guess ?(vecfile="") s =
| _ -> ROHF
and mult = s.mult
and charge = s.charge
and n_elec_alpha, _ =
and n_elec_alpha, _ =
n_elec_alpha_beta s
and mplevl =
if mp2 then 2 else 0
in
[
make_contrl ~mult ~charge ~mplevl scftyp
|> string_of_contrl
|> string_of_contrl
;
begin
match vecfile with
@ -394,7 +394,7 @@ let create_single_det_input ~mp2 ~guess ?(vecfile="") s =
make_data s.coord
|> string_of_data
] |> String.concat "\n\n"
let create_hf_input ~guess =
create_single_det_input ~mp2:false ~guess
@ -408,23 +408,23 @@ let create_cas_input ?(vecfile="") ~guess ~nstate s n_e n_a =
and mult = s.mult
and charge = s.charge
in
let n_elec_alpha, n_elec_beta =
let n_elec_alpha, n_elec_beta =
n_elec_alpha_beta s
in
let drt =
let drt =
make_drt n_elec_alpha n_elec_beta n_e n_a
in
let data =
let data =
make_data s.coord
in
[
make_contrl ~mult ~charge scftyp
|> string_of_contrl
|> string_of_contrl
;
begin
match vecfile with
| "" -> string_of_guess guess
| vecfile ->
| vecfile ->
let norb =
drt.nmcc + drt.ndoc + drt.nval + drt.nalp
in
@ -441,17 +441,17 @@ let create_cas_input ?(vecfile="") ~guess ~nstate s n_e n_a =
string_of_drt drt data.sym
;
make_gugdia nstate
|> string_of_gugdia
|> string_of_gugdia
;
string_of_gugdm2 nstate
;
string_of_data data
] |> String.concat "\n\n"
let create_input ?(vecfile="") ?(guess=Huckel) ~system ~nstate = function
| HF -> create_hf_input ~vecfile ~guess system
| MP2 -> create_mp2_input ~vecfile ~guess system
| CAS (n_e,n_a) -> create_cas_input ~vecfile ~nstate ~guess system n_e n_a
| CAS (n_e,n_a) -> create_cas_input ~vecfile ~nstate ~guess system n_e n_a

8
ocaml/GaussianPrimitive.ml
View File

@ -6,12 +6,12 @@ type t =
expo : AO_expo.t ;
} [@@deriving sexp]
let to_string p =
let to_string p =
let { sym = s ; expo = e } = p in
Printf.sprintf "(%s, %22e)"
Printf.sprintf "(%s, %22e)"
(Symmetry.to_string s)
(AO_expo.to_float e)
let of_sym_expo s e =
let of_sym_expo s e =
{ sym=s ; expo=e}

6
ocaml/Generic_input_of_rst.ml
View File

@ -2,7 +2,7 @@ open Core;;
open Qptypes;;
let fail_msg str (ex,range) =
let fail_msg str (ex,range) =
let msg = match ex with
| Failure msg -> msg
| _ -> raise ex
@ -24,8 +24,8 @@ let fail_msg str (ex,range) =
in
let str = String.tr str ~target:'(' ~replacement:' '
|> String.split ~on:')'
|> List.map ~f:String.strip
|> List.filter ~f:(fun x ->
|> List.map ~f:String.strip
|> List.filter ~f:(fun x ->
match String.substr_index x ~pos:0 ~pattern:"##" with
| None -> false
| Some _ -> true

22
ocaml/Gto.ml
View File

@ -19,7 +19,7 @@ let of_prim_coef_list pc =
let sym = p.GaussianPrimitive.sym in
let rec check = function
| [] -> `OK
| (p,c)::tl ->
| (p,c)::tl ->
if p.GaussianPrimitive.sym <> sym then
`Failed
else
@ -36,7 +36,7 @@ let of_prim_coef_list pc =
let read_one in_channel =
(* Fetch number of lines to read on first line *)
let buffer =
let buffer =
try input_line in_channel with
| End_of_file -> raise End_Of_Basis
in
@ -52,8 +52,8 @@ let read_one in_channel =
| i ->
begin
let line_buffer = input_line in_channel in
let buffer = line_buffer
|> String_ext.split ~on:' '
let buffer = line_buffer
|> String_ext.split ~on:' '
|> List.filter (fun x -> x <> "")
in
match buffer with
@ -63,7 +63,7 @@ let read_one in_channel =
Str.global_replace (Str.regexp "D") "e" coef
in
let p =
GaussianPrimitive.of_sym_expo sym
GaussianPrimitive.of_sym_expo sym
(AO_expo.of_float (float_of_string expo) )
and c = AO_coef.of_float (float_of_string coef) in
read_lines ( (p,c)::result) (i-1)
@ -78,16 +78,16 @@ let read_one in_channel =
(** Write the GTO in Gamess format *)
let to_string_gamess { sym = sym ; lc = lc } =
let result =
let result =
Printf.sprintf "%s %3d" (Symmetry.to_string sym) (List.length lc)
in
let rec do_work accu i = function
| [] -> List.rev accu
| (p,c)::tail ->
| (p,c)::tail ->
let p = AO_expo.to_float p.GaussianPrimitive.expo
and c = AO_coef.to_float c
in
let result =
let result =
Printf.sprintf "%3d %16f %16f" i p c
in
do_work (result::accu) (i+1) tail
@ -98,16 +98,16 @@ let to_string_gamess { sym = sym ; lc = lc } =
(** Write the GTO in Gaussian format *)
let to_string_gaussian { sym = sym ; lc = lc } =
let result =
let result =
Printf.sprintf "%s %3d 1.00" (Symmetry.to_string sym) (List.length lc)
in
let rec do_work accu i = function
| [] -> List.rev accu
| (p,c)::tail ->
| (p,c)::tail ->
let p = AO_expo.to_float p.GaussianPrimitive.expo
and c = AO_coef.to_float c
in
let result =
let result =
Printf.sprintf "%15.7f %15.7f" p c
in
do_work (result::accu) (i+1) tail

4
ocaml/Id.ml
View File

@ -1,12 +1,12 @@
module Id = struct
type t = int
let of_int x =
let of_int x =
assert (x>0); x
let to_int x = x
let of_string x =
let of_string x =
int_of_string x
|> of_int

44
ocaml/Input_ao_basis.ml
View File

@ -3,7 +3,7 @@ open Qputils;;
open Core;;
module Ao_basis : sig
type t =
type t =
{ ao_basis : AO_basis_name.t;
ao_num : AO_number.t ;
ao_prim_num : AO_prim_number.t array;
@ -22,7 +22,7 @@ module Ao_basis : sig
val to_md5 : t -> MD5.t
val to_rst : t -> Rst_string.t
end = struct
type t =
type t =
{ ao_basis : AO_basis_name.t;
ao_num : AO_number.t ;
ao_prim_num : AO_prim_number.t array;
@ -37,7 +37,7 @@ end = struct
let get_default = Qpackage.get_ezfio_default "ao_basis";;
let read_ao_basis () =
let read_ao_basis () =
Ezfio.get_ao_basis_ao_basis ()
|> AO_basis_name.of_string
;;
@ -48,7 +48,7 @@ end = struct
;;
let read_ao_prim_num () =
Ezfio.get_ao_basis_ao_prim_num ()
Ezfio.get_ao_basis_ao_prim_num ()
|> Ezfio.flattened_ezfio
|> Array.map ~f:AO_prim_number.of_int
;;
@ -62,7 +62,7 @@ end = struct
let read_ao_nucl () =
let nmax = Nucl_number.get_max () in
Ezfio.get_ao_basis_ao_nucl ()
Ezfio.get_ao_basis_ao_nucl ()
|> Ezfio.flattened_ezfio
|> Array.map ~f:(fun x-> Nucl_number.of_int ~max:nmax x)
;;
@ -85,7 +85,7 @@ end = struct
;;
let read_ao_coef () =
Ezfio.get_ao_basis_ao_coef ()
Ezfio.get_ao_basis_ao_coef ()
|> Ezfio.flattened_ezfio
|> Array.map ~f:AO_coef.of_float
;;
@ -124,12 +124,12 @@ end = struct
in
let rec do_work accu sym gto nucl =
match (sym, gto, nucl) with
| (s::srest, g::grest, n::nrest) ->
| (s::srest, g::grest, n::nrest) ->
do_work ((s,g,n)::accu) srest grest nrest
| ([],[],[]) -> List.rev accu
| _ -> assert false
in
do_work []
do_work []
(Array.to_list b.ao_power)
(Array.to_list gto_array)
(Array.to_list b.ao_nucl)
@ -138,18 +138,18 @@ end = struct
to_long_basis b
|> Long_basis.to_basis
;;
let to_md5 b =
let short_basis = to_basis b in
Basis.to_md5 short_basis
;;
let write_md5 b =
to_md5 b
|> MD5.to_string
|> Ezfio.set_ao_basis_ao_md5
|> MD5.to_string
|> Ezfio.set_ao_basis_ao_md5
;;
let write_ao_basis name =
@ -177,7 +177,7 @@ end = struct
let read () =
if (Ezfio.has_ao_basis_ao_basis ()) then
begin
let result =
let result =
{ ao_basis = read_ao_basis ();
ao_num = read_ao_num () ;
ao_prim_num = read_ao_prim_num ();
@ -197,15 +197,15 @@ end = struct
else
None
;;
let to_rst b =
let print_sym =
let print_sym =
let l = List.init (Array.length b.ao_power) ~f:(
fun i -> ( (i+1),b.ao_nucl.(i),b.ao_power.(i) ) ) in
let rec do_work = function
| [] -> []
| (i,n,x)::tail ->
| (i,n,x)::tail ->
(Printf.sprintf " %5d %6d %-8s\n" i (Nucl_number.to_int n) (Symmetry.Xyz.to_string x))::
(do_work tail)
in do_work l
@ -223,7 +223,7 @@ Cartesian coordinates (6d,10f,...) ::
ao_cartesian = %s
Basis set (read-only) ::
%s
@ -235,16 +235,16 @@ Basis set (read-only) ::
" (AO_basis_name.to_string b.ao_basis)
(Bool.to_string b.ao_cartesian)
(Basis.to_string short_basis
(Basis.to_string short_basis
|> String.split ~on:'\n'
|> List.map ~f:(fun x-> " "^x)
|> String.concat ~sep:"\n"
) print_sym
|> Rst_string.of_string
;;
let read_rst s =
let read_rst s =
let s = Rst_string.to_string s
|> String.split ~on:'\n'
in
@ -286,7 +286,7 @@ md5 = %s
|> String.concat ~sep:", ")
(b.ao_expo |> Array.to_list |> List.map ~f:AO_expo.to_string
|> String.concat ~sep:", ")
(b.ao_cartesian |> Bool.to_string)
(b.ao_cartesian |> Bool.to_string)
(to_md5 b |> MD5.to_string )
;;

32
ocaml/Input_bi_integrals.ml
View File

@ -3,7 +3,7 @@ open Qputils;;
open Core;;
module Bielec_integrals : sig
type t =
type t =
{ read_ao_integrals : bool;
read_mo_integrals : bool;
write_ao_integrals : bool;
@ -17,9 +17,9 @@ module Bielec_integrals : sig
val write : t -> unit
val to_string : t -> string
val to_rst : t -> Rst_string.t
val of_rst : Rst_string.t -> t option
val of_rst : Rst_string.t -> t option
end = struct
type t =
type t =
{ read_ao_integrals : bool;
read_mo_integrals : bool;
write_ao_integrals : bool;
@ -32,11 +32,11 @@ end = struct
let get_default = Qpackage.get_ezfio_default "bielec_integrals";;
let read_read_ao_integrals () =
let read_read_ao_integrals () =
if not (Ezfio.has_bielec_integrals_read_ao_integrals ()) then
get_default "read_ao_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_read_ao_integrals
|> Ezfio.set_bielec_integrals_read_ao_integrals
;
Ezfio.get_bielec_integrals_read_ao_integrals ()
;;
@ -46,11 +46,11 @@ end = struct
;;
let read_read_mo_integrals () =
let read_read_mo_integrals () =
if not (Ezfio.has_bielec_integrals_read_mo_integrals ()) then
get_default "read_mo_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_read_mo_integrals
|> Ezfio.set_bielec_integrals_read_mo_integrals
;
Ezfio.get_bielec_integrals_read_mo_integrals ()
;;
@ -60,11 +60,11 @@ end = struct
;;
let read_write_ao_integrals () =
let read_write_ao_integrals () =
if not (Ezfio.has_bielec_integrals_write_ao_integrals ()) then
get_default "write_ao_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_write_ao_integrals
|> Ezfio.set_bielec_integrals_write_ao_integrals
;
Ezfio.get_bielec_integrals_write_ao_integrals ()
;;
@ -74,11 +74,11 @@ end = struct
;;
let read_write_mo_integrals () =
let read_write_mo_integrals () =
if not (Ezfio.has_bielec_integrals_write_mo_integrals ()) then
get_default "write_mo_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_write_mo_integrals
|> Ezfio.set_bielec_integrals_write_mo_integrals
;
Ezfio.get_bielec_integrals_write_mo_integrals ()
;;
@ -88,7 +88,7 @@ end = struct
;;
let read_direct () =
let read_direct () =
if not (Ezfio.has_bielec_integrals_direct ()) then
get_default "direct"
|> Bool.of_string
@ -102,7 +102,7 @@ end = struct
;;
let read_threshold_ao () =
let read_threshold_ao () =
if not (Ezfio.has_bielec_integrals_threshold_ao ()) then
get_default "threshold_ao"
|> Float.of_string
@ -118,7 +118,7 @@ end = struct
;;
let read_threshold_mo () =
let read_threshold_mo () =
if not (Ezfio.has_bielec_integrals_threshold_mo ()) then
get_default "threshold_mo"
|> Float.of_string
@ -134,8 +134,8 @@ end = struct
;;
let read ()=
let result =
let read ()=
let result =
{ read_ao_integrals = read_read_ao_integrals();
read_mo_integrals = read_read_mo_integrals () ;
write_ao_integrals = read_write_ao_integrals ();

40
ocaml/Input_bitmasks.ml
View File

@ -3,7 +3,7 @@ open Qputils;;
open Core;;
module Bitmasks : sig
type t =
type t =
{ n_int : N_int_number.t;
bit_kind : Bit_kind.t;
n_mask_gen : Bitmask_number.t;
@ -12,10 +12,10 @@ module Bitmasks : sig
cas : int64 array;
} [@@deriving sexp]
;;
val read : unit -> t option
val read : unit -> t option
val to_string : t -> string
end = struct
type t =
type t =
{ n_int : N_int_number.t;
bit_kind : Bit_kind.t;
n_mask_gen : Bitmask_number.t;
@ -27,12 +27,12 @@ end = struct
let get_default = Qpackage.get_ezfio_default "bitmasks";;
let read_n_int () =
let read_n_int () =
if not (Ezfio.has_bitmasks_n_int()) then
Ezfio.get_mo_basis_mo_num ()
|> Bitlist.n_int_of_mo_num
|> Bitlist.n_int_of_mo_num
|> N_int_number.to_int
|> Ezfio.set_bitmasks_n_int
|> Ezfio.set_bitmasks_n_int
;
Ezfio.get_bitmasks_n_int ()
|> N_int_number.of_int
@ -42,7 +42,7 @@ end = struct
if not (Ezfio.has_bitmasks_bit_kind ()) then
Lazy.force Qpackage.bit_kind
|> Bit_kind.to_int
|> Ezfio.set_bitmasks_bit_kind
|> Ezfio.set_bitmasks_bit_kind
;
Ezfio.get_bitmasks_bit_kind ()
|> Bit_kind.of_int
@ -57,24 +57,24 @@ end = struct
;;
let full_mask n_int =
let full_mask n_int =
let range = "[1-"^
(Int.to_string (Ezfio.get_mo_basis_mo_num ()))^"]"
in
MO_class.create_active range
|> MO_class.to_bitlist n_int
MO_class.create_active range
|> MO_class.to_bitlist n_int
;;
let read_generators () =
if not (Ezfio.has_bitmasks_generators ()) then
begin
let n_int =
let n_int =
read_n_int ()
in
let act =
in
let act =
full_mask n_int
in
let result = [ act ; act ; act ; act ; act ; act ]
let result = [ act ; act ; act ; act ; act ; act ]
|> List.map ~f:(fun x ->
let y = Bitlist.to_int64_list x in y@y )
|> List.concat
@ -100,13 +100,13 @@ end = struct
let read_cas () =
if not (Ezfio.has_bitmasks_cas ()) then
begin
let n_int =
let n_int =
read_n_int ()
in
let act =
let act =
full_mask n_int
in
let result = [ act ; act ]
let result = [ act ; act ]
|> List.map ~f:(fun x ->
let y = Bitlist.to_int64_list x in y@y )
|> List.concat
@ -120,7 +120,7 @@ end = struct
|> Ezfio.flattened_ezfio
;;
let read () =
let read () =
if (Ezfio.has_mo_basis_mo_num ()) then
Some
{ n_int = read_n_int ();
@ -147,11 +147,11 @@ cas = %s
(Bit_kind.to_string b.bit_kind)
(Bitmask_number.to_string b.n_mask_gen)
(Array.to_list b.generators
|> List.map ~f:(fun x-> Int64.to_string x)
|> List.map ~f:(fun x-> Int64.to_string x)
|> String.concat ~sep:", ")
(Bitmask_number.to_string b.n_mask_cas)
(Array.to_list b.cas
|> List.map ~f:(fun x-> Int64.to_string x)
|> List.map ~f:(fun x-> Int64.to_string x)
|> String.concat ~sep:", ")
end

92
ocaml/Input_determinants_by_hand.ml
View File

@ -3,7 +3,7 @@ open Qputils;;
open Core;;
module Determinants_by_hand : sig
type t =
type t =
{ n_int : N_int_number.t;
bit_kind : Bit_kind.t;
n_det : Det_number.t;
@ -24,7 +24,7 @@ module Determinants_by_hand : sig
val extract_state : States_number.t -> unit
val extract_states : Range.t -> unit
end = struct
type t =
type t =
{ n_int : N_int_number.t;
bit_kind : Bit_kind.t;
n_det : Det_number.t;
@ -97,12 +97,12 @@ end = struct
;;
let write_n_states n =
let n_states =
let n_states =
States_number.to_int n
in
(*
let old_nstates, read_wf =
Ezfio.get_determinants_n_states (),
Ezfio.get_determinants_n_states (),
Ezfio.get_determinants_read_wf ()
in
if read_wf && old_nstates <> n_states then
@ -140,13 +140,13 @@ end = struct
in
if not (Ezfio.has_determinants_state_average_weight ()) then
begin
let data =
let data =
Array.init n_states (fun _ -> 1./.(float_of_int n_states))
|> Array.map ~f:Positive_float.of_float
in
write_state_average_weight data
end;
let result =
let result =
Ezfio.get_determinants_state_average_weight ()
|> Ezfio.flattened_ezfio
|> Array.map ~f:Positive_float.of_float
@ -154,7 +154,7 @@ end = struct
if Array.length result = n_states then
result
else
let data =
let data =
Array.init n_states (fun _ -> 1./.(float_of_int n_states))
|> Array.map ~f:Positive_float.of_float
in
@ -178,7 +178,7 @@ end = struct
let write_expected_s2 s2 =
Positive_float.to_float s2
|> Ezfio.set_determinants_expected_s2
|> Ezfio.set_determinants_expected_s2
;;
let read_psi_coef () =
@ -188,9 +188,9 @@ end = struct
read_n_states ()
|> States_number.to_int
in
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |]
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |]
~data:(List.init n_states ~f:(fun i -> if (i=0) then 1. else 0. ))
|> Ezfio.set_determinants_psi_coef
|> Ezfio.set_determinants_psi_coef
end;
Ezfio.get_determinants_psi_coef ()
|> Ezfio.flattened_ezfio
@ -201,20 +201,20 @@ end = struct
let n_det = Det_number.to_int n_det
and c = Array.to_list c
|> List.map ~f:Det_coef.to_float
and n_states =
and n_states =
States_number.to_int n_states
in
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c
|> Ezfio.set_determinants_psi_coef
|> Ezfio.set_determinants_psi_coef
;;
let read_psi_det () =
let n_int = read_n_int ()
let n_int = read_n_int ()
and n_alpha = Ezfio.get_electrons_elec_alpha_num ()
|> Elec_alpha_number.of_int
|> Elec_alpha_number.of_int
and n_beta = Ezfio.get_electrons_elec_beta_num ()
|> Elec_beta_number.of_int
|> Elec_beta_number.of_int
in
if not (Ezfio.has_determinants_psi_det ()) then
begin
@ -228,8 +228,8 @@ end = struct
and det_b = build_data [] (Elec_beta_number.to_int n_beta)
|> Bitlist.of_mo_number_list n_int
in
let data = ( (Bitlist.to_int64_list det_a) @
(Bitlist.to_int64_list det_b) )
let data = ( (Bitlist.to_int64_list det_a) @
(Bitlist.to_int64_list det_b) )
in
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; 1 |] ~data:data
|> Ezfio.set_determinants_psi_det ;
@ -252,7 +252,7 @@ end = struct
let write_psi_det ~n_int ~n_det d =
let data = Array.to_list d
|> Array.concat
|> Array.concat
|> Array.to_list
in
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; Det_number.to_int n_det |] ~data:data
@ -276,7 +276,7 @@ end = struct
;;
let read_maybe () =
let n_det =
let n_det =
read_n_det ()
in
if ( (Det_number.to_int n_det) < n_det_read_max ) then
@ -308,12 +308,12 @@ end = struct
let to_rst b =
let max =
Ezfio.get_mo_basis_mo_num ()
Ezfio.get_mo_basis_mo_num ()
in
let mo_num =
MO_number.of_int ~max max
in
let det_text =
let det_text =
let nstates =
read_n_states ()
|> States_number.to_int
@ -321,13 +321,13 @@ end = struct
Det_number.to_int b.n_det
in
let coefs_string i =
Array.init nstates (fun j ->
let ishift =
Array.init nstates (fun j ->
let ishift =
j*ndet
in
if (ishift < Array.length b.psi_coef) then
b.psi_coef.(i+ishift)
|> Det_coef.to_float
|> Det_coef.to_float
|> Float.to_string
else
"0."
@ -402,7 +402,7 @@ psi_det = %s
(* Split into header and determinants data *)
let idx = String.substr_index_exn r ~pos:0 ~pattern:"\nDeterminants"
in
let (header, dets) =
let (header, dets) =
(String.prefix r idx, String.suffix r ((String.length r)-idx) )
in
@ -420,23 +420,23 @@ psi_det = %s
String.tr line ~target:'=' ~replacement:' '
|> String.strip
)^")" )
|> String.concat
|> String.concat
in
(* Handle determinant coefs *)
let dets = match ( dets
|> String.split ~on:'\n'
|> List.map ~f:(String.strip)
) with
| _::lines -> lines
) with
| _::lines -> lines
| _ -> failwith "Error in determinants"
in
let psi_coef =
let psi_coef =
let rec read_coefs accu = function
| [] -> List.rev accu
| ""::""::tail -> read_coefs accu tail
| ""::c::tail ->
| ""::c::tail ->
let c =
String.split ~on:'\t' c
|> List.map ~f:(fun x -> Det_coef.of_float (Float.of_string x))
@ -446,15 +446,15 @@ psi_det = %s
| _::tail -> read_coefs accu tail
in
let a =
let buffer =
let buffer =
read_coefs [] dets
in
let nstates =
List.hd_exn buffer
|> Array.length
in
let extract_state i =
let i =
let extract_state i =
let i =
i-1
in
List.map ~f:(fun x -> Det_coef.to_string x.(i)) buffer
@ -464,26 +464,26 @@ psi_det = %s
| 1 -> extract_state 1
| i -> (build_result (i-1))^" "^(extract_state i)
in
build_result nstates
build_result nstates
in
"(psi_coef ("^a^"))"
in
(* Handle determinants *)
let psi_det =
let psi_det =
let n_alpha = Ezfio.get_electrons_elec_alpha_num ()
|> Elec_alpha_number.of_int
|> Elec_alpha_number.of_int
and n_beta = Ezfio.get_electrons_elec_beta_num ()
|> Elec_beta_number.of_int
|> Elec_beta_number.of_int
in
let rec read_dets accu = function
| [] -> List.rev accu
| ""::_::alpha::beta::tail ->
| ""::_::alpha::beta::tail ->
begin
let newdet =
(Bitlist.of_string ~zero:'-' ~one:'+' alpha ,
Bitlist.of_string ~zero:'-' ~one:'+' beta)
|> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta
|> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta
|> Determinant.sexp_of_t
|> Sexplib.Sexp.to_string
in
@ -491,10 +491,10 @@ psi_det = %s
end
| _::tail -> read_dets accu tail
in
let dets =
let dets =
List.map ~f:String.rev dets
in
let sze =
let sze =
List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) dets
in
let control =
@ -511,7 +511,7 @@ psi_det = %s
in
let bitkind =
let bitkind =
Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|> Bit_kind.to_int)
and n_int =
@ -519,7 +519,7 @@ psi_det = %s
and n_states =
Printf.sprintf "(n_states %d)" (States_number.to_int @@ read_n_states ())
in
let s =
let s =
String.concat [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det]
in
@ -605,11 +605,11 @@ psi_det = %s
Range.to_int_list range
|> List.iter ~f:(fun istate ->
if istate > n_states then
failwith "State to extract should not be greater than n_states")
failwith "State to extract should not be greater than n_states")
;
let sorted_list =
let sorted_list =
Range.to_int_list range
|> List.sort ~compare
|> List.sort ~compare
in
let state_shift = ref 0 in
List.iter ~f:(fun istate ->

20
ocaml/Input_electrons.ml
View File

@ -3,7 +3,7 @@ open Qputils;;
open Core;;
module Electrons : sig
type t =
type t =
{ elec_alpha_num : Elec_alpha_number.t;
elec_beta_num : Elec_beta_number.t;
} [@@deriving sexp]
@ -15,7 +15,7 @@ module Electrons : sig
val to_rst : t -> Rst_string.t
val of_rst : Rst_string.t -> t option
end = struct
type t =
type t =
{ elec_alpha_num : Elec_alpha_number.t;
elec_beta_num : Elec_beta_number.t;
} [@@deriving sexp]
@ -23,28 +23,28 @@ end = struct
let get_default = Qpackage.get_ezfio_default "electrons";;
let read_elec_alpha_num() =
let read_elec_alpha_num() =
Ezfio.get_electrons_elec_alpha_num ()
|> Elec_alpha_number.of_int
;;
let write_elec_alpha_num n =
let write_elec_alpha_num n =
Elec_alpha_number.to_int n
|> Ezfio.set_electrons_elec_alpha_num
|> Ezfio.set_electrons_elec_alpha_num
;;
let read_elec_beta_num() =
let read_elec_beta_num() =
Ezfio.get_electrons_elec_beta_num ()
|> Elec_beta_number.of_int
;;
let write_elec_beta_num n =
let write_elec_beta_num n =
Elec_beta_number.to_int n
|> Ezfio.set_electrons_elec_beta_num
|> Ezfio.set_electrons_elec_beta_num
;;
let read_elec_num () =
let read_elec_num () =
let na = Ezfio.get_electrons_elec_alpha_num ()
and nb = Ezfio.get_electrons_elec_beta_num ()
in assert (na >= nb);
@ -52,7 +52,7 @@ end = struct
;;
let read () =
let read () =
if (Ezfio.has_electrons_elec_alpha_num ()) then
Some
{ elec_alpha_num = read_elec_alpha_num ();

42
ocaml/Input_mo_basis.ml
View File

@ -4,7 +4,7 @@ open Core
module Mo_basis : sig
type t =
type t =
{ mo_num : MO_number.t ;
mo_label : MO_label.t;
mo_class : MO_class.t array;
@ -16,7 +16,7 @@ module Mo_basis : sig
val to_string : t -> string
val to_rst : t -> Rst_string.t
end = struct
type t =
type t =
{ mo_num : MO_number.t ;
mo_label : MO_label.t;
mo_class : MO_class.t array;
@ -26,7 +26,7 @@ end = struct
} [@@deriving sexp]
let get_default = Qpackage.get_ezfio_default "mo_basis"
let read_mo_label () =
let read_mo_label () =
if not (Ezfio.has_mo_basis_mo_label ()) then
Ezfio.set_mo_basis_mo_label "None"
;
@ -34,17 +34,17 @@ end = struct
|> MO_label.of_string
let read_ao_md5 () =
let ao_md5 =
let read_ao_md5 () =
let ao_md5 =
match (Input_ao_basis.Ao_basis.read ()) with
| None -> failwith "Unable to read AO basis"
| Some result -> Input_ao_basis.Ao_basis.to_md5 result
in
let result =
let result =
if not (Ezfio.has_mo_basis_ao_md5 ()) then
begin
MD5.to_string ao_md5
|> Ezfio.set_mo_basis_ao_md5
|> Ezfio.set_mo_basis_ao_md5
end;
Ezfio.get_mo_basis_ao_md5 ()
|> MD5.of_string
@ -63,11 +63,11 @@ end = struct
if not (Ezfio.has_mo_basis_mo_class ()) then
begin
let mo_num = MO_number.to_int (read_mo_num ()) in
let data =
let data =
Array.init mo_num ~f:(fun _ -> MO_class.(to_string (Active [])))
|> Array.to_list
in
Ezfio.ezfio_array_of_list ~rank:1
Ezfio.ezfio_array_of_list ~rank:1
~dim:[| mo_num |] ~data:data
|> Ezfio.set_mo_basis_mo_class
end;
@ -78,14 +78,14 @@ end = struct
let read_mo_occ () =
if not (Ezfio.has_mo_basis_mo_label ()) then
begin
let elec_alpha_num = Ezfio.get_electrons_elec_alpha_num ()
let elec_alpha_num = Ezfio.get_electrons_elec_alpha_num ()
and elec_beta_num = Ezfio.get_electrons_elec_beta_num ()
and mo_num = MO_number.to_int (read_mo_num ()) in
let data = Array.init mo_num ~f:(fun i ->
if (i<elec_beta_num) then 2.
else if (i < elec_alpha_num) then 1.
else 0.) |> Array.to_list in
Ezfio.ezfio_array_of_list ~rank:1
Ezfio.ezfio_array_of_list ~rank:1
~dim:[| mo_num |] ~data:data
|> Ezfio.set_mo_basis_mo_occ
end;
@ -94,7 +94,7 @@ end = struct
let read_mo_coef () =
let a = Ezfio.get_mo_basis_mo_coef ()
let a = Ezfio.get_mo_basis_mo_coef ()
|> Ezfio.flattened_ezfio
|> Array.map ~f:MO_coef.of_float
in
@ -120,20 +120,20 @@ end = struct
let mo_coef_to_string mo_coef =
let ao_num = Array.length mo_coef.(0)
let ao_num = Array.length mo_coef.(0)
and mo_num = Array.length mo_coef in
let rec print_five imin imax =
match (imax-imin+1) with
match (imax-imin+1) with
| 1 ->
let header = [ Printf.sprintf " #%15d" (imin+1) ; ] in
let new_lines =
let new_lines =
List.init ao_num ~f:(fun i ->
Printf.sprintf " %3d %15.10f " (i+1)
(MO_coef.to_float mo_coef.(imin ).(i)) )
in header @ new_lines
| 2 ->
let header = [ Printf.sprintf " #%15d %15d" (imin+1) (imin+2) ; ] in
let new_lines =
let new_lines =
List.init ao_num ~f:(fun i ->
Printf.sprintf " %3d %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i))
@ -142,7 +142,7 @@ end = struct
| 3 ->
let header = [ Printf.sprintf " #%15d %15d %15d"
(imin+1) (imin+2) (imin+3); ] in
let new_lines =
let new_lines =
List.init ao_num ~f:(fun i ->
Printf.sprintf " %3d %15.10f %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i))
@ -152,7 +152,7 @@ end = struct
| 4 ->
let header = [ Printf.sprintf " #%15d %15d %15d %15d"
(imin+1) (imin+2) (imin+3) (imin+4) ; ] in
let new_lines =
let new_lines =
List.init ao_num ~f:(fun i ->
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i))
@ -163,7 +163,7 @@ end = struct
| 5 ->
let header = [ Printf.sprintf " #%15d %15d %15d %15d %15d"
(imin+1) (imin+2) (imin+3) (imin+4) (imin+5) ; ] in
let new_lines =
let new_lines =
List.init ao_num ~f:(fun i ->
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i))
@ -171,10 +171,10 @@ end = struct
(MO_coef.to_float mo_coef.(imin+2).(i))
(MO_coef.to_float mo_coef.(imin+3).(i))
(MO_coef.to_float mo_coef.(imin+4).(i)) )
in header @ new_lines
in header @ new_lines
| _ -> assert false
in
let rec create_list accu i =
let rec create_list accu i =
if (i+4 < mo_num) then
create_list ( (print_five i (i+3) |> String.concat ~sep:"\n")::accu ) (i+4)
else

78
ocaml/Input_nuclei_by_hand.ml
View File

@ -3,7 +3,7 @@ open Qputils;;
open Core;;
module Nuclei_by_hand : sig
type t =
type t =
{ nucl_num : Nucl_number.t ;
nucl_label : Element.t array;
nucl_charge : Charge.t array;
@ -11,13 +11,13 @@ module Nuclei_by_hand : sig
} [@@deriving sexp]
;;
val read : unit -> t option
val write : t -> unit
val write : t -> unit
val to_string : t -> string
val to_atom_list : t -> Atom.t list
val to_rst : t -> Rst_string.t
val of_rst : Rst_string.t -> t option
end = struct
type t =
type t =
{ nucl_num : Nucl_number.t ;
nucl_label : Element.t array;
nucl_charge : Charge.t array;
@ -27,32 +27,32 @@ end = struct
let get_default = Qpackage.get_ezfio_default "nuclei";;
let read_nucl_num () =
let read_nucl_num () =
let nmax = Nucl_number.get_max () in
Nucl_number.of_int ~max:nmax nmax
;;
let write_nucl_num n =
let write_nucl_num n =
Nucl_number.to_int n
|> Ezfio.set_nuclei_nucl_num
;;
let read_nucl_label () =
Ezfio.get_nuclei_nucl_label ()
|> Ezfio.flattened_ezfio
|> Array.map ~f:Element.of_string
|> Array.map ~f:Element.of_string
;;
let write_nucl_label ~nucl_num labels =
let nucl_num =
let nucl_num =
Nucl_number.to_int nucl_num
in
let labels =
Array.to_list labels
Array.to_list labels
|> List.map ~f:Element.to_string
in
Ezfio.ezfio_array_of_list ~rank:1
Ezfio.ezfio_array_of_list ~rank:1
~dim:[| nucl_num |] ~data:labels
|> Ezfio.set_nuclei_nucl_label
;;
@ -65,14 +65,14 @@ end = struct
;;
let write_nucl_charge ~nucl_num charges =
let nucl_num =
let nucl_num =
Nucl_number.to_int nucl_num
in
let charges =
Array.to_list charges
|> List.map ~f:Charge.to_float
in
Ezfio.ezfio_array_of_list ~rank:1
Ezfio.ezfio_array_of_list ~rank:1
~dim:[| nucl_num |] ~data:charges
|> Ezfio.set_nuclei_nucl_charge
;;
@ -80,7 +80,7 @@ end = struct
let read_nucl_coord () =
let nucl_num = Nucl_number.to_int (read_nucl_num ()) in
let raw_data =
let raw_data =
Ezfio.get_nuclei_nucl_coord()
|> Ezfio.flattened_ezfio
in
@ -96,16 +96,16 @@ end = struct
;;
let write_nucl_coord ~nucl_num coord =
let nucl_num =
let nucl_num =
Nucl_number.to_int nucl_num
in
let coord = Array.to_list coord in
let coord =
let coord =
(List.map ~f:(fun x-> x.Point3d.x) coord) @
(List.map ~f:(fun x-> x.Point3d.y) coord) @
(List.map ~f:(fun x-> x.Point3d.z) coord)
(List.map ~f:(fun x-> x.Point3d.z) coord)
in
Ezfio.ezfio_array_of_list ~rank:2
Ezfio.ezfio_array_of_list ~rank:2
~dim:[| nucl_num ; 3 |] ~data:coord
|> Ezfio.set_nuclei_nucl_coord
;;
@ -132,23 +132,23 @@ end = struct
write_nucl_label ~nucl_num:nucl_num nucl_label;
write_nucl_charge ~nucl_num:nucl_num nucl_charge;
write_nucl_coord ~nucl_num:nucl_num nucl_coord;
;;
;;
let to_atom_list b =
let rec loop accu (coord, charge, label) = function
| -1 -> accu
| i ->
let atom =
{ Atom.element = label.(i) ;
Atom.charge = charge.(i) ;
Atom.coord = coord.(i) ;
}
in
loop (atom::accu) (coord, charge, label) (i-1)
in
loop [] (b.nucl_coord, b.nucl_charge, b.nucl_label)
( (Nucl_number.to_int b.nucl_num) - 1)
let rec loop accu (coord, charge, label) = function
| -1 -> accu
| i ->
let atom =
{ Atom.element = label.(i) ;
Atom.charge = charge.(i) ;
Atom.coord = coord.(i) ;
}
in
loop (atom::accu) (coord, charge, label) (i-1)
in
loop [] (b.nucl_coord, b.nucl_charge, b.nucl_label)
( (Nucl_number.to_int b.nucl_num) - 1)
;;
let to_string b =
@ -168,11 +168,11 @@ nucl_coord = %s
;;
let to_rst b =
let to_rst b =
let nucl_num = Nucl_number.to_int b.nucl_num in
let text =
let text =
( Printf.sprintf " %d\n "
nucl_num
nucl_num
) :: (
List.init nucl_num ~f:(fun i->
Printf.sprintf " %-3s %d %s"
@ -189,9 +189,9 @@ Nuclear coordinates in xyz format (Angstroms) ::
" text
|> Rst_string.of_string
;;
let of_rst s =
let l = Rst_string.to_string s
let l = Rst_string.to_string s
|> String.split ~on:'\n'
in
(* Find lines containing the xyz data *)
@ -208,8 +208,8 @@ Nuclear coordinates in xyz format (Angstroms) ::
in
(* Create a list of Atom.t *)
let nmax = Nucl_number.get_max () in
let atom_list =
match (extract_begin l) with
let atom_list =
match (extract_begin l) with
| _ :: nucl_num :: title :: lines ->
begin
let nucl_num = nucl_num
@ -224,7 +224,7 @@ Nuclear coordinates in xyz format (Angstroms) ::
| _ -> failwith "Error in xyz format"
in
(* Create the Nuclei.t data structure *)
let result =
let result =
{ nucl_num = List.length atom_list
|> Nucl_number.of_int ~max:nmax;
nucl_label = List.map atom_list ~f:(fun x ->

8
ocaml/Io_ext.ml
View File

@ -2,15 +2,15 @@ let input_lines filename =
let in_channel =
open_in filename
in
let rec aux accu =
let rec aux accu =
try
let newline =
let newline =
input_line in_channel
in
aux (newline::accu)
with End_of_file -> accu
in
let result =
let result =
List.rev (aux [])
in
close_in in_channel;
@ -18,7 +18,7 @@ let input_lines filename =
let read_all filename =
let read_all filename =
input_lines filename
|> String.concat "\n"

16
ocaml/Long_basis.ml
View File

@ -8,9 +8,9 @@ let of_basis b =
| [] -> accu
| (g,n)::tail ->
begin
let new_accu =
Symmetry.Xyz.of_symmetry g.Gto.sym
|> List.rev_map (fun x-> (x,g,n))
let new_accu =
Symmetry.Xyz.of_symmetry g.Gto.sym
|> List.rev_map (fun x-> (x,g,n))
in
do_work (new_accu@accu) tail
end
@ -22,12 +22,12 @@ let of_basis b =
let to_basis b =
let rec do_work accu = function
| [] -> List.rev accu
| (s,g,n)::tail ->
let first_sym =
| (s,g,n)::tail ->
let first_sym =
Symmetry.Xyz.of_symmetry g.Gto.sym
|> List.hd
in
let new_accu =
let new_accu =
if ( s = first_sym ) then
(g,n)::accu
else
@ -35,11 +35,11 @@ let to_basis b =
in
do_work new_accu tail
in
do_work [] b
do_work [] b
let to_string b =
let middle = List.map (fun (x,y,z) ->
let middle = List.map (fun (x,y,z) ->
"( "^((string_of_int (Nucl_number.to_int z)))^", "^
(Symmetry.Xyz.to_string x)^", "^(Gto.to_string y)
^" )"

4
ocaml/Long_basis.mli
View File

@ -1,6 +1,6 @@
open Qptypes;;
(** A long basis is a basis set where
(** A long basis is a basis set where
* all the P orbitals are converted to x, y, z
* all the D orbitals are converted to xx, xy, xz, yy, yx
* etc
@ -13,7 +13,7 @@ val of_basis :
(** Transform a long basis to a basis *)
val to_basis :
(Symmetry.Xyz.t * Gto.t * Nucl_number.t) list -> (Gto.t * Nucl_number.t) list
(Symmetry.Xyz.t * Gto.t * Nucl_number.t) list -> (Gto.t * Nucl_number.t) list
(** Convert the basis into its string representation *)
val to_string :

46
ocaml/MO_class.ml
View File

@ -1,7 +1,7 @@
open Core
open Qptypes
open Qptypes
type t =
type t =
| Core of MO_number.t list
| Inactive of MO_number.t list
| Active of MO_number.t list
@ -10,7 +10,7 @@ type t =
[@@deriving sexp]
let to_string x =
let to_string x =
let print_list l =
let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
|> (String.concat ~sep:", ")
@ -24,40 +24,40 @@ let to_string x =
| Active [] -> "Active"
| Virtual [] -> "Virtual"
| Deleted [] -> "Deleted"
| Core l -> "Core : "^(print_list l)
| Core l -> "Core : "^(print_list l)
| Inactive l -> "Inactive : "^(print_list l)
| Active l -> "Active : "^(print_list l)
| Virtual l -> "Virtual : "^(print_list l)
| Deleted l -> "Deleted : "^(print_list l)
let of_string s =
let of_string s =
match (String.lowercase s) with
| "core" -> Core []
| "inactive" -> Inactive []
| "active" -> Active []
| "virtual" -> Virtual []
| "deleted" -> Deleted []
| "core" -> Core []
| "inactive" -> Inactive []
| "active" -> Active []
| "virtual" -> Virtual []
| "deleted" -> Deleted []
| _ -> failwith "MO_class should be (Core|Inactive|Active|Virtual|Deleted)"
let _mo_number_list_of_range range =
Range.of_string range |> List.map ~f:MO_number.of_int
let _mo_number_list_of_range range =
Range.of_string range |> List.map ~f:MO_number.of_int
let create_core range = Core (_mo_number_list_of_range range)
let create_inactive range = Inactive (_mo_number_list_of_range range)
let create_active range = Active (_mo_number_list_of_range range)
let create_virtual range = Virtual (_mo_number_list_of_range range)
let create_deleted range = Deleted (_mo_number_list_of_range range)
let create_core range = Core (_mo_number_list_of_range range)
let create_inactive range = Inactive (_mo_number_list_of_range range)
let create_active range = Active (_mo_number_list_of_range range)
let create_virtual range = Virtual (_mo_number_list_of_range range)
let create_deleted range = Deleted (_mo_number_list_of_range range)
let to_bitlist n_int x =
match x with
| Core l
| Inactive l
| Active l
| Virtual l
match x with
| Core l
| Inactive l
| Active l
| Virtual l
| Deleted l -> Bitlist.of_mo_number_list n_int l

4
ocaml/MO_label.ml
View File

@ -19,8 +19,8 @@ let to_string = function
| None -> "None"
;;
let of_string s =
match String.lowercase (String.strip s) with
let of_string s =
match String.lowercase (String.strip s) with
| "guess" -> Guess
| "canonical" -> Canonical
| "natural" -> Natural

2
ocaml/Makefile
View File

@ -82,6 +82,8 @@ git:
${QP_EZFIO}/Ocaml/ezfio.ml:
$(NINJA) -C ${QP_EZFIO}
qp_edit.ml: ../scripts/ezfio_interface/qp_edit_template
Input_auto_generated.ml qp_edit.ml: $(filter-out Input_auto_generated.ml, $(wildcard Input_*.ml))
ei_handler.py ocaml_global

128
ocaml/Message.ml
View File

@ -4,9 +4,9 @@ open Qptypes
(** New job : Request to create a new multi-tasked job *)
module State : sig
type t
type t
val of_string : string -> t
val to_string : t -> string
val to_string : t -> string
end = struct
type t = string
let of_string x = x
@ -14,7 +14,7 @@ end = struct
end
module Newjob_msg : sig
type t =
type t =
{ state: State.t;
address_tcp: Address.Tcp.t ;
address_inproc: Address.Inproc.t;
@ -22,7 +22,7 @@ module Newjob_msg : sig
val create : address_tcp:string -> address_inproc:string -> state:string -> t
val to_string : t -> string
end = struct
type t =
type t =
{ state: State.t;
address_tcp: Address.Tcp.t ;
address_inproc: Address.Inproc.t;
@ -34,19 +34,19 @@ end = struct
}
let to_string t =
Printf.sprintf "new_job %s %s %s"
( State.to_string t.state )
( Address.Tcp.to_string t.address_tcp )
( Address.Inproc.to_string t.address_inproc )
( State.to_string t.state )
( Address.Tcp.to_string t.address_tcp )
( Address.Inproc.to_string t.address_inproc )
end
module Endjob_msg : sig
type t =
type t =
{ state: State.t;
}
val create : state:string -> t
val to_string : t -> string
end = struct
type t =
type t =
{ state: State.t;
}
let create ~state =
@ -54,7 +54,7 @@ end = struct
}
let to_string t =
Printf.sprintf "end_job %s"
( State.to_string t.state )
( State.to_string t.state )
end
@ -66,7 +66,7 @@ module Connect_msg : sig
val to_string : t -> string
end = struct
type t = Tcp | Inproc | Ipc
let create ~typ =
let create ~typ =
match typ with
| "tcp" -> Tcp
| "inproc" -> Inproc
@ -81,7 +81,7 @@ end
(** ConnectReply : Reply to the connect messsage *)
module ConnectReply_msg : sig
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
push_address: Address.t;
@ -89,12 +89,12 @@ module ConnectReply_msg : sig
val create : state:State.t -> client_id:Id.Client.t -> push_address:Address.t -> t
val to_string : t -> string
end = struct
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
push_address: Address.t;
}
let create ~state ~client_id ~push_address =
let create ~state ~client_id ~push_address =
{ client_id ; state ; push_address }
let to_string x =
Printf.sprintf "connect_reply %s %d %s"
@ -106,18 +106,18 @@ end
(** Disconnect : disconnect a client from the task server *)
module Disconnect_msg : sig
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
}
val create : state:string -> client_id:int -> t
val to_string : t -> string
end = struct
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
}
let create ~state ~client_id =
let create ~state ~client_id =
{ client_id = Id.Client.of_int client_id ; state = State.of_string state }
let to_string x =
Printf.sprintf "disconnect %s %d"
@ -126,18 +126,18 @@ end = struct
end
module DisconnectReply_msg : sig
type t =
{
type t =
{
state: State.t ;
}
val create : state:State.t -> t
val to_string : t -> string
end = struct
type t =
{
type t =
{
state: State.t ;
}
let create ~state =
let create ~state =
{ state }
let to_string x =
Printf.sprintf "disconnect_reply %s"
@ -148,14 +148,14 @@ end
(** AddTask : Add a new task to the queue *)
module AddTask_msg : sig
type t =
type t =
{ state: State.t;
tasks: string list;
}
val create : state:string -> tasks:string list -> t
val to_string : t -> string
end = struct
type t =
type t =
{ state: State.t;
tasks: string list;
}
@ -167,7 +167,7 @@ end
(** AddTaskReply : Reply to the AddTask message *)
module AddTaskReply_msg : sig
type t
type t
val create : task_id:Id.Task.t -> t
val to_string : t -> string
end = struct
@ -180,23 +180,23 @@ end
(** DelTask : Remove a task from the queue *)
module DelTask_msg : sig
type t =
type t =
{ state: State.t;
task_ids: Id.Task.t list
}
val create : state:string -> task_ids:int list -> t
val to_string : t -> string
end = struct
type t =
type t =
{ state: State.t;
task_ids: Id.Task.t list
}
let create ~state ~task_ids =
{ state = State.of_string state ;
{ state = State.of_string state ;
task_ids = List.map ~f:Id.Task.of_int task_ids
}
let to_string x =
Printf.sprintf "del_task %s %s"
Printf.sprintf "del_task %s %s"
(State.to_string x.state)
(String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
end
@ -204,7 +204,7 @@ end
(** DelTaskReply : Reply to the DelTask message *)
module DelTaskReply_msg : sig
type t
type t
val create : task_ids:Id.Task.t list -> more:bool -> t
val to_string : t -> string
end = struct
@ -214,30 +214,30 @@ end = struct
}
let create ~task_ids ~more = { task_ids ; more }
let to_string x =
let more =
let more =
if x.more then "more"
else "done"
in
Printf.sprintf "del_task_reply %s %s"
more (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
Printf.sprintf "del_task_reply %s %s"
more (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
end
(** GetTask : get a new task to do *)
module GetTask_msg : sig
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
}
val create : state:string -> client_id:int -> t
val to_string : t -> string
end = struct
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
}
let create ~state ~client_id =
let create ~state ~client_id =
{ client_id = Id.Client.of_int client_id ; state = State.of_string state }
let to_string x =
Printf.sprintf "get_task %s %d"
@ -247,7 +247,7 @@ end
(** GetTaskReply : Reply to the GetTask message *)
module GetTaskReply_msg : sig
type t
type t
val create : task_id:Id.Task.t option -> task:string option -> t
val to_string : t -> string
end = struct
@ -258,7 +258,7 @@ end = struct
let create ~task_id ~task = { task_id ; task }
let to_string x =
match x.task_id, x.task with
| Some task_id, Some task ->
| Some task_id, Some task ->
Printf.sprintf "get_task_reply %d %s" (Id.Task.to_int task_id) task
| _ ->
Printf.sprintf "get_task_reply 0"
@ -267,7 +267,7 @@ end
(** GetTasks : get a new task to do *)
module GetTasks_msg : sig
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
n_tasks: Strictly_positive_int.t ;
@ -275,12 +275,12 @@ module GetTasks_msg : sig
val create : state:string -> client_id:int -> n_tasks:int -> t
val to_string : t -> string
end = struct
type t =
type t =
{ client_id: Id.Client.t ;
state: State.t ;
n_tasks: Strictly_positive_int.t;
}
let create ~state ~client_id ~n_tasks =
let create ~state ~client_id ~n_tasks =
{ client_id = Id.Client.of_int client_id ; state = State.of_string state ;
n_tasks = Strictly_positive_int.of_int n_tasks }
let to_string x =
@ -300,15 +300,15 @@ end = struct
type t = (Id.Task.t option * string) list
let create l = l
let to_string _ =
"get_tasks_reply ok"
let to_string_list x =
"get_tasks_reply ok"
let to_string_list x =
"get_tasks_reply ok" :: (
List.map x ~f:(fun (task_id, task) ->
match task_id with
| Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task
| None -> Printf.sprintf "0 terminate"
| None -> Printf.sprintf "0 terminate"
) )
end
@ -325,7 +325,7 @@ end = struct
{ client_id : Id.Client.t ;
state : State.t ;
key : string; }
let create ~client_id ~state ~key =
let create ~client_id ~state ~key =
{ client_id = Id.Client.of_int client_id ;
state = State.of_string state;
key ; }
@ -361,13 +361,13 @@ end = struct
{ client_id : Id.Client.t ;
state : State.t ;
key : string }
let create ~client_id ~state ~key =
let create ~client_id ~state ~key =
{ client_id = Id.Client.of_int client_id ;
state = State.of_string state;
key }
let to_string x =
Printf.sprintf "get_data %s %d %s" (State.to_string x.state)
(Id.Client.to_int x.client_id) x.key
(Id.Client.to_int x.client_id) x.key
end
@ -375,12 +375,12 @@ end
module GetDataReply_msg : sig
type t
val create : value:string -> t
val to_string : t -> string
val to_string : t -> string
val to_string_list : t -> string list
end = struct
type t = string
let create ~value = value
let to_string x =
let to_string x =
Printf.sprintf "get_data_reply %d %s"
(String.length x) x
let to_string_list x = [
@ -405,8 +405,8 @@ end = struct
state: State.t ;
task_ids: Id.Task.t list;
}
let create ~state ~client_id ~task_ids =
{ client_id = Id.Client.of_int client_id ;
let create ~state ~client_id ~task_ids =
{ client_id = Id.Client.of_int client_id ;
state = State.of_string state ;
task_ids = List.map ~f:Id.Task.of_int task_ids;
}
@ -420,7 +420,7 @@ end
(** Terminate *)
module Terminate_msg : sig
type t
type t
val create : t
val to_string : t -> string
end = struct
@ -431,7 +431,7 @@ end
(** Abort *)
module Abort_msg : sig
type t
type t
val create : t
val to_string : t -> string
end = struct
@ -442,7 +442,7 @@ end
(** OK *)
module Ok_msg : sig
type t
type t
val create : t
val to_string : t -> string
end = struct
@ -453,14 +453,14 @@ end
(** Error *)
module Error_msg : sig
type t
type t
val create : string -> t
val to_string : t -> string
end = struct
type t = string
let create x = x
let to_string x =
String.concat ~sep:" " [ "error" ; x ]
String.concat ~sep:" " [ "error" ; x ]
end
@ -491,15 +491,15 @@ type t =
| Abort of Abort_msg.t
| Ok of Ok_msg.t
| Error of Error_msg.t
| SetStopped
| SetWaiting
| SetRunning
| SetStopped
| SetWaiting
| SetRunning
let of_string s =
let of_string s =
let open Message_lexer in
match parse s with
| AddTask_ { state ; tasks } ->
| AddTask_ { state ; tasks } ->
AddTask (AddTask_msg.create ~state ~tasks)
| DelTask_ { state ; task_ids } ->
DelTask (DelTask_msg.create ~state ~task_ids)
@ -528,8 +528,8 @@ let of_string s =
| SetRunning_ -> SetRunning
| Ok_ -> Ok (Ok_msg.create)
| Error_ m -> Error (Error_msg.create m)
let to_string = function
| GetData x -> GetData_msg.to_string x

54
ocaml/Molecule.ml
View File

@ -1,8 +1,8 @@
open Qptypes
open Qptypes
open Sexplib.Std
exception MultiplicityError of string
exception XYZError
exception XYZError
type t = {
nuclei : Atom.t list ;
@ -22,7 +22,7 @@ let get_charge { nuclei ; elec_alpha ; elec_beta } =
Charge.of_float (nucl_charge nuclei -. (float_of_int result))
let get_multiplicity m =
let get_multiplicity m =
let elec_alpha =
m.elec_alpha
in
@ -31,17 +31,17 @@ let get_multiplicity m =
let get_nucl_num m =
let nmax =
List.length m.nuclei
List.length m.nuclei
in
Nucl_number.of_int nmax ~max:nmax
let name m =
let name m =
let cm =
get_charge m
|> Charge.to_int
in
let c =
let c =
match cm with
| 0 -> ""
| 1 -> " (+)"
@ -72,9 +72,9 @@ let name m =
Element.to_string a
in
begin
match n with
match n with
| 1 -> build_name (a::accu) rest
| i when i>1 ->
| i when i>1 ->
let tmp = Printf.sprintf "%s%d" a i
in build_name (tmp::accu) rest
| _ -> assert false
@ -87,7 +87,7 @@ let name m =
String.concat "" result
let to_string_general ~f m =
let to_string_general ~f m =
let { nuclei ; elec_alpha ; elec_beta } = m
in
let n =
@ -102,8 +102,8 @@ let to_string_general ~f m =
let to_string =
to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
let to_xyz =
to_string_general ~f:Atom.to_xyz
let to_xyz =
to_string_general ~f:Atom.to_xyz
let of_xyz_string
@ -114,18 +114,18 @@ let of_xyz_string
|> List.filter (fun x -> x <> "")
|> List.map (fun x -> Atom.of_string units x)
in
let ne = ( get_charge {
let ne = ( get_charge {
nuclei=l ;
elec_alpha=(Elec_alpha_number.of_int 1) ;
elec_beta=(Elec_beta_number.of_int 0) }
|> Charge.to_int
elec_beta=(Elec_beta_number.of_int 0) }
|> Charge.to_int
) + 1 - (Charge.to_int charge)
|> Elec_number.of_int
|> Elec_number.of_int
in
let (na,nb) =
Multiplicity.to_alpha_beta ne multiplicity
in
let result =
let result =
{ nuclei = l ;
elec_alpha = na ;
elec_beta = nb }
@ -146,9 +146,9 @@ let of_xyz_file
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
filename =
let lines =
let lines =
match Io_ext.input_lines filename with
| natoms :: title :: rest ->
| natoms :: title :: rest ->
begin
try
if (int_of_string @@ String_ext.strip natoms) <= 0 then
@ -159,24 +159,24 @@ let of_xyz_file
String.concat "\n" rest
| _ -> raise XYZError
in
of_xyz_string ~charge:charge ~multiplicity:multiplicity
of_xyz_string ~charge:charge ~multiplicity:multiplicity
~units:units lines
let of_zmt_file
let of_zmt_file
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
filename =
filename =
Io_ext.read_all filename
|> Zmatrix.of_string
|> Zmatrix.to_xyz_string
|> of_xyz_string ~charge ~multiplicity ~units
let of_file
let of_file
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
filename =
filename =
try
of_xyz_file ~charge ~multiplicity ~units filename
with XYZError ->
@ -189,7 +189,7 @@ let distance_matrix molecule =
|> List.map (fun x -> x.Atom.coord)
|> Array.of_list
in
let n =
let n =
Array.length coord
in
let result =
@ -203,9 +203,9 @@ let distance_matrix molecule =
done;
done;
result
open Core ;;
include To_md5

6
ocaml/Molecule.mli
View File

@ -25,19 +25,19 @@ val to_xyz : t -> string
(** Creates a molecule from an xyz file *)
val of_xyz_file :
?charge:Charge.t ->
?charge:Charge.t ->
?multiplicity:Multiplicity.t ->
?units:Units.units -> string -> t
(** Creates a molecule from a zmt file *)
val of_zmt_file :
?charge:Charge.t ->
?charge:Charge.t ->
?multiplicity:Multiplicity.t ->
?units:Units.units -> string -> t
(** Creates a molecule from a file (xyz or zmt) *)
val of_file :
?charge:Charge.t ->
?charge:Charge.t ->
?multiplicity:Multiplicity.t ->
?units:Units.units -> string -> t

8
ocaml/Multiplicity.ml
View File

@ -6,7 +6,7 @@ type t = Strictly_positive_int.t [@@deriving sexp]
let of_int = Strictly_positive_int.of_int ;;
let to_int = Strictly_positive_int.to_int ;;
let to_string m =
let to_string m =
match (to_int m) with
| 1 -> "Singlet"
| 2 -> "Doublet"
@ -19,16 +19,16 @@ let to_string m =
| 9 -> "Nonet"
| i -> Printf.sprintf "%d-et" i
;;
let of_alpha_beta a b =
let a = Elec_alpha_number.to_int a
let a = Elec_alpha_number.to_int a
and b = Elec_beta_number.to_int b
in
assert (a >= b);
of_int (1 + a - b)
;;
let to_alpha_beta ne m =
let to_alpha_beta ne m =
let ne = Elec_number.to_int ne in
let nb = (ne-(to_int m)+1)/2 in
let na = ne - nb in

14
ocaml/Point3d.ml
View File

@ -8,7 +8,7 @@ type t = {
} [@@deriving sexp]
let of_tuple ~units (x,y,z) =
let f = match units with
let f = match units with
| Units.Bohr -> 1.
| Units.Angstrom -> Units.angstrom_to_bohr
in
@ -16,9 +16,9 @@ let of_tuple ~units (x,y,z) =
(** Read x y z coordinates in string s with units u *)
let of_string ~units s =
let f = match units with
let f = match units with
| Units.Bohr -> 1.
| Units.Angstrom -> Units.angstrom_to_bohr
| Units.Angstrom -> Units.angstrom_to_bohr
in
let l = s
|> String.split ~on:' '
@ -29,12 +29,12 @@ let of_string ~units s =
{ x = l.(0) *. f ;
y = l.(1) *. f ;
z = l.(2) *. f }
let distance2 p1 p2 =
let { x=x1 ; y=y1 ; z=z1 } = p1
and { x=x2 ; y=y2 ; z=z2 } = p2 in
(x2-.x1)*.(x2-.x1) +. (y2-.y1)*.(y2-.y1) +. (z2-.z1)*.(z2-.z1)
(x2-.x1)*.(x2-.x1) +. (y2-.y1)*.(y2-.y1) +. (z2-.z1)*.(z2-.z1)
|> Positive_float.of_float
@ -43,11 +43,11 @@ let distance p1 p2 =
let to_string ~units p =
let f = match units with
let f = match units with
| Units.Bohr -> 1.
| Units.Angstrom -> Units.bohr_to_angstrom
in
let { x=x ; y=y ; z=z } = p in
Printf.sprintf "%16.8f %16.8f %16.8f" (x*.f) (y*.f) (z*.f)

24
ocaml/Progress_bar.ml
View File

@ -1,7 +1,7 @@
open Core
type t =
{
{
title: string;
start_value: float;
cur_value : float;
@ -14,7 +14,7 @@ type t =
let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title =
{ title ; start_value ; end_value ; bar_length ; cur_value=start_value ;
init_time= Time.now () ; dirty = false ; next = Time.now () }
init_time= Time.now () ; dirty = false ; next = Time.now () }
let update ~cur_value bar =
{ bar with cur_value ; dirty=true }
@ -22,7 +22,7 @@ let update ~cur_value bar =
let increment_end bar =
{ bar with end_value=(bar.end_value +. 1.) ; dirty=false }
let clear bar =
let clear bar =
Printf.eprintf " \r%!";
None
@ -34,12 +34,12 @@ let display_tty bar =
let percent =
100. *. (bar.cur_value -. bar.start_value) /.
(bar.end_value -. bar.start_value)
in
in
let n_hashes =
(Float.of_int bar.bar_length) *. percent /. 100.
|> Float.to_int
in
let hashes =
let hashes =
String.init bar.bar_length ~f:(fun i ->
if (i < n_hashes) then '#'
else ' '
@ -48,11 +48,11 @@ let display_tty bar =
let now =
Time.now ()
in
let running_time =
let running_time =
Time.abs_diff now bar.init_time
in
let stop_time =
let x =
let x =
Time.Span.to_sec running_time
in
if (percent > 0.) then
@ -68,18 +68,18 @@ let display_tty bar =
(Time.Span.to_string running_time)
(stop_time |> Time.Span.to_string );
{ bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) }
let display_file bar =
let percent =
100. *. (bar.cur_value -. bar.start_value) /.
(bar.end_value -. bar.start_value)
in
let running_time =
in
let running_time =
Time.abs_diff (Time.now ()) bar.init_time
in
let stop_time =
let x =
let x =
Time.Span.to_sec running_time
in
if (percent > 0.) then
@ -93,7 +93,7 @@ let display_file bar =
(Time.Span.to_string running_time)
(Time.Span.to_string stop_time);
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 2.) }
let display bar =

72
ocaml/Pseudo.ml
View File

@ -4,22 +4,22 @@ open Qptypes
module GaussianPrimitive_local : sig
type t = {
type t = {
expo : AO_expo.t ;
r_power : R_power.t ;
} [@@deriving sexp]
val of_expo_r_power : AO_expo.t -> R_power.t -> t
val to_string : t -> string
end = struct
type t = {
type t = {
expo : AO_expo.t ;
r_power : R_power.t ;
} [@@deriving sexp]
let of_expo_r_power dz n =
let of_expo_r_power dz n =
{ expo = dz ; r_power = n }
let to_string p =
@ -31,7 +31,7 @@ end
module GaussianPrimitive_non_local : sig
type t = {
type t = {
expo : AO_expo.t ;
r_power : R_power.t ;
proj : Positive_int.t
@ -39,20 +39,20 @@ module GaussianPrimitive_non_local : sig
val of_proj_expo_r_power : Positive_int.t -> AO_expo.t -> R_power.t -> t
val to_string : t -> string
end = struct
type t = {
type t = {
expo : AO_expo.t ;
r_power : R_power.t ;
proj : Positive_int.t
} [@@deriving sexp]
let of_proj_expo_r_power p dz n =
let of_proj_expo_r_power p dz n =
{ expo = dz ; r_power = n ; proj = p }
let to_string p =
Printf.sprintf "(%d, %22e, %d)"
Printf.sprintf "(%d, %22e, %d)"
(R_power.to_int p.r_power)
(AO_expo.to_float p.expo)
(Positive_int.to_int p.proj)
@ -65,7 +65,7 @@ type t = {
element : Element.t ;
n_elec : Positive_int.t ;
local : (GaussianPrimitive_local.t * AO_coef.t ) list ;
non_local : (GaussianPrimitive_non_local.t * AO_coef.t ) list
non_local : (GaussianPrimitive_non_local.t * AO_coef.t ) list
} [@@deriving sexp]
let empty e =
@ -82,11 +82,11 @@ let to_string_local = function
"Local component:" ::
( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) ::
( List.map t ~f:(fun (l,c) -> Printf.sprintf "%20f %8d %20f"
(AO_coef.to_float c)
(AO_coef.to_float c)
(R_power.to_int l.GaussianPrimitive_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_local.expo)
) )
|> String.concat ~sep:"\n"
|> String.concat ~sep:"\n"
(** Transform the non-local component of the pseudopotential to a string *)
@ -96,16 +96,16 @@ let to_string_non_local = function
"Non-local component:" ::
( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") ::
( List.map t ~f:(fun (l,c) ->
let p =
let p =
Positive_int.to_int l.GaussianPrimitive_non_local.proj
in
Printf.sprintf "%20f %8d %20f |%d><%d|"
(AO_coef.to_float c)
(AO_coef.to_float c)
(R_power.to_int l.GaussianPrimitive_non_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_non_local.expo)
p p
) )
|> String.concat ~sep:"\n"
|> String.concat ~sep:"\n"
(** Transform the Pseudopotential to a string *)
let to_string t =
@ -118,22 +118,22 @@ let to_string t =
:: []
|> List.filter ~f:(fun x -> x <> "")
|> String.concat ~sep:"\n"
(** Find an element in the file *)
let find in_channel element =
In_channel.seek in_channel 0L;
let loop, element_read, old_pos =
ref true,
ref None,
ref None,
ref (In_channel.pos in_channel)
in
while !loop
do
try
let buffer =
let buffer =
old_pos := In_channel.pos in_channel;
match In_channel.input_line in_channel with
| Some line -> String.split ~on:' ' line
@ -141,7 +141,7 @@ let find in_channel element =
| None -> raise End_of_file
in
element_read := Some (Element.of_string buffer);
loop := !element_read <> (Some element)
loop := !element_read <> (Some element)
with
| Element.ElementError _ -> ()
| End_of_file -> loop := false
@ -153,7 +153,7 @@ let find in_channel element =
(** Read the Pseudopotential in GAMESS format *)
let read_element in_channel element =
match find in_channel element with
| Some e when e = element ->
| Some e when e = element ->
begin
let rec read result =
match In_channel.input_line in_channel with
@ -165,19 +165,19 @@ let read_element in_channel element =
read (line::result)
in
let data =
let data =
read []
|> List.rev
in
let debug_data =
let debug_data =
String.concat ~sep:"\n" data
in
let decode_first_line = function
| first_line :: rest ->
begin
let first_line_split =
let first_line_split =
String.split first_line ~on:' '
|> List.filter ~f:(fun x -> (String.strip x) <> "")
in
@ -193,11 +193,11 @@ let read_element in_channel element =
debug_data )
end
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
in
in
let rec loop create_primitive accu = function
| (0,rest) -> List.rev accu, rest
| (n,line::rest) ->
| (n,line::rest) ->
begin
match
String.split line ~on:' '
@ -208,10 +208,10 @@ let read_element in_channel element =
Int.of_string i
in
let elem =
( create_primitive
( create_primitive
(Float.of_string e |> AO_expo.of_float)
(i-2 |> R_power.of_int),
Float.of_string c |> AO_coef.of_float
Float.of_string c |> AO_coef.of_float
)
in
loop create_primitive (elem::accu) (n-1, rest)
@ -220,7 +220,7 @@ let read_element in_channel element =
| _ -> failwith ("Error reading pseudopotential\n"^debug_data)
in
let decode_local (pseudo,data) =
let decode_local (pseudo,data) =
let decode_local_n n rest =
let result, rest =
loop GaussianPrimitive_local.of_expo_r_power [] (Positive_int.to_int n,rest)
@ -238,15 +238,15 @@ let read_element in_channel element =
| _ -> failwith ("Unable to read (non-)local pseudopotential\n"^debug_data)
in
let decode_non_local (pseudo,data) =
let decode_non_local (pseudo,data) =
let decode_non_local_n proj n (pseudo,data) =
let result, rest =
let result, rest =
loop (GaussianPrimitive_non_local.of_proj_expo_r_power proj)
[] (Positive_int.to_int n, data)
in
{ pseudo with non_local = pseudo.non_local @ result }, rest
in
let rec new_proj (pseudo,data) proj =
let rec new_proj (pseudo,data) proj =
match data with
| n :: rest ->
let n =
@ -254,7 +254,7 @@ let read_element in_channel element =
|> Int.of_string
|> Positive_int.of_int
in
let result =
let result =
decode_non_local_n proj n (pseudo,rest)
and proj_next =
(Positive_int.to_int proj)+1
@ -268,11 +268,11 @@ let read_element in_channel element =
decode_first_line data
|> decode_local
|> decode_non_local
|> decode_non_local
end
| _ -> empty element
include To_md5
let to_md5 = to_md5 sexp_of_t

42
ocaml/Qpackage.ml
View File

@ -4,11 +4,11 @@ open Qputils;;
(** Variables related to the quantum package installation *)
let root =
let root =
match (Sys.getenv "QP_ROOT") with
| None -> failwith "QP_ROOT environment variable is not set.
Please source the quantum_package.rc file."
| Some x -> x
| Some x -> x
;;
let bit_kind_size = lazy (
@ -21,17 +21,17 @@ let bit_kind_size = lazy (
In_channel.close in_channel;
let rec get_data = function
| [] -> raise (Failure ("bit_kind_size not found in "^filename))
| line::tail ->
let line =
| [] -> raise (Failure ("bit_kind_size not found in "^filename))
| line::tail ->
let line =
begin match String.split ~on:'!' line |> List.hd with
| Some x -> x
| None -> ""
end in
begin match (String.rsplit2 ~on:':' line) with
| Some (_ ,buffer) ->
| Some (_ ,buffer) ->
begin match (String.split ~on:'=' buffer |> List.map ~f:String.strip) with
| ["bit_kind_size"; x] ->
| ["bit_kind_size"; x] ->
Int.of_string x |> Bit_kind_size.of_int
| _ -> get_data tail
end
@ -50,7 +50,7 @@ let bit_kind = lazy (
;;
let executables = lazy (
let filename = root^"/data/executables"
let filename = root^"/data/executables"
and func in_channel =
In_channel.input_lines in_channel
|> List.map ~f:(fun x ->
@ -63,10 +63,10 @@ let executables = lazy (
)
in
In_channel.with_file filename ~f:func
|> List.sort ~compare:(fun (x,_) (y,_) ->
|> List.sort ~compare:(fun (x,_) (y,_) ->
if x < y then -1
else if x > y then 1
else 0)
else 0)
)
@ -81,18 +81,18 @@ let get_ezfio_default_in_file ~directory ~data ~filename =
else
find_dir rest
| [] -> raise Caml.Not_found
in
in
let rec find_data = function
| line :: rest ->
if (line = "") then
raise Caml.Not_found
else if (line.[0] <> ' ') then
raise Caml.Not_found
else
else
begin
match (String.lsplit2 ~on:' ' (String.strip line)) with
| Some (l,r) ->
if (l = data) then
| Some (l,r) ->
if (l = data) then
String.strip r
else
find_data rest
@ -106,15 +106,15 @@ let get_ezfio_default_in_file ~directory ~data ~filename =
let get_ezfio_default directory data =
let dirname = root^"/data/ezfio_defaults/" in
let rec aux = function
| [] ->
let rec aux = function
| [] ->
begin
Printf.printf "%s/%s not found\n%!" directory data;
raise Caml.Not_found
end
| filename :: tail ->
let filename =
let filename =
dirname^filename
in
try
@ -124,11 +124,11 @@ let get_ezfio_default directory data =
in
Sys.readdir dirname
|> Array.to_list
|> aux
|> aux
;;
let ezfio_work ezfio_file =
let result =
let ezfio_work ezfio_file =
let result =
Filename.concat ezfio_file "work"
in
begin

14
ocaml/Qputils.ml
View File

@ -5,18 +5,18 @@ let rec transpose = function
| [] -> []
| []::tail -> transpose tail
| (x::t1)::t2 ->
let new_head = (x::(List.map List.hd t2))
let new_head = (x::(List.map List.hd t2))
and new_tail = (transpose (t1 :: (List.map List.tl t2) ))
in
in
new_head @ new_tail
;;
*)
let input_to_sexp s =
let result =
String_ext.split ~on:'\n' s
let result =
String_ext.split ~on:'\n' s
|> List.filter (fun x-> (String_ext.strip x) <> "")
|> List.map (fun x-> "("^
|> List.map (fun x-> "("^
(Str.global_replace (Str.regexp "=") " " x)
^")")
|> String.concat ""
@ -39,6 +39,6 @@ let rmdir dirname =
Unix.rmdir dir
in
remove_one dirname

40
ocaml/Queuing_system.ml
View File

@ -19,8 +19,8 @@ type t =
let create () =
{ queued_front = [] ;
queued_back = [] ;
{ queued_front = [] ;
queued_back = [] ;
running = RunningMap.empty ;
tasks = TasksMap.empty;
clients = ClientsSet.empty;
@ -37,7 +37,7 @@ let create () =
let add_task ~task q =
let task_id =
q.next_task_id
q.next_task_id
in
{ q with
queued_front = task_id :: q.queued_front ;
@ -52,7 +52,7 @@ let add_task ~task q =
let add_client q =
let client_id =
q.next_client_id
q.next_client_id
in
{ q with
clients = ClientsSet.add client_id q.clients;
@ -61,7 +61,7 @@ let add_client q =
}, client_id
let pop_task ~client_id q =
let pop_task ~client_id q =
let { queued_front ; queued_back ; running ; _ } =
q
in
@ -84,25 +84,25 @@ let pop_task ~client_id q =
and found =
try Some (TasksMap.find task_id q.tasks)
with Caml.Not_found -> None
in new_q, Some task_id, found
in new_q, Some task_id, found
| [] -> q, None, None
let del_client ~client_id q =
assert (ClientsSet.mem client_id q.clients);
{ q with
{ q with
clients = ClientsSet.remove client_id q.clients;
number_of_clients = q.number_of_clients - 1
}
let end_task ~task_id ~client_id q =
let end_task ~task_id ~client_id q =
let { running ; tasks ; _ } =
q
in
assert (ClientsSet.mem client_id q.clients);
let () =
let client_id_check =
let client_id_check =
try RunningMap.find task_id running with
Caml.Not_found -> failwith "Task already finished"
in
@ -113,11 +113,11 @@ let end_task ~task_id ~client_id q =
number_of_running = q.number_of_running - 1
}
let del_task ~task_id q =
let del_task ~task_id q =
let { tasks ; _ } =
q
in
if (TasksMap.mem task_id tasks) then
{ q with
tasks = TasksMap.remove task_id tasks;
@ -127,7 +127,7 @@ let del_task ~task_id q =
Printf.sprintf "Task %d is already deleted" (Id.Task.to_int task_id)
|> failwith
let number_of_tasks q =
assert (q.number_of_tasks >= 0);
@ -155,12 +155,12 @@ let to_string qs =
and r =
RunningMap.bindings running
|> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", "
^(Id.Client.to_string c)^")")
^(Id.Client.to_string c)^")")
|> String.concat " ; "
and t =
and t =
TasksMap.bindings tasks
|> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", \""
^c^"\")")
^c^"\")")
|> String.concat " ; "
in
Printf.sprintf "{
@ -173,15 +173,15 @@ tasks : [ %s
(number_of_tasks qs) (number_of_queued qs) (number_of_running qs) (number_of_clients qs)
q r t
let test () =
let q =
let q =
create ()
|> add_task ~task:"First Task"
|> add_task ~task:"Second Task"
in
let q, client_id =
let q, client_id =
add_client q
in
let q, task_id, task_content =
@ -205,5 +205,5 @@ let test () =
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
q
|> to_string
|> print_endline
|> print_endline

4
ocaml/Queuing_system.mli
View File

@ -6,8 +6,8 @@ type t = {
queued_front : Id.Task.t list ;
queued_back : Id.Task.t list ;
running : Id.Client.t RunningMap.t ;
tasks : string TasksMap.t ;
clients : ClientsSet.t ;
tasks : string TasksMap.t ;
clients : ClientsSet.t ;
next_client_id : Id.Client.t ;
next_task_id : Id.Task.t ;
number_of_queued : int ;

16
ocaml/Range.ml
View File

@ -1,7 +1,7 @@
open Sexplib.Std
(* A range is a string of the type:
*
*
* "[36-53,72-107,126-131]"
*
* that should represent the list of integers
@ -12,7 +12,7 @@ open Sexplib.Std
*)
type t = int list [@@deriving sexp]
type t = int list [@@deriving sexp]
let to_int_list r = r
@ -29,11 +29,11 @@ let expand_range r =
| i -> i::(do_work (i+1))
in do_work start
end
| None ->
| None ->
begin
match r with
| "" -> []
| _ -> [int_of_string r]
| _ -> [int_of_string r]
end
@ -48,17 +48,17 @@ let of_string s =
let l = String_ext.split ~on:',' s in
let l = List.map expand_range l in
List.concat l
|> List.sort_uniq compare
|> List.sort_uniq compare
let to_string l =
"[" ^
"[" ^
(List.map string_of_int l
|> String.concat ",") ^ "]"
(*
let rec do_work buf symbol = function
| [] -> buf
| a::([] as t) ->
| a::([] as t) ->
do_work (buf^symbol^(string_of_int a)) "" t
| a::(b::q as t) ->
if (b-a = 1) then
@ -66,7 +66,7 @@ let to_string l =
else
do_work (buf^symbol^","^(string_of_int b)) "" t
in
let result =
let result =
match l with
| [] -> "[]"
| h::t ->

2
ocaml/Range.mli
View File

@ -1,4 +1,4 @@
type t = int list [@@deriving sexp]
type t = int list [@@deriving sexp]
(** A range is a sorted list of ints in an interval.
It is created using a string :

32
ocaml/String_ext.ml
View File

@ -1,7 +1,7 @@
include String
(** Split a string on a given character *)
let split ?(on=' ') str =
let split ?(on=' ') str =
split_on_char on str
(*
let rec do_work ?(accu=[]) ?(left="") = function
@ -9,10 +9,10 @@ let split ?(on=' ') str =
| s ->
let new_s =
(length s) - 1
|> sub s 1
|> sub s 1
in
if (s.[0] = on) then
let new_accu =
let new_accu =
left :: accu
in
do_work ~accu:new_accu new_s
@ -24,7 +24,7 @@ let split ?(on=' ') str =
in
do_work str
*)
(** Strip blanks on the left of a string *)
let ltrim s =
@ -53,7 +53,7 @@ let rtrim s =
| ' ' -> do_work (sub s 0 (newl)) (newl)
| _ -> s
in
let l =
let l =
length s
in
if (l > 0) then
@ -68,16 +68,16 @@ let strip = String.trim
(** Split a string in two pieces when a character is found the 1st time from the left *)
let lsplit2_exn ?(on=' ') s =
let length =
let length =
String.length s
in
let rec do_work i =
let rec do_work i =
if (i = length) then
begin
raise Not_found
end
else if (s.[i] = on) then
( String.sub s 0 i,
( String.sub s 0 i,
String.sub s (i+1) (length-i-1) )
else
do_work (i+1)
@ -87,16 +87,16 @@ let lsplit2_exn ?(on=' ') s =
(** Split a string in two pieces when a character is found the 1st time from the right *)
let rsplit2_exn ?(on=' ') s =
let length =
let length =
String.length s
in
let rec do_work i =
let rec do_work i =
if (i = -1) then
begin
raise Not_found
end
else if (s.[i] = on) then
( String.sub s 0 i,
( String.sub s 0 i,
String.sub s (i+1) (length-i-1) )
else
do_work (i-1)
@ -106,14 +106,14 @@ let rsplit2_exn ?(on=' ') s =
let lsplit2 ?(on=' ') s =
try
Some (lsplit2_exn ~on s)
Some (lsplit2_exn ~on s)
with
| Not_found -> None
let rsplit2 ?(on=' ') s =
try
Some (rsplit2_exn ~on s)
Some (rsplit2_exn ~on s)
with
| Not_found -> None
@ -125,9 +125,9 @@ let to_list s =
let fold ~init ~f s =
to_list s
|> List.fold_left f init
|> List.fold_left f init
let is_prefix ~prefix s =
let len =
String.length prefix
@ -135,7 +135,7 @@ let is_prefix ~prefix s =
if len > String.length s then
false
else
prefix = String.sub s 0 len
prefix = String.sub s 0 len
let of_char c =

34
ocaml/Symmetry.ml
View File

@ -55,7 +55,7 @@ let to_l = function
| L -> Positive_int.of_int 9
let of_l i =
let of_l i =
let i = Positive_int.to_int i in
match i with
| 0 -> S
@ -84,44 +84,44 @@ module Xyz = struct
* The input string is like "x2z3" *)
let of_string s =
let flush state accu number =
let n =
let n =
if (number = "") then 1
else (int_of_string number)
else (int_of_string number)
in
match state with
| X -> { x= Positive_int.(of_int ( (to_int accu.x) +n));
y= accu.y ;
z= accu.z }
| Y -> { x= accu.x ;
| Y -> { x= accu.x ;
y= Positive_int.(of_int ( (to_int accu.y) +n));
z= accu.z }
| Z -> { x= accu.x ;
| Z -> { x= accu.x ;
y= accu.y ;
z= Positive_int.(of_int ( (to_int accu.z) +n))}
| Null -> accu
in
let rec do_work state accu number = function
| [] -> flush state accu number
| 'X'::rest | 'x'::rest ->
let new_accu = flush state accu number in
| 'X'::rest | 'x'::rest ->
let new_accu = flush state accu number in
do_work X new_accu "" rest
| 'Y'::rest | 'y'::rest ->
let new_accu = flush state accu number in
| 'Y'::rest | 'y'::rest ->
let new_accu = flush state accu number in
do_work Y new_accu "" rest
| 'Z'::rest | 'z'::rest ->
let new_accu = flush state accu number in
| 'Z'::rest | 'z'::rest ->
let new_accu = flush state accu number in
do_work Z new_accu "" rest
| c::rest -> do_work state accu (number^(String_ext.of_char c)) rest
in
String_ext.to_list s
|> do_work Null
{ x=Positive_int.of_int 0 ;
String_ext.to_list s
|> do_work Null
{ x=Positive_int.of_int 0 ;
y=Positive_int.of_int 0 ;
z=Positive_int.of_int 0 } ""
z=Positive_int.of_int 0 } ""
(** Transforms an XYZ triplet to a string *)
let to_string t =
let to_string t =
let x = match (Positive_int.to_int t.x) with
| 0 -> ""
| 1 -> "x"
@ -151,7 +151,7 @@ module Xyz = struct
(** Returns a list of XYZ powers for a given symmetry *)
let of_symmetry sym =
let l = Positive_int.to_int (to_l sym) in
let create_z xyz =
let create_z xyz =
{ x=xyz.x ;
y=xyz.y ;
z=Positive_int.(of_int (l-((to_int xyz.x)+(to_int xyz.y))))

184
ocaml/TaskServer.ml
View File

@ -24,7 +24,7 @@ type t =
{
queue : Queuing_system.t ;
state : Message.State.t option ;
address_tcp : Address.Tcp.t option ;
address_tcp : Address.Tcp.t option ;
address_inproc : Address.Inproc.t option ;
progress_bar : Progress_bar.t option ;
running : bool;
@ -59,7 +59,7 @@ let bind_socket ~socket_type ~socket ~port =
"Unable to bind the %s socket to port : %d "
socket_type port
| -1 -> ()
| i ->
| i ->
try
Zmq.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
loop (-1)
@ -103,14 +103,14 @@ let ip_address = lazy (
let reply_ok rep_socket =
Message.Ok_msg.create
Message.Ok_msg.create
|> Message.Ok_msg.to_string
|> Zmq.Socket.send rep_socket
|> Zmq.Socket.send rep_socket
let reply_wrong_state rep_socket =
Message.Error_msg.create "Wrong state"
|> Message.Error_msg.to_string
|> Zmq.Socket.send rep_socket
|> Zmq.Socket.send rep_socket
@ -143,7 +143,7 @@ let stop ~port =
let new_job msg program_state rep_socket pair_socket =
let state =
let state =
msg.Message.Newjob_msg.state
in
@ -155,7 +155,7 @@ let new_job msg program_state rep_socket pair_socket =
~title:(Message.State.to_string state)
in
let result =
let result =
{ program_state with
state = Some state ;
progress_bar = Some progress_bar ;
@ -170,9 +170,9 @@ let new_job msg program_state rep_socket pair_socket =
result
let change_pub_state msg program_state rep_socket pair_socket =
let msg =
let msg =
match msg with
| `Waiting -> Waiting
| `Waiting -> Waiting
| `Stopped -> Stopped
| `Running ->
begin
@ -190,7 +190,7 @@ let change_pub_state msg program_state rep_socket pair_socket =
program_state
let force_state =
let force_state =
Message.State.of_string "force"
let end_job msg program_state rep_socket pair_socket =
@ -201,7 +201,7 @@ let end_job msg program_state rep_socket pair_socket =
and success () =
reply_ok rep_socket;
{
{
queue = Queuing_system.create ();
state = None ;
progress_bar = Progress_bar.clear ();
@ -214,7 +214,7 @@ let end_job msg program_state rep_socket pair_socket =
and wait n =
Printf.sprintf "waiting for %d slaves..." n
|> Message.Error_msg.create
|> Message.Error_msg.create
|> Message.Error_msg.to_string
|> Zmq.Socket.send rep_socket ;
program_state
@ -222,7 +222,7 @@ let end_job msg program_state rep_socket pair_socket =
match program_state.state with
| None -> failure ()
| Some state ->
| Some state ->
begin
if (msg.Message.Endjob_msg.state = force_state) then
begin
@ -256,16 +256,16 @@ let connect msg program_state rep_socket =
else
match program_state.state with
| None -> failure ()
| Some state ->
| Some state ->
let push_address =
match msg with
| Message.Connect_msg.Tcp ->
| Message.Connect_msg.Tcp ->
begin
match program_state.address_tcp with
| Some address -> Address.Tcp address
| None -> failwith "Error: No TCP address"
end
| Message.Connect_msg.Inproc ->
| Message.Connect_msg.Inproc ->
begin
match program_state.address_inproc with
| Some address -> Address.Inproc address
@ -273,7 +273,7 @@ let connect msg program_state rep_socket =
end
| Message.Connect_msg.Ipc -> assert false
in
let new_queue, client_id =
Queuing_system.add_client program_state.queue
in
@ -282,24 +282,24 @@ let connect msg program_state rep_socket =
|> Message.to_string
|> Zmq.Socket.send rep_socket ;
{ program_state with
queue = new_queue
queue = new_queue
}
let disconnect msg program_state rep_socket =
let state, client_id =
msg.Message.Disconnect_msg.state,
msg.Message.Disconnect_msg.state,
msg.Message.Disconnect_msg.client_id
in
let failure () =
reply_wrong_state rep_socket;
program_state
and success () =
let new_program_state =
and success () =
let new_program_state =
{ program_state with
queue = Queuing_system.del_client ~client_id program_state.queue
}
@ -313,41 +313,41 @@ let disconnect msg program_state rep_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
begin
if (state = state') then
success ()
else
failure ()
end
let del_task msg program_state rep_socket =
let state, task_ids =
msg.Message.DelTask_msg.state,
msg.Message.DelTask_msg.state,
msg.Message.DelTask_msg.task_ids
in
let failure () =
reply_wrong_state rep_socket;
program_state
and success () =
let queue =
and success () =
let queue =
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
~init:program_state.queue task_ids
in
let accepting_clients =
(Queuing_system.number_of_queued queue > Queuing_system.number_of_clients queue)
let accepting_clients =
(Queuing_system.number_of_queued queue > Queuing_system.number_of_clients queue)
in
let new_program_state =
let new_program_state =
{ program_state with
accepting_clients ;
queue ;
}
in
let more =
let more =
(Queuing_system.number_of_tasks queue > 0)
in
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_ids ~more)
@ -359,7 +359,7 @@ let del_task msg program_state rep_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
begin
if (state = state') then
success ()
@ -381,12 +381,12 @@ let add_task msg program_state rep_socket =
| None -> None
in
let result =
let new_queue, new_bar =
let result =
let new_queue, new_bar =
List.fold ~f:(fun (queue, bar) task ->
Queuing_system.add_task ~task queue,
increment_progress_bar bar)
~init:(program_state.queue, program_state.progress_bar) tasks
~init:(program_state.queue, program_state.progress_bar) tasks
in
{ program_state with
queue = new_queue;
@ -401,23 +401,23 @@ let add_task msg program_state rep_socket =
let get_task msg program_state rep_socket pair_socket =
let state, client_id =
msg.Message.GetTask_msg.state,
msg.Message.GetTask_msg.state,
msg.Message.GetTask_msg.client_id
in
let failure () =
reply_wrong_state rep_socket;
program_state
and success () =
and success () =
let queue, task_id, task =
Queuing_system.pop_task ~client_id program_state.queue
in
let accepting_clients =
let accepting_clients =
(Queuing_system.number_of_queued queue >
Queuing_system.number_of_clients queue)
Queuing_system.number_of_clients queue)
in
let no_task =
@ -425,13 +425,13 @@ let get_task msg program_state rep_socket pair_socket =
in
if no_task then
string_of_pub_state Waiting
string_of_pub_state Waiting
|> Zmq.Socket.send pair_socket
else
string_of_pub_state (Running (Message.State.to_string state))
|> Zmq.Socket.send pair_socket;
let new_program_state =
let new_program_state =
{ program_state with
queue ;
accepting_clients;
@ -447,7 +447,7 @@ let get_task msg program_state rep_socket pair_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
begin
if (state = state') then
success ()
@ -460,7 +460,7 @@ let get_task msg program_state rep_socket pair_socket =
let get_tasks msg program_state rep_socket pair_socket =
let state, client_id, n_tasks =
msg.Message.GetTasks_msg.state,
msg.Message.GetTasks_msg.state,
msg.Message.GetTasks_msg.client_id,
Strictly_positive_int.to_int msg.Message.GetTasks_msg.n_tasks
in
@ -468,17 +468,17 @@ let get_tasks msg program_state rep_socket pair_socket =
let failure () =
reply_wrong_state rep_socket;
program_state
and success () =
and success () =
let rec build_list accu queue = function
| 0 -> queue, (List.rev accu)
| n ->
| n ->
let new_queue, task_id, task =
Queuing_system.pop_task ~client_id queue
in
match (task_id, task) with
| Some task_id, Some task ->
| Some task_id, Some task ->
build_list ( (Some task_id, task)::accu ) new_queue (n-1)
| _ -> build_list ( (None, "terminate")::accu ) queue 0
in
@ -491,19 +491,19 @@ let get_tasks msg program_state rep_socket pair_socket =
Queuing_system.number_of_queued new_queue = 0
in
let accepting_clients =
let accepting_clients =
(Queuing_system.number_of_queued new_queue >
Queuing_system.number_of_clients new_queue)
Queuing_system.number_of_clients new_queue)
in
if no_task then
string_of_pub_state Waiting
string_of_pub_state Waiting
|> Zmq.Socket.send pair_socket
else
string_of_pub_state (Running (Message.State.to_string state))
|> Zmq.Socket.send pair_socket;
let new_program_state =
let new_program_state =
{ program_state with
queue = new_queue;
accepting_clients;
@ -518,7 +518,7 @@ let get_tasks msg program_state rep_socket pair_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
begin
if (state = state') then
success ()
@ -544,21 +544,21 @@ let task_done msg program_state rep_socket =
let failure () =
reply_wrong_state rep_socket;
program_state
and success () =
let new_queue, new_bar =
List.fold ~f:(fun (queue, bar) task_id ->
and success () =
let new_queue, new_bar =
List.fold ~f:(fun (queue, bar) task_id ->
Queuing_system.end_task ~task_id ~client_id queue,
increment_progress_bar bar)
~init:(program_state.queue, program_state.progress_bar) task_ids
~init:(program_state.queue, program_state.progress_bar) task_ids
in
let accepting_clients =
let accepting_clients =
(Queuing_system.number_of_queued new_queue >
Queuing_system.number_of_clients new_queue)
Queuing_system.number_of_clients new_queue)
in
let result =
let result =
{ program_state with
queue = new_queue;
progress_bar = new_bar;
@ -571,7 +571,7 @@ let task_done msg program_state rep_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
begin
if (state = state') then
success ()
@ -586,7 +586,7 @@ let put_data msg rest_of_msg program_state rep_socket =
debug (Message.PutData_msg.to_string msg);
let state, key, value =
msg.Message.PutData_msg.state,
msg.Message.PutData_msg.key,
msg.Message.PutData_msg.key,
match rest_of_msg with
| [ x ] -> x
| _ -> failwith "Badly formed put_data message"
@ -606,7 +606,7 @@ let put_data msg rest_of_msg program_state rep_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
if (state = state') then
success ()
else
@ -621,8 +621,8 @@ let get_data msg program_state rep_socket =
msg.Message.GetData_msg.key
in
let success () =
let value =
let success () =
let value =
match StringHashtbl.find program_state.data key with
| Some value -> value
| None -> "\000"
@ -639,7 +639,7 @@ let get_data msg program_state rep_socket =
match program_state.state with
| None -> assert false
| Some state' ->
| Some state' ->
if (state = state') then
success ()
else
@ -654,7 +654,7 @@ let terminate program_state rep_socket =
running = false
}
let abort program_state rep_socket =
let queue, client_id =
Queuing_system.add_client program_state.queue
@ -665,7 +665,7 @@ let abort program_state rep_socket =
let new_queue, task_id, _ =
Queuing_system.pop_task ~client_id queue
in
let new_accu =
let new_accu =
match task_id with
| Some task_id -> task_id::accu
| None -> accu
@ -676,12 +676,12 @@ let abort program_state rep_socket =
let queue, tasks =
aux [] queue 1
in
let queue =
List.fold ~f:(fun queue task_id ->
let queue =
List.fold ~f:(fun queue task_id ->
Queuing_system.end_task ~task_id ~client_id queue)
~init:queue tasks
in
let queue =
let queue =
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
~init:queue tasks
in
@ -691,18 +691,18 @@ let abort program_state rep_socket =
reply_ok rep_socket;
{ program_state with
queue ;
queue ;
accepting_clients = false;
}
let error msg program_state rep_socket =
Message.Error (Message.Error_msg.create msg)
|> Message.to_string
|> Zmq.Socket.send rep_socket ;
program_state
let start_pub_thread ~port =
let start_pub_thread ~port =
Thread.create (fun () ->
let timeout =
1000
@ -710,8 +710,8 @@ let start_pub_thread ~port =
let pair_socket =
Zmq.Socket.create zmq_context Zmq.Socket.pair
and address =
"inproc://pair"
and address =
"inproc://pair"
in
Zmq.Socket.connect pair_socket address;
@ -721,13 +721,13 @@ let start_pub_thread ~port =
bind_socket ~socket_type:"PUB" ~socket:pub_socket ~port;
let pollitem =
Zmq.Poll.mask_of
Zmq.Poll.mask_of
[| (pair_socket, Zmq.Poll.In) |]
in
let rec run state =
let rec run state =
let new_state =
let polling =
let polling =
Zmq.Poll.poll ~timeout pollitem
in
if (polling.(0) = Some Zmq.Poll.In) then
@ -753,12 +753,12 @@ let run ~port =
(** Bind inproc socket for changing state of pub *)
let pair_socket =
Zmq.Socket.create zmq_context Zmq.Socket.pair
and address =
"inproc://pair"
and address =
"inproc://pair"
in
Zmq.Socket.bind pair_socket address;
let pub_thread =
let pub_thread =
start_pub_thread ~port:(port+1) ()
in
@ -804,11 +804,11 @@ let run ~port =
main_loop program_state true
else
begin
let program_state =
let program_state =
match program_state.progress_bar with
| None -> program_state
| Some bar ->
if bar.Progress_bar.dirty then
| Some bar ->
if bar.Progress_bar.dirty then
{ program_state with
progress_bar = Some (Progress_bar.display bar)
}
@ -827,7 +827,7 @@ let run ~port =
in
(** Debug input *)
let () =
let () =
if debug_env then
begin
Printf.sprintf "q:%d r:%d n:%d c:%d : %s\n%!"
@ -840,7 +840,7 @@ let run ~port =
end
in
let new_program_state =
let new_program_state =
try
match program_state.state, message with
| _ , Message.Terminate _ -> terminate program_state rep_socket
@ -864,7 +864,7 @@ let run ~port =
| _ , _ ->
error ("Invalid message : "^(Message.to_string message)) program_state rep_socket
with
| Failure f ->
| Failure f ->
error (f^" : "^raw_message) program_state rep_socket
| Assert_failure (f,i,j) ->
error (Printf.sprintf "%s:%d:%d : %s" f i j raw_message) program_state rep_socket
@ -881,4 +881,4 @@ let run ~port =

2
ocaml/Units.ml
View File

@ -1,5 +1,5 @@
type units =
type units =
| Bohr
| Angstrom
;;

70
ocaml/Zmatrix.ml
View File

@ -18,36 +18,36 @@ let rec in_range (xmin, xmax) x =
else
x
let atom_id_of_int : int -> atom_id =
let atom_id_of_int : int -> atom_id =
fun x -> ( assert (x>0) ; x)
let distance_of_float : float -> distance =
let distance_of_float : float -> distance =
fun x -> ( assert (x>=0.) ; Value x)
let angle_of_float : float -> angle =
let angle_of_float : float -> angle =
fun x -> Value (in_range (-180., 180.) x)
let dihedral_of_float : float -> dihedral =
let dihedral_of_float : float -> dihedral =
fun x -> Value (in_range (-360., 360.) x)
let atom_id_of_string : string -> atom_id =
let atom_id_of_string : string -> atom_id =
fun i -> atom_id_of_int @@ int_of_string i
let distance_of_string : string -> distance =
fun s ->
fun s ->
try
distance_of_float @@ float_of_string s
with _ -> Label s
let angle_of_string : string -> angle =
fun s ->
fun s ->
try
angle_of_float @@ float_of_string s
with _ -> Label s
let dihedral_of_string : string -> dihedral =
fun s ->
fun s ->
try
dihedral_of_float @@ float_of_string s
with _ -> Label s
@ -55,7 +55,7 @@ let dihedral_of_string : string -> dihedral =
let int_of_atom_id : atom_id -> int = fun x -> x
let float_of_distance : float StringMap.t -> distance -> float =
let float_of_distance : float StringMap.t -> distance -> float =
fun map -> function
| Value x -> x
| Label s -> StringMap.find s map
@ -71,7 +71,7 @@ let float_of_dihedral : float StringMap.t -> dihedral -> float =
| Label s -> StringMap.find s map
type line =
type line =
| First of Element.t
| Second of (Element.t * distance)
| Third of (Element.t * atom_id * distance * atom_id * angle)
@ -79,7 +79,7 @@ type line =
| Coord of (string * float)
let string_of_line map =
let string_of_line map =
let f_r = float_of_distance map
and f_a = float_of_angle map
and f_d = float_of_dihedral map
@ -102,7 +102,7 @@ let line_of_string l =
| e :: i :: r :: [] -> Second
(Element.of_string e,
distance_of_string r)
| e :: i :: r :: j :: a :: [] -> Third
| e :: i :: r :: j :: a :: [] -> Third
(Element.of_string e,
atom_id_of_string i,
distance_of_string r,
@ -130,7 +130,7 @@ let of_string t =
|> List.map line_of_string
in
let l =
let l =
match l with
| First _ :: Second _ :: Third _ :: _
| First _ :: Second _ :: Coord _ :: []
@ -151,7 +151,7 @@ let of_string t =
work [] (StringMap.empty) l
in
(Array.of_list l, m)
(** Linear algebra *)
@ -176,17 +176,17 @@ let normalized u =
let cross (x,y,z) (x',y',z') =
((y *. z' -. z *. y'), -. (x *. z' -. z *. x'), (x *. y' -. y *. x'))
let rotation_matrix axis angle =
let rotation_matrix axis angle =
(* Euler-Rodrigues formula for rotation matrix, taken from
https://github.com/jevandezande/zmatrix/blob/master/converter.py
*)
let a =
let a =
(cos (angle *. to_radian *. 0.5))
in
let (b, c, d) =
let (b, c, d) =
(-. sin (angle *. to_radian *. 0.5)) |. (normalized axis)
in
Array.of_list @@
Array.of_list @@
[(a *. a +. b *. b -. c *. c -. d *. d,
2. *. (b *. c -. a *. d),
2. *. (b *. d +. a *. c));
@ -196,12 +196,12 @@ let rotation_matrix axis angle =
(2. *. (b *. d -. a *. c),
2. *. (c *. d +. a *. b),
a *. a +. d *. d -. b *. b -. c *. c)]
let apply_rotation_matrix rot u =
(dot rot.(0) u, dot rot.(1) u, dot rot.(2) u)
let center_of_mass l =
let (x,y,z) =
let sum_mass, com =
@ -209,7 +209,7 @@ let (x,y,z) =
let mass =
Positive_float.to_float @@ Element.mass e
in
(s +. mass, ( mass |. (x,y,z) ) |+ com) )
(s +. mass, ( mass |. (x,y,z) ) |+ com) )
(0., (0.,0.,0.)) l
in
(1. /. sum_mass) |. com
@ -219,7 +219,7 @@ Printf.printf "%f %f %f\n" x y z ; (x,y,z)
let to_xyz (z,map) =
let result =
Array.make (Array.length z) None
in
in
let get_cartesian_coord i =
match result.(i-1) with
@ -230,14 +230,14 @@ let to_xyz (z,map) =
let append_line i' =
match z.(i') with
| First e ->
| First e ->
result.(i') <- Some (e, 0., 0., 0.)
| Second (e, r) ->
| Second (e, r) ->
let r =
float_of_distance map r
in
result.(i') <- Some (e, 0., 0., r)
| Third (e, i, r, j, a) ->
| Third (e, i, r, j, a) ->
begin
let i, r, j, a =
int_of_atom_id i,
@ -246,13 +246,13 @@ let to_xyz (z,map) =
float_of_angle map a
in
let ui, uj =
get_cartesian_coord i,
get_cartesian_coord i,
get_cartesian_coord j
in
let u_ij =
let u_ij =
(uj |- ui)
in
let rot =
let rot =
rotation_matrix (0., 1., 0.) a
in
let new_vec =
@ -263,7 +263,7 @@ let to_xyz (z,map) =
in
result.(i') <- Some (e, x, y, z)
end
| Other (e, i, r, j, a, k, d) ->
| Other (e, i, r, j, a, k, d) ->
begin
let i, r, j, a, k, d =
int_of_atom_id i,
@ -274,7 +274,7 @@ let to_xyz (z,map) =
float_of_dihedral map d
in
let ui, uj, uk =
get_cartesian_coord i,
get_cartesian_coord i,
get_cartesian_coord j,
get_cartesian_coord k
in
@ -284,7 +284,7 @@ let to_xyz (z,map) =
let normal =
cross u_ij u_kj
in
let new_vec =
let new_vec =
r |. (normalized u_ij)
|> apply_rotation_matrix (rotation_matrix normal a)
|> apply_rotation_matrix (rotation_matrix u_ij d)
@ -297,7 +297,7 @@ let to_xyz (z,map) =
| Coord _ -> ()
in
Array.iteri (fun i _ -> append_line i) z;
let result =
let result =
Array.map (function
| Some x -> x
| None -> failwith "Some atoms were not defined" ) result
@ -306,9 +306,9 @@ let to_xyz (z,map) =
let to_xyz_string (l,map) =
String.concat "\n"
( to_xyz (l,map)
|> List.map (fun (e,x,y,z) ->
String.concat "\n"
( to_xyz (l,map)
|> List.map (fun (e,x,y,z) ->
Printf.sprintf "%s %f %f %f\n" (Element.to_string e) x y z) )

12
ocaml/element_create_db.ml
View File

@ -3,14 +3,14 @@ open Qptypes
open Element
let () =
let indices =
let indices =
Array.init 78 (fun i -> i)
in
Out_channel.with_file (Qpackage.root ^ "/data/list_element.txt")
~f:(fun out_channel ->
Array.init 110 ~f:(fun i ->
Array.init 110 ~f:(fun i ->
let element =
try
try
Some (of_charge (Charge.of_int i))
with
| _ -> None
@ -21,7 +21,7 @@ let () =
i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x )
)
|> Array.to_list
|> String.concat ~sep:""
|> Out_channel.output_string out_channel
|> String.concat ~sep:""
|> Out_channel.output_string out_channel
)

2
ocaml/myocamlbuild.ml
View File

@ -1,7 +1,7 @@
open Ocamlbuild_plugin;;
dispatch begin function
| Before_rules ->
| Before_rules ->
begin
end
| After_rules ->

284
ocaml/qp_create_ezfio_from_xyz.ml
View File

@ -21,11 +21,11 @@ let dummy_centers ~threshold ~molecule ~nuclei =
| (-1,_) -> accu
| (i,-1) -> aux accu (i-1,i-1)
| (i,j) when (i>j) ->
let new_accu =
let new_accu =
let x,y =
Element.covalent_radius (nuclei.(i)).Atom.element |> Positive_float.to_float,
Element.covalent_radius (nuclei.(i)).Atom.element |> Positive_float.to_float,
Element.covalent_radius (nuclei.(j)).Atom.element |> Positive_float.to_float
in
in
let r =
( x +. y ) *. threshold
in
@ -39,37 +39,36 @@ let dummy_centers ~threshold ~molecule ~nuclei =
in
aux [] (n-1,n-1)
|> List.map ~f:(fun (i,x,j,y,r) ->
let f =
let f =
x /. (x +. y)
in
let u =
let u =
Point3d.of_tuple ~units:Units.Bohr
( nuclei.(i).Atom.coord.Point3d.x +.
(nuclei.(j).Atom.coord.Point3d.x -. nuclei.(i).Atom.coord.Point3d.x) *. f,
nuclei.(i).Atom.coord.Point3d.y +.
(nuclei.(j).Atom.coord.Point3d.y -. nuclei.(i).Atom.coord.Point3d.y) *. f,
nuclei.(i).Atom.coord.Point3d.z +.
(nuclei.(j).Atom.coord.Point3d.z -. nuclei.(i).Atom.coord.Point3d.z) *. f)
( nuclei.(i).Atom.coord.Point3d.x +.
(nuclei.(j).Atom.coord.Point3d.x -. nuclei.(i).Atom.coord.Point3d.x) *. f,
nuclei.(i).Atom.coord.Point3d.y +.
(nuclei.(j).Atom.coord.Point3d.y -. nuclei.(i).Atom.coord.Point3d.y) *. f,
nuclei.(i).Atom.coord.Point3d.z +.
(nuclei.(j).Atom.coord.Point3d.z -. nuclei.(i).Atom.coord.Point3d.z) *. f)
in
Atom.{ element = Element.X ; charge = Charge.of_int 0 ; coord = u }
)
(** Returns the list of available basis sets *)
let list_basis () =
let basis_list =
"python2 "^ Qpackage.root ^ "/external/emsl/EMSL_api.py list_basis"
|> Unix.open_process_in
let basis_list =
"python2 "^ Qpackage.root ^ "/external/emsl/EMSL_api.py list_basis"
|> Unix.open_process_in
|> In_channel.input_lines
|> List.map ~f:(fun x ->
|> List.map ~f:(fun x ->
match String.split x ~on:'\'' with
| [] -> ""
| a :: []
| a :: []
| _ :: a :: _ -> String.strip a
)
in
in
List.sort basis_list ~compare:String.ascending
|> String.concat ~sep:"\n"
(** Run the program *)
@ -108,35 +107,35 @@ let run ?o b au c d m p cart xyz_file =
| Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e)
in
match Hashtbl.find basis_table key with
| Some in_channel ->
| Some in_channel ->
in_channel
| None -> raise Caml.Not_found
in
let temp_filename =
Filename.temp_file "qp_create_" ".basis"
in
let () =
let () =
Sys.remove temp_filename
in
let fetch_channel basis =
let command =
Qpackage.root ^ "/scripts/get_basis.sh \"" ^ temp_filename
Qpackage.root ^ "/scripts/get_basis \"" ^ temp_filename
^ "." ^ basis ^ "\" \"" ^ basis ^"\""
in
let long_basis =
let long_basis =
Qpackage.root ^ "/data/basis/" ^ basis
in
match
match
Sys.is_file basis,
Sys.is_file long_basis
with
| `Yes, _ -> In_channel.create basis
| `No , `Yes -> In_channel.create long_basis
| _ ->
| _ ->
begin
let filename =
let filename =
Unix.open_process_in command
|> In_channel.input_all
|> String.strip
@ -151,19 +150,19 @@ let run ?o b au c d m p cart xyz_file =
let rec build_basis = function
| [] -> ()
| elem_and_basis_name :: rest ->
| elem_and_basis_name :: rest ->
begin
match (String.lsplit2 ~on:':' elem_and_basis_name) with
| None -> (* Principal basis *)
begin
let basis =
elem_and_basis_name
let basis =
elem_and_basis_name
in
let new_channel =
fetch_channel basis
in
List.iter nuclei ~f:(fun elem->
let key =
let key =
Element.to_string elem.Atom.element
in
match Hashtbl.add basis_table ~key:key ~data:new_channel with
@ -173,11 +172,11 @@ let run ?o b au c d m p cart xyz_file =
end
| Some (key, basis) -> (*Aux basis *)
begin
let elem =
let elem =
try
Element (Element.of_string key)
with Element.ElementError _ ->
let result =
let result =
match (String.split ~on:',' key) with
| i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k)
| _ -> failwith "Expected format is int,Element:basis"
@ -185,7 +184,7 @@ let run ?o b au c d m p cart xyz_file =
and basis =
String.lowercase basis
in
let key =
let key =
match elem with
| Element e -> Element.to_string e
| Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e)
@ -197,7 +196,7 @@ let run ?o b au c d m p cart xyz_file =
match Hashtbl.add basis_table ~key:key ~data:new_channel with
| `Ok -> ()
| `Duplicate ->
let e =
let e =
match elem with
| Element e -> e
| Int_elem (_,e) -> e
@ -209,13 +208,13 @@ let run ?o b au c d m p cart xyz_file =
build_basis rest
in
String.split ~on:'|' b
|> List.rev_map ~f:String.strip
|> List.rev_map ~f:String.strip
|> build_basis;
(***************
Pseudopotential
(***************
Pseudopotential
***************)
let pseudo_table =
@ -227,7 +226,7 @@ let run ?o b au c d m p cart xyz_file =
let key =
Element.to_string element
in
Hashtbl.find pseudo_table key
Hashtbl.find pseudo_table key
in
let temp_filename =
Filename.temp_file "qp_create_" ".pseudo"
@ -240,7 +239,7 @@ let run ?o b au c d m p cart xyz_file =
let long_pseudo =
Qpackage.root ^ "/data/pseudo/" ^ pseudo
in
match
match
Sys.is_file pseudo,
Sys.is_file long_pseudo
with
@ -293,7 +292,7 @@ let run ?o b au c d m p cart xyz_file =
end;
build_pseudo rest
in
let () =
let () =
match p with
| None -> ()
| Some p ->
@ -309,7 +308,7 @@ let run ?o b au c d m p cart xyz_file =
| None ->
begin
match String.rsplit2 ~on:'.' xyz_file with
| Some (x,"xyz")
| Some (x,"xyz")
| Some (x,"zmt") -> x^".ezfio"
| _ -> xyz_file^".ezfio"
end
@ -317,7 +316,7 @@ let run ?o b au c d m p cart xyz_file =
if Sys.file_exists_exn ezfio_file then
failwith (ezfio_file^" already exists");
let write_file () =
let write_file () =
(* Create EZFIO *)
Ezfio.set_file ezfio_file;
@ -327,23 +326,23 @@ let run ?o b au c d m p cart xyz_file =
match pseudo_channel x.Atom.element with
| Some channel -> Pseudo.read_element channel x.Atom.element
| None -> Pseudo.empty x.Atom.element
)
)
in
let molecule =
let molecule =
let n_elec_to_remove =
List.fold pseudo ~init:0 ~f:(fun accu x ->
accu + (Positive_int.to_int x.Pseudo.n_elec))
in
{ Molecule.elec_alpha =
{ Molecule.elec_alpha =
(Elec_alpha_number.to_int molecule.Molecule.elec_alpha)
- n_elec_to_remove/2
|> Elec_alpha_number.of_int;
Molecule.elec_beta =
Molecule.elec_beta =
(Elec_beta_number.to_int molecule.Molecule.elec_beta)
- (n_elec_to_remove - n_elec_to_remove/2)
|> Elec_beta_number.of_int;
Molecule.nuclei =
Molecule.nuclei =
let charges =
List.map pseudo ~f:(fun x -> Positive_int.to_int x.Pseudo.n_elec
|> Float.of_int)
@ -358,7 +357,7 @@ let run ?o b au c d m p cart xyz_file =
let nuclei =
molecule.Molecule.nuclei @ dummy
in
(* Write Electrons *)
Ezfio.set_electrons_elec_alpha_num ( Elec_alpha_number.to_int
@ -369,42 +368,42 @@ let run ?o b au c d m p cart xyz_file =
(* Write Nuclei *)
let labels =
List.map ~f:(fun x->Element.to_string x.Atom.element) nuclei
and charges =
List.map ~f:(fun x-> Atom.(Charge.to_float x.charge)) nuclei
and coords =
and charges =
List.map ~f:(fun x-> Atom.(Charge.to_float x.charge)) nuclei
and coords =
(List.map ~f:(fun x-> x.Atom.coord.Point3d.x) nuclei) @
(List.map ~f:(fun x-> x.Atom.coord.Point3d.y) nuclei) @
(List.map ~f:(fun x-> x.Atom.coord.Point3d.z) nuclei) in
let nucl_num = (List.length labels) in
Ezfio.set_nuclei_nucl_num nucl_num ;
Ezfio.set_nuclei_nucl_label (Ezfio.ezfio_array_of_list
Ezfio.set_nuclei_nucl_label (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| nucl_num |] ~data:labels);
Ezfio.set_nuclei_nucl_charge (Ezfio.ezfio_array_of_list
Ezfio.set_nuclei_nucl_charge (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| nucl_num |] ~data:charges);
Ezfio.set_nuclei_nucl_coord (Ezfio.ezfio_array_of_list
Ezfio.set_nuclei_nucl_coord (Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| nucl_num ; 3 |] ~data:coords);
(* Write pseudopotential *)
let () =
let () =
match p with
| None -> Ezfio.set_pseudo_do_pseudo false
| _ -> Ezfio.set_pseudo_do_pseudo true
in
let klocmax =
List.fold pseudo ~init:0 ~f:(fun accu x ->
let x =
let klocmax =
List.fold pseudo ~init:0 ~f:(fun accu x ->
let x =
List.length x.Pseudo.local
in
if (x > accu) then x
else accu
)
and lmax =
List.fold pseudo ~init:0 ~f:(fun accu x ->
let x =
and lmax =
List.fold pseudo ~init:0 ~f:(fun accu x ->
let x =
List.fold x.Pseudo.non_local ~init:0 ~f:(fun accu (x,_) ->
let x =
let x =
Positive_int.to_int x.Pseudo.GaussianPrimitive_non_local.proj
in
if (x > accu) then x
@ -416,10 +415,10 @@ let run ?o b au c d m p cart xyz_file =
)
in
let kmax =
let kmax =
Array.init (lmax+1) ~f:(fun i->
List.map pseudo ~f:(fun x ->
List.filter x.Pseudo.non_local ~f:(fun (y,_) ->
List.map pseudo ~f:(fun x ->
List.filter x.Pseudo.non_local ~f:(fun (y,_) ->
(Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i)
|> List.length )
|> List.fold ~init:0 ~f:(fun accu x ->
@ -428,9 +427,9 @@ let run ?o b au c d m p cart xyz_file =
|> Array.fold ~init:0 ~f:(fun accu i ->
if i > accu then i else accu)
in
let () =
let () =
Ezfio.set_pseudo_pseudo_klocmax klocmax;
Ezfio.set_pseudo_pseudo_kmax kmax;
Ezfio.set_pseudo_pseudo_lmax lmax;
@ -439,33 +438,33 @@ let run ?o b au c d m p cart xyz_file =
Array.make_matrix ~dimx:klocmax ~dimy:nucl_num 0. ,
Array.make_matrix ~dimx:klocmax ~dimy:nucl_num 0
in
List.iteri pseudo ~f:(fun j x ->
List.iteri pseudo ~f:(fun j x ->
List.iteri x.Pseudo.local ~f:(fun i (y,c) ->
tmp_array_v_k.(i).(j) <- AO_coef.to_float c;
let y, z =
AO_expo.to_float y.Pseudo.GaussianPrimitive_local.expo,
R_power.to_int y.Pseudo.GaussianPrimitive_local.r_power
AO_expo.to_float y.Pseudo.GaussianPrimitive_local.expo,
R_power.to_int y.Pseudo.GaussianPrimitive_local.r_power
in
tmp_array_dz_k.(i).(j) <- y;
tmp_array_n_k.(i).(j) <- z;
)
);
let concat_2d tmp_array =
let data =
let concat_2d tmp_array =
let data =
Array.map tmp_array ~f:Array.to_list
|> Array.to_list
|> List.concat
in
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[|nucl_num ; klocmax|] ~data
in
concat_2d tmp_array_v_k
in
concat_2d tmp_array_v_k
|> Ezfio.set_pseudo_pseudo_v_k ;
concat_2d tmp_array_dz_k
concat_2d tmp_array_dz_k
|> Ezfio.set_pseudo_pseudo_dz_k;
concat_2d tmp_array_n_k
concat_2d tmp_array_n_k
|> Ezfio.set_pseudo_pseudo_n_k;
let tmp_array_v_kl, tmp_array_dz_kl, tmp_array_n_kl =
let tmp_array_v_kl, tmp_array_dz_kl, tmp_array_n_kl =
Array.init (lmax+1) ~f:(fun _ ->
(Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0. )),
Array.init (lmax+1) ~f:(fun _ ->
@ -473,28 +472,28 @@ let run ?o b au c d m p cart xyz_file =
Array.init (lmax+1) ~f:(fun _ ->
(Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0 ))
in
List.iteri pseudo ~f:(fun j x ->
List.iteri pseudo ~f:(fun j x ->
let last_idx =
Array.create ~len:(lmax+1) 0
in
List.iter x.Pseudo.non_local ~f:(fun (y,c) ->
List.iter x.Pseudo.non_local ~f:(fun (y,c) ->
let k, y, z =
Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj,
AO_expo.to_float y.Pseudo.GaussianPrimitive_non_local.expo,
R_power.to_int y.Pseudo.GaussianPrimitive_non_local.r_power
in
let i =
last_idx.(k)
let i =
last_idx.(k)
in
tmp_array_v_kl.(k).(i).(j) <- AO_coef.to_float c;
tmp_array_dz_kl.(k).(i).(j) <- y;
tmp_array_n_kl.(k).(i).(j) <- z;
last_idx.(k) <- i+1;
)
);
let concat_3d tmp_array =
let data =
Array.map tmp_array ~f:(fun x ->
);
let concat_3d tmp_array =
let data =
Array.map tmp_array ~f:(fun x ->
Array.map x ~f:Array.to_list
|> Array.to_list
|> List.concat)
@ -510,7 +509,7 @@ let run ?o b au c d m p cart xyz_file =
concat_3d tmp_array_n_kl
|> Ezfio.set_pseudo_pseudo_n_kl ;
in
@ -531,7 +530,7 @@ let run ?o b au c d m p cart xyz_file =
let result = do_work [] 1 nuclei
|> List.rev
|> List.map ~f:(fun (x,i) ->
try
try
let e =
match x.Atom.element with
| Element.X -> Element.H
@ -554,7 +553,7 @@ let run ?o b au c d m p cart xyz_file =
with
| End_of_file -> failwith
("Element "^(Element.to_string x.Atom.element)^" not found in basis set.")
)
)
|> List.concat
in
(* close all in_channels *)
@ -564,24 +563,24 @@ let run ?o b au c d m p cart xyz_file =
let ao_num = List.length long_basis in
Ezfio.set_ao_basis_ao_num ao_num;
Ezfio.set_ao_basis_ao_basis b;
let ao_prim_num = List.map long_basis ~f:(fun (_,g,_) -> List.length g.Gto.lc)
let ao_prim_num = List.map long_basis ~f:(fun (_,g,_) -> List.length g.Gto.lc)
and ao_nucl = List.map long_basis ~f:(fun (_,_,n) -> Nucl_number.to_int n)
and ao_power=
and ao_power=
let l = List.map long_basis ~f:(fun (x,_,_) -> x) in
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) )@
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) )@
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) )
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) )
in
let ao_prim_num_max = List.fold ~init:0 ~f:(fun s x ->
if x > s then x
else s) ao_prim_num
in
let gtos =
let gtos =
List.map long_basis ~f:(fun (_,x,_) -> x)
in
let create_expo_coef ec =
let coefs =
let create_expo_coef ec =
let coefs =
begin match ec with
| `Coefs -> List.map gtos ~f:(fun x->
List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) )
@ -591,14 +590,14 @@ let run ?o b au c d m p cart xyz_file =
end
in
let rec get_n n accu = function
| [] -> List.rev accu
| [] -> List.rev accu
| h::tail ->
let y =
begin match List.nth h n with
| Some x -> x
| None -> 0.
end
in
in
get_n n (y::accu) tail
in
let rec build accu = function
@ -630,64 +629,82 @@ let run ?o b au c d m p cart xyz_file =
in
let () =
try write_file () with
| ex ->
| ex ->
begin
begin
match Sys.is_directory ezfio_file with
| `Yes -> rmdir ezfio_file
| _ -> ()
end;
end;
raise ex;
end
in
ignore @@ Sys.command ("qp_edit -c "^ezfio_file);
print_endline ezfio_file
let () =
"=== Available basis sets ===
" ^ (list_basis ()) ^ "
let open Command_line in
begin
"Creates an EZFIO directory from a standard xyz file or from a z-matrix file in Gaussian format. The basis set is defined as a single string if all the atoms are taken from the same basis set, otherwise specific elements can be defined as follows:
============================
-b \"cc-pcvdz | H:cc-pvdz | C:6-31g\"
-b \"cc-pvtz | 1,H:sto-3g | 3,H:6-31g\"
Creates an EZFIO directory from a standard xyz file or from a z-matrix file
in Gaussian format. The basis set is defined as a single string if all the
atoms are taken from the same basis set, otherwise specific elements can be
defined as follows:
If a file with the same name as the basis set exists, this file will be read. Otherwise, the basis set is obtained from the database.
" |> set_description_doc ;
set_header_doc (Sys.argv.(0) ^ " - Quantum Package command");
-b \"cc-pcvdz | H:cc-pvdz | C:6-31g\"
-b \"cc-pvtz | 1,H:sto-3g | 3,H:6-31g\"
[ { opt=Optional ; short='o'; long="output";
arg=With_arg "EZFIO_DIR";
doc="Name of the created EZFIO directory."} ;
If a file with the same name as the basis set exists, this file will be read.
Otherwise, the basis set is obtained from the database.
{ opt=Mandatory; short='b'; long="basis";
arg=With_arg "<string>";
doc="Name of basis set. If <string>=show, the list of all basis sets is displayed."} ;
" |> Command_line.set_header_doc ;
{ opt=Optional ; short='a'; long="au";
arg=Without_arg;
doc="Input geometry is in atomic units."} ;
{ opt=Optional ; short='c'; long="charge";
arg=With_arg "<int>";
doc="Total charge of the molecule. Default is 0."} ;
{ opt=Optional ; short='d'; long="dummy";
arg=With_arg "<float>";
doc="Add dummy atoms. x * (covalent radii of the atoms)."} ;
{ opt=Optional ; short='m'; long="multiplicity";
arg=With_arg "<int>";
doc="Spin multiplicity (2S+1) of the molecule. Default is 1."} ;
{ opt=Optional ; short='p'; long="pseudo";
arg=With_arg "<string>";
doc="Name of the pseudopotential."} ;
{ opt=Optional ; short='x'; long="cartesian";
arg=Without_arg;
doc="Compute AOs in the Cartesian basis set (6d, 10f, ...)."} ;
anonymous "FILE" Mandatory "Input file in xyz format or z-matrix.";
]
|> set_specs
end;
[ ( 'o', "output", "file Name of the created EZFIO file.", Command_line.With_arg) ;
( 'b', "basis", "string Name of basis set.", Command_line.With_arg) ;
( 'a', "au", "Input geometry is in atomic units.", Command_line.Without_arg) ;
( 'c', "charge", "int Total charge of the molecule. Default is 0.", Command_line.With_arg) ;
( 'd', "dummy", "float Add dummy atoms. x * (covalent radii of the atoms)", Command_line.With_arg);
( 'm', "multiplicity", "int Spin multiplicity (2S+1) of the molecule. Default is 1.", Command_line.With_arg);
( 'p', "pseudo", "string Name of the pseudopotential.", Command_line.With_arg);
( 'x', "cartesian", "Compute AOs in the Cartesian basis set (6d, 10f, ...)", Command_line.Without_arg);
Command_line.anonymous "(xyz_file|zmt_file)" "input file in xyz format or z-matrix."
]
|> Command_line.set_specs ;
(* Handle options *)
let output =
Command_line.get "output"
Command_line.get "output"
in
let basis =
match Command_line.get "basis" with
| None -> (Command_line.help () ; failwith "Error: [-b|--basis] option is missing.")
| None -> assert false
| Some x -> x
in
@ -714,13 +731,20 @@ Otherwise, the basis set is obtained from the database.
in
let pseudo =
Command_line.get "pseudo"
Command_line.get "pseudo"
in
let cart =
Command_line.get_bool "cartesian"
Command_line.get_bool "cartesian"
in
if basis = "show" then
begin
list_basis ()
|> List.iter ~f:print_endline;
exit 0
end;
let xyz_filename =
match Command_line.anon_args () with
| [x] -> x

8
ocaml/qp_print_basis.ml
View File

@ -30,7 +30,7 @@ let mo () =
| Some mo_coef -> mo_coef
| _ -> failwith "Error reading the mo set"
in
Input.Mo_basis.to_rst mo_coef
Input.Mo_basis.to_rst mo_coef
|> Rst_string.to_string
|> print_endline
@ -43,15 +43,15 @@ let psi_det () =
failwith "Error reading EZFIO file";
Ezfio.set_file ezfio_filename;
let psi_det =
Input.Determinants_by_hand.read ()
Input.Determinants_by_hand.read ()
in
Input.Determinants_by_hand.to_rst psi_det
Input.Determinants_by_hand.to_rst psi_det
|> Rst_string.to_string
|> print_endline
let () =
let () =
basis ();
mo ()
(* psi_det () *)

88
ocaml/qp_run.ml
View File

@ -7,26 +7,26 @@ open Qputils
*)
let print_list () =
Lazy.force Qpackage.executables
|> List.iter (fun (x,_) -> Printf.printf " * %s\n" x)
Lazy.force Qpackage.executables
|> List.iter (fun (x,_) -> Printf.printf " * %s\n" x)
let () =
let () =
Random.self_init ()
let run slave ?prefix exe ezfio_file =
(** Check availability of the ports *)
let port_number =
let port_number =
let zmq_context =
Zmq.Context.create ()
in
let dummy_socket =
let dummy_socket =
Zmq.Socket.create zmq_context Zmq.Socket.rep
in
let rec try_new_port port_number =
try
try
List.iter (fun i ->
let address =
let address =
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) (port_number+i)
in
Zmq.Socket.bind dummy_socket address;
@ -36,7 +36,7 @@ let run slave ?prefix exe ezfio_file =
with
| Unix.Unix_error _ -> try_new_port (port_number+100)
in
let result =
let result =
try_new_port 41279
in
Zmq.Socket.close dummy_socket;
@ -44,7 +44,7 @@ let run slave ?prefix exe ezfio_file =
result
in
let time_start =
let time_start =
Core.Time.now ()
in
@ -76,25 +76,25 @@ let run slave ?prefix exe ezfio_file =
| i -> failwith "Error: Input inconsistent\n"
end;
let qp_run_address_filename =
let qp_run_address_filename =
Filename.concat (Qpackage.ezfio_work ezfio_file) "qp_run_address"
in
let () =
let () =
if slave then
try
let address =
let address =
Core.In_channel.read_all qp_run_address_filename
|> String.trim
in
Unix.putenv "QP_RUN_ADDRESS_MASTER" address
with Sys_error _ -> failwith "No master is not running"
in
(** Start task server *)
let task_thread =
let thread =
Thread.create ( fun () ->
let thread =
Thread.create ( fun () ->
TaskServer.run port_number )
in
thread ();
@ -103,15 +103,15 @@ let run slave ?prefix exe ezfio_file =
Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) port_number
in
Unix.putenv "QP_RUN_ADDRESS" address;
let () =
let () =
if (not slave) then
Core.Out_channel.with_file qp_run_address_filename ~f:(
fun oc -> Core.Out_channel.output_lines oc [address])
fun oc -> Core.Out_channel.output_lines oc [address])
in
(** Run executable *)
let prefix =
let prefix =
match prefix with
| Some x -> x^" "
| None -> ""
@ -119,7 +119,7 @@ let run slave ?prefix exe ezfio_file =
match (List.find (fun (x,_) -> x = exe) executables) with
| (_,exe) -> exe^" "
in
let exit_code =
let exit_code =
match (Sys.command (prefix^exe^ezfio_file)) with
| 0 -> 0
| i -> (Printf.printf "Program exited with code %d.\n%!" i; i)
@ -130,7 +130,7 @@ let run slave ?prefix exe ezfio_file =
if (not slave) then
Sys.remove qp_run_address_filename;
let duration = Core.Time.diff (Core.Time.now()) time_start
let duration = Core.Time.diff (Core.Time.now()) time_start
|> Core.Time.Span.to_string in
Printf.printf "Wall time : %s\n\n" duration;
if (exit_code <> 0) then
@ -141,40 +141,38 @@ let run slave ?prefix exe ezfio_file =
let () =
(* Command-line specs *)
"Executes a Quantum Package binary file among these:\n\n"
^ (Lazy.force Qpackage.executables
|> List.map (fun (x,_) -> Printf.sprintf " * %s" x )
|> String.concat "\n"
) |> Command_line.set_header_doc;
let open Command_line in
begin
set_header_doc (Sys.argv.(0) ^ " - Quantum Package command");
"Executes a Quantum Package binary file among these:\n\n"
^ (Lazy.force Qpackage.executables
|> List.map (fun (x,_) -> Printf.sprintf " * %s" x )
|> String.concat "\n")
|> set_description_doc;
[ ( 's', "slave", "Required to run slave tasks in distributed environments",
Command_line.Without_arg);
( 'p', "prefix", "<string> Prefix before running the program, like gdb or valgrind",
Command_line.With_arg );
Command_line.anonymous "PROGRAM" "Name of the QP program to be run";
Command_line.anonymous "EZFIO_DIR" "EZFIO directory";
[ { short='s'; long="slave"; opt=Optional;
doc="Required to run slave tasks in distributed environments.";
arg=Without_arg; };
{ short='p'; long="prefix"; opt=Optional;
doc="Prefix before running the program, like gdb or valgrind.";
arg=With_arg "<string>"; };
anonymous "PROGRAM" Mandatory "Name of the QP program to be run";
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
]
|> Command_line.set_specs ;
|> set_specs ;
end;
(* Handle options *)
if Command_line.show_help () then
exit 0;
let slave =
match Command_line.get "slave" with
| None -> false
| _ -> true
in
let prefix =
Command_line.get "prefix"
let slave = Command_line.get_bool "slave"
and prefix = Command_line.get "prefix"
in
(* Run the program *)
match Command_line.anon_args () with
| exe :: ezfio_file :: [] -> run slave ?prefix exe ezfio_file
| _ -> (Command_line.help () ; failwith "Inconsistent command line")

126
ocaml/qp_set_mo_class.ml
View File

@ -14,7 +14,7 @@ let build_mask from upto n_int =
in
let rec build_mask bit = function
| 0 -> []
| i ->
| i ->
if ( i = upto ) then
Bit.One::(build_mask Bit.One (i-1))
else if ( i = from ) then
@ -22,7 +22,7 @@ let build_mask from upto n_int =
else
bit::(build_mask bit (i-1))
in
let starting_bit =
let starting_bit =
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
else Bit.Zero
in
@ -41,7 +41,7 @@ let set ~core ~inact ~act ~virt ~del =
in
let n_int =
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
with _ -> Bitlist.n_int_of_mo_num mo_num
with _ -> Bitlist.n_int_of_mo_num mo_num
in
@ -50,7 +50,7 @@ let set ~core ~inact ~act ~virt ~del =
in
(* Check input data *)
let apply_class l =
let apply_class l =
let rec apply_class t = function
| [] -> ()
| k::tail -> let i = MO_number.to_int k in
@ -71,11 +71,11 @@ let set ~core ~inact ~act ~virt ~del =
| MO_class.Deleted x -> apply_class (MO_class.Deleted []) x
in
let check f x =
let check f x =
try f x with Invalid_argument a ->
begin
Printf.printf "Number of MOs: %d\n%!" mo_num;
raise (Invalid_argument a)
raise (Invalid_argument a)
end
in
@ -90,7 +90,7 @@ let set ~core ~inact ~act ~virt ~del =
apply_class act ;
apply_class virt ;
apply_class del ;
for i=1 to (Array.length mo_class)
@ -108,16 +108,16 @@ let set ~core ~inact ~act ~virt ~del =
MO_class.to_string del |> print_endline ;
(* Create masks *)
let ia = Excitation.create_single inact act
and aa = Excitation.create_single act act
let ia = Excitation.create_single inact act
and aa = Excitation.create_single act act
and av = Excitation.create_single act virt
in
let single_excitations = [ ia ; aa ; av ]
|> List.map ~f:Excitation.(fun x ->
match x with
| Single (x,y) ->
| Single (x,y) ->
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
| Double _ -> assert false
)
@ -131,20 +131,20 @@ let set ~core ~inact ~act ~virt ~del =
|> List.map ~f:Excitation.(fun x ->
match x with
| Single _ -> assert false
| Double (x,y,z,t) ->
| Double (x,y,z,t) ->
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
MO_class.to_bitlist n_int (Hole.to_mo_class z),
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
)
in
let extract_hole (h,_) = h
and extract_particle (_,p) = p
and extract_hole1 (h,_,_,_) = h
and extract_particle1 (_,p,_,_) = p
and extract_hole2 (_,_,h,_) = h
and extract_particle2 (_,_,_,p) = p
let extract_hole (h,_) = h
and extract_particle (_,p) = p
and extract_hole1 (h,_,_,_) = h
and extract_particle1 (_,p,_,_) = p
and extract_hole2 (_,_,h,_) = h
and extract_particle2 (_,_,_,p) = p
in
let result = [
List.map ~f:extract_hole single_excitations
@ -162,14 +162,14 @@ let set ~core ~inact ~act ~virt ~del =
]
in
(* Debug masks in output
(* Debug masks in output
List.iter ~f:(fun x-> print_endline (Bitlist.to_string x)) result;
*)
(* Write masks *)
let result = List.map ~f:(fun x ->
let y = Bitlist.to_int64_list x in y@y )
result
result
|> List.concat
in
@ -177,13 +177,13 @@ let set ~core ~inact ~act ~virt ~del =
Ezfio.set_bitmasks_bit_kind 8;
Ezfio.set_bitmasks_n_mask_gen 1;
Ezfio.ezfio_array_of_list ~rank:4 ~dim:([| (N_int_number.to_int n_int) ; 2; 6; 1|]) ~data:result
|> Ezfio.set_bitmasks_generators ;
|> Ezfio.set_bitmasks_generators ;
let result =
let open Excitation in
let open Excitation in
match aa with
| Double _ -> assert false
| Single (x,y) ->
| Single (x,y) ->
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|> Bitlist.to_int64_list
@ -192,7 +192,7 @@ let set ~core ~inact ~act ~virt ~del =
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|> Ezfio.set_bitmasks_cas;
let data =
let data =
Array.to_list mo_class
|> List.map ~f:(fun x -> match x with
|None -> assert false
@ -211,9 +211,9 @@ let get () =
| None -> failwith "Unable to read electrons"
| Some x -> x
in
let elec_alpha_num =
let elec_alpha_num =
Elec_alpha_number.to_int data.Input.Electrons.elec_alpha_num
and elec_beta_num =
and elec_beta_num =
Elec_beta_number.to_int data.Input.Electrons.elec_beta_num
in
@ -230,7 +230,7 @@ let get () =
let n_int =
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
with _ -> Bitlist.n_int_of_mo_num mo_num
with _ -> Bitlist.n_int_of_mo_num mo_num
in
Printf.printf "Electrons: %d %d\n" elec_alpha_num elec_beta_num;
@ -240,7 +240,7 @@ let get () =
let rec work ?(core="[") ?(inact="[") ?(act="[") ?(virt="[") ?(del="[") i l =
match l with
| [] ->
| [] ->
let (core, inact, act, virt, del) =
(core ^"]",
inact ^"]",
@ -248,7 +248,7 @@ let get () =
virt ^"]",
del ^"]")
in
set ~core ~inact ~act ~virt ~del
set ~core ~inact ~act ~virt ~del
| (MO_class.Core _) :: rest ->
work ~core:(Printf.sprintf "%s,%d" core i) ~inact ~act ~virt ~del (i+1) rest
| (MO_class.Inactive _) :: rest ->
@ -277,14 +277,14 @@ let run ~q ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio
let ezfio_file =
let failure filename =
let failure filename =
eprintf "'%s' is not an EZFIO file.\n%!" filename;
exit 1
in
Command.Spec.Arg_type.create
(fun filename ->
match Sys.is_directory filename with
| `Yes ->
| `Yes ->
begin
match Sys.is_file (filename ^ "/.version") with
| `Yes -> filename
@ -295,14 +295,14 @@ let ezfio_file =
let default range =
let failure filename =
let failure filename =
eprintf "'%s' is not a regular file.\n%!" filename;
exit 1
in
Command.Spec.Arg_type.create
(fun filename ->
match Sys.is_directory filename with
| `Yes ->
| `Yes ->
begin
match Sys.is_file (filename^"/.version") with
| `Yes -> filename
@ -314,31 +314,51 @@ let default range =
let () =
"Set the orbital classes in an EZFIO directory.
The range of MOs has the form : \"[36-53,72-107,126-131]\"." |> Command_line.set_header_doc ;
let open Command_line in
begin
"Set the orbital classes in an EZFIO directory. The range of MOs has the form : \"[36-53,72-107,126-131]\"."
|> set_footer_doc ;
[ ( 'c', "core", "range Range of core MOs", Command_line.With_opt_arg);
( 'i', "inact", "range Range of inactive MOs", Command_line.With_opt_arg);
( 'a', "act", "range Range of active MOs", Command_line.With_opt_arg);
( 'v', "virt", "range Range of virtual MOs", Command_line.With_opt_arg);
( 'd', "del", "range Range of deleted MOs", Command_line.With_opt_arg);
( 'q', "query", "Print the current MOs classes", Command_line.Without_arg);
Command_line.anonymous "<EZFIO_FILE>" "EZFIO directory";
] |> Command_line.set_specs ;
[ { opt=Optional ; short='c'; long="core";
arg=With_arg "<range>";
doc="Range of core MOs." };
{ opt=Optional ; short='i'; long="inact";
arg=With_arg "<range>";
doc="Range of inactive MOs." };
{ opt=Optional ; short='a'; long="act";
arg=With_arg "<range>";
doc="Range of active MOs." };
{ opt=Optional ; short='v'; long="virt";
arg=With_arg "<range>";
doc="Range of virtual MOs." };
{ opt=Optional ; short='d'; long="del";
arg=With_arg "<range>";
doc="Range of deleted MOs." };
{ opt=Optional ; short='q'; long="query";
arg=Without_arg;
doc="Print the current MO classes." };
anonymous "EZFIO_DIR" Mandatory "EZFIO directory.";
] |> set_specs
end;
(* Handle options *)
if Command_line.show_help () then
exit 0;
let core = Command_line.get "core"
and inact = Command_line.get "inact"
and act = Command_line.get "act"
and virt = Command_line.get "virt"
and del = Command_line.get "del"
and q = Command_line.get_bool "q"
let core = Command_line.get "core"
and inact = Command_line.get "inact"
and act = Command_line.get "act"
and virt = Command_line.get "virt"
and del = Command_line.get "del"
and q = Command_line.get_bool "query"
in
let ezfio_filename =
let ezfio_filename =
match Command_line.anon_args () with
| [x] -> x
| _ -> (Command_line.help () ; failwith "EZFIO_FILE is missing")

86
ocaml/qptypes_generator.ml
View File

@ -1,4 +1,4 @@
let global_replace x =
let global_replace x =
x
|> Str.global_replace (Str.regexp "Float.to_string") "string_of_float"
|> Str.global_replace (Str.regexp "Float.of_string") "float_of_string"
@ -7,72 +7,72 @@ let global_replace x =
|> Str.global_replace (Str.regexp "String.\\(to\\|of\\)_string") ""
let input_data = "
* Positive_float : float
* Positive_float : float
if not (x >= 0.) then
raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\" x));
raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\" x));
* Strictly_positive_float : float
* Strictly_positive_float : float
if not (x > 0.) then
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
* Negative_float : float
* Negative_float : float
if not (x <= 0.) then
raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
* Strictly_negative_float : float
* Strictly_negative_float : float
if not (x < 0.) then
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
* Positive_int64 : int64
if not (x >= 0L) then
raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
* Positive_int : int
* Positive_int : int
if not (x >= 0) then
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
* Strictly_positive_int : int
* Strictly_positive_int : int
if not (x > 0) then
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
* Negative_int : int
* Negative_int : int
if not (x <= 0) then
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
* Det_coef : float
if (x < -1.) || (x > 1.) then
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
* Normalized_float : float
if (x < 0.) || (x > 1.) then
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
* Strictly_negative_int : int
* Strictly_negative_int : int
if not (x < 0) then
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
* Non_empty_string : string
if (x = \"\") then
raise (Invalid_argument \"Non_empty_string\");
* Det_number_max : int
assert (x > 0) ;
* Det_number_max : int
assert (x > 0) ;
if (x > 50_00_000_000) then
warning \"More than 50 billion determinants\";
* States_number : int
assert (x > 0) ;
* States_number : int
assert (x > 0) ;
if (x > 1000) then
warning \"More than 1000 states\";
* Bit_kind_size : int
* Bit_kind_size : int
begin match x with
| 8 | 16 | 32 | 64 -> ()
| _ -> raise (Invalid_argument \"Bit_kind_size should be (8|16|32|64).\")
end;
* Bit_kind : int
* Bit_kind : int
begin match x with
| 1 | 2 | 4 | 8 -> ()
| _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
@ -84,14 +84,14 @@ let input_data = "
* MO_coef : float
* MO_occ : float
if x < 0. then 0. else
if x < 0. then 0. else
if x > 2. then 2. else
* AO_coef : float
* AO_expo : float
* AO_expo : float
if (x < 0.) then
raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
* AO_prim_number : int
assert (x > 0) ;
@ -174,7 +174,7 @@ module MO_guess : sig
val to_string : t -> string
val of_string : string -> t
end = struct
type t =
type t =
| Huckel
| HCore
[@@deriving sexp]
@ -183,7 +183,7 @@ end = struct
| Huckel -> \"Huckel\"
| HCore -> \"HCore\"
let of_string s =
let of_string s =
match (String.lowercase_ascii s) with
| \"huckel\" -> Huckel
| \"hcore\" -> HCore
@ -196,7 +196,7 @@ module Disk_access : sig
val to_string : t -> string
val of_string : string -> t
end = struct
type t =
type t =
| Read
| Write
| None
@ -206,7 +206,7 @@ end = struct
| Read -> \"Read\"
| Write -> \"Write\"
| None -> \"None\"
let of_string s =
let of_string s =
match (String.lowercase_ascii s) with
| \"read\" -> Read
| \"write\" -> Write
@ -220,7 +220,7 @@ module Perturbation : sig
val to_string : t -> string
val of_string : string -> t
end = struct
type t =
type t =
| EN
| Barycentric
| Variance
@ -232,7 +232,7 @@ end = struct
| Variance -> \"Variance\"
| Barycentric -> \"Barycentric\"
| SOP -> \"SOP\"
let of_string s =
let of_string s =
match (String.lowercase_ascii s) with
| \"sop\" -> SOP
| \"en\" -> EN
@ -265,8 +265,8 @@ let parse_input input=
let rec parse result = function
| [] -> result
| ( "" , "" )::tail -> parse result tail
| ( t , text )::tail ->
let name,typ,params,params_val =
| ( t , text )::tail ->
let name,typ,params,params_val =
match String_ext.split ~on:':' t with
| [name;typ] -> (name,typ,"","")
| name::typ::params::params_val -> (name,typ,params,
@ -276,13 +276,13 @@ let parse_input input=
let typ = String_ext.strip typ
and name = String_ext.strip name in
let typ_cap = String.capitalize_ascii typ in
let newstring = Printf.sprintf template name typ typ typ params_val typ typ
let newstring = Printf.sprintf template name typ typ typ params_val typ typ
typ typ params ( String_ext.strip text ) typ_cap
in
List.rev (parse (newstring::result) tail )
in
String_ext.split ~on:'*' input
|> List.map (String_ext.lsplit2_exn ~on:'\n')
|> List.map (String_ext.lsplit2_exn ~on:'\n')
|> parse []
|> String.concat ""
|> global_replace
@ -308,7 +308,7 @@ end = struct
let get_min () =
%s
let to_%s x = x
let of_%s ?(min=get_min ()) ?(max=get_max ()) x =
let of_%s ?(min=get_min ()) ?(max=get_max ()) x =
begin
assert (x >= min) ;
if (x > %s) then
@ -327,7 +327,7 @@ end
let parse_input_ezfio input=
let parse s =
let parse s =
match (
String_ext.split s ~on:'\n'
|> List.filter (fun x -> (String_ext.strip x) <> "")
@ -339,13 +339,13 @@ let parse_input_ezfio input=
and ezfio_func = b
and (min, max) = String_ext.lsplit2_exn ~on:':' c
and msg = d
in
let (name, typ, ezfio_func, min, max, msg) =
in
let (name, typ, ezfio_func, min, max, msg) =
match List.map String_ext.strip [ name ; typ ; ezfio_func ; min ; max ; msg ] with
| [ name ; typ ; ezfio_func ; min ; max ; msg ] -> (name, typ, ezfio_func, min, max, msg)
| _ -> assert false
in
Printf.sprintf ezfio_template
Printf.sprintf ezfio_template
name typ typ typ typ typ typ typ typ (String.capitalize_ascii typ)
ezfio_func ezfio_func max min typ typ max msg min name (String.capitalize_ascii typ)
end
@ -358,7 +358,7 @@ let parse_input_ezfio input=
|> print_string
let () =
let () =
parse_input input_data ;
parse_input_ezfio input_ezfio;
print_endline untouched

45
scripts/ezfio_interface/qp_edit_template
View File

@ -9,7 +9,7 @@ open Core
(** Interactive editing of the input.
WARNING
This file is autogenerad by
This file is automatically generated by
`${{QP_ROOT}}/scripts/ezfio_interface/ei_handler.py`
*)
@ -265,24 +265,33 @@ let restore_backup ezfio_filename =
let () =
(* Command-line specs *)
Command_line.set_header_doc "Opens a text editor to edit the parameters of a EZFIO directory.";
let open Command_line in
begin
set_header_doc (Sys.argv.(0) ^ " - quantum_package command");
set_description_doc
"Opens a text editor to edit the parameters of an EZFIO directory.";
[ ( 'c', "check", "Checks the input data", Command_line.Without_arg);
( 'n', "ndet", "<int> Truncate the wavefunction to the target number of determinants",
Command_line.With_arg);
( 's', "state", "<range> Extract selected states, for example \"[1,3-5]\"", Command_line.With_arg);
Command_line.anonymous "<EZFIO_FILE>" "EZFIO directory";
]
|> Command_line.set_specs ;
[ {{ short='c'; long="check"; opt=Optional;
doc="Checks the input data";
arg=Without_arg; }};
{{ short='n'; long="ndet"; opt=Optional;
doc="Truncates the wavefunction to the target number of determinants";
arg=With_arg "<int>"; }};
{{
short='s'; long="state"; opt=Optional;
doc="Extracts selected states, for example \"[1,3-5]\"";
arg=With_arg "<range>"; }};
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
]
|> set_specs ;
end;
(* Handle options *)
if Command_line.show_help () then
exit 0;
let ndet =
match Command_line.get "ndet" with
| None -> None
@ -296,16 +305,12 @@ let () =
with _ -> failwith "[-s|--state] expects a range")
in
let c =
match Command_line.get "check" with
| None -> false
| _ -> true
in
let c = Command_line.get_bool "check" in
let ezfio_filename =
match Command_line.anon_args () with
| [x] -> x
| _ -> (Command_line.help () ; failwith "EZFIO_FILE is missing")
| _ -> (Command_line.help () ; failwith "EZFIO_DIR is missing")
in
at_exit (fun () -> remove_backup ezfio_filename);

26
scripts/generate_h_apply.py Executable file → Normal file
View File

@ -320,7 +320,7 @@ class H_apply(object):
sum_norm_pert(k) = 0.d0
sum_H_pert_diag(k) = 0.d0
enddo
"""
"""
self.data["deinit_thread"] = """
! OMP CRITICAL
@ -332,7 +332,7 @@ class H_apply(object):
! OMP END CRITICAL
deallocate (e_2_pert_buffer, coef_pert_buffer)
"""
self.data["size_max"] = "8192"
self.data["size_max"] = "8192"
self.data["initialization"] = """
PROVIDE psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit
"""
@ -342,7 +342,7 @@ class H_apply(object):
call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp,%s)
"""%(pert,self.energy)
else:
else:
self.data["keys_work"] = """
call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask,fock_diag_tmp,%s)
@ -356,12 +356,12 @@ class H_apply(object):
self.data["params_main"] = "pt2, norm_pert, H_pert_diag, N_st"
self.data["params_post"] = ","+self.data["params_main"] +", N_int"
self.data["decls_main"] = """ integer, intent(in) :: N_st
double precision, intent(inout):: pt2(N_st)
double precision, intent(inout):: norm_pert(N_st)
self.data["decls_main"] = """ integer, intent(in) :: N_st
double precision, intent(inout):: pt2(N_st)
double precision, intent(inout):: norm_pert(N_st)
double precision, intent(inout):: H_pert_diag(N_st)
double precision :: delta_pt2(N_st), norm_psi(N_st), pt2_old(N_st)
PROVIDE N_det_generators
PROVIDE N_det_generators
do k=1,N_st
pt2(k) = 0.d0
norm_pert(k) = 0.d0
@ -375,7 +375,7 @@ class H_apply(object):
write(6,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
'============', '========', '=========', '=========', '=========', &
'========='
"""
"""
self.data["printout_always"] = """
do k=1,N_st
@ -424,7 +424,7 @@ class H_apply(object):
""" + self.data["keys_work"]
self.data["keys_work"] += """
call fill_H_apply_buffer_selection(key_idx,keys_out,e_2_pert_buffer, &
coef_pert_buffer,N_st,N_int,iproc,select_max_out)
coef_pert_buffer,N_st,N_int,iproc,select_max_out)
"""
# self.data["omp_parallel"] += """&
# !$OMP REDUCTION (max:select_max_out)"""
@ -450,12 +450,12 @@ class H_apply_zmq(H_apply):
H_apply.set_perturbation(self,pert)
self.data["printout_now"] = ""
self.data["printout_always"] = ""
self.data["decls_main"] = """ integer, intent(in) :: N_st
double precision, intent(inout):: pt2(N_st)
double precision, intent(inout):: norm_pert(N_st)
self.data["decls_main"] = """ integer, intent(in) :: N_st
double precision, intent(inout):: pt2(N_st)
double precision, intent(inout):: norm_pert(N_st)
double precision, intent(inout):: H_pert_diag(N_st)
double precision :: delta_pt2(N_st), norm_psi(N_st), pt2_old(N_st)
PROVIDE N_det_generators
PROVIDE N_det_generators
do k=1,N_st
pt2(k) = 0.d0
norm_pert(k) = 0.d0

21
scripts/get_basis.sh → scripts/get_basis
View File

@ -11,8 +11,7 @@
#DEBUG:
#echo $0 $@ 1>&2
if [[ -z ${QP_ROOT} ]]
then
if [[ -z ${QP_ROOT} ]] ; then
print "The QP_ROOT environment variable is not set."
print "Please reload the quantum_package.rc file."
exit -1
@ -25,7 +24,9 @@ tmpfile="$1"
shift
# Case insensitive basis in input
#basis=$( python2 ${EMSL_API_ROOT}/EMSL_api.py list_basis | cut -d "'" -f 2 | grep -i "^${1}\$")
#basis=$( python2 ${EMSL_API_ROOT}/EMSL_api.py list_basis \
# | cut -d "'" -f 2\
# | grep -i "^${1}\$")
basis="$1"
shift
@ -37,13 +38,13 @@ do
atoms+="--atom ${atom} "
done
if [[ $? -ne 0 ]]
then
echo "==================================================" 1>& 2
echo "Unable to create temporary file $tmpfile" 1>& 2
echo "==================================================" 1>& 2
echo "ERROR"
if [[ $? -ne 0 ]] ; then
>&2 echo "=================================================="
>&2 echo "Unable to create temporary file $tmpfile"
>&2 echo "=================================================="
>&2 echo "ERROR"
exit 1
fi
python2 ${EMSL_API_ROOT}/EMSL_api.py get_basis_data --treat_l --save --path="${tmpfile}" --basis="${basis}"
exec python2 ${EMSL_API_ROOT}/EMSL_api.py get_basis_data \
--treat_l --save --path="${tmpfile}" --basis="${basis}"

0
scripts/perturbation.py Executable file → Normal file
View File

4
scripts/qp_bitmasks.py Executable file → Normal file
View File

@ -60,7 +60,7 @@ def int_to_bitmask(s,bit_kind_size=BIT_KIND_SIZE):
['0000000000000000000000000000000000000000000000000000000000001010']
>>> int_to_bitmask(-10)
['1111111111111111111111111111111111111111111111111111111111110110']
>>>
>>>
"""
assert type(s) in (int, long)
if s < 0:
@ -90,7 +90,7 @@ class BitMask(object):
>>> print A[1]
-127
"""
def __init__(self,l=[],bit_kind_size=BIT_KIND_SIZE):
self.bit_kind_size = bit_kind_size

140
scripts/qp_convert_output_to_ezfio
View File

@ -3,40 +3,32 @@
convert output of GAMESS/GAU$$IAN to ezfio
Usage:
qp_convert_output_to_ezfio [-o EZFIO_FILE|--output=EZFIO_FILE] <file.out>
qp_convert_output_to_ezfio [-o EZFIO_DIR] FILE
Options:
-o EZFIO_FILE --output=EZFIO_FILE Produced directory
by default is file.out.ezfio
-o --output=EZFIO_DIR Produced directory
by default is FILE.ezfio
"""
import sys
import os
from functools import reduce
# ~#~#~#~#~#~#~#~ #
# Add to the path #
# ~#~#~#~#~#~#~#~ #
from ezfio import ezfio
from docopt import docopt
try:
QP_ROOT = os.environ["QP_ROOT"]
QP_EZFIO = os.environ["QP_EZFIO"]
except:
except KeyError:
print "Error: QP_ROOT environment variable not found."
sys.exit(1)
else:
sys.path = [ QP_EZFIO + "/Python",
QP_ROOT + "/install/resultsFile",
QP_ROOT + "/install",
QP_ROOT + "/scripts"] + sys.path
# ~#~#~#~#~#~ #
# I m p o r t #
# ~#~#~#~#~#~ #
from ezfio import ezfio
sys.path = [QP_EZFIO + "/Python",
QP_ROOT + "/install/resultsFile",
QP_ROOT + "/install",
QP_ROOT + "/scripts"] + sys.path
try:
from resultsFile import *
@ -44,12 +36,7 @@ except:
print "Error: resultsFile Python library not installed"
sys.exit(1)
from docopt import docopt
# _
# |_ ._ _ _|_ o _ ._
# | |_| | | (_ |_ | (_) | |
#
def write_ezfio(res, filename):
@ -61,7 +48,7 @@ def write_ezfio(res, filename):
# |_ | _ _ _|_ ._ _ ._ _
# |_ | (/_ (_ |_ | (_) | | _>
#
print "Electrons\t...\t",
print "Electrons\t...\t",
ezfio.set_electrons_elec_alpha_num(res.num_alpha)
ezfio.set_electrons_elec_beta_num(res.num_beta)
print "OK"
@ -280,44 +267,44 @@ def write_ezfio(res, filename):
kmax = 0
nucl_num = len(res.geometry)
for ecp in res.pseudo:
lmax_local = ecp['lmax']
lmax = max(lmax_local,lmax)
nucl_charge_remove.append(ecp['zcore'])
klocmax = max(klocmax, len(ecp[str(lmax_local)]))
for l in range(lmax_local):
kmax = max(kmax,len(ecp[str(l)]))
lmax_local = ecp['lmax']
lmax = max(lmax_local, lmax)
nucl_charge_remove.append(ecp['zcore'])
klocmax = max(klocmax, len(ecp[str(lmax_local)]))
for l in range(lmax_local):
kmax = max(kmax, len(ecp[str(l)]))
lmax = lmax-1
ezfio.set_pseudo_pseudo_lmax(lmax)
ezfio.set_pseudo_nucl_charge_remove(nucl_charge_remove)
ezfio.set_pseudo_pseudo_klocmax(klocmax)
ezfio.set_pseudo_pseudo_kmax(kmax)
pseudo_n_k = [ [ 0 for _ in range(nucl_num) ] for _ in range(klocmax) ]
pseudo_v_k = [ [ 0. for _ in range(nucl_num) ] for _ in range(klocmax) ]
pseudo_dz_k = [ [ 0. for _ in range(nucl_num) ] for _ in range(klocmax) ]
pseudo_n_kl = [ [ [ 0 for _ in range(nucl_num) ] for _ in range(kmax) ] for _ in range(lmax+1) ]
pseudo_v_kl = [ [ [ 0. for _ in range(nucl_num) ] for _ in range(kmax) ] for _ in range(lmax+1) ]
pseudo_dz_kl = [ [ [ 0. for _ in range(nucl_num) ] for _ in range(kmax) ] for _ in range(lmax+1) ]
pseudo_n_k = [[0 for _ in range(nucl_num)] for _ in range(klocmax)]
pseudo_v_k = [[0. for _ in range(nucl_num)] for _ in range(klocmax)]
pseudo_dz_k = [[0. for _ in range(nucl_num)] for _ in range(klocmax)]
pseudo_n_kl = [[[0 for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
pseudo_v_kl = [[[0. for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
pseudo_dz_kl = [[[0. for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
for ecp in res.pseudo:
lmax_local = ecp['lmax']
klocmax = len(ecp[str(lmax_local)])
atom = ecp['atom']-1
for kloc in range(klocmax):
try:
v, n, dz = ecp[str(lmax_local)][kloc]
pseudo_n_k[kloc][atom] = n-2
pseudo_v_k[kloc][atom] = v
pseudo_dz_k[kloc][atom] = dz
except:
pass
for l in range(lmax_local):
for k in range(kmax):
try:
v, n, dz = ecp[str(l)][k]
pseudo_n_kl[l][k][atom] = n-2
pseudo_v_kl[l][k][atom] = v
pseudo_dz_kl[l][k][atom] = dz
except:
pass
lmax_local = ecp['lmax']
klocmax = len(ecp[str(lmax_local)])
atom = ecp['atom']-1
for kloc in range(klocmax):
try:
v, n, dz = ecp[str(lmax_local)][kloc]
pseudo_n_k[kloc][atom] = n-2
pseudo_v_k[kloc][atom] = v
pseudo_dz_k[kloc][atom] = dz
except:
pass
for l in range(lmax_local):
for k in range(kmax):
try:
v, n, dz = ecp[str(l)][k]
pseudo_n_kl[l][k][atom] = n-2
pseudo_v_kl[l][k][atom] = v
pseudo_dz_kl[l][k][atom] = dz
except:
pass
ezfio.set_pseudo_pseudo_n_k(pseudo_n_k)
ezfio.set_pseudo_pseudo_v_k(pseudo_v_k)
ezfio.set_pseudo_pseudo_dz_k(pseudo_dz_k)
@ -326,15 +313,15 @@ def write_ezfio(res, filename):
ezfio.set_pseudo_pseudo_dz_kl(pseudo_dz_kl)
n_alpha = res.num_alpha
n_beta = res.num_beta
n_beta = res.num_beta
for i in range(nucl_num):
charge[i] -= nucl_charge_remove[i]
n_alpha -= nucl_charge_remove[i]/2
n_beta -= nucl_charge_remove[i]/2
charge[i] -= nucl_charge_remove[i]
n_alpha -= nucl_charge_remove[i]/2
n_beta -= nucl_charge_remove[i]/2
ezfio.set_nuclei_nucl_charge(charge)
ezfio.set_electrons_elec_alpha_num(n_alpha)
ezfio.set_electrons_elec_beta_num(n_beta)
except:
ezfio.set_pseudo_do_pseudo(False)
else:
@ -342,7 +329,7 @@ def write_ezfio(res, filename):
print "OK"
def get_full_path(file_path):
@ -353,33 +340,32 @@ def get_full_path(file_path):
if __name__ == '__main__':
arguments = docopt(__doc__)
ARGUMENTS = docopt(__doc__)
file_ = get_full_path(arguments['<file.out>'])
FILE = get_full_path(ARGUMENTS['FILE'])
if arguments["--output"]:
ezfio_file = get_full_path(arguments["--output"])
elif arguments["-o"]:
ezfio_file = get_full_path(arguments["-o"])
if ARGUMENTS["--output"]:
EZFIO_FILE = get_full_path(ARGUMENTS["--output"])
elif ARGUMENTS["-o"]:
EZFIO_FILE = get_full_path(ARGUMENTS["-o"])
else:
ezfio_file = "{0}.ezfio".format(file_)
print ezfio_file
EZFIO_FILE = "{0}.ezfio".format(FILE)
print EZFIO_FILE
try:
res_file = getFile(file_)
RES_FILE = getFile(FILE)
except:
raise
else:
print file_, 'recognized as', str(res_file).split('.')[-1].split()[0]
print FILE, 'recognized as', str(RES_FILE).split('.')[-1].split()[0]
write_ezfio(res_file, ezfio_file)
write_ezfio(RES_FILE, EZFIO_FILE)
sys.stdout.flush()
if os.system("qp_run save_ortho_mos "+ezfio_file) != 0:
print """Warning: You need to run
if os.system("qp_run save_ortho_mos "+EZFIO_FILE) != 0:
print """Warning: You need to run
qp run save_ortho_mos
qp run save_ortho_mos
to be sure your MOs will be orthogonal, which is not the case when
the MOs are read from output files (not enough precision in output)."""

23
scripts/qp_e_conv_fci
View File

@ -1,17 +1,19 @@
#!/bin/bash
file=$1
qp=$QP_ROOT
source ${qp}/quantum_package.rc
if [[ -z ${QP_ROOT} ]] ; then
>&2 echo "please source quantum_package.rc"
exit 1
fi
source ${QP_ROOT}/quantum_package.rc
qp_run print_e_conv $1
qp_run print_e_conv $1
nstates=`cat ${1}/determinants/n_states`
echo $nstates
for i in `seq 1 $nstates`
do
out=${1}.${i}.conv
for i in $(seq 1 $nstates) ; do
out=${1}.${i}.conv
cat << EOF > ${out}.plt
set term pdf
set output "$out.pdf"
@ -28,9 +30,8 @@ rm ${out}.plt
done
for i in `seq 2 $nstates`
do
out=${1}.${i}.delta_e.conv
for i in $(seq 2 $nstates) ; do
out=${1}.${i}.delta_e.conv
cat << EOF > ${out}.plt
set term pdf
set output "$out.pdf"
@ -41,6 +42,6 @@ set ylabel "Energy difference (a.u.)"
plot "$out" w lp title "Delta E_{var} state $i", "$out" u 1:3 w lp title "Delta E_{var} + PT2 state $i"
EOF
gnuplot ${out}.plt
rm ${out}.plt
gnuplot ${out}.plt
rm ${out}.plt
done

149
scripts/qp_export_as_tgz
View File

@ -1,14 +1,61 @@
#!/bin/bash -x
#
#!/bin/bash
#
# Creates a self-contained binary distribution in the form of a tar.gz file
#
#
# Mon Nov 26 22:57:50 CET 2018
#
function help() {
cat << EOF
In some HPC facilities, the access to the internet is limited for security
reasons. In such an environment, the installation of QP is sometimes very
painful because the OCaml compiler and the libraries can't be installed by a
non-root user.
This command creates a self-contained binary distribution in the form of a
tar.gz file that can be copied on another machine.
Usage:
$(basename $0) [-h|--help]
Options:
-h --help Prints the help message
Note:
There can be conflicts due to the version of Glibc. The machine on which |QP| is
compiled should be the oldest one.
EOF
exit 0
}
function error() {
>&2 echo "$(basename $0): $@"
exit 2
}
while true ; do
case "$1" in
"")
break;;
-h|-help|--help)
help;;
*)
echo $(basename $0)": unknown option $1, try --help"
exit 2;;
esac
shift
done
set -x
# Check the QP_ROOT directory
if [[ -z ${QP_ROOT} ]]
then
if [[ -z ${QP_ROOT} ]] ; then
echo "The QP_ROOT environment variable is not set."
echo "Please reload the quantum_package.rc file."
exit 1
@ -23,83 +70,76 @@ if [[ -f quantum_package.rc \
&& -d bin \
&& -d ocaml \
&& -d external \
&& -d scripts ]]
then
&& -d scripts ]] ; then
: # OK, this is a quantum_package directory
else
echo "This doesn't look like a quantum_package directory"
error "This doesn't look like a quantum_package directory"
exit 1
fi
# Build all sources
ninja
if [[ $? -ne 0 ]]
then
echo "Error building ${dir}"
if [[ $? -ne 0 ]] ; then
error "Error building ${dir}"
fi
# Copy the files in the static directory
QPACKAGE_STATIC=${QP_ROOT}/quantum_package_static
function find_libs ()
{
for i in "$@"
do
function find_libs () {
for i in "$@" ; do
ldd $i
done | sort | grep '/' | cut --delimiter=' ' --fields=3 | uniq
done \
| sort \
| grep '/' \
| cut --delimiter=' ' --fields=3 \
| uniq
}
function find_exec ()
{
function find_exec () {
find ${QP_ROOT}/$1 -perm /u+x -type f
}
#
echo "Creating root of static directory"
# ---------------------------------
rm --recursive --force -- "${QPACKAGE_STATIC}"
mkdir --parents -- ${QPACKAGE_STATIC}/{bin,etc,man,lib,extra_lib,external}
if [[ $? -ne 0 ]] ;
then
echo "Error creating ${QPACKAGE_STATIC}/{bin,lib,etc,man,extra_lib,external}"
if [[ $? -ne 0 ]] ; then
error "Error creating ${QPACKAGE_STATIC}/{bin,lib,etc,man,extra_lib,external}"
exit 1
fi
#
echo "Copying binary files"
# --------------------
FORTRAN_EXEC=$(find_exec src)
if [[ -z $FORTRAN_EXEC ]] ;
then
echo 'Error : No Fortran binaries found.'
if [[ -z $FORTRAN_EXEC ]] ; then
error 'No Fortran binaries found.'
exit 1
fi
OCAML_EXEC=$(find_exec ocaml | grep .native )
if [[ -z $OCAML_EXEC ]] ;
then
echo 'Error : No ocaml binaries found.'
if [[ -z $OCAML_EXEC ]] ; then
error 'No ocaml binaries found.'
exit 1
fi
cp -- ${FORTRAN_EXEC} ${OCAML_EXEC} ${QPACKAGE_STATIC}/bin
if [[ $? -ne 0 ]] ;
then
cp -- ${FORTRAN_EXEC} ${OCAML_EXEC} ${QPACKAGE_STATIC}/bin
if [[ $? -ne 0 ]] ; then
error "Error in cp -- ${FORTRAN_EXEC} ${OCAML_EXEC} ${QPACKAGE_STATIC}/bin"
exit 1
fi
(
cd ${QPACKAGE_STATIC}/bin
for i in *.native
do
for i in *.native ; do
mv "$i" $(basename "$i" .native)
done
)
@ -107,8 +147,7 @@ cd ${QPACKAGE_STATIC}/bin
cp ${QP_ROOT}/bin/qpsh ${QPACKAGE_STATIC}/bin
cp --recursive -- ${QP_ROOT}/data ${QPACKAGE_STATIC}/data
for i in ${FORTRAN_EXEC}
do
for i in ${FORTRAN_EXEC} ; do
i=$(basename $i)
echo $i \$QP_ROOT/bin/$i
done > ${QPACKAGE_STATIC}/data/executables
@ -116,11 +155,13 @@ done > ${QPACKAGE_STATIC}/data/executables
mkdir --parents -- ${QPACKAGE_STATIC}/src/Bitmask
cp ${QP_ROOT}/src/Bitmask/bitmasks_module.f90 ${QPACKAGE_STATIC}/src/Bitmask
#
echo "Copying dynamic libraries"
# --------------------------
MKL_LIBS=$(find_libs ${FORTRAN_EXEC} | grep libmkl | head -1)
MKL_LIBS=$(find_libs ${FORTRAN_EXEC} \
| grep libmkl \
| head -1)
if [[ -n ${MKL_LIBS} ]]
then
MKL_LIBS=$(dirname ${MKL_LIBS})
@ -128,27 +169,26 @@ then
fi
ALL_LIBS=$(find_libs ${OCAML_EXEC} ${FORTRAN_EXEC})
for i in ${ALL_LIBS} ${MKL_LIBS}
do
for i in ${ALL_LIBS} ${MKL_LIBS} ; do
cp -- ${i} ${QPACKAGE_STATIC}/extra_lib
done
if [[ $? -ne 0 ]] ;
then
if [[ $? -ne 0 ]] ; then
echo 'cp -- ${ALL_LIBS} ${MKL_LIBS} ${QPACKAGE_STATIC}/extra_lib'
exit 1
fi
cp -- ${QPACKAGE_STATIC}/extra_lib/lib{[gi]omp*,mkl*,lapack*,blas*,z*} ${QPACKAGE_STATIC}/lib/
cp -- ${QPACKAGE_STATIC}/extra_lib/lib{[gi]omp*,mkl*,lapack*,blas*,z*} \
${QPACKAGE_STATIC}/lib/
#
echo "Copying scripts directory"
# -------------------------
# -------------------------
cp --recursive -- ${QP_ROOT}/scripts ${QPACKAGE_STATIC}/
if [[ $? -ne 0 ]] ;
then
echo 'cp --recursive -- ${QP_ROOT}/scripts ${QPACKAGE_STATIC}/'
error 'cp --recursive -- ${QP_ROOT}/scripts ${QPACKAGE_STATIC}/'
exit 1
fi
#
@ -157,9 +197,8 @@ echo "Copying external libraries"
# --------------------------
cp --recursive -- ${QP_ROOT}/external/emsl ${QPACKAGE_STATIC}/external
if [[ $? -ne 0 ]] ;
then
echo 'cp --recursive -- ${QP_ROOT}/external/emsl ${QPACKAGE_STATIC}/'
if [[ $? -ne 0 ]] ; then
error 'cp --recursive -- ${QP_ROOT}/external/emsl ${QPACKAGE_STATIC}/'
exit 1
fi
@ -170,7 +209,6 @@ cp --recursive -- ${QP_ROOT}/external/ezfio/Bash ${QPACKAGE_STATIC}/external/e
cp --recursive -- ${QP_ROOT}/man ${QPACKAGE_STATIC}/man
#
echo "Creating quantum_package.rc"
# ---------------------------
@ -181,17 +219,14 @@ export QP_ROOT="\$( cd \$(dirname \\\${BASH_SOURCE}) ; cd .. ; pwd -P )"
EOF
#exit 0
#
echo "Creating the archive"
# --------------------
tar --create --gzip --file "${QPACKAGE_STATIC}".tar.gz quantum_package_static && rm --recursive --force -- "${QPACKAGE_STATIC}"
if [[ $? -ne 0 ]] ;
then
echo 'tar --create --gzip --file "${QPACKAGE_STATIC}".tar.gz "${QPACKAGE_STATIC}" && rm --recursive --force -- "${QPACKAGE_STATIC}"'
tar --create --gzip --file "${QPACKAGE_STATIC}".tar.gz quantum_package_static && \
rm --recursive --force -- "${QPACKAGE_STATIC}"
if [[ $? -ne 0 ]] ; then
error 'tar --create --gzip --file "${QPACKAGE_STATIC}".tar.gz "${QPACKAGE_STATIC}" &&
rm --recursive --force -- "${QPACKAGE_STATIC}"'
exit 1
fi

63
scripts/qp_mpirun
View File

@ -1,15 +1,28 @@
#!/bin/bash
set -e
function error() {
>&2 echo "$(basename $0): $@"
exit 2
}
set -e
PROG=$1
INPUT=$2
case ${PROG} in
-h|--help)
exec qp_run --help
;;
esac
NODES=($(mpirun hostname))
# Test that there is one MPI process per node
NPROC=$(echo ${NODES[@]} | tr ' ' '\n' | sort | wc -l)
NUNIQ=$(echo ${NODES[@]} | tr ' ' '\n' | sort | uniq | wc -l)
if [[ $NPROC != $NUNIQ ]]
then
echo "
if [[ $NPROC != $NUNIQ ]] ; then
error "
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error:
@ -20,17 +33,15 @@ In your SLURM script file, use:
#SBATCH --ntasks-per-node=1
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
"
exit -1
"
exit -1
fi
PROG=$1
INPUT=$2
# Check if quantum_package.rc is sourced
if [[ -z ${QP_ROOT} ]]
then
if [[ -z ${QP_ROOT} ]] ; then
echo "Error: quantum_package.rc is not sourced"
exit -1
fi
@ -40,25 +51,22 @@ fi
MASTER_NODE=${NODES[0]}
SLAVE_NODES=$(echo ${NODES[@]:1}| tr ' ' ',')
if [[ $NPROC -gt 1 ]]
then
if [[ $NPROC -gt 1 ]] ; then
echo "Master : $MASTER_NODE"
echo "Slaves : $SLAVE_NODES"
fi
# Check if the integrals can be read
source ${QP_ROOT}/external/ezfio/Bash/ezfio.sh
ezfio set_file $INPUT
RW=$(ezfio set mo_two_e_ints io_mo_two_e_integrals)
if [[ $RW != Read ]]
then
qp set_file $INPUT
RW=$(qp get mo_two_e_ints io_mo_two_e_integrals)
if [[ $RW != Read ]] ; then
echo "
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Warning:
Two-electron integrals were not saved to disk in a previous run.
If the 4-index transformation takes time, you may consider
killing this job and running
If the 4-index transformation takes time, you may consider
killing this job and running
qp_run four_idx_transform $INPUT
@ -67,18 +75,17 @@ as a single-node job before re-submitting the current job.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
"
fi
rm --force "${INPUT}"/work/qp_run_address
rm --force -- "${INPUT}"/work/qp_run_address
set -x
mpiexec.hydra -n 1 -hosts "$MASTER_NODE" qp_run $PROG $INPUT &
if [[ $NPROC -gt 1 ]]
then
while [[ ! -f $INPUT/work/qp_run_address ]]
do
sleep 1
done
echo "Starting slaves"
mpiexec.hydra -n $((${SLURM_NTASKS}-1)) -hosts "$SLAVE_NODES" qp_run -slave $PROG $INPUT > $INPUT.slaves.out
if [[ $NPROC -gt 1 ]] ; then
while [[ ! -f $INPUT/work/qp_run_address ]] ; do
sleep 1
done
echo "Starting slaves"
mpiexec.hydra -n $((${SLURM_NTASKS}-1)) -hosts "$SLAVE_NODES" \
qp_run --slave="$PROG" $INPUT > $INPUT.slaves.out
fi
wait

30
scripts/qp_name
View File

@ -28,13 +28,14 @@ import os
try:
from docopt import docopt
from qp_path import QP_SRC, QP_ROOT, QP_PLUGINS
from qp_path import QP_SRC, QP_ROOT
except ImportError:
print "source .quantum_package.rc"
raise
def main(arguments):
"""Main function"""
# Check that name exist in */IRPF90_man
print "Checking that name exists..."
@ -43,25 +44,25 @@ def main(arguments):
f = arguments["<name>"]+".l"
found = False
for mod in all_modules:
if os.path.isdir( os.path.join(QP_SRC,mod,"IRPF90_man") ):
for filename in os.listdir( os.path.join(QP_SRC,mod,"IRPF90_man") ):
if os.path.isdir(os.path.join(QP_SRC, mod, "IRPF90_man")):
for filename in os.listdir(os.path.join(QP_SRC, mod, "IRPF90_man")):
if filename == f:
found = True
break
if found: break
if not found:
print "Error:"
print "The variable/subroutine/function \""+arguments["<name>"] \
+ "\" was not found in the sources."
print "Did you compile the code at the root?"
print "Continue? [y/N] ",
cont = sys.stdin.read(1).strip() in [ "y", "Y" ]
print "Continue? [y/N] ",
cont = sys.stdin.read(1).strip() in ["y", "Y"]
if not cont:
print "Aborted"
sys.exit(1)
# Now search in all the files
# Now search in all the files
if arguments["--rename"]:
print "Replacing..."
else:
@ -70,14 +71,14 @@ def main(arguments):
name = re.compile(r"\b"+arguments["<name>"]+r"\b", re.IGNORECASE)
for mod in all_modules:
dirname = os.path.join(QP_SRC,mod)
dirname = os.path.join(QP_SRC, mod)
if not os.path.isdir(dirname):
continue
for filename in os.listdir(dirname):
if "." not in filename:
continue
filename = os.path.join(dirname,filename)
filename = os.path.join(dirname, filename)
if not os.path.isfile(filename):
continue
with open(filename, "r") as f:
@ -90,15 +91,14 @@ def main(arguments):
f.write(f_new)
print "Done"
with open( os.path.join(QP_ROOT,"REPLACE"), 'a') as f:
print >>f, "qp_name "+" ".join(sys.argv[1:])
with open(os.path.join(QP_ROOT, "REPLACE"), 'a') as f:
print >>f, "qp_name "+" ".join(sys.argv[1:])
if __name__ == '__main__':
arguments = docopt(__doc__)
main(arguments)
ARGS = docopt(__doc__)
main(ARGS)

162
scripts/qp_plugins
View File

@ -2,44 +2,43 @@
# -*- coding: utf-8 -*-
"""
Usage:
qp_plugins list [ -i | -u | -q ]
qp_plugins list [-iuq]
qp_plugins download <url>
qp_plugins install <name>...
qp_plugins uninstall <name>
qp_plugins create -n <name> [-r <repository>] [<needed_modules>...]
qp_plugins create -n <name> [-r <repo>] [<needed_modules>...]
Options:
list List all the plugins
-i List only the installed plugins
-u List only the uninstalled plugins
-q List the external repositories
list List
-i --installed only the installed plugins
-u --uninstalled only the uninstalled plugins
-q --repositories the external repositories
download <url> Download an external repository.
The URL points to a tar.gz file or a git repository:
http://example.com/site/example.tar.gz
git@gitlab.com:user/example_repository
download <url> Download an external repository.
The URL points to a tar.gz file or a git repository:
http://example.com/site/example.tar.gz
git@gitlab.com:user/example_repository
install Install a plugin
install Install a plugin
uninstall Uninstall a plugin
uninstall Uninstall a plugin
create -n <name> Create a new plugin named <name>
-r <repository> Name of the repository in which to create the plugin
create
-n --name=<name> Create a new plugin named <name>
-r --repository=<repo> Name of the repository in which to create the plugin
"""
"""
import sys
import os
import subprocess
from os import listdir
from os.path import isdir, join
try:
from docopt import docopt
from module_handler import ModuleHandler, get_dict_child
from module_handler import get_l_module_descendant
from qp_path import QP_SRC, QP_PLUGINS, QP_ROOT, QP_DATA
from qp_path import QP_SRC, QP_PLUGINS, QP_DATA
except ImportError:
print "Please check if you have sourced the ${QP_ROOT}/quantum_package.rc"
print "(`source ${QP_ROOT}/quantum_package.rc`)"
@ -47,6 +46,7 @@ except ImportError:
def save_new_module(path, l_child):
"""Creates a new module"""
# ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ #
# N E E D E D _ C H I L D R E N _ M O D U L E S #
@ -78,8 +78,8 @@ def save_new_module(path, l_child):
data = g.read()
f.write(data)
with open(os.path.join(path, "%s.irp.f"%(module_name) ), "w") as f:
f.write("program {0}".format(module_name) )
with open(os.path.join(path, "%s.irp.f"%(module_name)), "w") as f:
f.write("program {0}".format(module_name))
f.write("""
implicit none
BEGIN_DOC
@ -90,49 +90,53 @@ def save_new_module(path, l_child):
""")
def main(arguments):
arguments["<name>"] = [ os.path.normpath(name) for name in arguments["<name>"] ]
"""Main function"""
arguments["<name>"] = [os.path.normpath(name) for name in arguments["<name>"]]
if arguments["list"]:
if arguments["-q"]:
l_result = [ f for f in listdir(QP_PLUGINS) if f not in [ ".gitignore", "local" ] ]
if arguments["--repositories"]:
l_result = [f for f in os.listdir(QP_PLUGINS) if f not in [".gitignore", "local"]]
else:
# Search in src all directories with a NEED file
l_tmp = [ dirname for (dirname, _, filenames) in os.walk(QP_PLUGINS, followlinks=False) for f in filenames if f == 'NEED']
# Search in src all directories with a NEED file
l_tmp = [dirname for (dirname, _, filenames) in \
os.walk(QP_PLUGINS, followlinks=False) \
for f in filenames if f == 'NEED']
# Find directories which contain modules
l_tmp = [ os.path.split(f) for f in l_tmp ]
l_tmp = [os.path.split(f) for f in l_tmp]
d_tmp = {}
for (x,_) in l_tmp:
for (x, _) in l_tmp:
d_tmp[x] = 1
l_repository = d_tmp.keys()
m_all_instances = ModuleHandler(l_repository)
m_instance = ModuleHandler(l_repository)
l_plugins = [ module for module in m_instance.l_module ]
m_instance = ModuleHandler(l_repository)
l_plugins = [module for module in m_instance.l_module]
l_result = l_plugins
if arguments["-i"] or arguments["-u"]:
if arguments["--installed"] or arguments["--uninstalled"]:
# Search in src all symbolic links that are modules
l_installed = [ f for f in listdir(QP_SRC) if (os.path.islink(os.path.join(QP_SRC,f)) and f != ".gitignore") ]
l_installed = [f for f in os.listdir(QP_SRC) \
if (os.path.islink(os.path.join(QP_SRC, f)) \
and f != ".gitignore")]
if arguments["-i"]:
l_result = [ f for f in l_plugins if f in l_installed ]
if arguments["--installed"]:
l_result = [f for f in l_plugins if f in l_installed]
elif arguments["-u"]:
l_result = [ f for f in l_plugins if f not in l_installed ]
elif arguments["--uninstalled"]:
l_result = [f for f in l_plugins if f not in l_installed]
for module in sorted(l_result):
print "* {0}".format(module)
if arguments["create"]:
m_instance = ModuleHandler([QP_SRC])
l_children = arguments["<needed_modules>"]
name = arguments["<name>"][0]
if arguments["-r"]:
repository = arguments["-r"]
for module in sorted(l_result):
print module
if arguments["create"]:
m_instance = ModuleHandler([QP_SRC])
l_children = arguments["<needed_modules>"]
name = arguments["<name>"][0]
if arguments["--repository"]:
repository = arguments["--repository"]
else:
repository = "local"
@ -161,16 +165,15 @@ def main(arguments):
print " [ OK ]"
print ""
arguments["create"]=False
arguments["install"]=True
arguments["create"] = False
arguments["install"] = True
main(arguments)
elif arguments["download"]:
url = arguments["<url>"]
is_repo = not( url.endswith(".tar.gz") or \
url.endswith(".tgz") or \
url.endswith(".zip") \
)
is_repo = not(url.endswith(".tar.gz") or \
url.endswith(".tgz") or \
url.endswith(".zip"))
os.chdir(QP_PLUGINS)
if is_repo:
subprocess.check_call(["git", "clone", url])
@ -179,38 +182,33 @@ def main(arguments):
import requests, shutil
try:
r = requests.get(url,verify=True,stream=True)
r = requests.get(url, verify=True, stream=True)
except:
r = requests.get(url,verify=False,stream=True)
r = requests.get(url, verify=False, stream=True)
r.raw.decode_content = True
with open(filename, 'wb') as f:
shutil.copyfileobj(r.raw, f)
shutil.copyfileobj(r.raw, f)
if filename.endswith(".tar.gz") or \
filename.endswith(".tgz") or \
filename.endswith(".tar.bz2") or \
filename.endswith(".tar"):
subprocess.check_call(["tar", "xf", filename])
os.remove(filename)
filename.endswith(".tgz") or \
filename.endswith(".tar.bz2") or \
filename.endswith(".tar"):
subprocess.check_call(["tar", "xf", filename])
os.remove(filename)
elif arguments["install"]:
# Python 2.6 ...
d_module_location= dict()
d_local = get_dict_child([QP_SRC])
# d_plugin = get_dict_child([join(QP_PLUGINS, f) for f in listdir(QP_PLUGINS) if isdir(join(QP_PLUGINS, f))])
l_tmp = [ dirname for (dirname, _, filenames) in os.walk(QP_PLUGINS, followlinks=False) for f in filenames if f == 'NEED']
l_tmp = [dirname for (dirname, _, filenames) in \
os.walk(QP_PLUGINS, followlinks=False) \
for f in filenames if f == 'NEED']
d_repo_of_plugin = {}
d_repo = {}
for (x,y) in [ os.path.split(f) for f in l_tmp ]:
for (x, y) in [os.path.split(f) for f in l_tmp]:
d_repo_of_plugin[y] = x
d_repo[x] = None
l_repository = d_repo.keys()
# m_all_instances = ModuleHandler(l_repository)
# m_instance = ModuleHandler(l_repository)
# l_plugins = [ module for module in m_instance.l_module ]
# print l_plugins
d_plugin = get_dict_child(l_repository)
@ -219,9 +217,9 @@ def main(arguments):
normalize_case = {}
for name in d_local.keys() + d_plugin.keys():
normalize_case [ name.lower() ] = name
normalize_case[name.lower()] = name
l_name = [ normalize_case[name.lower()] for name in arguments["<name>"] ]
l_name = [normalize_case[name.lower()] for name in arguments["<name>"]]
for name in l_name:
@ -240,11 +238,11 @@ def main(arguments):
print "Installation...",
for module_to_cp in l_module_to_cp:
src = os.path.join( d_repo_of_plugin[module_to_cp], module_to_cp )
src = os.path.join(d_repo_of_plugin[module_to_cp], module_to_cp)
des = os.path.join(QP_SRC, module_to_cp)
try:
os.symlink(src, des)
install = os.path.join(src,"install")
install = os.path.join(src, "install")
if os.path.isfile(install):
wd = os.getcwd()
os.chdir(src)
@ -268,10 +266,12 @@ def main(arguments):
if l_failed:
print "Plugins not installed:"
for name in sorted(l_failed):
print "* %s" % name
print "%s" % name
sys.exit(1)
l_name_to_remove = l_name + [module for module in m_instance.l_module for name in l_name if name in d_descendant[module]]
l_name_to_remove = l_name + \
[module for module in m_instance.l_module \
for name in l_name if name in d_descendant[module]]
print "Removing plugins:"
print l_name_to_remove
@ -282,7 +282,7 @@ def main(arguments):
for module in set(l_name_to_remove):
uninstall = os.path.join(QP_SRC,module,"uninstall")
uninstall = os.path.join(QP_SRC, module, "uninstall")
if os.path.isfile(uninstall):
subprocess.check_call([uninstall])
@ -293,6 +293,6 @@ def main(arguments):
if __name__ == '__main__':
arguments = docopt(__doc__)
main(arguments)
ARG = docopt(__doc__)
main(ARG)

37
scripts/qp_set_frozen_core
View File

@ -9,39 +9,38 @@ If pseudo-potentials are used, all the MOs are set as Active.
For elements on the right of the periodic table, qp_set_frozen_core will work
as expected. But for elements on the left, a small core will be chosen. For
example, a Carbon atom will have 2 core electrons, but a Lithium atom will have
zero.
zero.
Usage:
qp_set_frozen_core [-q|--query] <EZFIO_DIRECTORY>
qp_set_frozen_core [-q|--query] EZFIO_DIR
Options:
-q --query Prints in the standard output the number of core electrons
-q --query Prints in the standard output the number of frozen MOs
"""
import os
import sys
import os.path
import shutil
try:
from docopt import docopt
from qp_path import QP_SRC, QP_ROOT, QP_PLUGINS
import qp_path
except ImportError:
print "source .quantum_package.rc"
raise
from docopt import docopt
from ezfio import ezfio
def main(arguments):
"""Main function"""
filename = arguments["<EZFIO_DIRECTORY>"]
filename = arguments["EZFIO_DIR"]
ezfio.set_filename(filename)
nb = 0
n_frozen = 0
try:
do_pseudo = ezfio.pseudo_do_pseudo
except:
@ -52,25 +51,25 @@ def main(arguments):
if charge < 5:
pass
elif charge < 13:
nb += 1
n_frozen += 1
else:
nb += 5
n_frozen += 5
mo_num = ezfio.mo_basis_mo_num
if arguments["--query"]:
print nb
print n_frozen
sys.exit(0)
if nb == 0:
os.system( """qp_set_mo_class -a "[1-%d]" %s""" %
(mo_num, sys.argv[1]) )
if n_frozen == 0:
os.system("""qp_set_mo_class -a "[1-%d]" %s""" %
(mo_num, sys.argv[1]))
else:
os.system( """qp_set_mo_class -c "[1-%d]" -a "[%d-%d]" %s""" %
(nb, nb+1, mo_num, sys.argv[1]) )
os.system("""qp_set_mo_class -c "[1-%d]" -a "[%d-%d]" %s""" %
(n_frozen, n_frozen+1, mo_num, sys.argv[1]))
if __name__ == '__main__':
arguments = docopt(__doc__)
main(arguments)
ARGUMENTS = docopt(__doc__)
main(ARGUMENTS)

60
scripts/qp_srun
View File

@ -1,15 +1,28 @@
#!/bin/bash
set -e
function error() {
>&2 echo "$(basename $0): $@"
exit 2
}
set -e
PROG=$1
INPUT=$2
case ${PROG} in
-h|--help)
exec qp_run --help
;;
esac
NODES=($(srun hostname))
# Test that there is one MPI process per node
NPROC=$(echo ${NODES[@]} | tr ' ' '\n' | sort | wc -l)
NUNIQ=$(echo ${NODES[@]} | tr ' ' '\n' | sort | uniq | wc -l)
if [[ $NPROC != $NUNIQ ]]
then
echo "
if [[ $NPROC != $NUNIQ ]] ; then
error "
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error:
@ -20,17 +33,14 @@ In your SLURM script file, use:
#SBATCH --ntasks-per-node=1
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
"
exit -1
"
exit -1
fi
PROG=$1
INPUT=$2
# Check if quantum_package.rc is sourced
if [[ -z ${QP_ROOT} ]]
then
if [[ -z ${QP_ROOT} ]] ; then
echo "Error: quantum_package.rc is not sourced"
exit -1
fi
@ -40,25 +50,22 @@ fi
MASTER_NODE=${NODES[0]}
SLAVE_NODES=$(echo ${NODES[@]:1}| tr ' ' ',')
if [[ $NPROC -gt 1 ]]
then
if [[ $NPROC -gt 1 ]] ; then
echo "Master : $MASTER_NODE"
echo "Slaves : $SLAVE_NODES"
fi
# Check if the integrals can be read
source ${QP_ROOT}/external/ezfio/Bash/ezfio.sh
ezfio set_file $INPUT
RW=$(ezfio get mo_two_e_ints io_mo_two_e_integrals)
if [[ $RW != Read ]]
then
qp set_file $INPUT
RW=$(qp get mo_two_e_ints io_mo_two_e_integrals)
if [[ $RW != Read ]] ; then
echo "
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Warning:
Two-electron integrals were not saved to disk in a previous run.
If the 4-index transformation takes time, you may consider
killing this job and running
If the 4-index transformation takes time, you may consider
killing this job and running
qp_run four_idx_transform $INPUT
@ -71,14 +78,13 @@ rm --force -- "${INPUT}"/work/qp_run_address
set -x
srun -N 1 -n 1 qp_run $PROG $INPUT &
if [[ $NPROC -gt 1 ]]
then
while [[ ! -f $INPUT/work/qp_run_address ]]
do
sleep 1
done
echo "Starting slaves"
srun -n $((${SLURM_NTASKS}-1)) qp_run -slave $PROG $INPUT > $INPUT.slaves.out
if [[ $NPROC -gt 1 ]] ; then
while [[ ! -f $INPUT/work/qp_run_address ]] ; do
sleep 1
done
echo "Starting slaves"
srun -n $((${SLURM_NTASKS}-1)) \
qp_run -slave $PROG $INPUT > $INPUT.slaves.out
fi
wait

32
scripts/qp_test
View File

@ -19,7 +19,7 @@ import subprocess
try:
from docopt import docopt
from qp_path import QP_SRC, QP_PLUGINS, QP_ROOT, QP_TESTS
from qp_path import QP_SRC, QP_TESTS
except ImportError:
print "Please check if you have sourced the ${QP_ROOT}/quantum_package.rc"
print "(`source ${QP_ROOT}/quantum_package.rc`)"
@ -27,26 +27,28 @@ except ImportError:
def main(arguments):
"""Main function"""
# Fetch all *.bats files
l_bats = []
def append_bats(dirname, filenames):
for f in filenames:
if f.endswith(".bats"):
number, _ = f.split('.',1)
l_bats.append( (int(number), os.path.join(dirname,f)) )
number, _ = f.split('.', 1)
l_bats.append((int(number), os.path.join(dirname, f)))
if arguments["TEST"]:
os.environ["TEST"] = arguments["TEST"]
os.environ["TEST"] = arguments["TEST"]
if arguments["-a"]:
for (dirname, _, filenames) in os.walk(QP_SRC, followlinks=False) :
for (dirname, _, filenames) in os.walk(QP_SRC, followlinks=False):
if "IRPF90_temp" not in dirname:
append_bats(dirname, filenames)
else:
for (dirname, _, filenames) in os.walk(os.getcwd(), followlinks=False) :
for (dirname, _, filenames) in os.walk(os.getcwd(), followlinks=False):
if "IRPF90_temp" not in dirname:
append_bats(dirname, filenames)
l_bats = [ y for x,y in sorted(l_bats) ]
l_bats = [y for _, y in sorted(l_bats)]
# Execute tests
os.chdir(QP_TESTS)
@ -60,21 +62,23 @@ def main(arguments):
if arguments["-v"]:
p = None
if arguments["TEST"]:
TEST="export TEST=%s\n"%arguments["TEST"]
test = "export TEST=%s\n"%arguments["TEST"]
else:
TEST=""
script = TEST+(subprocess.check_output(["python2", "bats_to_sh.py", bats_file]) )
test = ""
script = test+(subprocess.check_output(["python2", \
"bats_to_sh.py", bats_file]))
try:
p = subprocess.check_call(script, shell=True, env=os.environ)
except:
if p: p.terminate()
if p:
p.terminate()
else:
subprocess.check_call(["bats", bats_file], env=os.environ)
if __name__ == '__main__':
arguments = docopt(__doc__)
main(arguments)
ARGS = docopt(__doc__)
main(ARGS)

67
scripts/qp_update Executable file
View File

@ -0,0 +1,67 @@
#!/bin/bash
#
# Updates the current version of QP
#
# Mon Jan 14 21:51:08 CET 2019
#
function help() {
cat << EOF
Updates the current version of QP.
Usage:
$(basename $0) [-h|--help]
Options:
-h --help Prints the help message
EOF
exit 0
}
function error() {
>&2 echo "$(basename $0): $@"
exit 2
}
TEMP=`getopt -o h -l help -n $0 -- "$@"` || exit 1
while true ; do
case "$1" in
""|--) shift ; break ;;
-h|-help|--help)
help
shift
exit 0;;
*)
echo $(basename $0)": unknown option $1, try --help"
exit 2;;
esac
done
# Check the QP_ROOT directory
if [[ -z ${QP_ROOT} ]] ; then
echo "The QP_ROOT environment variable is not set."
echo "Please reload the quantum_package.rc file."
exit 1
fi
read -r -p "Are you sure you want to update QP? [y/N] " response
case "$response" in
[yY][eE][sS]|[yY])
:
;;
*)
exit 0
;;
esac
cd ${QP_ROOT}
ninja clean
git pull origin master
ninja

16
scripts/remove_trailing_spaces Executable file
View File

@ -0,0 +1,16 @@
#!/bin/bash
#
# Removes white spaces at the end of lines.
#
# Usage:
#
# remove_trailing_spaces FILE
#
if [[ -n $1 ]] ; then
exec sed --in-place 's| *$||' $1
else
>&2 echo "Usage: $0 FILE"
exit 1
fi

18
scripts/save_current_mos.sh
View File

@ -5,8 +5,7 @@
# Wed Apr 2 14:35:15 CEST 2014
if [[ -z ${QP_ROOT} ]]
then
if [[ -z ${QP_ROOT} ]] ; then
print "The QP_ROOT environment variable is not set."
print "Please reload the quantum_package.rc file."
exit -1
@ -14,14 +13,12 @@ fi
EZFIO="$1"
if [[ -z "${EZFIO}" ]]
then
if [[ -z "${EZFIO}" ]] ; then
echo "Error in $0"
exit 1
fi
if [[ ! -f "${EZFIO}/mo_basis/mo_label" ]]
then
if [[ ! -f "${EZFIO}/mo_basis/mo_label" ]] ; then
LABEL='no_label'
else
LABEL=$(head -1 "${EZFIO}/mo_basis/mo_label" | xargs) #xargs trims the result
@ -31,19 +28,16 @@ DESTINATION="save/mo_basis/${LABEL}"
cd "${EZFIO}"
if [[ ! -d save/mo_basis ]]
then
if [[ ! -d save/mo_basis ]] ; then
mkdir -p save/mo_basis
fi
BACKUP="${DESTINATION}.old"
if [[ -d "${BACKUP}" ]]
then
if [[ -d "${BACKUP}" ]] ; then
rm -rf "${BACKUP}"
fi
if [[ -d "${DESTINATION}" ]]
then
if [[ -d "${DESTINATION}" ]] ; then
mv "${DESTINATION}" "${BACKUP}"
fi

0
scripts/utility/get_groups.py → scripts/utility/get_groups
View File

14
src/ao_basis/aos.irp.f
View File

@ -60,7 +60,7 @@ BEGIN_PROVIDER [ double precision, ao_coef_normalization_libint_factor, (ao_num)
powA(1) = ao_l(i)
powA(2) = 0
powA(3) = 0
! Normalization of the contracted basis functions
norm = 0.d0
do j=1,ao_prim_num(i)
@ -82,7 +82,7 @@ END_PROVIDER
BEGIN_DOC
! Sorted primitives to accelerate 4 index |MO| transformation
END_DOC
integer :: iorder(ao_prim_num_max)
double precision :: d(ao_prim_num_max,2)
integer :: i,j
@ -113,7 +113,7 @@ BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered_transp, (ao_prim_n
ao_coef_normalized_ordered_transp(i,j) = ao_coef_normalized_ordered(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_expo_ordered_transp, (ao_prim_num_max,ao_num) ]
@ -127,7 +127,7 @@ BEGIN_PROVIDER [ double precision, ao_expo_ordered_transp, (ao_prim_num_max,ao_n
ao_expo_ordered_transp(i,j) = ao_expo_ordered(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, ao_l, (ao_num) ]
@ -139,7 +139,7 @@ END_PROVIDER
END_DOC
integer :: i
do i=1,ao_num
ao_l(i) = ao_power(i,1) + ao_power(i,2) + ao_power(i,3)
ao_l(i) = ao_power(i,1) + ao_power(i,2) + ao_power(i,3)
ao_l_char(i) = l_to_charater(ao_l(i))
enddo
ao_l_max = maxval(ao_l)
@ -213,7 +213,7 @@ END_PROVIDER
integer :: i,j,k
BEGIN_DOC
! Index of the shell type |AOs| and of the corresponding |AOs|
! By convention, for p,d,f and g |AOs|, we take the index
! By convention, for p,d,f and g |AOs|, we take the index
! of the |AO| with the the corresponding power in the x axis
END_DOC
do i = 1, nucl_num
@ -274,7 +274,7 @@ BEGIN_PROVIDER [ character*(4), ao_l_char_space, (ao_num) ]
give_ao_character_space = 'X '
elseif(ao_power(i,2) == 1)then
give_ao_character_space = 'Y '
else
else
give_ao_character_space = 'Z '
endif
elseif(ao_l(i) == 2)then

72
src/ao_basis/aos_value.irp.f
View File

@ -9,14 +9,14 @@ double precision function ao_value(i,r)
integer :: m,num_ao
double precision :: center_ao(3)
double precision :: beta
integer :: power_ao(3)
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))
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)
@ -25,7 +25,7 @@ double precision function ao_value(i,r)
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)
accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
enddo
ao_value = accu * dx * dy * dz
@ -43,14 +43,14 @@ double precision function primitive_value(i,j,r)
integer :: m,num_ao
double precision :: center_ao(3)
double precision :: beta
integer :: power_ao(3)
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))
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)
@ -59,7 +59,7 @@ double precision function primitive_value(i,j,r)
accu = 0.d0
m=j
beta = ao_expo_ordered_transp(m,i)
accu += dexp(-beta*r2)
accu += dexp(-beta*r2)
primitive_value = accu * dx * dy * dz
end
@ -74,7 +74,7 @@ subroutine give_all_aos_at_r_old(r,aos_array)
double precision, intent(out) :: aos_array(ao_num)
integer :: i
double precision :: ao_value
do i = 1, ao_num
do i = 1, ao_num
aos_array(i) = ao_value(i,r)
enddo
end
@ -88,8 +88,8 @@ subroutine give_all_aos_at_r(r,aos_array)
END_DOC
double precision, intent(in) :: r(3)
double precision, intent(out) :: aos_array(ao_num)
integer :: power_ao(3)
integer :: power_ao(3)
integer :: i,j,k,l,m
double precision :: dx,dy,dz,r2
double precision :: dx2,dy2,dz2
@ -97,20 +97,20 @@ subroutine give_all_aos_at_r(r,aos_array)
double precision :: beta
do i = 1, nucl_num
center_ao(1:3) = nucl_coord(i,1:3)
dx = (r(1) - center_ao(1))
dy = (r(2) - center_ao(2))
dz = (r(3) - center_ao(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
do j = 1,Nucl_N_Aos(i)
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
do j = 1,Nucl_N_Aos(i)
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
aos_array(k) = 0.d0
power_ao(1:3)= ao_power_ordered_transp_per_nucl(1:3,j,i)
dx2 = dx**power_ao(1)
dy2 = dy**power_ao(2)
dz2 = dz**power_ao(3)
do l = 1,ao_prim_num(k)
dx2 = dx**power_ao(1)
dy2 = dy**power_ao(2)
dz2 = dz**power_ao(3)
do l = 1,ao_prim_num(k)
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
aos_array(k)+= ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
aos_array(k)+= ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
enddo
aos_array(k) = aos_array(k) * dx2 * dy2 * dz2
enddo
@ -128,8 +128,8 @@ subroutine give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
double precision, intent(in) :: r(3)
double precision, intent(out) :: aos_array(ao_num)
double precision, intent(out) :: aos_grad_array(3,ao_num)
integer :: power_ao(3)
integer :: power_ao(3)
integer :: i,j,k,l,m
double precision :: dx,dy,dz,r2
double precision :: dx2,dy2,dz2
@ -138,12 +138,12 @@ subroutine give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
double precision :: beta,accu_1,accu_2,contrib
do i = 1, nucl_num
center_ao(1:3) = nucl_coord(i,1:3)
dx = (r(1) - center_ao(1))
dy = (r(2) - center_ao(2))
dz = (r(3) - center_ao(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
do j = 1,Nucl_N_Aos(i)
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
do j = 1,Nucl_N_Aos(i)
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
aos_array(k) = 0.d0
aos_grad_array(1,k) = 0.d0
aos_grad_array(2,k) = 0.d0
@ -154,7 +154,7 @@ subroutine give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
dz2 = dz**power_ao(3)
if(power_ao(1) .ne. 0)then
dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1)
else
else
dx1 = 0.d0
endif
if(power_ao(2) .ne. 0)then
@ -169,9 +169,9 @@ subroutine give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
endif
accu_1 = 0.d0
accu_2 = 0.d0
do l = 1,ao_prim_num(k)
do l = 1,ao_prim_num(k)
beta = ao_expo_ordered_transp_per_nucl(l,j,i)
contrib = ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
contrib = ao_coef_normalized_ordered_transp_per_nucl(l,j,i) * dexp(-beta*r2)
accu_1 += contrib
accu_2 += contrib * beta
enddo
@ -213,7 +213,7 @@ subroutine give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_la
dz = (r(3) - center_ao(3))
r2 = dx*dx + dy*dy + dz*dz
do j = 1,Nucl_N_Aos(i)
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
k = Nucl_Aos_transposed(j,i) ! index of the ao in the ordered format
aos_array(k) = 0.d0
aos_grad_array(k,1) = 0.d0
aos_grad_array(k,2) = 0.d0
@ -229,7 +229,7 @@ subroutine give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_la
dz2 = dz**power_ao(3)
if(power_ao(1) .ne. 0)then
dx1 = dble(power_ao(1)) * dx**(power_ao(1)-1)
else
else
dx1 = 0.d0
endif
! For the Laplacian
@ -290,7 +290,7 @@ subroutine give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_la
aos_lapl_array(k,1) = accu_1 * dx3 * dy2 * dz2- 2.d0 * dx4 * dy2 * dz2* accu_2 +4.d0 * dx5 *dy2 * dz2* accu_3
aos_lapl_array(k,2) = accu_1 * dx2 * dy3 * dz2- 2.d0 * dx2 * dy4 * dz2* accu_2 +4.d0 * dx2 *dy5 * dz2* accu_3
aos_lapl_array(k,3) = accu_1 * dx2 * dy2 * dz3- 2.d0 * dx2 * dy2 * dz4* accu_2 +4.d0 * dx2 *dy2 * dz5* accu_3
enddo
enddo
end

4
src/ao_one_e_ints/README.rst
View File

@ -4,11 +4,11 @@ ao_one_e_integrals
All the one-electron integrals in the |AO| basis are here.
The most important providers for usual quantum-chemistry calculation are:
The most important providers for usual quantum-chemistry calculation are:
* `ao_kinetic_integral` which are the kinetic operator integrals on the |AO| basis (see :file:`kin_ao_ints.irp.f`)
* `ao_nucl_elec_integral` which are the nuclear-elctron operator integrals on the |AO| basis (see :file:`pot_ao_ints.irp.f`)
* `ao_one_e_integrals` which are the the h_core operator integrals on the |AO| basis (see :file:`ao_mono_ints.irp.f`)
Note that you can find other interesting integrals related to the position operator in :file:`spread_dipole_ao.irp.f`.
Note that you can find other interesting integrals related to the position operator in :file:`spread_dipole_ao.irp.f`.

4
src/ao_one_e_ints/ao_one_e_ints.irp.f
View File

@ -5,7 +5,7 @@
BEGIN_DOC
! One-electron Hamiltonian in the |AO| basis.
END_DOC
IF (read_ao_one_e_integrals) THEN
call ezfio_get_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals)
ELSE
@ -24,6 +24,6 @@
call ezfio_set_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals)
print *, 'AO one-e integrals written to disk'
ENDIF
END_PROVIDER

2
src/ao_one_e_ints/ao_ortho_canonical.irp.f
View File

@ -95,7 +95,7 @@ END_PROVIDER
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num ]
implicit none
BEGIN_DOC
! matrix of the coefficients of the mos generated by the
! matrix of the coefficients of the mos generated by the
! orthonormalization by the S^{-1/2} canonical transformation of the aos
! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital
END_DOC

14
src/ao_one_e_ints/ao_overlap.irp.f
View File

@ -3,7 +3,7 @@
&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_DOC
BEGIN_DOC
! Overlap between atomic basis functions:
!
! :math:`\int \chi_i(r) \chi_j(r) dr`
@ -73,7 +73,7 @@ END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
implicit none
BEGIN_DOC
BEGIN_DOC
! Overlap between absolute values of atomic basis functions:
!
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
@ -147,10 +147,10 @@ BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ]
double precision, allocatable :: U(:,:),Vt(:,:), D(:)
integer :: info, i, j, k
double precision, parameter :: threshold_overlap_AO_eigenvalues = 1.d-6
LDA = size(AO_overlap,1)
LDC = size(S_half_inv,1)
allocate( &
U(LDC,AO_num), &
Vt(LDA,AO_num), &
@ -188,7 +188,7 @@ BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ]
enddo
endif
enddo
END_PROVIDER
@ -203,7 +203,7 @@ BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ]
double precision, allocatable :: U(:,:)
double precision, allocatable :: Vt(:,:)
double precision, allocatable :: D(:)
allocate(U(ao_num,ao_num),Vt(ao_num,ao_num),D(ao_num))
call svd(ao_overlap,size(ao_overlap,1),U,size(U,1),D,Vt,size(Vt,1),ao_num,ao_num)
@ -222,7 +222,7 @@ BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ]
enddo
enddo
enddo
deallocate(U,Vt,D)
END_PROVIDER

4
src/ao_one_e_ints/kin_ao_ints.irp.f
View File

@ -28,7 +28,7 @@
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)
! --
! --
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
!$OMP DEFAULT(NONE) &
@ -125,7 +125,7 @@ BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
! :math:`\langle \chi_i |\hat{T}| \chi_j \rangle`
END_DOC
integer :: i,j,k,l
if (read_ao_integrals_kinetic) then
call ezfio_get_ao_one_e_ints_ao_integrals_kinetic(ao_kinetic_integrals)
print *, 'AO kinetic integrals read from disk'

42
src/ao_one_e_ints/pot_ao_erf_ints.irp.f
View File

@ -54,14 +54,14 @@ double precision function NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alp
! $\int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
! \frac{\erf(\mu |r-R_C|)}{|r-R_c|}$.
END_DOC
implicit none
integer, intent(in) :: n_pt_in
double precision,intent(in) :: C_center(3),A_center(3),B_center(3),alpha,beta,mu_in
integer, intent(in) :: power_A(3),power_B(3)
integer :: i,j,k,l,n_pt
double precision :: P_center(3)
double precision :: d(0:n_pt_in),pouet,coeff,dist,const,pouet_2,factor
double precision :: I_n_special_exact,integrate_bourrin,I_n_bibi
double precision :: V_e_n,const_factor,dist_integral,tmp
@ -72,7 +72,7 @@ double precision function NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alp
p_inv = 1.d0/p
p_inv_2 = 0.5d0 * p_inv
rho = alpha * beta * p_inv
dist = 0.d0
dist_integral = 0.d0
do i = 1, 3
@ -90,7 +90,7 @@ double precision function NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alp
factor = dexp(-const_factor)
coeff = dtwo_pi * factor * p_inv * p_new
lmax = 20
! print*, "b"
do i = 0, n_pt_in
d(i) = 0.d0
@ -102,24 +102,24 @@ double precision function NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alp
NAI_pol_mult_erf = coeff * pouet
return
endif
! call give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
p_new = p_new * p_new
call give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in,p,p_inv,p_inv_2,p_new,P_center)
if(n_pt_out<0)then
NAI_pol_mult_erf = 0.d0
return
endif
accu = 0.d0
! 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)
enddo
NAI_pol_mult_erf = accu * coeff
end
@ -144,7 +144,7 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
double precision :: accu
accu = 0.d0
ASSERT (n_pt_in > 1)
double precision :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
R1x(0) = (P_center(1) - A_center(1))
R1x(1) = 0.d0
@ -184,7 +184,7 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
enddo
return
endif
R1x(0) = (P_center(2) - A_center(2))
R1x(1) = 0.d0
R1x(2) = -(P_center(2) - C_center(2))* p_new
@ -203,8 +203,8 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
enddo
return
endif
R1x(0) = (P_center(3) - A_center(3))
R1x(1) = 0.d0
R1x(2) = -(P_center(3) - C_center(3))* p_new
@ -215,7 +215,7 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
!R2x = 0.5 / p - 0.5/p ( t * mu/sqrt(p+mu^2) )^2
a_z = power_A(3)
b_z = power_B(3)
call I_x1_pol_mult_one_e(a_z,b_z,R1x,R1xp,R2x,d3,n_pt3,n_pt_in)
if(n_pt3<0)then
n_pt_out = -1
@ -235,7 +235,7 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center,B_center,alpha,bet
do i = 0, n_pt_out
d(i) = d1(i)
enddo
end
@ -270,7 +270,7 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
do i =1, 3
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
enddo
double precision :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
R1x(0) = (P_center(1) - A_center(1))
R1x(1) = 0.d0
@ -311,7 +311,7 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
enddo
return
endif
R1x(0) = (P_center(2) - A_center(2))
R1x(1) = 0.d0
R1x(2) = -(P_center(2) - C_center(2))* mu_in**2 / (p+mu_in*mu_in)
@ -331,8 +331,8 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
enddo
return
endif
R1x(0) = (P_center(3) - A_center(3))
R1x(1) = 0.d0
R1x(2) = -(P_center(3) - C_center(3))* mu_in**2 / (p+mu_in*mu_in)
@ -343,7 +343,7 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
!R2x = 0.5 / p - 0.5/p ( t * mu/sqrt(p+mu^2) )^2
a_z = power_A(3)
b_z = power_B(3)
! print*,'a_z = ',a_z
! print*,'b_z = ',b_z
call I_x1_pol_mult_one_e(a_z,b_z,R1x,R1xp,R2x,d3,n_pt3,n_pt_in)
@ -366,6 +366,6 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,&
do i = 0, n_pt_out
d(i) = d1(i)
enddo
end

86
src/ao_one_e_ints/pot_ao_ints.irp.f
View File

@ -11,59 +11,59 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
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
if (read_ao_integrals_e_n) then
call ezfio_get_ao_one_e_ints_ao_integrals_e_n(ao_integrals_n_e)
print *, 'AO N-e integrals read from disk'
else
ao_integrals_n_e = 0.d0
! _
! /| / |_)
! | / | \
!
!$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)
n_pt_in = n_pt_max_integrals
!$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)
do i = 1, ao_num
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 l=1,ao_prim_num(j)
alpha = ao_expo_ordered_transp(l,j)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i)
double precision :: c
c = 0.d0
do k = 1, nucl_num
double precision :: Z
Z = nucl_charge(k)
C_center(1:3) = nucl_coord(k,1:3)
c = c - Z * NAI_pol_mult(A_center,B_center, &
power_A,power_B,alpha,beta,C_center,n_pt_in)
enddo
ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j) &
+ ao_coef_normalized_ordered_transp(l,j) &
@ -72,7 +72,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
endif
@ -80,7 +80,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
call ezfio_set_ao_one_e_ints_ao_integrals_e_n(ao_integrals_n_e)
print *, 'AO N-e integrals written to disk'
endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nucl_num)]
@ -96,9 +96,9 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
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
ao_integrals_n_e_per_atom = 0.d0
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,power_A,power_B,&
@ -107,7 +107,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
!$OMP n_pt_max_integrals,ao_integrals_n_e_per_atom,nucl_num)
n_pt_in = n_pt_max_integrals
!$OMP DO SCHEDULE (dynamic)
double precision :: c
do j = 1, ao_num
power_A(1)= ao_power(j,1)
@ -146,7 +146,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
enddo
!$OMP END DO
!$OMP END PARALLEL
END_PROVIDER
@ -157,7 +157,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
!
! :math:`\langle g_i | \frac{1}{|r-R_c|} | g_j \rangle`
END_DOC
implicit none
integer, intent(in) :: n_pt_in
double precision,intent(in) :: C_center(3),A_center(3),B_center(3),alpha,beta
@ -201,7 +201,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
factor = dexp(-const_factor)
coeff = dtwo_pi * factor * p_inv
lmax = 20
! print*, "b"
do i = 0, n_pt_in
d(i) = 0.d0
@ -213,16 +213,16 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
NAI_pol_mult = coeff * pouet
return
endif
call 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)
if(n_pt_out<0)then
NAI_pol_mult = 0.d0
return
endif
accu = 0.d0
! 1/r1 standard attraction integral
epsilo = 1.d0
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
@ -230,7 +230,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
accu += d(i) * rint(i/2,const)
enddo
NAI_pol_mult = accu * coeff
end
@ -263,7 +263,7 @@ subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_
do i =1, 3
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
enddo
double precision :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
R1x(0) = (P_center(1) - A_center(1))
R1x(1) = 0.d0
@ -304,7 +304,7 @@ subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_
enddo
return
endif
R1x(0) = (P_center(2) - A_center(2))
R1x(1) = 0.d0
R1x(2) = -(P_center(2) - C_center(2))
@ -324,8 +324,8 @@ subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_
enddo
return
endif
R1x(0) = (P_center(3) - A_center(3))
R1x(1) = 0.d0
R1x(2) = -(P_center(3) - C_center(3))
@ -336,7 +336,7 @@ subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_
a_z = power_A(3)
b_z = power_B(3)
call I_x1_pol_mult_one_e(a_z,b_z,R1x,R1xp,R2x,d3,n_pt3,n_pt_in)
if(n_pt3<0)then
@ -357,7 +357,7 @@ subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_
do i = 0, n_pt_out
d(i) = d1(i)
enddo
end
@ -379,7 +379,7 @@ recursive subroutine I_x1_pol_mult_one_e(a,c,R1x,R1xp,R2x,d,nd,n_pt_in)
dim = n_pt_in
! print*,'a,c = ',a,c
! print*,'nd_in = ',nd
if( (a==0) .and. (c==0))then
nd = 0
d(0) = 1.d0
@ -414,7 +414,7 @@ recursive subroutine I_x1_pol_mult_one_e(a,c,R1x,R1xp,R2x,d,nd,n_pt_in)
X(ix) *= dble(a-1)
enddo
call multiply_poly(X,nx,R2x,2,d,nd)
nx = nd
do ix=0,n_pt_in
X(ix) = 0.d0
@ -442,7 +442,7 @@ recursive subroutine I_x2_pol_mult_one_e(c,R1x,R1xp,R2x,d,nd,dim)
integer, intent(in) :: c
double precision, intent(in) :: R1x(0:2),R1xp(0:2),R2x(0:2)
integer :: i
if(c==0) then
nd = 0
d(0) = 1.d0
@ -468,7 +468,7 @@ recursive subroutine I_x2_pol_mult_one_e(c,R1x,R1xp,R2x,d,nd,dim)
do ix=0,dim
Y(ix) = 0.d0
enddo
call I_x1_pol_mult_one_e(0,c-1,R1x,R1xp,R2x,Y,ny,dim)
if(ny.ge.0)then
call multiply_poly(Y,ny,R1xp,2,d,nd)
@ -495,7 +495,7 @@ double precision function V_e_n(a_x,a_y,a_z,b_x,b_y,b_z,alpha,beta)
* V_phi(a_x+b_x,a_y+b_y) &
* V_theta(a_z+b_z,a_x+b_x+a_y+b_y+1)
endif
end
@ -510,7 +510,7 @@ double precision function int_gaus_pol(alpha,n)
integer :: n
double precision :: dble_fact
include 'utils/constants.include.F'
int_gaus_pol = 0.d0
if(iand(n,1).eq.0)then
int_gaus_pol = dsqrt(alpha/pi)
@ -522,7 +522,7 @@ double precision function int_gaus_pol(alpha,n)
enddo
int_gaus_pol = dble_fact(n -1) / int_gaus_pol
endif
end
double precision function V_r(n,alpha)
@ -598,7 +598,7 @@ double precision function Wallis(n)
Wallis = fact(p)
Wallis = dble(ibset(0_8,p+p)) * Wallis*Wallis / fact(p+p+1)
endif
end

78
src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f
View File

@ -3,12 +3,12 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)]
BEGIN_DOC
! Pseudo-potential integrals in the |AO| basis set.
END_DOC
if (read_ao_integrals_pseudo) then
call ezfio_get_ao_one_e_ints_ao_integrals_pseudo(ao_pseudo_integrals)
print *, 'AO pseudopotential integrals read from disk'
else
ao_pseudo_integrals = 0.d0
if (do_pseudo) then
if (pseudo_klocmax > 0) then
@ -19,12 +19,12 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)]
endif
endif
endif
if (write_ao_integrals_pseudo) then
call ezfio_set_ao_one_e_ints_ao_integrals_pseudo(ao_pseudo_integrals)
print *, 'AO pseudopotential integrals written to disk'
endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
@ -39,18 +39,18 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
integer :: power_A(3),power_B(3)
integer :: i,j,k,l,n_pt_in,m
double precision :: Vloc, Vpseudo
double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0
integer :: thread_num
integer :: omp_get_thread_num
ao_pseudo_integrals_local = 0.d0
print*, 'Providing the nuclear electron pseudo integrals (local)'
call wall_time(wall_1)
call cpu_time(cpu_1)
thread_num = 0
!$OMP PARALLEL &
@ -62,32 +62,32 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
!$OMP ao_pseudo_integrals_local,nucl_num,nucl_charge, &
!$OMP pseudo_klocmax,pseudo_lmax,pseudo_kmax,pseudo_v_k_transp,pseudo_n_k_transp, pseudo_dz_k_transp,&
!$OMP wall_1)
!$ thread_num = omp_get_thread_num()
wall_0 = wall_1
!$OMP DO SCHEDULE (guided)
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 i = 1, ao_num
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 l=1,ao_prim_num(j)
alpha = ao_expo_ordered_transp(l,j)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i)
double precision :: c
c = 0.d0
if (dabs(ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i))&
< thresh) then
cycle
@ -95,13 +95,13 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
do k = 1, nucl_num
double precision :: Z
Z = nucl_charge(k)
C_center(1:3) = nucl_coord(k,1:3)
c = c + Vloc(pseudo_klocmax, &
pseudo_v_k_transp (1,k), &
pseudo_n_k_transp (1,k), &
pseudo_dz_k_transp(1,k), &
pseudo_v_k_transp (1,k), &
pseudo_n_k_transp (1,k), &
pseudo_dz_k_transp(1,k), &
A_center,power_A,alpha,B_center,power_B,beta,C_center)
enddo
@ -110,7 +110,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
enddo
enddo
enddo
call wall_time(wall_2)
if (thread_num == 0) then
if (wall_2 - wall_0 > 1.d0) then
@ -140,14 +140,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
integer :: i,j,k,l,n_pt_in,m
double precision :: Vloc, Vpseudo
integer :: omp_get_thread_num
double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0
integer :: thread_num
ao_pseudo_integrals_non_local = 0.d0
print*, 'Providing the nuclear electron pseudo integrals (non-local)'
call wall_time(wall_1)
call cpu_time(cpu_1)
thread_num = 0
@ -161,32 +161,32 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
!$OMP ao_pseudo_integrals_non_local,nucl_num,nucl_charge,&
!$OMP pseudo_klocmax,pseudo_lmax,pseudo_kmax,pseudo_n_kl_transp, pseudo_v_kl_transp, pseudo_dz_kl_transp,&
!$OMP wall_1)
!$ thread_num = omp_get_thread_num()
wall_0 = wall_1
!$OMP DO SCHEDULE (guided)
!
!
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 i = 1, ao_num
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 l=1,ao_prim_num(j)
alpha = ao_expo_ordered_transp(l,j)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i)
double precision :: c
c = 0.d0
if (dabs(ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i))&
< thresh) then
cycle
@ -195,9 +195,9 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
do k = 1, nucl_num
double precision :: Z
Z = nucl_charge(k)
C_center(1:3) = nucl_coord(k,1:3)
c = c + Vpseudo(pseudo_lmax,pseudo_kmax, &
pseudo_v_kl_transp(1,0,k), &
pseudo_n_kl_transp(1,0,k), &
@ -209,7 +209,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
enddo
enddo
enddo
call wall_time(wall_2)
if (thread_num == 0) then
if (wall_2 - wall_0 > 1.d0) then

288
src/ao_one_e_ints/pseudopot.f90
View File

@ -6,7 +6,7 @@
!! with :
!!
!! {\tt Vloc}(C)=\sum_{k=1}^{\tt klocmax} v_k r_C^{n_k} \exp(-dz_k r_C^2) \\
!!
!!
!! {\tt Vpp}(C)=\sum_{l=0}^{\tt lmax}\left( \sum_{k=1}^{\tt kmax} v_{kl}
!! r_C^{n_{kl}} \exp(-dz_{kl} r_C)^2 \right) |l\rangle \langle l|
!!
@ -40,7 +40,7 @@ double precision Vloc_num,Vpseudo_num,v1,v2
integer npts,nptsgrid
nptsgrid=50
call initpseudos(nptsgrid)
v1=Vloc_num(npts,rmax,klocmax,v_k,n_k,dz_k,a,n_a,g_a,b,n_b,g_b,c)
v1=Vloc_num(npts,rmax,klocmax,v_k,n_k,dz_k,a,n_a,g_a,b,n_b,g_b,c)
v2=Vpseudo_num(nptsgrid,rmax,lmax,kmax,v_kl,n_kl,dz_kl,a,n_a,g_a,b,n_b,g_b,c)
Vps_num=v1+v2
end
@ -68,7 +68,7 @@ do iz=1,npts_over
z=-xmax+dx*iz+dx/2.d0
term=orb_phi(x,y,z,n_a,ac,g_a)*orb_phi(x,y,z,n_b,bc,g_b)
r=dsqrt(x**2+y**2+z**2)
do k=1,klocmax
do k=1,klocmax
Vloc_num=Vloc_num+dx**3*v_k(k)*r**n_k(k)*dexp(-dz_k(k)*r**2)*term
enddo
enddo
@ -85,12 +85,12 @@ orb_phi=(x-center(1))**npower(1)*(y-center(2))**npower(2)*(z-center(3))**npower(
orb_phi=orb_phi*dexp(-gamma*r2)
end
!! Real spherical harmonics Ylm
!! Real spherical harmonics Ylm
! factor = ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2
! Y_lm(theta,phi) =
! Y_lm(theta,phi) =
! m > 0 factor* P_l^|m|(cos(theta)) cos (|m| phi)
! m = 0 1/sqrt(2) *factor* P_l^0(cos(theta))
! m = 0 1/sqrt(2) *factor* P_l^0(cos(theta))
! m < 0 factor* P_l^|m|(cos(theta)) sin (|m| phi)
!
! x=cos(theta)
@ -107,7 +107,7 @@ end
if(dabs(x).gt.1.d0)then
print*,'pb. in ylm_no'
print*,'x=',x
stop
stop
endif
call LPMN(MM,l,l,X,PM)
plm=PM(iabs_m,l)
@ -134,16 +134,16 @@ end
if(l.gt.2)stop 'l > 2 not coded!'
end
! _
! | |
! __ __ _ __ ___ ___ _ _ __| | ___
! \ \ / / | '_ \/ __|/ _ \ | | |/ _` |/ _ \
! _
! | |
! __ __ _ __ ___ ___ _ _ __| | ___
! \ \ / / | '_ \/ __|/ _ \ | | |/ _` |/ _ \
! \ V / | |_) \__ \ __/ |_| | (_| | (_) |
! \_/ | .__/|___/\___|\__,_|\____|\___/
! | |
! |_|
! \_/ | .__/|___/\___|\__,_|\____|\___/
! | |
! |_|
!! Routine Vpseudo is based on formumla (66)
!! Routine Vpseudo is based on formumla (66)
!! of Kahn Baybutt TRuhlar J.Chem.Phys. vol.65 3826 (1976):
!!
!! Vpseudo= (4pi)**2* \sum_{l=0}^lmax \sum_{m=-l}^{l}
@ -167,8 +167,8 @@ end
!! BC=|B-C|
!! AC_unit= vect(AC)/AC
!! BC_unit= vect(BC)/BC
!! bigI(lambda,mu,l,m,k1,k2,k3)=
!! \int dOmega Y_{lambda mu}(Omega) xchap^k1 ychap^k2 zchap^k3 Y_{l m}(Omega)
!! bigI(lambda,mu,l,m,k1,k2,k3)=
!! \int dOmega Y_{lambda mu}(Omega) xchap^k1 ychap^k2 zchap^k3 Y_{l m}(Omega)
!!
!! bigR(lambda,lambdap,N,g_a,g_b,gamm_k,AC,BC)
!! = exp(-g_a* AC**2 -g_b* BC**2) * int_prod_bessel_loc(ktot+2,g_a+g_b+dz_k(k),l,dreal)
@ -178,19 +178,19 @@ double precision function Vpseudo &
(lmax,kmax,v_kl,n_kl,dz_kl,a,n_a,g_a,b,n_b,g_b,c)
implicit none
! ___
! | ._ ._ _|_
! _|_ | | |_) |_| |_
! |
! ___
! | ._ ._ _|_
! _|_ | | |_) |_| |_
! |
double precision, intent(in) :: a(3),g_a,b(3),g_b,c(3)
integer, intent(in) :: lmax,kmax,n_kl(kmax,0:lmax)
integer, intent(in) :: n_a(3),n_b(3)
double precision, intent(in) :: v_kl(kmax,0:lmax),dz_kl(kmax,0:lmax)
!
! | _ _ _. |
! |_ (_) (_ (_| |
!
!
! | _ _ _. |
! |_ (_) (_ (_| |
!
double precision :: fourpi,f,prod,prodp,binom_func,accu,bigR,bigI,ylm
double precision :: theta_AC0,phi_AC0,theta_BC0,phi_BC0,ac,bc,big
@ -200,10 +200,10 @@ double precision :: arg
integer :: ntot,ntotA,m,mu,mup,k1,k2,k3,ntotB,k1p,k2p,k3p,lambda,lambdap,ktot
integer :: l,k, nkl_max
! _
! |_) o _ _. ._ ._ _.
! |_) | (_| (_| | | (_| \/
! _| /
! _
! |_) o _ _. ._ ._ _.
! |_) | (_| (_| | | (_| \/
! _| /
double precision, allocatable :: array_coefs_A(:,:)
double precision, allocatable :: array_coefs_B(:,:)
@ -248,7 +248,7 @@ allocate (array_coefs_B(0:ntot,3))
allocate (array_R(kmax,0:ntot+nkl_max,0:lmax,0:lmax+ntot,0:lmax+ntot))
allocate (array_I_A(-(lmax+ntot):lmax+ntot,0:lmax+ntot,0:ntot,0:ntot,0:ntot))
allocate (array_I_B(-(lmax+ntot):lmax+ntot,0:lmax+ntot,0:ntot,0:ntot,0:ntot))
if(ac.eq.0.d0.and.bc.eq.0.d0)then
@ -309,7 +309,7 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
enddo
enddo
enddo
do k1=0,n_a(1)
array_coefs_A(k1,1) = binom_func(n_a(1),k1)*(c(1)-a(1))**(n_a(1)-k1)
enddo
@ -329,7 +329,7 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
do k3p=0,n_b(3)
array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p)
enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
@ -337,7 +337,7 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
accu=0.d0
do l=0,lmax
do m=-l,l
do k3=0,n_a(3)
do k2=0,n_a(2)
do k1=0,n_a(1)
@ -349,7 +349,7 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
enddo
enddo
enddo
do k3p=0,n_b(3)
do k2p=0,n_b(2)
do k1p=0,n_b(1)
@ -361,7 +361,7 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
enddo
enddo
enddo
do k3=0,n_a(3)
if (array_coefs_A(k3,3) == 0.d0) cycle
do k2=0,n_a(2)
@ -371,40 +371,40 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
do lambda=0,l+ntotA
do mu=-lambda,lambda
prod=ylm(lambda,mu,theta_AC0,phi_AC0)*array_coefs_A(k1,1)*array_coefs_A(k2,2)*array_coefs_A(k3,3)*array_I_A(mu,lambda,k1,k2,k3)
if (prod == 0.d0) cycle
do k3p=0,n_b(3)
do k2p=0,n_b(2)
do k1p=0,n_b(1)
do lambdap=0,l+ntotB
do mup=-lambdap,lambdap
prodp=prod*ylm(lambdap,mup,theta_BC0,phi_BC0)* &
array_coefs_B(k1p,1)*array_coefs_B(k2p,2)*array_coefs_B(k3p,3)* &
array_I_B(mup,lambdap,k1p,k2p,k3p)
if (prodp == 0.d0) cycle
do k=1,kmax
ktot=k1+k2+k3+k1p+k2p+k3p+n_kl(k,l)
accu=accu+prodp*v_kl(k,l)*array_R(k,ktot,l,lambda,lambdap)
enddo
enddo
enddo
enddo
enddo
enddo
enddo
enddo
enddo
enddo
enddo
enddo
enddo
@ -455,7 +455,7 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
accu=0.d0
do l=0,lmax
do m=-l,l
do k3p=0,n_b(3)
do k2p=0,n_b(2)
do k1p=0,n_b(1)
@ -467,9 +467,9 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
enddo
enddo
enddo
prod=bigI(0,0,l,m,n_a(1),n_a(2),n_a(3))
do k3p=0,n_b(3)
if (array_coefs_B(k3p,3) == 0.d0) cycle
do k2p=0,n_b(2)
@ -478,18 +478,18 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
if (array_coefs_B(k1p,1) == 0.d0) cycle
do lambdap=0,l+ntotB
do mup=-lambdap,lambdap
prodp=prod*array_coefs_B(k1p,1)*array_coefs_B(k2p,2)*array_coefs_B(k3p,3)*ylm(lambdap,mup,theta_BC0,phi_BC0)*array_I_B(mup,lambdap,k1p,k2p,k3p)
if (prodp == 0.d0) cycle
do k=1,kmax
ktot=ntotA+k1p+k2p+k3p+n_kl(k,l)
accu=accu+prodp*v_kl(k,l)*array_R(k,ktot,l,0,lambdap)
enddo
enddo
enddo
enddo
@ -566,18 +566,18 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
if (array_coefs_A(k1,1) == 0.d0) cycle
do lambda=0,l+ntotA
do mu=-lambda,lambda
prod=array_coefs_A(k1,1)*array_coefs_A(k2,2)*array_coefs_A(k3,3)*ylm(lambda,mu,theta_AC0,phi_AC0)*array_I_A(mu,lambda,k1,k2,k3)
if (prod == 0.d0) cycle
prodp=prod*bigI(0,0,l,m,n_b(1),n_b(2),n_b(3))
if (prodp == 0.d0) cycle
do k=1,kmax
ktot=k1+k2+k3+ntotB+n_kl(k,l)
accu=accu+prodp*v_kl(k,l)*array_R(k,ktot,l,lambda,0)
enddo
enddo
enddo
enddo
@ -586,7 +586,7 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
enddo
enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
@ -594,52 +594,52 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
Vpseudo=f*accu
endif
! _
! |_ o ._ _. | o _ _
! | | | | (_| | | _> (/_
!
! _
! |_ o ._ _. | o _ _
! | | | | (_| | | _> (/_
!
deallocate (array_R, array_I_A, array_I_B)
deallocate (array_coefs_A, array_coefs_B)
return
end
! _
! | |
!__ __ _ __ ___ ___ _ _ __| | ___ _ __ _ _ _ __ ___
!\ \ / / | '_ \/ __|/ _ \ | | |/ _` |/ _ \ | '_ \| | | | '_ ` _ \
! _
! | |
!__ __ _ __ ___ ___ _ _ __| | ___ _ __ _ _ _ __ ___
!\ \ / / | '_ \/ __|/ _ \ | | |/ _` |/ _ \ | '_ \| | | | '_ ` _ \
! \ V / | |_) \__ \ __/ |_| | (_| | (_) | | | | | |_| | | | | | |
! \_/ | .__/|___/\___|\__,_|\__,_|\___/ |_| |_|\__,_|_| |_| |_|
! | |
! |_|
! | |
! |_|
double precision function Vpseudo_num(npts,rmax,lmax,kmax,v_kl,n_kl,dz_kl,a,n_a,g_a,b,n_b,g_b,c)
implicit none
! ___
! | ._ ._ _|_
! _|_ | | |_) |_| |_
! |
! ___
! | ._ ._ _|_
! _|_ | | |_) |_| |_
! |
double precision, intent(in) :: a(3),g_a,b(3),g_b,c(3)
integer, intent(in) :: lmax,kmax,npts
integer, intent(in) :: n_a(3),n_b(3), n_kl(kmax,0:lmax)
double precision, intent(in) :: v_kl(kmax,0:lmax),dz_kl(kmax,0:lmax)
double precision, intent(in) :: rmax
!
!
! | _ _ _. |
! |_ (_) (_ (_| |
!
!
integer :: l,m,k,kk
double precision ac(3),bc(3)
double precision dr,sum,rC
double precision overlap_orb_ylm_brute
! _
! / _. | _ |
! \_ (_| | (_ |_| |
!
! _
! / _. | _ |
! \_ (_| | (_ |_| |
!
do l=1,3
ac(l)=a(l)-c(l)
@ -663,7 +663,7 @@ enddo
Vpseudo_num=sum
return
end
!! Routine Vloc is a variation of formumla (66)
!! Routine Vloc is a variation of formumla (66)
!! of Kahn Baybutt TRuhlar J.Chem.Phys. vol.65 3826 (1976)
!! without the projection operator
!!
@ -689,9 +689,9 @@ end
!! BC_unit= vect(BC)/BCA
!!
!! bigR(lambda,g_a,g_b,g_k,AC,BC)
!! = exp(-g_a* AC**2 -g_b* BC**2)*
!! I_loc= \int dx x**l *exp(-gam*x**2) M_n(ax) l=ktot+2 gam=g_a+g_b+dz_k(k) a=dreal n=l
!! M_n(x) modified spherical bessel function
!! = exp(-g_a* AC**2 -g_b* BC**2)*
!! I_loc= \int dx x**l *exp(-gam*x**2) M_n(ax) l=ktot+2 gam=g_a+g_b+dz_k(k) a=dreal n=l
!! M_n(x) modified spherical bessel function
double precision function Vloc(klocmax,v_k,n_k,dz_k,a,n_a,g_a,b,n_b,g_b,c)
@ -717,14 +717,14 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
Vloc=0.d0
return
endif
ntotA=n_a(1)+n_a(2)+n_a(3)
ntotB=n_b(1)+n_b(2)+n_b(3)
ntot=ntotA+ntotB
if(ac.eq.0.d0.and.bc.eq.0.d0)then
accu=0.d0
do k=1,klocmax
accu=accu+v_k(k)*crochet(n_k(k)+2+ntot,g_a+g_b+dz_k(k))
enddo
@ -732,9 +732,9 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
!bigI frequently is null
return
endif
freal=dexp(-g_a*ac**2-g_b*bc**2)
d2 = 0.d0
do i=1,3
d(i)=g_a*(a(i)-c(i))+g_b*(b(i)-c(i))
@ -742,11 +742,11 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
enddo
d2=dsqrt(d2)
dreal=2.d0*d2
allocate (array_R_loc(-2:ntot+klocmax,klocmax,0:ntot))
allocate (array_coefs(0:ntot,0:ntot,0:ntot,0:ntot,0:ntot,0:ntot))
do ktot=-2,ntotA+ntotB+klocmax
do l=0,ntot
do k=1,klocmax
@ -754,7 +754,7 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
enddo
enddo
enddo
do k1=0,n_a(1)
do k2=0,n_a(2)
do k3=0,n_a(3)
@ -771,8 +771,8 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
enddo
enddo
enddo
accu=0.d0
if(d2 == 0.d0)then
l=0
@ -796,11 +796,11 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
enddo
enddo
enddo
else
theta_DC0=dacos(d(3)/d2)
phi_DC0=datan2(d(2)/d2,d(1)/d2)
do k=1,klocmax
if (v_k(k) == 0.d0) cycle
do k1=0,n_a(1)
@ -830,7 +830,7 @@ double precision int_prod_bessel_loc,binom_func,accu,prod,ylm,bigI,arg
enddo
endif
Vloc=f*accu
deallocate (array_R_loc)
deallocate (array_coefs)
end
@ -1129,7 +1129,7 @@ do i=1,npts
sintheta=dsqrt(1.d0-u**2)
do j=1,npts
phi=dphi*(j-1)+dphi/2.d0
x_orb=r*dcos(phi)*sintheta
x_orb=r*dcos(phi)*sintheta
y_orb=r*dsin(phi)*sintheta
z_orb=r*u
term=orb_phi(x_orb,y_orb,z_orb,npower_orb,center_orb,g_orb)*ylm_real(l,m,u,phi)
@ -1168,11 +1168,11 @@ end
! l=0,1,2,....
! m=0,1,...,l
! Here:
! n=l (n=0,1,...)
! m=0,1,...,n
! n=l (n=0,1,...)
! m=0,1,...,n
! x=cos(theta) 0 < x < 1
!
!
!
! This routine computes: PM(m,n) for n=0,...,N (number N in input) and m=0,..,n
! Exemples (see 'Associated Legendre Polynomilas wikipedia')
@ -1197,7 +1197,7 @@ end
! Input : x --- Argument of Pmn(x)
! m --- Order of Pmn(x), m = 0,1,2,...,n
! n --- Degree of Pmn(x), n = 0,1,2,...,N
! mm --- Physical dimension of PM
! mm --- Physical dimension of PM
! Output: PM(m,n) --- Pmn(x)
! =====================================================
!
@ -1238,7 +1238,7 @@ end
ENDDO
II = 0.D0
DO I=0,M
DO I=0,M
JJ = II+2.D0
DO J=I+2,N
PM(I,J)=((2.0D0*JJ-1.0D0)*X*PM(I,J-1)- (II+JJ-1.0D0)*PM(I,J-2))*INVERSE(J-I)
@ -1576,7 +1576,7 @@ end
cc=g_a+g_b+g_k
if(cc.eq.0.d0)stop 'pb. in bigR'
rmax=dsqrt(-dlog(10.d-20)/cc)
npts=500
npts=500
dr=rmax/npts
sum=0.d0
do i=1,npts
@ -1633,7 +1633,7 @@ end
!c m=-l,l
!c
!c m>0: Y_lm = sqrt(2) ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2 P_l^|m|(cos(theta)) cos(m phi)
!c m=0: Y_l0 = ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2 P_l^0 (cos(theta))
!c m=0: Y_l0 = ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2 P_l^0 (cos(theta))
!c m<0: Y_lm = sqrt(2) ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2 P_l^|m|(cos(theta)) sin(|m|phi)
!Examples(wikipedia http://en.wikipedia.org/wiki/Table_of_spherical_harmonics#Real_spherical_harmonics)
@ -1650,11 +1650,11 @@ end
!
! l = 2
!
! Y_2,-2= 1/2 \sqrt{15/pi} xy/r^2
! Y_2,-1= 1/2 \sqrt{15/pi} yz/r^2
! Y_20 = 1/4 \sqrt{15/pi} (-x^2-y^2 +2z^2)/r^2
! Y_21 = 1/2 \sqrt{15/pi} zx/r^2
! Y_22 = 1/4 \sqrt{15/pi} (x^2-y^2)/r^2
! Y_2,-2= 1/2 \sqrt{15/pi} xy/r^2
! Y_2,-1= 1/2 \sqrt{15/pi} yz/r^2
! Y_20 = 1/4 \sqrt{15/pi} (-x^2-y^2 +2z^2)/r^2
! Y_21 = 1/2 \sqrt{15/pi} zx/r^2
! Y_22 = 1/4 \sqrt{15/pi} (x^2-y^2)/r^2
!
!c
double precision function ylm(l,m,theta,phi)
@ -1692,7 +1692,7 @@ else if (m < 0) then
endif
end
!c Explicit representation of Legendre polynomials P_n(x)
!c Explicit representation of Legendre polynomials P_n(x)
!!
!! P_n0(x) = P_n(x)= \sum_{k=0}^n a_k x^k
!!
@ -1714,14 +1714,14 @@ end
!! Ylm_bis uses the series expansion of Ylm in xchap^i ychap^j zchap^k
!! xchap=x/r etc.
!c m>0: Y_lm = sqrt(2)*factor* P_l^|m|(cos(theta)) cos(m phi)
!c m=0: Y_l0 = factor* P_l^0 (cos(theta))
!c m=0: Y_l0 = factor* P_l^0 (cos(theta))
!c m<0: Y_lm = sqrt(2) factor* P_l^|m|(cos(theta)) sin(|m|phi)
!c factor= ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2
!c factor= ([(2l+1)*(l-|m|)!]/[4pi*(l+|m|)!])^1/2
!! P_l^m (x) = (-1)**m (1-x**2)^m/2 d^m/dx^m P_l(x) m >0 or 0
!! the series expansion of P_m (x) is known
!!
!! sin(theta)**m cos(mphi) = \sum_0^[m/2] binom(m,2k) x^(m-2k) y^2k (-1)**k (easy to proove with
!! sin(theta)**m cos(mphi) = \sum_0^[m/2] binom(m,2k) x^(m-2k) y^2k (-1)**k (easy to proove with
!! Moivre formula)
!! (here x = xchap...)
!!
@ -1780,8 +1780,8 @@ end
!c
!c Computation of associated Legendre Polynomials PM(m,n) for n=0,...,N
!c Here:
!c n=l (n=0,1,...)
!c m=0,1,...,n
!c n=l (n=0,1,...)
!c m=0,1,...,n
!c x=cos(theta) 0 < x < 1
!c
!c This routine computes: PM(m,n) for n=0,...,N (number N in input) and m=0,..,n
@ -1826,7 +1826,7 @@ double precision function coef_nk(n,k)
gam=dble_fact(n+n+k+k+1)
! coef_nk=1.d0/(2.d0**k*fact(k)*gam)
coef_nk=1.d0/(dble(ibset(0_8,k))*fact(k)*gam)
return
end
@ -1835,7 +1835,7 @@ end
!!
!! I= \int dx x**l *exp(-gam*x**2) M_n(ax) M_m(bx)
!!
!! M_n(x) modified spherical bessel function
!! M_n(x) modified spherical bessel function
!!
double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
@ -1862,7 +1862,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
int_prod_bessel=0.d0
return
endif
int_prod_bessel=crochet(l,gam)*freal
return
endif
@ -1900,7 +1900,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
mk = dble(m)
! Loop over q for the convergence of the sequence
do while (.not.done)
do while (.not.done)
! Init
s_q_k=s_q_0
@ -1916,14 +1916,14 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
s_q_k = two_qkmp1*qk*inverses(k)*s_q_k
sum=sum+s_q_k
two_qkmp1 = two_qkmp1-2.d0
qk = qk-1.d0
qk = qk-1.d0
enddo
inverses(q) = a_over_b_square/(dble(q+n+q+n+3) * dble(q+1))
inverses(q) = a_over_b_square/(dble(q+n+q+n+3) * dble(q+1))
! do k=0,q
! sum=sum+s_q_k
! s_q_k = a_over_b_square * ( dble(2*(q-k+m)+1)*dble(q-k)/(dble(2*(k+n)+3) * dble(k+1)) ) * s_q_k
! enddo
int=int+sum
if(dabs(int-intold).lt.1d-15)then
@ -1933,7 +1933,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
!Compute the s_q+1_0
! s_q_0=s_q_0*(2.d0*q+nlm+1)*b**2/((2.d0*(m+q)+3)*4.d0*(q+1)*gam)
s_q_0=s_q_0*(q+q+nlm+1)*b*b/(dble(8*(m+q)+12)*(q+1)*gam)
if(mod(n+m+l,2).eq.1)s_q_0=s_q_0*dsqrt(pi*.5d0)
! Increment q
q=q+1
@ -1948,7 +1948,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
endif
if(a.eq.0.d0.and.b.ne.0.d0)then
int = int_prod_bessel_loc(l,gam,m,b)
int_prod_bessel=int*freal
return
@ -1975,26 +1975,26 @@ double precision function int_prod_bessel_large(l,gam,n,m,a,b,arg)
u=(a+b)/(2.d0*dsqrt(gam))
factor=dexp(u*u-arg)/dsqrt(gam)
xq(1)= 5.38748089001123
xq(2)= 4.60368244955074
xq(3)= 3.94476404011563
xq(4)= 3.34785456738322
xq(1)= 5.38748089001123
xq(2)= 4.60368244955074
xq(3)= 3.94476404011563
xq(4)= 3.34785456738322
xq(5)= 2.78880605842813
xq(6)= 2.25497400208928
xq(7)= 1.73853771211659
xq(8)= 1.23407621539532
xq(9)= 0.737473728545394
xq(10)= 0.245340708300901
xq(6)= 2.25497400208928
xq(7)= 1.73853771211659
xq(8)= 1.23407621539532
xq(9)= 0.737473728545394
xq(10)= 0.245340708300901
xq(11)=-0.245340708300901
xq(12)=-0.737473728545394
xq(13)=-1.23407621539532
xq(14)=-1.73853771211659
xq(15)=-2.25497400208928
xq(16)=-2.78880605842813
xq(17)=-3.34785456738322
xq(18)=-3.94476404011563
xq(19)=-4.60368244955074
xq(20)=-5.38748089001123
xq(12)=-0.737473728545394
xq(13)=-1.23407621539532
xq(14)=-1.73853771211659
xq(15)=-2.25497400208928
xq(16)=-2.78880605842813
xq(17)=-3.34785456738322
xq(18)=-3.94476404011563
xq(19)=-4.60368244955074
xq(20)=-5.38748089001123
wq(1)= 2.229393645534151E-013
wq(2)= 4.399340992273176E-010
wq(3)= 1.086069370769280E-007
@ -2031,7 +2031,7 @@ end
!!
!! I= \int dx x**l *exp(-gam*x**2) M_n(ax)
!!
!! M_n(x) modified spherical bessel function
!! M_n(x) modified spherical bessel function
!!
double precision function int_prod_bessel_loc(l,gam,n,a)
implicit none
@ -2040,12 +2040,12 @@ double precision function int_prod_bessel_loc(l,gam,n,a)
double precision int,intold,coef_nk,crochet,dble_fact, fact, pi, expo
double precision :: f_0, f_k
logical done
pi=dacos(-1.d0)
intold=-1.d0
done=.false.
int=0
! Int f_0
coef_nk=1.d0/dble_fact( n+n+1 )
expo=0.5d0*dfloat(n+l+1)
@ -2072,7 +2072,7 @@ double precision function int_prod_bessel_loc(l,gam,n,a)
endif
enddo
int_prod_bessel_loc=int
end

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