Added Weight

Conflicts:
	ocaml/Qmcchem_dataserver.ml

.gitignore

@@ -1,5 +1,3 @@
-.ninja_deps
-.ninja_log
 EZFIO
 install/Downloads
 install/_build
@@ -10,4 +8,4 @@ make.config
 src/ZMQ/f77_zmq.h
 ezfio_config/properties.config
 bin/
-
+*.mod

.gitmodules

@@ -0,0 +1,6 @@
+[submodule "EZFIO"]
+	path = EZFIO
+	url = https://gitlab.com/scemama/EZFIO.git
+[submodule "f77_zmq"]
+	path = f77_zmq
+	url = https://github.com/zeromq/f77_zmq.git

EZFIO

@@ -0,0 +1 @@
+Subproject commit d5805497fa0ef30e70e055cde1ecec2963303e93

Makefile

@@ -0,0 +1,77 @@
+# QMC=Chem
+
+FC = gfortran
+LIBS = 
+CPPFLAGS =  
+LDFLAGS= 
+
+ZMQ_LIBS = -lzmq
+ZMQ_LDFLAGS = 
+ZMQ_CPPFLAGS = 
+
+include make.config
+
+
+default_target: all
+
+.phony: clean always
+
+clean:
+	./scripts/clean.sh
+
+# put all files of PROPERTIES here
+# --------------------------------
+
+ezfio_config/properties.config ocaml/Property.ml: scripts/create_properties_python.py src/PROPERTIES/properties.irp.f src/PROPERTIES/properties_energy.irp.f src/PROPERTIES/properties_general.irp.f src/irpf90.make
+	bash -c "source qmcchemrc ; exec python2 ./scripts/create_properties_ezfio.py"
+
+# EZFIO 
+# -----
+
+build lib/libezfio.a lib/libezfio_irp.a EZFIO/lib/libezfio.a EZFIO/lib/libezfio_irp.a EZFIO/Ocaml/ezfio.ml EZFIO/Python/ezfio.py: ezfio_config/qmc.config ezfio_config/properties.config make.config scripts/create_properties_ezfio.py src/tags src/irpf90_entities src/irpf90.make src/irpf90.make
+	./scripts/compile_ezfio.sh
+
+
+# Fortran executables
+# -------------------      
+
+
+always: /dev/null
+
+src/tags src/irpf90_entities src/irpf90.make: make.config always
+	./scripts/compile_irpf90.sh
+
+src/MAIN/qmc src/MAIN/vmc_test src/MAIN/qmc_create_walkers src/MAIN/qmcchem_info: lib/libezfio.a lib/libezfio_irp.a src/tags src/irpf90_entities src/irpf90.make src/irpf90.make
+	./scripts/compile_src.sh
+
+# OCaml
+# -----
+
+ocaml/qmcchem: EZFIO/Ocaml/ezfio.ml $(wildcard ocaml/*.ml)
+	./scripts/compile_ocaml.sh
+
+# Archive
+# -------
+
+qmcchem.tar.gz: all
+	git archive --format tar.gz HEAD --prefix "QmcChem/" -7 -o qmcchem.tar.gz
+
+
+# Binaries
+# --------
+
+bin/qmc: src/MAIN/qmc
+	cp src/MAIN/qmc bin/
+
+bin/qmcchem_info: src/MAIN/qmcchem_info
+	cp src/MAIN/qmcchem_info bin/
+
+bin/qmc_create_walkers: src/MAIN/qmc_create_walkers
+	cp src/MAIN/qmc_create_walkers bin/
+
+bin/qmcchem: ocaml/qmcchem
+	cp ocaml/qmcchem bin/
+
+all: bin/qmc bin/qmcchem_info bin/qmc_create_walkers bin/qmcchem 
+
+

Makefile.am

@@ -0,0 +1,76 @@
+# QMC=Chem
+
+FC = @FC@
+LIBS = @LIBS@
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS= @LDFLAGS@
+
+ZMQ_LIBS = @ZMQ_LIBS@
+ZMQ_LDFLAGS = @ZMQ_LDFLAGS@
+ZMQ_CPPFLAGS = @ZMQ_CPPFLAGS@
+
+
+
+default_target: all
+
+.phony: clean always
+
+clean:
+	./scripts/clean.sh
+
+# put all files of PROPERTIES here
+# --------------------------------
+
+ezfio_config/properties.config ocaml/Property.ml: scripts/create_properties_python.py src/PROPERTIES/properties.irp.f src/PROPERTIES/properties_energy.irp.f src/PROPERTIES/properties_general.irp.f src/irpf90.make
+	bash -c "source qmcchemrc ; exec python2 ./scripts/create_properties_ezfio.py"
+
+# EZFIO 
+# -----
+
+build lib/libezfio.a lib/libezfio_irp.a EZFIO/lib/libezfio.a EZFIO/lib/libezfio_irp.a EZFIO/Ocaml/ezfio.ml EZFIO/Python/ezfio.py: ezfio_config/qmc.config ezfio_config/properties.config make.config scripts/create_properties_ezfio.py src/tags src/irpf90_entities src/irpf90.make src/irpf90.make
+	./scripts/compile_ezfio.sh
+
+
+# Fortran executables
+# -------------------      
+
+
+always: /dev/null
+
+src/tags src/irpf90_entities src/irpf90.make: make.config always
+	./scripts/compile_irpf90.sh
+
+src/MAIN/qmc src/MAIN/vmc_test src/MAIN/qmc_create_walkers src/MAIN/qmcchem_info: lib/libezfio.a lib/libezfio_irp.a src/tags src/irpf90_entities src/irpf90.make src/irpf90.make
+	./scripts/compile_src.sh
+
+# OCaml
+# -----
+
+ocaml/qmcchem: EZFIO/Ocaml/ezfio.ml $(wildcard ocaml/*.ml)
+	./scripts/compile_ocaml.sh
+
+# Archive
+# -------
+
+qmcchem.tar.gz: all
+	git archive --format tar.gz HEAD --prefix "QmcChem/" -7 -o qmcchem.tar.gz
+
+
+# Binaries
+# --------
+
+bin/qmc: src/MAIN/qmc
+	cp src/MAIN/qmc bin/
+
+bin/qmcchem_info: src/MAIN/qmcchem_info
+	cp src/MAIN/qmcchem_info bin/
+
+bin/qmc_create_walkers: src/MAIN/qmc_create_walkers
+	cp src/MAIN/qmc_create_walkers bin/
+
+bin/qmcchem: ocaml/qmcchem
+	cp ocaml/qmcchem bin/
+
+all: bin/qmc bin/qmcchem_info bin/qmc_create_walkers bin/qmcchem 
+
+

README.md

@@ -1,8 +1,6 @@
 QMC=Chem : Quantum Monte Carlo for Chemistry
 ============================================
 
-**This repository is under migration to GitHub. This version may not be fully working. Please be patient...**
-
 QMC=Chem is the quantum Monte Carlo program of the
 [Toulouse (France) group](http://qmcchem.ups-tlse.fr).
 It is meant to be used in the *post-Full-CI* context : a quasi-Full-CI
@@ -30,74 +28,70 @@ Warnings:
 * QMC=Chem is under the GPLv2 license. Any modifications to or
   software including (via compiler) GPL-licensed code must also be made available
   under the GPL along with build & install instructions.
-* Pseudopotentials are about to change in the EZFIO database. Current calculations
-  will not be compatible with future versions
 
 
 Requirements
 ------------
 
-* [Ninja build tool](http://github.com/martine/ninja)
 * [OCaml compiler with Opam and Core library](http://github.com/ocaml)
 * [ZeroMQ high performance communication library](http://www.zeromq.org)
 * [F77_ZMQ ZeroMQ Fortran interface](http://github.com/scemama/f77_zmq/)
 * [IRPF90 Fortran code generator](http://irpf90.ups-tlse.fr)
 * [EZFIO Easy Fortran I/O library generator](http://github.com/scemama/EZFIO)
-* GNU C++ Compiler (g++) for ZeroMQ and Ninja
+* GNU C++ Compiler (g++) for ZeroMQ 
 * Python >= 2.6 for install scripts
 * Bash for install scripts
 * Fortran compiler, Intel Fortran recommended
 * Lapack library, Intel MKL recommended
 
 
-Most of the dependencies are open-source will be downloaded automatically.
+Most of the dependencies are open-source can be downloaded automatically by
+going into the `install` directory and running `make`. It will first download
+into the `install/Downloads` directory everything that needs to be installed.
+The building of the dependencies takes place in the `install/_build`
+directory, and the packages that are being installed can be followed by looking
+at the log files in this directory. When a package was successfully installed,
+a `*.ok` file is created and the log file is deleted.
+
+If you don't have an internet connection available, you can execute the
+downloading step on another computer and transfer all the downloaded files
+into the `Downloads` directory.
 The Fortran and C++ compilers, Python and Bash interpreters and the Lapack
 library need to be installed manually by the user.
 
 Installation
 ------------
 
-The ``make.config`` file contains compiler specific parameters. You should change
-them to match your hardware.
-
-The ``configure.sh`` script will first download the
-[Ninja](http://github.com/martine/ninja) build tool, and will then run Ninja
-using the ``install/build.ninja`` file.  The configuration script will work in
-the ``install`` directory.  It will first download into the
-``install/Downloads`` directory everything that needs to be installed.
-The building of the dependencies takes place in the ``install/_build``
-directory, and the packages that are being installed can be followed by looking
-at the log files in this directory. When a package was successfully installed,
-a ``*.ok`` file is created and the log file is deleted.
-
-If you don't have an internet connection available, you can execute the
-downloading step on another computer and transfer all the downloaded files
-into the ``Downloads`` directory.
-
+The `make.config` file contains compiler specific parameters. You should change
+them to match your hardware. You can copy the `make.config.ifort` or
+`make.config.gfortran` as a starting point.
 
 Before using or compiling QMC=Chem, environment variables need to be loaded. The
-environment variables are located in the ``qmcchemrc`` file:
+environment variables are located in the `qmcchemrc` file:
 
 ```bash
 $ source qmcchemrc
 ```
 
+The `QMCCHEM_NIC` environment variable should be set to the proper network interface,
+usually `ib0` on HPC machines.
+
 To compile the program, run
 
 ```bash
-$ ninja
+$ make
 ```
 
 
 Example of a QMC=Chem calculation
 ---------------------------------
 
-Calculation with the [quantum package](http://github.com/LCPQ/quantum_package)
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1.Calculation with the [quantum package](http://github.com/QuantumPackage/qp2)
 
-1) Create the ``xyz`` file containing the nuclear coordinates of the system
 
-```
+Create the `xyz` file containing the nuclear coordinates of the system
+
+```bash
 $ cat > h2o.xyz << EOF
 3
 Water molecule
@@ -107,36 +101,37 @@ H -0.239987 0.926627 0.
 EOF
 ```
 
-2) Choose a suitable basis set and create the [EZFIO database](https://github.com/LCPQ/ezfio)
+Choose a suitable basis set and create the [EZFIO database](https://github.com/LCPQ/ezfio)
 
 ```bash
-$ qp_create_ezfio_from_xyz -b cc-pvdz h2o.xyz -o h2o
+$ qp_create_ezfio -b cc-pvdz h2o.xyz -o h2o
 ```
 
-3) Run the SCF calculation
+Run the SCF calculation
 
 ```bash
-$ qp_run SCF h2o
+$ qp_run scf h2o
 ```
-4) Run the CIPSI calculation
+Run the CIPSI calculation
 
 ```bash
-$ qp_run full_ci h2o
+$ qp_run fci h2o
 ```
 
-5) Transform the input for use in QMC=Chem
+Transform the input for use in QMC=Chem
 
 ```bash
 $ qp_run save_for_qmcchem h2o
 ```
 
-FN-DMC calculation with QMC=Chem
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+2.FN-DMC calculation with QMC=Chem
+
 
 Before using QMC=Chem, you need to load the environment variables:
 
 ```bash
-$ source qmcchem.rc
+$ source qmcchemrc
 ```
 
 In QMC=Chem, everything goes through the use of the ``qmcchem`` command.

bin/jast_opt.py

@@ -0,0 +1,227 @@
+#!/usr/bin/env python3
+
+import scipy as sp
+import scipy.optimize
+import numpy as np
+import sys
+import os
+import time
+import subprocess
+from math import sqrt
+
+
+
+QMCCHEM_PATH=os.environ["QMCCHEM_PATH"]
+
+sys.path.insert(0,QMCCHEM_PATH+"/EZFIO/Python/")
+
+from ezfio import ezfio
+
+# PARAMETERS
+thresh = 1.e-2
+block_time = 6
+
+def main():
+    if len(sys.argv) != 2:
+      print("Usage: %s <EZFIO_DIRECTORY>"%sys.argv[0])
+      sys.exit(1)
+
+    filename = sys.argv[1]
+    ezfio.set_file(filename)
+
+    jast_type = ezfio.jastrow_jast_type
+    print (jast_type)
+
+    def make_atom_map():
+        labels = {}
+        dimension = 0
+        for i,k in enumerate(ezfio.nuclei_nucl_label):
+            if k in labels:
+                labels[k].append(i)
+            else:
+                labels[k] = [dimension, i]
+                dimension += 1
+        atom_map = [[] for i in range(dimension)]
+        for atom in labels.keys():
+            l = labels[atom]
+            atom_map[l[0]] = l[1:]
+        return atom_map
+    atom_map = make_atom_map()
+
+
+    if jast_type == 'Simple':
+
+      def get_params_b():
+          return ezfio.jastrow_jast_b_up_dn
+
+      def set_params_b(x):
+          x = np.abs(x)
+          ezfio.set_jastrow_jast_b_up_up(x)
+          ezfio.set_jastrow_jast_b_up_dn(x)
+
+    elif jast_type == 'Mu':
+
+      def get_params_b():
+          return ezfio.jastrow_mu_erf
+
+      def set_params_b(x):
+          x = np.abs(x)
+          ezfio.set_jastrow_mu_erf(x)
+
+    if jast_type == 'Simple':
+
+      def get_params_pen():
+          d = ezfio.jastrow_jast_pen
+          return np.array([d[m[0]] for m in atom_map])
+
+      def set_params_pen(x):
+          x = np.abs(x)
+          y=list(ezfio.jastrow_jast_pen)
+          for i,m in enumerate(atom_map):
+              for j in m:
+                  y[j] = x[i]
+          ezfio.set_jastrow_jast_pen(y)
+
+    elif jast_type == 'Mu':
+
+      def get_params_pen():
+          d = ezfio.jastrow_jast_1bgauss_pen
+          return np.array([d[m[0]] for m in atom_map])
+
+      def set_params_pen(x):
+          x = np.abs(x)
+          y=list(ezfio.jastrow_jast_1bgauss_pen)
+          for i,m in enumerate(atom_map):
+              for j in m:
+                  y[j] = x[i]
+          ezfio.set_jastrow_jast_1bgauss_pen(y)
+
+    def get_norm():
+        return 1.,0.
+#        buffer = subprocess.check_output(['qmcchem', 'result', '-e', 'psi_norm', filename],
+#                                         encoding='UTF-8')
+#        if buffer.strip() != "":
+#            buffer = buffer.splitlines()[-1]
+#            _, energy, error = [float(x) for x in buffer.split()]
+#        else:
+#            return None, None
+
+    def get_energy():
+        buffer = subprocess.check_output(['qmcchem', 'result', '-e', 'e_loc', filename],
+                                         encoding='UTF-8')
+        if buffer.strip() != "":
+            buffer = buffer.splitlines()[-1]
+            _, energy, error = [float(x) for x in buffer.split()]
+            return energy, error
+        else:
+            return None, None
+
+    def get_variance():
+        buffer = subprocess.check_output(['qmcchem', 'result', '-e',
+                                          'e_loc_qmcvar', filename],
+                                         encoding='UTF-8')
+        if buffer.strip() != "":
+            buffer = buffer.splitlines()[-1]
+            _, variance, error = [float(x) for x in buffer.split()]
+            return variance, error
+        else:
+            return None, None
+
+
+
+    def run_qmc():
+        return subprocess.check_output(['qmcchem', 'run', filename])
+
+
+    def stop_qmc():
+        subprocess.check_output(['qmcchem', 'stop', filename])
+
+
+    def set_vmc_params():
+#        subprocess.check_output(['qmcchem', 'edit', '-c', '-j', jast_type,
+#                                 '-m', 'VMC',
+#                                 '-l', str(block_time),
+#                                 '--time-step=0.3',
+#                                 '--stop-time=36000',
+#                                 '--norm=1.e-5',
+#                                 '-w', '10',
+#                                 filename])
+        subprocess.check_output(['qmcchem', 'edit', '-c', '-j', jast_type,
+                                 '-l', str(block_time),
+                                 filename])
+
+
+    memo_energy = {'fmin': 100000000.}
+    def f(x):
+        print ("x = %s"%str(x))
+        sys.stdout.flush()
+        h = str(x)
+        if h in memo_energy:
+            return memo_energy[h]
+        set_params_b(x[0])
+        set_params_pen(x[1:])
+        set_vmc_params()
+        pid = os.fork()
+        if pid == 0:
+            run_qmc()
+            os._exit(os.EX_OK)
+        else:
+            import atexit
+            atexit.register(stop_qmc)
+
+            err = thresh+1.
+            time.sleep(3.*block_time/4.)
+            local_thresh = thresh
+            while err > local_thresh:
+                time.sleep(block_time)
+                e, e_err = get_energy()
+                variance, v_err = get_variance() 
+                if e is None or variance is None:
+                    continue
+#                norm, _ = get_norm() 
+#                e, e_err = e, e_err/norm
+#                variance, v_err =variance/norm, v_err/norm
+                energy = e #+ variance
+                err = e_err #sqrt(e_err*e_err+v_err*v_err)
+                print(" %f  %f    %f  %f  %f  %f"%(e, e_err, variance, v_err, energy, err))
+                sys.stdout.flush()
+                if (energy-2.*err) > memo_energy['fmin']+thresh:
+                   local_thresh = 10.*thresh
+                elif (energy+2.*err) < memo_energy['fmin']-thresh:
+                   local_thresh = 10.*thresh
+
+                # Check if PID is still running
+                try:
+                    os.kill(pid,0)
+                except OSError:
+                    print("---")
+                    sys.stdout.flush()
+                    break
+            stop_qmc()
+        os.wait()
+        memo_energy[h] = energy + err
+        memo_energy['fmin'] = min(energy, memo_energy['fmin'])
+        return energy
+
+
+    def run():
+        x = np.array([ get_params_b() ] + list(get_params_pen()))
+        if sum(x) == 0.:
+          jast_a_up_dn = ezfio.jastrow_jast_a_up_dn
+          x += jast_a_up_dn
+#        opt = sp.optimize.minimize(f,x,method="Powell",
+#                             options= {'disp':True, 'ftol':thresh,'xtol':0.02})
+        opt = sp.optimize.minimize(f,x,method="Nelder-Mead",
+                             options= {'disp':True, 'ftol':thresh,'xtol':0.02})
+        print("x = "+str(opt))
+        sys.stdout.flush()
+        set_params_b(opt['x'][0])
+        set_params_pen(opt['x'][1:])
+
+    run()
+
+if __name__ == '__main__':
+    main()
+
+
+

bin/mu_opt.py

@@ -0,0 +1,201 @@
+#!/usr/bin/env python3
+
+import scipy as sp
+import scipy.optimize
+import numpy as np
+import sys
+import os
+import time
+import subprocess
+from math import sqrt
+
+
+
+QMCCHEM_PATH=os.environ["QMCCHEM_PATH"]
+
+sys.path.insert(0,QMCCHEM_PATH+"/EZFIO/Python/")
+
+from ezfio import ezfio
+
+# PARAMETERS
+thresh = 1.e-2
+block_time = 6
+
+def main():
+    if len(sys.argv) != 2:
+      print("Usage: %s <EZFIO_DIRECTORY>"%sys.argv[0])
+      sys.exit(1)
+
+    filename = sys.argv[1]
+    ezfio.set_file(filename)
+
+    jast_type = ezfio.jastrow_jast_type
+    print (jast_type)
+
+    def make_atom_map():
+        labels = {}
+        dimension = 0
+        for i,k in enumerate(ezfio.nuclei_nucl_label):
+            if k in labels:
+                labels[k].append(i)
+            else:
+                labels[k] = [dimension, i]
+                dimension += 1
+        atom_map = [[] for i in range(dimension)]
+        for atom in labels.keys():
+            l = labels[atom]
+            atom_map[l[0]] = l[1:]
+        return atom_map
+    atom_map = make_atom_map()
+
+
+
+    def get_params_b():
+        return ezfio.jastrow_mu_erf
+
+    def set_params_b(x):
+        x = np.abs(x)
+        ezfio.set_jastrow_mu_erf(x)
+
+    def get_params_pen():
+        d = ezfio.jastrow_jast_1bgauss_pen
+        return np.array([d[m[0]] for m in atom_map])
+
+    def set_params_pen(x):
+        x = np.abs(x)
+        y=list(ezfio.jastrow_jast_1bgauss_pen)
+        for i,m in enumerate(atom_map):
+            for j in m:
+                y[j] = x[i]
+        ezfio.set_jastrow_jast_1bgauss_pen(y)
+
+    def get_norm():
+        return 1.0, 0.0
+        buffer = subprocess.check_output(['qmcchem', 'result', '-e', 'psi_norm', filename],
+                                         encoding='UTF-8')
+        if buffer.strip() != "":
+            buffer = buffer.splitlines()[-1]
+            _, energy, error = [float(x) for x in buffer.split()]
+            return energy, error
+        else:
+            return None, None
+
+    def get_energy():
+        buffer = subprocess.check_output(['qmcchem', 'result', '-e', 'Ci_dress_mu_opt_qmcvar', filename],
+                                         encoding='UTF-8')
+        if buffer.strip() != "":
+            buffer = buffer.splitlines()[-1]
+            _, energy, error = [float(x) for x in buffer.split()]
+            return energy, error
+        else:
+            return None, None
+
+    def get_variance():
+        buffer = subprocess.check_output(['qmcchem', 'result', '-e',
+                                          'Ci_dress_mu_opt_qmcvar', filename],
+                                         encoding='UTF-8')
+        if buffer.strip() != "":
+            buffer = buffer.splitlines()[-1]
+            _, variance, error = [float(x) for x in buffer.split()]
+            return variance, error
+        else:
+            return None, None
+
+
+
+    def run_qmc():
+        return subprocess.check_output(['qmcchem', 'run', filename])
+
+
+    def stop_qmc():
+        subprocess.check_output(['qmcchem', 'stop', filename])
+
+
+    def set_vmc_params():
+#        subprocess.check_output(['qmcchem', 'edit', '-c', '-j', jast_type,
+#                                 '-m', 'VMC',
+#                                 '-l', str(block_time),
+#                                 '--time-step=0.3',
+#                                 '--stop-time=36000',
+#                                 '--norm=1.e-5',
+#                                 '-w', '10',
+#                                 filename])
+        subprocess.check_output(['qmcchem', 'edit', '-c', '-j', jast_type,
+                                 '-l', str(block_time),
+                                 filename])
+
+
+    memo_energy = {'fmin': 100000000.}
+    def f(x):
+        print ("x = %s"%str(x))
+        sys.stdout.flush()
+        h = str(x)
+        if h in memo_energy:
+            return memo_energy[h]
+        set_params_b(x[0])
+        set_params_pen(x[1:])
+        set_vmc_params()
+        pid = os.fork()
+        if pid == 0:
+            run_qmc()
+            os._exit(os.EX_OK)
+        else:
+            import atexit
+            atexit.register(stop_qmc)
+
+            err = thresh+1.
+            time.sleep(3.*block_time/4.)
+            local_thresh = thresh
+            while err > local_thresh:
+                time.sleep(block_time)
+                e, e_err = get_energy()
+                variance, v_err = get_variance() 
+                if e is None or variance is None:
+                    continue
+                norm, _ = get_norm() 
+                e, e_err = e/norm, e_err/norm
+                variance, v_err =variance/norm, v_err/norm
+                energy = e #+ variance
+                err = e_err #sqrt(e_err*e_err+v_err*v_err)
+                print(" %f  %f    %f   %f"%(e, err, local_thresh, memo_energy['fmin']))
+                sys.stdout.flush()
+                if (energy-2.*err) > memo_energy['fmin']+local_thresh:
+                   local_thresh = 10.*local_thresh
+                elif (energy+2.*err) < memo_energy['fmin']-local_thresh:
+                   local_thresh = 10.*local_thresh
+
+                # Check if PID is still running
+                try:
+                    os.kill(pid,0)
+                except OSError:
+                    print("---")
+                    sys.stdout.flush()
+                    break
+            stop_qmc()
+        os.wait()
+        memo_energy[h] = energy + err
+        memo_energy['fmin'] = min(energy, memo_energy['fmin'])
+        return energy
+
+
+    def run():
+        x = np.array([ get_params_b() ] + list(get_params_pen()))
+        if sum(x) == 0.:
+          jast_a_up_dn = ezfio.jastrow_jast_a_up_dn
+          x += jast_a_up_dn
+        opt = sp.optimize.minimize(f,x,method="Powell",
+                             options= {'disp':True, 'ftol':thresh,'xtol':0.02})
+#        opt = sp.optimize.minimize(f,x,method="Nelder-Mead",
+#                             options= {'disp':True, 'ftol':thresh,'xtol':0.02})
+        print("x = "+str(opt))
+        sys.stdout.flush()
+        set_params_b(opt['x'][0])
+        set_params_pen(opt['x'][1:])
+
+    run()
+
+if __name__ == '__main__':
+    main()
+
+
+

build.ninja

@@ -1,88 +0,0 @@
-rule compile_ezfio
-  command = ./scripts/compile_ezfio.sh
-  description = Compiling the EZFIO library
-  pool = console
-
-rule build_properties_config
-  command = bash -c "source qmcchemrc ; exec python ./scripts/create_properties_ezfio.py"
-  pool = console
-
-rule compile_irpf90
-  command = ./scripts/compile_irpf90.sh
-  description = Compiling IRPF90
-  pool = console
-
-rule compile_src
-  command = ./scripts/compile_src.sh
-  description = Compiling src
-  pool = console
-
-rule create_archive
-  command = git archive --format tar.gz HEAD --prefix "QmcChem/" -7 -o qmcchem.tar.gz
-  description = Creating archive
-  pool = console
-
-rule compile_ocaml_dep
-  command = scripts/compile_ocaml_dep.sh
-  description = Finding dependencies in OCaml files
-  pool = console
-
-rule compile_ocaml
-  command = cd ocaml ; ninja $target
-  description = Compiling OCaml tools
-  pool = console
-
-rule copy_to_bin
-  command = bash -c "cp $in $out ; touch $out"
-  description = Copying $in into bin/
-  pool = console
-
-rule clean
-  command = ./scripts/clean.sh
-  pool = console
-
-# put all files of PROPERTIES here
-# --------------------------------
-
-build ezfio_config/properties.config ocaml/Property.ml: build_properties_config | scripts/create_properties_python.py src/PROPERTIES/properties.irp.f src/PROPERTIES/properties_energy.irp.f src/PROPERTIES/properties_general.irp.f || src/IRPF90_temp/build.ninja
-
-# EZFIO 
-# -----
-
-build lib/libezfio.a lib/libezfio_irp.a EZFIO/lib/libezfio.a EZFIO/lib/libezfio_irp.a EZFIO/Ocaml/ezfio.ml EZFIO/Python/ezfio.py: compile_ezfio | ezfio_config/qmc.config ezfio_config/properties.config make.config scripts/create_properties_ezfio.py || src/tags src/irpf90_entities src/irpf90.make src/IRPF90_temp/build.ninja
-
-# Fortran executables
-# -------------------
-
-build always: phony
-
-build src/tags src/irpf90_entities src/irpf90.make src/IRPF90_temp/build.ninja: compile_irpf90 | make.config always
-
-build src/MAIN/qmc src/MAIN/qmc_create_walkers src/MAIN/qmcchem_info: compile_src | lib/libezfio.a lib/libezfio_irp.a src/tags || src/irpf90_entities src/irpf90.make src/IRPF90_temp/build.ninja
-
-# Archive
-# -------
-
-build qmcchem.tar.gz: create_archive
-
-# Ocaml
-# -----
-
-build ocaml/qmcchem : compile_ocaml | EZFIO/Ocaml/ezfio.ml ocaml/Property.ml 
-
-
-# Copy binaries in bin
-# --------------------
-
-build bin/qmc: copy_to_bin src/MAIN/qmc
-build bin/qmcchem_info: copy_to_bin src/MAIN/qmcchem_info
-build bin/qmc_create_walkers: copy_to_bin src/MAIN/qmc_create_walkers
-build bin/qmcchem: copy_to_bin ocaml/qmcchem 
-
-default bin/qmc bin/qmcchem_info bin/qmc_create_walkers bin/qmcchem 
-
-# Clean
-# -----
-
-build clean: clean
-

configure.ac

@@ -0,0 +1,57 @@
+#                                               -*- Autoconf -*-
+# Process this file with autoconf to produce a configure script.
+
+AC_PREREQ([2.69])
+
+AC_INIT([QMC=Chem], [2.0.0], [https://gitlab.com/scemama/qmcchem/-/issues/new])
+AM_INIT_AUTOMAKE([foreign subdir-objects silent-rules])
+
+AC_CONFIG_SRCDIR([README.md])
+AC_CONFIG_MACRO_DIR([m4])
+AC_CONFIG_HEADERS([include/config.h])
+
+# Checks for programs.
+AC_PROG_AWK
+AC_PROG_CC
+AC_PROG_INSTALL
+AC_PROG_LN_S
+AC_PROG_MAKE_SET
+AX_PROG_IRPF90
+
+# Fortran compiler checks
+AC_PROG_FC([ifort gfortran])
+AC_FC_LINE_LENGTH([512])
+
+
+# Checks for libraries.
+AX_ZMQ([4.0], [], [ AC_MSG_ERROR([Please install ZeroMQ >= 4.0]) ])
+AX_BLAS()
+AX_LAPACK()
+
+# Required by EZFIO
+AC_CHECK_FUNCS([mkdir strerror])
+AC_TYPE_SIZE_T
+
+# Required by OCaml C bindings
+AC_CHECK_FUNCS([inet_ntoa])
+AC_CHECK_FUNCS([memset])
+AC_CHECK_FUNCS([socket])
+AC_CHECK_HEADERS([arpa/inet.h netinet/in.h sys/ioctl.h sys/socket.h])
+
+# Required by ZeroMQ
+AC_CHECK_HEADERS([stddef.h])
+AC_TYPE_INT32_T
+AC_TYPE_UINT16_T
+AC_TYPE_UINT32_T
+AC_TYPE_UINT8_T
+
+# Required by QMCkl
+#AC_CHECK_HEADER_STDBOOL
+#AC_TYPE_INT64_T
+#AC_TYPE_UINT64_T
+
+
+AC_LANG([Fortran])
+
+AC_CONFIG_FILES([Makefile])
+AC_OUTPUT

configure.sh

@@ -6,23 +6,10 @@ QMCCHEM_PATH=$PWD
 mkdir -p "${QMCCHEM_PATH}"/bin
 cd "${QMCCHEM_PATH}"/install
 mkdir -p Downloads _build
-# TODO : Check if network is up (ping)
-if [[ ! -x "${QMCCHEM_PATH}"/bin/ninja ]]
-then
-  echo "Installing Ninja"
-  ./scripts/install_ninja.sh &> _build/ninja.log 
-  if [[ ! -x "${QMCCHEM_PATH}"/bin/ninja ]]
-  then
-    echo "Installation of Ninja failed"
-    exit 1
-  fi
-  touch _build/ninja.ok
-fi
-touch "${QMCCHEM_PATH}"/{src,ocaml}/.ls_md5
-"${QMCCHEM_PATH}"/bin/ninja "$@"
 
 cd "${QMCCHEM_PATH}"
 
+set +e
 if [[ ! -f make.config ]]
 then
   which ifort > /dev/null
@@ -39,7 +26,26 @@ echo "Configuration OK."
 echo "Now, source the qmcchemrc file and build the program:"
 echo ""
 echo "source qmcchemrc"
-echo "ninja"
+echo "make"
 echo ""
 echo "====================================================================="
 
+if [[ -f qmcchemrc ]] ; then
+  cp qmcchemrc qmcchemrc.bak
+fi
+cat << EOF > qmcchemrc                                                                        
+# QMC=Chem environment variables
+export QMCCHEM_PATH=${QMCCHEM_PATH}
+export PATH="\${QMCCHEM_PATH}/bin:\${PATH}"
+export LD_LIBRARY_PATH="\${QMCCHEM_PATH}/lib:\${LD_LIBRARY_PATH}"
+export LIBRARY_PATH="\${QMCCHEM_PATH}/lib:\${LIBRARY_PATH}"
+export QMCCHEM_MPIRUN="mpirun"
+export QMCCHEM_MPIRUN_FLAGS=""
+#export QMCCHEM_IO="B"
+export C_INCLUDE_PATH="\${QMCCHEM_PATH}/include:\${C_INCLUDE_PATH}"
+#export QMCCHEM_NIC=ib0
+source \${QMCCHEM_PATH}/irpf90/bin/irpman
+#source \${QMCCHEM_PATH}/EZFIO/Bash/ezfio.sh
+eval \$(opam env)
+EOF
+

ezfio_config/qmc.config

@@ -8,15 +8,12 @@ ao_basis
   ao_expo            real          (ao_basis_ao_num,ao_basis_ao_prim_num_max)
 
 mo_basis
-  mo_tot_num         integer
-  mo_coef            real              (ao_basis_ao_num,mo_basis_mo_tot_num)
-  mo_classif         character         (mo_basis_mo_tot_num)
-  mo_closed_num      integer           =n_count_ch(mo_basis_mo_classif,size(mo_basis_mo_classif),'c')
-  mo_active_num      integer           =n_count_ch(mo_basis_mo_classif,size(mo_basis_mo_classif),'a')
-  mo_virtual_num     integer           =n_count_ch(mo_basis_mo_classif,size(mo_basis_mo_classif),'v')
-  mo_energy          real              (mo_basis_mo_tot_num)
-  mo_occ             real              (mo_basis_mo_tot_num)
-  mo_symmetry        character*(8)     (mo_basis_mo_tot_num)
+  mo_num             integer
+  mo_coef            real              (ao_basis_ao_num,mo_basis_mo_num)
+  mo_classif         character         (mo_basis_mo_num)
+  mo_energy          real              (mo_basis_mo_num)
+  mo_occ             real              (mo_basis_mo_num)
+  mo_symmetry        character*(8)     (mo_basis_mo_num)
 
 electrons
   elec_alpha_num      integer
@@ -26,14 +23,13 @@ electrons
   elec_walk_num       integer
   elec_coord_pool     real             (electrons_elec_num+1,3,electrons_elec_coord_pool_size)
   elec_coord_pool_size integer
-  elec_fitcusp_radius real        
+  elec_fitcusp_radius real
 
 nuclei
   nucl_num            integer
   nucl_label          character*(32) (nuclei_nucl_num)
   nucl_charge         real           (nuclei_nucl_num)
   nucl_coord          real           (nuclei_nucl_num,3)
-  nucl_fitcusp_radius real           (nuclei_nucl_num)
 
 spindeterminants
   n_det_alpha     integer
@@ -47,7 +43,20 @@ spindeterminants
   psi_coef_matrix_rows    integer (spindeterminants_n_det)
   psi_coef_matrix_columns integer (spindeterminants_n_det)
   psi_coef_matrix_values  double precision (spindeterminants_n_det,spindeterminants_n_states)
-
+  n_svd_coefs_unique         integer
+  n_svd_coefs                integer
+  n_svd_selected             integer
+  n_svd_toselect             integer
+  psi_svd_alpha_unique       double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs_unique,spindeterminants_n_states)
+  psi_svd_beta_unique        double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs_unique,spindeterminants_n_states)
+  psi_svd_coefs_unique       double precision (spindeterminants_n_svd_coefs_unique,spindeterminants_n_states)
+  psi_svd_alpha              double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states)
+  psi_svd_beta               double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states)
+  psi_svd_coefs              double precision (spindeterminants_n_svd_coefs,spindeterminants_n_states)
+  psi_svd_alpha_numselected  integer          (spindeterminants_n_svd_selected,spindeterminants_n_states)
+  psi_svd_beta_numselected   integer          (spindeterminants_n_svd_selected,spindeterminants_n_states)
+  psi_svd_alpha_numtoselect  integer          (spindeterminants_n_svd_toselect,spindeterminants_n_states)
+  psi_svd_beta_numtoselect   integer          (spindeterminants_n_svd_toselect,spindeterminants_n_states)
 
 simulation
   do_run              integer
@@ -55,7 +64,7 @@ simulation
   equilibration       logical
   http_server         character*(128)
   do_jast             logical
-  do_nucl_fitcusp     logical
+  nucl_fitcusp_factor real
   method              character*(32)
   block_time          integer
   sampling            character*(32)
@@ -65,7 +74,8 @@ simulation
   ci_threshold        double precision
   md5_key             character*(32)
   E_ref               double precision
-  dmc_projection_time real
+  E_trial             double precision
+  srmc_projection_time real
 
 jastrow
   jast_type           character*(32)
@@ -73,6 +83,7 @@ jastrow
   jast_a_up_dn        real
   jast_b_up_up        real
   jast_b_up_dn        real
+  mu_erf              real
   jast_pen            real                (nuclei_nucl_num)
   jast_eeN_e_a        real                (nuclei_nucl_num)
   jast_eeN_e_b        real                (nuclei_nucl_num)
@@ -81,9 +92,13 @@ jastrow
   jast_core_a2        real                (nuclei_nucl_num)
   jast_core_b1        real                (nuclei_nucl_num)
   jast_core_b2        real                (nuclei_nucl_num)
+  jast_1b_type        integer
+  jast_1btanh_pen     real                (nuclei_nucl_num)
+  jast_1berf_pen      real                (nuclei_nucl_num)
+  jast_1bgauss_pen    real                (nuclei_nucl_num)
 
 blocks
-  empty   integer 
+  empty   integer
 
 pseudo
   ao_pseudo_grid   double precision   (ao_basis_ao_num,pseudo_pseudo_lmax+pseudo_pseudo_lmax+1,pseudo_pseudo_lmax-0+1,nuclei_nucl_num,pseudo_pseudo_grid_size)

f77_zmq

@@ -0,0 +1 @@
+Subproject commit 934e063881553e42d81c5d1aaed35822988529f0

install/Makefile

@@ -0,0 +1,71 @@
+default_target: all
+
+Downloads/irpf90.tar.gz: 
+	wget --no-check-certificate \
+	"https://gitlab.com/scemama/irpf90/-/archive/v2.0.5/irpf90-v2.0.5.tar.gz" \
+	-O $@.tmp -o /dev/null && mv $@.tmp $@
+
+Downloads/ezfio.tar.gz:
+	wget --no-check-certificate \
+	"https://gitlab.com/scemama/EZFIO/-/archive/master/EZFIO-master.tar.gz" \
+	-O $@.tmp -o /dev/null && mv $@.tmp $@
+
+Downloads/zmq.tar.gz:
+	wget --no-check-certificate \
+	"http://github.com/zeromq/libzmq/releases/download/v4.2.5/zeromq-4.2.5.tar.gz" \
+	-O $@.tmp -o /dev/null && mv $@.tmp $@
+
+Downloads/f77_zmq.tar.gz:
+	wget --no-check-certificate \
+	"https://github.com/scemama/f77_zmq/archive/v4.2.5.tar.gz" \
+	-O $@.tmp -o /dev/null && mv $@.tmp $@
+
+Downloads/opam_installer.sh:
+	wget --no-check-certificate \
+	"https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh" \
+	-O $@.tmp -o /dev/null && mv $@.tmp $@
+
+_build/irpf90.ok ../bin/irpman ../bin/irpf90: Downloads/irpf90.tar.gz
+	export target=irpf90 ; \
+	./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	touch _build/$${target}.ok || cat _build/$${target}.log
+
+
+_build/zmq.ok: Downloads/zmq.tar.gz
+	export target=zmq ; \
+	./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	touch _build/$${target}.ok || cat _build/$${target}.log
+
+_build/ezfio.ok: Downloads/ezfio.tar.gz
+	export target=ezfio ; \
+	./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	touch _build/$${target}.ok || cat _build/$${target}.log
+
+_build/f77_zmq.ok: Downloads/f77_zmq.tar.gz  _build/zmq.ok
+	export target=f77_zmq ; \
+	./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	touch _build/$${target}.ok || cat _build/$${target}.log
+
+_build/qmcchemrc.ok: _build/irpf90.ok _build/ezfio.ok
+	export target=qmcchemrc; \
+	./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	touch _build/$${target}.ok || cat _build/$${target}.log
+
+_build/ocaml.ok: Downloads/opam_installer.sh  _build/qmcchemrc.ok ../qmcchemrc
+	which opam && touch _build/$${target}.ok || \
+	( export target=ocaml; \
+	  ./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	  touch _build/$${target}.ok || cat _build/$${target}.log ;\
+	)
+
+_build/ocaml_zmq.ok: _build/ocaml.ok
+	export target=ocaml_zmq; \
+	./scripts/install_$${target}.sh > _build/$${target}.log 2>&1 &&\
+	touch _build/$${target}.ok || cat _build/$${target}.log
+
+
+
+all: _build/ocaml_zmq.ok _build/ocaml.ok _build/qmcchemrc.ok _build/f77_zmq.ok _build/ezfio.ok _build/zmq.ok _build/irpf90.ok
+	@echo "Now, source again the qmcchemrc file"
+	@echo "source $$QMCCHEM_PATH/qmcchemrc"
+

install/build.ninja

@@ -1,76 +0,0 @@
-# This script should be run in the install dircetory
-
-# URLs
-######
-
-URL_OPAM  ="https://raw.github.com/ocaml/opam/master/shell/opam_installer.sh"
-URL_IRPF90="https://github.com/scemama/irpf90/archive/v1.6.7.tar.gz"
-URL_EZFIO ="https://github.com/scemama/EZFIO/archive/v1.3.1.tar.gz"
-
-URL_ZMQ   ="http://download.zeromq.org/zeromq-4.0.7.tar.gz"
-#URL_ZMQ   ="http://download.zeromq.org/zeromq-4.1.3.tar.gz"
-URL_F77ZMQ="https://github.com/scemama/f77_zmq/archive/v4.1.3.tar.gz"
-
-# Rules
-#######
-
-rule download
-  command = wget ${url} -O ${out}.tmp -o /dev/null && mv ${out}.tmp ${out}
-  description = Downloading ${descr}
-
-rule install
-  command = ./scripts/install_${target}.sh > _build/${target}.log 2>&1 &&  touch _build/${target}.ok || cat _build/${target}.log
-  description = Installing ${descr} | tail -f install/_build/${target}.log 
-
-
-# Builds
-########
-
-build Downloads/irpf90.tar.gz: download 
-  url = ${URL_IRPF90}
-  descr = IRPF90 code generator
-
-build Downloads/ezfio.tar.gz: download 
-  url = ${URL_EZFIO}
-  descr = EZFIO I/O library generator
-
-build Downloads/zmq.tar.gz: download 
-  url = ${URL_ZMQ}
-  descr = ZeroMQ communication library
-
-build Downloads/f77_zmq.tar.gz: download 
-  url = ${URL_F77ZMQ}
-  descr = Fortran ZeroMQ interface
-
-build Downloads/opam_installer.sh: download
-  url = ${URL_OPAM}
-  descr = OCaml OPAM installer
-
-build _build/irpf90.ok ../bin/irpman ../bin/irpf90: install | Downloads/irpf90.tar.gz 
-  target = irpf90
-  descr = IRPF90
-
-build _build/zmq.ok ../lib/libzmq.a ../lib/libzmq.so.4 ../lib/libzmq.so ../lib/zmq.h ../lib/zmq_utils.h: install | Downloads/zmq.tar.gz 
-  target = zmq
-  descr = ZeroMQ
-
-build _build/ezfio.ok: install | Downloads/ezfio.tar.gz  _build/irpf90.ok ../bin/irpman ../bin/irpf90
-  target = ezfio
-  descr = EZFIO
-
-build _build/f77_zmq.ok ../src/ZMQ/f77_zmq.h ../lib/libf77zmq.a ../lib/libf77zmq.so: install | Downloads/f77_zmq.tar.gz  _build/zmq.ok ../lib/libzmq.a ../lib/libzmq.so.4 ../lib/libzmq.so ../lib/zmq.h ../lib/zmq_utils.h
-  target = f77_zmq
-  descr = Fortran ZeroMQ interface
-
-build _build/qmcchemrc.ok ../qmcchemrc: install | _build/irpf90.ok ../bin/irpman ../bin/irpf90 _build/ezfio.ok
-  target = qmcchemrc
-  description = QMC=Chem environment variables
-
-build _build/ocaml.ok ../bin/opam: install | Downloads/opam_installer.sh  _build/qmcchemrc.ok ../qmcchemrc
-  target = ocaml
-  descr = OCaml compiler 
-
-build _build/ocaml_zmq.ok: install | ../bin/opam ../lib/libzmq.so ../lib/zmq.h ../lib/zmq_utils.h _build/ocaml.ok _build/zmq.ok ../lib/libzmq.a ../lib/libzmq.so.4 ../lib/libzmq.so ../lib/zmq.h ../lib/zmq_utils.h
-  target = ocaml_zmq
-  descr = OCaml ZeroMQ interface
-

install/scripts/install_f77_zmq.sh

@@ -5,17 +5,17 @@ function _install()
 {
   cd .. ; QMCCHEM_PATH="$PWD" ; cd -
   set +u
-  export C_INCLUDE_PATH="${C_INCLUDE_PATH}":../../../lib
+  export C_INCLUDE_PATH="${C_INCLUDE_PATH}":../../../include
   set -e
   set -u
   cd "${BUILD}"
-  export ZMQ_H="${QMCCHEM_PATH}"/lib/zmq.h
+  export ZMQ_H="${QMCCHEM_PATH}"/include/zmq.h
   cp "${ZMQ_H}" .
   make -j 8
   cd - 
   rm -f -- "${QMCCHEM_PATH}"/src/ZMQ/f77_zmq.h "${QMCCHEM_PATH}"/lib/libf77zmq.a "${QMCCHEM_PATH}"/lib/libf77zmq.so
   cp "${BUILD}"/libf77zmq.{a,so} ../lib/ 
-  cp "${BUILD}"/f77_zmq.h ../src/ZMQ/ 
+  cp "${BUILD}"/f77_zmq_free.h ../src/ZMQ/f77_zmq.h
   return 0
 }
 

install/scripts/install_ninja.sh

@@ -1,27 +0,0 @@
-#!/bin/bash -x
-
-set -u
-set -e
-
-TARGET=ninja
-URL="http://github.com/martine/ninja/archive/v1.5.3.tar.gz"
-
-function _install()
-{
-  cd .. ; QMCCHEM_PATH="$PWD" ; cd -
-  set -e
-  set -u
-  cd "${BUILD}"
-  ./configure.py --bootstrap
-  cd -
-  mv "${BUILD}/ninja" "${QMCCHEM_PATH}"/bin/
-  return 0 
-}
-
-if [[ ! -f "Downloads/${TARGET}.tar.gz" ]]
-then
-  wget ${URL} -O "Downloads/${TARGET}.tar.gz.tmp" 
-  mv "Downloads/${TARGET}.tar.gz"{.tmp,} 
-fi
-source scripts/build.sh
-

install/scripts/install_ocaml.sh

@@ -4,11 +4,45 @@ set -u
 set -e
 
 cd .. ; QMCCHEM_PATH="$PWD" ; cd -
-PACKAGES="core cryptokit ocamlfind sexplib"
+PACKAGES="cryptokit ocamlbuild getopt ocamlfind sexplib ppx_sexp_conv ppx_deriving"
 
-declare -i i
-i=$(gcc -dumpversion | cut -d '.' -f 2)
-if [[ i -lt 6 ]]
+# return 0 if program version is equal or greater than check version
+check_version () {
+    if [[ $1 == $2 ]]
+    then
+        return 0
+    fi
+    local IFS=.
+    local i ver1=($1) ver2=($2)
+    # fill empty fields in ver1 with zeros
+    for ((i=${#ver1[@]}; i<${#ver2[@]}; i++))
+    do
+        ver1[i]=0
+    done
+    for ((i=0; i<${#ver1[@]}; i++))
+    do
+        if [[ -z ${ver2[i]} ]]
+        then
+            # fill empty fields in ver2 with zeros
+            ver2[i]=0
+        fi
+        if ((10#${ver1[i]} > 10#${ver2[i]}))
+        then
+            return 1
+        fi
+        if ((10#${ver1[i]} < 10#${ver2[i]}))
+        then
+            return 0
+        fi
+    done
+    return 0
+}
+
+
+i=$(gcc -dumpversion)
+
+check_version 4.6 $i
+if [[ $? == 1 ]]
 then
    echo "GCC version $(gcc -dumpversion) too old. GCC >= 4.6 required."
    exit 1
@@ -19,31 +53,45 @@ source "${QMCCHEM_PATH}"/qmcchemrc
 set -u
 cd Downloads 
 chmod +x opam_installer.sh
+rm --force ${QMCCHEM_PATH}/bin/opam
+export OPAMROOT=${OPAMROOT:-${HOME}/.opam}
 
-if [[ -d "${HOME}"/.opam ]]
+
+if [[ -d "$OPAMROOT" ]]
 then
   set +e
   set +u
-  source "${HOME}"/.opam/opam-init/init.sh 
+  source "${OPAMROOT}"/opam-init/init.sh 
   set -e
   set -u
+  rm -f ${QMCCHEM_PATH}/bin/opam 
+  ln -s $(which opam) ${QMCCHEM_PATH}/bin/opam 
 fi
 
-echo N | ./opam_installer.sh "${QMCCHEM_PATH}"/bin/ 
+
+cat << EOF | bash ./opam_installer.sh --no-backup
+${QMCCHEM_PATH}/bin/
+
+
+EOF
+
 if [[ ! -f "${QMCCHEM_PATH}"/bin/opam ]]
 then
    echo "Installation of OPAM failed"
    exit 2
 fi
-"${QMCCHEM_PATH}"/bin/opam config setup -a --dot-profile "${QMCCHEM_PATH}"/qmcchemrc 
+
+source ${OPAMROOT}/opam-init/init.sh > /dev/null 2> /dev/null || true
+${QMCCHEM_PATH}/bin/opam init --verbose --yes --compiler=4.10.0 --disable-sandboxing
 touch "${QMCCHEM_PATH}"/bin/opam
+eval $(${QMCCHEM_PATH}/bin/opam env)
 
 set +u
 export LD_LIBRARY_PATH="${QMCCHEM_PATH}/lib:${LD_LIBRARY_PATH}"
 export LIBRARY_PATH="${QMCCHEM_PATH}/lib:${LIBRARY_PATH}"
 export C_INCLUDE_PATH="${QMCCHEM_PATH}/lib:${C_INCLUDE_PATH}"
 set -u
-opam install ${PACKAGES} 
+opam install -y --unlock-base ${PACKAGES} || exit 3
 rm "${QMCCHEM_PATH}"/install/_build/ocaml.log
 exit 0
 

install/scripts/install_ocaml_zmq.sh

@@ -32,7 +32,7 @@ export C_INCLUDE_PATH="${QMCCHEM_PATH}/lib":$C_INCLUDE_PATH
 export LIBRARY_PATH="${QMCCHEM_PATH}/lib":$LIBRARY_PATH
 export LD_LIBRARY_PATH="${QMCCHEM_PATH}/lib":$LD_LIBRARY_PATH
 set -u
-opam install zmq 
+opam install -y zmq conf-zmq
 rm -f _build/ocaml_zmq.log
 exit 0
 

install/scripts/install_zmq.sh

@@ -3,25 +3,18 @@
 TARGET=zmq
 function _install()
 {
-  LIBVERSION=4
+  LIBVERSION=5
   cd .. ; QMCCHEM_PATH="$PWD" ; cd -
   set +u
   export C_INCLUDE_PATH="${C_INCLUDE_PATH}":./
   set -e
   set -u
   cd "${BUILD}"
-  ./configure --without-libsodium
-  make -j 8
-  cd - 
   rm -f -- "${QMCCHEM_PATH}"/lib/libzmq.{a,so,so.$LIBVERSION} 
-# cp "${BUILD}"/.libs/libzmq.a "${QMCCHEM_PATH}"/lib/ 
-# cp "${BUILD}"/.libs/libzmq.so "${QMCCHEM_PATH}"/lib/libzmq.so.$LIBVERSION	
-  cp "${BUILD}"/src/.libs/libzmq.a "${QMCCHEM_PATH}"/lib/ 
-  cp "${BUILD}"/src/.libs/libzmq.so "${QMCCHEM_PATH}"/lib/libzmq.so.$LIBVERSION
-  cp "${BUILD}"/include/{zmq,zmq_utils}.h "${QMCCHEM_PATH}"/lib/
-  cd "${QMCCHEM_PATH}"/lib
-  ln libzmq.so.$LIBVERSION libzmq.so || cp libzmq.so.$LIBVERSION libzmq.so
-  cd -
+  ./configure --without-libsodium --enable-libunwind=no --prefix="${QMCCHEM_PATH}"
+  make -j 8
+  make install
+  cd - 
   return 0
 }
 

m4/ax_blas.m4

@@ -0,0 +1,241 @@
+# ===========================================================================
+#         https://www.gnu.org/software/autoconf-archive/ax_blas.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_BLAS([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
+#
+# DESCRIPTION
+#
+#   This macro looks for a library that implements the BLAS linear-algebra
+#   interface (see http://www.netlib.org/blas/). On success, it sets the
+#   BLAS_LIBS output variable to hold the requisite library linkages.
+#
+#   To link with BLAS, you should link with:
+#
+#     $BLAS_LIBS $LIBS $FLIBS
+#
+#   in that order. FLIBS is the output variable of the
+#   AC_F77_LIBRARY_LDFLAGS macro (called if necessary by AX_BLAS), and is
+#   sometimes necessary in order to link with F77 libraries. Users will also
+#   need to use AC_F77_DUMMY_MAIN (see the autoconf manual), for the same
+#   reason.
+#
+#   Many libraries are searched for, from ATLAS to CXML to ESSL. The user
+#   may also use --with-blas=<lib> in order to use some specific BLAS
+#   library <lib>. In order to link successfully, however, be aware that you
+#   will probably need to use the same Fortran compiler (which can be set
+#   via the F77 env. var.) as was used to compile the BLAS library.
+#
+#   ACTION-IF-FOUND is a list of shell commands to run if a BLAS library is
+#   found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it is
+#   not found. If ACTION-IF-FOUND is not specified, the default action will
+#   define HAVE_BLAS.
+#
+# LICENSE
+#
+#   Copyright (c) 2008 Steven G. Johnson <stevenj@alum.mit.edu>
+#   Copyright (c) 2019 Geoffrey M. Oxberry <goxberry@gmail.com>
+#
+#   This program is free software: you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation, either version 3 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see <https://www.gnu.org/licenses/>.
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+#serial 17
+
+AU_ALIAS([ACX_BLAS], [AX_BLAS])
+AC_DEFUN([AX_BLAS], [
+AC_PREREQ([2.55])
+AC_REQUIRE([AC_F77_LIBRARY_LDFLAGS])
+AC_REQUIRE([AC_CANONICAL_HOST])
+ax_blas_ok=no
+
+AC_ARG_WITH(blas,
+	[AS_HELP_STRING([--with-blas=<lib>], [use BLAS library <lib>])])
+case $with_blas in
+	yes | "") ;;
+	no) ax_blas_ok=disable ;;
+	-* | */* | *.a | *.so | *.so.* | *.dylib | *.dylib.* | *.o)
+		BLAS_LIBS="$with_blas"
+	;;
+	*) BLAS_LIBS="-l$with_blas" ;;
+esac
+
+# Get fortran linker names of BLAS functions to check for.
+AC_F77_FUNC(sgemm)
+AC_F77_FUNC(dgemm)
+
+ax_blas_save_LIBS="$LIBS"
+LIBS="$LIBS $FLIBS"
+
+# First, check BLAS_LIBS environment variable
+if test $ax_blas_ok = no; then
+if test "x$BLAS_LIBS" != x; then
+	save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"
+	AC_MSG_CHECKING([for $sgemm in $BLAS_LIBS])
+	AC_LINK_IFELSE([AC_LANG_CALL([], [$sgemm])], [ax_blas_ok=yes], [BLAS_LIBS=""])
+	AC_MSG_RESULT($ax_blas_ok)
+	LIBS="$save_LIBS"
+fi
+fi
+
+# BLAS linked to by default?  (happens on some supercomputers)
+if test $ax_blas_ok = no; then
+	save_LIBS="$LIBS"; LIBS="$LIBS"
+	AC_MSG_CHECKING([if $sgemm is being linked in already])
+	AC_LINK_IFELSE([AC_LANG_CALL([], [$sgemm])], [ax_blas_ok=yes])
+	AC_MSG_RESULT($ax_blas_ok)
+	LIBS="$save_LIBS"
+fi
+
+# BLAS in OpenBLAS library? (http://xianyi.github.com/OpenBLAS/)
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(openblas, $sgemm, [ax_blas_ok=yes
+			                BLAS_LIBS="-lopenblas"])
+fi
+
+# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(atlas, ATL_xerbla,
+		[AC_CHECK_LIB(f77blas, $sgemm,
+		[AC_CHECK_LIB(cblas, cblas_dgemm,
+			[ax_blas_ok=yes
+			 BLAS_LIBS="-lcblas -lf77blas -latlas"],
+			[], [-lf77blas -latlas])],
+			[], [-latlas])])
+fi
+
+# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(blas, $sgemm,
+		[AC_CHECK_LIB(dgemm, $dgemm,
+		[AC_CHECK_LIB(sgemm, $sgemm,
+			[ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"],
+			[], [-lblas])],
+			[], [-lblas])])
+fi
+
+# BLAS in Intel MKL library?
+if test $ax_blas_ok = no; then
+	# MKL for gfortran
+	if test x"$ac_cv_fc_compiler_gnu" = xyes; then
+		# 64 bit
+		if test $host_cpu = x86_64; then
+			AC_CHECK_LIB(mkl_gf_lp64, $sgemm,
+			[ax_blas_ok=yes;BLAS_LIBS="-lmkl_gf_lp64 -lmkl_sequential -lmkl_core -lpthread"],,
+			[-lmkl_gf_lp64 -lmkl_sequential -lmkl_core -lpthread])
+		# 32 bit
+		elif test $host_cpu = i686; then
+			AC_CHECK_LIB(mkl_gf, $sgemm,
+				[ax_blas_ok=yes;BLAS_LIBS="-lmkl_gf -lmkl_sequential -lmkl_core -lpthread"],,
+				[-lmkl_gf -lmkl_sequential -lmkl_core -lpthread])
+		fi
+	# MKL for other compilers (Intel, PGI, ...?)
+	else
+		# 64-bit
+		if test $host_cpu = x86_64; then
+			AC_CHECK_LIB(mkl_intel_lp64, $sgemm,
+				[ax_blas_ok=yes;BLAS_LIBS="-lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lpthread"],,
+				[-lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lpthread])
+		# 32-bit
+		elif test $host_cpu = i686; then
+			AC_CHECK_LIB(mkl_intel, $sgemm,
+				[ax_blas_ok=yes;BLAS_LIBS="-lmkl_intel -lmkl_sequential -lmkl_core -lpthread"],,
+				[-lmkl_intel -lmkl_sequential -lmkl_core -lpthread])
+		fi
+	fi
+fi
+# Old versions of MKL
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(mkl, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lmkl -lguide -lpthread"],,[-lguide -lpthread])
+fi
+
+# BLAS in Apple vecLib library?
+if test $ax_blas_ok = no; then
+	save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"
+	AC_MSG_CHECKING([for $sgemm in -framework vecLib])
+	AC_LINK_IFELSE([AC_LANG_CALL([], [$sgemm])], [ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"])
+	AC_MSG_RESULT($ax_blas_ok)
+	LIBS="$save_LIBS"
+fi
+
+# BLAS in Alpha CXML library?
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(cxml, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lcxml"])
+fi
+
+# BLAS in Alpha DXML library? (now called CXML, see above)
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(dxml, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-ldxml"])
+fi
+
+# BLAS in Sun Performance library?
+if test $ax_blas_ok = no; then
+	if test "x$GCC" != xyes; then # only works with Sun CC
+		AC_CHECK_LIB(sunmath, acosp,
+			[AC_CHECK_LIB(sunperf, $sgemm,
+				[BLAS_LIBS="-xlic_lib=sunperf -lsunmath"
+                                 ax_blas_ok=yes],[],[-lsunmath])])
+	fi
+fi
+
+# BLAS in SCSL library?  (SGI/Cray Scientific Library)
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(scs, $sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lscs"])
+fi
+
+# BLAS in SGIMATH library?
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(complib.sgimath, $sgemm,
+		     [ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"])
+fi
+
+# BLAS in IBM ESSL library? (requires generic BLAS lib, too)
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(blas, $sgemm,
+		[AC_CHECK_LIB(essl, $sgemm,
+			[ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"],
+			[], [-lblas $FLIBS])])
+fi
+
+# Generic BLAS library?
+if test $ax_blas_ok = no; then
+	AC_CHECK_LIB(blas, $sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lblas"])
+fi
+
+AC_SUBST(BLAS_LIBS)
+
+LIBS="$ax_blas_save_LIBS"
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test x"$ax_blas_ok" = xyes; then
+        ifelse([$1],,AC_DEFINE(HAVE_BLAS,1,[Define if you have a BLAS library.]),[$1])
+        :
+else
+        ax_blas_ok=no
+        $2
+fi
+])dnl AX_BLAS

m4/ax_check_gnu_make.m4

@@ -0,0 +1,96 @@
+# ===========================================================================
+#    https://www.gnu.org/software/autoconf-archive/ax_check_gnu_make.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_CHECK_GNU_MAKE([run-if-true],[run-if-false])
+#
+# DESCRIPTION
+#
+#   This macro searches for a GNU version of make. If a match is found:
+#
+#     * The makefile variable `ifGNUmake' is set to the empty string, otherwise
+#       it is set to "#". This is useful for including a special features in a
+#       Makefile, which cannot be handled by other versions of make.
+#     * The makefile variable `ifnGNUmake' is set to #, otherwise
+#       it is set to the empty string. This is useful for including a special
+#       features in a Makefile, which can be handled
+#       by other versions of make or to specify else like clause.
+#     * The variable `_cv_gnu_make_command` is set to the command to invoke
+#       GNU make if it exists, the empty string otherwise.
+#     * The variable `ax_cv_gnu_make_command` is set to the command to invoke
+#       GNU make by copying `_cv_gnu_make_command`, otherwise it is unset.
+#     * If GNU Make is found, its version is extracted from the output of
+#       `make --version` as the last field of a record of space-separated
+#       columns and saved into the variable `ax_check_gnu_make_version`.
+#     * Additionally if GNU Make is found, run shell code run-if-true
+#       else run shell code run-if-false.
+#
+#   Here is an example of its use:
+#
+#   Makefile.in might contain:
+#
+#     # A failsafe way of putting a dependency rule into a makefile
+#     $(DEPEND):
+#             $(CC) -MM $(srcdir)/*.c > $(DEPEND)
+#
+#     @ifGNUmake@ ifeq ($(DEPEND),$(wildcard $(DEPEND)))
+#     @ifGNUmake@ include $(DEPEND)
+#     @ifGNUmake@ else
+#     fallback code
+#     @ifGNUmake@ endif
+#
+#   Then configure.in would normally contain:
+#
+#     AX_CHECK_GNU_MAKE()
+#     AC_OUTPUT(Makefile)
+#
+#   Then perhaps to cause gnu make to override any other make, we could do
+#   something like this (note that GNU make always looks for GNUmakefile
+#   first):
+#
+#     if  ! test x$_cv_gnu_make_command = x ; then
+#             mv Makefile GNUmakefile
+#             echo .DEFAULT: > Makefile ;
+#             echo \  $_cv_gnu_make_command \$@ >> Makefile;
+#     fi
+#
+#   Then, if any (well almost any) other make is called, and GNU make also
+#   exists, then the other make wraps the GNU make.
+#
+# LICENSE
+#
+#   Copyright (c) 2008 John Darrington <j.darrington@elvis.murdoch.edu.au>
+#   Copyright (c) 2015 Enrico M. Crisostomo <enrico.m.crisostomo@gmail.com>
+#
+#   Copying and distribution of this file, with or without modification, are
+#   permitted in any medium without royalty provided the copyright notice
+#   and this notice are preserved. This file is offered as-is, without any
+#   warranty.
+
+#serial 12
+
+AC_DEFUN([AX_CHECK_GNU_MAKE],dnl
+  [AC_PROG_AWK
+  AC_CACHE_CHECK([for GNU make],[_cv_gnu_make_command],[dnl
+    _cv_gnu_make_command="" ;
+dnl Search all the common names for GNU make
+    for a in "$MAKE" make gmake gnumake ; do
+      if test -z "$a" ; then continue ; fi ;
+      if "$a" --version 2> /dev/null | grep GNU 2>&1 > /dev/null ; then
+        _cv_gnu_make_command=$a ;
+        AX_CHECK_GNU_MAKE_HEADLINE=$("$a" --version 2> /dev/null | grep "GNU Make")
+        ax_check_gnu_make_version=$(echo ${AX_CHECK_GNU_MAKE_HEADLINE} | ${AWK} -F " " '{ print $(NF); }')
+        break ;
+      fi
+    done ;])
+dnl If there was a GNU version, then set @ifGNUmake@ to the empty string, '#' otherwise
+  AS_VAR_IF([_cv_gnu_make_command], [""], [AS_VAR_SET([ifGNUmake], ["#"])],   [AS_VAR_SET([ifGNUmake], [""])])
+  AS_VAR_IF([_cv_gnu_make_command], [""], [AS_VAR_SET([ifnGNUmake], [""])],   [AS_VAR_SET([ifnGNUmake], ["#"])])
+  AS_VAR_IF([_cv_gnu_make_command], [""], [AS_UNSET(ax_cv_gnu_make_command)], [AS_VAR_SET([ax_cv_gnu_make_command], [${_cv_gnu_make_command}])])
+  AS_VAR_IF([_cv_gnu_make_command], [""],[$2],[$1])
+  AC_SUBST([ifGNUmake])
+  AC_SUBST([ifnGNUmake])
+])
+

m4/ax_irpf90.m4

@@ -0,0 +1,73 @@
+# ===========================================================================
+#        https://www.gnu.org/software/autoconf-archive/ax_irpf90.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_PROG_IRPF90
+#
+# DESCRIPTION
+#
+#   Check for the program 'irpf90', let script continue if exists, pops up
+#   error message if not.
+#
+#   Besides checking existence, this macro also set these environment
+#   variables upon completion:
+#
+#     IRPF90 = which irpf90
+#
+# DEPENDENCIES
+#
+#   AX_CHECK_GNU_MAKE
+#
+# LICENSE
+#
+#   Copyright (c) 2021 Anthony Scemama
+#
+#   This program is free software; you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation; either version 2 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see <https://www.gnu.org/licenses/>.
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+
+AU_ALIAS([AC_PROG_IRPF90], [AX_PROG_IRPF90])
+
+AC_DEFUN([AX_PROG_IRPF90], [
+
+# Requirements
+AC_REQUIRE([AX_CHECK_GNU_MAKE])
+
+AS_IF([test "x$ifGNUmake" = "x#"], [ AC_MSG_ERROR([GNU Make (gmake) is required with IRPF90]) ])
+
+# IRPF90
+AC_PATH_PROG([IRPF90], [irpf90], [nocommand])
+AS_IF([test "x$IRPF90" = xnocommand], [
+        AC_MSG_ERROR([irpf90 not found in $PATH]) ])
+
+AC_FC_FREEFORM
+AC_FC_LINE_LENGTH
+AC_FC_MODULE_EXTENSION
+
+])
+

m4/ax_lapack.m4

@@ -0,0 +1,135 @@
+# ===========================================================================
+#        https://www.gnu.org/software/autoconf-archive/ax_lapack.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_LAPACK([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
+#
+# DESCRIPTION
+#
+#   This macro looks for a library that implements the LAPACK linear-algebra
+#   interface (see http://www.netlib.org/lapack/). On success, it sets the
+#   LAPACK_LIBS output variable to hold the requisite library linkages.
+#
+#   To link with LAPACK, you should link with:
+#
+#     $LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS
+#
+#   in that order. BLAS_LIBS is the output variable of the AX_BLAS macro,
+#   called automatically. FLIBS is the output variable of the
+#   AC_F77_LIBRARY_LDFLAGS macro (called if necessary by AX_BLAS), and is
+#   sometimes necessary in order to link with F77 libraries. Users will also
+#   need to use AC_F77_DUMMY_MAIN (see the autoconf manual), for the same
+#   reason.
+#
+#   The user may also use --with-lapack=<lib> in order to use some specific
+#   LAPACK library <lib>. In order to link successfully, however, be aware
+#   that you will probably need to use the same Fortran compiler (which can
+#   be set via the F77 env. var.) as was used to compile the LAPACK and BLAS
+#   libraries.
+#
+#   ACTION-IF-FOUND is a list of shell commands to run if a LAPACK library
+#   is found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it
+#   is not found. If ACTION-IF-FOUND is not specified, the default action
+#   will define HAVE_LAPACK.
+#
+# LICENSE
+#
+#   Copyright (c) 2009 Steven G. Johnson <stevenj@alum.mit.edu>
+#   Copyright (c) 2019 Geoffrey M. Oxberry <goxberry@gmail.com>
+#
+#   This program is free software: you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation, either version 3 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see <https://www.gnu.org/licenses/>.
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+#serial 10
+
+AU_ALIAS([ACX_LAPACK], [AX_LAPACK])
+AC_DEFUN([AX_LAPACK], [
+AC_REQUIRE([AX_BLAS])
+ax_lapack_ok=no
+
+AC_ARG_WITH(lapack,
+        [AS_HELP_STRING([--with-lapack=<lib>], [use LAPACK library <lib>])])
+case $with_lapack in
+        yes | "") ;;
+        no) ax_lapack_ok=disable ;;
+        -* | */* | *.a | *.so | *.so.* | *.dylib | *.dylib.* | *.o)
+                 LAPACK_LIBS="$with_lapack"
+        ;;
+        *) LAPACK_LIBS="-l$with_lapack" ;;
+esac
+
+# Get fortran linker name of LAPACK function to check for.
+AC_F77_FUNC(cheev)
+
+# We cannot use LAPACK if BLAS is not found
+if test "x$ax_blas_ok" != xyes; then
+        ax_lapack_ok=noblas
+        LAPACK_LIBS=""
+fi
+
+# First, check LAPACK_LIBS environment variable
+if test "x$LAPACK_LIBS" != x; then
+        save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS"
+        AC_MSG_CHECKING([for $cheev in $LAPACK_LIBS])
+        AC_LINK_IFELSE([AC_LANG_CALL([], [$cheev])], [ax_lapack_ok=yes], [LAPACK_LIBS=""])
+        AC_MSG_RESULT($ax_lapack_ok)
+        LIBS="$save_LIBS"
+        if test $ax_lapack_ok = no; then
+                LAPACK_LIBS=""
+        fi
+fi
+
+# LAPACK linked to by default?  (is sometimes included in BLAS lib)
+if test $ax_lapack_ok = no; then
+        save_LIBS="$LIBS"; LIBS="$LIBS $BLAS_LIBS $FLIBS"
+        AC_CHECK_FUNC($cheev, [ax_lapack_ok=yes])
+        LIBS="$save_LIBS"
+fi
+
+# Generic LAPACK library?
+for lapack in lapack lapack_rs6k; do
+        if test $ax_lapack_ok = no; then
+                save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"
+                AC_CHECK_LIB($lapack, $cheev,
+                    [ax_lapack_ok=yes; LAPACK_LIBS="-l$lapack"], [], [$FLIBS])
+                LIBS="$save_LIBS"
+        fi
+done
+
+AC_SUBST(LAPACK_LIBS)
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test x"$ax_lapack_ok" = xyes; then
+        ifelse([$1],,AC_DEFINE(HAVE_LAPACK,1,[Define if you have LAPACK library.]),[$1])
+        :
+else
+        ax_lapack_ok=no
+        $2
+fi
+])dnl AX_LAPACK
+

m4/ax_zmq.m4

@@ -0,0 +1,91 @@
+# ===========================================================================
+#          https://www.gnu.org/software/autoconf-archive/ax_zmq.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_ZMQ([MINIMUM-VERSION], [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
+#
+# DESCRIPTION
+#
+#   Test for the ZMQ libraries of a particular version (or newer). The
+#   default version tested for is 4.0.0.
+#
+#   The macro tests for ZMQ libraries in the library/include path, and, when
+#   provided, also in the path given by --with-zmq.
+#
+#   This macro calls:
+#
+#     AC_SUBST(ZMQ_CPPFLAGS) / AC_SUBST(ZMQ_LDFLAGS) / AC_SUBST(ZMQ_LIBS)
+#
+#   And sets:
+#
+#     HAVE_ZMQ
+#
+# LICENSE
+#
+#   Copyright (c) 2016 Jeroen Meijer <jjgmeijer@gmail.com>
+#
+#   Copying and distribution of this file, with or without modification, are
+#   permitted in any medium without royalty provided the copyright notice
+#   and this notice are preserved. This file is offered as-is, without any
+#   warranty.
+
+#serial 3
+
+AC_DEFUN([AX_ZMQ], [
+    AC_ARG_WITH([zmq], [AS_HELP_STRING([--with-zmq=<prefix>],[ZMQ prefix directory])], [
+        ZMQ_LDFLAGS="-L${with_zmq}/lib"
+        ZMQ_CPPFLAGS="-I${with_zmq}/include"
+    ])
+
+    HAVE_ZMQ=0
+    if test "$with_zmq" != "no"; then
+
+        LD_FLAGS="$LDFLAGS $ZMQ_LDFLAGS"
+        CPPFLAGS="$CPPFLAGS $ZMQ_CPPFLAGS"
+
+        AC_LANG_PUSH([C])
+        AC_CHECK_HEADER(zmq.h, [zmq_h=yes], [zmq_h=no])
+        AC_LANG_POP([C])
+
+        if test "$zmq_h" = "yes"; then
+            version=ifelse([$1], ,4.0.0,$1)
+            AC_MSG_CHECKING([for ZMQ version >= $version])
+            version=$(echo $version | tr '.' ',')
+            AC_EGREP_CPP([version_ok], [
+#include <zmq.h>
+#if defined(ZMQ_VERSION) && ZMQ_VERSION >= ZMQ_MAKE_VERSION($version)
+    version_ok
+#endif
+            ],[
+                AC_MSG_RESULT(yes)
+                AC_CHECK_LIB([zmq],[zmq_send],[
+                    HAVE_ZMQ=1
+                    ZMQ_LIBS="-lzmq"
+                  ],[
+                    AC_MSG_ERROR([libzmq.so not in LIBRARY_PATH])
+                  ])
+                         
+                AC_SUBST(ZMQ_LDFLAGS)
+                AC_SUBST(ZMQ_CPPFLAGS)
+                AC_SUBST(ZMQ_LIBS)
+            ], AC_MSG_RESULT([no valid ZMQ version was found]))
+        else
+            AC_MSG_WARN([no valid ZMQ installation was found])
+        fi
+
+        if test $HAVE_ZMQ = 1; then
+            # execute ACTION-IF-FOUND (if present):
+            ifelse([$2], , :, [$2])
+        else
+            # execute ACTION-IF-NOT-FOUND (if present):
+            ifelse([$3], , :, [$3])
+        fi
+    else
+        AC_MSG_NOTICE([not checking for ZMQ])
+    fi
+
+    AC_DEFINE(HAVE_ZMQ,,[define if the ZMQ library is available])
+])
+

make.config.gfortran

@@ -6,13 +6,13 @@ CPU_TYPE="-mavx"
 
 ## FORTRAN compiler
 FC="gfortran -ffree-line-length-none"
-NINJA="ninja"
 FCFLAGS="-O2 -g ${CPU_TYPE}"
-LIB="-lblas -llapack"
+LIB="-lblas -llapack -lpthread"
+ARCHIVE="ar crf"
 
 ## IRPF90
 IRPF90="${QMCCHEM_PATH}/bin/irpf90"
 IRPF90_FLAGS="--align=16"
 
-export FC NINJA FCFLAGS LIB IRPF90 IRPF90_FLAGS
+export FC FCFLAGS LIB IRPF90 IRPF90_FLAGS AR
 

make.config.ifort

@@ -10,13 +10,13 @@ ALIGN="32"
 
 ## FORTRAN compiler
 FC="ifort"
-NINJA="ninja"
-FCFLAGS="-O2 -g -ip -ftz -finline ${CPU_TYPE}" #-traceback
+FCFLAGS="-O2 -g -ip -ftz -finline ${CPU_TYPE} -qopenmp-simd" #-traceback
 LIB="-mkl=sequential"
+ARCHIVE="ar crf"
 
 ## IRPF90
 IRPF90="${QMCCHEM_PATH}/bin/irpf90"
-IRPF90_FLAGS="--align=${ALIGN} ${IRPF90_FLAGS}"
+IRPF90_FLAGS="--align=${ALIGN}"
 
-export FC NINJA FCFLAGS LIB IRPF90 IRPF90_FLAGS
+export FC FCFLAGS LIB IRPF90 IRPF90_FLAGS ARCHIVE
 

ocaml/.gitignore

@@ -1,12 +1,10 @@
 *.cmi
 *.cmx
 *.o
+*.cmo
 ezfio.ml
 Qptypes.ml
 .ls_md5
-.ninja_deps
-.ninja_log
-generated.ninja
 qmcchem
 qptypes_generator
 Property.ml

ocaml/.merlin

@@ -0,0 +1,3 @@
+PKG cryptokit str zmq
+S .
+

ocaml/Block.ml

@@ -1,19 +1,18 @@
-open Core.Std;;
-open Qptypes;;
+open Qptypes
 
-type t = 
+type t =
   { property       : Property.t ;
     value          : Sample.t        ;
     weight         : Weight.t        ;
     compute_node   : Compute_node.t  ;
-    pid            : Pid.t           ;
+    pid            : int             ;
     block_id       : Block_id.t      ;
   }
 
 let re =
   Str.regexp "[ |#|\n]+"
 
-let of_string s = 
+let of_string s =
 
    try
      let lst =
@@ -23,55 +22,148 @@ let of_string s =
       match lst with
       | b :: pid :: c:: p :: w :: v :: [] -> Some
         { property = Property.of_string p ;
-          value    = Sample.of_float (Float.of_string v) ;
-          weight   = Weight.of_float (Float.of_string w) ; 
+          value    = Sample.of_float (float_of_string v) ;
+          weight   = Weight.of_float (float_of_string w) ;
           compute_node = Compute_node.of_string c;
-          pid          = Pid.of_string pid;
-          block_id     = Block_id.of_int (Int.of_string b) ;
+          pid          = int_of_string pid;
+          block_id     = Block_id.of_int (int_of_string b) ;
         }
-      | b :: pid :: c:: p :: w :: v -> 
-          let v = 
+      | b :: pid :: c:: p :: w :: v ->
+          let v =
             List.rev v
-            |> Array.of_list 
-            |> Array.map ~f:Float.of_string
+            |> Array.of_list
+            |> Array.map float_of_string
           in
-          let dim = 
+          let dim =
             Array.length v
           in
         Some
         { property = Property.of_string p ;
           value    = Sample.of_float_array ~dim v ;
-          weight   = Weight.of_float (Float.of_string w) ; 
+          weight   = Weight.of_float (float_of_string w) ;
           compute_node = Compute_node.of_string c;
-          pid          = Pid.of_string pid;
-          block_id     = Block_id.of_int (Int.of_string b) ;
+          pid          = int_of_string pid;
+          block_id     = Block_id.of_int (int_of_string b) ;
         }
       | _ -> None
    with
    | _ -> None
 
 
-  
+
+let to_short_string b =
+    Printf.sprintf "%s # %s %d %d"
+      (Property.to_string     b.property)
+      (Compute_node.to_string b.compute_node)
+      b.pid
+      (Block_id.to_int        b.block_id)
+
+
 let to_string b =
-  Printf.sprintf "%s %s # %s %s %s %d"
-  (Sample.to_string       b.value )
-  (Weight.to_float        b.weight       |> Float.to_string)
-  (Property.to_string     b.property)
-  (Compute_node.to_string b.compute_node)
-  (Pid.to_string          b.pid)
-  (Block_id.to_int        b.block_id)
+    Printf.sprintf "%s %s # %s %s %s %d"
+      (Sample.to_string       b.value )
+      (Weight.to_float        b.weight       |> string_of_float)
+      (Property.to_string     b.property)
+      (Compute_node.to_string b.compute_node)
+      (string_of_int          b.pid)
+      (Block_id.to_int        b.block_id)
 
 
 
+
+let zero =
+  bytes_of_int 0
+
+let to_bytes b =
+  (* [ Length of b
+       [ Length of value ;
+         Value ;
+         Length of weight ;
+         Weight ;
+         ...  ] ]  *)
+  let l =
+    [  Property.to_bytes      b.property ;
+       Sample.to_bytes        b.value  ;
+       Weight.to_bytes        b.weight ;
+       bytes_of_int           b.pid ;
+       Block_id.to_bytes      b.block_id ;
+       Compute_node.to_bytes  b.compute_node ]
+    |> List.map (fun x -> [ bytes_of_int (Bytes.length x) ;  x ] )
+    |> List.concat
+  in
+  let result =
+    Bytes.concat Bytes.empty (zero :: l)
+  in
+  Bytes.set_int64_ne result 0 (Int64.of_int ((Bytes.length result) - 8));
+  result
+
+
+let read_bytes b idx =
+  (* Reads m, the first 8 bytes as an int64 containing the number of bytes to read.
+     Then, read the next m bytes and return a tuple containing the decoded data and the rest.
+  *)
+  let l = (Bytes.length b) - idx in
+  if l < 8 then
+     None
+  else
+     let m =
+       Bytes.get_int64_ne b idx
+       |> Int64.to_int
+     in
+     try
+       Some (Bytes.sub b (idx+8) m, idx+8+m)
+     with Invalid_argument _ -> None
+
+
+
+let of_bytes ?(idx=0) b =
+  let get_x s idx =
+    match read_bytes s idx with
+    | Some ( data, i1) -> data, i1
+    | _ -> raise Exit
+  in
+
+
+  let result =
+    try
+      let property, idx = get_x b idx in
+      let value   , idx = get_x b idx in
+      let weight  , idx = get_x b idx in
+      let pid     , idx = get_x b idx in
+      let block_id, idx = get_x b idx in
+      let compute_node, i5 = get_x b idx in
+      Some
+          { property = Property.of_bytes property;
+            value    = Sample.of_bytes value;
+            weight   = Weight.of_bytes weight;
+            pid          = int_of_bytes pid;
+            block_id     = Block_id.of_bytes block_id;
+            compute_node = Compute_node.of_bytes compute_node;
+          }
+    with Exit -> None
+  in
+  result
+
+
+let of_string_or_bytes s =
+  if Qmcchem_config.binary_io then
+     Bytes.of_string s
+     |> of_bytes
+  else
+     of_string s
+
 let dir_name = lazy(
-  let ezfio_filename = 
+  let ezfio_filename =
      Lazy.force Qputils.ezfio_filename
   in
   let md5 =
-     Md5.hash ()
+     QmcMd5.hash ()
   in
-  List.fold_right ~init:"" ~f:Filename.concat 
-    [ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ]
+  let d = Filename.concat ezfio_filename "blocks" in
+  if not ( Sys.file_exists d ) then
+    Unix.mkdir d 0o755;
+  List.fold_right Filename.concat
+    [ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] ""
 )
 
 
@@ -82,58 +174,107 @@ let _raw_data =
 
 let update_raw_data ?(locked=true) () =
   (* Create array of files to read *)
-  let dir_name = 
+  let dir_name =
     Lazy.force dir_name
   in
-  let files = 
-     let result = 
-       match Sys.is_directory dir_name with
-       | `Yes -> 
+  let files =
+     let result =
+       if Sys.file_exists dir_name && Sys.is_directory dir_name then
          begin
            Sys.readdir dir_name
-           |> Array.map ~f:(fun x -> dir_name^x)
+           |> Array.map (fun x -> dir_name^x)
            |> Array.to_list
          end
-       | _ -> []
+       else []
      in
      if locked then
        result
      else
-       List.filter result ~f:(fun x ->
-         match String.substr_index ~pattern:"locked" x with
-         | Some x -> false
-         | None -> true
-       )
+       List.filter (fun x ->
+         try
+          let _ =
+            Str.search_backward (Str.regexp "locked") x ((String.length x) - 1)
+          in false
+         with
+         | Not_found -> true
+       ) result
   in
 
-  let rec transform new_list = function 
-   | [] -> new_list
-   | head :: tail ->
-     let head = String.strip head in
-     let item = of_string head in
-     match item with
-       | None   -> transform new_list tail
-       | Some x -> transform (x::new_list) tail
-  in
+  if Qmcchem_config.binary_io then
+    begin
+      let result =
+        let rec aux buf idx accu =
+          (* Read one block *)
+          match read_bytes buf idx with
+          | None -> List.rev accu
+          | Some (item, new_idx) ->
+              match of_bytes item with
+              | None   -> List.rev accu
+              | Some item -> (aux [@tailcall]) buf new_idx (item::accu)
+        in
+        List.concat_map (fun filename ->
+          let ic = open_in filename in
+          let length = in_channel_length ic in
+          let result =
+            if length > 0 then
+                let buf = Bytes.create length in
+                really_input ic buf 0 length;
+                aux buf 0 []
+            else []
+          in
+          close_in ic;
+          result ) files
+      in
+      result
+    end
+  else
+    begin
+      let rec transform new_list = function
+      | [] -> new_list
+      | head :: tail ->
+        let head = String.trim head in
+        let item = of_string head in
+        match item with
+          | None   -> transform new_list tail
+          | Some x -> transform (x::new_list) tail
+      in
 
-  let result =
-  List.map files ~f:(fun filename ->
-    In_channel.with_file filename ~f:(fun in_channel ->
-      In_channel.input_all in_channel)
-    )
-  |> String.concat 
-  |> String.split_lines 
-  |> List.rev
-  |> transform [] 
-  in
-  result
+      let result =
+        let rec aux ic accu =
+          let l =
+            try
+              Some (input_line ic)
+            with
+            | End_of_file -> None
+          in
+          match l with
+          | None -> List.rev accu
+          | Some l -> (aux [@tailcall]) ic (l::accu)
+          in
+          List.concat_map (fun filename ->
+            let ic = open_in filename in
+            let result = aux ic [] in
+            close_in ic;
+            result ) files
+        |> transform []
+      in
+      result
+    end
 
 
-let raw_data ?(locked=true) () = 
+let to_string_or_bytes b =
+  if Qmcchem_config.binary_io then
+    to_bytes b
+    |> Bytes.to_string
+  else
+    to_string b
+
+
+let raw_data ?(locked=true) () =
   match !_raw_data with
   | Some x -> x
   | None   ->
-    let result = 
+    let result =
       update_raw_data ~locked ()
     in
     _raw_data := Some result;
@@ -142,9 +283,11 @@ let raw_data ?(locked=true) () =
 
 
 let properties = lazy (
-  let set = Set.empty ~comparator:Comparator.Poly.comparator in
-  List.fold (raw_data ()) ~init:set ~f:(fun s x -> Set.add s x.property)
-    |> Set.to_list
+  let h = Hashtbl.create 63 in
+  List.iter (fun x ->
+    Hashtbl.replace h (Property.to_string x.property) x.property)
+    (raw_data ());
+  Hashtbl.fold (fun k v a -> v :: a) h []
 )
 
 

ocaml/Command_line.ml

@@ -0,0 +1,218 @@
+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 ;
+  }
+
+(* Mutable variables *)
+let anon_args  = ref []
+and header_doc = ref ""
+and description_doc = ref ""
+and footer_doc = ref ""
+and specs      = ref []
+
+let reset () = 
+    anon_args  := [];
+    header_doc := "";
+    description_doc := "";
+    footer_doc := "";
+    specs      := []
+
+(* End mutable variables *)
+
+let set_header_doc s = header_doc := s
+let set_description_doc s = description_doc := s
+let set_footer_doc s = footer_doc := s
+
+(* Hash table containing all the options *)
+let dict = Hashtbl.create 67 
+
+let get_bool x = Hashtbl.mem dict x
+
+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 help () =
+
+    (* Print the header *)
+    output_text !header_doc;
+    Format.printf "@.@.";
+
+    (* Find the anonymous arguments *)
+    let anon =
+      List.filter (fun x -> x.short = ' ') !specs
+    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
+
+    (* 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
+
+
+    (* 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 "@]@,@]@,";
+
+
+    (* 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 "@]@,@]@,";
+
+
+    (* 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 "@."
+
+
+
+let set_specs ?(no_help=false) specs_in =
+    specs := { short='h' ;
+               long ="help" ;
+               doc  ="Prints the help message." ;
+               arg  =Without_arg ;
+               opt  =Optional ;
+             } :: specs_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
+
+    let cmdline =
+      Sys.argv
+      |> Array.to_list
+      |> List.filter (fun x -> x <> "")
+      |> Array.of_list
+    in
+    Getopt.parse cmd_specs (fun x -> anon_args := !anon_args @ [x])
+      cmdline 1 (Array.length cmdline -1);
+
+
+    if not no_help && (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.")
+        )
+;;
+
+
+let anon_args () = !anon_args
+
+
+

ocaml/Command_line.mli

@@ -0,0 +1,129 @@
+(** 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 : ?no_help:bool -> description list -> unit
+
+
+(** Returns the list of anonymous arguments *)
+val anon_args : unit -> string list
+
+
+(** Reset the internal state *)
+val reset : unit -> unit
+

ocaml/Default.ml

@@ -1,34 +1,37 @@
-open Core.Std;;
-
-
-let simulation_do_nucl_fitcusp  = lazy(
-  if (not (Ezfio.has_pseudo_do_pseudo ())) then
-    not (Ezfio.get_pseudo_do_pseudo ())
+let simulation_nucl_fitcusp_factor  = lazy(
+  let default = 
+    1.
+  in
+  if (Ezfio.has_pseudo_do_pseudo ()) then
+    if (Ezfio.get_pseudo_do_pseudo ()) then
+      0.
+    else
+      default
   else
-    true
+    default
 )
 
-let electrons_elec_walk_num        = lazy ( 30          )
-let electrons_elec_walk_num_tot    = lazy ( 10000       )
-let jastrow_jast_type              = lazy ( "None"      )
-let simulation_block_time          = lazy ( 30          )
-let simulation_ci_threshold        = lazy ( 1.e-8     )
-let simulation_method              = lazy ( "VMC"       )
-let simulation_sampling            = lazy ( "Langevin"  )
-let simulation_stop_time           = lazy ( 3600        )
-let simulation_time_step           = lazy ( 0.15        )
-let simulation_dmc_projection_time = lazy ( 1.        )
+let electrons_elec_walk_num         = lazy ( 100         )
+let electrons_elec_walk_num_tot     = lazy ( 1000        )
+let jastrow_jast_type               = lazy ( "None"      )
+let simulation_block_time           = lazy ( 30          )
+let simulation_ci_threshold         = lazy ( 1.e-8       )
+let simulation_method               = lazy ( "VMC"       )
+let simulation_sampling             = lazy ( "Langevin"  )
+let simulation_stop_time            = lazy ( 3600        )
+let simulation_time_step            = lazy ( 0.15        )
+let simulation_srmc_projection_time = lazy ( 1.          )
                                  
 let reset_defaults () =
-  List.iter ~f:(fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x))
+  List.iter (fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x))
     [ "/electrons/elec_walk_num"       ;
       "/electrons/elec_walk_num_tot"   ;
       "/jastrow/jast_type"             ;
       "/simulation/block_time"         ;
       "/simulation/ci_threshold"       ;
-      "/simulation/do_nucl_fitcusp"    ;
       "/simulation/method"             ;
       "/simulation/sampling"           ;
       "/simulation/stop_time"          ;
-      "/simulation/time_step"          ]
+      "/simulation/time_step"          ;
+      "/simulation/nucl_fitcusp_factor" ]
 

ocaml/Input.ml

@@ -1,4 +1,3 @@
-open Core.Std
 open Qptypes
 open Qputils
 
@@ -38,13 +37,13 @@ end = struct
 
   let to_string t =
     to_bool t
-    |> Bool.to_string
+    |> string_of_bool
 
 
   let of_string t =
     try
-      String.lowercase t
-      |> Bool.of_string 
+      String.lowercase_ascii t
+      |> bool_of_string 
       |> of_bool
     with
     | Invalid_argument msg -> failwith msg
@@ -66,81 +65,69 @@ end = struct
 
 end
 
-module Fitcusp : sig
 
-  type t = bool
+
+module Fitcusp_factor : sig
+
+  type t = float
   val doc   : string
   val read  : unit -> t
   val write : t -> unit
-  val to_bool : t -> bool
-  val of_bool : bool -> t
-  val to_int  : t -> int
-  val of_int  : int -> t
+  val to_float : t -> float
+  val of_float : float -> t
   val to_string : t -> string
   val of_string : string -> t
 
 end = struct
 
-  type t = bool
+  type t = float
 
-  let doc = "Correct wave function to verify electron-nucleus cusp condition"
+  let doc = "Correct wave function to verify electron-nucleus cusp condition. 
+Fit is done for r < r_c(f) where r_c(f) = (1s orbital radius) x f. Value of f"
 
-  let of_bool x = x 
+  let of_float x = 
+    if (x < 0.) then
+       failwith "Fitcusp_factor should be >= 0.";
+    if (x > 10.) then
+       failwith "Fitcusp_factor is too large.";
+    x 
 
-  let to_bool x = x 
+  let to_float x = x 
 
   let read () = 
-    let _ =
-      Lazy.force Qputils.ezfio_filename
-    in
-    if (not (Ezfio.has_simulation_do_nucl_fitcusp ())) then
-      Lazy.force Default.simulation_do_nucl_fitcusp
-      |> Ezfio.set_simulation_do_nucl_fitcusp ;
-    Ezfio.get_simulation_do_nucl_fitcusp ()
-    |> of_bool
+    ignore @@
+      Lazy.force Qputils.ezfio_filename ;
+    if (not (Ezfio.has_simulation_nucl_fitcusp_factor ())) then
+      begin
+        let factor =
+          Lazy.force Default.simulation_nucl_fitcusp_factor ;
+        in
+        Ezfio.set_simulation_nucl_fitcusp_factor factor
+      end ;
+    Ezfio.get_simulation_nucl_fitcusp_factor () 
+    |> of_float 
 
 
   let write t =
     let _ =
       Lazy.force Qputils.ezfio_filename
     in
-    let () =
-      match (Pseudo.read () |> Pseudo.to_bool, to_bool t) with
-      | (true, true) -> failwith "Pseudopotentials and Fitcusp are incompatible"
-      | _ -> ()
-    in
-    to_bool t
-    |> Ezfio.set_simulation_do_nucl_fitcusp
+    to_float t
+    |> Ezfio.set_simulation_nucl_fitcusp_factor 
 
 
   let to_string t =
-    to_bool t
-    |> Bool.to_string
+    to_float t
+    |> string_of_float 
 
 
   let of_string t =
     try
-      String.lowercase t
-      |> Bool.of_string 
-      |> of_bool
+      float_of_string t
+      |> of_float
     with
     | Invalid_argument msg -> failwith msg
 
-
-  let to_int t =
-    let t = 
-      to_bool t
-    in
-    if t then 1
-    else 0
-
-
-  let of_int = function
-    | 0 -> false
-    | 1 -> true
-    | _ -> failwith "Expected 0 or 1"
-
-
 end
 
 module Block_time : sig
@@ -193,21 +180,21 @@ end = struct
 
   let to_string t =
     to_int t
-    |> Int.to_string
+    |> string_of_int
 
 
   let of_string t =
-    Int.of_string t
+    int_of_string t
     |> of_int
 
 
   let to_float  t =
     to_int t
-    |> Float.of_int
+    |> float_of_int
 
 
   let of_float t =
-    Int.of_float t
+    int_of_float t
     |> of_int
 
 
@@ -260,11 +247,11 @@ end = struct
 
   let to_string t =
     to_int t
-    |> Int.to_string
+    |> string_of_int
 
 
   let of_string t =
-    Int.of_string t
+    int_of_string t
     |> of_int
 
 
@@ -317,11 +304,11 @@ end = struct
 
   let to_string t =
     to_int t
-    |> Int.to_string
+    |> string_of_int
 
 
   let of_string t =
-    Int.of_string t
+    int_of_string t
     |> of_int
 
 
@@ -376,21 +363,21 @@ end = struct
 
   let to_string t =
     to_int t
-    |> Int.to_string
+    |> string_of_int
 
 
   let of_string t =
-    Int.of_string t
+    int_of_string t
     |> of_int
 
 
   let to_float  t =
     to_int t
-    |> Float.of_int
+    |> float_of_int
 
 
   let of_float t =
-    Int.of_float t
+    int_of_float t
     |> of_int
 
 end
@@ -399,7 +386,7 @@ end
 
 module Method : sig
 
-  type t = VMC | DMC
+  type t = VMC | DMC | SRMC | FKMC | PDMC
   val doc : string
   val read  : unit -> t
   val write : t -> unit
@@ -408,19 +395,25 @@ module Method : sig
 
 end = struct
 
-  type t = VMC | DMC
+  type t = VMC | DMC | SRMC | FKMC | PDMC
 
-  let doc = "QMC Method : [ VMC | DMC ]"
+  let doc = "QMC Method : [ VMC | DMC | SRMC | FKMC | PDMC ]"
 
   let of_string = function
-  | "VMC" | "vmc" -> VMC
-  | "DMC" | "dmc" -> DMC
-  | x -> failwith ("Method should be [ VMC | DMC ], not "^x^".")
+  | "VMC"  | "vmc"  -> VMC
+  | "DMC"  | "dmc"  -> DMC
+  | "SRMC" | "srmc" -> SRMC
+  | "PDMC" | "pdmc" -> PDMC
+  | "FKMC" | "fkmc" -> FKMC
+  | x -> failwith ("Method should be [ VMC | DMC | SRMC | FKMC | PDMC ], not "^x^".")
 
 
   let to_string = function
   | VMC  -> "VMC"
   | DMC  -> "DMC"
+  | SRMC -> "SRMC"
+  | PDMC -> "PDMC"
+  | FKMC -> "FKMC"
 
 
   let read () = 
@@ -462,7 +455,7 @@ end = struct
   let doc = "Sampling algorithm : [ Langevin | Brownian ]"
 
   let of_string s = 
-    match String.capitalize (String.strip s) with
+    match String.capitalize_ascii (String.trim s) with
     | "Langevin" -> Langevin
     | "Brownian" -> Brownian
     | x -> failwith ("Sampling should be [ Brownian | Langevin ], not "^x^".")
@@ -496,6 +489,63 @@ end
 
 
 
+module Trial_wf_energy : sig
+
+  type t = float
+  val doc : string
+  val read  : unit -> t
+  val write : t -> unit
+  val to_float  : t -> float 
+  val of_float  : float -> t
+  val to_string : t -> string
+  val of_string : string -> t
+
+end = struct
+
+  type t = float
+  let doc = "Energy of the trial wave function (au)"
+
+  let of_float x = 
+    if (x > 0.) then
+      failwith "Reference energy should not be positive.";
+    if (x <= -1_000_000.) then
+      failwith "Reference energy is too low.";
+    x
+
+
+  let to_float x = x
+
+  let read () = 
+    let _ =
+      Lazy.force Qputils.ezfio_filename
+    in
+    if (not (Ezfio.has_simulation_e_trial ())) then
+      to_float 0.
+      |> Ezfio.set_simulation_e_trial;
+    Ezfio.get_simulation_e_trial ()
+    |> of_float
+
+
+  let write t =
+    let _ =
+      Lazy.force Qputils.ezfio_filename
+    in
+    to_float t
+    |> Ezfio.set_simulation_e_trial
+
+
+  let of_string x =
+     float_of_string x
+     |> of_float
+
+
+  let to_string x =
+    to_float x 
+    |> string_of_float
+
+
+end
+
 module Ref_energy : sig
 
   type t = float
@@ -542,13 +592,13 @@ end = struct
 
 
   let of_string x =
-     Float.of_string x
+     float_of_string x
      |> of_float
 
 
   let to_string x =
     to_float x 
-    |> Float.to_string 
+    |> string_of_float
 
 
 end
@@ -601,17 +651,17 @@ contribution to the norm less than t (au)"
 
 
   let of_string x =
-    Float.of_string x
+    float_of_string x
     |> of_float
 
 
   let to_string x =
     to_float x
-    |> Float.to_string 
+    |> string_of_float 
   
 end
 
-module DMC_projection_time : sig
+module SRMC_projection_time : sig
 
   type t = float
   val doc : string
@@ -625,13 +675,13 @@ module DMC_projection_time : sig
 end = struct
 
   type t = float
-  let doc = "DMC projection time (au)"
+  let doc = "SRMC projection time (au)"
 
   let of_float x = 
     if (x >= 100.) then
-      failwith "DMC Projection time should be < 100.";
+      failwith "SRMC Projection time should be < 100.";
     if (x <= 0.) then
-      failwith "DMC Projection time should be positive.";
+      failwith "SRMC Projection time should be positive.";
     x
 
 
@@ -641,10 +691,10 @@ end = struct
     let _ =
       Lazy.force Qputils.ezfio_filename
     in
-    if (not (Ezfio.has_simulation_dmc_projection_time())) then
-      Lazy.force Default.simulation_dmc_projection_time
-      |> Ezfio.set_simulation_dmc_projection_time ;
-    Ezfio.get_simulation_dmc_projection_time ()
+    if (not (Ezfio.has_simulation_srmc_projection_time())) then
+      Lazy.force Default.simulation_srmc_projection_time
+      |> Ezfio.set_simulation_srmc_projection_time ;
+    Ezfio.get_simulation_srmc_projection_time ()
     |> of_float
 
 
@@ -653,17 +703,17 @@ end = struct
       Lazy.force Qputils.ezfio_filename
     in
     to_float t
-    |> Ezfio.set_simulation_dmc_projection_time
+    |> Ezfio.set_simulation_srmc_projection_time
 
 
   let of_string x =
-    Float.of_string x
+    float_of_string x
     |> of_float
 
 
   let to_string x =
     to_float x
-    |> Float.to_string 
+    |> string_of_float 
 
 end
 
@@ -713,19 +763,19 @@ end = struct
 
 
   let of_string x =
-    Float.of_string x
+    float_of_string x
     |> of_float
 
 
   let to_string x =
     to_float x
-    |> Float.to_string 
+    |> string_of_float 
 
 end
 
 module Jastrow_type : sig
 
-  type t = None | Core | Simple
+  type t = None | Core | Simple | Mu
   val doc : string
   val read  : unit -> t
   val write : t -> unit
@@ -734,20 +784,22 @@ module Jastrow_type : sig
 
 end = struct
 
-  type t = None | Core | Simple
-  let doc = "Type of Jastrow factor [ None | Core | Simple ]"
+  type t = None | Core | Simple | Mu
+  let doc = "Type of Jastrow factor [ None | Core | Simple | Mu ]"
 
   let of_string s = 
-    match String.capitalize (String.strip s) with
+    match String.capitalize_ascii (String.trim  s) with
     | "Core" -> Core
     | "Simple" -> Simple
     | "None" -> None
-    | _ -> failwith "Jastrow type should be [ None | Core | Simple ]"
+    | "Mu" -> Mu
+    | _ -> failwith "Jastrow type should be [ None | Core | Simple | Mu ]"
 
 
   let to_string = function
   | Core -> "Core"
   | Simple -> "Simple"
+  | Mu -> "Mu"
   | None -> "None"
 
 
@@ -766,13 +818,6 @@ end = struct
     let _ =
       Lazy.force Qputils.ezfio_filename
     in
-    let () =
-      match (Pseudo.read () |> Pseudo.to_bool, t) with
-      | (false, _) 
-      | (true , None) -> ()
-      | _ -> failwith "Jastrow and Pseudopotentials are incompatible for now"
-    in
-
     to_string t
     |> Ezfio.set_jastrow_jast_type
 
@@ -797,31 +842,33 @@ end = struct
 
 
   let read () =
-    List.map Property.all ~f:(fun x -> (x, Property.calc x))
+    List.rev_map (fun x -> (x, Property.calc x)) Property.all 
+    |> List.rev
 
 
   let write l =
-    List.iter l ~f:(fun (x,b) -> Property.set_calc x b)
+    List.iter (fun (x,b) -> Property.set_calc x b) l
 
 
   let to_string l =
-    List.map l ~f:(fun (x,b) -> 
+    List.rev_map (fun (x,b) -> 
       let ch =
          if b then "X" else " "
       in
-      Printf.sprintf "(%s) %s" ch (Property.to_string x))
-    |> String.concat ~sep:"\n"
+      Printf.sprintf "(%s) %s" ch (Property.to_string x)) l
+    |> List.rev
+    |> String.concat "\n"
 
 
   let of_string s =
-    String.split s ~on:'\n'
-    |> List.map ~f:(fun x ->
+    String.split_on_char '\n' s 
+    |> List.rev_map (fun x ->
        let (calc,prop) = 
-         String.strip x
-         |> String.rsplit2_exn ~on:' '
+         String.trim x
+         |> String_ext.rsplit2_exn ~on:' '
        in
        let prop = 
-         String.strip prop 
+         String.trim prop 
          |> Property.of_string
        and calc =
          match calc with
@@ -831,6 +878,7 @@ end = struct
        in
        (prop, calc)
     )
+    |> List.rev
 
 end
 
@@ -851,10 +899,6 @@ let validate () =
      Sampling.read ()
   and ts =
      Time_step.read ()
-  and jast_type = 
-    Jastrow_type.read ()
-  and do_fitcusp =
-    Fitcusp.read ()
   and do_pseudo =
     Pseudo.read ()
   in
@@ -862,19 +906,19 @@ let validate () =
   (* Check sampling and time steps *)
   let () =
     match (sampling, meth, Pseudo.to_bool do_pseudo) with
-    | (Sampling.Brownian, Method.DMC, true) ->
-      if ( (Time_step.to_float ts) >= 0.5 ) then
-          warn "Time step seems large for DMC.";
-    | (Sampling.Brownian, Method.DMC, false) ->
-      if ( (Time_step.to_float ts) >= 0.01 ) then
-          warn "Time step seems large for DMC.";
     | (Sampling.Brownian, Method.VMC, _) -> 
       if ( (Time_step.to_float ts) >= 10. ) then
-          warn "Time step seems large for VMC.";
+          warn "Time step seems large for VMC."
     | (Sampling.Langevin, Method.VMC, _) -> 
       if ( (Time_step.to_float ts) <= 0.01 ) then
           warn "Time step seems small for Langevin sampling."
-    | (Sampling.Langevin, Method.DMC, _) ->
+    | (Sampling.Brownian, _, true) ->
+      if ( (Time_step.to_float ts) >= 0.5 ) then
+          warn ( "Time step seems large for "^(Method.to_string meth) )
+    | (Sampling.Brownian, _, false) ->
+      if ( (Time_step.to_float ts) >= 0.01 ) then
+          warn ( "Time step seems large for "^(Method.to_string meth) )
+    | (Sampling.Langevin, _, _) ->
         failwith "Lanvegin sampling is incompatible with DMC"
   in
 
@@ -882,7 +926,10 @@ let validate () =
   (* Check E_ref is not zero *)
   let () =
     match (meth, Ref_energy.(read () |> to_float) ) with
-    | (Method.DMC,0.) -> failwith "E_ref should not be zero in DMC"
+    | (Method.SRMC,0.) 
+    | (Method.PDMC,0.) 
+    | (Method.FKMC,0.) 
+    | (Method.DMC,0.) -> failwith ("E_ref should not be zero in "^(Method.to_string meth) )
     | _          -> ()
   in
 
@@ -895,26 +942,31 @@ let validate () =
   (* Check if E_loc if computed *)
   let () =
     match (meth, Property.(calc E_loc)) with
-    | (Method.DMC, false) -> failwith "E_loc should be sampled in DMC"
+    | (Method.SRMC, false) 
+    | (Method.PDMC, false) 
+    | (Method.FKMC, false) 
+    | (Method.DMC, false) -> failwith ( "E_loc should be sampled in "^(Method.to_string meth) )
     | (Method.VMC, false) -> warn "Sampling of E_loc is not activated in input"
     | _ -> ()
   in
 
-  (* Pseudo and Jastrow are incompatible *)
-  let () = 
-    match (Pseudo.to_bool do_pseudo, jast_type) with
-    | (true, Jastrow_type.Core  ) 
-    | (true, Jastrow_type.Simple) -> failwith "Jastrow and Pseudopotentials are incompatible"
-    | _ -> ()
-  in
-
-  (* Fitcusp is not recommended with pseudo *)
+  (* Fitcusp is incompatible with pseudo *)
   let () =
-    match (Pseudo.to_bool do_pseudo, Fitcusp.to_bool do_fitcusp) with
-    | (true, true) -> warn "Fitcusp is incompatible with Pseudopotentials"
+    let f = 
+      Fitcusp_factor.read ()
+      |> Fitcusp_factor.to_float
+    in
+    match (Pseudo.to_bool do_pseudo, f > 0.) with
+    | (true, true) ->
+      begin
+        warn "Electron-nucleus cusp fitting is incompatible with Pseudopotentials.";
+        Fitcusp_factor.of_float 0.
+        |> Fitcusp_factor.write
+      end
     | _ -> ()
   in
 
+  
   (* Other Checks *)
   let () =
     let _ =

ocaml/Launcher.ml

@@ -1,5 +1,3 @@
-open Core.Std;;
-
 type t =
   | Srun
   | MPI
@@ -8,7 +6,21 @@ type t =
 let to_string = function
   | Srun     -> "srun"
   | Bash     -> "env"
-  | MPI      -> Lazy.force Qmcchem_config.mpirun
+  | MPI      -> String.concat " " [ Lazy.force Qmcchem_config.mpirun ;
+                    try Sys.getenv "QMCCHEM_MPIRUN_FLAGS"  with Not_found -> ""
+                  ]
+
+(*
+let to_string = function
+  | MPI
+  | Srun     -> String.concat ~sep:" " [ Lazy.force Qmcchem_config.mpirun ;
+      match Sys.getenv "QMCCHEM_MPIRUN_FLAGS" with
+      | None -> ""
+      | Some p -> p
+    ]
+  | Bash     -> "env"
+  *)
+
 
 
 (** Find the launcher for the current job scheduler *)
@@ -40,19 +52,21 @@ let create_nodefile () =
   in
 
   let h =
-    Hashtbl.create ~hashable:String.hashable ~size:1000 ()
+    Hashtbl.create 1000
   in
 
   let in_channel =
     Unix.open_process_in (launcher_command^" hostname -s")
   in
-  In_channel.input_lines in_channel
-  |> List.map  ~f:String.strip
-  |> List.iter ~f:( fun host ->
-       Hashtbl.change h host (function
-        | Some x -> Some (x+1)
-        | None -> Some 1
-       )
+  String_ext.input_lines in_channel
+  |> List.map  String.trim
+  |> List.iter ( fun host ->
+       let n = 
+          match Hashtbl.find_opt h host with
+          | Some x -> x+1
+          | None -> 1
+       in
+       Hashtbl.replace h host n
      );
   match
     Unix.close_process_in in_channel
@@ -70,9 +84,8 @@ let create_nodefile () =
         fun (node, n) ->
             Printf.sprintf "%s %d\n" node n
   in
-  Hashtbl.to_alist h
-  |> List.map ~f
-  |> String.concat  
+  Hashtbl.fold (fun k v a -> (f (k,v)) :: a) h []
+  |> String.concat "\n"
 
 
 

ocaml/Makefile

@@ -0,0 +1,59 @@
+.NOPARALLEL:
+
+# Check if QMCCHEM_PATH is defined
+ifndef QMCCHEM_PATH
+$(info  -------------------- Error --------------------)
+$(info  QMCCHEM_PATH undefined. Source the qmcchem.rc script)
+$(info  -----------------------------------------------)
+$(error )
+endif
+
+
+LIBS=
+PKGS=
+OCAMLCFLAGS="-g"
+OCAMLOPTFLAGS="opt -O3 -remove-unused-arguments -rounds 16 -inline 100 -inline-max-unroll 100"
+OCAMLBUILD=ocamlbuild -j 0 -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS) -ocamlopt $(OCAMLOPTFLAGS)
+MLLFILES=$(wildcard *.mll) 
+MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml 
+MLIFILES=$(wildcard *.mli) 
+ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
+ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qmcchem.native
+
+.PHONY: default 
+
+
+default: $(ALL_EXE) 
+
+tests: $(ALL_TESTS) 
+
+
+%.inferred.mli: $(MLFILES)
+	$(OCAMLBUILD) $*.inferred.mli -use-ocamlfind  $(PKGS) 
+	mv _build/$*.inferred.mli .
+
+%.byte: $(MLFILES) $(MLIFILES)
+	rm -f -- $*
+	$(OCAMLBUILD) $*.byte  -use-ocamlfind  $(PKGS)
+	ln -s $*.byte $*
+
+%.native: $(MLFILES) $(MLIFILES)
+	rm -f -- $*
+	$(OCAMLBUILD) $*.native -use-ocamlfind $(PKGS)
+	ln -s $*.native $*
+
+ezfio.ml: ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml
+	cp ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml .
+
+qptypes_generator.byte: qptypes_generator.ml
+	$(OCAMLBUILD) qptypes_generator.byte  -use-ocamlfind 
+
+Qptypes.ml: qptypes_generator.byte
+	./qptypes_generator.byte > Qptypes.ml
+
+${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml: 
+	${MAKE) -C ${QMCCHEM_PATH}/EZFIO/
+
+clean: 
+	rm -rf _build Qptypes.ml $(ALL_EXE) $(ALL_TESTS)
+

ocaml/Message.ml

@@ -1,126 +1,141 @@
-open Core.Std
 open Qptypes
 
 type t =
-| Property    of Block.t
-| Walkers     of Compute_node.t * Pid.t * (float array) array
-| Register    of Compute_node.t * Pid.t
-| Unregister  of Compute_node.t * Pid.t
-| Test
-| GetWalkers  of Strictly_positive_int.t
-| Ezfio       of string
+  | Property    of Block.t
+  | Walkers     of Compute_node.t * int * (float array) array
+  | Register    of Compute_node.t * int
+  | Unregister  of Compute_node.t * int
+  | Test
+  | GetWalkers  of Strictly_positive_int.t
+  | Ezfio       of string
+  | Error       of string
 
 
-let create = function 
-  | [ "cpu"        ; c ; pid ; b ; "1" ; v ] ->
-      let open Block in
-          Property
-          { property     = Property.Cpu;
-            value        = Sample.of_float (Float.of_string v) ;
-            weight       = Weight.of_float 1.;
-            compute_node = Compute_node.of_string c;
-            pid          = Pid.of_string pid;
-            block_id     = Block_id.of_int (Int.of_string b);
-          } 
-  | [ "accep" ; c ; pid ; b ; "1" ; v ] ->
-      let open Block in
-          Property
-          { property     = Property.Accep;
-            value        = Sample.of_float (Float.of_string v) ;
-            weight       = Weight.of_float 1.;
-            compute_node = Compute_node.of_string c;
-            pid          = Pid.of_string pid;
-            block_id     = Block_id.of_int (Int.of_string b);
-          } 
-  | [ prop ; c ; pid ; b ; w ; v ] ->  
-      let open Block in
-          Property
-          { property     = Property.of_string prop;
-            value        = Sample.of_float (Float.of_string v);
-            weight       = Weight.of_float (Float.of_string w);
-            compute_node = Compute_node.of_string c;
-            pid          = Pid.of_string pid;
-            block_id     = Block_id.of_int (Int.of_string b);
-          } 
-  | "elec_coord" :: c :: pid :: _ :: n ::walkers ->
-    begin
-      let walk_num =
-        Lazy.force Qputils.walk_num
-      and elec_num =
-        Lazy.force Qputils.elec_num
-      and n = 
-        Int.of_string n
-      in
-      assert (n = List.length walkers);
-      assert (n = walk_num*(elec_num+1)*3);
-      let rec build_walker accu = function
-      | (0,tail) -> 
-          let result = 
-            List.rev accu 
-            |> List.map ~f:Float.of_string
-            |> Array.of_list
-          in
-          (result, tail)
-      | (n,head::tail)  ->
-          build_walker (head::accu) (n-1, tail)
-      | _ -> failwith "Bad walkers"
-      in
-      let rec build accu = function  
-      | [] -> Array.of_list accu
-      | w -> 
-        let (result, tail) = 
-          build_walker [] (3*elec_num+3, w)
-        in
-        build (result::accu) tail
-      in
-      Walkers (Compute_node.of_string c, Pid.of_string pid, build [] walkers)
-    end
-  | [ "get_walkers" ; n ] -> GetWalkers (n |> Int.of_string |> Strictly_positive_int.of_int)
-  | [ "register"   ; c ; pid  ] -> Register   (Compute_node.of_string c, Pid.of_string pid)
-  | [ "unregister" ; c ; pid  ] -> Unregister (Compute_node.of_string c, Pid.of_string pid)
-  | [ "Test" ] -> Test
-  | [ "Ezfio" ; ezfio_msg ] -> Ezfio ezfio_msg
-  | prop :: c :: pid :: b :: d :: w :: l -> 
-      let property =
-        Property.of_string prop
-      in
-      begin
-        assert (not (Property.is_scalar property));
-        let a = 
-          Array.of_list l
-          |> Array.map ~f:Float.of_string
-        and dim =
-          Int.of_string d
-        in
-        assert (Array.length a = dim);
+let of_string_list m =
+  try
+    match m with
+    | [ "cpu"        ; c ; pid ; b ; "1" ; v ] ->
         let open Block in
-          Property
-          { property     = property ;
-            value        = Sample.of_float_array ~dim a;
-            weight       = Weight.of_float (Float.of_string w);
-            compute_node = Compute_node.of_string c;
-            pid          = Pid.of_string pid;
-            block_id     = Block_id.of_int (Int.of_string b);
-          } 
-      end
-  | l -> 
+            Property
+            { property     = Property.Cpu;
+              value        = Sample.of_float (float_of_string v) ;
+              weight       = Weight.of_float 1.;
+              compute_node = Compute_node.of_string c;
+              pid          = int_of_string pid;
+              block_id     = Block_id.of_int (int_of_string b);
+            }
+    | [ "accep" ; c ; pid ; b ; "1" ; v ] ->
+        let open Block in
+            Property
+            { property     = Property.Accep;
+              value        = Sample.of_float (float_of_string v) ;
+              weight       = Weight.of_float 1.;
+              compute_node = Compute_node.of_string c;
+              pid          = int_of_string pid;
+              block_id     = Block_id.of_int (int_of_string b);
+            }
+    | [ prop ; c ; pid ; b ; w ; v ] ->
+        let open Block in
+            Property
+            { property     = Property.of_string prop;
+              value        = Sample.of_float (float_of_string v);
+              weight       = Weight.of_float (float_of_string w);
+              compute_node = Compute_node.of_string c;
+              pid          = int_of_string pid;
+              block_id     = Block_id.of_int (int_of_string b);
+            }
+    | "elec_coord" :: c :: pid :: _ :: n ::walkers ->
       begin
-        List.iter ~f:(Printf.printf  ":%s:") l;
-        failwith "Message not understood"
+        let elec_num =
+          Lazy.force Qputils.elec_num
+        and n =
+          int_of_string n
+        in
+        assert (n = List.length walkers);
+        let rec build_walker accu = function
+        | (0,tail) ->
+            let result =
+              List.rev accu
+              |> List.rev_map float_of_string
+              |> List.rev
+              |> Array.of_list
+            in
+            (result, tail)
+        | (n,head::tail)  ->
+            build_walker (head::accu) (n-1, tail)
+        | _ -> failwith "Bad walkers"
+        in
+        let rec build accu = function
+        | [] -> Array.of_list accu
+        | w ->
+          let (result, tail) =
+            build_walker [] (3*elec_num+3, w)
+          in
+          build (result::accu) tail
+        in
+        Walkers (Compute_node.of_string c, int_of_string pid, build [] walkers)
       end
+    | [ "get_walkers" ; n ] -> GetWalkers (n |> int_of_string |> Strictly_positive_int.of_int)
+    | [ "register"   ; c ; pid  ] -> Register   (Compute_node.of_string c, int_of_string pid)
+    | [ "unregister" ; c ; pid  ] -> Unregister (Compute_node.of_string c, int_of_string pid)
+    | [ "Test" ] -> Test
+    | [ "Ezfio" ; ezfio_msg ] -> Ezfio ezfio_msg
+    | prop :: c :: pid :: b :: d :: w :: "bin" :: block :: [] ->
+        (* Block in binary format *)
+        let property =
+          Property.of_string prop
+        in
+        begin
+          assert (not (Property.is_scalar property));
+          match Block.of_bytes ~idx:8 (Bytes.unsafe_of_string block)  with
+          | Some block -> Property block
+          | None -> failwith "Invalid block"
+        end
+    | prop :: c :: pid :: b :: d :: w :: l ->
+        (* Bock in text format *)
+        let property =
+          Property.of_string prop
+        in
+        begin
+          assert (not (Property.is_scalar property));
+          let a =
+            Array.of_list l
+            |> Array.map float_of_string
+          and dim =
+            int_of_string d
+          in
+          assert (Array.length a = dim);
+          let open Block in
+            Property
+            { property     = property ;
+              value        = Sample.of_float_array ~dim a;
+              weight       = Weight.of_float (float_of_string w);
+              compute_node = Compute_node.of_string c;
+              pid          = int_of_string pid;
+              block_id     = Block_id.of_int (int_of_string b);
+            }
+        end
+    | l -> Error (String.concat ":" l)
+  with
+  | Assert_failure (l,_,_) -> Error l
+  | _ -> Error "Unknown error"
+
 
 
 let to_string = function
   | Property   b         -> "Property   : "^(Block.to_string b)
-  | Walkers    (h,p,w)   -> Printf.sprintf "Walkers      : %s %s : %d walkers"
-      (Compute_node.to_string h) (Pid.to_string p)
-      (Array.length w)
+  | Walkers    (h,p,w)   -> Printf.sprintf "Walkers      : %s %d : %d walkers"
+                              (Compute_node.to_string h) p (Array.length w)
   | GetWalkers n         -> Printf.sprintf "GetWalkers %d" (Strictly_positive_int.to_int n)
-  | Register   (h,p)     -> Printf.sprintf "Register   : %s %s" 
-      (Compute_node.to_string h) (Pid.to_string p)
-  | Unregister (h,p)     -> Printf.sprintf "Unregister   : %s %s" 
-      (Compute_node.to_string h) (Pid.to_string p)
+  | Register   (h,p)     -> Printf.sprintf "Register   : %s %d"
+                              (Compute_node.to_string h) p
+  | Unregister (h,p)     -> Printf.sprintf "Unregister   : %s %d"
+                              (Compute_node.to_string h) p
   | Test                 -> "Test"
   | Ezfio msg            -> "Ezfio "^msg
+  | Error msg            -> "Error "^msg
 
 
+let create m =
+   of_string_list m
+

ocaml/QmcMd5.ml

@@ -1,5 +1,3 @@
-open Core.Std
-
 (** Directory containing the list of input files. The directory is created is inexistant. *)
 let input_directory = lazy (
 
@@ -12,9 +10,8 @@ let input_directory = lazy (
   in
 
   begin
-    match ( Sys.is_directory dirname ) with
-    | `No  -> Unix.mkdir  dirname
-    | _    -> ()
+    if not (Sys.file_exists dirname) then 
+      Unix.mkdir dirname 0o777
   end ;
 
   dirname
@@ -37,10 +34,9 @@ let files_to_track = [
   "mo_basis/mo_tot_num" ;
   "nuclei/nucl_charge.gz" ;
   "nuclei/nucl_coord.gz" ;
-  "nuclei/nucl_fitcusp_radius.gz" ;
   "nuclei/nucl_num" ;
   "simulation/ci_threshold" ;
-  "simulation/do_nucl_fitcusp" ;
+  "simulation/nucl_fitcusp_factor" ;
   "simulation/jast_a_up_dn" ;
   "simulation/jast_a_up_up" ;
   "simulation/jast_b_up_dn" ;
@@ -84,15 +80,18 @@ let files_to_track = [
 
 (** Get an MD5 ke from the content of a file. *)
 let hash_file filename =
-  match Sys.is_file filename with
-  | `Yes -> 
+  if Sys.file_exists filename then
     begin
-      In_channel.with_file filename ~f:(fun ic ->
+      let ic = open_in filename in
+      let result = 
         Cryptokit.hash_channel (Cryptokit.Hash.md5 ()) ic
-        |> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) )
+        |> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) 
+      in
+      close_in ic;
+      result
     end
-  | _ -> ""
-
+  else ""
+  
 
 (** Cache containing the current value of the MD5 hash. *)
 let _hash = 
@@ -110,12 +109,17 @@ let hash () =
       else
          ""
     in
-    let new_md5 = files_to_track
-    |> List.map ~f:(fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
-    |> List.map ~f:hash_file
-    |> String.concat
-    |> Cryptokit.hash_string (Cryptokit.Hash.md5 ()) 
-    |> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) 
+    let md5_string = 
+      files_to_track
+      |> List.rev_map (fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
+      |> List.rev_map hash_file
+      |> String.concat ""
+    in
+
+    let new_md5 = 
+      md5_string
+      |> Cryptokit.hash_string (Cryptokit.Hash.md5 ()) 
+      |> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) 
     in
     if (new_md5 <> old_md5) then
       begin

ocaml/Qmcchem_config.ml

@@ -1,22 +1,18 @@
-open Core.Std;;
-
 
 (** QMC=Chem installation directory *)
 let root = lazy (
-  match ( Sys.getenv "QMCCHEM_PATH" ) with
-  | Some x -> x
-  | None   -> failwith "QMCCHEM_PATH environment variable not set"
+  try Sys.getenv "QMCCHEM_PATH" with
+  | Not_found -> failwith "QMCCHEM_PATH environment variable not set"
 )
 
 
 (* PATH environment variable as a list of strings *)
 let path =  lazy (
-  let p = 
-    match Sys.getenv "PATH" with
-    | None -> failwith "PATH environment variable is not set"
-    | Some p -> p
-  in 
-  String.split ~on:':' p
+  let p =
+    try Sys.getenv "PATH" with
+    | Not_found -> failwith "PATH environment variable is not set"
+  in
+  String.split_on_char ':' p
 )
 
 
@@ -27,12 +23,13 @@ let full_path exe =
   | [] -> None
   | head :: tail ->
     begin
-      let fp = 
-        Filename.concat head exe 
+      let fp =
+        Filename.concat head exe
       in
-      match (Sys.is_file fp) with
-      | `Yes -> Some fp
-      | _    -> in_path_rec tail
+      if Sys.file_exists fp then
+        Some fp
+      else
+        in_path_rec tail
     end
   in
   Lazy.force path
@@ -42,7 +39,7 @@ let full_path exe =
 
 (* True if an executable is in the PATH *)
 let in_path x =
-   match (full_path x) with
+   match full_path x with
    | Some _ -> true
    | None   -> false
 
@@ -51,13 +48,13 @@ let has_parallel   = lazy( in_path "parallel" )
 let has_mpirun     = lazy( in_path "mpirun"   )
 let has_srun       = lazy( in_path "parallel" )
 let has_qmc        = lazy( in_path "qmc"      )
-let has_qmc_mic    = lazy( in_path "qmc_mic"  )
 
 
 let mpirun = lazy (
-    match Sys.getenv "QMCCHEM_MPIRUN" with
-    | None -> "mpirun"
-    | Some p -> p
+    try
+      Sys.getenv "QMCCHEM_MPIRUN"
+    with
+    | Not_found -> "mpirun"
 )
 
 let qmcchem = lazy(
@@ -69,9 +66,7 @@ and qmc = lazy(
 and qmcchem_info = lazy(
   Filename.concat (Lazy.force root) "bin/qmcchem_info"
 )
-and qmc_mic = lazy(
-  Filename.concat (Lazy.force root) "bin/qmc_mic"
-)
+
 and qmc_create_walkers = lazy(
   Filename.concat (Lazy.force root) "bin/qmc_create_walkers"
 )
@@ -83,33 +78,46 @@ let hostname = lazy (
   try
     Unix.gethostname ()
   with
-  | _ -> "localhost"
+  | _ -> "127.0.0.1"
 )
 
 
+external get_ipv4_address_for_interface : string -> string =
+  "get_ipv4_address_for_interface"
+
+
 let ip_address = lazy (
-  match Sys.getenv "QMCCHEM_NIC" with
-  | None -> 
+  let interface =
+    try Some (Sys.getenv "QMCCHEM_NIC")
+    with Not_found -> None
+  in
+  match interface with
+  | None ->
       begin
         try
-          Lazy.force hostname
-          |> Unix.Inet_addr.of_string_or_getbyname
-          |> Unix.Inet_addr.to_string
+          let host =
+            Lazy.force hostname
+            |> Unix.gethostbyname
+          in
+          Unix.string_of_inet_addr host.h_addr_list.(0);
         with
         | Unix.Unix_error _ ->
             failwith "Unable to find IP address from host name."
       end
   | Some interface ->
-      begin
-        try
-          ok_exn Linux_ext.get_ipv4_address_for_interface interface
-        with
-        | Unix.Unix_error _ ->
-            Lazy.force hostname
-            |> Unix.Inet_addr.of_string_or_getbyname
-            |> Unix.Inet_addr.to_string
-      end
+        let result = get_ipv4_address_for_interface interface in
+        if String.sub result 0 5 = "error" then
+          Printf.sprintf "Unable to use network interface %s" interface
+          |> failwith
+        else
+          result
 )
 
 
 
+let binary_io =
+  try
+    let qmcchem_io = Sys.getenv "QMCCHEM_IO" in
+    qmcchem_io = "B" || qmcchem_io = "b"
+  with Not_found -> false
+

ocaml/Qmcchem_debug.ml

@@ -1,32 +1,29 @@
-open Core.Std
+let run ~t ezfio_filename=
 
-
-let run ~t filename=
-
-  Ezfio.set_file filename;
+  Qputils.set_ezfio_filename ezfio_filename;
 
   if (not (Ezfio.has_simulation_http_server ())) then
      failwith "QMC=Chem is not running"
   ;
 
   let zmq_context =
-    ZMQ.Context.create ()
+    Zmq.Context.create ()
   in
 
-  Printf.printf "Debugging %s\n%!" filename;
+  Printf.printf "Debugging %s\n%!" ezfio_filename;
   let socket =
-    ZMQ.Socket.create zmq_context ZMQ.Socket.sub
+    Zmq.Socket.create zmq_context Zmq.Socket.sub
   in
 
   let address = 
     match (Ezfio.get_simulation_http_server ()
-        |> String.rsplit2 ~on:':' )
+        |> String_ext.rsplit2 ~on:':' )
     with
-    | Some (a,p) -> a^":"^( (Int.of_string p)+4 |> Int.to_string )
+    | Some (a,p) -> a^":"^( (int_of_string p)+4 |> string_of_int )
     | None -> failwith "Badly formed address"
   in
-  ZMQ.Socket.connect socket address;
-  ZMQ.Socket.subscribe socket "";
+  Zmq.Socket.connect socket address;
+  Zmq.Socket.subscribe socket "";
 
   if t then
       begin
@@ -34,22 +31,22 @@ let run ~t filename=
            Str.regexp " *: *"
         in
         let tot_size = 
-          ref (Byte_units.create `Bytes 0.)
+          ref 0.
         in
         while true
         do
           let msg = 
-            ZMQ.Socket.recv socket
+            Zmq.Socket.recv socket
           in
           let (socket, bytes)  =
             match Str.split re_split msg with
             |  socket :: bytes :: _ ->
-                (socket, Byte_units.create `Bytes (Float.of_string bytes))
-            | _ -> (print_endline msg ; ("", Byte_units.create `Bytes 0.))
+                (socket, float_of_string bytes)
+            | _ -> (print_endline msg ; ("", 0.))
           in
-          tot_size := Byte_units.create `Bytes ((Byte_units.bytes !tot_size) +. (Byte_units.bytes bytes));
-          Printf.printf "%s\n%!" (Byte_units.to_string !tot_size);
-          Time.pause (Time.Span.of_float 1.)
+          tot_size := !tot_size +. bytes;
+          Printf.printf "%f\n%!" !tot_size;
+          Unix.sleep 1
         done
       end
   else
@@ -57,7 +54,7 @@ let run ~t filename=
         while true
         do
           let msg = 
-            ZMQ.Socket.recv socket
+            Zmq.Socket.recv socket
           in
           Printf.printf "%s\n%!" msg;
         done
@@ -65,20 +62,29 @@ let run ~t filename=
 
 
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> flag "t" no_arg 
-     ~doc:"Measure the throughput"
-  +> anon ("filename" %: string)
+let command () =
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Debug ZeroMQ communications";
+    [ { short='t' ; long="traffic" ; opt=Optional ;
+        doc="Print traffic in bytes" ;
+        arg=Without_arg } ;
+
+        anonymous "EZFIO_DIR" Mandatory "EZFIO directory" ]
+    |> set_specs
+  end;
+
+  let t = Command_line.get_bool "traffic" in
+  let ezfio_file =
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
+
+  run t ezfio_file
 
 
-let command = 
-  Command.basic
-  ~summary: "Debug ZeroMQ communications"
-  ~readme:(fun () -> "Gets debug information from the ZMQ debug sockets.")
-  spec
-  (fun t filename () -> run t filename)
 
 
 

ocaml/Qmcchem_edit.ml

@@ -1,5 +1,3 @@
-open Core.Std
-
 let file_header filename = Printf.sprintf
 "
 +----------------------------------------------------------------+
@@ -12,7 +10,7 @@ Editing file `%s`
 
 let make_header s =
   let l = String.length s in
-  "\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n"
+  "\n\n"^s^"\n"^(String.init l (fun _ -> '='))^"\n\n"
 
 
 type field = 
@@ -20,13 +18,14 @@ type field =
  | Walk_num
  | Walk_num_tot
  | Stop_time
- | Fitcusp
+ | Fitcusp_factor
  | Method
  | Sampling
  | Ref_energy
+ | Trial_wf_energy
  | CI_threshold
  | Time_step
- | DMC_projection_time 
+ | SRMC_projection_time 
  | Jastrow_type
  | Properties
 
@@ -54,20 +53,22 @@ let get field =
    option_to_string Walk_num_tot.read Walk_num_tot.to_string Walk_num_tot.doc  
  | Stop_time    ->
    option_to_string Stop_time.read    Stop_time.to_string    Stop_time.doc  
- | Fitcusp      ->
-   option_to_string Fitcusp.read      Fitcusp.to_string      Fitcusp.doc
+ | Fitcusp_factor ->
+   option_to_string Fitcusp_factor.read      Fitcusp_factor.to_string      Fitcusp_factor.doc
  | Method       ->
    option_to_string Method.read       Method.to_string       Method.doc  
  | Sampling     ->
    option_to_string Sampling.read     Sampling.to_string     Sampling.doc  
  | Ref_energy   ->
    option_to_string Ref_energy.read   Ref_energy.to_string   Ref_energy.doc  
+ | Trial_wf_energy ->
+   option_to_string Trial_wf_energy.read   Trial_wf_energy.to_string   Trial_wf_energy.doc  
  | CI_threshold ->                    
    option_to_string CI_threshold.read   CI_threshold.to_string   CI_threshold.doc  
  | Time_step    ->                    
    option_to_string Time_step.read    Time_step.to_string    Time_step.doc  
- | DMC_projection_time ->             
-   option_to_string DMC_projection_time.read    DMC_projection_time.to_string   DMC_projection_time.doc 
+ | SRMC_projection_time ->             
+   option_to_string SRMC_projection_time.read SRMC_projection_time.to_string SRMC_projection_time.doc 
  | Jastrow_type ->                    
    option_to_string Jastrow_type.read Jastrow_type.to_string Jastrow_type.doc  
  | Properties   ->                    
@@ -81,31 +82,31 @@ let create_temp_file ?temp_filename ezfio_filename fields =
     | None -> Filename.temp_file "qmcchem_edit_" ".rst"
     | Some name -> name
   in
-  Out_channel.with_file filename ~f:(fun out_channel ->
-      (file_header ezfio_filename) :: (List.map ~f:get fields)
-      |> String.concat ~sep:"\n"
-      |> Out_channel.output_string out_channel
-    )
+  let out_channel = open_out filename in
+  (file_header ezfio_filename) :: (List.rev @@ List.rev_map get fields)
+  |> String.concat "\n"
+  |> output_string out_channel
+  ; close_out out_channel
   ; filename
 
 
 (** Write the input file corresponding to the MD5 key *)
 let write_input_in_ezfio  ezfio_filename  fields =
   let dirname = 
-    Lazy.force  Md5.input_directory
+    Lazy.force  QmcMd5.input_directory
   in
   let temp_filename = 
-    Md5.hash ()
+    QmcMd5.hash ()
     |> Filename.concat  dirname
   in
   let input_filename =
     create_temp_file  ~temp_filename  ezfio_filename  fields
   in
-  assert (Sys.file_exists_exn  input_filename)
+  assert (Sys.file_exists  input_filename)
 
 
 (** Run the edit command *)
-let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
+let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
 
   let interactive = ref (
     if c then
@@ -116,10 +117,7 @@ let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
   in
 
   (* Open EZFIO *)
-  if (not (Sys.file_exists_exn ezfio_filename)) then
-    failwith (ezfio_filename^" does not exist");
-
-  Ezfio.set_file ezfio_filename;
+  Qputils.set_ezfio_filename ezfio_filename;
 
   let handle_option (type_conv, write) x =
     let () =
@@ -133,19 +131,20 @@ let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
     in ();
   in
 
-  handle_option   Input.Ref_energy.(of_float , write) e;
-  handle_option Input.Jastrow_type.(of_string, write) j;
-  handle_option   Input.Block_time.(of_int   , write) l;
-  handle_option       Input.Method.(of_string, write) m;
-  handle_option    Input.Stop_time.(of_int   , write) t;
-  handle_option     Input.Sampling.(of_string, write) s;
-  handle_option      Input.Fitcusp.(of_int   , write) f;
-  handle_option    Input.Time_step.(of_float , write) ts;
-  handle_option     Input.Walk_num.(of_int   , write) w;
-  handle_option Input.Walk_num_tot.(of_int   , write) wt;
-  handle_option Input.CI_threshold.(of_float , write) n;
-  handle_option Input.DMC_projection_time.(of_float , write) p;
-
+  handle_option      Input.Ref_energy.(of_string, write) e;
+  handle_option Input.Trial_wf_energy.(of_string, write) et;
+  handle_option    Input.Jastrow_type.(of_string, write) j;
+  handle_option      Input.Block_time.(of_string, write) l;
+  handle_option          Input.Method.(of_string, write) m;
+  handle_option       Input.Stop_time.(of_string, write) t;
+  handle_option        Input.Sampling.(of_string, write) s;
+  handle_option  Input.Fitcusp_factor.(of_string, write) f;
+  handle_option       Input.Time_step.(of_string, write) ts;
+  handle_option        Input.Walk_num.(of_string, write) w;
+  handle_option    Input.Walk_num_tot.(of_string, write) wt;
+  handle_option    Input.CI_threshold.(of_string, write) n;
+  handle_option Input.SRMC_projection_time.(of_string, write) p;
+                 
 
   let fields = 
    [ 
@@ -154,11 +153,12 @@ let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
       Method               ;
       Sampling             ;
       Time_step            ;
-      DMC_projection_time  ;
+      SRMC_projection_time  ;
       Ref_energy           ;
+      Trial_wf_energy      ;
       Walk_num             ;
       Walk_num_tot         ;
-      Fitcusp              ;
+      Fitcusp_factor       ;
       CI_threshold         ;
       Jastrow_type         ;
       Properties           ;
@@ -177,21 +177,24 @@ let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
             if (not !interactive) then
                failwith "Input file not allowed with command line arguments"
             else
-              begin
+              let rc = 
                 Printf.sprintf "cp %s %s" filename temp_filename
-                |> Sys.command_exn ;
-              end
+                |> Sys.command 
+              in
+              assert (rc = 0)
           end
         | None          -> 
           begin
             (* Open the temp file with external editor *)
             let editor =
-              match Sys.getenv "EDITOR" with
-              | Some editor -> editor
-              | None -> "vi"
+              try Sys.getenv "EDITOR" with
+              | Not_found -> "vi"
             in
-            Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename 
-            |> Sys.command_exn 
+            let rc = 
+              Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename 
+              |> Sys.command
+            in
+            assert (rc = 0)
           end
       in
      
@@ -201,38 +204,42 @@ let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
       and re_prop =
          Str.regexp "([ xX]) .*$"
       and raw_data =
-        In_channel.with_file temp_filename ~f:In_channel.input_lines
+        let ic = open_in temp_filename in
+        let result = String_ext.input_lines ic in
+        close_in ic ; result
       in
       let data = 
-        ( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0)
-          |> List.map ~f:String.strip ) @
+        ( List.filter (fun x -> Str.string_match re_data x 0) raw_data
+          |> List.rev_map String.trim |> List.rev ) @
         [
-        List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0)
-        |> List.map ~f:String.strip
-        |> String.concat ~sep:"\n" ]
+        List.filter (fun x -> Str.string_match re_prop x 0) raw_data 
+        |> List.rev_map String.trim
+        |> List.rev
+        |> String.concat "\n" ]
       in
       let open Input in
-      List.iter2_exn data fields ~f:(fun s f -> 
+      List.iter2 (fun s f -> 
        try 
          begin
             match f with
-            |  Stop_time            ->  Stop_time.(of_string            s  |>  write)
-            |  Fitcusp              ->  Fitcusp.(of_string              s  |>  write)
-            |  Block_time           ->  Block_time.(of_string           s  |>  write)
-            |  Method               ->  Method.(of_string               s  |>  write)
-            |  Ref_energy           ->  Ref_energy.(of_string           s  |>  write)
-            |  Sampling             ->  Sampling.(of_string             s  |>  write)
-            |  Time_step            ->  Time_step.(of_string            s  |>  write)
-            |  DMC_projection_time  ->  DMC_projection_time.(of_string  s  |>  write)
-            |  Walk_num             ->  Walk_num.(of_string             s  |>  write)
-            |  Walk_num_tot         ->  Walk_num_tot.(of_string         s  |>  write)
-            |  CI_threshold         ->  CI_threshold.(of_string         s  |>  write)
-            |  Jastrow_type         ->  Jastrow_type.(of_string         s  |>  write)
-            |  Properties           ->  Properties.(of_string           s  |>  write)
+            |  Stop_time             ->  Stop_time.(of_string            s  |>  write)
+            |  Fitcusp_factor        ->  Fitcusp_factor.(of_string       s  |>  write)
+            |  Block_time            ->  Block_time.(of_string           s  |>  write)
+            |  Method                ->  Method.(of_string               s  |>  write)
+            |  Ref_energy            ->  Ref_energy.(of_string           s  |>  write)
+            |  Sampling              ->  Sampling.(of_string             s  |>  write)
+            |  Time_step             ->  Time_step.(of_string            s  |>  write)
+            |  SRMC_projection_time  ->  SRMC_projection_time.(of_string s  |>  write)
+            |  Walk_num              ->  Walk_num.(of_string             s  |>  write)
+            |  Walk_num_tot          ->  Walk_num_tot.(of_string         s  |>  write)
+            |  CI_threshold          ->  CI_threshold.(of_string         s  |>  write)
+            |  Jastrow_type          ->  Jastrow_type.(of_string         s  |>  write)
+            |  Trial_wf_energy       ->  Trial_wf_energy.(of_string      s  |>  write)
+            |  Properties            ->  Properties.(of_string           s  |>  write)
          end
        with
        | Failure msg -> Printf.eprintf "%s\n" msg
-      );
+      ) data fields ;
      
       (* Remove temp_file *)
       Sys.remove temp_filename;
@@ -241,77 +248,123 @@ let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
   ;
 
   if c then
-      begin
-        let dirname = 
-          Filename.concat (Filename.concat ezfio_filename "blocks") (Md5.hash ()) 
-        in
-        let rec clean_dir y =
-          match Sys.is_directory y with
-          | `Yes ->
-            Sys.ls_dir y
-            |> List.map ~f:(Filename.concat y)
-            |> List.iter ~f:(function x ->
-                match ( Sys.is_directory x, Sys.is_file x ) with
-                | (`Yes, _) -> clean_dir x
-                | (_, `Yes) -> Sys.remove x
-                | (_,_)     -> ()
-            );
+    begin
+      let dirname = 
+        Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ()) 
+      in
+      let rec clean_dir y =
+        if Sys.file_exists y && Sys.is_directory y then
+          begin
+            Sys.readdir y
+            |> Array.map (fun x -> Filename.concat y x)
+            |> Array.iter (function x ->
+                if Sys.file_exists x && Sys.is_directory x  then
+                  clean_dir x
+                else
+                  Sys.remove x
+              );
             Unix.rmdir y
-          | `Unknown
-          | `No -> ()
-        in clean_dir dirname;
-        Printf.printf "Blocks cleared\n"
-      end
+          end
+      in clean_dir dirname;
+      Printf.printf "Blocks cleared\n"
+    end
   ;
 
   Input.validate ();
-  Md5.reset_hash ();
+  QmcMd5.reset_hash ();
   write_input_in_ezfio ezfio_filename fields
 
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> flag "c"  no_arg
-     ~doc:(" Clear blocks")
-  +> flag "f"  (optional int)
-     ~doc:("0|1 "^Input.Fitcusp.doc)
-  +> flag "t"  (optional int)
-     ~doc:("seconds "^Input.Stop_time.doc)
-  +> flag "l"  (optional int)
-     ~doc:("seconds "^Input.Block_time.doc)
-  +> flag "m"  (optional string)
-     ~doc:("method "^Input.Method.doc)
-  +> flag "e"  (optional float)
-     ~doc:("energy "^Input.Ref_energy.doc)
-  +> flag "s"  (optional string)
-     ~doc:("sampling "^Input.Sampling.doc)
-  +> flag "ts"  (optional float)
-     ~doc:("time_step "^Input.Time_step.doc)
-  +> flag "w"  (optional int)
-     ~doc:("walk_num "^Input.Walk_num.doc)
-  +> flag "wt"  (optional int)
-     ~doc:("walk_num_tot "^Input.Walk_num_tot.doc)
-  +> flag "n"  (optional float)
-     ~doc:("norm "^Input.CI_threshold.doc)
-  +> flag "j"  (optional string)
-     ~doc:("jastrow_type "^Input.Jastrow_type.doc)
-  +> flag "p"  (optional float)
-     ~doc:("projection_time "^Input.DMC_projection_time.doc)
-  +> anon ("ezfio_file" %: string)
-  +> anon (maybe ("input" %: string))
-;;
+let command () = 
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Edits input data";
 
-let command =
-    Command.basic
-    ~summary: "Edit input data"
-    ~readme:(fun () ->
-      "
-Edit input data
-      ")
-    spec
-    (fun c f t l m e s ts w wt n j p ezfio_file input () -> 
-      run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )
+    [ { short='c' ; long="clear" ; opt=Optional ;
+        doc="Clears blocks" ;
+        arg=Without_arg ; };
+
+      { short='e' ; long="ref-energy" ; opt=Optional ;
+        doc=Input.Ref_energy.doc;
+        arg=With_arg "<float>"; };
+    
+      { short='f' ; long="fitcusp" ; opt=Optional ;
+        doc=Input.Fitcusp_factor.doc;
+        arg=With_arg "<float>"; };
+    
+      { short='i' ; long="time-step" ; opt=Optional ;
+        doc=Input.Time_step.doc;
+        arg=With_arg "<float>"; };
+    
+      { short='j' ; long="jastrow" ; opt=Optional ;
+        doc=Input.Jastrow_type.doc;
+        arg=With_arg "<string>"; };
+    
+      { short='l' ; long="block-time" ; opt=Optional ;
+        doc=Input.Block_time.doc;
+        arg=With_arg "<int>"; };
+    
+      { short='m' ; long="method" ; opt=Optional ;
+        doc=Input.Method.doc;
+        arg=With_arg "<string>"; };
+    
+      { short='n' ; long="norm" ; opt=Optional ;
+        doc=Input.CI_threshold.doc;
+        arg=With_arg "<float>"; };
+    
+      { short='p' ; long="projection-time" ; opt=Optional ;
+        doc=Input.SRMC_projection_time.doc;
+        arg=With_arg "<float>"; };
+    
+      { short='r' ; long="trial-energy" ; opt=Optional ;
+        doc=Input.Trial_wf_energy.doc;
+        arg=With_arg "<float>"; };
+    
+      { short='s' ; long="sampling" ; opt=Optional ;
+        doc=Input.Sampling.doc;
+        arg=With_arg "<string>"; };
+    
+      { short='t' ; long="stop-time" ; opt=Optional ;
+        doc=Input.Stop_time.doc;
+        arg=With_arg "<int>"; };
+    
+      { short='w' ; long="walk-num" ; opt=Optional ;
+        doc=Input.Walk_num.doc;
+        arg=With_arg "<int>"; };
+    
+      { short='x' ; long="walk-num-tot" ; opt=Optional ;
+        doc=Input.Walk_num_tot.doc;
+        arg=With_arg "<int>"; };
+    
+      anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
+      anonymous "FILE"   Optional  "Name of the input file";
+    ]
+    |> set_specs 
+  end;        
+
+  let c = Command_line.get_bool "clear" in
+  let f = Command_line.get "fitcusp" in
+  let t = Command_line.get "stop-time" in
+  let l = Command_line.get "block-time" in
+  let m = Command_line.get "method" in
+  let e = Command_line.get "ref-energy" in
+  let et = Command_line.get "trial-energy" in
+  let s = Command_line.get "sampling" in
+  let ts = Command_line.get "time-step" in
+  let w = Command_line.get "walk-num" in
+  let wt = Command_line.get "walk-num-tot" in
+  let n = Command_line.get "norm" in
+  let j = Command_line.get "jastrow" in
+  let p = Command_line.get "projection-time" in
+
+  let ezfio_file, input =
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file, None
+    | ezfio_file :: file :: [] -> ezfio_file, (Some file)
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
+  run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file
 
 
 

ocaml/Qmcchem_forwarder.ml

@@ -1,22 +1,25 @@
-open Core.Std;;
-
 let bind_socket ~socket_type ~socket ~address =
-  try
-    ZMQ.Socket.bind socket address
-  with 
-  | Unix.Unix_error (_, message, f) -> 
-    failwith @@ Printf.sprintf 
-        "\n%s\nUnable to bind the forwarder's %s socket :\n %s\n%s"
-        f socket_type address message
-  | other_exception -> raise other_exception
+  let rec loop = function 
+    | 0 -> failwith @@ Printf.sprintf 
+        "Unable to bind the forwarder's %s socket : %s\n"
+        socket_type address
+    | -1 -> () 
+    | i ->  
+      try 
+        Zmq.Socket.bind socket address; 
+        loop (-1) 
+      with 
+      | Unix.Unix_error _ -> (Unix.sleep 1 ; loop (i-1) ) 
+      | other_exception -> raise other_exception 
+  in loop 10 
+
 
 
 let run ezfio_filename dataserver =
 
   let dataserver_address, dataserver_port =
-    Substring.create ~pos:6 dataserver
-    |> Substring.to_string
-    |> String.lsplit2_exn ~on:':' 
+    String.sub dataserver 6 (String.length dataserver - 6)
+    |> String_ext.lsplit2_exn ~on:':' 
   and qmc = 
     Lazy.force Qmcchem_config.qmc
   in
@@ -30,14 +33,14 @@ let run ezfio_filename dataserver =
 
   (* Port of the data server *)
   let port = 
-    (Int.of_string dataserver_port)+10
+    (int_of_string dataserver_port)+10
   in
 
   (* Build qmc executable command *)
-  let prog, args = 
+  let prog, argv = 
       qmc, 
-    [ qmc ; ezfio_filename ;
-       Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm port ];
+    [| qmc ; ezfio_filename ;
+       Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm port |];
   in
 
   (* Create the temporary directory. If it is possible, then the process is a
@@ -45,67 +48,88 @@ let run ezfio_filename dataserver =
    *)
   let () = 
     try
-      Unix.mkdir tmpdir
+      Unix.mkdir tmpdir 0o755;
+      Unix.chdir tmpdir
     with
     | Unix.Unix_error _ ->
-        (* TODO : wait until the forwarder has started *)
-        begin
-          Unix.chdir tmpdir;
-          ignore @@ Unix.exec ~prog ~args ()
-        end
+      begin
+        Unix.chdir tmpdir;
+        Unix.sleep 1;
+        if Sys.file_exists "PID" then
+          begin
+            let pid = 
+              let ic = open_in "PID" in
+              try
+                int_of_string (input_line ic)
+              with
+              | End_of_file -> -1
+            in
+            match pid with
+            | -1 -> ()
+            | pid ->
+                try
+                  Unix.kill pid 0 ;
+                  ignore @@ Unix.execvp prog argv
+                with
+                | Unix.Unix_error (Unix.ESRCH, _, _) -> ()
+          end
+      end
   in
-  Unix.chdir tmpdir;
 
   (* Now, only one forwarder will execute the following code *)
+  let oc = open_out "PID" in
+  Unix.getpid ()
+  |> Printf.sprintf "%d\n" 
+  |> output_string oc
+  ; close_out oc;
 
   (* Fork a qmc *)
   ignore @@
-    Watchdog.fork_exec ~prog ~args ();
+    Watchdog.fork_exec ~prog ~args:argv ();
 
-  (* If there are MICs, use them here (TODO) *)
-  
   (* Fetch input *)
   let zmq_context =
-    ZMQ.Context.create ()
+    Zmq.Context.create ()
   in
 
   let terminate () = 
     (* Clean up the temp directory *)
     Unix.chdir Qmcchem_config.dev_shm;
-    let command = 
-      Printf.sprintf "rm -rf -- \"%s\" " tmpdir
-    in
-    match Unix.system command with
-    | Ok _ -> ()
-    | _    -> print_endline "Unable to remove temporary directory"
-    ;
-    ZMQ.Context.terminate zmq_context ;
+    Zmq.Context.terminate zmq_context ;
     for i=port to port+4
     do
       let filename =
-         Filename.concat Qmcchem_config.dev_shm  (Printf.sprintf ":%d" i)
+         Printf.sprintf ":%d" i
       in
       try
-         Unix.unlink filename
+         Sys.remove filename
       with
       | _ ->  ()
       ;
-    done
+    done;
+    let command = 
+      Printf.sprintf "rm -rf -- \"%s\" " tmpdir
+    in
+    try
+      ignore @@ Unix.system command
+    with
+    | Unix.Unix_error _  -> print_endline "Unable to remove temporary directory"
+    ;
+    Watchdog.kill ()
   in
 
 
   (* Signal handler to Kill properly all the processes *)
   let handler s =
-    Printf.printf "Forwarder received the %s signal... killing\n" (Signal.to_string s);
-    terminate ();
-    Watchdog.kill ();
+    Printf.printf "Forwarder received signal %d... killing\n%!" s;
+    terminate ()
   in
-  List.iter [
-     Signal.term ;
-     Signal.quit ;
-     Signal.int
+  List.iter (fun s -> ignore @@ Sys.signal s (Sys.Signal_handle handler))
+    [
+      Sys.sigint  ;
+      Sys.sigterm ;
+      Sys.sigquit ;
     ]
-    ~f:(fun x -> Signal.Expert.handle x handler)
   ;
 
 
@@ -126,43 +150,43 @@ let run ezfio_filename dataserver =
 
     let f () =
       let pub_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.pub
+        Zmq.Socket.create zmq_context Zmq.Socket.pub
       and address =
         Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port+1);
       in
       bind_socket "PUB" pub_socket address;
 
       let sub_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.sub
+        Zmq.Socket.create zmq_context Zmq.Socket.sub
       and address =
         Printf.sprintf "tcp://%s:%d" dataserver_address (port+1-10)
       in
-      ZMQ.Socket.connect sub_socket address;
-      ZMQ.Socket.subscribe sub_socket "";
+      Zmq.Socket.connect sub_socket address;
+      Zmq.Socket.subscribe sub_socket "";
 
       let pollitem =
-        ZMQ.Poll.mask_of
-        [| (sub_socket, ZMQ.Poll.In) ;
+        Zmq.Poll.mask_of
+        [| (sub_socket, Zmq.Poll.In) ;
         |]
       in
 
       while (!status <> Status.Stopped)
       do
         let polling =
-          ZMQ.Poll.poll ~timeout:1000 pollitem
+          Zmq.Poll.poll ~timeout:1000 pollitem
         in
-        if (polling.(0) = Some ZMQ.Poll.In) then
+        if (polling.(0) = Some Zmq.Poll.In) then
           begin
             let msg =
-              ZMQ.Socket.recv ~block:false sub_socket
+              Zmq.Socket.recv ~block:false sub_socket
             in
-            ZMQ.Socket.send pub_socket msg;
+            Zmq.Socket.send pub_socket msg;
             status := Status.of_string msg;
           end;
       done;
-      List.iter ~f:(fun socket ->
-        ZMQ.Socket.set_linger_period socket 1000 ;
-        ZMQ.Socket.close socket)
+      List.iter (fun socket ->
+        Zmq.Socket.set_linger_period socket 1000 ;
+        Zmq.Socket.close socket)
         [ sub_socket ; pub_socket ]
     in
     Thread.create f
@@ -172,23 +196,23 @@ let run ezfio_filename dataserver =
 
     let f () =
       let sub_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.xsub
+        Zmq.Socket.create zmq_context Zmq.Socket.xsub
       and address =
         Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port+3);
       in
       bind_socket "XSUB" sub_socket address;
 
       let pub_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.xpub
+        Zmq.Socket.create zmq_context Zmq.Socket.xpub
       and address =
         Printf.sprintf "tcp://%s:%d" dataserver_address (port+3-10)
       in
-      ZMQ.Socket.connect pub_socket address;
+      Zmq.Socket.connect pub_socket address;
 
       let pollitem =
-        ZMQ.Poll.mask_of
-        [| (sub_socket, ZMQ.Poll.In) ;
-           (pub_socket, ZMQ.Poll.In) ;
+        Zmq.Poll.mask_of
+        [| (sub_socket, Zmq.Poll.In) ;
+           (pub_socket, Zmq.Poll.In) ;
         |]
       in
 
@@ -196,23 +220,23 @@ let run ezfio_filename dataserver =
       while (!status <> Status.Stopped)
       do
         let polling =
-          ZMQ.Poll.poll ~timeout:1000 pollitem
+          Zmq.Poll.poll ~timeout:1000 pollitem
         in
-        if (polling.(0) = Some ZMQ.Poll.In) then
+        if (polling.(0) = Some Zmq.Poll.In) then
           begin
-            ZMQ.Socket.recv ~block:false sub_socket
-            |> ZMQ.Socket.send pub_socket ;
+            Zmq.Socket.recv ~block:false sub_socket
+            |> Zmq.Socket.send pub_socket ;
           end
-        else if (polling.(1) = Some ZMQ.Poll.In) then
+        else if (polling.(1) = Some Zmq.Poll.In) then
           begin
-            Printf.printf "Forwarder subscribe\n%!";
-            ZMQ.Socket.recv ~block:false pub_socket
-            |> ZMQ.Socket.send sub_socket ;
+            Printf.eprintf "Forwarder subscribe\n%!";
+            Zmq.Socket.recv ~block:false pub_socket
+            |> Zmq.Socket.send sub_socket ;
           end
       done;
-      List.iter ~f:(fun socket ->
-        ZMQ.Socket.set_linger_period socket 1000 ;
-        ZMQ.Socket.close socket)
+      List.iter (fun socket ->
+        Zmq.Socket.set_linger_period socket 1000 ;
+        Zmq.Socket.close socket)
         [ sub_socket ; pub_socket ]
     in
     Thread.create f
@@ -223,47 +247,47 @@ let run ezfio_filename dataserver =
     let f () =
 
       let req_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.req
+        Zmq.Socket.create zmq_context Zmq.Socket.req
       in
-      ZMQ.Socket.connect req_socket dataserver;
-      ZMQ.Socket.set_receive_timeout req_socket 180_000;
+      Zmq.Socket.connect req_socket dataserver;
+      Zmq.Socket.set_receive_timeout req_socket 600_000;
 
       let dealer_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.dealer
+        Zmq.Socket.create zmq_context Zmq.Socket.dealer
       in
 
       bind_socket "PROXY" dealer_socket "inproc://dealer";
-      ZMQ.Socket.set_receive_high_water_mark dealer_socket 100000;
-      ZMQ.Socket.set_send_high_water_mark dealer_socket 100000;
-      ZMQ.Socket.set_immediate dealer_socket true;
+      Zmq.Socket.set_receive_high_water_mark dealer_socket 100_000;
+      Zmq.Socket.set_send_high_water_mark dealer_socket 100_000;
+      Zmq.Socket.set_immediate dealer_socket true;
+      Zmq.Socket.set_linger_period dealer_socket 600_000;
 
       let fetch_walkers () =
-        ZMQ.Socket.send_all req_socket ["get_walkers" ; Int.to_string !walk_num ];
-        ZMQ.Socket.recv_all req_socket
+        Zmq.Socket.send_all req_socket ["get_walkers" ; string_of_int !walk_num ];
+        Zmq.Socket.recv_all req_socket
       in
 
       let pollitem =
-        ZMQ.Poll.mask_of
-        [| (dealer_socket, ZMQ.Poll.In) ;
+        Zmq.Poll.mask_of
+        [| (dealer_socket, Zmq.Poll.In) ;
         |]
       in
 
       (* EZFIO Cache *)
       let ezfio_cache = 
-        String.Table.create ()
+        Hashtbl.create 63
       in
       let handle_ezfio msg =
-        match Hashtbl.find ezfio_cache msg with
+        match Hashtbl.find_opt ezfio_cache msg with
         | Some result -> result
         | None ->
           begin
-            ZMQ.Socket.send_all req_socket ["Ezfio" ; msg];
+            Zmq.Socket.send_all req_socket ["Ezfio" ; msg];
             let result = 
-              ZMQ.Socket.recv_all req_socket
+              Zmq.Socket.recv_all req_socket
             in
-            match (Hashtbl.add ezfio_cache ~key:msg ~data:result) with
-            | `Ok -> result
-            | `Duplicate -> result
+            Hashtbl.add ezfio_cache msg result;
+            result
           end
       in
         
@@ -272,12 +296,12 @@ let run ezfio_filename dataserver =
       while (!status <> Status.Stopped)
       do
         let polling =
-          ZMQ.Poll.poll ~timeout:1000 pollitem
+          Zmq.Poll.poll ~timeout:1000 pollitem
         in
-        if (polling.(0) = Some ZMQ.Poll.In) then
+        if (polling.(0) = Some Zmq.Poll.In) then
           begin
             let raw_msg = 
-              ZMQ.Socket.recv_all ~block:false dealer_socket
+              Zmq.Socket.recv_all ~block:false dealer_socket
             in
             let header, msg =
               let rec aux header = function
@@ -285,7 +309,7 @@ let run ezfio_filename dataserver =
                 | head :: tail -> aux (head::header) tail
                 | _            -> failwith "Too many routers in the middle"
               in
-              aux [] (List.map ~f:String.strip raw_msg)
+              aux [] (List.rev @@ List.rev_map String.trim raw_msg)
             in
             let handle message =
               match message with
@@ -293,7 +317,7 @@ let run ezfio_filename dataserver =
                   let result = 
                     handle_ezfio ezfio_msg
                   in
-                  ZMQ.Socket.send_all dealer_socket (header @ result) ;
+                  Zmq.Socket.send_all dealer_socket (header @ result) 
               | Message.GetWalkers n_walks ->
                 begin
                   if (!walk_num = 0) then
@@ -301,11 +325,12 @@ let run ezfio_filename dataserver =
                       walk_num := Qptypes.Strictly_positive_int.to_int n_walks;
                       walkers := fetch_walkers ();
                     end;
-                  ZMQ.Socket.send_all dealer_socket (header @ !walkers);
+                  Zmq.Socket.send_all dealer_socket (header @ !walkers);
                   walkers := fetch_walkers ();
                 end
               | Message.Test ->
-                  ZMQ.Socket.send_all dealer_socket (header @ [ "OK" ]);
+                  Zmq.Socket.send_all dealer_socket (header @ [ "OK" ])
+              | Message.Error _ ->  ()
               | Message.Register _
               | Message.Unregister _ 
               | Message.Walkers  _
@@ -314,10 +339,10 @@ let run ezfio_filename dataserver =
             in handle msg
           end;
       done;
-      ZMQ.Socket.set_linger_period dealer_socket 1000 ;
-      ZMQ.Socket.close dealer_socket;
-      ZMQ.Socket.set_linger_period req_socket 1000 ;
-      ZMQ.Socket.close req_socket;
+      Zmq.Socket.set_linger_period dealer_socket 1000 ;
+      Zmq.Socket.set_linger_period req_socket 1000 ;
+      Zmq.Socket.close dealer_socket;
+      Zmq.Socket.close req_socket;
     in
     Thread.create f
   in
@@ -327,35 +352,38 @@ let run ezfio_filename dataserver =
     let f () =
 
       let dealer_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.dealer
+        Zmq.Socket.create zmq_context Zmq.Socket.dealer
       in
-      ZMQ.Socket.connect dealer_socket dataserver;
+      Zmq.Socket.connect dealer_socket dataserver;
+      Zmq.Socket.set_linger_period dealer_socket 600_000;
 
       let proxy_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.dealer
+        Zmq.Socket.create zmq_context Zmq.Socket.dealer
       in
-      ZMQ.Socket.connect proxy_socket "inproc://dealer";
+      Zmq.Socket.connect proxy_socket "inproc://dealer";
 
       let router_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.router
+        Zmq.Socket.create zmq_context Zmq.Socket.router
       and address =
         Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port);
       in
       bind_socket "ROUTER" router_socket address;
-      ZMQ.Socket.set_receive_high_water_mark router_socket 100000;
-      ZMQ.Socket.set_send_high_water_mark router_socket 100000;
-      ZMQ.Socket.set_immediate router_socket true;
+      Zmq.Socket.set_receive_high_water_mark router_socket 100000;
+      Zmq.Socket.set_send_high_water_mark router_socket 100000;
+      Zmq.Socket.set_immediate router_socket true;
+      Zmq.Socket.set_linger_period router_socket 600_000;
 
       (* Pull socket for computed data *)
       let push_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.push
+        Zmq.Socket.create zmq_context Zmq.Socket.push
       and address =
         Printf.sprintf "tcp://%s:%d" dataserver_address (port+2-10)
       in
-      ZMQ.Socket.connect push_socket address;
+      Zmq.Socket.connect push_socket address;
+      Zmq.Socket.set_linger_period push_socket 600_000;
 
       let pull_socket =
-        ZMQ.Socket.create zmq_context ZMQ.Socket.pull
+        Zmq.Socket.create zmq_context Zmq.Socket.pull
       and address =
         Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port+2);
       in
@@ -365,7 +393,7 @@ let run ezfio_filename dataserver =
       (* Handles messages coming into the ROUTER socket. *)
       let handle_router () =
         let raw_msg = 
-          ZMQ.Socket.recv_all ~block:false router_socket
+          Zmq.Socket.recv_all ~block:false router_socket
         in
         let header, msg =
           let rec aux header = function
@@ -373,66 +401,121 @@ let run ezfio_filename dataserver =
             | head :: tail -> aux (head::header) tail
             | _            -> failwith "Too many routers in the middle"
           in
-          aux [] (List.map ~f:String.strip raw_msg)
+          aux [] (List.rev @@ List.rev_map String.trim raw_msg)
         in
         let handle message =
           match message with
           | Message.GetWalkers _ 
           | Message.Ezfio _
           | Message.Test ->
-              ZMQ.Socket.send_all proxy_socket raw_msg;
+              Zmq.Socket.send_all proxy_socket raw_msg
           | Message.Register _
           | Message.Unregister _ ->
-              ZMQ.Socket.send_all dealer_socket raw_msg;
+              Zmq.Socket.send_all dealer_socket raw_msg
           | Message.Walkers (_, _, _)
           | Message.Property _ ->
               failwith "Bad message"
+          | Message.Error _ -> ()
         in handle msg
       in
 
       let handle_dealer () =
-        ZMQ.Socket.recv_all ~block:false dealer_socket
-        |> ZMQ.Socket.send_all router_socket
+        Zmq.Socket.recv_all ~block:false dealer_socket
+        |> Zmq.Socket.send_all router_socket
       in
 
       let handle_proxy () =
-        ZMQ.Socket.recv_all ~block:false proxy_socket
-        |> ZMQ.Socket.send_all router_socket
+        Zmq.Socket.recv_all ~block:false proxy_socket
+        |> Zmq.Socket.send_all router_socket
+      in
+
+      let select_n_of ~n ~len l =
+        let a = 
+          Array.of_list l
+        in
+        let s = 
+          (Array.length a)/ len
+        in
+        let fetch i = 
+          let rec loop accu = function 
+          | -1 -> accu
+          | k -> loop ((Array.get a (i*len+k)) :: accu) (k-1)
+          in
+          loop [] (len-1)
+        in
+        let rec select accu = function
+        | 0 -> accu
+        | i -> let new_accu =
+                (fetch @@ Random.int s) :: accu
+              in 
+              select new_accu (i-1)
+        in
+        select [] n
+        |> List.concat
       in
 
       (* Handles messages coming into the PULL socket. *)
       let handle_pull () =
-        ZMQ.Socket.recv_all ~block:false pull_socket
-        |> ZMQ.Socket.send_all push_socket 
+        let message = 
+          Zmq.Socket.recv_all ~block:false pull_socket
+        in
+        let new_message = 
+          match message with
+          | "elec_coord":: hostname :: pid :: id :: n_str :: rest ->
+            let n = 
+              int_of_string n_str
+            in
+            let len =
+              if !walk_num = 0 then n else
+              n / !walk_num
+            in
+            if (n < 5*len) then
+              message
+            else
+              List.concat [ [ "elec_coord" ; hostname ; pid ; id ; 
+              string_of_int (5*len)] ; ( select_n_of ~n:5 ~len rest ) ]
+          | prop :: c :: pid :: b :: d :: w :: [] -> message
+          | prop :: c :: pid :: b :: d :: w :: l ->
+            if Qmcchem_config.binary_io then
+              match Message.create message with
+              | Message.Property block -> 
+                  prop :: c :: pid :: b :: d :: w :: "bin" ::
+                  (Block.to_bytes block |> Bytes.unsafe_to_string ) :: []
+              | _ -> failwith "Inconsistent message"
+            else
+              message
+          | _ -> message
+        in
+        Zmq.Socket.send_all  push_socket  new_message
       in
 
       (* Polling item to poll ROUTER and PULL sockets. *)
       let pollitem =
-        ZMQ.Poll.mask_of
-        [| (router_socket , ZMQ.Poll.In) ;
-            (pull_socket  , ZMQ.Poll.In) ;
-            (dealer_socket, ZMQ.Poll.In) ;
-            (proxy_socket , ZMQ.Poll.In)
+        Zmq.Poll.mask_of
+        [| (router_socket , Zmq.Poll.In) ;
+            (pull_socket  , Zmq.Poll.In) ;
+            (dealer_socket, Zmq.Poll.In) ;
+            (proxy_socket , Zmq.Poll.In)
         |]
       in
       (* Main loop *)
       while (!status <> Status.Stopped)
       do
         let polling =
-          ZMQ.Poll.poll ~timeout:1000 pollitem
+          Zmq.Poll.poll ~timeout:1000 pollitem
         in
-        if (polling.(0) = Some ZMQ.Poll.In) then
+        if (polling.(0) = Some Zmq.Poll.In) then
           handle_router ();
-        if (polling.(1) = Some ZMQ.Poll.In) then
+        if (polling.(1) = Some Zmq.Poll.In) then
           handle_pull ();
-        if (polling.(2) = Some ZMQ.Poll.In) then
+        if (polling.(2) = Some Zmq.Poll.In) then
           handle_dealer ();
-        if (polling.(3) = Some ZMQ.Poll.In) then
+        if (polling.(3) = Some Zmq.Poll.In) then
           handle_proxy ();
       done;
-      List.iter ~f:(fun socket ->
-        ZMQ.Socket.set_linger_period socket 1000 ;
-        ZMQ.Socket.close socket)
+      List.iter (fun socket ->
+        Zmq.Socket.set_linger_period socket 1000 ;
+        Zmq.Socket.close socket)
       [ router_socket ; dealer_socket ; push_socket ; pull_socket ; proxy_socket ]
     in
     Thread.create f
@@ -442,7 +525,7 @@ let run ezfio_filename dataserver =
   (* Start the status thread and the main thread *)
   begin
     try
-      (List.iter ~f:Thread.join 
+      (List.iter Thread.join 
         [ start_status_thread ();
           start_log_thread ();
           start_proxy_thread ();
@@ -453,12 +536,19 @@ let run ezfio_filename dataserver =
       begin
         print_endline "Trapped error. Waiting 10 seconds...";
         status := Status.Stopping;
-        Time.Span.of_sec 10. |> Time.pause;
+        Unix.sleep 10 ;
         raise err
       end
   end;
 
   (* Wait for the qmc process to complete *)
-  ignore (Watchdog.join ());
-  terminate ()
+  try
+    ignore (Watchdog.join ());
+    terminate ()
+  with
+  | error -> 
+    begin
+      terminate ();
+      raise error
+    end
 

ocaml/Qmcchem_info.ml

@@ -1,31 +1,31 @@
-open Core.Std
 
 
 let run ezfio_filename = 
+  Qputils.set_ezfio_filename ezfio_filename;
   let qmcchem_info =
       Lazy.force Qmcchem_config.qmcchem_info
   in
-  let prog, args = 
+  let prog, argv = 
       qmcchem_info, 
-    [ qmcchem_info ; ezfio_filename ]
+    [| qmcchem_info ; ezfio_filename |]
   in
   ignore @@
-    Unix.exec ~prog ~args () 
+    Unix.execvp prog argv 
 
+let command () =
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Display info on an EZFIO database";
+    [ anonymous "EZFIO_DIR" Mandatory "EZFIO directory" ]
+    |> set_specs
+  end;
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> anon ("ezfio_file" %: string)
-
-let command = 
-    Command.basic
-    ~summary: "Display info on an EZFIO database"
-    ~readme:(fun () ->
-      "
-Display info on an EZFIO database
-      ")
-    spec
-    (fun ezfio_file () ->  run ezfio_file )
+  let ezfio_file =
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file                                                          
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
 
+  run ezfio_file
 

ocaml/Qmcchem_md5.ml

@@ -1,17 +1,16 @@
-open Core.Std
 
-let run ?c ?d ~l ezfio_filename =
+let run ?c ?d ~l ~update ezfio_filename =
 
-  Ezfio.set_file ezfio_filename;
+  Qputils.set_ezfio_filename ezfio_filename;
 
   let input_directory =
-    Lazy.force Md5.input_directory
+    Lazy.force QmcMd5.input_directory
   in
 
   let handle_options () =
 
     let current_md5 = 
-      Md5.hash ()
+      QmcMd5.hash ()
     in
 
     let filename_of_key key = 
@@ -22,9 +21,47 @@ let run ?c ?d ~l ezfio_filename =
       let filename = 
         filename_of_key key
       in
-      Sys.file_exists_exn filename
+      Sys.file_exists filename
     in
 
+    if (update) then
+       begin
+          Printf.printf "Updating\n%!" ;
+          let update_one old_key =
+            Qmcchem_edit.run ~c:false ~input:(filename_of_key old_key) ezfio_filename;
+            QmcMd5.reset_hash ();
+            let new_key =
+              QmcMd5.hash ()
+            in
+
+            if (old_key <> new_key) then
+              begin
+                let prefix = 
+                  Filename.concat ezfio_filename "blocks" 
+                in
+                let new_name = 
+                  Filename.concat prefix new_key 
+                and old_name = 
+                  Filename.concat prefix old_key 
+                in
+                Printf.printf "Renaming %s -> %s\n" old_name new_name;
+                try Sys.rename old_name new_name with
+                | Sys_error _ -> ();
+
+                let old_name = 
+                  String.concat "/" [ ezfio_filename; "input"; old_key ]
+                in
+                Printf.printf "Removing %s\n%!" old_name;
+                try Sys.remove old_name with
+                | Sys_error _ -> ();
+            end
+          in
+          Sys.readdir input_directory
+          |> Array.iter (fun x -> update_one x) ;
+          Printf.printf "Done\n%!" ;
+       end
+    ;
+
     let () =
       match c with
       | None -> ()
@@ -39,8 +76,8 @@ let run ?c ?d ~l ezfio_filename =
       match l with
       | false -> ()
       | true  ->
-          Sys.ls_dir   input_directory
-          |> List.iter ~f:(fun md5 -> 
+          Sys.readdir   input_directory
+          |> Array.iter (fun md5 -> 
               let filename =
                 Filename.concat  input_directory  md5
               in
@@ -50,11 +87,10 @@ let run ?c ?d ~l ezfio_filename =
                 else
                   ""
               in
-              let date = 
-                (Unix.stat filename).Unix.st_mtime
-              in
-              let date = 
-                Unix.strftime (Unix.localtime date) "%a, %d %b %Y %T %z"
+              let date =
+                let open Unix in
+                localtime (stat filename).st_mtime 
+                |> Time.string_of_date
               in
               Printf.printf "%s : %s  %s\n" md5 date this)
     in
@@ -65,13 +101,12 @@ let run ?c ?d ~l ezfio_filename =
       | Some other_key ->
           if (key_is_valid other_key) then
             let command =
-              String.concat ~sep:" "
+              String.concat " "
                [ "diff" ; "-u" ; "-w" ;
                  (filename_of_key current_md5) ;
                  (filename_of_key other_key) ]
             in
-            match (Unix.system command) with
-            | _ -> ()
+            ignore @@ Unix.system command
           else
             failwith ("Error: " ^ other_key ^ " does not exist") 
     in
@@ -79,34 +114,51 @@ let run ?c ?d ~l ezfio_filename =
 
   in
 
-  match (c,d,l) with
-  | (None,None,false) -> 
-      Printf.printf "Current key :\n%s\n" (Md5.hash ())
+  match (c,d,l,update) with
+  | (None,None,false,false) -> 
+      Printf.printf "Current key :\n%s\n" (QmcMd5.hash ())
   | _ -> handle_options ()
 
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> flag "c" (optional string)
-     ~doc:("<key> Change to input to <key>")
-  +> flag "d" (optional string)
-     ~doc:("<key> Show input differences with <key>")
-  +> flag "l" no_arg
-     ~doc:(" List all the saved MD5 keys.")
-  +> anon ("ezfio_file" %: string)
+let command () =
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Manipulate input MD5 keys";
 
+    [ { short='c' ; long="clear" ; opt=Optional ;
+	doc="Change to input to <key>" ;
+        arg=With_arg "<string>" ; };
 
+      { short='d' ; long="diff" ; opt=Optional ;
+	doc="Show input differences with <key>" ;
+        arg=With_arg "<string>" ; };
 
-let command =
-    Command.basic
-    ~summary: "Manipulate input MD5 keys"
-    ~readme:(fun () ->
-      "
-Manipulate input MD5 keys
-      ")
-    spec
-    (fun c d l ezfio_file () -> run ?c ?d ~l ezfio_file )
+      { short='l' ; long="list" ; opt=Optional ;
+	doc="List all the saved MD5 keys." ;
+        arg=Without_arg ; };
+
+      { short='u' ; long="update" ; opt=Optional ;
+	doc="Update to the latest MD5 format." ;
+        arg=Without_arg ; };
+
+      anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
+    ]
+    |> set_specs 
+  end;
+
+  let update = Command_line.get_bool "update" in
+  let c = Command_line.get "clear" in
+  let d = Command_line.get "diff" in
+  let l = Command_line.get_bool "list" in
+
+  let ezfio_file =
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
+
+  run ?c ?d ~l ~update ezfio_file 
 
 
 

ocaml/Qmcchem_result.ml

@@ -1,36 +1,35 @@
-open Core.Std
 open Qptypes
 
 (** Display a table that can be plotted by gnuplot *)
-let display_table property =
-  let p = Property.of_string property
-  |> Random_variable.of_raw_data
+let display_table ~range property =
+  let p =
+    Property.of_string property
+    |> Random_variable.of_raw_data ~range
   in
   let  conv = Random_variable.convergence p
   and rconv = Random_variable.rev_convergence p
   and data  = p.Random_variable.data
   in
   let results = 
-  List.map2_exn conv rconv ~f:(fun (val1, err1) (val2,err2) -> (val1, err1, val2, err2))
+    List.rev_map2 (fun (val1, err1) (val2,err2) -> (val1, err1, val2, err2)) conv rconv 
+    |> List.rev
   in
-  List.iter2_exn results data ~f:(fun (val1, err1, val2, err2) block ->
+  List.iter2 (fun (val1, err1, val2, err2) block ->
      Printf.printf "%10.6f  %10.6f    %10.6f  %10.6f   %10.6f\n"
      val1 err1 val2 err2 (Sample.to_float block.Block.value)
-  )
-;;
+  ) results data 
 
 
 (** Display a convergence plot of the requested property *)
-let display_plot property =
+let display_plot ~range property =
   print_string ("display_plot "^property^".\n")
-;;
 
 
 (** Display a convergence table of the error *)
-let display_err_convergence property =
+let display_err_convergence ~range property =
   let p =
     Property.of_string property
-    |> Random_variable.of_raw_data
+    |> Random_variable.of_raw_data ~range
   in
   let rec aux n p = 
       match Random_variable.ave_error p with
@@ -50,13 +49,13 @@ let display_err_convergence property =
       | (ave, None) -> ()
   in
   aux 1 p
-;;
+
 
 (** Display the centered cumulants of a property *)
-let display_cumulants property =
+let display_cumulants ~range property =
   let p =
     Property.of_string property
-    |> Random_variable.of_raw_data
+    |> Random_variable.of_raw_data ~range
   in
   let cum =
     Random_variable.centered_cumulants p
@@ -65,30 +64,30 @@ let display_cumulants property =
   Printf.printf "Variance    = %16.10f\n" cum.(1);
   Printf.printf "Centered k3 = %16.10f\n" cum.(2);
   Printf.printf "Centered k4 = %16.10f\n" cum.(3);
-  print_newline ();
+  Printf.printf "\n%!";
   let n = 1. /. 12. *. cum.(2) *. cum.(2) +.
           1. /. 48. *. cum.(3) *. cum.(3)
   in
   Printf.printf "Non-gaussianity = %16.10f\n" n
-;;
+
 
 
 (** Display a table for the autocovariance of the property *)
-let display_autocovariance property =
+let display_autocovariance ~range property =
   let p = 
     Property.of_string property
-    |> Random_variable.of_raw_data
+    |> Random_variable.of_raw_data ~range
   in
   Random_variable.autocovariance p
-  |> List.iteri ~f:(fun i x ->
+  |> List.iteri (fun i x ->
       Printf.printf "%10d  %16.10f\n" i x)
-;;
+
 
 (** Display a histogram of the property *)
-let display_histogram property =
+let display_histogram ~range property =
   let p = 
     Property.of_string property
-    |> Random_variable.of_raw_data
+    |> Random_variable.of_raw_data ~range
   in
   let histo = 
     Random_variable.histogram p
@@ -103,8 +102,8 @@ let display_histogram property =
   let g =
     Random_variable.GaussianDist.eval ~g
   in
-  List.iter histo ~f:( fun (x,y) -> 
-      Printf.printf "%16.10f  %16.10f  %16.10f\n" x y (g ~x))
+  List.iter ( fun (x,y) -> 
+      Printf.printf "%16.10f  %16.10f  %16.10f\n" x y (g ~x)) histo 
     (*
   and sigma2 = 
     (Random_variable.centered_cumulants p).(1) 
@@ -118,57 +117,73 @@ let display_histogram property =
   and norm =
     1. /. (sqrt(sigma2 *. 2.*.pi))
   in
-  List.map histo ~f:(fun (x,y) -> 
+  List.rev_map histo ~f:(fun (x,y) -> 
     let g =
       norm *. exp(-.((x-.mu)*.(x-.mu)*.one_over_2sigma2))
     in
     (x,y,g)
   )
-  |>  List.iter ~f:(fun (x,y,g) ->
-      Printf.printf "%16.10f  %16.10f  %16.10f\n" x y g)
+  |> List.rev
+  |> List.iter ~f:(fun (x,y,g) ->
+     Printf.printf "%16.10f  %16.10f  %16.10f\n" x y g)
       *)
-;;
 
 
 
-(** Display a summary of all the cmoputed quantities *)
-let display_summary () =
+
+(** Display a summary of all the computed quantities *)
+let display_summary ~range =
   
   let properties =
     Lazy.force Block.properties
   and print_property property = 
-    let p = Random_variable.of_raw_data property
+    let p = Random_variable.of_raw_data ~range property
     in
-    Printf.printf "%20s : %s\n"
-     (Property.to_string property)
-     (Random_variable.to_string p)
+    Printf.printf "%20s : %!" (Property.to_string property);
+    Printf.printf "%s\n%!" (Random_variable.to_string p)
   in
-  List.iter properties ~f:print_property ;
+  List.iter print_property properties ;
 
 
   let cpu =
-    Random_variable.of_raw_data Property.Cpu
+    Random_variable.of_raw_data ~range Property.Cpu
     |> Random_variable.sum
   and wall =
-    Random_variable.of_raw_data Property.Wall
+    Random_variable.of_raw_data ~range Property.Wall
     |> Random_variable.max_value_per_compute_node
     |> Random_variable.sum
+  and total_weight =
+    Random_variable.of_raw_data ~range Property.E_loc
+    |> Random_variable.total_weight
   in
 
   let speedup =
     cpu /. wall
   in
-  Printf.printf "%20s : %10.2f x\n" "Speedup" speedup;
-;;
+  Printf.printf "%20s : %10.2f x\n" "Speedup" speedup ;
+  Printf.printf "%20s : %20.10e\n" "Total weight" total_weight
 
 
-let run ?a ?c ?e ?h ?t ?p ezfio_file =
 
-  Ezfio.set_file ezfio_file;
-  let f (x,func) =
-    match x with
-    | Some property -> func property 
-    | None -> ()
+let run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file =
+
+  Qputils.set_ezfio_filename ezfio_file;
+
+  let rmin =
+      match rmin with
+      | None -> 0.
+      | Some x when (float_of_string x < 0.)   -> failwith "rmin should be >= 0"
+      | Some x when (float_of_string x > 100.) -> failwith "rmin should be <= 100"
+      | Some x -> float_of_string x
+  and rmax = 
+      match rmax with
+      | None -> 100.
+      | Some x when (float_of_string x < 0.)   -> failwith "rmax should be >= 0"
+      | Some x when (float_of_string x > 100.) -> failwith "rmax should be <= 100"
+      | Some x -> float_of_string x
+  in
+  let range = 
+    (rmin, rmax)
   in
 
   let l = 
@@ -181,44 +196,80 @@ let run ?a ?c ?e ?h ?t ?p ezfio_file =
     ]
   in
 
-  List.iter ~f l
-  ;
+  List.iter (fun (x,func) ->
+      match x with
+      | Some property -> func ~range property 
+      | None -> ()
+    ) l;
 
-  if (List.fold ~init:true ~f:(fun accu x ->
+  if (List.fold_left (fun accu x ->
       match x with
       | (None, _) -> accu && true
       | (Some _,_) -> false
-     ) l
+     ) true l
     ) then
-    display_summary ()
-;;
+    display_summary ~range
 
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> flag "a" (optional string)
-     ~doc:"property Display the autcovariance function of the property"
-  +> flag "c"  (optional string)
-     ~doc:"property Print the centered cumulants of a property"
-  +> flag "e" (optional string)
-     ~doc:"property Display the convergence of the error of the property by merging blocks"
-  +> flag "h" (optional string)
-     ~doc:"property Display the histogram of the property blocks"
-  +> flag "p" (optional string)
-     ~doc:"property Display a convergence plot for a property"
-  +> flag "t"  (optional string)
-     ~doc:"property Print a table for the convergence of a property"
-  +> anon ("ezfio_file" %: string)
-;;
+let command () = 
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Displays the results computed in an EZFIO directory.";
 
-let command =
-    Command.basic
-    ~summary: "Displays the results computed in an EZFIO directory."
-    ~readme:(fun () -> "Displays the results computed in an EZFIO directory.")
-    spec
-    (fun a c e h p t ezfio_file () -> run ?a ?c ?e ?h ?t ?p ezfio_file )
-;;
+    [ { short='a' ; long="autocovariance" ; opt=Optional ;
+        doc="Display the autcovariance function of the property";
+        arg=With_arg "<string>" ; };
+
+      { short='c' ; long="centered-cumulants" ; opt=Optional ;
+        doc="Print the centered cumulants of a property" ;
+        arg=With_arg "<string>"; };
+    
+      { short='e' ; long="error" ; opt=Optional ;
+        doc="Display the convergence of the error of the property by merging blocks";
+        arg=With_arg "<string>"; };
+    
+      { short='i' ; long="histogram" ; opt=Optional ;
+        doc="Display the histogram of the property blocks" ;
+        arg=With_arg "<string>"; };
+    
+      { short='p' ; long="plot" ; opt=Optional ;
+        doc="Display a convergence plot for a property";
+        arg=With_arg "<string>"; };
+    
+      { short='m' ; long="rmin" ; opt=Optional ;
+        doc="Lower bound of the percentage of the total weight to consider (default 0)" ;
+        arg=With_arg "<int>"; };
+    
+      { short='n' ; long="rmax" ; opt=Optional ;
+        doc="Upper bound of the percentage of the total weight to consider (default 100)" ;
+        arg=With_arg "<int>"; };
+    
+      { short='t' ; long="table" ; opt=Optional ;
+        doc="Print a table for the convergence of a property" ;
+        arg=With_arg "<string>"; };
+
+      anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
+    ]
+
+    |> set_specs ;
+  end;        
+
+  let a = Command_line.get "autocovariance" in
+  let c = Command_line.get "centered-cumulants" in
+  let e = Command_line.get "error" in
+  let h = Command_line.get "histogram" in
+  let t = Command_line.get "table" in
+  let p = Command_line.get "plot" in
+  let rmin = Command_line.get "rmin" in
+  let rmax = Command_line.get "rmax" in
+
+  let ezfio_file =
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
+  run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file 
 
 
 

ocaml/Qmcchem_run.ml

@@ -1,4 +1,3 @@
-open Core.Std
 
 let full_run ?(start_dataserver=true) ezfio_filename  = 
   (* Identify the job scheduler *)
@@ -7,18 +6,21 @@ let full_run ?(start_dataserver=true) ezfio_filename  =
   and scheduler = 
     Scheduler.find ()
   in
-  Printf.printf "Scheduler : %s\n" (Scheduler.to_string scheduler);
-  Printf.printf "Launcher  : %s\n" (Launcher.to_string  launcher );
+  Printf.printf "Scheduler : %s\n%!" (Scheduler.to_string scheduler);
+  Printf.printf "Launcher  : %s\n%!" (Launcher.to_string  launcher );
 
 
   (* Create the node file *)
-  let server_file = 
-    Filename.concat ezfio_filename "nodefile"
-  in
-  Out_channel.with_file server_file ~f:(fun out_channel ->
-    Launcher.create_nodefile ()
-    |> Out_channel.output_string out_channel 
-  ) ;
+  (*
+  let () =
+    let server_file = 
+      Filename.concat ezfio_filename "nodefile"
+    in
+    Out_channel.with_file server_file ~f:(fun out_channel ->
+      Launcher.create_nodefile ()
+      |> Out_channel.output_string out_channel 
+    ) 
+  *)
   
 
   (* Get the configuration of executables *)
@@ -32,46 +34,46 @@ let full_run ?(start_dataserver=true) ezfio_filename  =
   if (start_dataserver) then
     begin
       (* Reset socket address in EZFIO *)
-      Ezfio.set_simulation_http_server "tcp://localhost:65534";
+      Ezfio.set_simulation_http_server "tcp://127.0.0.1:65534";
 
 
       (* Start the data server *)
       let prog, args = 
-        qmcchem,  [ qmcchem; "run" ; "-d" ; ezfio_filename]
+        qmcchem,  [| qmcchem; "run" ; "-d" ; ezfio_filename |]
       in
       let pid_dataserver = 
         Watchdog.fork_exec ~prog ~args ()
       in
-      Printf.printf "%7d : %s\n%!" (Pid.to_int pid_dataserver) (String.concat ~sep:" " args)
+      Printf.printf "%7d : %s\n%!" pid_dataserver (String.concat " " (Array.to_list args))
     end;
   
 
-  (* Check if the ZMQ Rep socket is open *)
+  (* Check if the Zmq Rep socket is open *)
   let test_open_rep_socket () =
     let zmq_context =
-      ZMQ.Context.create ()
+      Zmq.Context.create ()
     in
     let socket = 
-      ZMQ.Socket.create zmq_context ZMQ.Socket.req
+      Zmq.Socket.create zmq_context Zmq.Socket.req
     and address = 
       Ezfio.get_simulation_http_server ()
     in
+    Zmq.Socket.set_receive_timeout socket 100;
     let reply = 
        try
         (
-           ZMQ.Socket.set_receive_timeout socket 100;
-           ZMQ.Socket.connect socket address;
-           ZMQ.Socket.send socket (Message.(to_string Test));
-           ZMQ.Socket.recv socket
+           Zmq.Socket.connect socket address;
+           Zmq.Socket.send socket (Message.(to_string Test));
+           Zmq.Socket.recv socket
          ) with
        | Unix.Unix_error _ ->
            begin
-             ZMQ.Socket.set_linger_period socket 1 ;
-             ZMQ.Socket.close socket;
-             ZMQ.Context.terminate zmq_context;
              "Failed"
            end
     in
+    Zmq.Socket.set_linger_period socket 1 ;
+    Zmq.Socket.close socket;
+    Zmq.Context.terminate zmq_context;
     reply = "OK"
   in
 
@@ -83,7 +85,7 @@ let full_run ?(start_dataserver=true) ezfio_filename  =
   | n  -> 
     if (not (test_open_rep_socket ())) then
       begin
-       Time.pause (Time.Span.of_float 0.5);
+       Unix.sleep 2;
        count (n-1);
       end
     else
@@ -91,23 +93,26 @@ let full_run ?(start_dataserver=true) ezfio_filename  =
   in
   if (not (count 300)) then
     Watchdog.kill ();
+  Unix.sleep 3;
      
 
   (* Start the qmc processes *)
-  let prog, args =
+  let prog, args_list =
     let launcher =
       Launcher.(find () |> to_string)
     in
     match launcher
-    |> String.split ~on:' '
-    |> List.map ~f:String.strip
-    |> List.filter ~f:(fun x -> x <> "")
+    |> String.split_on_char ' '
+    |> List.rev_map String.trim
+    |> List.rev
+    |> List.filter (fun x -> x <> "")
     with
     | launcher_exe::launcher_flags -> 
        launcher_exe, launcher_exe :: launcher_flags @ qmc @ [ 
          Ezfio.get_simulation_http_server () ; ezfio_filename ] 
     | _ -> failwith "Error in launcher"
   in
+  let args = Array.of_list args_list in
   let pid_qmc = 
     try 
       Watchdog.fork_exec ~prog ~args ()
@@ -115,7 +120,7 @@ let full_run ?(start_dataserver=true) ezfio_filename  =
     | Unix.Unix_error _ ->
         begin
           let command = 
-            String.concat ~sep:" " args 
+            String.concat " " args_list
           in
           Printf.printf "
 ============================================================
@@ -126,7 +131,7 @@ Error: Unable to run the following command
           Watchdog.kill () 
         end
   in
-  Printf.printf "%7d : %s\n%!" (Pid.to_int pid_qmc) (String.concat ~sep:" " args);  
+  Printf.printf "%7d : %s\n%!" pid_qmc (String.concat " " args_list);  
 
   (* Wait for processes to finish *)
   Watchdog.join ()
@@ -143,24 +148,22 @@ let ssh_run host dataserver ezfio_filename =
 
 let run a d ?q ?s ezfio_filename = 
 
-  Ezfio.set_file ezfio_filename;
-  let ezfio_filename = 
-    Lazy.force Qputils.ezfio_filename
-  in
+  Qputils.set_ezfio_filename ezfio_filename;
 
   (* Signal handler to Kill properly all the processes *)
-  let handler s = 
-    Printf.printf "Received the %s signal... killing\n" (Signal.to_string s);
+  let handler s =
+    Printf.printf "QMC=Chem received signal %d... killing\n%!" s;
     Watchdog.kill ();
   in
-  List.iter [
-     Signal.term ;
-     Signal.quit ;
-     Signal.int  
+  List.iter (fun s -> ignore @@ Sys.signal s (Sys.Signal_handle handler))
+    [
+      Sys.sigint  ;
+      Sys.sigterm ;
+      Sys.sigquit ;                                                                           
     ]
-    ~f:(fun x -> Signal.Expert.handle x handler)
   ;
 
+
   (* Validate input *)
   Input.validate ();
 (*  Printf.printf "MD5 : %s\n" (Lazy.force Md5.hash) ; *)
@@ -188,30 +191,45 @@ let run a d ?q ?s ezfio_filename =
 
 
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> flag "a" no_arg
-     ~doc:(" Add more resources to a running calculation.")
-  +> flag "d" no_arg
-     ~doc:(" Start a dataserver process on the local host.")
-  +> flag "q" (optional string)
-     ~doc:("<dataserver_addr> Start a qmc process on the local host.")
-  +> flag "s" (optional string)
-     ~doc:("<host> Start a qmc process on <host>.")
-  +> anon ("ezfio_file" %: string)
-
-
-
-let command =
-    Command.basic
-    ~summary: "Run a calculation"
-    ~readme:(fun () ->
-      "
-Run QMC=Chem
-      ")
-    spec
-    (fun a d q s ezfio_file () -> run a d ?q ?s ezfio_file )
+let command () =
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Run a calculation";
+
+    [ { short='a' ; long="add" ; opt=Optional ;
+        doc="Add more resources to a running calculation" ;
+        arg=Without_arg ; };
+
+      { short='d' ; long="data-server" ; opt=Optional ;
+        doc="Start a dataserver process on the local host" ;
+        arg=Without_arg ; };
+
+      { short='q' ; long="local-qmc" ; opt=Optional ;
+        doc="Start a qmc process on the local host attached to the addres given as an argument" ;
+        arg=With_arg "<string>" ; };
+
+      { short='s' ; long="remote-qmc" ; opt=Optional ;
+        doc="Start a qmc process on the remote host as an argument" ;
+        arg=With_arg "<string>" ; };
+
+      anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
+    ]
+    |> set_specs
+  end;
+
+  let a = Command_line.get_bool "add" in
+  let d = Command_line.get_bool "data-server" in
+  let q = Command_line.get "local-qmc" in
+  let s = Command_line.get "remote-qmc" in
+
+  let ezfio_file =
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file                                                          
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
+
+  run a d ?q ?s ezfio_file 
 
 
 

ocaml/Qmcchem_stop.ml

@@ -1,24 +1,23 @@
-open Core.Std
-
 
 let run ezfio_filename = 
-  Ezfio.set_file ezfio_filename ;
+  Qputils.set_ezfio_filename ezfio_filename;
   Status.write Status.Stopping
 
+let command () = 
+  let open Command_line in
+  begin
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
+    set_description_doc "Stop a running calculation";
+    [ anonymous "EZFIO_DIR" Mandatory "EZFIO directory" ]
+    |> set_specs
+  end;
 
-let spec =
-  let open Command.Spec in
-  empty
-  +> anon ("ezfio_file" %: string)
+  let ezfio_file = 
+    match Command_line.anon_args () with
+    | ezfio_file :: [] -> ezfio_file
+    | _ -> (Command_line.help () ; failwith "Inconsistent command line")
+  in
 
-let command = 
-    Command.basic
-    ~summary: "Stop a running calculation"
-    ~readme:(fun () ->
-      "
-Stop a running calculation
-      ")
-    spec
-    (fun ezfio_file () ->  run ezfio_file )
+  run ezfio_file
 
 

ocaml/Qputils.ml

@@ -1,42 +1,52 @@
-open Core.Std
-
 let split_re = 
   Str.regexp " +"
 
 
 let split s =
-  String.strip s
+  String.trim s
   |> Str.split split_re
 
 
+let set_ezfio_filename ezfio_filename =
+  let () = 
+    if (not (Sys.file_exists ezfio_filename)) then
+      failwith (ezfio_filename^" does not exist")
+  in
+  let () =
+    if Sys.file_exists ezfio_filename && Sys.is_directory ezfio_filename then
+      Ezfio.set_file ezfio_filename 
+    else
+      failwith ("Error : "^ezfio_filename^" is not a directory")
+  in 
+  let dir, result =
+    Filename.dirname ezfio_filename,
+    Filename.basename ezfio_filename
+  in
+  Unix.chdir dir ;
+  Ezfio.set_file result
+  
+
 let ezfio_filename = lazy (
   let f =
     !Ezfio.ezfio_filename
   in
   let full_path = 
-    begin
-      if f = "EZFIO_File" then
+    match f with
+    | "EZFIO_File" ->
         begin
-          if (Array.length Sys.argv = 1) then
-             failwith "Error : EZFIO directory not specified on the command line\n";
-          let ezfio_filename = Sys.argv.(1)
+          let args =
+            Command_line.anon_args ()
+            |> Array.of_list
           in
-          let () =
-            match (Sys.is_directory ezfio_filename) with
-            | `Yes -> Ezfio.set_file ezfio_filename ;
-            | _ -> failwith ("Error : "^ezfio_filename^" not found")
-          in ezfio_filename
+          if (Array.length args < 1) then
+             failwith "Error : EZFIO directory not specified on the command line\n";
+          args.(0)
         end
-      else
-        f
-    end
+    | f -> f
   in
-  let dir, result =
-    Filename.realpath full_path
-    |> Filename.split
-  in
-  Unix.chdir dir;
-  result
+  set_ezfio_filename full_path;
+
+  !Ezfio.ezfio_filename
 )
 
 

ocaml/Sample.ml

@@ -1,35 +1,35 @@
-open Core.Std
+open Sexplib.Std
 
-type t = 
+type t =
   | One_dimensional  of float
   | Multidimensional of (float array * int)
-with sexp
+[@@deriving sexp]
 
 let dimension = function
   | One_dimensional _ -> 1
   | Multidimensional (_,d) -> d
 
-let to_float ?idx x = 
+let to_float ?idx x =
   match (idx,x) with
   | None  , One_dimensional x
-  | Some 0, One_dimensional x  -> x 
+  | Some 0, One_dimensional x  -> x
   | Some i, One_dimensional x  ->
       failwith "Index should not be specified in One_dimensional"
   | None  , Multidimensional (x,_) -> x.(0)
   | Some i, Multidimensional (x,s) when i < s  -> x.(i)
-  | Some i, Multidimensional (x,s) -> 
-      Printf.sprintf "Index out of bounds in Multidimensional 
+  | Some i, Multidimensional (x,s) ->
+      Printf.sprintf "Index out of bounds in Multidimensional
       %d not in [0,%d[ " i s
       |> failwith
 
-let to_float_array = function 
+let to_float_array = function
   | One_dimensional _ -> failwith "Should be Multidimensional"
   | Multidimensional (x,_) -> x
 
-let of_float x = 
+let of_float x =
   One_dimensional x
 
-let of_float_array ~dim x = 
+let of_float_array ~dim x =
   if (Array.length x) <> dim then
     failwith "Inconsistent array size in of_float_array"
   else
@@ -38,9 +38,30 @@ let of_float_array ~dim x =
     | _ -> Multidimensional (x, dim)
 
 let to_string = function
-  | One_dimensional  x -> Float.to_string x
-  | Multidimensional (x,_) -> 
-      Array.map x ~f:Float.to_string
-      |> String.concat_array ~sep:" " 
-      |> Printf.sprintf "%s"
+  | One_dimensional  x -> string_of_float x
+  | Multidimensional (x,_) ->
+      Array.map string_of_float x
+      |> Array.to_list
+      |> String.concat " "
 
+let to_bytes = function
+  | One_dimensional  x -> Qptypes.bytes_of_float x
+  | Multidimensional (x,_) ->
+      let b = Bytes.create (8 * Array.length x) in
+      Array.iteri (fun i x ->
+        Int64.bits_of_float x
+        |> Bytes.set_int64_ne b (i*8) ) x;
+      b
+
+let of_bytes b =
+  match Bytes.length b with
+  | 8 -> let x = Qptypes.float_of_bytes b in
+         One_dimensional x
+  | l -> let len = l/8 in
+let result = 
+         Multidimensional ( Array.init len (fun i ->
+                               Bytes.get_int64_ne b (i*8)
+                               |> Int64.float_of_bits ),
+                           len )
+in
+result

ocaml/Sample.mli

@@ -1,8 +1,10 @@
-type t with sexp
+type t [@@deriving sexp]
 val to_float        : ?idx:int -> t -> float
 val to_float_array  : t -> float array
 val of_float        : float -> t
-val of_float_array  : dim:int -> float array -> t 
+val of_float_array  : dim:int -> float array -> t
 val to_string       : t -> string
+val to_bytes        : t -> bytes
+val of_bytes        : bytes -> t
 val dimension       : t -> int
 

ocaml/Scheduler.ml

@@ -1,5 +1,3 @@
-open Core.Std;;
-
 type t = 
   | SGE
   | PBS
@@ -18,12 +16,10 @@ let to_string = function
 let find () = 
   let scheduler = 
     [  "SLURM_NODELIST" ; "PE_HOSTFILE" ; "PBS_NODEFILE" ]
-    |> List.map ~f:(function x -> 
-         match (Sys.getenv x) with
-           | Some _ -> x
-           | None -> ""
+    |> List.map (function x -> 
+         try ignore @@ (Sys.getenv x) ; Some x with
+         | Not_found -> None
          )
-    |> List.filter ~f:(function x -> x <> "")
     |> List.hd
   in
   let result = 

ocaml/Status.ml

@@ -37,15 +37,18 @@ let to_int = function
 | Stopping  -> 3
 ;;
 
+let is_set = ref false
 
 let read () =
-  Ezfio.set_file (Lazy.force ezfio_filename);
+  if not !is_set then
+    (Ezfio.set_file (Lazy.force ezfio_filename); is_set := true);
   Ezfio.get_simulation_do_run ()
   |> of_int
 ;;
 
 let write x =
-  Ezfio.set_file (Lazy.force ezfio_filename);
+  if not !is_set then
+    (Ezfio.set_file (Lazy.force ezfio_filename); is_set := true);
   to_int x
   |> Ezfio.set_simulation_do_run 
 ;;

ocaml/String_ext.ml

@@ -0,0 +1,160 @@
+include String
+
+(** Split a string on a given character *)
+let split ?(on=' ') str =
+  split_on_char on str
+
+
+(** Strip blanks on the left of a string *)
+let ltrim s =
+    let rec do_work s l =
+        match s.[0] with
+        | '\n'
+        | ' ' -> do_work (sub s 1 (l-1)) (l-1)
+        | _ -> s
+    in
+    let l =
+        length s
+    in
+    if (l > 0) then
+        do_work s l
+    else
+        s
+
+(** Strip blanks on the right of a string *)
+let rtrim s =
+    let rec do_work s l =
+        let newl =
+            l-1
+        in
+        match s.[newl] with
+        | '\n'
+        | ' ' -> do_work (sub s 0 (newl)) (newl)
+        | _ -> s
+    in
+    let l =
+        length s
+    in
+    if (l > 0) then
+        do_work s l
+    else
+        s
+
+
+(** Strip blanks on the right and left of a string *)
+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 =
+        String.length s
+    in
+    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 (i+1) (length-i-1) )
+        else
+           do_work (i+1)
+    in
+    do_work 0
+
+
+(** Split a string in two pieces when a character is found the 1st time from the right *)
+let rsplit2_exn ?(on=' ') s =
+    let length =
+        String.length s 
+    in
+    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 (i+1) (length-i-1) )
+        else
+           do_work (i-1)
+    in
+    do_work (length-1)
+
+
+let lsplit2 ?(on=' ') s =
+  try
+    Some (lsplit2_exn ~on s)
+  with
+  | Not_found -> None
+
+
+let rsplit2 ?(on=' ') s =
+  try
+    Some (rsplit2_exn ~on s)
+  with
+  | Not_found -> None
+
+
+let to_list s =
+  Array.init (String.length s) (fun i -> s.[i])
+  |> Array.to_list
+
+
+let of_list l =
+  let a = Array.of_list l in
+  String.init (Array.length a) (fun i -> a.(i))
+
+let rev s =
+  to_list s
+  |> List.rev
+  |> of_list
+
+let fold ~init ~f s =
+    to_list s
+    |> List.fold_left f init
+
+
+let is_prefix ~prefix s =
+  let len =
+    String.length prefix
+  in
+  if len > String.length s then
+    false
+  else
+    prefix = String.sub s 0 len
+
+
+let of_char c =
+  String.make 1 c
+
+let tr ~target ~replacement s =
+  String.map (fun c -> if c = target then replacement else c) s
+
+
+let substr_index ?(pos=0) ~pattern s =
+  try
+    let regexp = 
+      Str.regexp pattern
+    in
+    Some (Str.search_forward regexp s pos)
+  with Not_found -> None
+
+
+let substr_replace_all ~pattern ~with_ s =
+  let regexp =
+    Str.regexp pattern
+  in
+  Str.global_replace regexp with_ s
+
+
+let input_lines ic =                                                                    
+  let rec aux ic accu =
+    try
+      aux ic ((input_line ic)::accu)
+    with
+    | End_of_file -> List.rev accu
+  in
+  aux ic [] 
+

ocaml/Time.ml

@@ -0,0 +1,50 @@
+let of_sec s =
+  Unix.gmtime s
+
+let to_sec t =
+  let sec  = t.Unix.tm_sec
+  and min  = t.Unix.tm_min
+  and hour = t.Unix.tm_hour
+  and mday = t.Unix.tm_mday
+  in
+  sec +
+  min  * 60 +
+  hour * 60 * 60 + 
+  (mday-1) * 60 * 60 * 24 
+
+let string_of_t t = 
+  let mday = t.Unix.tm_mday - 1 in
+  let sec  = t.Unix.tm_sec
+  and min  = t.Unix.tm_min
+  and hour = t.Unix.tm_hour + 24*mday
+  in
+  Printf.sprintf "%2d:%2.2d:%2.2d" hour min sec
+
+let string_of_date t = 
+  let year = 1900 + t.Unix.tm_year in
+  let mon  = t.Unix.tm_mon  in
+  let mday = t.Unix.tm_mday in
+  let sec  = t.Unix.tm_sec
+  and min  = t.Unix.tm_min
+  and hour = t.Unix.tm_hour 
+  in
+  let month = 
+    match mon with 
+      | 0  -> "Jan" | 1  -> "Feb" | 2  -> "Mar" | 3  -> "Apr"
+      | 4  -> "May" | 5  -> "Jun" | 6  -> "Jul" | 7  -> "Aug"
+      | 8  -> "Sep" | 9  -> "Oct" | 10 -> "Nov" | 11 -> "Dec"
+      | _ -> assert false
+  in
+  Printf.sprintf "%2d %3s %4d - %2d:%2.2d:%2.2d" mday month year hour min sec
+
+
+let string_of_now () = 
+  Unix.gettimeofday ()
+  |> Unix.localtime 
+  |> string_of_date
+
+
+let string_of_sec s = 
+  of_sec s 
+  |> string_of_t 
+

ocaml/Watchdog.ml

@@ -1,18 +1,16 @@
-open Core.Std;;
-
-let _list    = ref [] ;;
-let _running = ref false;;
-let _threads = ref [] ;;
+let _list    = ref [] 
+let _running = ref false
+let _threads = ref [] 
 
 (** Kill the current process and all children *)
 let kill () =
   let kill pid = 
-    Signal.send_i Signal.int (`Pid pid);
-    Printf.printf "Killed %d\n" (Pid.to_int pid)
+    Unix.kill pid Sys.sigkill;
+    Printf.printf "Killed %d\n%!" pid
   in
-  List.iter ~f:kill (!_list);
+  List.iter kill (!_list);
   exit 1 
-;;
+
 
 
 (** Start watchdog *)
@@ -25,14 +23,11 @@ let start () =
       _running := true;
 
       let pause () =
-        Time.Span.of_sec 1.
-        |> Time.pause 
+        Unix.sleep 1
       in
 
       let pid_is_running pid =
-         match (Sys.file_exists ("/proc/"^(Pid.to_string pid)^"/stat")) with
-         | `No | `Unknown ->  false
-         | `Yes -> true
+         Sys.file_exists ("/proc/"^(string_of_int pid)^"/stat")
       in
 
       let f () =
@@ -41,13 +36,13 @@ let start () =
           pause () ;
 
 (*DEBUG
- List.iter (!_list) ~f:(fun x -> Printf.printf "%d\n%!" (Pid.to_int x));
+ List.iter (fun x -> Printf.printf "%d\n%!" x) (!_list) ;
  *)
 
           let continue () =
-            List.fold_left (!_list) ~init:true ~f:(
-              fun accu x -> accu && (pid_is_running x)
-              ) 
+            List.fold_left
+              ( fun accu x -> accu && (pid_is_running x)) 
+              true (!_list)
           in
           if ( not (continue ()) ) then
             kill ()
@@ -55,7 +50,7 @@ let start () =
       in
       _threads := ( (Thread.create f) () ) :: (!_threads)
     end
-;;
+
 
 (** Stop watchdog *)
 let stop () =
@@ -63,14 +58,14 @@ let stop () =
     _running := false
   else
     failwith "Watchdog error: Already stopped"
-;;
+
 
 (** Add a PID to tracking *)
 let add pid = 
   if (not !_running) then
     start ();
   _list := pid :: (!_list)
-;;
+
 
 (** Remove a PID from tracking *)
 let del pid = 
@@ -87,27 +82,26 @@ let del pid =
   match (!_list) with
   | [] -> if (!_running) then stop ()
   | _ -> ()
-;;
+
 
 (** Fork and exec a new process *)
 let fork_exec ~prog ~args () =
   let pid = 
-    Unix.fork_exec ~prog ~args ()
+    match Unix.fork () with
+    | 0 -> Unix.execvp prog args 
+    | pid -> pid
   in
 
   let f () = 
     add pid;
     let success = 
-      match (Unix.waitpid pid) with
-      | Core_kernel.Std.Result.Ok () -> true
-      | Core_kernel.Std.Result.Error (`Exit_non_zero n) ->
-          ( Printf.printf "PID %d exited with code %d\n%!"
-              (Pid.to_int pid) n ;
+      match (Unix.waitpid [] pid) with
+      | pid , Unix.WEXITED n -> true
+      | pid , Unix.WSIGNALED n -> 
+          ( Printf.printf "PID %d killed with signal %d\n%!" pid n;
             false )
-      | Core_kernel.Std.Result.Error (`Signal n) ->
-          ( Printf.printf "PID %d killed with signal %d (%s)\n%!"
-              (Pid.to_int pid) (Signal.to_system_int n)
-              (Signal.to_string n) ;
+      | pid , Unix.WSTOPPED n -> 
+          ( Printf.printf "PID %d stopped with signal %d\n%!" pid n;
             false )
     in
     del pid ;
@@ -116,11 +110,11 @@ let fork_exec ~prog ~args () =
   in
   _threads := ( (Thread.create f) () ) :: (!_threads);
   pid
-;;
+
 
 (** Wait for threads to finish *)
 let join () =
 (*  if (!_running) then stop (); *)
-  List.iter ~f:Thread.join (!_threads);
+  List.iter Thread.join (!_threads);
   assert (not !_running)
-;;
+

ocaml/_tags

@@ -0,0 +1,6 @@
+true: package(cryptokit,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
+true: thread
+false: profile
+<*byte>   : linkdep(c_bindings.o), custom
+<*.native>: linkdep(c_bindings.o)
+

ocaml/build.ninja

@@ -1,83 +0,0 @@
-MAIN=qmcchem
-# Main program to build
-
-PACKAGES=-package core,sexplib.syntax,cryptokit,str,ZMQ
-# Required opam packages, for example:
-# PACKAGES=-package core,sexplib.syntax
-
-THREAD=-thread 
-# If you need threding support, use:
-# THREAD=-thread
-
-SYNTAX=-syntax camlp4o 
-# If you need pre-processing, use:
-# SYNTAX=-syntax camlp4o
-
-OCAMLC_FLAGS=-g -warn-error A
-# Flags to give to ocamlc, for example:
-# OCAMLC_FLAGS=-g -warn-error A
-
-LINK_FLAGS=
-# Flags to give to the linker, for example:
-# LINK_FLAGS=-cclib '-Wl,-rpath=../lib,--enable-new-dtags'
-
-GENERATED_NINJA=generated.ninja
-# Name of the auto-generated ninja file
-
-rule run_ninja
-  command = ../scripts/compile_ocaml.sh $target
-  description = Compiling OCaml executables
-  pool = console
-
-rule run_ninja_ocaml
-  command = ../scripts/compile_ocaml_dep.sh
-  description = Finding dependencies in OCaml files
-
-rule run_clean
-  command = ninja -f $GENERATED_NINJA -t clean ; rm -f $GENERATED_NINJA rm -f *.cmx *.cmi *.o .ls_md5 ; ninja -t clean
-  pool = console
-  description = Cleaning directory
-
-rule ocamlc
-  command = ocamlfind ocamlc -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $in (bytecode)
-
-rule ocamlopt
-  command = ocamlfind ocamlopt -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $in (native)
-
-rule ocamlc_link
-  command = ocamlfind ocamlc $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in 
-  description = Compiling $out (bytecode)
-
-rule ocamlopt_link
-  command = ocamlfind ocamlopt $OCAMLC_FLAGS $THREAD -linkpkg $PACKAGES $PACKAGES $SYNTAX -o $out $in 
-  description = Compiling $out (native)
-
-rule create_qptypes
-  command = ./$in 
-  description = Creating $out
-
-rule copy
-  command = cp $in $out 
-  description = Copying $in to $out
-
-build always: phony 
-build $GENERATED_NINJA: run_ninja_ocaml | Qptypes.ml ezfio.ml always 
-build ezfio.ml: copy ../EZFIO/Ocaml/ezfio.ml
-build Qptypes.ml: create_qptypes qptypes_generator | ezfio.ml
-build qptypes_generator.o qptypes_generator.cmx: ocamlopt qptypes_generator.ml | ezfio.ml
-build qptypes_generator: ocamlopt_link qptypes_generator.cmx
-
-build clean: run_clean 
-
-build $MAIN: run_ninja | ezfio.ml Qptypes.ml $GENERATED_NINJA 
-  target = $MAIN
-
-build all: run_ninja | ezfio.ml Qptypes.ml $GENERATED_NINJA 
-  target = 
-
-default $MAIN
-
-
-

ocaml/c_bindings.c

@@ -0,0 +1,70 @@
+#include <caml/mlvalues.h>                                                                    
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/threads.h>
+
+#include <string.h>
+
+
+
+/* Adapted from
+   https://github.com/monadbobo/ocaml-core/blob/master/base/core/lib/linux_ext_stubs.c
+*/
+
+#include <unistd.h>
+#include <sys/ioctl.h>
+#include <net/if.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+
+CAMLprim value get_ipv4_address_for_interface(value v_interface)
+{
+  CAMLparam1(v_interface);
+  struct ifreq ifr;
+  int fd = -1;
+  value res;
+  char* error = NULL;
+
+  memset(&ifr, 0, sizeof(ifr));
+  ifr.ifr_addr.sa_family = AF_INET;
+  /* [ifr] is already initialized to zero, so it doesn't matter if the
+     incoming string is too long, and [strncpy] fails to add a \0. */
+  strncpy(ifr.ifr_name, String_val(v_interface), IFNAMSIZ - 1);
+
+  caml_enter_blocking_section();
+  fd = socket(AF_INET, SOCK_DGRAM, 0);
+
+  if (fd == -1)
+    error = "error: couldn't allocate socket";
+  else {
+    if (ioctl(fd, SIOCGIFADDR, &ifr) < 0)
+      error = "error: ioctl(fd, SIOCGIFADDR, ...) failed";
+
+    (void) close(fd);
+  }
+
+  caml_leave_blocking_section();
+
+  if (error == NULL) {                                                                        
+    /* This is weird but doing the usual casting causes errors when using
+     * the new gcc on CentOS 6.  This solution was picked up on Red Hat's
+     * bugzilla or something.  It also works to memcpy a sockaddr into
+     * a sockaddr_in.  This is faster hopefully.
+     */
+    union {
+      struct sockaddr sa;
+      struct sockaddr_in sain;
+    } u;
+    u.sa = ifr.ifr_addr;
+    res = caml_copy_string(inet_ntoa(u.sain.sin_addr));
+  }
+  else
+    res = caml_copy_string(error);
+  CAMLreturn(res);
+
+}
+
+
+

ocaml/compile.sh

@@ -25,7 +25,7 @@ if [[ ${MD5} != ${REF} ]]
 then
   echo ${MD5} > ${LSMD5_FILE}
   echo Finding dependencies in OCaml files
-  python ./ninja_ocaml.py
+  python2 ./ninja_ocaml.py
 fi
 
 ninja ${@}

ocaml/myocamlbuild.ml

@@ -0,0 +1,13 @@
+open Ocamlbuild_plugin;;
+
+dispatch begin function
+  | Before_rules ->
+    begin
+    end
+  | After_rules ->
+    begin
+      flag ["ocaml";"compile";"native";"gprof"] (S [ A "-p"]);
+      pdep ["link"] "linkdep" (fun param -> [param]);
+    end
+  | _ -> ()
+end

ocaml/ninja_ocaml.py

@@ -1,288 +0,0 @@
-#!/usr/bin/env python
-#
-#  Copyright 2015 Anthony Scemama
-#
-#  Licensed under the Apache License, Version 2.0 (the "License");
-#  you may not use this file except in compliance with the License.
-#  You may obtain a copy of the License at
-#
-#      http://www.apache.org/licenses/LICENSE-2.0
-#
-#  Unless required by applicable law or agreed to in writing, software
-#  distributed under the License is distributed on an "AS IS" BASIS,
-#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-#  See the License for the specific language governing permissions and
-#  limitations under the License.
-#
-#  This file can be downloaded here:
-#  https://raw.githubusercontent.com/scemama/ninja_ocaml/master/ninja_ocaml.py
-#
-
-"""Build OCaml projects using ninja."""
-
-__author__ = """Anthony Scemama <scemama@irsamc.ups-tlse.fr>"""
-
-import os
-import sys
-import subprocess
-
-def _help_ ():
-  print """
-  1) Download and install ninja :
-     https://github.com/martine/ninja/releases/latest
-  2) Copy the script into your OCaml project.
-  3) Run the script. It will build a default build.ninja file
-  4) Edit the build.ninja file
-  5) Compile the main target using `ninja`
-  6) Compile all the targets using `ninja all`
-  """
-
-def create_generated_ninja():
-  """Creates the generated.ninja file"""
-
-  # Header
-  PACKAGES=""
-  THREAD=""
-  SYNTAX=""
-  OCAMLC_FLAGS=""
-  GENERATED_NINJA="generated.ninja"
-  with open('build.ninja','r') as f:
-      for line in f:
-          if line.startswith("PACKAGES"):
-              PACKAGES=line.split('=',1)[1].strip()
-          elif line.startswith("THREAD"):
-              THREAD=line.split('=',1)[1].strip()
-          elif line.startswith("SYNTAX"):
-              SYNTAX=line.split('=',1)[1].strip()
-          elif line.startswith("OCAMLC_FLAGS"):
-              OCAMLC_FLAGS=line.split('=',1)[1].strip()
-          elif line.startswith("LINK_FLAGS"):
-              LINK_FLAGS=line.split('=',1)[1].strip()
-          elif line.startswith("GENERATED_NINJA"):
-              GENERATED_NINJA=line.split('=',1)[1].strip()
-
-  if PACKAGES != "":
-      LINK_FLAGS = "-linkpkg "+PACKAGES
-
-  header = [
-"""
-########################################################
-# This file was auto-generated.                        #
-# This file will be overwritten. Don't edit this file! #
-# Changes should be done in the build.ninja file.      #
-########################################################
-
-""",
-
-             "PACKAGES=%s"%(PACKAGES),
-             "THREAD=%s"%(THREAD),
-             "SYNTAX=%s"%(SYNTAX),
-             "OCAMLC_FLAGS=%s"%(OCAMLC_FLAGS),
-             "LINK_FLAGS=%s"%(LINK_FLAGS),
-             "GENERATED_NINJA=%s"%(GENERATED_NINJA),
-             ]
-
-  header += """
-rule ocamlc
-  command = ocamlfind ocamlc -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $out (bytecode)
-
-rule ocamlopt
-  command = ocamlfind ocamlopt -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $o $in
-  description = Compiling $out (native)
-
-rule ocamlc_link
-  command = ocamlfind ocamlc $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $out (bytecode)
-
-rule ocamlopt_link
-  command = ocamlfind ocamlopt $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $out (native)
-
-""".splitlines()
-
-  # Get the list of .ml files
-  all_files = os.listdir(os.getcwd())
-  files = [ os.path.splitext(i)[0] for i in all_files if i.endswith('.ml') ]
-  while "myocamlbuild" in files:
-    files.remove("myocamlbuild")
-  ml_files = ' '.join( [ '%s.ml'%i for i in files ] )
-
-  # Dependencies
-  result = subprocess.Popen(
-      ("ocamlfind ocamldep {0} {1} {2}".format(PACKAGES,SYNTAX,ml_files)).split()
-      ,stdout=subprocess.PIPE).communicate()[0]
-  result = result.replace('\\\n',' ')
-  dependencies = {}
-  for line in result.splitlines():
-      key, value = line.split(':')
-      dependencies[key.strip()] = value.strip()
-
-  result = header
-  template = """
-build {0}.cmi: ocamlc {0}.mli  | $GENERATED_NINJA
-build {0}.cmo: ocamlc {0}.ml  | $GENERATED_NINJA {1}
-build {0}.cmx {0}.o: ocamlopt {0}.ml | $GENERATED_NINJA {2}
-  o = {0}.o
-"""
-
-  template_root_byte = """
-build {2}.byte: ocamlc_link {1} {0}
-"""
-
-  template_root_native = """
-build {2}: ocamlopt_link {1} {0}
-"""
-
-  # Find roots
-  dep = {}
-  for f in dependencies:
-      dep[f] = [ i.strip() for i in dependencies[f].split() ]
-
-  roots = {}
-  for f in dependencies:
-      Found = False
-      for g,l in dep.iteritems():
-          if f in l:
-              Found = True
-      if not Found:
-         roots[f] = []
-
-  def get_deps(l):
-    result = []
-    for i in l:
-      if i in dep:
-        result += get_deps(dep[i])
-    result += l
-    newresult = []
-    for r in result:
-      if r not in newresult:
-        newresult.append(r)
-    return newresult
-
-  for r in roots:
-    roots[r] = [ i for i in get_deps(dep[r]) if not i.endswith(".cmi") ]
-
-  # Write the $GENERATED_NINJA file
-  result += [ template.format(basename,
-                              dependencies["%s.cmo"%basename],
-                              dependencies["%s.cmx"%basename]
-                              ) for basename in files ]
-  result += [ template_root_byte.format(basename,
-                               ' '.join(roots[basename]),
-                               os.path.splitext(basename)[0]
-                              ) for basename in roots if basename.endswith('.cmo')]
-  result += [ template_root_native.format(basename,
-                               ' '.join(roots[basename]),
-                               os.path.splitext(basename)[0]
-                              ) for basename in roots if basename.endswith('.cmx')]
-
-  output = '\n'.join(result)
-  try:
-    with open(GENERATED_NINJA,'r') as f:
-      inp = f.read()
-  except IOError:
-    inp = ""
-
-  if inp != output:
-    with open(GENERATED_NINJA,'w') as f:
-      f.write(output)
-
-def create_build_ninja ():
-    with open('build.ninja','w') as f:
-        f.write("""
-MAIN=
-# Main program to build
-
-PACKAGES=
-# Required opam packages, for example:
-# PACKAGES=-package core,sexplib.syntax
-
-THREAD=
-# If you need threding support, use:
-# THREAD=-thread
-
-SYNTAX=
-# If you need pre-processing, use:
-# SYNTAX=-syntax camlp4o
-
-OCAMLC_FLAGS=
-# Flags to give to ocamlc, for example:
-# OCAMLC_FLAGS=-g -warn-error A
-
-LINK_FLAGS=
-# Flags to give to the linker, for example:
-# LINK_FLAGS=-cclib '-Wl,-rpath=../lib,--enable-new-dtags'
-
-GENERATED_NINJA=generated.ninja
-# Name of the auto-generated ninja file
-
-rule create_generated
-  command = python ./ninja_ocaml.py
-  description = Finding dependencies between modules
-
-rule run_ninja
-  command = ninja -f $in $target
-  description = Compiling OCaml executables
-  pool = console
-
-rule run_clean
-  command = ninja -f $GENERATED_NINJA -t clean ; rm $GENERATED_NINJA
-  pool = console
-  description = Cleaning directory
-
-rule ocamlc
-  command = ocamlfind ocamlc -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $in (bytecode)
-
-rule ocamlopt
-  command = ocamlfind ocamlopt -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $in (native)
-
-rule ocamlc_link
-  command = ocamlfind ocamlc $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $out (bytecode)
-
-rule ocamlopt_link
-  command = ocamlfind ocamlopt $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in
-  description = Compiling $out (native)
-
-
-build clean: run_clean
-build always $GENERATED_NINJA: create_generated
-
-build $MAIN: run_ninja $GENERATED_NINJA
-  target = $MAIN
-
-build all: run_ninja $GENERATED_NINJA
-  target =
-
-default $MAIN
-
-""")
-
-
-def main():
-
-    for h in "help -h -help --help ?".split():
-        if h in sys.argv:
-            _help_ ()
-            return
-
-    if "build.ninja" in os.listdir(os.getcwd()):
-        create_generated_ninja ()
-    else:
-        create_build_ninja ()
-        print """
-==========================================================
-A default build.ninja file was created.
-Now, edit build.ninja and compile your project using:
-
-  ninja
-
-==========================================================
-"""
-
-if __name__ == '__main__':
-    main()
-

ocaml/qmcchem.ml

@@ -1,16 +1,60 @@
-open Core.Std
+let update_command_line () =
+  let last = (Array.length Sys.argv) - 2 in
+  Sys.argv.(0) <- Sys.argv.(0) ^ "_" ^ Sys.argv.(1);
+  for i=1 to last do
+    Sys.argv.(i) <- Sys.argv.(i+1)
+  done;
+  Sys.argv.(last+1) <- ""
 
 
-let command =
-    Command.group ~summary:"QMC=Chem command" [
-          "debug" , Qmcchem_debug.command ;
-          "edit"  , Qmcchem_edit.command ;
-          "info"  , Qmcchem_info.command ;
-          "md5"   , Qmcchem_md5.command ;
-          "result", Qmcchem_result.command ;
-          "run"   , Qmcchem_run.command ;
-          "stop"  , Qmcchem_stop.command ;
-    ]
+let help () = 
+  Printf.printf "
+qmcchem - QMC=Chem command 
+
+Usage:
+  
+  qmcchem [-h] COMMAND
+  
+Arguments:
+  
+  COMMAND       QMC=Chem command to run :
+                [run|edit|stop|result|md5|info|debug] 
+  
+Options:
+  
+  -h  --help    Prints the help message. 
+  
+Description:
+  
+  Driver for subcommands. 
+
+"
+
+let () =
+  if Array.length Sys.argv < 2 then
+    (help (); failwith "Inconsistent command line") ;
+  
+  match String.trim Sys.argv.(1) with
+  | "-h" | "--help" -> 
+    begin
+      help () ;
+      exit 0
+    end
+  | _ -> 
+    begin
+      let command =
+        Sys.argv.(1)
+      in
+      update_command_line ();
+
+      match command with
+      | "debug"  -> let open Qmcchem_debug  in command ()
+      | "edit"   -> let open Qmcchem_edit   in command ()
+      | "info"   -> let open Qmcchem_info   in command ()
+      | "md5"    -> let open Qmcchem_md5    in command ()
+      | "result" -> let open Qmcchem_result in command ()
+      | "run"    -> let open Qmcchem_run    in command ()
+      | "stop"   -> let open Qmcchem_stop   in command ()
+      | _        -> (help () ; failwith "Inconsistent command line")
+    end
 
-let () = 
-  Command.run command

ocaml/qptypes_generator.ml

@@ -1,85 +1,106 @@
-open Core.Std;;
+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"
+  |> Str.global_replace (Str.regexp "Int.to_string") "string_of_int"
+  |> Str.global_replace (Str.regexp "Int.of_string") "int_of_string"
+  |> Str.global_replace (Str.regexp "Int.to_bytes") "bytes_of_int"
+  |> Str.global_replace (Str.regexp "Int64.to_bytes") "bytes_of_int64"
+  |> Str.global_replace (Str.regexp "Float.to_bytes") "bytes_of_float"
+  |> Str.global_replace (Str.regexp "Float.of_bytes") "float_of_bytes"
+  |> Str.global_replace (Str.regexp "Int.of_bytes") "int_of_bytes"
+  |> Str.global_replace (Str.regexp "Int64.of_bytes") "int64_of_bytes"
+  |> Str.global_replace (Str.regexp "String.\\(to\\|of\\)_string") ""
+  |> Str.global_replace (Str.regexp "String.to_bytes") "Bytes.of_string"
+  |> Str.global_replace (Str.regexp "String.of_bytes") "Bytes.to_string"
 
 let input_data = "
-* Positive_float : float  
-  assert (x >= 0.) ; 
+* Positive_float : float
+  if not (x >= 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\"  x));
 
-* Strictly_positive_float : float  
-  assert (x > 0.) ; 
+* 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  
-  assert (x <= 0.) ; 
+* Negative_float : float
+  if not (x <= 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
 
-* Strictly_negative_float : float  
-  assert (x < 0.) ; 
+* Strictly_negative_float : float
+  if not (x < 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
 
-* Positive_int : int  
-  assert (x >= 0) ; 
+* Positive_int64 : int64
+  if not (x >= 0L) then
+    raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
 
-* Strictly_positive_int : int  
-  assert (x > 0) ; 
+* Positive_int : int
+  if not (x >= 0) then
+    raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
 
-* Negative_int : int  
-  assert (x <= 0) ; 
+* Strictly_positive_int : int
+  if not (x > 0) then
+    raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
+
+* Negative_int : int
+  if not (x <= 0) then
+    raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
+  assert (x <= 0) ;
 
 * Det_coef : float
-  assert (x >= -1.) ; 
-  assert (x <=  1.) ; 
+  if (x < -1.) || (x > 1.) then
+    raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
 
 * Normalized_float : float
-  assert (x <= 1.) ; 
-  assert (x >= 0.) ; 
+  if (x < 0.) || (x > 1.) then
+    raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
 
-* Strictly_negative_int : int  
-  assert (x < 0) ; 
+* Strictly_negative_int : int
+  if not (x < 0) then
+    raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
 
 * Non_empty_string : string
-  assert (x <> \"\") ;
+  if (x = \"\") then
+    raise (Invalid_argument \"Non_empty_string\");
 
 
-* Det_number_max : int 
-  assert (x > 0) ; 
-  if (x > 100000000) then
+* Det_number_max : int
+  assert (x > 0) ;
+  if (x > 100_000_000) then
     warning \"More than 100 million determinants\";
-"^
-(*
-"
-* States_number : int 
-  assert (x > 0) ; 
-  if (x > 100) then
-    warning \"More than 100 states\";
-  if (Ezfio.has_determinants_n_states_diag ()) then
-    assert (x <= (Ezfio.get_determinants_n_states_diag ()))
-  else if (Ezfio.has_determinants_n_states ()) then
-    assert (x <= (Ezfio.get_determinants_n_states ()));
 
-* Bit_kind_size : int  
+* States_number : int
+  assert (x > 0) ;
+  if (x > 1000) then
+    warning \"More than 1000 states\";
+
+* Bit_kind_size : int
   begin match x with
   | 8 | 16 | 32 | 64 -> ()
-  | _ -> raise (Failure \"Bit_kind_size should be (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 (Failure \"Bit_kind should be (1|2|4|8).\")
+  | _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
   end;
 
 * Bitmask_number : int
   assert (x > 0) ;
-"^
-*)
-"
 
 * MO_coef : float
 
 * MO_occ : float
-  assert (x >= 0.); 
+  if x < 0. then 0.  else
+  if x > 2. then 2.  else
 
 * AO_coef : float
 
-* AO_expo : float  
-  assert (x >= 0.) ; 
+* AO_expo : float
+  if (x < 0.) then
+    raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
 
 * AO_prim_number : int
   assert (x > 0) ;
@@ -102,6 +123,12 @@ let input_data = "
 
 * MD5 : string
   assert ((String.length x) = 32);
+  assert (
+    let a =
+      Array.init (String.length x) (fun i -> x.[i])
+    in
+    Array.fold_left (fun accu x -> accu && (x < 'g')) true a
+    );
 
 * Rst_string : string
 
@@ -116,97 +143,131 @@ let input_data = "
   assert (x <> \"\") ;
 
 "
-;;
+
 
 let input_ezfio = "
 * MO_number : int
-  mo_basis_mo_tot_num
-  1 : 10000
-  More than 10000 MOs
+  mo_basis_mo_num
+  1 : 10_000
+  More than 10_000 MOs
 
 * AO_number : int
   ao_basis_ao_num
-  1 : 10000
-  More than 10000 AOs
+  1 : 10_000
+  More than 10_000 AOs
 
 * Nucl_number : int
   nuclei_nucl_num
-  1 : 10000
-  More than 10000 nuclei
+  1 : 10_000
+  More than 10_000 nuclei
 
-"^
-(*
-"
 * N_int_number : int
-  determinants_n_int
+  spindeterminants_n_int
   1 : 30
   N_int > 30
 
 * Det_number : int
-  determinants_n_det
-  1 : 100000000
+  spindeterminants_n_det
+  1 : 100_000_000
   More than 100 million determinants
-" 
-*)
-""
-;;
+
+"
+
 
 let untouched = "
+let bytes_of_int64 i =
+  let result = Bytes.create 8 in
+  Bytes.set_int64_ne result 0 i;
+  result
+
+let bytes_of_int i =
+  Int64.of_int i
+  |> bytes_of_int64
+
+
+let int64_of_bytes b =
+  Bytes.get_int64_ne b 0
+
+
+let int_of_bytes b =
+  int64_of_bytes b
+  |> Int64.to_int
+
+
+let float_of_bytes b =
+  int64_of_bytes b
+  |> Int64.float_of_bits
+
+
+let bytes_of_float f =
+  Int64.bits_of_float f
+  |> bytes_of_int64
+
 "
 
 let template = format_of_string "
 module %s : sig
-  type t with sexp
+  type t [@@deriving sexp]
   val to_%s : t -> %s
   val of_%s : %s %s -> t
   val to_string : t -> string
+  val to_bytes  : t -> bytes
+  val of_bytes  : bytes -> t
 end = struct
-  type t = %s with sexp
+  type t = %s [@@deriving sexp]
   let to_%s x = x
   let of_%s %s x = ( %s x )
   let to_string x = %s.to_string x
+  let to_bytes  x = %s.to_bytes  x
+  let of_bytes  b = %s.of_bytes  b
 end
 
 "
-;;
+
+
 
 let parse_input input=
+  print_string "open Sexplib.Std\nlet warning = print_string\n" ;
   let rec parse result = function
     | [] -> result
     | ( "" , ""   )::tail -> parse result tail
-    | ( t  , text )::tail -> 
-        let name,typ,params,params_val = 
-          match String.split ~on:':' t with
+    | ( t  , text )::tail ->
+        let name,typ,params,params_val =
+          match String.split_on_char ':' t with
           | [name;typ] -> (name,typ,"","")
           | name::typ::params::params_val -> (name,typ,params,
-            (String.concat params_val ~sep:":") )
+            (String.concat ":" params_val) )
           | _ -> assert false
         in
-        let typ  = String.strip typ
-        and name = String.strip name in
-        let typ_cap = String.capitalize typ in
-        let newstring = Printf.sprintf template name typ typ typ params_val typ typ 
-          typ typ params ( String.strip text ) typ_cap
+        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
+          typ typ params ( String_ext.strip text ) typ_cap typ_cap typ_cap
         in
         List.rev (parse (newstring::result) tail )
   in
-     String.split ~on:'*' input
-  |> List.map ~f:(String.lsplit2_exn ~on:'\n') 
+     String_ext.split ~on:'*' input
+  |> List.map (String_ext.lsplit2_exn ~on:'\n')
   |> parse []
-  |> String.concat 
-;;
+  |> String.concat  ""
+  |> global_replace
+  |> print_string
+
 
 
 let ezfio_template = format_of_string "
 module %s : sig
-  type t with sexp
+  type t [@@deriving sexp]
   val to_%s : t -> %s
   val get_max : unit -> %s
   val of_%s : ?min:%s -> ?max:%s -> %s -> t
   val to_string : t -> string
+  val to_bytes  : t -> bytes
 end = struct
-  type t = %s with sexp
+  type t = %s [@@deriving sexp]
   let to_string x = %s.to_string x
+  let to_bytes  x = %s.to_bytes  x
   let get_max () =
     if (Ezfio.has_%s ()) then
       Ezfio.get_%s ()
@@ -215,7 +276,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
@@ -223,113 +284,129 @@ end = struct
       begin
         match max with
         | %s -> ()
-        | i  -> assert ( x <= i )
+        | i  ->
+          if ( x > i ) then
+            raise (Invalid_argument (Printf.sprintf \"%s: %%s\" (%s.to_string x) ))
       end ;
       x
     end
 end
 "
 
+(*
+  val of_bytes  : bytes -> t
+  let of_bytes  x = %s.of_bytes  x
+*)
 
 let parse_input_ezfio input=
-  let parse s = 
+  let parse s =
     match (
-      String.split s ~on:'\n'
-      |> List.filter ~f:(fun x -> (String.strip x) <> "")
+      String_ext.split s ~on:'\n'
+      |> List.filter (fun x -> (String_ext.strip x) <> "")
     ) with
     | [] -> ""
     | a :: b :: c :: d :: [] ->
       begin
-        let (name,typ) = String.lsplit2_exn ~on:':' a
+        let (name,typ) = String_ext.lsplit2_exn ~on:':' a
         and ezfio_func = b
-        and (min, max) = String.lsplit2_exn ~on:':' c
+        and (min, max) = String_ext.lsplit2_exn ~on:':' c
         and msg = d
-        in 
-        let (name, typ, ezfio_func, min, max, msg) = 
-        match (List.map [ name ; typ ; ezfio_func ; min ; max ; msg ] ~f:String.strip) with
+        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 
-          name typ typ typ typ typ typ typ typ (String.capitalize typ)
-          ezfio_func ezfio_func max min typ typ max msg min
+        let typ_cap = String.capitalize_ascii typ in
+        Printf.sprintf ezfio_template
+          name typ typ typ typ typ typ typ typ typ_cap typ_cap
+          ezfio_func ezfio_func max min typ typ max msg min name typ_cap
       end
     | _ -> failwith "Error in input_ezfio"
   in
-     String.split ~on:'*' input
-  |> List.map ~f:parse
-  |> String.concat 
+     String_ext.split ~on:'*' input
+  |> List.map parse
+  |> String.concat ""
+  |> global_replace
+  |> print_string
+
 
 
 (** EZFIO *)
+let input_lines filename =
+  let ic = open_in filename in
+  let result = String_ext.input_lines ic in
+  close_in ic;
+  result
+
+
 let create_ezfio_handler () =
-  let lines = 
-    In_channel.with_file "ezfio.ml" ~f:In_channel.input_lines
-    |> List.filteri ~f:(fun i _ -> i > 470)
+  let lines =
+    input_lines "ezfio.ml"
+    (* /!\ Change when ezfio.ml changes *)
+    |> List.mapi (fun i l -> if i > 442 then Some l else None)
+    |> List.filter (fun x -> x <> None)
+    |> List.map (fun x ->
+        match x with
+        | Some x -> x
+        | None -> assert false)
   in
-  let functions = 
-    List.map lines ~f:(fun x ->
-      match String.split x ~on:' ' with
+  let functions =
+    List.map (fun x ->
+      match String.split_on_char ' ' x with
       | _ :: x :: "()" :: "=" :: f :: dir :: item :: _-> (x, f, dir, item)
       | _ :: x ::         "=" :: f :: dir :: item :: _-> (x, f, dir, item)
       | _ -> ("","","","")
-    )
+    ) lines
   in
-  let has_functions = 
-    List.filter functions ~f:(fun (x,_,_,_) -> String.is_prefix ~prefix:"has_" x)
-  and get_functions = 
-    List.filter functions ~f:(fun (x,_,_,_) -> String.is_prefix ~prefix:"get_" x)
+  let has_functions =
+    List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "has_") functions
+  and get_functions =
+    List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "get_") functions
   in
+  let chop s =
+    match (Str.split_delim (Str.regexp ";;") s) with
+    | x :: _ -> x
+    | _ -> assert false
+  in
+
   let result =
     [ "let decode_ezfio_message msg =
 match msg with " ] @
     (
-      List.map get_functions ~f:(fun (x,f,d,i) ->
-        let i =
-          match (String.chop_suffix i ~suffix:";;") with
-          | Some x -> x
-          | None -> i
-        in
-        if (String.is_suffix f ~suffix:"_array") then
-          Printf.sprintf " | \"%s\" -> 
+      List.map (fun (x,f,d,i) ->
+        let i = chop i in
+        if (String.sub f ((String.length f)-6) 6 = "_array") then
+          Printf.sprintf " | \"%s\" ->
              Ezfio.read_string_array %s %s
-             |> Ezfio.flattened_ezfio 
+             |> Ezfio.flattened_ezfio
              |> Array.to_list
-             |> String.concat ~sep:\" \"" x d i
+             |> String.concat \" \"" x d i
         else
           Printf.sprintf " | \"%s\" -> Ezfio.read_string %s %s" x d i
-      )
+      ) get_functions
     ) @ (
-      List.map has_functions ~f:(fun (x,_,_,_) ->
-        Printf.sprintf " | \"%s\" -> if (Ezfio.%s ()) then \"T\" else \"F\"" x x 
-      )
-    ) @ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;"]
+      List.map (fun (x,_,_,_) ->
+        Printf.sprintf " | \"%s\" -> if (Ezfio.%s ()) then \"T\" else \"F\"" x x
+      ) has_functions
+    )
+    @ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;"  ;
+       "" ; "let all_ezfio_messages = [ " ] @
+    (
+      List.rev_map (fun (x,_,_,_) ->
+        Printf.sprintf "   \"%s\" ; " (String.sub x 4 ((String.length x)-4))
+      ) has_functions
+    ) @ ["]"]
   in
-  String.concat result ~sep:"\n"
+  String.concat "\n" result
+  |> print_endline
 
 (** Main *)
-
-let () = 
-  let input = 
-    String.concat ~sep:"\n"
-    [ "open Core.Std\nlet warning = print_string\n\n" ;
-      parse_input input_data ;
-      parse_input_ezfio input_ezfio ;
-      create_ezfio_handler ();
-      untouched ]
-
-  and old_input =
-    let filename = 
-      "Qptypes.ml"
-    in
-    match Sys.file_exists filename with
-    | `Yes -> In_channel.read_all "Qptypes.ml" 
-    | `No | `Unknown -> "empty"
-
-  in
-
-  if input <> old_input then
-      Out_channel.write_all "Qptypes.ml" ~data:input 
+let () =
+  print_endline untouched;
+  parse_input input_data ;
+  parse_input_ezfio input_ezfio;
+  create_ezfio_handler ()
 
 
 

promela/qmcchem.pml

@@ -0,0 +1,271 @@
+#define NPROC 2
+#define BUFSIZE 4
+#define not_here false
+
+mtype = { NONE, TERMINATE, OK, TEST, ERROR, PROPERTY, WALKERS, EZFIO, GETWALKERS, REGISTER,
+          EZFIO_REPLY, UNREGISTER, STOPPING, STOPPED, QUEUED, RUNNING };
+
+typedef message_req {
+  mtype m = NONE;
+  byte value = 0;
+  chan reply = [BUFSIZE] of { mtype };
+}
+
+typedef message_pull {
+  mtype m = NONE;
+  byte value = 0;
+}
+
+chan dataserver_pull = [NPROC] of { message_pull };
+chan dataserver_req  = [NPROC] of { message_req };
+
+byte dataserver_status_pub;
+bit http_address = 0;
+bit killall_qmc = 0;
+bit killall_dataserver = 0;
+byte dataserver_status = QUEUED;
+byte dataserver_status_n_connected = 0;
+
+
+
+
+/* qmcchem process */
+active proctype qmcchem() {
+  byte reply = NONE;
+  byte dataserver_pid;
+  byte i,j;
+  message_req msg;
+
+  dataserver_pid = run dataserver();
+
+  /* Wait until ZMQ socket is open */
+  (http_address == 1);
+  do
+  :: (reply == OK) -> break
+  :: (reply == NONE) -> 
+        msg.m = TEST;
+        dataserver_req ! msg;
+        msg.reply ? reply ;
+        assert (reply == OK || reply == NONE)
+  od;
+  printf("Dataserver is ready.\n");
+
+  /* Start the QMC processes */
+
+  printf("qmcchem: Starting qmc processes.\n");
+  atomic {
+  i=0;
+  do
+  :: (i < NPROC) -> 
+    run qmc(); i++
+  :: else -> break
+  od;
+  }
+  printf("qmcchem: qmc processes started.\n");
+
+}
+
+
+
+
+
+
+
+/* dataserver process */
+proctype dataserver() {
+  byte reply = 0;
+  byte request = 0;
+  byte cont = 0;
+  byte reply_pid = 0;
+  message_req msg;
+
+  /* Simulate initialization */
+  http_address = 1;
+  dataserver_req ? msg;
+  msg.reply ! NONE ;
+
+  /* Status thread */
+  run dataserver_status_thread();
+  run dataserver_main_thread();
+}
+
+#define delay 5
+#define stop_time 100
+
+
+proctype dataserver_status_thread() {
+  byte count=0;
+  byte n_connected = 0;
+  byte time=0;
+
+  dataserver_status_pub = dataserver_status;
+  do
+  :: (dataserver_status == STOPPED) -> break
+  :: else  ->
+     time = (time < stop_time -> time+1 : time);
+     count++;
+     if
+     :: (count != delay) -> skip
+     :: else ->
+        count = 0;
+        if 
+        :: (dataserver_status == RUNNING &&
+            n_connected == dataserver_status_n_connected && 
+            time >= stop_time) ->
+            dataserver_status = STOPPING;
+            printf("Stop time reached : STOPPING\n")
+
+        :: (dataserver_status == STOPPING &&
+            n_connected != dataserver_status_n_connected && 
+            dataserver_status_n_connected == 0) ->
+            dataserver_status = STOPPED;
+            printf("No more connected clients : STOPPED\n")
+
+        :: (n_connected != dataserver_status_n_connected && 
+            dataserver_status_n_connected > 0) ->
+            n_connected = dataserver_status_n_connected;
+
+        :: else -> skip
+        fi
+     fi
+     dataserver_status_pub = dataserver_status;
+  od
+  printf ("End of dataserver_status_thread\n");
+}
+
+
+proctype dataserver_main_thread() {
+  byte time = 0;
+  mtype reply;
+  dataserver_status = QUEUED;
+  message_req msg;
+  message_pull pull;
+
+  /* Inform main process that the qmc processes can start (blocking recv) */
+  dataserver_req ? msg;
+  assert (msg.m == TEST);
+  msg.reply ! OK;
+
+  do
+  :: (dataserver_status == STOPPED && (!dataserver_pull ?[pull]) && (!dataserver_req ?[msg])) -> break
+  :: else ->
+    do
+    :: (dataserver_pull ?[pull]) -> 
+        dataserver_pull ? pull
+        printf("pull: "); printm(pull.m); printf("\n");
+        if
+        :: (pull.m == ERROR) -> skip;
+        :: (pull.m == WALKERS) -> skip
+        :: (pull.m == PROPERTY) -> skip;
+        fi
+    :: else -> break
+    od
+    if
+    :: (dataserver_req ?[msg]) -> 
+        dataserver_req ? msg;
+        printf("req : "); printm(msg.m); printf("\n");
+        if 
+        :: (msg.m == TEST) -> reply = OK
+        :: (msg.m == EZFIO) -> reply = EZFIO_REPLY
+        :: (msg.m == GETWALKERS) -> reply = WALKERS
+        :: (msg.m == REGISTER && dataserver_status == QUEUED ) ->
+              dataserver_status_n_connected++;
+              dataserver_status = RUNNING;
+              reply = OK;
+              printf("Status changed to RUNNING\n")
+        :: (msg.m == REGISTER && dataserver_status == RUNNING ) ->
+              dataserver_status_n_connected++;
+              reply = OK
+        :: (msg.m == REGISTER &&
+            (dataserver_status == STOPPED || dataserver_status == STOPPING) ) ->
+              dataserver_status_n_connected++; reply = ERROR;
+              printf("dataserver_req: register failed \n")
+        :: (msg.m == UNREGISTER) -> 
+            dataserver_status_n_connected--;
+            reply = OK;
+            if
+            :: (dataserver_status_n_connected == 0) ->
+                dataserver_status = STOPPED
+              printf("Status changed to STOPPED\n")
+            :: else -> skip
+            fi
+        :: else -> skip
+        fi;
+        msg.reply ! reply
+    :: else -> skip
+    fi
+  od
+}
+
+/* qmc processes */
+proctype qmc() {
+  byte status;
+  mtype reply;
+  message_req msg;
+  message_pull pull;
+
+  /* Init */
+  status = dataserver_status_pub;
+
+  msg.m = REGISTER;
+  dataserver_req ! msg;
+end:  msg.reply ? reply;
+  if 
+  :: (reply  == ERROR) -> goto exit;
+  :: else -> assert (reply == OK);
+  fi;
+
+  msg.m = EZFIO;
+  dataserver_req ! msg;
+  msg.reply ? reply;
+  if 
+  :: (reply  == ERROR) -> goto exit;
+  :: else -> assert (reply == EZFIO_REPLY);
+  fi;
+
+  msg.m = GETWALKERS;
+  dataserver_req ! msg;
+  msg.reply ? reply;
+  if 
+  :: (reply  == ERROR) -> goto exit;
+  :: else -> assert (reply == WALKERS);
+  fi;
+
+
+
+  /* Equilibration */
+  (dataserver_status_pub == RUNNING);
+
+  msg.m = EZFIO;
+  dataserver_req ! msg;
+  msg.reply ? reply;
+  if 
+  :: (reply  == ERROR) -> goto exit;
+  :: else -> assert (reply == EZFIO_REPLY);
+  fi;
+
+  status = dataserver_status_pub;
+
+  /* Cycles */
+  do
+  :: (status != RUNNING) -> break
+  :: else ->
+    pull.m = PROPERTY; pull.value = 0;
+    dataserver_pull ! pull;
+    pull.m = PROPERTY; pull.value =1 ;
+    dataserver_pull ! pull;
+    pull.m = WALKERS;
+    dataserver_pull ! pull;
+    status = dataserver_status_pub;
+  od;
+
+  /* Termination */
+  msg.m = UNREGISTER;
+  dataserver_req ! msg;
+  msg.reply ? reply;
+  assert (reply == OK);
+
+exit: skip
+}
+
+

scripts/clean.sh

@@ -1,14 +1,15 @@
 #!/bin/bash
 # This script is supposed to run in $QMCCHEM_PATH
 
-ninja -C ocaml clean 
+make -C ocaml clean 
 if [[ -d src/IRPF90_temp ]]
 then
-  ninja -C src/IRPF90_temp -t clean 
+  make -C src/IRPF90_temp clean 
 fi
-ninja -t clean
 
-rm -f ocaml/qmcchem ocaml/.ls_md5 ocaml/generated.ninja
+make -C EZFIO clean
+
+rm -f ocaml/qmcchem ocaml/.ls_md5 
 rm -f EZFIO/Ocaml/ezfio.ml
 cd src
  rm -rf tags irpf90_entities irpf90.make IRPF90_temp IRPF90_man .ls_md5

scripts/compile_ezfio.sh

@@ -10,9 +10,12 @@ source make.config
 source qmcchemrc
 FCFLAGS="${FCFLAGS} -fPIC"
 export IRPF90 FC FCFLAGS AR RANLIB
-cd EZFIO
-rm -f make.config
-${NINJA} || exit -1
+cd EZFIO/config
+[[ -f properties.config ]]  || ln -s ../../ezfio_config/properties.config .
+[[ -f qmc.config ]]  || ln -s ../../ezfio_config/qmc.config .
+cd ..
+source ../make.config 
+make || exit -1
 cp lib/libezfio{,_irp}.a ${QMCCHEM_PATH}/lib/ || exit 1
 
 

scripts/compile_irpf90.sh

@@ -19,31 +19,31 @@ then
   REF=$(cat ${LSMD5_FILE})
 fi
 
-if [[ ${MD5} != ${REF} ]]
+if [[ ${MD5} == ${REF} ]]
 then
-  echo ${MD5} > ${LSMD5_FILE}
-  echo Running IRPF90
-
-  source ${QMCCHEM_PATH}/make.config
-
-  LIB="${LIB} ${QMCCHEM_PATH}/lib/libezfio_irp.a ${QMCCHEM_PATH}/lib/libf77zmq.a ${QMCCHEM_PATH}/lib/libzmq.a -lstdc++ -lrt"
-  SRC="${SRC} ZMQ/f77_zmq_module.f90" 
-  OBJ="${OBJ} IRPF90_temp/ZMQ/f77_zmq_module.o"
-  INCLUDES="${INCLUDES} -I AO -I SAMPLING -I TOOLS -I JASTROW -I MAIN -I PROPERTIES -I ZMQ"
-  IRPF90_FLAGS="${IRPF90_FLAGS} --ninja"
-
-  # Check IRPF90 version
-  if [[ $( ${IRPF90} -v | python -c "import sys ; print float(sys.stdin.read().rsplit('.',1)[0]) >= 1.6") == False ]]
-  then
-    echo "IRPF90 version >= 1.6 required"
-    exit -1
-  fi
-
-  export IRPF90 IRPF90_FLAGS INCLUDES LIB SRC OBJ 
-
-  exec ${IRPF90} ${IRPF90_FLAGS} ${INCLUDES} || exit -1
+  exit 0
 fi
 
-
+echo ${MD5} > ${LSMD5_FILE}
+echo Running IRPF90
+
+source ${QMCCHEM_PATH}/make.config
+
+LIB="${LIB} ${QMCCHEM_PATH}/lib/libezfio_irp.a ${QMCCHEM_PATH}/lib/libf77zmq.a ${QMCCHEM_PATH}/lib/libzmq.a -lstdc++ -lrt -lz"
+SRC="${SRC} ZMQ/f77_zmq_module.f90" 
+OBJ="${OBJ} IRPF90_temp/ZMQ/f77_zmq_module.o"
+INCLUDES="${INCLUDES} -I AO -I SAMPLING -I TOOLS -I JASTROW -I MAIN -I PROPERTIES -I ZMQ"
+IRPF90_FLAGS="${IRPF90_FLAGS}"
+
+# Check IRPF90 version
+if [[ $( ${IRPF90} -v | python2 -c "import sys ; print float(sys.stdin.read().rsplit('.',1)[0]) >= 1.6") == False ]]
+then
+  echo "IRPF90 version >= 1.6 required"
+  exit -1
+fi
+
+export IRPF90 IRPF90_FLAGS INCLUDES LIB SRC OBJ 
+
+exec ${IRPF90} ${IRPF90_FLAGS} ${INCLUDES} || exit -1
 
 

scripts/compile_ocaml.sh

@@ -8,4 +8,4 @@ fi
 
 cd ${QMCCHEM_PATH}/ocaml || exit -1
 
-exec ninja -f generated.ninja ${@} || exit -1
+exec make

scripts/compile_ocaml_dep.sh

@@ -1,31 +0,0 @@
-#!/bin/bash
-
-if [[ -z ${QMCCHEM_PATH} ]]
-then
-  echo "Error: qmcchemrc not loaded"
-  exit -1
-fi
-
-cd ${QMCCHEM_PATH}/ocaml || exit -1
-
-cp ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml . || exit -1
-
-LSMD5_FILE=${QMCCHEM_PATH}/ocaml/.ls_md5
-FILES="*.ml *.mli"
-MD5=$(ls -ltr --full-time ${FILES} 2>/dev/null | md5sum | cut -d ' ' -f 1)
-
-REF=0
-
-if [[ -f ${LSMD5_FILE} ]]
-then
-  REF=$(cat ${LSMD5_FILE})
-fi
-
-if [[ ${MD5} != ${REF} ]]
-then
-  echo ${MD5} > ${LSMD5_FILE}
-  echo Finding dependencies in OCaml files
-  python ./ninja_ocaml.py || exit -1
-fi
-
-

scripts/compile_src.sh

@@ -6,6 +6,19 @@ then
   exit -1
 fi
 
-cd ${QMCCHEM_PATH}/src/IRPF90_temp || exit -1
 
-exec ninja ${@}
+cd ${QMCCHEM_PATH}/src || exit -1
+
+
+source ${QMCCHEM_PATH}/make.config
+
+LIB="${QMCCHEM_PATH}/lib/libezfio_irp.a ${QMCCHEM_PATH}/lib/libf77zmq.a ${QMCCHEM_PATH}/lib/libzmq.a -lstdc++ -lrt -lz ${LIB}"
+SRC="${SRC} ZMQ/f77_zmq_module.f90"
+OBJ="${OBJ} IRPF90_temp/ZMQ/f77_zmq_module.o"
+INCLUDES="${INCLUDES} -I AO -I SAMPLING -I TOOLS -I JASTROW -I MAIN -I PROPERTIES -I ZMQ"
+IRPF90_FLAGS="${IRPF90_FLAGS} ${INCLUDES}"
+
+
+export IRPF90 IRPF90_FLAGS INCLUDES LIB SRC OBJ 
+
+exec make ${@}

scripts/create_properties_ezfio.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python
+#!/usr/bin/env python2
 #
 # Creates the properties.config file in the EZFIO directory. This is
 # done by reading all the properties written in the src/PROPERTIES
@@ -67,7 +67,7 @@ file = open(tmp_filename,'w')
 # ----
 
 print >>file, """
-(* File generated by ${QMCCHEM_PATH}/src/create_properties.py. Do not
+(* File generated by ${QMCCHEM_PATH}/scripts/create_properties.py. Do not
    modify here
  *)
 
@@ -125,7 +125,7 @@ for p in properties:
 print >>file, """;;
 
 let of_string s = 
-  match (String.lowercase s) with 
+  match (String.lowercase_ascii s) with 
   | "cpu" -> Cpu
   | "wall" -> Wall
   | "accep" -> Accep"""
@@ -145,6 +145,14 @@ let to_string = function
 for p in properties_qmcvar:
   print >>file, """| %(P)s -> "%(P)s" """%{'P':p[1].capitalize(), 'p':p[1]}
 print >>file, """;;
+
+let of_bytes x = 
+   Bytes.to_string x
+   |> of_string
+
+let to_bytes x = 
+   to_string x
+   |> Bytes.of_string
 """
 
 # is_scalar

scripts/create_properties_python.py

@@ -1,4 +1,4 @@
-#!/usr/bin/python
+#!/usr/bin/env python2
 
 import string
 import os

src/.gitignore

@@ -4,5 +4,4 @@ irpf90.make
 irpf90_entities
 tags
 .ls_md5
-Makefile
 properties.pyc

src/AO/ao.irp.f

@@ -260,26 +260,6 @@ END_PROVIDER
     enddo
   enddo
 
-
-! Normalization of the contracted AOs 
-! -----------------------------------
-
-  integer                        :: k
-  do i=1,ao_num
-    pow(1) = ao_power_transp(1,i)
-    pow(2) = ao_power_transp(2,i)
-    pow(3) = ao_power_transp(3,i)
-    norm = 0.d0
-    do j=1,ao_prim_num(i)
-      do k=1,ao_prim_num(i)
-        norm = norm + ao_coef(i,j) * ao_coef(i,k) * goverlap(ao_expo(i,j),ao_expo(i,k),pow)
-      enddo
-    enddo
-    do j=1,ao_prim_num(i)
-      ao_coef(i,j) = ao_coef(i,j)/sqrt(norm)
-    enddo
-  enddo
-
 END_PROVIDER
 
 

src/AO/ao_axis.irp.f

@@ -45,14 +45,14 @@ subroutine pow_l(r,a,x1,x2,x3)
      x3 = 0.
      return
   end select
-end function
+end
 
 
- BEGIN_PROVIDER [ real, ao_axis_block, ((-2*simd_sp+1):ao_block_num_8) ]
-&BEGIN_PROVIDER [ real, ao_axis_grad_block_x, ((-2*simd_sp+1):ao_block_num_8) ]
-&BEGIN_PROVIDER [ real, ao_axis_grad_block_y, ((-2*simd_sp+1):ao_block_num_8) ]
-&BEGIN_PROVIDER [ real, ao_axis_grad_block_z, ((-2*simd_sp+1):ao_block_num_8) ]
-&BEGIN_PROVIDER [ real, ao_axis_lapl_block, ((-2*simd_sp+1):ao_block_num_8) ]
+ BEGIN_PROVIDER [ real, ao_axis_block, (ao_block_num_8) ]
+&BEGIN_PROVIDER [ real, ao_axis_grad_block_x, (ao_block_num_8) ]
+&BEGIN_PROVIDER [ real, ao_axis_grad_block_y, (ao_block_num_8) ]
+&BEGIN_PROVIDER [ real, ao_axis_grad_block_z, (ao_block_num_8) ]
+&BEGIN_PROVIDER [ real, ao_axis_lapl_block, (ao_block_num_8) ]
   implicit none
   include '../types.F'
 
@@ -111,13 +111,13 @@ end function
    ao_axis_block(idx) = p023 * p10
    p023 = real_of_int(pow1) * p023
 
+   ao_axis_grad_block_x(idx) =  p023 * p11 
+   ao_axis_grad_block_y(idx) =  p013 * p21
+   ao_axis_grad_block_z(idx) =  p012 * p31
    ao_axis_lapl_block(idx) = real_of_int(pow1-1) * p023 * p12 & 
                            + real_of_int(pow2-1) * p013 * p22 &
                            + real_of_int(pow3-1) * p012 * p32
 
-   ao_axis_grad_block_x(idx) =  p023 * p11 
-   ao_axis_grad_block_y(idx) =  p013 * p21
-   ao_axis_grad_block_z(idx) =  p012 * p31
 
 
   enddo

src/AO/ao_full.irp.f

@@ -73,6 +73,7 @@ BEGIN_PROVIDER [ logical, primitives_reduced ]
       PROVIDE  ao_power
       PROVIDE  ao_coef
       PROVIDE  ao_nucl
+      PROVIDE  mo_fitcusp_normalization_before
       do i=1,ao_num
         if (ao_oned_p(i) /= 0.) then
           l=ao_power(i,1)+ao_power(i,2)+ao_power(i,3)

src/JASTROW/jastrow_1b.irp.f

@@ -0,0 +1,308 @@
+
+BEGIN_PROVIDER [ double precision, jast_1b_value, (elec_num_8)  ]
+
+  BEGIN_DOC  
+  ! 1-body Jastrow
+  END_DOC
+
+  include '../constants.F'
+
+  implicit none
+  integer          :: i, j
+  double precision :: a, c, rij, tmp
+  double precision :: z, mu, mu_pi, zr, mur
+
+  do i = 1, elec_num
+
+    jast_1b_value(i) = 0.d0
+
+     if( jast_1b_type .eq. 1 ) then     ! add 1body-Slater Jastrow
+                                        ! J(i) = - \sum_A c_A exp( - alpha_A r_iA )
+!      !DIR$ LOOP COUNT (100)
+!      do j = 1, nucl_num
+!        a   = jast_1bslat_expo(j)
+!        c   = jast_1bslat_coef(j)
+!        rij = nucl_elec_dist(j,i)
+!        tmp = c * dexp( - a * rij )
+!        jast_1b_value(i) -= tmp
+!     enddo
+
+    elseif( jast_1b_type .eq. 2 ) then ! add 1body-Tanh Jastrow
+                                       ! J(i) = - \sum_A tanh(alpha_A r_iA )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1btanh_pen(j)
+        rij = nucl_elec_dist(j,i)
+        tmp = dtanh(a*rij)
+        jast_1b_value(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 3 ) then ! add 1body-Simple Jastrow
+                                       ! J(i) = - \sum_A [ (alpha_A r_iA) / (1 + alpha_A r_iA) ]^2
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_pen(j)
+        rij = a * nucl_elec_dist(j,i)
+        tmp = rij / (1.d0 + rij)
+        jast_1b_value(i) -= tmp*tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 4 ) then ! add 1body-RSDFT  Jastrow
+                                       ! J(i) = - \sum_A [ -z_A r_iA erfc(mu*r_iA) + z_A exp(-(mu*r_iA)^2)/(mu*sqt_pi) ]
+      mu    = jast_mu_erf
+      mu_pi = 1.d0 / ( dsqpi * mu )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        rij = nucl_elec_dist(j,i)
+        z   = nucl_charge(j) 
+        zr  = z  * rij
+        mur = mu * rij
+        tmp = - zr * ( 1.d0 - derf(mur) ) + z * mu_pi * dexp(-mur*mur)
+        jast_1b_value(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 5 ) then ! add 1body-erf Jastrow
+                                       ! J(i) = - \sum_A erf( alpha_A r_iA )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1berf_pen(j)
+        rij = nucl_elec_dist(j,i)
+        tmp = derf(a*rij)
+        jast_1b_value(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 6 ) then ! add 1body-Gauss Jastrow
+                                       ! J(i) = - \sum_A [ 1 - exp( -alpha_A r_iA^2 ) ]
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1bGauss_pen(j)
+        rij = nucl_elec_dist(j,i)
+        tmp = 1.d0 - dexp(-a*rij*rij)
+        jast_1b_value(i) -= tmp
+      enddo
+
+    endif
+
+  enddo
+
+END_PROVIDER
+
+! ---
+
+ BEGIN_PROVIDER [ double precision, jast_1b_grad_x, (elec_num_8) ]
+&BEGIN_PROVIDER [ double precision, jast_1b_grad_y, (elec_num_8) ]
+&BEGIN_PROVIDER [ double precision, jast_1b_grad_z, (elec_num_8) ]
+
+  BEGIN_DOC  
+  ! Gradient of the Jastrow
+  END_DOC
+
+  include '../constants.F'
+
+  implicit none
+  integer          :: i, j
+  double precision :: a, c, rij, tmp
+  double precision :: z, mu, mur
+
+  do i = 1, elec_num
+
+    jast_1b_grad_x(i) = 0.d0
+    jast_1b_grad_y(i) = 0.d0
+    jast_1b_grad_z(i) = 0.d0
+
+    if( jast_1b_type .eq. 1 ) then     ! add 1body-Slater Jastrow
+                                       ! J(i) = - \sum_A c_A exp( - alpha_A r_iA )
+!      !DIR$ LOOP COUNT (100)
+!      do j = 1, nucl_num
+!        a   = jast_1bslat_expo(j)
+!        c   = jast_1bslat_coef(j)
+!        rij = nucl_elec_dist(j,i)
+!        tmp = c * a * dexp( - a * rij ) / rij
+!        jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
+!        jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
+!        jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
+!      enddo
+
+    elseif( jast_1b_type .eq. 2 ) then ! add 1body-Tanh Jastrow
+                                       ! J(i) = - \sum_A tanh(alpha_A r_iA )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1btanh_pen(j)
+        rij = nucl_elec_dist(j,i)
+        c   = dtanh(a*rij)
+        tmp = a * ( 1.d0 - c*c ) / rij
+        jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
+        jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
+        jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 3 ) then ! add 1body-Simple Jastrow
+                                       ! J(i) = - \sum_A [ (alpha_A r_iA) / (1 + alpha_A r_iA) ]^2
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_pen(j)
+        rij = a * nucl_elec_dist(j,i)
+        tmp = (a+a)*a / (1.d0+rij*(3.d0+rij*(3.d0+rij)))
+        jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
+        jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
+        jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 4 ) then ! add 1body-RSDFT  Jastrow
+                                       ! J(i) = - \sum_A [ -z_A r_iA erfc(mu*r_iA) + z_A exp(-(mu*r_iA)^2)/(mu*sqt_pi) ]
+      mu = jast_mu_erf
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        rij = nucl_elec_dist(j,i)
+        z   = nucl_charge(j) 
+        mur = mu * rij
+        tmp = -z * ( 1.d0 - derf(mur) ) / rij 
+        jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
+        jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
+        jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 5 ) then ! add 1body-erf Jastrow
+                                       ! J(i) = - \sum_A erf( alpha_A r_iA )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1berf_pen(j)
+        rij = nucl_elec_dist(j,i)
+        c   = a * rij
+        tmp = 2.d0 * a * dexp(-c*c) / (dsqpi * rij)
+        jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
+        jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
+        jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 6 ) then ! add 1body-Gauss Jastrow
+                                       ! J(i) = - \sum_A [ 1 - exp( -alpha_A r_iA^2 ) ]
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1bGauss_pen(j)
+        rij = nucl_elec_dist(j,i)
+        tmp = 2.d0 * a * dexp(-a*rij*rij)
+        jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
+        jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
+        jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
+      enddo
+
+    endif
+
+  enddo
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, jast_1b_lapl, (elec_num_8) ]
+
+  BEGIN_DOC  
+  ! Laplacian of the Jastrow factor
+  END_DOC
+
+  include '../constants.F'
+
+  implicit none
+  integer          :: i, j
+  double precision :: a, c, rij, tmp
+  double precision :: mu, mu_pi, mur, z
+
+  do i = 1, elec_num
+
+    jast_1b_lapl(i) = 0.d0
+
+    if( jast_1b_type .eq. 1 ) then     ! add 1body-Slater Jastrow
+                                       ! J(i) = - \sum_A c_A exp( - alpha_A r_iA )
+!    !DIR$ LOOP COUNT (100)
+!    do j = 1, nucl_num
+!      a   = jast_1bslat_expo(j)
+!      c   = jast_1bslat_coef(j)
+!      rij = nucl_elec_dist(j,i)
+!      tmp = c * a * dexp(-a*rij) * ( 2.d0/rij - a )
+!      jast_1b_lapl(i) -= tmp
+!    enddo
+
+    elseif( jast_1b_type .eq. 2 ) then ! add 1body-Tanh Jastrow
+                                       ! J(i) = - \sum_A tanh(alpha_A r_iA )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1btanh_pen(j)
+        rij = nucl_elec_dist(j,i)
+        c   = dtanh(a*rij)
+        tmp = 2.d0 * a * ( 1.d0 - c*c ) * ( 1.d0/rij - a*c )
+        jast_1b_lapl(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 3 ) then ! add 1body-Simple Jastrow
+                                       ! J(i) = - \sum_A [ (alpha_A r_iA) / (1 + alpha_A r_iA) ]^2
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_pen(j)
+        rij = a * nucl_elec_dist(j,i)
+        tmp = 6.d0*a*a / (1.d0+rij*(4.d0+rij*(6.d0+rij*(4.d0+rij))))
+        jast_1b_lapl(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 4 ) then ! add 1body-RSDFT  Jastrow
+                                       ! J(i) = - \sum_A [ -z_A r_iA erfc(mu*r_iA) + z_A exp(-(mu*r_iA)^2)/(mu*sqt_pi) ]
+      mu    = jast_mu_erf
+      mu_pi = mu / dsqpi
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        rij = nucl_elec_dist(j,i)
+        z   = nucl_charge(j) 
+        mur = mu * rij
+        tmp = -2.d0*z*(1.d0-derf(mur))/rij + 2.d0*z*mu_pi*dexp(-mur*mur)
+        jast_1b_lapl(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 5 ) then ! add 1body-erf Jastrow
+                                       ! J(i) = - \sum_A erf( alpha_A r_iA )
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1berf_pen(j)
+        rij = nucl_elec_dist(j,i)
+        c   = a * rij
+        tmp = 4.d0 * dexp(-c*c) * (a/rij-a*a*a*rij) / dsqpi
+        jast_1b_lapl(i) -= tmp
+      enddo
+
+    elseif( jast_1b_type .eq. 6 ) then ! add 1body-Gauss Jastrow
+                                       ! J(i) = - \sum_A [ 1 - exp( -alpha_A r_iA^2 ) ]
+      !DIR$ LOOP COUNT (100)
+      do j = 1, nucl_num
+        a   = jast_1bGauss_pen(j)
+        rij = nucl_elec_dist(j,i)
+        c   = a * rij * rij
+        tmp = 2.d0 * a * dexp(-c) * (3.d0-2.d0*c)
+        jast_1b_lapl(i) -= tmp
+      enddo
+
+    endif
+
+  enddo
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, jast_1b_grad_sq, (elec_num_8) ]
+
+  BEGIN_DOC  
+  ! square of the gradient of the 1-body Jastrow
+  END_DOC
+
+  implicit none
+  integer          :: i
+
+  do i = 1, elec_num
+    jast_1b_grad_sq(i) = jast_1b_grad_x(i) * jast_1b_grad_x(i) &
+                       + jast_1b_grad_y(i) * jast_1b_grad_y(i) &
+                       + jast_1b_grad_z(i) * jast_1b_grad_z(i) 
+  enddo
+
+END_PROVIDER
+
+! ---
+

src/JASTROW/jastrow_core.irp.f

@@ -14,7 +14,7 @@
      jast_elec_Core_range(i) = 0.d0
    else
      double precision :: rc
-     double precision, parameter :: thresh = 0.5  ! function = thresh at rc
+     double precision, parameter :: thresh = 0.5d0  ! function = thresh at rc
      rc = min(0.8d0,max(4.0d0/nucl_charge(i), 0.25d0))
      jast_elec_Core_expo(i) = -1.d0/rc**2 * log(thresh)
      jast_elec_Core_range(i) = dsqrt(15.d0/jast_elec_Core_expo(i))

src/JASTROW/jastrow_full.irp.f

@@ -26,6 +26,7 @@ BEGIN_TEMPLATE
 SUBST [X]
 Simple ;;
 Core   ;;
+Mu     ;;
 END_TEMPLATE
    if (ifirst == 0) then
      dshift = argexpo
@@ -83,6 +84,7 @@ BEGIN_TEMPLATE
 SUBST [ X ]
 Simple ;;
 Core   ;;
+Mu     ;;
 END_TEMPLATE
    !DIR$ VECTOR ALIGNED
    !DIR$ LOOP COUNT (200)
@@ -129,6 +131,7 @@ BEGIN_TEMPLATE
 SUBST [X]
 Simple ;;
 Core ;;
+Mu   ;;
 END_TEMPLATE
 
    !DIR$ VECTOR ALIGNED

src/JASTROW/jastrow_mu.irp.f

@@ -0,0 +1,123 @@
+! Mu Jastrow
+! --------------
+
+! See Giner JCP 2021
+
+BEGIN_PROVIDER [ double precision , jast_elec_Mu_value, (elec_num_8)  ]
+implicit none
+ BEGIN_DOC  
+! J(i) = \sum_j a.rij/(1+b^2.rij) - \sum_A (a.riA/(1+a.riA))^2
+! Eq (11) 
+ END_DOC
+ integer :: i,j
+ double precision :: a, b, rij, tmp
+ include '../constants.F'
+ double precision :: mu
+ mu = jast_mu_erf
+
+ do i=1,elec_num
+   jast_elec_Mu_value(i) =  jast_1b_value(i)
+ enddo
+
+ do j=1,elec_num 
+  !DIR$ LOOP COUNT (50)
+  do i=1,elec_num
+    if(j==i)cycle
+    rij = elec_dist(i,j)
+    tmp = 0.5d0 * rij * (1.d0 - derf(mu*rij)) - 0.5d0/(dsqpi*mu) * dexp(-mu*mu*rij*rij)
+    jast_elec_Mu_value(j) += 0.5d0*tmp ! symmetrization 
+  enddo
+ enddo
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision , jast_elec_Mu_grad_x, (elec_num_8) ]
+&BEGIN_PROVIDER [ double precision , jast_elec_Mu_grad_y, (elec_num_8) ]
+&BEGIN_PROVIDER [ double precision , jast_elec_Mu_grad_z, (elec_num_8) ]
+ implicit none
+ BEGIN_DOC  
+! Gradient of the Jastrow factor
+! Eq (A1) 
+ END_DOC
+
+ integer :: i,j
+ double precision :: a, b, rij, tmp, x, y, z
+ include '../constants.F'
+ double precision :: mu
+ mu = jast_mu_erf
+
+ do i=1,elec_num
+  jast_elec_Mu_grad_x(i) = jast_1b_grad_x(i)
+  jast_elec_Mu_grad_y(i) = jast_1b_grad_y(i)
+  jast_elec_Mu_grad_z(i) = jast_1b_grad_z(i)
+ enddo
+
+ ! (grad of J(r12) with respect to xi, yi, zi)
+ do i = 1, elec_num
+  do j = 1, elec_num
+   if(i==j)cycle
+   rij = elec_dist(j,i)
+   jast_elec_Mu_grad_x(i) += 0.5d0 * ( 1.d0 - derf(mu * rij) ) * elec_dist_inv(j,i) * (-1.d0) * elec_dist_vec_x(j,i)
+   jast_elec_Mu_grad_y(i) += 0.5d0 * ( 1.d0 - derf(mu * rij) ) * elec_dist_inv(j,i) * (-1.d0) * elec_dist_vec_y(j,i)
+   jast_elec_Mu_grad_z(i) += 0.5d0 * ( 1.d0 - derf(mu * rij) ) * elec_dist_inv(j,i) * (-1.d0) * elec_dist_vec_z(j,i)
+  enddo
+ enddo
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision , jast_elec_Mu_lapl, (elec_num_8) ]
+ implicit none
+ BEGIN_DOC  
+! Laplacian of the Jastrow factor
+! Eq (A10) 
+ END_DOC
+
+ integer :: i,j
+ double precision :: a, b, rij, tmp, x, y, z
+ include '../constants.F'
+ double precision :: mu, x_ij, y_ij, z_ij, rij_inv
+ mu = jast_mu_erf
+
+ do i=1,elec_num
+  jast_elec_Mu_lapl(i) = jast_1b_lapl(i)
+ enddo
+
+ do i=1, elec_num
+  do j=1, elec_num
+   if(j==i)cycle
+   rij = elec_dist(j,i)
+   rij_inv = elec_dist_inv(j,i)
+   x_ij = elec_dist_vec_x(j,i)
+   y_ij = elec_dist_vec_y(j,i)
+   z_ij = elec_dist_vec_z(j,i)
+
+   jast_elec_Mu_lapl(i) += (1.d0 - derf(mu*rij))*elec_dist_inv(j,i) - mu/dsqpi * dexp(-mu*mu*rij*rij)
+  enddo
+ enddo
+END_PROVIDER
+
+
+ BEGIN_PROVIDER [double precision, grad_j_mu_x,(elec_num, elec_num)]
+&BEGIN_PROVIDER [double precision, grad_j_mu_y,(elec_num, elec_num)]
+&BEGIN_PROVIDER [double precision, grad_j_mu_z,(elec_num, elec_num)]
+ implicit none
+ BEGIN_DOC
+! Needed for 3-body terms
+ END_DOC
+ integer :: i,j
+ double precision :: rij, mu,scal
+ mu = jast_mu_erf
+ grad_j_mu_x = 0.d0
+ grad_j_mu_y = 0.d0
+ grad_j_mu_z = 0.d0
+ do j = 1, elec_num
+  do i = 1, elec_num
+   if(i==j)cycle
+   rij = elec_dist(i,j)
+   scal = 0.5d0 * ( 1.d0 - derf(mu * rij) ) * elec_dist_inv(i,j) 
+   grad_j_mu_x(i,j) = (elec_coord_transp(1,i) - elec_coord_transp(1,j)) * scal
+   grad_j_mu_y(i,j) = (elec_coord_transp(2,i) - elec_coord_transp(2,j)) * scal
+   grad_j_mu_z(i,j) = (elec_coord_transp(3,i) - elec_coord_transp(3,j)) * scal
+  enddo
+ enddo
+
+END_PROVIDER 
+

src/JASTROW/jastrow_param.irp.f

@@ -27,8 +27,10 @@ BEGIN_PROVIDER [ integer, jast_type ]
     jast_type = t_None
   else if (buffer == types(t_Core)) then
     jast_type = t_Core
+  else if (buffer == types(t_Mu)) then
+    jast_type = t_Mu
   else
-    call abrt(irp_here,'Jastrow type should be (None|Simple|Core)')
+    call abrt(irp_here,'Jastrow type should be (None|Simple|Core|Mu)')
   endif
   call cinfo(irp_here,'jast_type',buffer)
 
@@ -40,7 +42,7 @@ BEGIN_PROVIDER [ real, jast_a_up_up ]
 ! a_{up up} parameters of the Jastrow
   END_DOC
   include '../types.F'
-  jast_a_up_up = 0.25
+  jast_a_up_up = 0.5
   call get_jastrow_jast_a_up_up(jast_a_up_up)
 
 END_PROVIDER
@@ -62,7 +64,7 @@ BEGIN_PROVIDER [ real, jast_b_up_up ]
 ! b_{up up} parameters of the Jastrow
   END_DOC
   include '../types.F'
-  jast_b_up_up = 5.
+  jast_b_up_up = 1.
   call get_jastrow_jast_b_up_up(jast_b_up_up)
 
 END_PROVIDER
@@ -73,7 +75,7 @@ BEGIN_PROVIDER [ real, jast_b_up_dn ]
 ! b_{up dn} parameters of the Jastrow
   END_DOC
   include '../types.F'
-  jast_b_up_dn = 5.
+  jast_b_up_dn = 1.
   call get_jastrow_jast_b_up_dn(jast_b_up_dn)
 
 END_PROVIDER
@@ -84,7 +86,7 @@ BEGIN_PROVIDER [ real, jast_pen, (nucl_num) ]
 ! penetration parameters of the Jastrow
   END_DOC
   include '../types.F'
-  jast_pen(:) = 0.
+  jast_pen(:) = 0.5
   call get_jastrow_jast_pen(jast_pen)
 
 END_PROVIDER
@@ -106,7 +108,7 @@ BEGIN_PROVIDER [ real, jast_eeN_e_b, (nucl_num) ]
 ! b parameters of the electron-electron-Nucleus component of the Jastrow
   END_DOC
   include '../types.F'
-  jast_eeN_e_b(:) = 3.
+  jast_eeN_e_b(:) = 1.
   call get_jastrow_jast_eeN_e_b(jast_eeN_e_b)
 
 END_PROVIDER
@@ -154,3 +156,46 @@ END_PROVIDER
 
 END_PROVIDER
 
+BEGIN_PROVIDER [ real, jast_mu_erf ]
+  implicit none
+  include '../types.F'
+  jast_mu_erf = 0.5
+  call get_jastrow_mu_erf(jast_mu_erf)
+END_PROVIDER
+
+
+BEGIN_PROVIDER  [ integer, jast_1b_type ]
+ implicit none
+ include '../types.F'
+! jast_1b_type = 0 ! no  1body Jastrow
+ !jast_1b_type = 2 ! add 1body-Tanh   Jastrow
+ !jast_1b_type = 3 ! add 1body-Simple Jastrow
+ !jast_1b_type = 4 ! add 1body-RSDFT  Jastrow
+ !jast_1b_type = 5 ! add 1body-erf    Jastrow
+ jast_1b_type = 6 ! add 1body-Gauss  Jastrow
+! call get_jastrow_jast_1b_type(jast_1b_type)
+END_PROVIDER
+
+! useful if  jast_1b_type = 2
+BEGIN_PROVIDER [ real, jast_1btanh_pen, (nucl_num) ]
+  implicit none
+  include '../types.F'
+  jast_1btanh_pen(:) = 1.0
+  call get_jastrow_jast_1btanh_pen(jast_1btanh_pen)
+END_PROVIDER
+
+! useful if  jast_1b_type = 5
+BEGIN_PROVIDER [ real, jast_1berf_pen, (nucl_num) ]
+  implicit none
+  include '../types.F'
+  jast_1berf_pen(:) = 1.0
+  call get_jastrow_jast_1berf_pen(jast_1berf_pen)
+END_PROVIDER
+
+! useful if  jast_1b_type = 6
+BEGIN_PROVIDER [ real, jast_1bGauss_pen, (nucl_num) ]
+  implicit none
+  include '../types.F'
+  jast_1bGauss_pen(:) = 1.0
+  call get_jastrow_jast_1bgauss_pen(jast_1bGauss_pen)
+END_PROVIDER

src/JASTROW/jastrow_simple.irp.f

@@ -20,10 +20,10 @@ implicit none
   enddo
  enddo
 
- a = 0.5*jast_a_up_up
+ a = 0.5d0*jast_a_up_up
  b = jast_b_up_up
 
- do j=1,elec_alpha_num
+ do j=1,elec_alpha_num-1
   !DIR$ LOOP COUNT (50)
   do i=j+1,elec_alpha_num
     rij = elec_dist(i,j)
@@ -33,7 +33,7 @@ implicit none
   enddo
  enddo
 
- do j=elec_alpha_num+1,elec_num
+ do j=elec_alpha_num+1,elec_num-1
   !DIR$ LOOP COUNT (50)
   do i=j+1,elec_num
     rij = elec_dist(i,j)
@@ -43,7 +43,7 @@ implicit none
   enddo
  enddo
 
- a = 0.5*jast_a_up_dn
+ a = 0.5d0*jast_a_up_dn
  b = jast_b_up_dn
 
  do j=1,elec_alpha_num
@@ -190,5 +190,30 @@ BEGIN_PROVIDER [ double precision , jast_elec_Simple_lapl, (elec_num_8) ]
   enddo
  enddo
 
+END_PROVIDER
+
+
+
+
+BEGIN_PROVIDER[ double precision, jast_elec_Simple_deriv_nucPar, (nucl_num) ]
+  implicit none
+  BEGIN_DOC  
+  ! Variation of the Jastrow factor with respect to nuclear parameters
+  END_DOC
+
+  integer          :: i, j
+  double precision :: a, rij, tmp1, tmp2
+
+  do j = 1, nucl_num
+    a    = jast_pen(j)
+    tmp2 = 0.d0
+    !DIR$ LOOP COUNT (100)
+    do i = 1, elec_num
+      rij  = nucl_elec_dist(j,i)
+      tmp1 = (1.d0+a*rij)*(1.d0+a*rij)*(1.d0+a*rij)
+      tmp2 += rij*rij/tmp1
+    end do
+    jast_elec_Simple_deriv_nucPar(j) = -2.d0 * a * tmp2
+  end do
 
 END_PROVIDER

src/MAIN/admc.org

@@ -0,0 +1,277 @@
+#+TITLE: Asynchronous DMC
+#+AUTHOR: Anthony Scemama
+#+EMAIL: scemama@irsamc.ups-tlse.fr
+
+
+#+PROPERTY: header-args  :tangle no :noweb yes 
+
+
+* Main program
+
+** Declarations
+
+  #+NAME: declarations
+  #+begin_src f90 
+  include '../types.F'
+
+  integer          :: iter
+  integer          :: k_full  ! Index of walkers in elec_coord_full
+  integer          :: k_new   ! Index of walkers in elec_coord_new
+  integer          :: iw      ! Number of copies in branching
+  integer          :: l
+
+  real, allocatable :: elec_coord_new(:,:,:)
+
+  double precision :: w
+  double precision, allocatable :: E_out(:), w_sum(:)
+
+  double precision, external :: qmc_ranf                                                  
+
+  allocate(elec_coord_new(elec_num+1,3,walk_num))
+  allocate(E_out(walk_num), w_sum(walk_num))
+  #+end_src
+
+** Main flow
+
+   - Fetch ~walk_num~ electron coordinates in ~elec_coord_full~
+   - For each set of coordinates,
+     - Make a PDMC trajectory, and output the weight ~w~
+     - Perform branching depending on the value of the weight
+     - Store the new sets of coordinates in ~elec_coord_new~
+   - When ~elec_coord_new~ is full, send it to the server
+     
+  #+begin_src f90 :tangle "admc.irp.f" 
+program admc
+  call run
+  call ezfio_finish
+end program admc
+
+subroutine run
+  implicit none
+
+  <<declarations>>
+  
+  ! Initialization
+  if (vmc_algo /= t_Brownian) then
+     call abrt(irp_here,'DMC should run with Brownian algorithm')
+  endif
+
+  do iter=1,1000
+!    call read_coords()
+     k_new  = 1
+     do k_full=1,walk_num
+        call pdmc_trajectory(k_full, w, E_out(k_full), w_sum(k_full))
+
+        <<branching>>
+
+       if (k_new >= walk_num) then
+         w_sum(k_full+1:) = 0.d0
+         exit
+       end if
+     end do
+  
+     k_new = k_new-1
+     elec_coord_full(1:elec_num+1,1:3,1:k_new) = &
+          elec_coord_new(1:elec_num+1,1:3,1:k_new)
+
+!     call write_coords(k_new)
+     call write_energy(walk_num, E_out, w_sum)
+  end do
+
+end subroutine run
+
+<<read_coords>>
+<<write_coords>>
+<<write_energy>>
+<<pdmc_trajectory>>
+  #+end_src
+
+** Branching
+
+   #+NAME: branching
+    #+begin_src f90
+  ! Find number of copies
+  iw = int(w)
+  w = w - int(w)
+  if (qmc_ranf() < w) then
+     iw = iw+1
+  end if
+
+  ! Duplicate walker
+  do l=1,iw
+    elec_coord_new(1:elec_num+1,1:3,k_new) = &
+         elec_coord(1:elec_num+1,1:3) 
+    k_new = k_new+1
+    if (k_new >= walk_num) exit
+  end do
+
+    #+end_src
+
+* Read/write
+  
+** Read coordinates
+
+   Fetch a new set of coordinates for ~walk_num~ walkers from the pool of coordinates.
+  
+   #+NAME: read_coords
+   #+begin_src f90
+subroutine read_coords()
+  implicit none
+
+  integer :: i, k
+
+  do k=1,walk_num
+     do i=1,elec_num
+        read(*,*) elec_coord_full(i,1:3,k)
+     end do
+  end do
+
+  SOFT_TOUCH elec_coord_full
+     
+end subroutine read_coords
+   #+end_src
+
+** Write coordinates
+
+   Send the current set of coordinates for ~walk_num~ walkers to the pool of coordinates.
+  
+   #+NAME: write_coords
+   #+begin_src f90
+subroutine write_coords()
+  implicit none
+
+  integer :: i, k
+
+  do k=1,walk_num
+     do i=1,elec_num
+        write(*,*) 'C', elec_coord_full(i,1:3,k)
+     end do
+  end do
+
+end subroutine write_coords
+   #+end_src
+
+** Write energy
+
+   Compute the weighted average over the computed energies.
+  \[
+     E = \frac{\sum_i w_i E_i}{\sum_i w_i}
+  \]
+  
+   #+NAME: write_energy
+   #+begin_src f90
+subroutine write_energy(walk_num_, E_out, w_sum)
+  implicit none
+  integer, intent(in) :: walk_num_
+  double precision, intent(in) :: E_out(walk_num_)
+  double precision, intent(in) :: w_sum(walk_num_)
+
+  integer :: i, k
+  double precision :: E, S
+
+  E = 0.d0
+  S = 0.d0
+  do k=1,walk_num
+     S = S + w_sum(k)
+     E = E + w_sum(k) * E_out(k)
+  end do
+  write(*,*) 'E', E/S, S
+
+end subroutine write_energy
+   #+end_src
+
+* PDMC trajectory
+  
+  Computes a PDMC trajectory until the weight ~w~ is $1/2 < w < 3/2$.
+  The energy of the trajectory is computed as
+  \[
+     E = \frac{\sum_i w_i E(R_i)}{\sum_i w_i}
+  \]
+
+  The function returns:
+  - ~w~: the last of all $w_i$
+  - ~E_out~: The average energy $E$ of the trajectory
+  - ~w_sum~: The sum of the weights
+    
+  #+NAME: declarations_pdmc
+  #+begin_src f90
+  integer          :: i,j,l
+  double precision :: delta
+
+  ! If true, continue to make more steps
+  logical :: loop
+
+  ! Max number of steps
+  integer :: imax
+  integer, parameter :: nmax=10000
+
+  ! Brownian step variables
+  double precision               :: p,q
+  real                           :: delta_x
+  logical                        :: accepted
+
+  ! Local energies from the past
+  double precision :: E_loc_save(4)
+  double precision :: w
+
+  #+end_src
+  
+   #+NAME: pdmc_trajectory
+   #+begin_src f90
+subroutine pdmc_trajectory(k_full, pdmc_weight, E_out, w_sum)
+  implicit none
+
+  integer, intent(in) :: k_full
+  double precision, intent(out) :: pdmc_weight, E_out, w_sum
+
+  <<declarations_pdmc>>
+  
+  elec_coord(1:elec_num+1,1:3) = elec_coord_full(1:elec_num+1,1:3,k_full)
+  TOUCH elec_coord
+
+  E_out = 0.d0
+  w_sum = 0.d0
+
+  E_loc_save(1:4) = E_loc
+
+  pdmc_weight = 1.d0
+  loop = .True.
+
+  do imax = 1, nmax
+
+     call brownian_step(p,q,accepted,delta_x)
+
+!    delta = (9.d0*E_loc+19.d0*E_loc_save(1)-5.d0*E_loc_save(2)+E_loc_save(3))/24.d0
+     delta = E_loc
+     delta = (delta - E_ref)*p
+
+     if (delta >= 0.d0) then
+       w = dexp(-dtime_step*delta)
+     else
+       w = 2.d0-dexp(dtime_step*delta)
+     endif
+     elec_coord(elec_num+1,1) += p*time_step
+     elec_coord(elec_num+1,2)  = E_loc
+     elec_coord(elec_num+1,3)  = pdmc_weight
+     if (accepted) then
+        E_loc_save(4) = E_loc_save(3) 
+        E_loc_save(3) = E_loc_save(2) 
+        E_loc_save(2) = E_loc_save(1) 
+        E_loc_save(1) = E_loc
+     endif
+
+     w_sum = w_sum + pdmc_weight
+     E_out = E_out + pdmc_weight * E_loc
+
+     pdmc_weight = pdmc_weight * w
+
+     loop = pdmc_weight > 0.5d0 .and. pdmc_weight < 2.0d0
+     if (.not.loop) exit
+     
+  end do
+
+  E_out = E_out / w_sum
+
+end subroutine pdmc_trajectory
+   #+end_src
+

src/MAIN/admc.py

@@ -0,0 +1,125 @@
+#!/usr/bin/env python3
+
+from mpi4py import MPI
+import sys
+import gzip
+import random
+import math
+import subprocess
+
+admc_exec = "/home/scemama/qmcchem/src/MAIN/admc"
+n_walk_per_proc = 10
+
+def start():
+    return subprocess.Popen(
+        [ admc_exec, sys.argv[1] ],
+        stdin=subprocess.PIPE,
+        stdout=subprocess.PIPE,
+        stderr=subprocess.PIPE)
+
+
+def read(process,len_walk):
+    line = process.stdout.readline().decode("utf-8").strip()
+    walk_num = int(line)
+    walkers = []
+    print(walk_num)
+    for k in range(walk_num):
+        w = []
+        for i in range(len_walk):
+            line = process.stdout.readline().decode("utf-8").strip()
+            w.append( line )
+        w = '\n'.join(w)
+        walkers.append(w)
+
+    _, E, W = process.stdout.readline().decode("utf-8").split()
+    return walkers, float(E), float(W)
+
+
+def write(process, message):
+    process.stdin.write(f"{message}\n".encode("utf-8"))
+    process.stdin.flush()
+
+
+def terminate(process):
+    process.stdin.close()
+    process.terminate()
+    process.wait(timeout=0.2)
+
+def print_energy(EnergyWeight, Energy2Weight, Weight, N):
+    e  = EnergyWeight / Weight
+    e2 = Energy2Weight / Weight
+    err = math.sqrt(abs(e*e - e2) / max(1,(N-1)) )
+    print("%f +/- %f"%(e, err))
+    return err
+
+def main():
+    try:
+      input_dir = sys.argv[1]
+    except:
+        print("syntax: argv[0] [FILE]")
+        sys.exit(-1)
+
+    # Pool of electron coordinates
+    with gzip.open(input_dir+"/electrons/elec_coord_pool.gz","r") as f:
+        data = f.read().decode("utf-8").split()
+
+    len_walk = int(data[1])*int(data[2])
+    icount = 0
+    buffer = []
+    walkers = []
+    for d in data[4:]:
+        buffer.append(d)
+        icount += 1
+        if (icount == len_walk):
+            walkers.append(buffer)
+            buffer = []
+            icount = 0
+
+    walkers = [ '\n'.join(x) for x in walkers ]
+    do_loop = True
+
+    EnergyWeight  = 0.
+    Energy2Weight = 0.
+    Weight        = 0.
+    NSamples      = 0.
+
+    # Start processes
+    proc = start()
+    while do_loop:
+
+        # Once every 1000, shuffle the list of walkers
+        if random.random() < 0.01:
+            print("SHUFFLE")
+            random.shuffle(walkers)
+
+        # Pick new walkers
+        new_coords = walkers[:n_walk_per_proc]
+        walkers = walkers[n_walk_per_proc:]
+
+        # Send new walkers to the process
+        write(proc, '\n'.join(new_coords))
+
+        # Fetch new walkers from the process
+        new_coords, e_new, w_new = read(proc, len_walk)
+        walkers += new_coords
+
+        # Print energy
+        ew = e_new * w_new
+        EnergyWeight  += ew
+        Energy2Weight += e_new * ew
+        Weight        += w_new
+        NSamples      += 1.
+        print (len(walkers))
+        err = print_energy(EnergyWeight, Energy2Weight, Weight, NSamples)
+
+        if err < 1.e-3:
+                do_loop = False
+
+    terminate(proc)
+    return
+
+
+
+
+if __name__ == "__main__":
+    main()

src/MAIN/qmcchem_info.irp.f

@@ -13,6 +13,9 @@ program qmcchem_info
   endif
   print *,  'Number of determinants                   : ', det_num
   print *,  'Number of unique alpha/beta determinants : ', det_alpha_num, det_beta_num
+  if (use_svd) then
+    print *,  'SVD rank                                 : ', n_svd_coefs
+  endif
   print *,  'Closed-shell MOs                         : ', mo_closed_num
   print *,  'Number of MOs in determinants            : ', num_present_mos
 !  print *,  'Det alpha norm:'

src/MAIN/vmc_test.irp.f

@@ -0,0 +1,39 @@
+program vmc_test
+  real :: t1,t2
+  print *,  'Ndet=',det_num
+  print *,  'Ndet alpha beta =',det_alpha_num, det_beta_num
+  if (do_prepare) then
+    stop 'No walkers'
+  endif
+  print *,  'E_loc = ', E_loc
+  call step2
+  call ezfio_finish
+end
+
+subroutine step2
+  implicit none
+  real :: accep_rate
+  print *,  '---'
+  print *,  '<E_loc> = ', E_loc_block_walk
+  print *,  '<E_loc_2> = ', E_loc_2_block_walk
+  print *,  'w = ', block_weight
+  print *,  'Accept', accep_rate()
+  print *,  ''
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+
+derivlist = []
+
+for p in properties:
+  t = """
+    if (calc_$X) then
+      PROVIDE $X_block_walk
+      PROVIDE $X_2_block_walk
+    endif
+    """
+  print t.replace("$X",p[1])
+END_SHELL
+end
+
+
+

src/Makefile

@@ -0,0 +1,12 @@
+IRPF90=irpf90
+IRPF90+= $(IRPF90_FLAGS)
+include irpf90.make
+export
+
+irpf90.make: $(filter-out IRPF90_temp/%, $(wildcard */*.irp.f)) $(wildcard *.irp.f) $(wildcard *.inc.f) Makefile 
+	$(IRPF90)
+
+IRPF90_temp/irp_touches.irp.o: IRPF90_temp/irp_touches.irp.F90
+	$(FC) -O2 -c -g  IRPF90_temp/irp_touches.irp.F90 -o IRPF90_temp/irp_touches.irp.o
+
+

src/PROPERTIES/properties.irp.f

@@ -1,4 +1,4 @@
-BEGIN_SHELL [ /usr/bin/env python ]
+BEGIN_SHELL [ /usr/bin/env python2 ]
 import os
 from properties import properties
 root = os.environ['QMCCHEM_PATH']
@@ -59,7 +59,7 @@ END_SHELL
 ! DIMENSIONS
 !==========================================================================!
 
-BEGIN_SHELL [ /usr/bin/python ]
+BEGIN_SHELL [ /usr/bin/env python2 ]
 from properties import *
 make_dims()
 END_SHELL

src/PROPERTIES/properties_ci.irp.f

@@ -0,0 +1,403 @@
+BEGIN_PROVIDER [ double precision, psi_norm ]
+ implicit none
+  BEGIN_DOC
+  ! <1/J^2>
+  END_DOC
+  psi_norm = jast_value_inv*jast_value_inv
+
+  psi_norm_min = min(psi_norm_min,psi_norm)
+  psi_norm_max = max(psi_norm_max,psi_norm)
+  SOFT_TOUCH psi_norm_min psi_norm_max
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ci_overlap_psidet, (size_ci_overlap_psidet) ]
+  implicit none
+  BEGIN_DOC
+  ! < Phi_0 | det(j) >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer                        :: i, j, k
+
+  do k=1,det_num
+    i = det_coef_matrix_rows(k)
+    j = det_coef_matrix_columns(k)
+    ci_overlap_psidet(k) = det_alpha_value(i)*det_beta_value (j)*psidet_inv
+  enddo
+
+  ci_overlap_psidet_min = min(ci_overlap_psidet_min,minval(ci_overlap_psidet))
+  ci_overlap_psidet_max = max(ci_overlap_psidet_max,maxval(ci_overlap_psidet))
+  SOFT_TOUCH ci_overlap_psidet_min ci_overlap_psidet_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_h_psidet, (size_ci_h_psidet) ]
+  implicit none
+  BEGIN_DOC
+  ! < Phi_0 | H | det(j) >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer                        :: i, j, k, l
+  double precision :: T
+
+  do k=1,det_num
+    i = det_coef_matrix_rows(k)
+    j = det_coef_matrix_columns(k)
+    T = det_alpha_lapl_sum(i)*det_beta_value(j) + det_beta_lapl_sum(j)*det_alpha_value(i)
+    ci_h_psidet(k) = -0.5d0*T + (E_pot + E_nucl) * det_alpha_value(i)*det_beta_value (j)
+    ci_h_psidet(k) *= psi_value_inv * jast_value_inv
+  enddo
+
+  ci_h_psidet_min = min(ci_h_psidet_min,minval(ci_h_psidet))
+  ci_h_psidet_max = max(ci_h_psidet_max,maxval(ci_h_psidet))
+  SOFT_TOUCH ci_h_psidet_min ci_h_psidet_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_overlap_matrix, (size_ci_overlap_matrix) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) | det(j) >
+  !
+  ! Dimensions : det_num*det_num
+  END_DOC
+
+  integer                        :: i, j, k, l, m, n
+  double precision :: f
+
+  do k=1,det_num
+    i = det_coef_matrix_rows(k)
+    j = det_coef_matrix_columns(k)
+    f = det_alpha_value(i)*det_beta_value (j)*psidet_inv*psidet_inv
+    do l=1,det_num
+      m = det_coef_matrix_rows(l)
+      n = det_coef_matrix_columns(l)
+      ci_overlap_matrix( det_num*(k-1) + l) = det_alpha_value(m)*det_beta_value(n) * f
+    enddo
+  enddo
+
+  ci_overlap_matrix_min = min(ci_overlap_matrix_min,minval(ci_overlap_matrix))
+  ci_overlap_matrix_max = max(ci_overlap_matrix_max,maxval(ci_overlap_matrix))
+  SOFT_TOUCH ci_overlap_matrix_min ci_overlap_matrix_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_h_matrix, (size_ci_h_matrix) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) |H| det(j) >
+  !
+  ! Dimensions : det_num*det_num
+  END_DOC
+
+  integer                        :: i, j, k, l, m, n, e
+  double precision :: f, g, h, T, V, j_lapl_inv
+
+  ! (Lapl J)/J
+  j_lapl_inv = 0.d0
+  do e=1,elec_num
+    j_lapl_inv += jast_lapl_jast_inv(e)
+  enddo
+
+  do l=1,det_num
+      m = det_coef_matrix_rows(l)
+      n = det_coef_matrix_columns(l)
+      ! Lapl D 
+      T = det_alpha_lapl_sum(m) * det_beta_value (n) &
+          + det_alpha_value(m) * det_beta_lapl_sum(n)
+      if (j_lapl_inv /= 0.d0) then
+        ! D (Lapl J)/J
+        T += det_alpha_value(m) * det_beta_value(n) * j_lapl_inv
+
+        ! 2 (grad D).(Grad J)/J
+        g = 0.d0
+        do e=1,elec_alpha_num
+          g += &
+            det_alpha_grad_lapl(1,e,m) * jast_grad_jast_inv_x(e) + &
+            det_alpha_grad_lapl(2,e,m) * jast_grad_jast_inv_y(e) + &
+            det_alpha_grad_lapl(3,e,m) * jast_grad_jast_inv_z(e)
+        enddo
+        h = 0.d0
+        do e=1,elec_beta_num
+          h += &
+            det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(elec_alpha_num+e) + &
+            det_beta_grad_lapl(2,e,n) * jast_grad_jast_inv_y(elec_alpha_num+e) + &
+            det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
+        enddo
+        T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
+      endif
+      g = det_alpha_value(m)*det_beta_value(n)
+      V = (E_pot + E_nucl)* g
+      if (do_pseudo) then
+        do e=1,elec_alpha_num
+          V -= pseudo_non_local(e)* g
+          V += det_alpha_pseudo(e,m) * det_beta_value(n)
+        enddo
+        do e=1,elec_beta_num
+          V -= pseudo_non_local(e)* g
+          V += det_alpha_value(m) * det_beta_pseudo(e,n)
+        enddo
+      endif 
+      f = -0.5d0*T + V
+      f *= psidet_inv * psidet_inv
+      do k=1,det_num
+        i = det_coef_matrix_rows(k)
+        j = det_coef_matrix_columns(k)
+        ci_h_matrix( det_num*(l-1) + k) = f * &
+           det_alpha_value(i)*det_beta_value (j)
+      enddo
+  enddo
+  ci_h_matrix_min = min(ci_h_matrix_min,minval(ci_h_matrix))
+  ci_h_matrix_max = max(ci_h_matrix_max,maxval(ci_h_matrix))
+  SOFT_TOUCH ci_h_matrix_min ci_h_matrix_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_h_matrix_diag, (size_ci_h_matrix_diag) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) |H| det(j) >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer                        :: i, j, k, l, m, n, e
+  double precision :: f, g, h, T, V
+
+  do l=1,det_num
+      m = det_coef_matrix_rows(l)
+      n = det_coef_matrix_columns(l)
+      ! Lapl D 
+      g = 0.d0
+      do e=1,elec_alpha_num
+        g += det_alpha_grad_lapl(4,e,m) * det_beta_value (n)
+      enddo
+      do e=1,elec_beta_num
+        g += det_alpha_value(m) * det_beta_grad_lapl(4,e,n)
+      enddo
+      T = g
+      ! D (Lapl J)/J
+      g = 0.d0
+      do e=1,elec_num
+        g += jast_lapl_jast_inv(e)
+      enddo
+      T += det_alpha_value(m) * det_beta_value(n) * g
+      ! 2 (grad D).(Grad J)/J
+      g = 0.d0
+      do e=1,elec_alpha_num
+        g += &
+          det_alpha_grad_lapl(1,e,m) * jast_grad_jast_inv_x(e) + &
+          det_alpha_grad_lapl(2,e,m) * jast_grad_jast_inv_y(e) + &
+          det_alpha_grad_lapl(3,e,m) * jast_grad_jast_inv_z(e)
+      enddo
+      h = 0.d0
+      do e=1,elec_beta_num
+        h += &
+          det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(elec_alpha_num+e) + &
+          det_beta_grad_lapl(2,e,n) * jast_grad_jast_inv_y(elec_alpha_num+e) + &
+          det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
+      enddo
+      T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
+      g = det_alpha_value(m)*det_beta_value(n)
+      V = E_pot* g
+      if (do_pseudo) then
+        do e=1,elec_alpha_num
+          V -= pseudo_non_local(e)* g
+          V += det_alpha_pseudo(e,m) * det_beta_value(n)
+        enddo
+        do e=1,elec_beta_num
+          V -= pseudo_non_local(e)* g
+          V += det_alpha_value(m) * det_beta_pseudo(e,n)
+        enddo
+      endif
+      f = -0.5d0*T + V
+      f *= psidet_inv * psidet_inv
+      ci_h_matrix_diag(l) = f * &
+           det_alpha_value(m)*det_beta_value (n)
+  enddo
+
+  ci_h_matrix_diag_min = min(ci_h_matrix_diag_min,minval(ci_h_matrix_diag))
+  ci_h_matrix_diag_max = max(ci_h_matrix_diag_max,maxval(ci_h_matrix_diag))
+  SOFT_TOUCH ci_h_matrix_diag_min ci_h_matrix_diag_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_h_transcor_psi, (size_ci_h_transcor_psi) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) e^{-J} |H| Psi >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer                        :: i, j, k
+
+  do k=1,det_num
+    i = det_coef_matrix_rows(k)
+    j = det_coef_matrix_columns(k)
+    ci_h_transcor_psi(k) = E_loc * jast_value_inv * &
+       det_alpha_value(i)*det_beta_value(j) * psi_value_inv
+  enddo
+
+  ci_h_transcor_psi_min = min(ci_h_transcor_psi_min,minval(ci_h_transcor_psi))
+  ci_h_transcor_psi_max = max(ci_h_transcor_psi_max,maxval(ci_h_transcor_psi))
+  SOFT_TOUCH ci_h_transcor_psi_min ci_h_transcor_psi_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_dress, (size_ci_dress) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) e^{-J} |H| Psi >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer          :: i, j, k, l
+  double precision :: T, h_psidet, dij, f, E_noJ, dE
+
+  h_psidet = -0.5d0*psidet_lapl*psidet_inv + E_pot + E_nucl 
+  E_noJ = h_psidet 
+  dE = E_loc - E_noJ
+  do k=1,det_num
+     i = det_coef_matrix_rows(k)
+     j = det_coef_matrix_columns(k)
+     f = det_alpha_value(i)*det_beta_value(j) * psi_value_inv * jast_value_inv
+     ci_dress(k) = dE * f
+  enddo
+
+return
+  integer                        :: m, n, e
+  double precision :: g, h, V, j_lapl_inv, det_ab
+
+  ! (Lapl J)/J
+  j_lapl_inv = 0.d0
+  do e=1,elec_num
+    j_lapl_inv += jast_lapl_jast_inv(e)
+  enddo
+
+  do l=1,det_num
+      m = det_coef_matrix_rows(l)
+      n = det_coef_matrix_columns(l)
+      ! Lapl D 
+!      T = det_alpha_lapl_sum(m) * det_beta_value (n) &
+!          + det_alpha_value(m) * det_beta_lapl_sum(n)
+!      det_ab = det_alpha_value(m)*det_beta_value(n)
+!      ci_dress(l) = -0.5d0*T + (E_pot + E_nucl) * det_ab
+      T = 0.d0
+      ci_dress(l) = 0.d0
+
+      ! D (Lapl J)/J
+      T += det_alpha_value(m) * det_beta_value(n) * j_lapl_inv
+
+      ! 2 (grad D).(Grad J)/J
+      g = 0.d0
+      do e=1,elec_alpha_num
+        g += &
+          det_alpha_grad_lapl(1,e,m) * jast_grad_jast_inv_x(e) + &
+          det_alpha_grad_lapl(2,e,m) * jast_grad_jast_inv_y(e) + &
+          det_alpha_grad_lapl(3,e,m) * jast_grad_jast_inv_z(e)
+      enddo
+      h = 0.d0
+      do e=1,elec_beta_num
+        h += &
+          det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(elec_alpha_num+e) + &
+          det_beta_grad_lapl(2,e,n) * jast_grad_jast_inv_y(elec_alpha_num+e) + &
+          det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
+      enddo
+      T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
+
+      V = 0.d0 ! (E_pot + E_nucl)* det_ab
+      if (do_pseudo) then
+        do e=1,elec_alpha_num
+          V -= pseudo_non_local(e)* det_ab
+          V += det_alpha_pseudo(e,m) * det_beta_value(n)
+        enddo
+        do e=1,elec_beta_num
+          V -= pseudo_non_local(e)* det_ab
+          V += det_alpha_value(m) * det_beta_pseudo(e,n)
+        enddo
+      endif 
+      f = -0.5d0*T + V !- ci_dress(l)
+      ci_dress(l) = f *  psi_value_inv * jast_value_inv * jast_value_inv
+
+  enddo
+
+
+  ci_dress_min = min(ci_dress_min,minval(ci_dress))
+  ci_dress_max = max(ci_dress_max,maxval(ci_dress))
+  SOFT_TOUCH ci_dress_min ci_dress_max
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ci_dress_opt ]
+  BEGIN_DOC
+  ! Use for optimizing mu
+  END_DOC
+  implicit none
+  integer          :: i, j, k, l
+  double precision :: T, dij, f, E_noJ, dE
+  ! energy = H \Phi / \Phi
+  E_noJ = -0.5d0*psidet_lapl*psidet_inv + E_pot + E_nucl 
+  dE = (E_loc - E_noJ) * psi_value_inv * jast_value_inv ! PsiJ.J
+  k = 1
+  i = det_coef_matrix_rows(   k)
+  j = det_coef_matrix_columns(k)
+  f = det_alpha_value(i) * det_beta_value(j)
+  ci_dress_opt = dE * f
+  ci_dress_opt_min = min(ci_dress_opt_min, ci_dress_opt)
+  ci_dress_opt_max = max(ci_dress_opt_max, ci_dress_opt)
+  SOFT_TOUCH ci_dress_opt_min ci_dress_opt_max
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ci_dress_Htilde, (size_ci_dress_htilde) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) e^{-J} |H| Psi >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer          :: i, j, k, l
+  double precision :: T, h_psidet, dij, f, E_noJ, dE
+
+  E_noJ = -0.5d0*psidet_lapl*psidet_inv + E_pot + E_nucl 
+  dE = E_loc - E_noJ
+  do k=1,det_num
+     i = det_coef_matrix_rows(k)
+     j = det_coef_matrix_columns(k)
+     f = det_alpha_value(i)*det_beta_value(j) * psi_value_inv * jast_value_inv
+     ci_dress_Htilde(k) = dE * f
+  enddo
+
+  ci_dress_Htilde_min = min(ci_dress_Htilde_min,minval(ci_dress_Htilde))
+  ci_dress_Htilde_max = max(ci_dress_Htilde_max,maxval(ci_dress_Htilde))
+  SOFT_TOUCH ci_dress_Htilde_min ci_dress_Htilde_max
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ci_dress_H, (size_ci_dress_h) ]
+  implicit none
+  BEGIN_DOC
+  ! < det(i) e^{-J} |H| Psi >
+  !
+  ! Dimensions : det_num
+  END_DOC
+
+  integer          :: i, j, k, l
+  double precision :: T, h_psidet, dij, f, E_noJ, dE
+
+  E_noJ= -0.5d0*psidet_lapl*psidet_inv + E_pot + E_nucl 
+  do k=1,det_num
+     i = det_coef_matrix_rows(k)
+     j = det_coef_matrix_columns(k)
+     f = det_alpha_value(i)*det_beta_value(j) * psi_value_inv * jast_value_inv
+     ci_dress_h(k) = E_noJ * f
+  enddo
+
+  ci_dress_h_min = min(ci_dress_h_min,minval(ci_dress_h))
+  ci_dress_h_max = max(ci_dress_h_max,maxval(ci_dress_h))
+  SOFT_TOUCH ci_dress_h_min ci_dress_h_max
+END_PROVIDER
+

src/PROPERTIES/properties_energy.irp.f

@@ -13,7 +13,7 @@ BEGIN_PROVIDER [ double precision, single_det_E_kin ]
   do i=1,elec_num
     single_det_E_kin -= 0.5d0*single_det_lapl(i)/single_det_value
   enddo
-  
+
 END_PROVIDER
 
 
@@ -22,7 +22,7 @@ BEGIN_PROVIDER  [ double precision, single_det_E_loc ]
   BEGIN_DOC
   ! Local energy : single_det_E_kin + E_pot + E_nucl
   END_DOC
-  
+
   single_det_E_loc = single_det_E_kin + E_pot + E_nucl
 END_PROVIDER
 
@@ -32,7 +32,7 @@ BEGIN_PROVIDER [ double precision, E_pot_grad, (elec_num,3) ]
   BEGIN_DOC
   ! Gradient of the Electronic Potential energy
   END_DOC
-  
+
   integer                        :: i,j
   double precision               :: dinv
   do i=1,elec_num
@@ -64,7 +64,7 @@ BEGIN_PROVIDER [ double precision, E_pot_grad, (elec_num,3) ]
       E_pot_grad(i,3) += nucl_elec_dist_vec(3,j,i)*dinv
     enddo
   enddo
-  
+
 END_PROVIDER
 
 
@@ -73,7 +73,7 @@ BEGIN_PROVIDER [ double precision, E_pot_elec, (elec_num) ]
   BEGIN_DOC
   ! Electronic Potential energy
   END_DOC
-  
+
   integer                        :: i, j
   if (do_pseudo) then
     do i=1,elec_num
@@ -89,7 +89,7 @@ BEGIN_PROVIDER [ double precision, E_pot_elec, (elec_num) ]
     !DIR$ VECTOR ALIGNED
     !DIR$ LOOP COUNT(50)
     do j=1,elec_num
-      E_pot_elec(i) = E_pot_elec(i) + 0.5d0*elec_dist_inv(j,i) 
+      E_pot_elec(i) = E_pot_elec(i) + 0.5d0*elec_dist_inv(j,i)
     enddo
     !DIR$ VECTOR ALIGNED
     !DIR$ LOOP COUNT(50)
@@ -97,7 +97,7 @@ BEGIN_PROVIDER [ double precision, E_pot_elec, (elec_num) ]
       E_pot_elec(i) = E_pot_elec(i) - nucl_charge(j)*nucl_elec_dist_inv(j,i)
     enddo
   enddo
-  
+
 END_PROVIDER
 
 
@@ -106,7 +106,7 @@ BEGIN_PROVIDER [ double precision, E_pot_elec_one, (elec_num) ]
   BEGIN_DOC
   ! Electronic Potential energy
   END_DOC
-  
+
   integer                        :: i, j
   do i=1,elec_num
     E_pot_elec_one(i) = 0.d0
@@ -116,7 +116,7 @@ BEGIN_PROVIDER [ double precision, E_pot_elec_one, (elec_num) ]
       E_pot_elec_one(i) -= nucl_charge(j)*nucl_elec_dist_inv(j,i)
     enddo
   enddo
-  
+
 END_PROVIDER
 
 
@@ -125,7 +125,7 @@ BEGIN_PROVIDER [ double precision, E_pot_elec_two, (elec_num) ]
   BEGIN_DOC
   ! Electronic Potential energy
   END_DOC
-  
+
   integer                        :: i, j
   do i=1,elec_num
     E_pot_elec_two(i) = 0.d0
@@ -138,22 +138,38 @@ BEGIN_PROVIDER [ double precision, E_pot_elec_two, (elec_num) ]
       E_pot_elec_two(i) += 0.5d0*elec_dist_inv(j,i)
     enddo
   enddo
-  
+
 END_PROVIDER
 
 
 BEGIN_PROVIDER [ double precision, E_kin_elec, (elec_num) ]
   implicit none
-  
+
   BEGIN_DOC
   ! Electronic Kinetic energy : -1/2 (Lapl.Psi)/Psi
   END_DOC
-  
+
   integer                        :: i
   do i=1,elec_num
     E_kin_elec(i) = -0.5d0*psi_lapl_psi_inv(i)
   enddo
-  
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, dmc_zv_weight ]
+ implicit none
+ BEGIN_DOC
+ ! Weight for Zero-variance in DMC
+ END_DOC
+ dmc_zv_weight = 1.d0
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, dmc_zv_weight_half ]
+ implicit none
+ BEGIN_DOC
+ ! Weight for Zero-variance in DMC
+ END_DOC
+ dmc_zv_weight_half = 1.d0
 END_PROVIDER
 
 
@@ -166,7 +182,7 @@ BEGIN_PROVIDER [ double precision, E_nucl ]
   BEGIN_DOC
   ! Nuclear potential energy
   END_DOC
-  
+
   E_nucl = 0.d0
   integer                        :: i, j
   do i=1,nucl_num
@@ -174,7 +190,7 @@ BEGIN_PROVIDER [ double precision, E_nucl ]
       E_nucl += nucl_charge(i)*nucl_charge(j)/nucl_dist(j,i)
     enddo
   enddo
-  
+
   E_nucl_min = min(E_nucl,E_nucl_min)
   E_nucl_max = max(E_nucl,E_nucl_max)
   SOFT_TOUCH E_nucl_min E_nucl_max
@@ -186,13 +202,13 @@ BEGIN_PROVIDER [ double precision, E_pot ]
   BEGIN_DOC
   ! Electronic Potential energy
   END_DOC
-  
+
   E_pot = 0.d0
   integer                        :: i, j
   do i=1,elec_num
     E_pot += E_pot_elec(i)
   enddo
-  
+
   E_pot_min = min(E_pot,E_pot_min)
   E_pot_max = max(E_pot,E_pot_max)
   SOFT_TOUCH E_pot_min E_pot_max
@@ -204,16 +220,16 @@ BEGIN_PROVIDER [ double precision, E_kin ]
   BEGIN_DOC
   ! Electronic Kinetic energy : -1/2 (Lapl.Psi)/Psi
   END_DOC
-  
+
   E_kin = 0.d0
-  
+
   integer                        :: i
   !DIR$ VECTOR ALIGNED
   !DIR$ LOOP COUNT(200)
   do i=1,elec_num
     E_kin -= 0.5d0*psi_lapl_psi_inv(i)
   enddo
-  
+
   E_kin_min = min(E_kin,E_kin_min)
   E_kin_max = max(E_kin,E_kin_max)
   SOFT_TOUCH E_kin_min E_kin_max
@@ -226,7 +242,7 @@ BEGIN_PROVIDER  [ double precision, E_loc ]
   BEGIN_DOC
   ! Local energy : E_kin + E_pot + E_nucl
   END_DOC
-  
+
   integer                        :: i
   E_loc = E_nucl
   !DIR$ VECTOR ALIGNED
@@ -234,20 +250,29 @@ BEGIN_PROVIDER  [ double precision, E_loc ]
   do i=1,elec_num
     E_loc += E_kin_elec(i) + E_pot_elec(i)
   enddo
-  
-  ! Avoid divergence of E_loc
-  if (qmc_method == t_DMC) then
+
+  ! Avoid divergence of E_loc and population explosion
+  if (do_pseudo .and. (qmc_method == t_DMC) ) then
     double precision :: delta_e
     delta_e = E_loc-E_ref
-    E_loc = E_ref + erf(1.d0/(time_step*delta_e*time_step*delta_e)) * delta_e
+    E_loc = E_ref + delta_e * dexp(-dabs(delta_e)*time_step_sq)
   endif
-
-  
   E_loc_min = min(E_loc,E_loc_min)
   E_loc_max = max(E_loc,E_loc_max)
   SOFT_TOUCH E_loc_min E_loc_max
 END_PROVIDER
 
 
+!BEGIN_PROVIDER [ double precision, E_loc_zv, ((pdmc_n_diag+1)*2) ]
+BEGIN_PROVIDER [ double precision, E_loc_zv ]
+ implicit none
+ BEGIN_DOC
+ ! Zero-variance parameter on E_loc
+ END_DOC
+   E_loc_zv = E_loc
+   E_loc_zv += (E_trial-E_loc) * dmc_zv_weight
+!   E_loc_zv += - time_step*(E_trial**2 + 1.44341217940434 - E_loc**2)*dmc_zv_weight
+!  E_loc_zv(3)  = dmc_zv_weight_half
+!  E_loc_zv(:)  = 0.d0
 
-
+END_PROVIDER

src/PROPERTIES/properties_general.irp.f

@@ -47,19 +47,23 @@ BEGIN_PROVIDER  [ double precision, wf_extension ]
   SOFT_TOUCH wf_extension_min wf_extension_max
 END_PROVIDER
 
-BEGIN_PROVIDER [ double precision, dmc_pop_weight ]
+BEGIN_PROVIDER [ double precision, pop_weight ]
  implicit none
  BEGIN_DOC
- ! Weight of the DMC population
+ ! Weight of the SRMC population
  END_DOC
- dmc_pop_weight = pop_weight_mult
- dmc_pop_weight_min = min(dmc_pop_weight,dmc_pop_weight_min)
- dmc_pop_weight_max = max(dmc_pop_weight,dmc_pop_weight_max)
- SOFT_TOUCH dmc_pop_weight_min dmc_pop_weight_max
+ include '../types.F'
+ if (qmc_method == t_SRMC) then
+   pop_weight = srmc_pop_weight_mult
+ else if (qmc_method == t_PDMC) then
+   pop_weight = pdmc_pop_weight_mult(pdmc_n_diag)
+ endif
+ pop_weight_min = min(pop_weight,pop_weight_min)
+ pop_weight_max = max(pop_weight,pop_weight_max)
+ SOFT_TOUCH pop_weight_min pop_weight_max
 
 END_PROVIDER
 
-
 BEGIN_PROVIDER [ double precision, drift_mod, (size_drift_mod) ]
   implicit none
   BEGIN_DOC

src/PROPERTIES/properties_mu.irp.f

@@ -0,0 +1,268 @@
+
+BEGIN_PROVIDER [ double precision, emudiff ]
+  implicit none
+  BEGIN_DOC
+  ! E mu
+  END_DOC
+
+  !emudiff = e_loc - energy_mu * jast_value_inv * jast_value_inv
+  emudiff = ( e_loc - energy_mu ) * jast_value_inv * jast_value_inv
+
+  emudiff_min = min(emudiff_min,emudiff)
+  emudiff_max = max(emudiff_max,emudiff)
+  SOFT_TOUCH emudiff_min emudiff_max
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, Energy_mu ]
+
+  BEGIN_DOC
+  ! E mu = < H_mu \Phi / \Phi >_{\Phi^2}
+  END_DOC
+
+  implicit none
+  integer :: i
+
+  double precision :: lapl
+  lapl = 0.d0
+  do i=1,elec_num
+    lapl += psidet_grad_lapl(4,i)*psidet_inv + jast_elec_mu_lapl(i) + &
+    2.d0*psidet_inv * (&
+        psidet_grad_lapl(1,i)*jast_elec_mu_grad_x(i) +                   &
+        psidet_grad_lapl(2,i)*jast_elec_mu_grad_y(i) +                   &
+        psidet_grad_lapl(3,i)*jast_elec_mu_grad_z(i)  ) + ( &
+        jast_elec_mu_grad_x(i)*jast_elec_mu_grad_x(i) + &
+        jast_elec_mu_grad_y(i)*jast_elec_mu_grad_y(i) + &
+        jast_elec_mu_grad_z(i)*jast_elec_mu_grad_z(i) )
+
+  enddo
+  Energy_mu = -0.5d0 * lapl + E_nucl + E_pot
+
+  energy_mu_min = min(energy_mu_min,energy_mu)
+  energy_mu_max = max(energy_mu_max,energy_mu)
+  SOFT_TOUCH energy_mu_min energy_mu_max
+END_PROVIDER
+
+BEGIN_PROVIDER [double precision, E_nucl_elec]
+ implicit none
+ integer :: i,j
+ E_nucl_elec = 0.d0
+ do i = 1, elec_num
+!  E_nucl_elec += E_pot_elec_one(i) + E_pot_elec_two(i)
+  E_nucl_elec += E_pot_elec_one(i) 
+ enddo
+  E_nucl_elec_min = min(E_nucl_elec_min,E_nucl_elec)
+  E_nucl_elec_max = max(E_nucl_elec_max,E_nucl_elec)
+END_PROVIDER 
+
+
+ BEGIN_PROVIDER [double precision, Eff_pot_mu_elec, (elec_num)]
+&BEGIN_PROVIDER [double precision, Eff_pot_mu_elec_simple, (elec_num)]
+
+  include '../constants.F'
+
+  implicit none
+  integer :: i,j
+  double precision :: rij, mu
+
+  mu = jast_mu_erf
+  Eff_pot_mu_elec = 0.d0
+
+
+  ! 2body-Jastrow:
+  ! 
+  ! \Delta_i u_ij + \Delta_j u_ij     = 2 [ (1-erf(mu r_ij))/r_ij - mu exp(-(mu r_ij)^2)/sqrt(pi) ]
+  !
+  ! (grad_i u_ij)^2 + (grad_j u_ij)^2 = (1-erf(mu r_ij))^2 / 2 
+
+  do i = 1, elec_num
+    !DIR$ VECTOR ALIGNED
+    !DIR$ LOOP COUNT(50)
+    do j = 1, elec_num
+      rij = elec_dist(j,i)
+      if(i==j)cycle
+
+      Eff_pot_mu_elec(i) = Eff_pot_mu_elec(i) + 0.5d0 * derf(mu * rij) * elec_dist_inv(j,i)
+      Eff_pot_mu_elec(i) = Eff_pot_mu_elec(i) + 0.5d0 * mu/dsqpi * dexp(-mu*mu*rij*rij)
+      Eff_pot_mu_elec_simple(i) = Eff_pot_mu_elec(i)
+
+      Eff_pot_mu_elec(i) = Eff_pot_mu_elec(i) + 0.5d0 * (-  0.25d0 * (1.d0 - derf(mu*rij))**2.d0 )
+                                             
+    enddo
+  enddo
+
+  ! 1-body Jastrow
+  if( jast_1b_type .gt. 0 ) then
+    do i = 1, elec_num
+      Eff_pot_mu_elec(i) -= 0.5d0 * jast_1b_lapl(i) 
+      Eff_pot_mu_elec(i) -= 0.5d0 * jast_1b_grad_sq(i) 
+      do j = 1, elec_num
+        if(i==j) cycle
+        ! + sign for i <--> j
+        ! 0.5d0  for double counting
+        Eff_pot_mu_elec(i) += 0.5d0 *                                                      &
+                            ( grad_j_mu_x(j,i) * ( jast_1b_grad_x(i) - jast_1b_grad_x(j) ) &
+                            + grad_j_mu_y(j,i) * ( jast_1b_grad_y(i) - jast_1b_grad_y(j) ) &
+                            + grad_j_mu_z(j,i) * ( jast_1b_grad_z(i) - jast_1b_grad_z(j) ) )
+      enddo
+    enddo
+  endif
+
+END_PROVIDER 
+
+ BEGIN_PROVIDER [double precision, Eff_pot_mu ]
+ implicit none
+ include '../constants.F'
+ integer :: i
+ Eff_pot_mu = 0.d0
+ do i=1,elec_num
+  Eff_pot_mu += Eff_pot_mu_elec(i) 
+ enddo
+  Eff_pot_mu_min = min(Eff_pot_mu_min,Eff_pot_mu)
+  Eff_pot_mu_max = max(Eff_pot_mu_max,Eff_pot_mu)
+  SOFT_TOUCH Eff_pot_mu_min Eff_pot_mu_max
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, Eff_pot_mu_simple ]
+ implicit none
+ include '../constants.F'
+ integer :: i
+ Eff_pot_mu_simple = 0.d0
+ do i=1,elec_num
+  Eff_pot_mu_simple += Eff_pot_mu_elec_simple(i) 
+ enddo
+  Eff_pot_mu_simple_min = min(Eff_pot_mu_simple_min,Eff_pot_mu_simple)
+  Eff_pot_mu_simple_max = max(Eff_pot_mu_simple_max,Eff_pot_mu_simple)
+  SOFT_TOUCH Eff_pot_mu_simple_min Eff_pot_mu_simple_max
+
+END_PROVIDER 
+
+
+
+BEGIN_PROVIDER [double precision, Eff_pot_deriv_mu_elec, (elec_num) ]
+
+  BEGIN_DOC
+  !
+  ! non-Hermitian term:
+  !   - grad_i(tau) . grad_i(\Phi) / \Phi
+  !
+  END_DOC
+
+  implicit none
+  integer          :: i, j
+  double precision :: rij, mu
+
+  mu = jast_mu_erf
+  Eff_pot_deriv_mu_elec = 0.d0
+
+  ! 2body-Jastrow: (eq A4)
+  !   - [ grad_i(tau_mu) . grad_i(\Phi) + grad_j(tau_mu) . grad_j(\Phi) ] / \Phi = 
+  !   ( erf(mu r_ij) - 1 ) / ( 2 r_ij \Phi) * [ 
+  !                           ( x_i - x_j ) * ( \partial_{x_i} - \partial_{x_j} ) + 
+  !                           ( y_i - y_j ) * ( \partial_{y_i} - \partial_{y_j} ) +
+  !                           ( z_i - z_j ) * ( \partial_{z_i} - \partial_{z_j} ) ]
+  !
+  do i = 1, elec_num
+    do j = 1, elec_num
+      if(i==j)cycle
+      rij = elec_dist(i,j)
+      Eff_pot_deriv_mu_elec(i) += 0.5d0 * ( derf(mu * rij) - 1.d0 ) * elec_dist_inv(j,i)   &
+                                        * ( - elec_dist_vec_x(j,i) * psidet_grad_lapl(1,i) &
+                                            - elec_dist_vec_y(j,i) * psidet_grad_lapl(2,i) &
+                                            - elec_dist_vec_z(j,i) * psidet_grad_lapl(3,i) ) * psidet_inv
+    enddo
+  enddo
+
+
+  ! 1-body Jastrow
+  if( jast_1b_type .gt. 0 ) then
+    do i = 1, elec_num
+      Eff_pot_deriv_mu_elec(i) -= ( jast_1b_grad_x(i) * psidet_grad_lapl(1,i) &
+                                  + jast_1b_grad_y(i) * psidet_grad_lapl(2,i) &
+                                  + jast_1b_grad_z(i) * psidet_grad_lapl(3,i) ) * psidet_inv
+    enddo
+  endif
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [double precision, three_body_mu ]
+ implicit none
+ integer :: i,j,k
+ three_body_mu = 0.d0
+ do i = 1, elec_num
+  do j = i+1, elec_num
+   do k = j+1, elec_num
+    three_body_mu += grad_j_mu_x(i,j) * grad_j_mu_x(i,k) 
+    three_body_mu += grad_j_mu_y(i,j) * grad_j_mu_y(i,k) 
+    three_body_mu += grad_j_mu_z(i,j) * grad_j_mu_z(i,k) 
+
+    three_body_mu += grad_j_mu_x(j,i) * grad_j_mu_x(j,k) 
+    three_body_mu += grad_j_mu_y(j,i) * grad_j_mu_y(j,k) 
+    three_body_mu += grad_j_mu_z(j,i) * grad_j_mu_z(j,k) 
+
+    three_body_mu += grad_j_mu_x(k,i) * grad_j_mu_x(k,j) 
+    three_body_mu += grad_j_mu_y(k,i) * grad_j_mu_y(k,j) 
+    three_body_mu += grad_j_mu_z(k,i) * grad_j_mu_z(k,j) 
+   enddo
+  enddo
+ enddo
+ three_body_mu_min = min(three_body_mu_min,three_body_mu)
+ three_body_mu_max = max(three_body_mu_max,three_body_mu)
+ SOFT_TOUCH  three_body_mu_min three_body_mu_max
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, Eff_pot_deriv_mu]
+ implicit none
+ integer :: i
+ Eff_pot_deriv_mu = 0.d0
+ do i = 1, elec_num
+  Eff_pot_deriv_mu += Eff_pot_deriv_mu_elec(i)
+ enddo
+  eff_pot_deriv_mu_min = min(eff_pot_deriv_mu_min,eff_pot_deriv_mu)
+  eff_pot_deriv_mu_max = max(eff_pot_deriv_mu_max,eff_pot_deriv_mu)
+  SOFT_TOUCH eff_pot_deriv_mu_min eff_pot_deriv_mu_max
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, ci_dress_mu, (size_ci_dress_mu) ]
+  BEGIN_DOC
+  ! Dimensions : det_num
+  END_DOC
+  implicit none
+  integer          :: i, j, k, l
+  double precision :: T, dij, f, E_noJ, dE
+  ! energy_mu = H_mu \Phi / \Phi
+  dE = (E_loc - energy_mu) * psi_value_inv * jast_value_inv
+  do k = 1, det_num
+     i = det_coef_matrix_rows(   k)
+     j = det_coef_matrix_columns(k)
+     f = det_alpha_value(i) * det_beta_value(j)
+     ci_dress_mu(k) = dE * f
+  enddo
+  ci_dress_mu_min = min(ci_dress_mu_min, minval(ci_dress_mu))
+  ci_dress_mu_max = max(ci_dress_mu_max, maxval(ci_dress_mu))
+  SOFT_TOUCH ci_dress_mu_min ci_dress_mu_max
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ci_dress_mu_opt ]
+  BEGIN_DOC
+  ! Use for optimizing mu
+  END_DOC
+  implicit none
+  integer          :: i, j, k, l
+  double precision :: T, dij, f, E_noJ, dE
+  ! energy_mu = H_mu \Phi / \Phi
+  dE = (E_loc - energy_mu) * psi_value_inv * jast_value_inv ! PsiJ.J
+  k = 1
+  i = det_coef_matrix_rows(   k)
+  j = det_coef_matrix_columns(k)
+  f = det_alpha_value(i) * det_beta_value(j)
+  ci_dress_mu_opt = dE * f
+  ci_dress_mu_opt = E_loc - energy_mu
+  ci_dress_mu_opt_min = min(ci_dress_mu_opt_min, ci_dress_mu_opt)
+  ci_dress_mu_opt_max = max(ci_dress_mu_opt_max, ci_dress_mu_opt)
+  SOFT_TOUCH ci_dress_mu_opt_min ci_dress_mu_opt_max
+END_PROVIDER
+

src/SAMPLING/block.irp.f

@@ -1,6 +1,6 @@
 ! Providers of *_block_walk
 !==============================
-BEGIN_SHELL [ /usr/bin/python ]
+BEGIN_SHELL [ /usr/bin/env python2 ]
 from properties import *
 
 t = """
@@ -24,6 +24,24 @@ t = """
     $X_block_walk = $X_dmc_block_walk
     $X_2_block_walk = $X_2_dmc_block_walk
   endif
+ else if (qmc_method == t_SRMC) then
+  PROVIDE E_loc_srmc_block_walk
+  if (calc_$X) then
+    $X_block_walk = $X_srmc_block_walk
+    $X_2_block_walk = $X_2_srmc_block_walk
+  endif
+ else if (qmc_method == t_PDMC) then
+  PROVIDE E_loc_pdmc_block_walk
+  if (calc_$X) then
+    $X_block_walk = $X_pdmc_block_walk
+    $X_2_block_walk = $X_2_pdmc_block_walk
+  endif
+ else if (qmc_method == t_FKMC) then
+  PROVIDE E_loc_fkmc_block_walk
+  if (calc_$X) then
+    $X_block_walk = $X_fkmc_block_walk
+    $X_2_block_walk = $X_2_fkmc_block_walk
+  endif
  endif
 
 END_PROVIDER

src/SAMPLING/brownian_step.irp.f

@@ -84,13 +84,8 @@ subroutine brownian_step(p,q,accepted,delta_x)
   !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xdiff_y
   !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xdiff_z
   double precision :: gauss 
-! integer :: k
-! k=0
   do l=1,3
    do i=1,elec_num
-   !k=k+1
-   !double precision :: halton_gauss 
-   !xbrown(i,l) = halton_gauss(k)*time_step_sq
     xbrown(i,l) = gauss()*time_step_sq
    enddo
   enddo

src/SAMPLING/dmc_step.irp.f

@@ -1,6 +1,6 @@
 ! Providers of *_dmc_block_walk
 !==============================
-BEGIN_SHELL [ /usr/bin/python ]
+BEGIN_SHELL [ /usr/bin/env python2 ]
 from properties import *
 
 t = """
@@ -10,7 +10,7 @@ t = """
 &BEGIN_PROVIDER [ $T, $X_2_dmc_block_walk_kahan $D2 ]
  implicit none
  BEGIN_DOC  
-! VMC averages of $X
+! DMC averages of $X. Computed in E_loc_dmc_block_walk
  END_DOC
  $X_dmc_block_walk = 0.d0
  $X_dmc_block_walk_kahan = 0.d0
@@ -27,113 +27,151 @@ for p in properties:
       D1 = ", ("+p[2][1:-1]+")"
       D2 = ", ("+p[2][1:-1]+",3)"
     print t.replace("$X",p[1]).replace("$T",p[0]).replace("$D1",D1).replace("$D2",D2)
+
 END_SHELL
 
 
 
- BEGIN_PROVIDER [ double precision, E_loc_dmc_block_walk  ]
-&BEGIN_PROVIDER [ double precision, E_loc_2_dmc_block_walk  ]
+ BEGIN_PROVIDER [ double precision, E_loc_dmc_block_walk       ]
+&BEGIN_PROVIDER [ double precision, E_loc_2_dmc_block_walk     ]
 &BEGIN_PROVIDER [ double precision, E_loc_dmc_block_walk_kahan, (3) ]
-&BEGIN_PROVIDER [ double precision, E_loc_2_dmc_block_walk_kahan, (3) 
+&BEGIN_PROVIDER [ double precision, E_loc_2_dmc_block_walk_kahan, (3) ]
  implicit none
  include '../types.F'
  BEGIN_DOC
 ! Properties averaged over the block using the DMC method
  END_DOC
 
-  real, allocatable :: elec_coord_tmp(:,:,:)
-  integer :: mod_align
-  double precision, allocatable :: psi_grad_psi_inv_save_tmp(:,:,:)
-  double precision :: psi_value_save_tmp(walk_num)
-  integer :: trapped_walk_tmp(walk_num)
-  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_grad_psi_inv_save_tmp
-  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save_tmp
-  allocate ( elec_coord_tmp(mod_align(elec_num+1),3,walk_num) )
-  allocate ( psi_grad_psi_inv_save_tmp(elec_num_8,3,walk_num) )
+ real, allocatable :: elec_coord_tmp(:,:,:)
+ integer :: mod_align
+ double precision :: E_loc_save(walk_num_dmc_max)
+ double precision :: E_loc_save_tmp(walk_num_dmc_max)
+ double precision :: psi_value_save(walk_num_dmc_max)
+ double precision :: psi_value_save_tmp(walk_num_dmc_max)
+ double precision :: dmc_weight(walk_num_dmc_max)
+ integer :: trapped_walk_tmp(walk_num_dmc_max)
+ !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: E_loc_save
+ !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: E_loc_save_tmp
+ !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dmc_weight
+ !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save
+ !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save_tmp
+ allocate ( elec_coord_tmp(mod_align(elec_num+1),3,walk_num_dmc_max) )
+ psi_value_save = 0.d0
+ psi_value_save_tmp = 0.d0
+ dmc_weight = 1.d0
 
 ! Initialization
  if (vmc_algo /= t_Brownian) then
    call abrt(irp_here,'DMC should run with Brownian algorithm')
  endif
- PROVIDE E_loc_vmc_block_walk
 
  integer :: k, i_walk, i_step
 
-BEGIN_SHELL [ /usr/bin/python ]
+BEGIN_SHELL [ /usr/bin/env python2 ]
 from properties import *
 t = """
  if (calc_$X) then
+   !DIR$ VECTOR ALIGNED
    $X_dmc_block_walk = 0.d0
+   !DIR$ VECTOR ALIGNED
    $X_dmc_block_walk_kahan = 0.d0
+   !DIR$ VECTOR ALIGNED
    $X_2_dmc_block_walk = 0.d0
+   !DIR$ VECTOR ALIGNED
    $X_2_dmc_block_walk_kahan = 0.d0
-   $X_min = huge(1.)
-   $X_max =-huge(1.)
  endif
 """
 for p in properties:
  print  t.replace("$X",p[1])
 END_SHELL
 
- double precision :: icount
-
- icount = 0.d0
-
  logical                        :: loop
  integer*8                      :: cpu0, cpu1, cpu2, count_rate, count_max
 
  loop = .True.
  call system_clock(cpu0, count_rate, count_max)
  cpu2 = cpu0
+
+ block_weight = 0.d0
+
+ real, external                 :: accep_rate
+ double precision               :: delta, thr, E0
+
+ thr = 2.d0/time_step_sq
+ E0 = E_ref
+
+
  do while (loop)
-  ! Move to the next projection step
-  dmc_projection_step = mod(dmc_projection_step,dmc_projection)+1
 
-  ! Remove contribution of the old value of the weight at the new
-  ! projection step
-  pop_weight_mult *= 1.d0/pop_weight(dmc_projection_step)
+  ! Every walker makes a step
+  do i_walk=1,walk_num_dmc
+    integer :: i,j,l
+    do l=1,3
+      do i=1,elec_num+1
+        elec_coord(i,l) = elec_coord_full_dmc(i,l,i_walk)
+      enddo
+    enddo
+    TOUCH elec_coord
 
-  ! Compute the new weight of the population
-  pop_weight(dmc_projection_step) = 0.d0
-  do k=1,walk_num
-    pop_weight(dmc_projection_step) += dmc_weight(k)
-  enddo
+   double precision               :: p,q
+   real                           :: delta_x
+   logical                        :: accepted
+   call brownian_step(p,q,accepted,delta_x)
+   if (accepted) then
+      trapped_walk(i_walk) = 0
+   else
+      trapped_walk(i_walk) += 1
+   endif
 
-  ! Normalize the weight of the walkers by the weight of the population
-  do k=1,walk_num
-    dmc_weight(k) = dmc_weight(k)/pop_weight(dmc_projection_step)
-  enddo
+   if ( (trapped_walk(i_walk) < trapped_walk_max).and. &
+        (psi_value * psi_value_save(i_walk) >= 0.d0) ) then
+     delta = ((E_loc+E_loc_save(i_walk))*0.5d0 - E0) * p 
+     if ( delta > thr ) then
+       dmc_weight(i_walk) = dexp(-dtime_step*thr)
+     else if ( delta < -thr ) then
+       dmc_weight(i_walk) = dexp(dtime_step*thr)
+     else
+       dmc_weight(i_walk) = dexp(-dtime_step*delta)
+     endif
+   else
+     dmc_weight(i_walk) = 0.d0
+     trapped_walk(i_walk) = 0
+   endif
+   
+   elec_coord(elec_num+1,1) += p*time_step
+   elec_coord(elec_num+1,2)  = E_loc
+   elec_coord(elec_num+1,3)  = dmc_weight(i_walk)
+   do l=1,3
+      do i=1,elec_num+1
+        elec_coord_full_dmc(i,l,i_walk) = elec_coord(i,l)
+      enddo
+   enddo
 
-  ! Normalize the weight of the population at the current projection step by
-  ! the number of walkers
-  pop_weight(dmc_projection_step) = pop_weight(dmc_projection_step)/dble(walk_num)
+   psi_value_save(i_walk) = psi_value
+   E_loc_save(i_walk) = E_loc
 
-  ! Update the running population weight
-  pop_weight_mult *= pop_weight(dmc_projection_step)
-  SOFT_TOUCH pop_weight_mult
-
-BEGIN_SHELL [ /usr/bin/python ]
+BEGIN_SHELL [ /usr/bin/env python2 ]
 from properties import *
 t = """
- if (calc_$X) then
-! Kahan's summation algorithm to compute these sums reducing the rounding error:
-!  $X_dmc_block_walk($D)   += $X * pop_weight_mult
-!  $X_2_dmc_block_walk($D) += $X_2 * pop_weight_mult
-! see http://en.wikipedia.org/wiki/Kahan_summation_algorithm
-
-   $X_dmc_block_walk_kahan($D2 3) = $X * pop_weight_mult - $X_dmc_block_walk_kahan($D2 1)
-   $X_dmc_block_walk_kahan($D2 2) = $X_dmc_block_walk $D1  + $X_dmc_block_walk_kahan($D2 3)
-   $X_dmc_block_walk_kahan($D2 1) = ($X_dmc_block_walk_kahan($D2 2) - $X_dmc_block_walk $D1 ) &
-       - $X_dmc_block_walk_kahan($D2 3)
-   $X_dmc_block_walk $D1  =  $X_dmc_block_walk_kahan($D2 2) 
-
-
-   $X_2_dmc_block_walk_kahan($D2 3) = $X_2 * pop_weight_mult - $X_2_dmc_block_walk_kahan($D2 1)
-   $X_2_dmc_block_walk_kahan($D2 2) = $X_2_dmc_block_walk $D1 + $X_2_dmc_block_walk_kahan($D2 3)
-   $X_2_dmc_block_walk_kahan($D2 1) = ($X_2_dmc_block_walk_kahan($D2 2) - $X_2_dmc_block_walk $D1 ) &
-       - $X_2_dmc_block_walk_kahan($D2 3)
-   $X_2_dmc_block_walk $D1 =  $X_2_dmc_block_walk_kahan($D2 2) 
- endif
+     if (calc_$X) then
+   ! Kahan's summation algorithm to compute these sums reducing the rounding error:
+   !  $X_dmc_block_walk    += $X * dmc_weight(i_walk)
+   !  $X_2_dmc_block_walk  += $X_2 * dmc_weight(i_walk)
+   ! see http://en.wikipedia.org/wiki/Kahan_summation_algorithm
+   
+      $X_dmc_block_walk_kahan($D2 3) = $X * dmc_weight(i_walk) - $X_dmc_block_walk_kahan($D2 1)
+      $X_dmc_block_walk_kahan($D2 2) = $X_dmc_block_walk $D1  + $X_dmc_block_walk_kahan($D2 3)
+      $X_dmc_block_walk_kahan($D2 1) = ($X_dmc_block_walk_kahan($D2 2) - $X_dmc_block_walk $D1 ) &
+          - $X_dmc_block_walk_kahan($D2 3)
+      $X_dmc_block_walk $D1  =  $X_dmc_block_walk_kahan($D2 2) 
+   
+   
+      $X_2_dmc_block_walk_kahan($D2 3) = $X_2 * dmc_weight(i_walk) - $X_2_dmc_block_walk_kahan($D2 1)
+      $X_2_dmc_block_walk_kahan($D2 2) = $X_2_dmc_block_walk $D1 + $X_2_dmc_block_walk_kahan($D2 3)
+      $X_2_dmc_block_walk_kahan($D2 1) = ($X_2_dmc_block_walk_kahan($D2 2) - $X_2_dmc_block_walk $D1 ) &
+          - $X_2_dmc_block_walk_kahan($D2 3)
+      $X_2_dmc_block_walk $D1 =  $X_2_dmc_block_walk_kahan($D2 2) 
+     endif
 """
 for p in properties:
   if p[2] == "":
@@ -143,88 +181,91 @@ for p in properties:
    D1 = "("+":"*(p[2].count(',')+1)+")"
    D2 = ":"*(p[2].count(',')+1)+","
   print t.replace("$X",p[1]).replace("$D1",D1).replace("$D2",D2)
+
 END_SHELL
-  icount += pop_weight_mult
 
-! Reconfiguration
 
-  integer :: ipos(walk_num)
-  call reconfigure(ipos,dmc_weight)
-   
-  do k=1,walk_num
-    integer :: i, l
+   block_weight += dmc_weight(i_walk)
+
+  enddo
+
+  ! Population control
+  double precision :: sum_weight
+  sum_weight = 0.d0
+  do k=1,walk_num_dmc
+    sum_weight += dmc_weight(k)
+  enddo
+  E0 = E_ref - log(sum_weight/real(walk_num)) * 0.1d0 /dtime_step
+
+! Branching
+  integer                        :: ipos(walk_num_dmc_max), walk_num_dmc_new
+  double precision, external     :: qmc_ranf
+  double precision               :: r
+
+  do k=1,walk_num_dmc
     do l=1,3
      do i=1,elec_num+1
-      elec_coord_tmp(i,l,k) = elec_coord_full(i,l,k)
-     enddo
-     !DIR$ VECTOR ALIGNED
-     !DIR$ LOOP COUNT(200)
-     do i=1,elec_num
-      psi_grad_psi_inv_save_tmp(i,l,k) = psi_grad_psi_inv_save(i,l,k)
+      elec_coord_tmp(i,l,k) = elec_coord_full_dmc(i,l,k)
      enddo
     enddo
     psi_value_save_tmp(k) = psi_value_save(k)
+    E_loc_save_tmp(k) = E_loc_save(k)
     trapped_walk_tmp(k) = trapped_walk(k)
+    ipos(k) = k
   enddo
-  
+
+  walk_num_dmc_new = walk_num_dmc
+  do k=1,walk_num_dmc
+    r = qmc_ranf()
+    if (dmc_weight(k) > 1.d0) then
+      if ( 1.d0+r < dmc_weight(k) ) then
+        walk_num_dmc_new = walk_num_dmc_new+1
+        ipos(walk_num_dmc_new) = k
+      endif
+    else
+      if ( r > dmc_weight(k) ) then
+        ipos(k) = ipos(walk_num_dmc_new)
+        walk_num_dmc_new = walk_num_dmc_new-1
+      endif
+    endif
+  enddo
+  walk_num_dmc = walk_num_dmc_new
+
   integer :: ipm
-  do k=1,walk_num
+  do k=1,walk_num_dmc
    ipm = ipos(k)
    do l=1,3
     do i=1,elec_num+1
-     elec_coord_full(i,l,k) = elec_coord_tmp(i,l,ipm)
-    enddo
-    !DIR$ VECTOR ALIGNED
-    !DIR$ LOOP COUNT(200)
-    do i=1,elec_num
-     psi_grad_psi_inv_save(i,l,k) = psi_grad_psi_inv_save_tmp(i,l,ipm)
+     elec_coord_full_dmc(i,l,k) = elec_coord_tmp(i,l,ipm)
     enddo
    enddo
+   E_loc_save(k) = E_loc_save_tmp(ipm)
    psi_value_save(k) = psi_value_save_tmp(ipm)
    trapped_walk(k) = trapped_walk_tmp(ipm)
   enddo
 
-  ! Set 1st walker
-  !DIR$ VECTOR ALIGNED
-  !DIR$ LOOP COUNT(200)
-  do i=1,elec_num
-    psi_grad_psi_inv_x(i) = psi_grad_psi_inv_save(i,1,1)
-    psi_grad_psi_inv_y(i) = psi_grad_psi_inv_save(i,2,1)
-    psi_grad_psi_inv_z(i) = psi_grad_psi_inv_save(i,3,1)
-  enddo
-
-  !DIR$ VECTOR UNALIGNED
-  !DIR$ LOOP COUNT(200)
-  do i=1,elec_num
-    elec_coord(i,1) = elec_coord_full(i,1,1)
-    elec_coord(i,2) = elec_coord_full(i,2,1)
-    elec_coord(i,3) = elec_coord_full(i,3,1)
-  enddo
-  psi_value = psi_value_save(1)
-
-  TOUCH elec_coord_full psi_value_save psi_grad_psi_inv_save psi_value psi_grad_psi_inv_x psi_grad_psi_inv_y psi_grad_psi_inv_z elec_coord
-
   call system_clock(cpu1, count_rate, count_max)
   if (cpu1 < cpu0) then
     cpu1 = cpu1+cpu0
   endif
-  loop = dble(cpu1-cpu0) < dble(block_time)*dble(count_rate)
+  loop = dble(cpu1-cpu0)/dble(count_rate) < block_time
   if (cpu1-cpu2 > count_rate) then
     integer                        :: do_run
     call get_running(do_run)
-    loop = do_run == t_Running
+    loop = loop.and.(do_run == t_Running)
     cpu2 = cpu1
   endif
 
+
+  SOFT_TOUCH elec_coord_full_dmc psi_value psi_grad_psi_inv_x psi_grad_psi_inv_y psi_grad_psi_inv_z elec_coord 
+
  enddo
 
-
-
  double precision :: factor
- factor = 1.d0/icount
- block_weight *= icount
+ factor = 1.d0/block_weight
  SOFT_TOUCH block_weight
-BEGIN_SHELL [ /usr/bin/python ]
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
 from properties import *
 t = """
  if (calc_$X) then
@@ -237,7 +278,22 @@ for p in properties:
 END_SHELL
 
  deallocate ( elec_coord_tmp )
- deallocate ( psi_grad_psi_inv_save_tmp )
+
+ do k=1,min(walk_num,walk_num_dmc)
+  do l=1,3
+   do i=1,elec_num+1
+    elec_coord_full(i,l,k) = elec_coord_full_dmc(i,l,k)
+   enddo
+  enddo
+ enddo
+ do k=walk_num_dmc+1,walk_num
+  do l=1,3
+   do i=1,elec_num+1
+    elec_coord_full(i,l,k) = elec_coord_full_dmc(i,l,mod(k,walk_num_dmc)+1)
+   enddo
+  enddo
+ enddo
+ SOFT_TOUCH elec_coord_full
 
 END_PROVIDER
 
@@ -251,33 +307,47 @@ BEGIN_PROVIDER [ double precision, E_ref ]
   call get_simulation_E_ref(E_ref)
 END_PROVIDER
 
-BEGIN_PROVIDER [ double precision, pop_weight_mult ]
+ BEGIN_PROVIDER [ integer, trapped_walk, (walk_num_dmc_max) ]
+&BEGIN_PROVIDER [ integer,  trapped_walk_max ]
  implicit none
  BEGIN_DOC  
-! Population weight of DMC
+! Number of steps when the walkers were trapped
  END_DOC
- pop_weight_mult = pop_weight(dmc_projection)
+ trapped_walk = 0
+ trapped_walk_max = 20
 END_PROVIDER
 
- BEGIN_PROVIDER [ integer, dmc_projection ]
-&BEGIN_PROVIDER [ integer, dmc_projection_step ]
+
+BEGIN_PROVIDER [ integer, walk_num_dmc ]
  implicit none
- BEGIN_DOC  
-! Number of projection steps for SRMC
+ BEGIN_DOC
+ ! Current number of walkers in DMC
  END_DOC
- real :: dmc_projection_time
- dmc_projection_time = 1.
- call get_simulation_dmc_projection_time(dmc_projection_time)
- dmc_projection = int( dmc_projection_time/time_step)
- dmc_projection_step = 0
+ walk_num_dmc = walk_num
 END_PROVIDER
 
-BEGIN_PROVIDER [ double precision, pop_weight, (dmc_projection) ]
+BEGIN_PROVIDER [ integer, walk_num_dmc_max ]
  implicit none
- BEGIN_DOC  
-! Population weight of DMC
+ BEGIN_DOC
+ ! Max number of walkers in DMC
  END_DOC
- pop_weight = 1.d0
- pop_weight(dmc_projection) = 1.d0/dble(dmc_projection)
+ walk_num_dmc_max = max(3 * walk_num, 30)
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ real, elec_coord_full_dmc, (elec_num+1,3,walk_num_dmc_max)]
+ implicit none
+ BEGIN_DOC
+ ! DMC population
+ END_DOC
+ integer :: i,k,l
+ do k=1,walk_num
+   do l=1,3
+     do i=1,elec_num+1
+       elec_coord_full_dmc(i,l,k) = elec_coord_full(i,l,k)
+      enddo
+    enddo
+  enddo
+
 END_PROVIDER
 

src/SAMPLING/fkmc_step.irp.f

@@ -0,0 +1,375 @@
+! Providers of *_fkmc_block_walk
+!==============================
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+
+t = """
+ BEGIN_PROVIDER [ $T, $X_fkmc_block_walk $D1 ]
+&BEGIN_PROVIDER [ $T, $X_fkmc_block_walk_kahan $D2 ]
+&BEGIN_PROVIDER [ $T, $X_2_fkmc_block_walk $D1 ]
+&BEGIN_PROVIDER [ $T, $X_2_fkmc_block_walk_kahan $D2 ]
+ implicit none
+ BEGIN_DOC  
+! fkMC averages of $X. Computed in E_loc_fkmc_block_walk
+ END_DOC
+ $X_fkmc_block_walk = 0.d0
+ $X_fkmc_block_walk_kahan = 0.d0
+ $X_2_fkmc_block_walk = 0.d0
+ $X_2_fkmc_block_walk_kahan = 0.d0
+END_PROVIDER
+"""
+for p in properties:
+  if p[1] != 'e_loc':
+    if p[2] == "":
+      D1 = ""
+      D2 = ", (3)"
+    else:
+      D1 = ", ("+p[2][1:-1]+")"
+      D2 = ", ("+p[2][1:-1]+",3)"
+    print t.replace("$X",p[1]).replace("$T",p[0]).replace("$D1",D1).replace("$D2",D2)
+
+END_SHELL
+
+
+
+ BEGIN_PROVIDER [ double precision, E_loc_fkmc_block_walk       ]
+&BEGIN_PROVIDER [ double precision, E_loc_2_fkmc_block_walk     ]
+&BEGIN_PROVIDER [ double precision, E_loc_fkmc_block_walk_kahan, (3) ]
+&BEGIN_PROVIDER [ double precision, E_loc_2_fkmc_block_walk_kahan, (3) ]
+ implicit none
+ include '../types.F'
+ BEGIN_DOC
+! Properties averaged over the block using the FKMC method
+ END_DOC
+
+  integer, parameter :: BIRTH=1, DEATH=2
+  real, allocatable :: elec_coord_tmp(:,:,:)
+  integer :: mod_align
+  double precision :: E_loc_save(walk_num_dmc_max)
+  double precision :: E_loc_save_tmp(walk_num_dmc_max)
+  double precision :: psi_value_save(walk_num)
+  double precision :: psi_value_save_tmp(walk_num)
+  double precision :: fkmc_weight(walk_num)
+  double precision :: delta(walk_num)
+  double precision, allocatable :: psi_grad_psi_inv_save(:,:,:)
+  double precision, allocatable :: psi_grad_psi_inv_save_tmp(:,:,:)
+  double precision, allocatable :: fkmc_clock_tmp(:,:)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_grad_psi_inv_save
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_grad_psi_inv_save_tmp
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: E_loc_save
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: E_loc_save_tmp
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save_tmp
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: fkmc_weight
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: fkmc_clock_tmp
+  allocate ( psi_grad_psi_inv_save(elec_num_8,3,walk_num),           &
+       psi_grad_psi_inv_save_tmp(elec_num_8,3,walk_num),             &
+       elec_coord_tmp(mod_align(elec_num+1),3,walk_num),             &
+       fkmc_clock_tmp(2,walk_num) )
+  psi_value_save = 0.d0
+  psi_value_save_tmp = 0.d0
+  fkmc_weight = 1.d0
+
+! Initialization
+ if (vmc_algo /= t_Brownian) then
+   call abrt(irp_here,'FKMC should run with Brownian algorithm')
+ endif
+
+ integer :: k, i_walk, i_step
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+t = """
+ if (calc_$X) then
+   !DIR$ VECTOR ALIGNED
+   $X_fkmc_block_walk = 0.d0
+   !DIR$ VECTOR ALIGNED
+   $X_fkmc_block_walk_kahan = 0.d0
+   !DIR$ VECTOR ALIGNED
+   $X_2_fkmc_block_walk = 0.d0
+   !DIR$ VECTOR ALIGNED
+   $X_2_fkmc_block_walk_kahan = 0.d0
+ endif
+"""
+for p in properties:
+ print  t.replace("$X",p[1])
+END_SHELL
+
+ logical                        :: loop
+ integer*8                      :: cpu0, cpu1, cpu2, count_rate, count_max
+
+ loop = .True.
+ call system_clock(cpu0, count_rate, count_max)
+ cpu2 = cpu0
+
+ block_weight = 0.d0
+
+ real, external                 :: accep_rate
+ double precision               :: thr
+
+ thr = 2.d0/time_step_sq
+
+ logical :: first_loop
+ first_loop = .True.
+
+ do while (loop)
+
+  ! Every walker makes a step
+  do i_walk=1,walk_num
+    
+    if (.not.first_loop) then
+      integer                        :: i,j,l
+      do l=1,3
+        do i=1,elec_num+1
+          elec_coord(i,l) = elec_coord_full(i,l,i_walk)
+        enddo
+        do i=1,elec_num
+          psi_grad_psi_inv_x(i) = psi_grad_psi_inv_save(i,1,i_walk)
+          psi_grad_psi_inv_y(i) = psi_grad_psi_inv_save(i,2,i_walk)
+          psi_grad_psi_inv_z(i) = psi_grad_psi_inv_save(i,3,i_walk)
+        enddo
+        psi_value = psi_value_save(i_walk)
+        E_loc = E_loc_save(i_walk)
+      enddo
+      SOFT_TOUCH elec_coord psi_grad_psi_inv_x psi_grad_psi_inv_y psi_grad_psi_inv_z psi_value E_loc
+    else
+      do l=1,3
+        do i=1,elec_num+1
+          elec_coord(i,l) = elec_coord_full(i,l,i_walk)
+        enddo
+      enddo
+      TOUCH elec_coord
+      E_loc_save(i_walk) = E_loc 
+      psi_value_save(i_walk) = psi_value
+    endif
+
+   double precision               :: p,q
+   real                           :: delta_x
+   logical                        :: accepted
+   call brownian_step(p,q,accepted,delta_x)
+
+   if ( psi_value * psi_value_save(i_walk) >= 0.d0 ) then
+     delta(i_walk) = ((E_loc+E_loc_save(i_walk))*0.5d0 - E_ref) * p
+     if ( delta(i_walk) > thr ) then
+       delta(i_walk) = thr
+     else if ( delta(i_walk) < -thr ) then
+       delta(i_walk) = -thr
+     endif
+     fkmc_weight(i_walk) = dexp(-dtime_step*delta(i_walk))
+     elec_coord(elec_num+1,1) += p*time_step
+     elec_coord(elec_num+1,2)  = E_loc
+     elec_coord(elec_num+1,3)  = fkmc_weight(i_walk) 
+     do l=1,3
+        do i=1,elec_num+1
+          elec_coord_full(i,l,i_walk) = elec_coord(i,l)
+        enddo
+     enddo
+     do i=1,elec_num
+       psi_grad_psi_inv_save(i,1,i_walk) = psi_grad_psi_inv_x(i)
+       psi_grad_psi_inv_save(i,2,i_walk) = psi_grad_psi_inv_y(i)
+       psi_grad_psi_inv_save(i,3,i_walk) = psi_grad_psi_inv_z(i)
+     enddo
+
+     psi_value_save(i_walk) = psi_value
+     E_loc_save(i_walk) = E_loc
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+t = """
+     if (calc_$X) then
+   ! Kahan's summation algorithm to compute these sums reducing the rounding error:
+   !  $X_fkmc_block_walk    += $X * fkmc_weight(i_walk)
+   !  $X_2_fkmc_block_walk  += $X_2 * fkmc_weight(i_walk)
+   ! see http://en.wikipedia.org/wiki/Kahan_summation_algorithm
+   
+      $X_fkmc_block_walk_kahan($D2 3) = $X * fkmc_weight(i_walk) - $X_fkmc_block_walk_kahan($D2 1)
+      $X_fkmc_block_walk_kahan($D2 2) = $X_fkmc_block_walk $D1  + $X_fkmc_block_walk_kahan($D2 3)
+      $X_fkmc_block_walk_kahan($D2 1) = ($X_fkmc_block_walk_kahan($D2 2) - $X_fkmc_block_walk $D1 ) &
+          - $X_fkmc_block_walk_kahan($D2 3)
+      $X_fkmc_block_walk $D1  =  $X_fkmc_block_walk_kahan($D2 2) 
+   
+   
+      $X_2_fkmc_block_walk_kahan($D2 3) = $X_2 * fkmc_weight(i_walk) - $X_2_fkmc_block_walk_kahan($D2 1)
+      $X_2_fkmc_block_walk_kahan($D2 2) = $X_2_fkmc_block_walk $D1 + $X_2_fkmc_block_walk_kahan($D2 3)
+      $X_2_fkmc_block_walk_kahan($D2 1) = ($X_2_fkmc_block_walk_kahan($D2 2) - $X_2_fkmc_block_walk $D1 ) &
+          - $X_2_fkmc_block_walk_kahan($D2 3)
+      $X_2_fkmc_block_walk $D1 =  $X_2_fkmc_block_walk_kahan($D2 2) 
+     endif
+"""
+for p in properties:
+  if p[2] == "":
+   D1 = ""
+   D2 = ""
+  else:
+   D1 = "("+":"*(p[2].count(',')+1)+")"
+   D2 = ":"*(p[2].count(',')+1)+","
+  print t.replace("$X",p[1]).replace("$D1",D1).replace("$D2",D2)
+
+END_SHELL
+
+    block_weight += fkmc_weight(i_walk)
+
+   else
+     fkmc_weight(i_walk) = 0.d0
+     delta(i_walk) = 1.d5
+   endif
+
+  enddo
+
+  ! Compute the new weight of the population
+  double precision :: sum_weight
+  sum_weight = 0.d0
+  do k=1,walk_num
+    sum_weight += fkmc_weight(k)
+  enddo
+
+  do k=1,walk_num
+    do l=1,3
+     do i=1,elec_num+1
+      elec_coord_tmp(i,l,k) = elec_coord_full(i,l,k)
+     enddo
+     do i=1,elec_num
+      psi_grad_psi_inv_save_tmp(i,l,k) = psi_grad_psi_inv_save(i,l,k)
+     enddo
+    enddo
+    psi_value_save_tmp(k) = psi_value_save(k)
+    E_loc_save_tmp(k) = E_loc_save(k)
+    if (fkmc_weight(k) == 0.d0) then
+      fkmc_clock(DEATH,k) = -1.d0
+    endif
+    if ( delta(k) <= 0.d0 ) then
+      fkmc_clock_tmp(BIRTH,k) = fkmc_clock(BIRTH,k) +time_step * delta(k)
+      fkmc_clock_tmp(DEATH,k) = fkmc_clock(DEATH,k)
+    else
+      fkmc_clock_tmp(BIRTH,k) = fkmc_clock(BIRTH,k)
+      fkmc_clock_tmp(DEATH,k) = fkmc_clock(DEATH,k) -time_step * delta(k)
+    endif
+  enddo
+
+! Reconfiguration
+! ===============
+
+  ! Identify first which walkers will be killed to place branched walkers there
+  ! later
+  
+  double precision, external     :: qmc_ranf
+  integer                        :: ipm, m
+  integer                        :: killed(walk_num)
+
+  m=1
+  do k=1,walk_num
+    fkmc_clock(DEATH,k) = fkmc_clock_tmp(DEATH,k) 
+    if (fkmc_clock_tmp(DEATH,k) <= 0.d0) then
+      killed(m) = k
+      m += 1
+      fkmc_clock(DEATH,k) = -dlog(qmc_ranf())
+      fkmc_clock(BIRTH,k) = -dlog(qmc_ranf())
+      ipm = k
+      do while (ipm == k)
+        ipm = 1 + int (walk_num*qmc_ranf())
+      enddo
+      do l=1,3
+        do i=1,elec_num+1
+        elec_coord_full(i,l,k) = elec_coord_tmp(i,l,ipm)
+        enddo
+        do i=1,elec_num
+          psi_grad_psi_inv_save(i,l,k) = psi_grad_psi_inv_save_tmp(i,l,ipm)
+        enddo
+      enddo
+      psi_value_save(k) = psi_value_save_tmp(ipm)
+      E_loc_save(k) = E_loc_save_tmp(ipm)
+    endif
+  enddo
+  killed(m) = 0
+
+  m=1
+  do k=1,walk_num
+    fkmc_clock(BIRTH,k) = fkmc_clock_tmp(BIRTH,k) 
+    if (fkmc_clock_tmp(BIRTH,k) <= 0.d0) then
+      fkmc_clock(BIRTH,k) = -dlog(qmc_ranf())
+      if (killed(m) == 0) then
+        ipm = k
+        do while (ipm == k)
+          ipm = 1 + int (walk_num*qmc_ranf())
+        enddo
+      else
+        ipm = killed(m)
+        m +=1
+      endif
+      fkmc_clock(BIRTH,ipm) = -dlog(qmc_ranf())
+      fkmc_clock(DEATH,ipm) = -dlog(qmc_ranf())
+      do l=1,3
+        do i=1,elec_num+1
+        elec_coord_full(i,l,ipm) = elec_coord_tmp(i,l,k)
+        enddo
+        do i=1,elec_num
+          psi_grad_psi_inv_save(i,l,ipm) = psi_grad_psi_inv_save_tmp(i,l,k)
+        enddo
+      enddo
+      psi_value_save(ipm) = psi_value_save_tmp(k)
+      E_loc_save(ipm) = E_loc_save_tmp(k)
+      
+    endif
+
+  enddo
+
+  
+
+  call system_clock(cpu1, count_rate, count_max)
+  if (cpu1 < cpu0) then
+    cpu1 = cpu1+cpu0
+  endif
+  loop = dble(cpu1-cpu0)/dble(count_rate) < block_time
+  if (cpu1-cpu2 > count_rate) then
+    integer                        :: do_run
+    call get_running(do_run)
+    loop = loop.and.(do_run == t_Running)
+    cpu2 = cpu1
+  endif
+
+! Update E_ref to take into account the weight of the population
+  E_ref -= dlog(sum_weight / dble(walk_num) ) / time_step 
+  SOFT_TOUCH elec_coord_full E_ref
+
+  first_loop = .False.
+
+ enddo
+
+ double precision :: factor
+ factor = 1.d0/block_weight
+ SOFT_TOUCH block_weight
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+t = """
+ if (calc_$X) then
+   $X_fkmc_block_walk   *= factor
+   $X_2_fkmc_block_walk *= factor
+ endif
+"""
+for p in properties:
+ print  t.replace("$X",p[1])
+END_SHELL
+
+ deallocate ( elec_coord_tmp, psi_grad_psi_inv_save, psi_grad_psi_inv_save_tmp, &
+   fkmc_clock_tmp )
+
+END_PROVIDER
+
+
+
+BEGIN_PROVIDER [ double precision, fkmc_clock, (2,walk_num) ]
+ implicit none
+ BEGIN_DOC
+ ! Branching clocks for the FKMC algotithm. (1,:) is the birth clock and
+ ! (2,:) is the death clock.
+ END_DOC
+ integer :: i
+ double precision, external :: qmc_ranf
+ do i=1, walk_num
+   fkmc_clock(1,i) = -dlog(qmc_ranf())
+   fkmc_clock(2,i) = -dlog(qmc_ranf())
+ enddo
+
+END_PROVIDER
+

src/SAMPLING/pdmc_step.irp.f

@@ -0,0 +1,393 @@
+! Providers of *_pdmc_block_walk
+!==============================
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+
+t = """
+ BEGIN_PROVIDER [ $T, $X_pdmc_block_walk $D1 ]
+&BEGIN_PROVIDER [ $T, $X_pdmc_block_walk_kahan $D2 ]
+&BEGIN_PROVIDER [ $T, $X_2_pdmc_block_walk $D1 ]
+&BEGIN_PROVIDER [ $T, $X_2_pdmc_block_walk_kahan $D2 ]
+ implicit none
+ BEGIN_DOC
+ ! PDMC averages of $X. Computed in E_loc_pdmc_block_walk
+ END_DOC
+ $X_pdmc_block_walk = 0.d0
+ $X_pdmc_block_walk_kahan = 0.d0
+ $X_2_pdmc_block_walk = 0.d0
+ $X_2_pdmc_block_walk_kahan = 0.d0
+END_PROVIDER
+"""
+for p in properties:
+  if p[1] != 'e_loc':
+    if p[2] == "":
+      D1 = ""
+      D2 = ", (3)"
+    else:
+      D1 = ", ("+p[2][1:-1]+")"
+      D2 = ", ("+p[2][1:-1]+",3)"
+    print t.replace("$X",p[1]).replace("$T",p[0]).replace("$D1",D1).replace("$D2",D2)
+
+END_SHELL
+
+
+
+ BEGIN_PROVIDER [ double precision, E_loc_pdmc_block_walk              ]
+&BEGIN_PROVIDER [ double precision, E_loc_2_pdmc_block_walk            ]
+&BEGIN_PROVIDER [ double precision, E_loc_pdmc_block_walk_kahan  , (3) ]
+&BEGIN_PROVIDER [ double precision, E_loc_2_pdmc_block_walk_kahan, (3) ]
+ implicit none
+ include '../types.F'
+ BEGIN_DOC
+! Properties averaged over the block using the PDMC method
+ END_DOC
+
+  real, allocatable :: elec_coord_tmp(:,:,:)
+  integer :: mod_align
+  double precision :: E_loc_save(4,walk_num_dmc_max)
+  double precision :: psi_value_save(walk_num)
+  double precision :: psi_value_save_tmp(walk_num)
+  double precision :: pdmc_weight(walk_num)
+  double precision, allocatable :: psi_grad_psi_inv_save(:,:,:)
+  double precision, allocatable :: psi_grad_psi_inv_save_tmp(:,:,:)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_grad_psi_inv_save
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_grad_psi_inv_save_tmp
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: E_loc_save
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: psi_value_save_tmp
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: pdmc_weight
+  allocate ( psi_grad_psi_inv_save(elec_num_8,3,walk_num) ,          &
+       psi_grad_psi_inv_save_tmp(elec_num_8,3,walk_num) ,            &
+      elec_coord_tmp(mod_align(elec_num+1),3,walk_num) )
+  psi_value_save = 0.d0
+  psi_value_save_tmp = 0.d0
+  pdmc_weight = 1.d0
+
+! Initialization
+ if (vmc_algo /= t_Brownian) then
+   call abrt(irp_here,'PDMC should run with Brownian algorithm')
+ endif
+
+ integer :: k, i_walk, i_step
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+t = """
+ if (calc_$X) then
+   !DIR$ VECTOR ALIGNED
+   $X_pdmc_block_walk = 0.d0
+   !DIR$ VECTOR ALIGNED
+   $X_pdmc_block_walk_kahan = 0.d0
+   !DIR$ VECTOR ALIGNED
+   $X_2_pdmc_block_walk = 0.d0
+   !DIR$ VECTOR ALIGNED
+   $X_2_pdmc_block_walk_kahan = 0.d0
+ endif
+"""
+for p in properties:
+ print  t.replace("$X",p[1])
+END_SHELL
+
+ logical                        :: loop
+ integer*8                      :: cpu0, cpu1, cpu2, count_rate, count_max
+
+ loop = .True.
+ call system_clock(cpu0, count_rate, count_max)
+ cpu2 = cpu0
+
+ block_weight = 0.d0
+
+ real, external                 :: accep_rate
+ double precision               :: delta, thr
+
+ thr = 2.d0/time_step_sq
+
+ logical :: first_loop
+ first_loop = .True.
+ if (walk_num > 1) then
+   call abrt(irp_here,'walk_num > 1')
+ endif
+
+  integer :: info
+!  double precision :: H(0:pdmc_n_diag/2,0:pdmc_n_diag/2), S(0:pdmc_n_diag/2,0:pdmc_n_diag/2), w(0:pdmc_n_diag/2), work(3*pdmc_n_diag+1)
+!  H = 0.d0
+!  S = 0.d0
+
+ do while (loop)
+
+  i_walk = 1
+
+    if (.not.first_loop) then
+      integer                        :: i,j,l
+      do l=1,3
+        do i=1,elec_num+1
+          elec_coord(i,l) = elec_coord_full(i,l,i_walk)
+        enddo
+        do i=1,elec_num
+          psi_grad_psi_inv_x(i) = psi_grad_psi_inv_save(i,1,i_walk)
+          psi_grad_psi_inv_y(i) = psi_grad_psi_inv_save(i,2,i_walk)
+          psi_grad_psi_inv_z(i) = psi_grad_psi_inv_save(i,3,i_walk)
+        enddo
+        psi_value = psi_value_save(i_walk)
+        E_loc = E_loc_save(1,i_walk)
+      enddo
+      SOFT_TOUCH elec_coord psi_grad_psi_inv_x psi_grad_psi_inv_y psi_grad_psi_inv_z psi_value E_loc
+    else
+      do l=1,3
+        do i=1,elec_num+1
+          elec_coord(i,l) = elec_coord_full(i,l,i_walk)
+        enddo
+      enddo
+      TOUCH elec_coord
+      psi_value_save(i_walk) = psi_value
+      E_loc_save(:,i_walk) = E_loc
+    endif
+
+   double precision               :: p,q
+   real                           :: delta_x
+   logical                        :: accepted
+   call brownian_step(p,q,accepted,delta_x)
+
+!   if ( psi_value * psi_value_save(i_walk) >= 0.d0 ) then
+
+!2    delta = (E_loc+E_loc_save(1,i_walk))*0.5d0
+!3    delta = (5.d0 * E_loc + 8.d0 * E_loc_save(1,i_walk) - E_loc_save(2,i_walk))/12.d0
+      delta = (9.d0*E_loc+19.d0*E_loc_save(1,i_walk)-5.d0*E_loc_save(2,i_walk)+E_loc_save(3,i_walk))/24.d0
+!      delta = -((-251.d0*E_loc)-646.d0*E_loc_save(1,i_walk)+264.d0*E_loc_save(2,i_walk)-&
+!         106.d0*E_loc_save(3,i_walk)+19.d0*E_loc_save(4,i_walk))/720.d0
+
+     delta = (delta - E_ref)*p
+
+     if (delta >= 0.d0) then
+       pdmc_weight(i_walk) = dexp(-dtime_step*delta)
+     else
+       pdmc_weight(i_walk) = 2.d0-dexp(dtime_step*delta)
+     endif
+     elec_coord(elec_num+1,1) += p*time_step
+     elec_coord(elec_num+1,2)  = E_loc
+     elec_coord(elec_num+1,3)  = pdmc_weight(i_walk) * pdmc_pop_weight_mult(pdmc_n_diag)
+     do l=1,3
+        do i=1,elec_num+1
+          elec_coord_full(i,l,i_walk) = elec_coord(i,l)
+        enddo
+     enddo
+     do i=1,elec_num
+       psi_grad_psi_inv_save(i,1,i_walk) = psi_grad_psi_inv_x(i)
+       psi_grad_psi_inv_save(i,2,i_walk) = psi_grad_psi_inv_y(i)
+       psi_grad_psi_inv_save(i,3,i_walk) = psi_grad_psi_inv_z(i)
+     enddo
+
+     psi_value_save(i_walk) = psi_value
+     E_loc_save(4,i_walk) = E_loc_save(3,i_walk)
+     E_loc_save(3,i_walk) = E_loc_save(2,i_walk)
+     E_loc_save(2,i_walk) = E_loc_save(1,i_walk)
+     E_loc_save(1,i_walk) = E_loc
+
+
+  if (do_print_dmc_data) then
+    do k=1,walk_num
+      double precision, external :: qmc_ranf
+      if (qmc_ranf() < 0.001) then
+       print *, '--'
+       do i=1,elec_num
+         print *, elec_coord_full(i,1:3,k)
+       enddo
+       print *, 'w=', pdmc_pop_weight_mult(pdmc_n_diag) * pdmc_weight(i_walk)
+      endif
+    enddo
+  endif
+
+     if (dabs(pdmc_weight(i_walk)*pdmc_pop_weight_mult(pdmc_n_diag)) > 1.d-15) then
+       dmc_zv_weight = 1.d0/(pdmc_weight(i_walk)*pdmc_pop_weight_mult(pdmc_n_diag))
+       dmc_zv_weight_half = 1.d0/(pdmc_weight(i_walk)*pdmc_pop_weight_mult(pdmc_n_diag/2))
+     else
+       dmc_zv_weight = 0.d0
+       dmc_zv_weight_half = 0.d0
+     endif
+     TOUCH dmc_zv_weight dmc_zv_weight_half
+
+!    do i=1,pdmc_n_diag+1
+!      E_loc_zv(i) =   E_loc * pdmc_pop_weight_mult(i-1) * pdmc_weight(i_walk) * dmc_zv_weight + (E_trial-E_loc) * dmc_zv_weight
+!      E_loc_zv(i+pdmc_n_diag+1) = pdmc_pop_weight_mult(i-1) * pdmc_weight(i_walk) * dmc_zv_weight
+!    enddo
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+t = """
+     if (calc_$X) then
+   ! Kahan's summation algorithm to compute these sums reducing the rounding error:
+   !  $X_pdmc_block_walk    += $X * pdmc_pop_weight_mult(pdmc_n_diag) * pdmc_weight(i_walk)
+   !  $X_2_pdmc_block_walk  += $X_2 * pdmc_pop_weight_mult(pdmc_n_diag) * pdmc_weight(i_walk)
+   ! see http://en.wikipedia.org/wiki/Kahan_summation_algorithm
+
+      $X_pdmc_block_walk_kahan($D2 3) = $X * pdmc_pop_weight_mult(pdmc_n_diag) * pdmc_weight(i_walk) - $X_pdmc_block_walk_kahan($D2 1)
+      $X_pdmc_block_walk_kahan($D2 2) = $X_pdmc_block_walk $D1  + $X_pdmc_block_walk_kahan($D2 3)
+      $X_pdmc_block_walk_kahan($D2 1) = ($X_pdmc_block_walk_kahan($D2 2) - $X_pdmc_block_walk $D1 ) &
+          - $X_pdmc_block_walk_kahan($D2 3)
+      $X_pdmc_block_walk $D1  =  $X_pdmc_block_walk_kahan($D2 2)
+
+
+      $X_2_pdmc_block_walk_kahan($D2 3) = $X_2 * pdmc_pop_weight_mult(pdmc_n_diag) * pdmc_weight(i_walk) - $X_2_pdmc_block_walk_kahan($D2 1)
+      $X_2_pdmc_block_walk_kahan($D2 2) = $X_2_pdmc_block_walk $D1 + $X_2_pdmc_block_walk_kahan($D2 3)
+      $X_2_pdmc_block_walk_kahan($D2 1) = ($X_2_pdmc_block_walk_kahan($D2 2) - $X_2_pdmc_block_walk $D1 ) &
+          - $X_2_pdmc_block_walk_kahan($D2 3)
+      $X_2_pdmc_block_walk $D1 =  $X_2_pdmc_block_walk_kahan($D2 2)
+     endif
+"""
+for p in properties:
+  if p[2] == "":
+   D1 = ""
+   D2 = ""
+  else:
+   D1 = "("+":"*(p[2].count(',')+1)+")"
+   D2 = ":"*(p[2].count(',')+1)+","
+  print t.replace("$X",p[1]).replace("$D1",D1).replace("$D2",D2)
+
+END_SHELL
+
+    block_weight += pdmc_pop_weight_mult(pdmc_n_diag) * pdmc_weight(i_walk)
+
+    pdmc_pop_weight_mult(0) = 1.d0/pdmc_weight(i_walk)
+!    do k=0,pdmc_n_diag/2
+!      do l=0,pdmc_n_diag/2
+!        H(k,l) += E_loc*pdmc_pop_weight_mult(k+l) * pdmc_weight(i_walk)
+!        S(k,l) += pdmc_pop_weight_mult(k+l) * pdmc_weight(i_walk)
+!      enddo
+!    enddo
+!    H = H + (E_trial - E_loc)
+
+!  else
+!     pdmc_weight(i_walk) = 1.d0
+!     pdmc_pop_weight(:,:) = 1.d0
+!     pdmc_pop_weight_mult(:) = 1.d0
+!  endif
+
+  do k=1,pdmc_n_diag
+    ! Move to the next projection step
+    if (pdmc_projection(pdmc_n_diag) > 0) then
+      pdmc_projection_step(k) = mod(pdmc_projection_step(k),pdmc_projection(k))+1
+    else
+      pdmc_projection_step(k) = 1
+    endif
+
+    ! Eventually, recompute the weight of the population
+    if (pdmc_projection_step(k) == k) then
+      pdmc_pop_weight_mult(k) = 1.d0
+      do l=1,pdmc_projection(k)
+        pdmc_pop_weight_mult(k) *= pdmc_pop_weight(l,k)
+      enddo
+    endif
+    ! Remove contribution of the old value of the weight at the new
+    ! projection step
+
+    pdmc_pop_weight_mult(k) *= 1.d0/pdmc_pop_weight(pdmc_projection_step(k),k)
+    pdmc_pop_weight(pdmc_projection_step(k),k) = pdmc_weight(i_walk)/dble(walk_num)
+
+    ! Update the running population weight
+    pdmc_pop_weight_mult(k) *= pdmc_pop_weight(pdmc_projection_step(k),k)
+
+  enddo
+
+
+  call system_clock(cpu1, count_rate, count_max)
+  if (cpu1 < cpu0) then
+    cpu1 = cpu1+cpu0
+  endif
+  loop = dble(cpu1-cpu0)/dble(count_rate) < block_time
+  if (cpu1-cpu2 > count_rate) then
+    integer                        :: do_run
+    call get_running(do_run)
+    loop = loop.and.(do_run == t_Running)
+    cpu2 = cpu1
+  endif
+
+  SOFT_TOUCH elec_coord_full pdmc_pop_weight_mult
+
+  first_loop = .False.
+
+ enddo
+
+
+ double precision :: factor
+ factor = 1.d0/block_weight
+ SOFT_TOUCH block_weight
+
+BEGIN_SHELL [ /usr/bin/env python2 ]
+from properties import *
+t = """
+ if (calc_$X) then
+   $X_pdmc_block_walk   *= factor
+   $X_2_pdmc_block_walk *= factor
+ endif
+"""
+for p in properties:
+ print  t.replace("$X",p[1])
+END_SHELL
+
+!  H(0,0) = H(3,3)
+!  H(1,0) = H(4,3)
+!  H(0,1) = H(3,4)
+!  H(1,1) = H(4,4)
+!  S(0,0) = S(3,3)
+!  S(1,0) = S(4,3)
+!  S(0,1) = S(3,4)
+!  S(1,1) = S(4,4)
+!
+!  print *,  H(0,0)/S(0,0)
+!  print *,  H(1,1)/S(1,1)
+!  print *,  ''
+!
+!  call dsygv(1, 'N', 'U', pdmc_n_diag/2+1, H, pdmc_n_diag/2+1, S, pdmc_n_diag/2+1, w, work, 3*(pdmc_n_diag+1), info)
+!  call dsygv(1, 'N', 'U', 2, H, pdmc_n_diag/2+1, S, pdmc_n_diag/2+1, w, work, 3*(pdmc_n_diag+1), info)
+!  E_loc_zv_diag_pdmc_block_walk = w(0)
+!  print *,  w
+
+ deallocate ( elec_coord_tmp, psi_grad_psi_inv_save, psi_grad_psi_inv_save_tmp )
+
+END_PROVIDER
+
+
+ BEGIN_PROVIDER [ integer, pdmc_projection, (pdmc_n_diag) ]
+&BEGIN_PROVIDER [ integer, pdmc_projection_step, (pdmc_n_diag) ]
+ implicit none
+ BEGIN_DOC
+! Number of projection steps for PDMC
+ END_DOC
+ real :: pdmc_projection_time
+ pdmc_projection_time = 1.
+ call get_simulation_srmc_projection_time(pdmc_projection_time)
+ pdmc_projection(pdmc_n_diag) = int( pdmc_projection_time/time_step)
+ integer :: k
+ do k=1,pdmc_n_diag-1
+   pdmc_projection(k) = k*pdmc_projection(pdmc_n_diag)/pdmc_n_diag
+ enddo
+ pdmc_projection_step(:) = 0
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, pdmc_pop_weight, (0:pdmc_projection(pdmc_n_diag)+1,pdmc_n_diag) ]
+ implicit none
+ BEGIN_DOC
+! Population weight of PDMC
+ END_DOC
+ pdmc_pop_weight(:,:) = 1.d0
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, pdmc_pop_weight_mult, (0:pdmc_n_diag) ]
+ implicit none
+ BEGIN_DOC
+! Population weight of PDMC
+ END_DOC
+ pdmc_pop_weight_mult(:) = 1.d0
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ integer, pdmc_n_diag ]
+ implicit none
+ BEGIN_DOC
+! Size of the matrix to diagonalize
+ END_DOC
+ pdmc_n_diag = 8
+END_PROVIDER
+
+
+

src/SAMPLING/reconfigure.irp.f

@@ -3,44 +3,48 @@ subroutine reconfigure(ipos,w)
   integer, intent(inout)         :: ipos(*)
   double precision, intent(in)   :: w(*)
   
-  integer                        :: kp, km
-  double precision               :: accup, accum
-  integer                        :: k
-  
-  double precision               :: dwalk_num
-  dwalk_num = dble(walk_num)
-  
   integer                        :: kptab(walk_num), kmtab(walk_num)
   double precision               :: wp(walk_num), wm(walk_num)
   double precision               :: tmp
   
-  do k=1,walk_num
-    ipos(k) = k
-  enddo
+  double precision               :: dwalk_num
   
+  tmp = 0.d0
+  do k=1,walk_num
+    tmp = tmp + w(k)
+  enddo
+  dwalk_num = dble(walk_num)/tmp
+
+  integer                        :: kp, km
   kp=0
   km=0
+
+  double precision               :: accup, accum
   accup = 0.d0
   accum = 0.d0
+
+  integer                        :: k
   do k=1,walk_num
     tmp = dwalk_num*w(k)-1.d0
     if (tmp >= 0.d0) then
-      kp += 1
-      wp(kp) = abs(tmp)
-      accup += wp(kp)
+      kp = kp+1
+      wp(kp) = dabs(tmp)
+      accup = accup + wp(kp)
       kptab(kp) = k
     else
-      km += 1
-      wm(km) = abs(tmp)
-      accum += wm(km)
+      km = km+1
+      wm(km) = dabs(tmp)
+      accum = accum + wm(km)
       kmtab(km) = k
     endif
   enddo
+
   if(kp+km /= walk_num) then
     print *,  kp, km
     call abrt(irp_here,'pb in reconfiguration +/-')
   endif
-  if(abs(accup-accum).gt.1.d-11) then
+
+  if(dabs(accup-accum) > 1.d-11) then
     print *,  accup, accum
     call abrt(irp_here,'pb in reconfiguration')
   endif
@@ -59,24 +63,26 @@ subroutine reconfigure(ipos,w)
   averageconf = accup
   kcp = 1
   rand = rando(kcp)
+
   do while (rand < averageconf)
     k=1
     current=wm(k)
     do while (rand > current)
-      k += 1
-      current += wm(k)
+      k = k+1
+      current = current + wm(k)
     enddo
     kremove = kmtab(k)
     
     k=1
     current=wp(k)
     do while (rand > current)
-      k += 1
-      current += wp(k)
+      k = k+1
+      current = current + wp(k)
     enddo
     kadd = kptab(k)
+
     ipos(kremove) = kadd
-    kcp += 1
+    kcp = kcp + 1
     rand = rando(kcp)
   enddo