Add LEED calculator

The Low Energy Electron Diffraction spectroscopy is now included
with Matrix Inversion algoriyhm only for now.

Dockerfile

@@ -1,24 +1,112 @@
 # Get the base Python image
-FROM python:latest
+FROM alpine:edge AS builder
+
+# Variables
+ARG branch="devel"
+ARG login="" password=""
+ARG folder=/opt/msspec user=msspec
 
 # Install system dependencies
-RUN apt-get update && apt-get install -y virtualenv gfortran libgtk-3-dev nano
-
-# Add a non-privileged user
-RUN useradd -ms /bin/bash -d /opt/msspec msspec
-
-# Set the working directory in the container
-USER msspec
-RUN mkdir -p /opt/msspec/code
-WORKDIR /opt/msspec/code
+# tools
+RUN apk add bash git make gfortran python3 py3-numpy-f2py 
+# headers
+RUN apk add python3-dev lapack-dev musl-dev hdf5-dev cairo-dev
+# python packages
+RUN apk add py3-virtualenv py3-pip py3-numpy-dev py3-h5py py3-lxml py3-matplotlib \
+            py3-numpy py3-pandas py3-cairo py3-scipy py3-setuptools_scm \
+            py3-terminaltables ipython
+RUN apk add --no-cache -X http://dl-cdn.alpinelinux.org/alpine/edge/community py3-wxpython
+#RUN pip install ase pint terminaltables ipython
+# for GUI
+RUN apk add ttf-droid adwaita-icon-theme
+RUN apk add build-base
 
 # Fetch the code
-RUN git clone https://git.ipr.univ-rennes1.fr/epsi/msspec_python3.git .
-#COPY --chown=msspec:msspec . .
+RUN mkdir -p ${folder}/code
+WORKDIR ${folder}/code
+RUN git clone --branch ${branch} https://${login}:${password}@git.ipr.univ-rennes1.fr/epsi/msspec_python3.git .
 
+RUN virtualenv --system-site-packages ${folder}/.local/src/msspec_venv
+RUN make        pybinding PYTHON=python3 VENV_PATH=${folder}/.local/src/msspec_venv VERBOSE=1
+RUN make -C src sdist     PYTHON=python3 VENV_PATH=${folder}/.local/src/msspec_venv VERBOSE=1
+RUN make -C src frontend  PYTHON=python3 VENV_PATH=${folder}/.local/src/msspec_venv VERBOSE=1
+RUN source ${folder}/.local/src/msspec_venv/bin/activate && pip install src/dist/msspec*tar.gz
+
+
+
+# Build
+#RUN make pybinding NO_VENV=1 PYTHON=python3 VERBOSE=1
+#RUN make -C src sdist PYTHON=python3 NO_VENV=1 VENV_PATH=${folder}/.local/src/msspec_venv 
+#&& \
+#    pip install src/dist/msspec*tar.gz
+
+# Add a non-privileged user
+#RUN adduser -D -s /bin/bash -h ${folder} ${user}
+
+# Set the working directory in the container
+#USER ${user}
+
+#RUN virtualenv --system-site-packages ${folder}/.local/src/msspec_venv
+#RUN source ${folder}/.local/src/msspec_venv/bin/activate && pip install src/dist/msspec*.tar.gz
+#RUN make -C src frontend PYTHON=python3 NO_VENV=1 VENV_PATH=${folder}/.local/src/msspec_venv
+
+
+
+FROM alpine:edge
+# Variables
+ARG folder=/opt/msspec user=msspec
+# Install system dependencies
+RUN apk add --no-cache -X http://dl-cdn.alpinelinux.org/alpine/edge/community \
+#  hdf5-hl cairo openblas lapack libxml2 libxslt libzlf wxwidgets-gtk3 openjpeg libimagequant \
+   nano \
+   py3-virtualenv \
+   lapack \
+   bash \
+#  git \
+#  make \
+#  gfortran \
+   python3 \
+#   ttf-droid \
+   ttf-liberation \
+   adwaita-xfce-icon-theme \
+#  python3-dev \
+#  lapack-dev \
+#  musl-dev \
+#  py3-virtualenv \
+   py3-pip \
+#  py3-numpy-dev \
+   py3-h5py \
+   py3-lxml \
+   py3-matplotlib \
+   py3-numpy \
+   py3-pandas \
+   py3-cairo \
+   py3-scipy \
+   py3-setuptools_scm \
+   py3-wxpython \
+   py3-terminaltables \
+   py3-bayesian-optimization \
+   # Add a non-privileged user
+   && adduser -D -s /bin/bash -h ${folder} ${user}
+
+# Set the working directory in the container
+USER ${user}
+WORKDIR ${folder}
 # Install msspec
-ENV PATH=/opt/msspec/.local/bin:$PATH
-RUN make install VERBOSE=1
+#COPY --from=builder ${folder}/.local ${folder}/.local
+#COPY --from=builder /usr/lib/python3.10/site-packages /usr/lib/python3.10/site-packages
+
+COPY --from=builder ${folder}/code/src/dist/msspec*tar.gz msspec.tar.gz
+RUN virtualenv --system-site-packages .local/src/msspec_venv && \
+    . .local/src/msspec_venv/bin/activate && \
+    pip install msspec.tar.gz && \
+    pip install ipython && \
+    pip cache purge && \
+    rm -f msspec.tar.gz && \
+    mkdir -p .local/bin
+
+COPY --from=builder /root/.local/bin/msspec .local/bin/msspec
+ENV PATH=${folder}/.local/bin:$PATH
 
 # Run the msspec frontend command on startup
 ENTRYPOINT ["msspec"]

Jenkinsfile

@@ -13,9 +13,9 @@ pipeline {
         }
         stage('Syncing website...') {
             steps {
-		// echo 'Syncing website...'
+		echo 'Syncing website only in master branch, not here in devel branch...'
 		// sh 'rm -rf $HOME/www/*'
-                sh 'cp -a ./doc/build/html/* $HOME/www/'
+                // sh 'cp -a ./doc/build/html/* $HOME/www/'
             }
         }
 

Makefile

@@ -1,7 +1,7 @@
 include src/options.mk
 
 
-.PHONY: pybinding install devel venv doc clean
+.PHONY: pybinding install devel venv doc clean _attrdict
 
 
 pybinding:
@@ -11,19 +11,20 @@ pybinding:
 venv:
 ifeq ($(NO_VENV),0)
 	@virtualenv --python=$(PYTHON_EXE) --prompt="(msspec-$(VERSION)) " $(VENV_PATH)
-	$(INSIDE_VENV) \
-            wget https://bootstrap.pypa.io/get-pip.py && \
-            python get-pip.py                         && \
-            pip install --upgrade setuptools          && \
-            pip install -r src/pip.freeze             && \
-            rm -f get-pip.py
+	$(INSIDE_VENV) python -m ensurepip --upgrade
 endif
 
+# wget https://bootstrap.pypa.io/get-pip.py && \
+# python get-pip.py                         && \
+# rm -f get-pip.py
+# pip install --upgrade setuptools          && \
+# pip install -r src/pip.freeze             && \
+
 
 install: venv pybinding wx
 	@+$(INSIDE_VENV) $(MAKE) -C src sdist
 	@+$(INSIDE_VENV) $(MAKE) -C src frontend
-	@+$(INSIDE_VENV) pip install src/dist/msspec-$(VERSION).tar.gz
+	@+$(INSIDE_VENV) pip install src/dist/msspec-$(VERSION)*.whl
 	@echo "Do not forget to check that $(INSTALL_PREFIX)/bin is set in your \$$PATH"
 
 
@@ -37,20 +38,28 @@ light: venv
 	@$(INSIDE_VENV) pip install src/
 
 
-_build_wx/wxPython.target:
+_attrdict:
+	# Check if virtualenv python version > 3.3.0
+	# If so, install the patched version of attrdict used to build the version 4.2.0 of wxPython
+	@$(INSIDE_VENV) if `python -c "import sys; exit(sys.version_info > (3,3))"`; then \
+		pip install --no-cache attrdict; \
+	else \
+		pip install thirdparty/attrdict-2.0.1.tar.gz; \
+	fi
+
+
+_build_wx/wxPython.target: _attrdict
 	@$(INSIDE_VENV) echo "Building wxPython for your `python --version 2>&1` under Linux $(DISTRO_RELEASE)..."
 	# Create a folder to build wx into
 	@mkdir -p _build_wx
-	@$(INSIDE_VENV) pip install attrdict sip
-	# TODO: attrdict is no longer compatible with collections package. The build will fail
 	# download the wheel or the source if it cannot find a wheel
-	@$(INSIDE_VENV) cd _build_wx && pip download -f https://extras.wxpython.org/wxPython4/extras/linux/gtk3/$(DISTRO_RELEASE) wxPython
+	$(INSIDE_VENV) cd _build_wx && pip download -f https://extras.wxpython.org/wxPython4/extras/linux/gtk3/$(DISTRO_RELEASE) wxPython
 	# Build the source if a tar.gz was downloaded
 	@$(INSIDE_VENV) cd _build_wx && \
           if [ -e wxPython*.tar.gz ]; then \
             tar -x --skip-old-files -vzf wxPython*.tar.gz; \
             cd `ls -d wxPython*/`; \
-            pip install requests; \
+            pip install requests sip; \
             python build.py dox etg --nodoc sip build bdist_wheel; \
             ln -sf `readlink -f dist/wxPython*.whl` ../; \
           fi;

doc/source/tutorials/RhO/RhO.py

@@ -18,7 +18,8 @@ for zi, z0 in enumerate(all_z):
     calc.set_atoms(cluster)
 
     # Compute
-    data = calc.get_theta_phi_scan(level='1s', kinetic_energy=723, data=data)
+    data = calc.get_theta_phi_scan(level='1s', kinetic_energy=723, data=data,
+                                   malloc={'NPH_M': 8000})
     dset = data[-1]
     dset.title = "{:d}) z = {:.2f} angstroms".format(zi, z0)
 

src/MANIFEST.in

@@ -1,6 +0,0 @@
-recursive-include msspec *.so
-recursive-include . SConstruct
-include setup_requirements.txt
-include requirements.txt
-include pip.freeze
-include VERSION

src/Makefile

@@ -9,16 +9,15 @@ sdist: dist/msspec-$(VERSION).tar.gz
 frontend: $(INSTALL_PREFIX)/bin/msspec
 
 
-dist/msspec-$(VERSION).tar.gz: VERSION
+dist/msspec-$(VERSION).tar.gz: msspec/VERSION
 	@echo "Creating Python source distribution..."
-	@python setup.py sdist
+	@+$(INSIDE_VENV) pip install build && python -m build
 
 
-$(INSTALL_PREFIX)/bin/msspec: msspec.sh.template VERSION
+$(INSTALL_PREFIX)/bin/msspec: msspec.sh.template msspec/VERSION
 	@echo "Installing frontend command..."
 	@mkdir -p $(dir $@)
-	@cat $< | sed -e 's/__VERSION__/$(VERSION)/' -e 's#__VENV_PATH__#$(VENV_PATH)#' > $@
-	#@cat $< | sed 's/__VERSION__/$(VERSION)/' > $@
+	@cat $< | sed -e 's#__VENV_PATH__#$(VENV_PATH)#' > $@
 	@chmod 755 $@
 
 
@@ -26,7 +25,7 @@ pybinding:
 	@echo "Building Python binding for phagen and spec..."
 	@+$(MAKE) -C msspec/phagen/fortran all
 	@+$(MAKE) -C msspec/spec/fortran all
-	@echo "$(VERSION)" > VERSION
+	@echo "$(VERSION)" > msspec/VERSION
 
 
 results: msspec/results.txt
@@ -54,7 +53,7 @@ clean::
 #	remove previous sdist
 	@rm -rf dist
 	@rm -rf *.egg*
-	@rm -f VERSION
+	@rm -f msspec/VERSION
 
 
 help:

src/msspec.sh.template

@@ -2,12 +2,11 @@
 
 SCRIPT_PATH="$0"
 SCRIPT_NAME=$(basename "$SCRIPT_PATH")
-VERSION="__VERSION__"
 VENV_PATH="__VENV_PATH__"
 
 # Check venv path
 if ! [ -d "$VENV_PATH" ]; then
-   echo "ERROR: Unable to find version $VERSION of msspec!!"
+   echo "ERROR: Unable to find msspec!!"
    exit 1
 fi
 
@@ -15,6 +14,10 @@ launch_script() {
    . "$VENV_PATH/bin/activate" && python "$@"
 }
 
+show_version () {
+    . "$VENV_PATH/bin/activate" && python -c "import msspec; print(msspec.__version__)"
+}
+
 show_help () {
    echo "Usage: 1) $SCRIPT_NAME -p [PYTHON OPTIONS] SCRIPT [ARGUMENTS...]"
    echo "       2) $SCRIPT_NAME [-l FILE | -i | -h]"
@@ -92,7 +95,7 @@ while getopts "hvil:p:eu" option; do
          ;;
       u) uninstall
          ;;
-      v) echo $VERSION
+      v) show_version
          ;;
       *|h) show_help
          ;;

src/msspec/__init__.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -16,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/__init__.py
-# Last modified: ven. 10 avril 2020 17:22:12
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 import ase

src/msspec/calcio.py

@@ -1,5 +1,25 @@
+#!/usr/bin/env python
 # coding: utf-8
-# vim: set et ts=4 sw=4 fdm=indent mouse=a cc=+1 tw=80:
+#
+# Copyright © 2016-2020 - Rennes Physics Institute
+#
+# This file is part of msspec.
+#
+# msspec 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.
+# msspec 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 msspec.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Source file  : src/msspec/calcio.py
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
+
 
 """
 Module calcio
@@ -910,7 +930,7 @@ class SpecIO(object):
         if content != old_content:
             with open(filename, 'w') as fd:
                 fd.write(content)
-                LOGGER.debug(f"Writing Spec input file written in {filename}")
+                LOGGER.debug("Writing Spec input file written in {}".format(filename))
             modified = True
 
         return modified
@@ -1255,13 +1275,13 @@ class CompCurveIO(object):
         data = []
         for i in range(1, 13):
             #data.append(np.loadtxt(prefix + f'{i:02d}' + '.txt')[-1])
-            results = np.loadtxt(prefix + f'{i:02d}' + '.txt')
+            results = np.loadtxt(prefix + '{:02d}'.format(i) + '.txt')
             results = results.reshape((-1, 2))
             data.append(results[index,1])
         suffix = 'ren'
         exp = {'int': None, 'ren': None, 'chi': None, 'cdf': None}
         exp_ren = np.loadtxt(os.path.join('exp', 'div',
-                                          f'experiment_{suffix}.txt'))
+                                          'experiment_{}.txt'.format(suffix)))
         calc_ren = np.loadtxt(os.path.join('calc', 'div',
-                                           f'calculation{index:d}_{suffix}.txt'))
+                                           'calculation{:d}_{}.txt'.format(index,suffix)))
         return data, exp_ren, calc_ren

src/msspec/calculator.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -16,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/calculator.py
-# Last modified: ven. 10 avril 2020 17:19:24
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Thu, 25 Jan 2024 09:48:44 +0100
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes.fr>
 
 
 """
@@ -82,6 +83,7 @@ from msspec.parameters import CompCurveGeneralParameters
 from msspec.parameters import DetectorParameters
 from msspec.parameters import EIGParameters
 from msspec.parameters import GlobalParameters
+from msspec.parameters import LEEDParameters
 from msspec.parameters import MuffintinParameters
 from msspec.parameters import PEDParameters
 from msspec.parameters import PhagenMallocParameters
@@ -96,6 +98,8 @@ from msspec.spec.fortran import _eig_mi
 from msspec.spec.fortran import _eig_pw
 from msspec.spec.fortran import _phd_mi_noso_nosp_nosym
 from msspec.spec.fortran import _phd_se_noso_nosp_nosym
+from msspec.spec.fortran import _phd_ce_noso_nosp_nosym
+from msspec.spec.fortran import _led_mi_noso_nosp_nosym
 from msspec.spec.fortran import _comp_curves
 from msspec.utils import get_atom_index
 
@@ -148,6 +152,9 @@ class _MSCALCULATOR(Calculator):
         if spectroscopy == 'PED':
             self.spectroscopy_parameters = PEDParameters(self.phagen_parameters,
                                                          self.spec_parameters)
+        elif spectroscopy == 'LEED':
+            self.spectroscopy_parameters = LEEDParameters(self.phagen_parameters,
+                                                          self.spec_parameters)
         elif spectroscopy == 'EIG':
             self.spectroscopy_parameters = EIGParameters(self.phagen_parameters,
                                                          self.spec_parameters)
@@ -404,6 +411,16 @@ class _MSCALCULATOR(Calculator):
                     do_spec = _phd_se_noso_nosp_nosym.run
                 elif self.global_parameters.algorithm == 'inversion':
                     do_spec = _phd_mi_noso_nosp_nosym.run
+                elif self.global_parameters.algorithm == 'correlation':
+                    do_spec = _phd_ce_noso_nosp_nosym.run
+                else:
+                    LOGGER.error("\'{}\' spectroscopy with \'{}\' algorithm is not "
+                                 "an allowed combination.".format(self.global_parameters.spectroscopy,
+                                 self.global_parameters.algorithm))
+                    raise ValueError
+            elif self.global_parameters.spectroscopy == 'LEED':
+                if self.global_parameters.algorithm == 'inversion':
+                    do_spec = _led_mi_noso_nosp_nosym.run
                 else:
                     LOGGER.error("\'{}\' spectroscopy with \'{}\' algorithm is not "
                                  "an allowed combination.".format(self.global_parameters.spectroscopy,
@@ -745,7 +762,7 @@ class _PED(_MSCALCULATOR):
 
                 view = dset.add_view("E = {:.2f} eV".format(ke), title=title,
                                      xlabel=xlabel, ylabel=ylabel,
-                                     projection='stereo', colorbar=True, autoscale=True)
+                                     projection='stereo', colorbar=True, autoscale=False)
                 view.select('theta', 'phi', 'cross_section')
 
 
@@ -1043,6 +1060,400 @@ class _EIG(_MSCALCULATOR):
         return self.iodata
 
 
+class _LEED(_MSCALCULATOR):
+    """This class creates a calculator object for Low Electron Energy Diffraction
+    spectroscopy.
+
+    :param algorithm: The algorithm to use for the computation. See
+        :ref:`globalparameters-algorithm` for more details about the allowed
+        values and the type.
+
+    :param polarization: The incoming light polarization (see
+        :ref:`globalparameters-polarization`)
+
+    :param dichroism: Wether to enable or not the dichroism (see
+        :ref:`globalparameters-dichroism`)
+
+    :param spinpol: Enable or disable the spin polarization in the calculation
+        (see :ref:`globalparameters-spinpol`)
+
+    :param folder: The path to the temporary folder for the calculations. See
+        :ref:`globalparameters-folder`
+
+    :param txt: The name of a file where to redirect standard output. The string
+        '-' will redirect the standard output to the screen (default).
+    :type txt: str
+
+    .. note::
+
+        This class constructor is not meant to be called directly by the user.
+        Use the :py:func:`MSSPEC` to instanciate any calculator.
+
+
+    """
+    def __init__(self, algorithm='inversion', polarization=None, dichroism=None,
+                 spinpol=False, folder='./calc', txt='-'):
+        _MSCALCULATOR.__init__(self, spectroscopy='LEED', algorithm=algorithm,
+                              polarization=polarization, dichroism=dichroism,
+                              spinpol=spinpol, folder=folder, txt=txt)
+        self.source_parameters.theta = 0
+        self.source_parameters.phi = 0
+
+        self.iodata = iodata.Data('LEED Simulation')
+
+    def _get_scan(self, scan_type='theta', phi=0,
+                  theta=np.linspace(-70, 70, 141),
+                  kinetic_energy=None, data=None,
+                  malloc={}, other_parameters={}):
+        LOGGER.info("Computting the %s scan...", scan_type)
+        # Force absorber to be 0.
+        self.atoms.absorber = get_atom_index(self.atoms, 0, 0, 0)
+        self.detector_parameters.rotate = True
+        self.source_parameters.theta = 0
+        self.source_parameters.phi   = 0
+        if data:
+            self.iodata = data
+
+        if kinetic_energy is None:
+            LOGGER.error('The kinetic energy is not specified!')
+            raise ValueError('You must define a kinetic_energy value.')
+
+        # update the parameters
+        self.scan_parameters.set_parameter('kinetic_energy', kinetic_energy)
+        all_ke = self.scan_parameters.get_parameter('ke_array')
+        if np.any(all_ke.value < 0):
+            LOGGER.error('Source energy is not high enough or level too deep!')
+            raise ValueError('Kinetic energy is < 0! ({})'.format(
+                kinetic_energy))
+        self.scan_parameters.set_parameter('type', scan_type)
+
+        # make sure there is only one energy point in scatf scan
+        if scan_type == 'scatf':
+            assert len(all_ke) == 1, ('kinetic_energy should not be an array '
+                                      'in scatf scan')
+
+
+        if scan_type != 'scatf':
+            self.scan_parameters.set_parameter('phi', phi)
+            self.scan_parameters.set_parameter('theta', theta)
+
+        #self.spectroscopy_parameters.set_parameter('level', level)
+
+        # It is still possible to modify any option right before runing phagen
+        # and spec
+        for k, v in other_parameters.items():
+            grp_str, param_str = k.split('.')
+            grp = getattr(self, grp_str)
+            grp.set_parameter(param_str, v, force=True)
+
+        self.get_tmatrix()
+        self.run_spec(malloc)
+
+        # Now load the data
+        ndset = len(self.iodata)
+        dset = self.iodata.add_dset('{} scan [{:d}]'.format(scan_type, ndset))
+        for p in self.get_parameters():
+            bundle = {'group': str(p.group),
+                      'name': str(p.name),
+                      'value': str(p.value),
+                      'unit': '' if p.unit is None else str(p.unit)}
+            dset.add_parameter(**bundle)
+        if scan_type in ('theta', 'phi', 'energy'):
+            results_fname = os.path.join(self.tmp_folder, 'output/results.dat')
+            data = self.specio.load_results(results_fname)
+            for _plane, _theta, _phi, _energy, _dirsig, _cs in data.T:
+                if _plane == -1:
+                    dset.add_row(theta=_theta, phi=_phi, energy=_energy, cross_section=_cs, direct_signal=_dirsig)
+        elif scan_type in ('scatf',):
+            results_fname = os.path.join(self.tmp_folder, 'output/facdif1.dat')
+            data = self.specio.load_facdif(results_fname)
+            data = data[:, [1, 4, 5, 6, 8]].T
+            _proto, _sf_real, _sf_imag, _theta, _energy = data
+            _sf = _sf_real + _sf_imag * 1j
+            dset.add_columns(proto_index=_proto, sf_real=np.real(_sf),
+                             sf_imag=np.imag(_sf), sf_module=np.abs(_sf),
+                             theta=_theta, energy=_energy)
+        elif scan_type in ('theta_phi',):
+            results_fname = os.path.join(self.tmp_folder, 'output/results.dat')
+            data = self.specio.load_results(results_fname)
+            #theta_c, phi_c = data[[2, 3], :]
+            #xsec_c = data[-1, :]
+            #dirsig_c = data[-2, :]
+
+            #dset.add_columns(theta=theta_c)
+            #dset.add_columns(phi=phi_c)
+            #dset.add_columns(cross_section=xsec_c)
+            #dset.add_columns(direct_signal=dirsig_c)
+            for _plane, _theta, _phi, _energy, _dirsig, _cs in data.T:
+                if _plane == -1:
+                    dset.add_row(theta=_theta, phi=_phi, energy=_energy, cross_section=_cs,
+                                 direct_signal=_dirsig)
+
+        # create a view
+        title = ''
+        for ke in all_ke.value:
+            if scan_type == 'theta':
+                title = 'Polar scan at {:.2f} eV'.format(ke)
+                xlabel = r'Angle $\theta$($\degree$)'
+                ylabel = r'Signal (a. u.)'
+
+                view = dset.add_view("E = {:.2f} eV".format(ke), title=title,
+                                     xlabel=xlabel, ylabel=ylabel, autoscale=True)
+                for angle_phi in self.scan_parameters.get_parameter(
+                    'phi').value:
+                    where = ("energy=={:.2f} and phi=={:.2f}"
+                             "").format(ke, angle_phi)
+                    legend = r'$\phi$ = {:.1f} $\degree$'.format(angle_phi)
+                    view.select('theta', 'cross_section', where=where,
+                                legend=legend)
+            if scan_type == 'phi':
+                title = 'Azimuthal scan at {:.2f} eV'.format(ke)
+                xlabel = r'Angle $\phi$($\degree$)'
+                ylabel = r'Signal (a. u.)'
+
+                view = dset.add_view("E = {:.2f} eV".format(ke), title=title,
+                                     xlabel=xlabel, ylabel=ylabel)
+                for angle_theta in self.scan_parameters.get_parameter(
+                    'theta').value:
+                    where = ("energy=={:.2f} and theta=={:.2f}"
+                             "").format(ke, angle_theta)
+                    legend = r'$\theta$ = {:.1f} $\degree$'.format(angle_theta)
+                    view.select('phi', 'cross_section', where=where,
+                                legend=legend)
+
+            if scan_type == 'theta_phi':
+                absorber_symbol = self.atoms[self.atoms.absorber].symbol
+                title = ('Stereographic projection at {:.2f} eV'
+                         '').format(ke)
+                xlabel = r'Angle $\phi$($\degree$)'
+                ylabel = r'Signal (a. u.)'
+
+                view = dset.add_view("E = {:.2f} eV".format(ke), title=title,
+                                     xlabel=xlabel, ylabel=ylabel,
+                                     projection='stereo', colorbar=True, autoscale=True)
+                view.select('theta', 'phi', 'cross_section')
+
+
+        if scan_type == 'scatf':
+            for i in range(self.phagenio.nat):
+                proto_index = i+1
+                title = 'Scattering factor at {:.3f} eV'.format(kinetic_energy)
+
+                mini = min(map(np.min, [dset.sf_real, dset.sf_imag, dset.sf_module]))
+                maxi = max(map(np.max, [dset.sf_real, dset.sf_imag, dset.sf_module]))
+                view = dset.add_view("Proto. atom #{:d}".format(proto_index),
+                                     title=title, projection='polar',
+                                     ylim=[mini, maxi])
+                where = "proto_index=={:d}".format(proto_index)
+                view.select('theta', 'sf_module', where=where,
+                            legend=r'$|f(\theta)|$')
+                view.select('theta', 'sf_real', where=where,
+                            legend=r'$\Re(f(\theta))$')
+                view.select('theta', 'sf_imag', where=where,
+                            legend=r'$\Im(f(\theta))$')
+
+        if scan_type == 'energy':
+            absorber_symbol = self.atoms[self.atoms.absorber].symbol
+            title = (r'Energy scan of {}({}) at $\theta$={:.2f}$\degree$ and '
+                      '$\phi$={:.2f}$\degree$').format(
+                     absorber_symbol, level, theta, phi)
+            xlabel = r'Photoelectron kinetic energy (eV)'
+            ylabel = r'Signal (a. u.)'
+
+            view = dset.add_view("EnergyScan".format(ke), title=title,
+                                 xlabel=xlabel, ylabel=ylabel)
+            view.select('energy', 'cross_section')
+
+        # save the cluster
+        #clusbuf = StringIO()
+        #self.atoms.info['absorber'] = self.atoms.absorber
+        #self.atoms.write(clusbuf, format='xyz')
+        #dset.add_parameter(group='Cluster', name='cluster', value=clusbuf.getvalue(), hidden="True")
+        self.add_cluster_to_dset(dset)
+
+        LOGGER.info('%s scan computing done!', scan_type)
+
+        return self.iodata
+
+    def get_potential(self, atom_index=None, data=None, units={'energy': 'eV', 'space': 'angstrom'}):
+        """Computes the coulombic part of the atomic potential.
+
+        :param atom_index: The atom indices to get the potential of, either as a list or as a single integer
+        :param data: The data object to store the results to
+        :param units: The units to be used. A dictionary with the keys 'energy' and 'space'
+        :return: A Data object
+        """
+        LOGGER.info("Getting the Potential...")
+        LOGGER.debug(get_call_info(inspect.currentframe()))
+
+        _units = {'energy': 'eV', 'space': 'angstrom'}
+        _units.update(units)
+
+        if data:
+            self.iodata = data
+
+        self.run_phagen()
+
+        filename = os.path.join(self.tmp_folder, 'output/tmatrix.tl')
+        tl = self.phagenio.load_tl_file(filename)
+
+        filename = os.path.join(self.tmp_folder, 'output/cluster.clu')
+        self.phagenio.load_cluster_file(filename)
+
+        if self.phagen_parameters.potgen in ('in'):
+            filename = os.path.join(self.tmp_folder, 'output/plot/plot_vc.dat')
+        else:
+            filename = os.path.join(self.tmp_folder, 'output/plot/plot_v.dat')
+        pot_data = self.phagenio.load_potential_file(filename)
+
+        cluster = self.phagen_parameters.get_parameter('atoms').value
+
+        dset = self.iodata.add_dset('Potential [{:d}]'.format(len(self.iodata)))
+        r = []
+        v = []
+        index = np.empty((0,1), dtype=int)
+
+        absorber_position = cluster[cluster.absorber].position
+        for _pot_data in pot_data:
+            # find the proto index of these data
+            at_position = (_pot_data['coord'] * UREG.bohr_radius).to('angstrom').magnitude + absorber_position
+            at_index = get_atom_index(cluster, *at_position)
+            at_proto_index = cluster[at_index].get('proto_index')
+            #values = np.asarray(_pot_data['values'])
+            values = _pot_data['values']
+            index = np.append(index, np.ones(values.shape[0], dtype=int) * at_proto_index)
+            r = np.append(r, (values[:, 0] * UREG.bohr_radius).to(_units['space']).magnitude)
+            v = np.append(v, (values[:, 1] * UREG.rydberg).to(_units['energy']).magnitude)
+
+        dset.add_columns(distance=r, potential=v, index=index)
+        view = dset.add_view('potential data', title='Potential energy of atoms',
+                             xlabel='distance from atomic center [{:s}]'.format(_units['space']),
+                             ylabel='energy [{:s}]'.format(_units['energy']), scale='linear',
+                             autoscale=True)
+
+        if atom_index == None:
+            for i in range(pot_data[len(pot_data) - 1]['index']):
+                view.select('distance', 'potential', where="index=={:d}".format(i),
+                            legend="Atom index #{:d}".format(i + 1))
+        else:
+            for i in atom_index:
+                view.select('distance', 'potential', where="index=={:d}".format(cluster[i].get('proto_index') - 1),
+                            legend="Atom index #{:d}".format(i))
+
+        return self.iodata
+
+    def get_scattering_factors(self, level='1s', kinetic_energy=None,
+                               data=None, **kwargs):
+        """Computes the scattering factors of all prototypical atoms in the
+        cluster.
+
+        This function computes the real and imaginery parts of the scattering
+        factor as well as its modulus for each non symetrically equivalent atom
+        in the cluster. The results are stored in the *data* object if provided
+        as a parameter.
+
+        :param level: The electronic level. See :ref:`pedparameters-level`.
+        :param kinetic_energy: see :ref:`scanparameters-kinetic_energy`.
+        :param data: a :py:class:`iodata.Data` object to append the results to
+            or None.
+
+        :returns: The modified :py:class:`iodata.Data` object passed as an
+            argument or a new :py:class:`iodata.Data` object.
+
+        """
+        data = self._get_scan(scan_type='scatf', level=level, data=data,
+                              kinetic_energy=kinetic_energy, **kwargs)
+        return data
+
+    def get_theta_scan(self, phi=0, theta=np.linspace(-70, 70, 141),
+                       kinetic_energy=None, data=None, **kwargs):
+        """Computes a polar scan of the emitted photoelectrons.
+
+        :param phi: The azimuthal angle in degrees. See
+            :ref:`scanparameters-phi`.
+        :param theta: All the values of the polar angle to be computed. See
+            :ref:`scanparameters-theta`.
+        :param level: The electronic level. See :ref:`pedparameters-level`.
+        :param kinetic_energy: see :ref:`scanparameters-kinetic_energy`.
+        :param data: a :py:class:`iodata.Data` object to append the results to
+            or None.
+
+        :returns: The modified :py:class:`iodata.Data` object passed as an
+            argument or a new :py:class:`iodata.Data` object.
+
+        """
+        data = self._get_scan(scan_type='theta', theta=theta,
+                              phi=phi, kinetic_energy=kinetic_energy,
+                              data=data, **kwargs)
+        return data
+
+    def get_phi_scan(self, phi=np.linspace(0, 359, 359), theta=0,
+                     kinetic_energy=None, data=None, **kwargs):
+        """Computes an azimuthal scan of the emitted photoelectrons.
+
+        :param phi: All the values of the azimuthal angle to be computed. See
+            :ref:`scanparameters-phi`.
+        :param theta: The polar angle in degrees. See
+            :ref:`scanparameters-theta`.
+        :param level: The electronic level. See :ref:`pedparameters-level`.
+        :param kinetic_energy: see :ref:`scanparameters-kinetic_energy`.
+        :param data: a :py:class:`iodata.Data` object to append the results to
+            or None.
+
+        :returns: The modified :py:class:`iodata.Data` object passed as an
+            argument or a new :py:class:`iodata.Data` object.
+
+        """
+        data = self._get_scan(scan_type='phi', theta=theta,
+                              phi=phi, kinetic_energy=kinetic_energy,
+                              data=data, **kwargs)
+        return data
+
+    def get_theta_phi_scan(self, phi=np.linspace(0, 360),
+                           theta=np.linspace(0, 90, 45),
+                           kinetic_energy=None, data=None, **kwargs):
+        """Computes a stereographic scan of the emitted photoelectrons.
+
+        The azimuth ranges from 0 to 360° and the polar angle ranges from 0 to
+        90°.
+
+        :param level: The electronic level. See :ref:`pedparameters-level`.
+        :param kinetic_energy: see :ref:`scanparameters-kinetic_energy`.
+        :param data: a :py:class:`iodata.Data` object to append the results to
+            or None.
+
+        :returns: The modified :py:class:`iodata.Data` object passed as an
+            argument or a new :py:class:`iodata.Data` object.
+
+        """
+        data = self._get_scan(scan_type='theta_phi', theta=theta,
+                              phi=phi, kinetic_energy=kinetic_energy, data=data,
+                              **kwargs)
+        return data
+
+    def get_energy_scan(self, phi=0, theta=0,
+                        level=None, kinetic_energy=None, data=None, **kwargs):
+        """Computes an energy scan of the emitted photoelectrons.
+
+        :param phi: All the values of the azimuthal angle to be computed. See
+            :ref:`scanparameters-phi`.
+        :param theta: The polar angle in degrees. See
+            :ref:`scanparameters-theta`.
+        :param level: The electronic level. See :ref:`pedparameters-level`.
+        :param kinetic_energy: see :ref:`scanparameters-kinetic_energy`.
+        :param data: a :py:class:`iodata.Data` object to append the results to
+            or None.
+
+        :returns: The modified :py:class:`iodata.Data` object passed as an
+            argument or a new :py:class:`iodata.Data` object.
+
+        """
+        data = self._get_scan(scan_type='energy', level=level, theta=theta,
+                              phi=phi, kinetic_energy=kinetic_energy,
+                              data=data, **kwargs)
+        return data
+
+
 def MSSPEC(spectroscopy='PED', **kwargs):
     """ The MsSpec calculator constructor.
 
@@ -1132,7 +1543,7 @@ class RFACTOR(object):
         for i in range(noif):
             X, Y = args[2*i], args[2*i+1]
             fname = os.path.join('calc',
-                                 f'calculation{self.stack_count:d}.txt')
+                                 'calculation{:d}.txt'.format(self.stack_count))
             # And save to the working space
             np.savetxt(fname, np.transpose([X, Y]))
             self.stack_count += 1
@@ -1140,7 +1551,7 @@ class RFACTOR(object):
         # Update the list of input calculation files
         self._params.calc_filename = []
         for i in range(self.stack_count):
-            fname = os.path.join('calc', f'calculation{i:d}.txt')
+            fname = os.path.join('calc', 'calculation{:d}.txt'.format(i))
             self._params.calc_filename.append(fname)
 
         # Write the input file
@@ -1235,23 +1646,23 @@ class RFACTOR(object):
             dset_values.x, dset_values.yref = exp_data.T
             # Append the calculated values
             ycalc = calc_data[:,1]
-            dset_values.add_columns(**{f"calc{i:d}": ycalc})
-            dset_rfc.add_columns(**{f'variable_set{i:d}': rfc})
+            dset_values.add_columns(**{"calc{:d}".format(i): ycalc})
+            dset_rfc.add_columns(**{'variable_set{:d}'.format(i): rfc})
 
         # Plot the curves
         view_values.select('x', 'yref', legend='Reference values')
         title = ''
         for k,v in self.best_values.items():
-            title += f'{k}={v} '
-        view_values.select('x', f"calc{self.index:d}",
+            title += '{}={} '.format(k, v)
+        view_values.select('x', "calc{:d}".format(self.index),
                            legend="Best calculated values")
         view_values.set_plot_options(title=title)
 
         view_results.select('counts')
 
         for i in range(self.stack_count):
-            view_rfc.select('rfactor_number', f'variable_set{i:d}',
-                            legend=f"variables set #{i:d}")
+            view_rfc.select('rfactor_number', 'variable_set{:d}'.format(i),
+                            legend="variables set #{:d}".format(i))
         # Save the parameters
         for p in self.get_parameters():
             bundle = {'group': str(p.group),
@@ -1281,5 +1692,7 @@ class RFACTOR(object):
 
 
 
+
+
 if __name__ == "__main__":
     pass

src/msspec/cli.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -18,8 +19,8 @@
 # along with msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/cli.py
-# Last modified: jeu. 04 juin 2020 16:54:12
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 import sys

src/msspec/create_tests_results.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -18,8 +19,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/create_tests_results.py
-# Last modified: ven. 10 avril 2020 17:29:16
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 from msspec.tests import create_tests_results

src/msspec/data/__init__.py

@@ -1,5 +1,24 @@
-# -*- encoding: utf-8 -*-
-# vim: set fdm=indent ts=4 sw=4 sts=4 et ai tw=80 cc=+0 mouse=a nu : #
+#!/usr/bin/env python
+# coding: utf-8
+#
+# Copyright © 2016-2020 - Rennes Physics Institute
+#
+# This file is part of msspec.
+#
+# msspec 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.
+# msspec 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 msspec.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Source file  : src/msspec/data/__init__.py
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 from .electron_be import electron_be

src/msspec/data/electron_be.py

@@ -1,4 +1,24 @@
+#!/usr/bin/env python
 # coding: utf-8
+#
+# Copyright © 2016-2020 - Rennes Physics Institute
+#
+# This file is part of msspec.
+#
+# msspec 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.
+# msspec 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 msspec.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Source file  : src/msspec/data/electron_be.py
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 """
 Module electron_be

src/msspec/iodata.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -16,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/iodata.py
-# Last modified: ven. 10 avril 2020 17:23:11
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Thu, 25 Jan 2024 09:48:44 +0100
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes.fr>
 
 
 """
@@ -85,6 +86,7 @@ from matplotlib.backends.backend_wxagg import FigureCanvasWxAgg as FigureCanvas
 from matplotlib.backends.backend_agg import FigureCanvasAgg
 from matplotlib.backends.backend_wxagg import NavigationToolbar2WxAgg
 from matplotlib.figure import Figure
+from matplotlib.ticker import FormatStrFormatter
 from terminaltables import AsciiTable
 
 import msspec
@@ -92,13 +94,17 @@ from msspec.msspecgui.msspec.gui.clusterviewer import ClusterViewer
 from msspec.misc import LOGGER
 
 
-def cols2matrix(x, y, z, nx=88*1+1, ny=360*1+1):
+def cols2matrix(x, y, z, nx=88*1+1, ny=360*1+1, xlim=[None, None], ylim=[None, None]):
     # mix the values of existing theta and new theta and return the
     # unique values
-    newx = np.linspace(np.min(x), np.max(x), nx)
+    xmin = xlim[0] if xlim[0] is not None else np.min(x)
+    xmax = xlim[1] if xlim[1] is not None else np.max(x)
+    ymin = ylim[0] if ylim[0] is not None else np.min(y)
+    ymax = ylim[1] if ylim[1] is not None else np.max(y)
+    newx = np.linspace(xmin, xmax, nx)
     newy = np.linspace(np.min(y), np.max(y), ny)
-    ux = np.unique(np.append(x, newx))
-    uy = np.unique(np.append(y, newy))
+    ux = np.unique(np.sort(np.append(x, newx)).clip(xmin, xmax))
+    uy = np.unique(np.sort(np.append(y, newy)).clip(ymin, ymax))
 
     # create an empty matrix to hold the results
     zz = np.empty((len(ux), len(uy)))
@@ -442,24 +448,24 @@ class DataSet(object):
             for k, v in parameters.items():
                 if k == 'Cluster':
                     continue
-                s += f"# {k}:\n"
+                s += "# {}:\n".format(k)
                 if not(isinstance(v, list)):
                     v = [v,]
                 for p in v:
-                    s += f"#       {p['name']} = {p['value']} {p['unit']}\n"
+                    s += "#       {} = {} {}\n".format(p['name'], p['value'], p['unit'])
             return s
 
         colnames = self.columns()
         with open(filename, mode) as fd:
             # write the date and time of export
             now = datetime.now()
-            fd.write(f"# Data exported on {now}\n")
+            fd.write("# Data exported on {}\n".format(now))
             fd.write(rule)
 
             # Append notes
             fd.write("# NOTES:\n")
             for line in self.notes.split('\n'):
-                fd.write(f"#    {line}\n")
+                fd.write("#    {}\n".format(line))
             fd.write(rule)
 
             # Append parameters
@@ -812,7 +818,8 @@ class _DataSetView(object):
             xlabel='', ylabel='', grid=True, legend=[], colorbar=False,
             projection='rectilinear', xlim=[None, None], ylim=[None, None],
             scale='linear',
-            marker=None, autoscale=False)
+            specular=None,
+            marker=None, autoscale=True)
         self._plotopts.update(plotopts)
         self._selection_tags = []
         self._selection_conditions = []
@@ -878,19 +885,26 @@ class _DataSetView(object):
                 axes.set_xticks(xvalues)
             else:
                 if proj in ('ortho', 'stereo'):
-                    theta, phi, Xsec = cols2matrix(*values)
-                    theta_ticks = np.arange(0, 91, 15)
+                    theta, phi, Xsec = cols2matrix(*values, xlim=opts['xlim'], ylim=opts['ylim'])
+                    #theta_ticks = np.arange(0, 91, 15)
+                    theta_ticks = np.linspace(np.min(theta), np.max(theta), 7)
                     if proj == 'ortho':
                         R = np.sin(np.radians(theta))
                         R_ticks = np.sin(np.radians(theta_ticks))
                     elif proj == 'stereo':
                         R = 2 * np.tan(np.radians(theta/2.))
                         R_ticks = 2 * np.tan(np.radians(theta_ticks/2.))
-                    #R = np.tan(np.radians(theta/2.))
                     X, Y = np.meshgrid(np.radians(phi), R)
-                    im = axes.pcolormesh(X, Y, Xsec)
+                    if opts['specular'] is not None:
+                        Xsec[Y<np.radians(opts['specular'])] = np.nan
+
+                    im = axes.pcolormesh(X, Y, Xsec, shading='gouraud')
                     axes.set_yticks(R_ticks)
-                    axes.set_yticklabels(theta_ticks)
+                    axes.set_yticklabels([ '{:.1f}'.format(_) for _ in theta_ticks ])
+
+                    #print(R_ticks)
+                    print(theta_ticks)
+                    #exit()
 
                     figure.colorbar(im)
 
@@ -913,8 +927,6 @@ class _DataSetView(object):
             axes.set_title(opts['title'])
             axes.set_xlabel(opts['xlabel'])
             axes.set_ylabel(opts['ylabel'])
-            axes.set_xlim(*opts['xlim'])
-            axes.set_ylim(*opts['ylim'])
             #axes.set_pickradius(5)
             if label:
                 axes.legend()

src/msspec/iodata_gi.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -15,9 +16,9 @@
 # You should have received a copy of the GNU General Public License
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
-# Source file  : src/msspec/iodata.py
-# Last modified: ven. 10 avril 2020 17:23:11
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Source file  : src/msspec/iodata_gi.py
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """
@@ -234,8 +235,8 @@ class DataSet(object):
                          float: '{:<20.10e}', complex: 's'}
         self._formats = ((np.integer, '{:<20d}'),
                          (np.floating, '{:<20.10e}'),
-                         (np.complex, '({0.real:<.10e} {0.imag:<.10e}j)'),
-                         (np.bool, '{:s}'),
+                         (complex, '({0.real:<.10e} {0.imag:<.10e}j)'),
+                         (bool, '{:s}'),
                          (str, '{:s}'))
 
 
@@ -449,9 +450,13 @@ class DataSet(object):
         :return: The cluster
         :rtype: :py:class:`ase.Atoms`
         """
+        p = self.get_parameter(group='Cluster', name='cluster')['value']
         s = StringIO()
         s.write(self.get_parameter(group='Cluster', name='cluster')['value'])
-        return ase.io.read(s, format='xyz')
+        s.seek(0)
+        #return ase.io.read(s, format='xyz')
+        cluster = list(read_xyz(s))[-1]
+        return cluster
 
 
     def select(self, *args, **kwargs):
@@ -491,24 +496,24 @@ class DataSet(object):
             for k, v in parameters.items():
                 if k == 'Cluster':
                     continue
-                s += f"# {k}:\n"
+                s += "# {}:\n".format(k)
                 if not(isinstance(v, list)):
                     v = [v,]
                 for p in v:
-                    s += f"#       {p['name']} = {p['value']} {p['unit']}\n"
+                    s += "#       {} = {} {}\n".format(p['name'], p['value'], p['unit'])
             return s
 
         colnames = self.columns()
         with open(filename, mode) as fd:
             # write the date and time of export
             now = datetime.now()
-            fd.write(f"# Data exported on {now}\n")
+            fd.write("# Data exported on {}\n".format(now))
             fd.write(rule)
 
             # Append notes
             fd.write("# NOTES:\n")
             for line in self.notes.split('\n'):
-                fd.write(f"#    {line}\n")
+                fd.write("#    {}\n".format(line))
             fd.write(rule)
 
             # Append parameters
@@ -784,13 +789,13 @@ class Data(object):
                 dset = output.add_dset(dset_name)
                 dset.notes = fd['DATA'][dset_name].attrs['notes']
                 for h5dset in fd['DATA'][dset_name]:
-                    dset.add_columns(**{h5dset: fd['DATA'][dset_name][h5dset].value})
+                    dset.add_columns(**{h5dset: fd['DATA'][dset_name][h5dset][...]})
 
             try:
                 vfile = LooseVersion(fd['MsSpec viewer metainfo'].attrs['version'])
                 if vfile > LooseVersion(msspec.__version__):
                     raise NameError('File was saved with a more recent format')
-                xml = fd['MsSpec viewer metainfo']['info'].value.tostring()
+                xml = fd['MsSpec viewer metainfo']['info'][...].tobytes()
                 root = etree.fromstring(xml)
                 for elt0 in root.iter('parameters'):
                     dset_name = elt0.attrib['dataset']
@@ -853,7 +858,7 @@ class Data(object):
         #win.show()
         #Gtk.main()
         app = _Application(self)
-        exit_status = app.run(sys.argv)
+        exit_status = app.run()#sys.argv)
         sys.exit(exit_status)
 
 class _Application(Gtk.Application):
@@ -946,7 +951,8 @@ class _DataSetView(object):
             if np.shape(values)[0] == 1:
                 xvalues = list(range(len(values[0])))
                 axes.bar(xvalues, values[0], label=label,
-                          picker=5)
+                         # picker=5
+                         )
                 axes.set_xticks(xvalues)
             else:
                 if proj in ('ortho', 'stereo'):
@@ -960,7 +966,7 @@ class _DataSetView(object):
                         R_ticks = 2 * np.tan(np.radians(theta_ticks/2.))
                     #R = np.tan(np.radians(theta/2.))
                     X, Y = np.meshgrid(np.radians(phi), R)
-                    im = axes.pcolormesh(X, Y, Xsec)
+                    im = axes.pcolormesh(X, Y, Xsec, shading='gouraud')
                     axes.set_yticks(R_ticks)
                     axes.set_yticklabels(theta_ticks)
 
@@ -968,7 +974,7 @@ class _DataSetView(object):
 
                 elif proj == 'polar':
                     values[0] = np.radians(values[0])
-                    axes.plot(*values, label=label, picker=5,
+                    axes.plot(*values, label=label, #picker=5,
                               marker=opts['marker'])
                 else:
                     if scale == 'semilogx':
@@ -979,7 +985,7 @@ class _DataSetView(object):
                         pltcmd = axes.loglog
                     else:
                         pltcmd = axes.plot
-                    pltcmd(*values, label=label, picker=5,
+                    pltcmd(*values, label=label, #picker=5,
                            marker=opts['marker'])
             axes.grid(opts['grid'])
             axes.set_title(opts['title'])
@@ -987,6 +993,7 @@ class _DataSetView(object):
             axes.set_ylabel(opts['ylabel'])
             axes.set_xlim(*opts['xlim'])
             axes.set_ylim(*opts['ylim'])
+            #axes.set_pickradius(5)
             if label:
                 axes.legend()
         axes.autoscale(enable=opts['autoscale'])
@@ -1241,7 +1248,7 @@ class _DataWindow(Gtk.ApplicationWindow):
     def on_close(self, action, param):
         if self.data.is_dirty():
             dlg = Gtk.Dialog(title="Warning: Unsaved data",
-                             transient_for=self, flags=Gtk.DialogFlags.MODAL)
+                             transient_for=self, modal=True)
             dlg.add_buttons(Gtk.STOCK_YES, Gtk.ResponseType.YES,
                             Gtk.STOCK_NO, Gtk.ResponseType.NO)
             dlg.set_default_size(150, 100)
@@ -1473,9 +1480,14 @@ class OLD_DataWindow(wx.Frame):
         cluster_viewer = ClusterViewer(win, size=wx.Size(480, 340))
 
         dset = self.data[self._current_dset]
-        s = StringIO()
-        s.write(dset.get_parameter(group='Cluster', name='cluster')['value'])
-        atoms = ase.io.read(s, format='xyz')
+        #s = StringIO()
+        #s.write(dset.get_parameter(group='Cluster', name='cluster')['value'])
+        #_s = dset.get_parameter(group='Cluster', name='cluster')['value']
+        #print(_s)
+        # rewind to the begining of the string
+        #s.seek(0)
+        #atoms = ase.io.read(s, format='xyz')
+        atoms = dset.get_cluster()
         cluster_viewer.set_atoms(atoms, rescale=True, center=True)
         cluster_viewer.rotate_atoms(0., 180.)
         cluster_viewer.rotate_atoms(-45., -45.)
@@ -1676,7 +1688,7 @@ class OLD_DataWindow(wx.Frame):
 
 
 if __name__ == "__main__":
-    if True:
+    if False:
         data = Data('all my data')
         dset = data.add_dset('Dataset 0')
         X = np.arange(0, 20)
@@ -1712,6 +1724,7 @@ if __name__ == "__main__":
         view.select('x', 'y')
 
         data.view()
-    #import sys
-    #data = Data.load(sys.argv[1])
-    #data.view()
+        exit()
+    import sys
+    data = Data.load(sys.argv[1])
+    data.view()

src/msspec/iodata_wx.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -15,9 +16,9 @@
 # You should have received a copy of the GNU General Public License
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
-# Source file  : src/msspec/iodata.py
-# Last modified: ven. 10 avril 2020 17:23:11
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Source file  : src/msspec/iodata_wx.py
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """
@@ -437,24 +438,24 @@ class DataSet(object):
             for k, v in parameters.items():
                 if k == 'Cluster':
                     continue
-                s += f"# {k}:\n"
+                s += "# {}:\n".format(k)
                 if not(isinstance(v, list)):
                     v = [v,]
                 for p in v:
-                    s += f"#       {p['name']} = {p['value']} {p['unit']}\n"
+                    s += "#       {} = {} {}\n".format(p['name'], p['value'], p['unit'])
             return s
 
         colnames = self.columns()
         with open(filename, mode) as fd:
             # write the date and time of export
             now = datetime.now()
-            fd.write(f"# Data exported on {now}\n")
+            fd.write("# Data exported on {}\n".format(now))
             fd.write(rule)
 
             # Append notes
             fd.write("# NOTES:\n")
             for line in self.notes.split('\n'):
-                fd.write(f"#    {line}\n")
+                fd.write("#    {}\n".format(line))
             fd.write(rule)
 
             # Append parameters

src/msspec/looper.py

@@ -1,6 +1,24 @@
-# coding: utf8
-# -*- encoding: future_fstrings -*-
-# vim: set et sw=4 ts=4 nu tw=79 cc=+1:
+#!/usr/bin/env python
+# coding: utf-8
+#
+# Copyright © 2016-2020 - Rennes Physics Institute
+#
+# This file is part of msspec.
+#
+# msspec 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.
+# msspec 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 msspec.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Source file  : src/msspec/looper.py
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 from collections import OrderedDict
 from functools import partial
@@ -21,7 +39,7 @@ class Variable:
         self.doc = doc
 
     def __repr__(self):
-        return f"<Variable(\'{self.name}\')>"
+        return "<Variable(\'{}\')>".format(self.name)
 
 class Sweep:
     def __init__(self, key, comments="", unit=None,

src/msspec/misc.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -18,8 +19,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/misc.py
-# Last modified: ven. 10 avril 2020 17:30:42
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """

src/msspec/parameters.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -18,8 +19,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/parameters.py
-# Last modified: ven. 10 avril 2020 17:31:50
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Thu, 25 Jan 2024 09:48:45 +0100
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes.fr>
 
 
 """
@@ -487,11 +488,11 @@ class SpecParameters(BaseParameters):
                       fmt='.2f'),
             Parameter('leed_r1', types=float, default=-1.0,
                       fmt='.3f'),
-            Parameter('leed_thini', types=float, default=-55.0,
+            Parameter('leed_thini', types=float, default=0.,
                       fmt='.2f'),
             Parameter('leed_phiini', types=float, default=0.,
                       fmt='.2f'),
-            Parameter('leed_imod', types=int, default=1,
+            Parameter('leed_imod', types=int, default=0,
                       fmt='d'),
             Parameter('leed_imoy', types=int, default=0,
                       fmt='d'),
@@ -832,12 +833,23 @@ class GlobalParameters(BaseParameters):
             'AED': ('aed', 'AED'),
             'LEED': ('led', 'LED'),
             'EXAFS': ('xas', 'XAS'),
-            'EIG': ('xpd', 'EIG'),
+            'EIG': ('led', 'EIG'),
         }
         phagen_calctype, spec_calctype = mapping[p.value]
         self.phagen_parameters.calctype = phagen_calctype
         self.spec_parameters.calctype_spectro = spec_calctype
 
+    def bind_polarization(self, p):
+        if p.value is None:
+            ipol = 0
+        elif p.value == 'linear_qOz':
+            ipol = 1
+        elif p.value == 'linear_xOy':
+            ipol = -1
+        elif p.value == 'circular':
+            ipol = 2
+        self.spec_parameters.calctype_ipol = ipol
+
     def bind_spinpol(self, p):
         if p.value == True:
             LOGGER.error('Spin polarization is not yet enabled in the Python version.')
@@ -1142,7 +1154,7 @@ class DetectorParameters(BaseParameters):
                       default=None, doc="""
                       Used to averaged the signal over directions lying in the
                       cone of half-angle *angular_acceptance*. The number of
-                      directions to take into account depends on the choosen
+                      directions to take into account depends on the chosen
                       value:
 
                       - **None**, for no averaging at all
@@ -1295,7 +1307,7 @@ class ScanParameters(BaseParameters):
             calculation_parameters.set_parameter('basis_functions',
                                                  'spherical', force=True)
 
-        LOGGER.info('\'%s\' scan type choosen.', p.value)
+        LOGGER.info('\'%s\' scan type chosen.', p.value)
 
     def bind_theta(self, p):
         spectro = self.global_parameters.spectroscopy
@@ -1410,6 +1422,10 @@ class ScanParameters(BaseParameters):
         self.spec_parameters.ped_e1 = energies[1]
         self.spec_parameters.ped_ne = energies[2]
 
+        self.spec_parameters.leed_e0 = energies[0]
+        self.spec_parameters.leed_e1 = energies[1]
+        self.spec_parameters.leed_ne = energies[2]
+
         self.spec_parameters.eigval_ekini = energies[0]
         self.spec_parameters.eigval_ekfin = energies[1]
         self.spec_parameters.eigval_ne = energies[2]
@@ -1817,6 +1833,57 @@ class PEDParameters(BaseParameters):
         self.spec_parameters.ped_iso = somap[p.value]
 
 
+class LEEDParameters(BaseParameters):
+    def __init__(self, phagen_parameters, spec_parameters):
+        # parameters = (
+            # Parameter('level', types=str, pattern=r'\d+[spdfgSPDFG](\d/2)?$',
+                      # default='1s', doc="""
+            # The level is the electronic level where the electron comes from.
+            # It is written: *nlJ*
+            # where:
+
+            # - *n* is the principal quantum number
+            # - *l* is the orbital quantum number
+            # - *J* is the spin-orbit component
+
+            # Example::
+
+            # >>> calc.spectroscopy_parameters.level = '2p3/2'
+            # >>> calc.spectroscopy_parameters.level = '2p' # is equivalent to '2p1/2'
+
+            # """),
+            # Parameter('final_state', types=int, limits=(-1, 2), default=2),
+            # Parameter('spin_orbit', types=(type(None), str),
+                      # allowed_values=(None, 'single', 'both'), default=None),
+        # )
+        BaseParameters.__init__(self)
+        #self.add_parameters(*parameters)
+        self.phagen_parameters = phagen_parameters
+        self.spec_parameters = spec_parameters
+
+    # def bind_level(self, p):
+        # edge = get_level_from_electron_configuration(p.value)
+        # self.phagen_parameters.edge = edge
+
+        # li, so = re.match(r'(^\d+[spdfg])(.*$)', p.value).groups()
+        # if so == '':
+            # so = '1/2'
+
+        # self.spec_parameters.ped_li = li
+        # self.spec_parameters.ped_so = so
+        # self.spec_parameters.extra_level = p.value
+
+    # def bind_final_state(self, p):
+        # self.spec_parameters.ped_initl = p.value
+
+    # def bind_spin_orbit(self, p):
+        # somap = {
+            # None: 0,
+            # 'single': 1,
+            # 'both': 2}
+        # self.spec_parameters.ped_iso = somap[p.value]
+
+
 class EIGParameters(BaseParameters):
     def __init__(self, phagen_parameters, spec_parameters):
         parameters = (
@@ -2012,20 +2079,20 @@ class CompCurveGeneralParameters(BaseParameters):
         value = p.allowed_values.index(p.value)
         self.compcurve_parameters.general_norm = value
         LOGGER.info("Curve Comparison: Normalization mode set to "
-                    f"\"{p.value}\"")
+                    "\"{}\"".format(p.value))
 
     def bind_rescale(self, p):
         self.compcurve_parameters.general_iscale = int(p.value)
         state = "deactivated"
         if p.value:
             state = "activated"
-        LOGGER.info(f"Curve Comparison: Rescaling of data {state}")
+        LOGGER.info("Curve Comparison: Rescaling of data {}".format(state))
 
     def bind_function(self, p):
         value = p.allowed_values.index(p.value)
         self.compcurve_parameters.general_icur = value
         LOGGER.info("Curve Comparison: Type of data used for comparison "
-                    f"set to \"{p.value}\"")
+                    "set to \"{}\"".format(p.value))
 
 
 

src/msspec/phagen/fortran/phagen_2.2_dp/msxas3.inc

@@ -28,7 +28,7 @@ c
       integer fl_, rdx_
 c
       parameter ( rdx_     =  1600,
-     $            lmax_    =  50,
+     $            lmax_    =  80,
      $            npss     =  lmax_ + 2,
      $            fl_       =  2*npss + 1,
      $            nef_     =  10,

src/msspec/phagen/fortran/phagen_2.2_dp/phagen_scf_2.2_dp.f

@@ -14625,7 +14625,7 @@ c      check = .true.
 !
       do
 !
-        if ( r_real ( i ) > r_in ) then
+        if (( r_real ( i ) > r_in ) .or. ( i .ge. size(r_real) )) then
 
           exit
 

src/msspec/spec/fortran/Makefile

@@ -1,6 +1,6 @@
-.PHONY: all phd_se phd_mi eig_mi eig_pw comp_curve clean
+.PHONY: all phd_se phd_mi phd_ce led_mi eig_mi eig_pw comp_curve clean
 
-all: phd_se phd_mi eig_mi eig_pw comp_curve
+all: phd_se phd_mi phd_ce led_mi eig_mi eig_pw comp_curve
 
 phd_se:
 	@+$(MAKE) -f phd_se_noso_nosp_nosym.mk all
@@ -8,6 +8,12 @@ phd_se:
 phd_mi:
 	@+$(MAKE) -f phd_mi_noso_nosp_nosym.mk all
 
+phd_ce:
+	@+$(MAKE) -f phd_ce_noso_nosp_nosym.mk all
+
+led_mi:
+	@+$(MAKE) -f led_mi_noso_nosp_nosym.mk all
+
 eig_mi:
 	@+$(MAKE) -f eig_mi.mk all
 
@@ -20,6 +26,8 @@ comp_curve:
 clean::
 	@+$(MAKE) -f phd_se_noso_nosp_nosym.mk $@
 	@+$(MAKE) -f phd_mi_noso_nosp_nosym.mk $@
+	@+$(MAKE) -f phd_ce_noso_nosp_nosym.mk $@
+	@+$(MAKE) -f led_mi_noso_nosp_nosym.mk $@
 	@+$(MAKE) -f eig_mi.mk $@
 	@+$(MAKE) -f eig_pw.mk $@
 	@+$(MAKE) -f comp_curve.mk $@

src/msspec/spec/fortran/eig/common/eig_mat_ms.f

@@ -178,6 +178,10 @@ CKMD          WRITE(IUO1,*) '                        '
 CKMD          WRITE(IUO1,*) '    --->  WORK(1),INFO =',WORK(1),INFO
 CKMD          WRITE(IUO1,*) '                        '
 CKMD      ENDIF
+C
+CKMD Save eigenvalues to unformatted stream file eigenvalues.dat
+C
+      call save_eigenvalues(w, jlin, e_kin)
 C
       N_EIG=0
 C

src/msspec/spec/fortran/eig/common/save_eigenvalues.f

@@ -0,0 +1,37 @@
+c
+c=======================================================================
+c
+      subroutine save_eigenvalues (evalues, n, ke)
+c
+      implicit none
+c
+      integer,    intent(in) :: n
+      real,       intent(in) :: ke
+      complex*16, intent(in) :: evalues(n)
+c
+c Local variables
+c
+      integer :: io
+      logical :: exists
+c
+c
+      inquire(file='eigenvalues.dat', exist=exists)
+c
+      if (exists) then
+         open(newunit=io, file='eigenvalues.dat', status='old',
+     +        form='unformatted', access='stream', action='write',
+     +        position='append')
+      else
+         open(newunit=io, file='eigenvalues.dat', status='new',
+     +        form='unformatted', access='stream', action='write')
+      end if
+c
+      write(io) ke, n, evalues(1:n)
+c
+      close(io)
+c
+      return
+      end subroutine save_eigenvalues
+c
+c=======================================================================
+c

src/msspec/spec/fortran/eig_mi.mk

@@ -2,7 +2,8 @@ memalloc_src               := memalloc/dim_mod.f memalloc/modules.f memalloc/all
 cluster_gen_src            := $(wildcard cluster_gen/*.f)
 common_sub_src             := $(wildcard common_sub/*.f)
 renormalization_src        := $(wildcard renormalization/*.f)
-eig_common_src             := $(wildcard eig/common/*.f)
+#eig_common_src             := $(wildcard eig/common/*.f)
+eig_common_src             := $(filter-out eig/common/lapack_eig.f, $(wildcard eig/common/*.f))
 eig_mi_src                 := $(wildcard eig/mi/*.f)
 
 SRCS   = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(eig_common_src) $(eig_mi_src)

src/msspec/spec/fortran/led_mi_noso_nosp_nosym.mk

@@ -0,0 +1,11 @@
+memalloc_src               := memalloc/dim_mod.f memalloc/modules.f memalloc/allocation.f 
+cluster_gen_src            := $(wildcard cluster_gen/*.f)
+common_sub_src             := $(wildcard common_sub/*.f)
+renormalization_src        := $(wildcard renormalization/*.f)
+led_mi_noso_nosp_nosym_src := $(filter-out led_mi_noso_nosp_nosym/lapack_inv.f, $(wildcard led_mi_noso_nosp_nosym/*.f))
+
+SRCS   = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(led_mi_noso_nosp_nosym_src)
+MAIN_F = led_mi_noso_nosp_nosym/main.f
+SO     = _led_mi_noso_nosp_nosym.so
+
+include ../../../options.mk

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/dwsph.f

@@ -0,0 +1,85 @@
+C
+C=======================================================================
+C
+      SUBROUTINE DWSPH(JTYP,JE,X,TLT,ISPEED)
+C
+C  This routine recomputes the T-matrix elements taking into account the
+C                mean square displacements.
+C
+C  When the argument X is tiny, no vibrations are taken into account
+C
+C                                      Last modified : 25 Apr 2013
+C
+      USE DIM_MOD
+C
+      USE TRANS_MOD
+C
+      DIMENSION GNT(0:N_GAUNT)
+C
+      COMPLEX TLT(0:NT_M,4,NATM,NE_M),SL1,ZEROC
+C
+      COMPLEX*16 FFL(0:2*NL_M)
+C
+      DATA PI4,EPS /12.566371,1.0E-10/
+C
+      ZEROC=(0.,0.)
+C
+      IF(X.GT.EPS) THEN
+C
+C  Standard case: vibrations
+C
+        IF(ISPEED.LT.0) THEN
+          NSUM_LB=ABS(ISPEED)
+        ENDIF
+C
+        COEF=PI4*EXP(-X)
+        NL2=2*LMAX(JTYP,JE)+2
+        IBESP=5
+        MG1=0
+        MG2=0
+C
+        CALL BESPHE(NL2,IBESP,X,FFL)
+C
+        DO L=0,LMAX(JTYP,JE)
+          XL=FLOAT(L+L+1)
+          SL1=ZEROC
+C
+          DO L1=0,LMAX(JTYP,JE)
+            XL1=FLOAT(L1+L1+1)
+            CALL GAUNT(L,MG1,L1,MG2,GNT)
+            L2MIN=ABS(L1-L)
+            IF(ISPEED.GE.0) THEN
+              L2MAX=L1+L
+            ELSEIF(ISPEED.LT.0) THEN
+              L2MAX=L2MIN+2*(NSUM_LB-1)
+            ENDIF
+            SL2=0.
+C
+            DO L2=L2MIN,L2MAX,2
+              XL2=FLOAT(L2+L2+1)
+              C=SQRT(XL1*XL2/(PI4*XL))
+              SL2=SL2+C*GNT(L2)*REAL(DREAL(FFL(L2)))
+            ENDDO
+C
+            SL1=SL1+SL2*TL(L1,1,JTYP,JE)
+          ENDDO
+C
+          TLT(L,1,JTYP,JE)=COEF*SL1
+C
+        ENDDO
+C
+      ELSE
+C
+C  Argument X tiny: no vibrations
+C
+        DO L=0,LMAX(JTYP,JE)
+C
+          TLT(L,1,JTYP,JE)=TL(L,1,JTYP,JE)
+C
+        ENDDO
+C
+      ENDIF
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/facdif.f

@@ -0,0 +1,26 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF(COSTH,JAT,JE,FTHETA)
+C
+C  This routine computes the plane wave scattering factor
+C
+      USE DIM_MOD
+C
+      USE TRANS_MOD
+C
+      DIMENSION PL(0:100)
+C
+      COMPLEX FTHETA
+C
+      FTHETA=(0.,0.)
+      NL=LMAX(JAT,JE)+1
+      CALL POLLEG(NL,COSTH,PL)
+      DO 20 L=0,NL-1
+        FTHETA=FTHETA+(2*L+1)*TL(L,1,JAT,JE)*PL(L)
+  20  CONTINUE
+      FTHETA=FTHETA/VK(JE)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/facdif1.f

@@ -0,0 +1,113 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF1(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,FSPH,JAT,J
+     &E,*)
+C
+C  This routine computes a spherical wave scattering factor
+C
+C                                        Last modified : 03/04/2006
+C
+      USE DIM_MOD
+      USE APPROX_MOD
+      USE EXPFAC_MOD
+      USE TRANS_MOD
+      USE TYPCAL_MOD , I2 => IPHI, I3 => IE, I4 => ITHETA, I5 => IMOD, I
+     &6 => IPOL, I7 => I_CP, I8 => I_EXT, I9 => I_TEST
+C
+      DIMENSION PLMM(0:100,0:100)
+      DIMENSION D(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
+C
+      COMPLEX HLM(0:NO_ST_M,0:NL_M-1),HLN(0:NO_ST_M,0:NL_M-1),FSPH,RHOJ
+      COMPLEX HLM1,HLM2,HLM3,HLM4,ALMU,BLMU,SLP,SNU,SMU,VKE
+      COMPLEX RHOJK
+C
+C
+      DATA PI/3.141593/
+C
+      A=1.
+      INTER=0
+      IF(ITL.EQ.1) VKE=VK(JE)
+      RHOJ=VKE*RJ
+      RHOJK=VKE*RJK
+      HLM1=(1.,0.)
+      HLM2=(1.,0.)
+      HLM3=(1.,0.)
+      HLM4=(1.,0.)
+      IEM=1
+      CSTH=COS(BETA)
+      IF((IFTHET.EQ.0).OR.(THRJ.LT.0.0001)) THEN
+        INTER=1
+        BLMU=SQRT(4.*PI/FLOAT(2*L+1))*CEXP((0.,-1.)*M*(PHIRJ-PI))
+      ENDIF
+      CALL PLM(CSTH,PLMM,LMAX(JAT,JE))
+      IF(ISPHER.EQ.0) NO1=0
+      IF(ISPHER.EQ.1) THEN
+        IF(NO.EQ.8) THEN
+          NO1=LMAX(JAT,JE)+1
+        ELSE
+          NO1=NO
+        ENDIF
+        CALL POLHAN(ISPHER,NO1,LMAX(JAT,JE),RHOJ,HLM)
+         IF(IEM.EQ.0) THEN
+          HLM4=HLM(0,L)
+        ENDIF
+        IF(RJK.GT.0.0001) THEN
+          NDUM=0
+          CALL POLHAN(ISPHER,NDUM,LMAX(JAT,JE),RHOJK,HLN)
+        ENDIF
+        CALL DJMN(THRJ,D,L)
+        A1=ABS(D(0,M,L))
+        IF(((A1.LT.0.0001).AND.(IFTHET.EQ.1)).AND.(INTER.EQ.0)) RETURN 1
+     &
+      ENDIF
+      MUMAX=MIN0(L,NO1)
+      SMU=(0.,0.)
+      DO 10 MU=0,MUMAX
+        IF(MOD(MU,2).EQ.0) THEN
+          B=1.
+        ELSE
+          B=-1.
+          IF(SIN(BETA).LT.0.) THEN
+            A=-1.
+          ENDIF
+        ENDIF
+        IF(ISPHER.LE.1) THEN
+          ALMU=(1.,0.)
+          C=1.
+        ENDIF
+        IF(ISPHER.EQ.0) GOTO 40
+        IF(INTER.EQ.0) BLMU=CMPLX(D(M,0,L))
+        IF(MU.GT.0) THEN
+          C=B*FLOAT(L+L+1)/EXPF(MU,L)
+          ALMU=(D(M,MU,L)*CEXP((0.,-1.)*MU*GAMMA)+B*
+     *          CEXP((0.,1.)*MU*GAMMA)*D(M,-MU,L))/BLMU
+        ELSE
+          C=1.
+          ALMU=CMPLX(D(M,0,L))/BLMU
+        ENDIF
+  40    SNU=(0.,0.)
+        NU1=INT(0.5*(NO1-MU)+0.0001)
+        NUMAX=MIN0(NU1,L-MU)
+        DO 20 NU=0,NUMAX
+          SLP=(0.,0.)
+          LPMIN=MAX0(MU,NU)
+          DO 30 LP=LPMIN,LMAX(JAT,JE)
+            IF(ISPHER.EQ.1) THEN
+              HLM1=HLM(NU,LP)
+              IF(RJK.GT.0.0001) HLM3=HLN(0,LP)
+            ENDIF
+            SLP=SLP+FLOAT(2*LP+1)*TL(LP,1,JAT,JE)*HLM1*PLMM(LP,MU)*HLM3
+  30      CONTINUE
+          IF(ISPHER.EQ.1) THEN
+            HLM2=HLM(MU+NU,L)
+          ENDIF
+          SNU=SNU+SLP*HLM2
+  20    CONTINUE
+        SMU=SMU+SNU*C*ALMU*A*B
+  10  CONTINUE
+      FSPH=SMU/(VKE*HLM4)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/inv_mat_ms2_la.f

@@ -0,0 +1,192 @@
+C
+C=======================================================================
+C
+      SUBROUTINE INV_MAT_MS(JE,TAU)
+C
+C   This subroutine stores the multiple scattering matrix and invert
+C     it to obtain the scattering path operator exactly.
+C
+C                           (Photoelectron case)
+C
+C                                         Last modified : 24 Apr 2007
+C
+C      INCLUDE 'spec.inc'
+      USE DIM_MOD
+      USE COOR_MOD
+      USE INIT_L_MOD
+      USE TRANS_MOD
+C
+C      PARAMETER(NLTWO=2*NL_M)
+C
+      COMPLEX*16 HL1(0:2*NL_M),SM(LINMAX*NATCLU_M,LINMAX*NATCLU_M)
+      COMPLEX*16 SUM_L,ONEC,IC,ZEROC,WORK(4*LINMAX*NATCLU_M)
+      COMPLEX*16 YLM(0:2*NL_M,-2*NL_M:2*NL_M),TLJ,TLK,EXPKJ
+C
+      COMPLEX TAU(LINMAX*LINMAX*NATCLU_M*NATCLU_M)
+C
+C
+      REAL*8 PI,ATTKJ,GNT(0:N_GAUNT),XKJ,YKJ,ZKJ,RKJ,ZDKJ,KRKJ
+C
+      INTEGER IPIV(LINMAX*NATCLU_M)
+C
+C
+      DATA PI /3.1415926535898D0/
+C
+      ONEC=(1.D0,0.D0)
+      IC=(0.D0,1.D0)
+      ZEROC=(0.D0,0.D0)
+      IBESS=3
+C
+C  Construction of the multiple scattering matrix MS = (I-GoT).
+C    Elements are stored using a linear index LINJ representing
+C    (J,LJ)
+C
+      JLIN=0
+      DO JTYP=1,N_PROT
+        NBTYPJ=NATYP(JTYP)
+        LMJ=LMAX(JTYP,JE)
+        DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+          XJ=SYM_AT(1,JATL)
+          YJ=SYM_AT(2,JATL)
+          ZJ=SYM_AT(3,JATL)
+C
+          DO LJ=0,LMJ
+            ILJ=LJ*LJ+LJ+1
+            TLJ=DCMPLX(TL(LJ,1,JTYP,JE))
+            DO MJ=-LJ,LJ
+              INDJ=ILJ+MJ
+              JLIN=JLIN+1
+C
+              KLIN=0
+              DO KTYP=1,N_PROT
+                NBTYPK=NATYP(KTYP)
+                LMK=LMAX(KTYP,JE)
+                DO KNUM=1,NBTYPK
+                  KATL=NCORR(KNUM,KTYP)
+                  IF(KATL.NE.JATL) THEN
+                    XKJ=DBLE(SYM_AT(1,KATL)-XJ)
+                    YKJ=DBLE(SYM_AT(2,KATL)-YJ)
+                    ZKJ=DBLE(SYM_AT(3,KATL)-ZJ)
+                    RKJ=DSQRT(XKJ*XKJ+YKJ*YKJ+ZKJ*ZKJ)
+                    KRKJ=DBLE(VK(JE))*RKJ
+                    ATTKJ=DEXP(-DIMAG(DCMPLX(VK(JE)))*
+     &              RKJ)
+                    EXPKJ=(XKJ+IC*YKJ)/RKJ
+                    ZDKJ=ZKJ/RKJ
+                    CALL SPH_HAR2(2*NL_M,ZDKJ,EXPKJ,YLM,
+     &              LMJ+LMK)
+                    CALL BESPHE2(LMJ+LMK+1,IBESS,KRKJ,
+     &              HL1)
+                  ENDIF
+C
+                  DO LK=0,LMK
+                    ILK=LK*LK+LK+1
+                    L_MIN=ABS(LK-LJ)
+                    L_MAX=LK+LJ
+                    TLK=DCMPLX(TL(LK,1,KTYP,JE))
+                    DO MK=-LK,LK
+                      INDK=ILK+MK
+                      KLIN=KLIN+1
+                      SM(KLIN,JLIN)=ZEROC
+                      SUM_L=ZEROC
+                      IF(KATL.NE.JATL) THEN
+                        CALL GAUNT2(LK,MK,LJ,MJ,GNT)
+C
+                        DO L=L_MIN,L_MAX,2
+                          M=MJ-MK
+                          IF(ABS(M).LE.L) THEN
+                            SUM_L=SUM_L+(IC**L)*
+     &                      HL1(L)*YLM(L,M)*GNT(L)
+                          ENDIF
+                        ENDDO
+                        SUM_L=SUM_L*ATTKJ*4.D0*PI*IC
+                      ELSE
+                        SUM_L=ZEROC
+                      ENDIF
+C
+                      IF(KLIN.EQ.JLIN) THEN
+                         SM(KLIN,JLIN)=ONEC-TLK*
+     &                   SUM_L
+                      ELSE
+                         SM(KLIN,JLIN)=-TLK*SUM_L
+                      ENDIF
+C
+                    ENDDO
+                  ENDDO
+C
+                ENDDO
+              ENDDO
+C
+            ENDDO
+          ENDDO
+C
+        ENDDO
+      ENDDO
+C
+      LWORK=JLIN
+C
+C   Inversion of the multiple scattering matrix MS and
+C                  multiplication by T
+C
+      CALL ZGETRF(JLIN,JLIN,SM,LINMAX*NATCLU_M,IPIV,INFO1)
+      IF(INFO1.NE.0) THEN
+         WRITE(6,*) '     --->  INFO1 =',INFO1
+      ELSE
+        CALL ZGETRI(JLIN,SM,LINMAX*NATCLU_M,IPIV,WORK,LWORK,INFO)
+        IF(INFO.NE.0) THEN
+          WRITE(6,*) '    --->  WORK(1),INFO =',WORK(1),INFO
+        ENDIF
+      ENDIF
+C
+C   Storage of the Tau matrix
+C
+      LIN=0
+C
+      JLIN=0
+      DO JTYP=1,N_PROT
+        NBTYPJ=NATYP(JTYP)
+        LMJ=LMAX(JTYP,JE)
+        DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+C
+          KLIN=0
+          DO KTYP=1,N_PROT
+            NBTYPK=NATYP(KTYP)
+            LMK=LMAX(KTYP,JE)
+            DO KNUM=1,NBTYPK
+              KATL=NCORR(KNUM,KTYP)
+C
+              DO LJ=0,LMJ
+                ILJ=LJ*LJ+LJ+1
+                TLJ=DCMPLX(TL(LJ,1,JTYP,JE))
+                DO MJ=-LJ,LJ
+                  INDJ=ILJ+MJ
+                  JLIN=JLIN+1
+C
+                  DO LK=0,LMK
+                    ILK=LK*LK+LK+1
+                    DO MK=-LK,LK
+                      INDK=ILK+MK
+                      KLIN=KLIN+1
+                      LIN=LIN+1
+                      TAU(LIN)=CMPLX(SM(KLIN,JLIN)*TLJ)
+                    ENDDO
+                  ENDDO
+                  KLIN=KLIN-INDK
+C
+                ENDDO
+              ENDDO
+              KLIN=KLIN+INDK
+              JLIN=JLIN-INDJ
+C
+            ENDDO
+          ENDDO
+          JLIN=JLIN+INDJ
+C
+        ENDDO
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/leddif_mi.f

@@ -0,0 +1,915 @@
+C
+C
+C=======================================================================
+C
+      SUBROUTINE LEDDIF_MI(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOK,
+     &NATCLU,NFICHLEC,JFICH,NP)
+C
+C   This subroutine computes the LEED formula in the spin-independent
+C           case.
+C
+C   The calculation is performed using a matrix inversion for the
+C           expression of the scattering path operator
+C
+C   The matrix inversion is performed using the LAPACK inversion
+C           routines for a general complex matrix
+C
+C                                        Last modified : 26 Apr 2013
+C
+C      INCLUDE 'spec.inc'
+      USE DIM_MOD
+      USE ALGORITHM_MOD
+      USE AMPLI_MOD
+      USE APPROX_MOD
+      USE COOR_MOD, NTCLU => NATCLU, NTP => NATYP
+      USE DEBWAL_MOD
+      USE DIRECT_MOD, RTHETA => RTHEXT
+      USE EXTREM_MOD
+      USE FIXSCAN_MOD
+      USE INFILES_MOD
+      USE INUNITS_MOD
+      USE INIT_L_MOD
+      USE INIT_J_MOD
+      USE LIMAMA_MOD
+      USE MOYEN_MOD
+      USE OUTFILES_MOD
+      USE OUTUNITS_MOD
+      USE PARCAL_MOD
+      USE RESEAU_MOD
+      USE SPIN_MOD
+      USE TESTPB_MOD
+      USE TESTS_MOD
+      USE TRANS_MOD
+      USE TYPCAL_MOD
+      USE TYPEM_MOD
+      USE TYPEXP_MOD
+      USE VALIN_MOD
+      USE VALIN_AV_MOD
+      USE VALFIN_MOD
+C
+      REAL BEAM(3),AXE(3),EPS(3),DIRBEAM(3),BEAMDIR(3),EMET(3)
+C
+      COMPLEX IC,ONEC,ZEROC,COEF
+      COMPLEX TLT(0:NT_M,4,NATM,NE_M)
+      COMPLEX TAU(LINMAX*LINMAX*NATCLU_M*NATCLU_M)
+      COMPLEX YLMI(LINMAX)
+      COMPLEX YLMJ(LINMAX)
+      COMPLEX SLJDIF,SJDIF
+      COMPLEX SLIDIF,SLIDIR,SIDIF,SIDIR
+      COMPLEX RHOK(NE_M,NATM,0:18,2,NSPIN2_M),RD
+      COMPLEX ATT_MI,ATT_MI2,ATT_MJ
+C
+      DIMENSION VAL(NATCLU_M),NATYP(NATM)
+      DIMENSION R_L(9),COORD(3,NATCLU_M)
+C
+C
+C
+      CHARACTER*7 STAT
+      CHARACTER*13 OUTDATA1,OUTDATA2
+C
+C
+      CHARACTER*24 OUTFILE
+      CHARACTER*24 AMPFILE
+C
+C
+      DATA PI,PIS180,CONV /3.141593,0.017453,0.512314/
+      DATA FINSTRUC,CVECT,SMALL /0.007297,1.0,0.0001/
+C
+      ALGO1='MI'
+      ALGO2='  '
+      ALGO3='  '
+      ALGO4='  '
+C
+      I_DIR=0
+      NSET=1
+      JEL=1
+      JEMET=1
+      OUTDATA1='CROSS-SECTION'
+      IF(I_AMP.EQ.1) THEN
+        I_MI=1
+        OUTDATA2='MS AMPLITUDES'
+      ELSE
+        I_MI=0
+      ENDIF
+C
+C   The first atom in the list taken as the origin
+C
+      EMET(1)=SYM_AT(1,1)
+      EMET(2)=SYM_AT(2,1)
+      EMET(3)=SYM_AT(3,1)
+C
+      IF(SPECTRO.EQ.'LED') THEN
+        IOUT=IUO2
+        OUTFILE=OUTFILE2
+        STAT='UNKNOWN'
+        IF(I_MI.EQ.1) THEN
+          IOUT2=IUSCR2+1
+          N_DOT=1
+          DO J_CHAR=1,24
+            IF(OUTFILE(J_CHAR:J_CHAR).EQ.'.') GOTO 888
+            N_DOT=N_DOT+1
+          ENDDO
+  888     CONTINUE
+          AMPFILE=OUTFILE(1:N_DOT)//'amp'
+          OPEN(UNIT=IOUT2, FILE=AMPFILE, STATUS=STAT)
+        ENDIF
+      ENDIF
+C
+C  Position of the initial beam when the analyzer is along the z axis :
+C                  (X_BEAM_Z,Y_BEAM_Z,Z_BEAM_Z)
+C
+      RTHBEAM=THBEAM*PIS180
+      RPHBEAM=PHBEAM*PIS180
+      X_BEAM_Z=SIN(RTHBEAM)*COS(RPHBEAM)
+      Y_BEAM_Z=SIN(RTHBEAM)*SIN(RPHBEAM)
+      Z_BEAM_Z=COS(RTHBEAM)
+C
+      IF(IMOD.EQ.0) THEN
+C
+C  The analyzer is rotated
+C
+        DIRBEAM(1)=X_BEAM_Z
+        DIRBEAM(2)=Y_BEAM_Z
+        DIRBEAM(3)=Z_BEAM_Z
+      ELSE
+C
+C  The sample is rotated ---> beam and analyzer rotated
+C
+        IF(I_EXT.EQ.0) THEN
+          RTH0=THETA0*PIS180
+          RPH0=PHI0*PIS180
+          RTH=RTH0
+          RPH=RPH0
+C
+C  R_L is the rotation matrix from 0z to (THETA0,PHI0) expressed as
+C    a function of the Euler angles ALPHA=PHI0, BETA=THETA0, GAMMA=-PHI0
+C    It is stored as (1 2 3)
+C                    (4 5 6)
+C                    (7 8 9)
+C
+          R_L(1)=COS(RTH0)*COS(RPH0)*COS(RPH0)+SIN(RPH0)*SIN(RPH0)
+          R_L(2)=COS(RTH0)*SIN(RPH0)*COS(RPH0)-SIN(RPH0)*COS(RPH0)
+          R_L(3)=SIN(RTH0)*COS(RPH0)
+          R_L(4)=COS(RTH0)*SIN(RPH0)*COS(RPH0)-SIN(RPH0)*COS(RPH0)
+          R_L(5)=COS(RTH0)*SIN(RPH0)*SIN(RPH0)+COS(RPH0)*COS(RPH0)
+          R_L(6)=SIN(RTH0)*SIN(RPH0)
+          R_L(7)=-SIN(RTH0)*COS(RPH0)
+          R_L(8)=-SIN(RTH0)*SIN(RPH0)
+          R_L(9)=COS(RTH0)
+C
+C  Position of the beam when the analyzer is along (THETA0,PHI0) : BEAM(3)
+C
+          BEAM(1)=X_BEAM_Z*R_L(1)+Y_BEAM_Z*R_L(2)+Z_BEAM_Z*R_L(3)
+          BEAM(2)=X_BEAM_Z*R_L(4)+Y_BEAM_Z*R_L(5)+Z_BEAM_Z*R_L(6)
+          BEAM(3)=X_BEAM_Z*R_L(7)+Y_BEAM_Z*R_L(8)+Z_BEAM_Z*R_L(9)
+C
+        ENDIF
+      ENDIF
+C
+      IC=(0.,1.)
+      ONEC=(1.,0.)
+      ZEROC=(0.,0.)
+      ATTSJ=1.
+      ATTSI=1.
+      ZSURF=VAL(1)
+C
+      IF((ISOM.EQ.0).OR.(JFICH.EQ.1)) THEN
+        OPEN(UNIT=IOUT, FILE=OUTFILE, STATUS=STAT)
+      ENDIF
+C
+C  Writing the headers in the output file
+C
+      CALL HEADERS(IOUT)
+C
+      IF((ISOM.EQ.0).OR.((ISOM.GT.0).AND.(JFICH.EQ.1))) THEN
+        WRITE(IOUT,12) SPECTRO,OUTDATA1
+        WRITE(IOUT,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,
+     &  IE,IPH_1,I_EXT
+        IF(I_MI.EQ.1) THEN
+          WRITE(IOUT2,12) SPECTRO,OUTDATA2
+          WRITE(IOUT2,12) STEREO
+          WRITE(IOUT2,19) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,
+     &    ITHETA,IE,IPH_1,I_EXT
+          WRITE(IOUT2,20) PHI0,THETA0,PHI1,THETA1,NONVOL(1)
+        ENDIF
+      ENDIF
+C
+      IF(ISOM.EQ.0) THEN
+        WRITE(IOUT,79) NPLAN,NEMET,NTHETA,NPHI,NE
+        IF(I_MI.EQ.1) THEN
+          WRITE(IOUT2,79) NPLAN,NEMET,NTHETA,NPHI,NE
+        ENDIF
+      ELSEIF((ISOM.NE.0).AND.(JFICH.EQ.1)) THEN
+        WRITE(IOUT,11) NTHETA,NPHI,NE
+        IF(I_MI.EQ.1) THEN
+          WRITE(IOUT2,11) NTHETA,NPHI,NE
+        ENDIF
+      ENDIF
+      IJK=0
+C
+C   Loop over the planes
+C
+      DO JPLAN=1,NPLAN
+       Z=VAL(JPLAN)
+       IF((IPHA.EQ.1).OR.(IPHA.EQ.2)) THEN
+         DZZEM=ABS(Z-ZEM)
+         IF(DZZEM.LT.SMALL) GOTO 10
+         GOTO 1
+       ENDIF
+ 10    CONTINUE
+C
+       IF(ISOM.EQ.1) NP=JPLAN
+C
+C   Loop over the energies
+C
+       DO JE=1,NE
+        FMIN(0)=1.
+        FMAX(0)=1.
+        IF(NE.GT.1) THEN
+          ECIN=E0+FLOAT(JE-1)*(EFIN-E0)/FLOAT(NE-1)
+        ELSEIF(NE.EQ.1) THEN
+          ECIN=E0
+        ENDIF
+        IF(I_TEST.NE.1) THEN
+          CFM=16.*PI*PI
+        ELSE
+          CFM=1.
+        ENDIF
+        CALL LPM(ECIN,XLPM,*6)
+        XLPM1=XLPM/A
+        IF(IPRINT.GT.0) WRITE(IUO1,56) A,XLPM1
+        IF((IPRINT.GT.0).AND.(IBAS.EQ.1)) THEN
+          IF(I_TEST.NE.2) WRITE(IUO1,57) COUPUR
+        ENDIF
+        IF(ITL.EQ.0) THEN
+          VK(JE)=SQRT(ECIN+VINT)*CONV*A*(1.,0.)
+          VK2(JE)=CABS(VK(JE)*VK(JE))
+        ENDIF
+        GAMMA=1./(2.*XLPM1)
+        IF(IPOTC.EQ.0) THEN
+          VK(JE)=VK(JE)+IC*GAMMA
+        ENDIF
+        IF(I_TEST.NE.1) THEN
+          VKR=REAL(VK(JE))
+        ELSE
+          VKR=1.
+        ENDIF
+        IF(I_MI.EQ.1) THEN
+          WRITE(IOUT2,21) ECIN,VKR*CFM
+        ENDIF
+        IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) THEN
+          IF(IDCM.GE.1) WRITE(IUO1,22)
+          DO JAT=1,N_PROT
+            IF(IDCM.EQ.0) THEN
+              XK2UJ2=VK2(JE)*UJ2(JAT)
+            ELSE
+              XK2UJ2=VK2(JE)*UJ_SQ(JAT)
+              WRITE(IUO1,23) JAT,UJ_SQ(JAT)*A*A
+            ENDIF
+            CALL DWSPH(JAT,JE,XK2UJ2,TLT,ISPEED)
+            DO LAT=0,LMAX(JAT,JE)
+              TL(LAT,1,JAT,JE)=TLT(LAT,1,JAT,JE)
+            ENDDO
+          ENDDO
+        ENDIF
+        IF(ABS(I_EXT).GE.1) THEN
+          OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+          READ(IUI6,13) I_DIR,NSET,N_DUM1
+          READ(IUI6,14) I_DUM1,N_DUM2,N_DUM3
+        ENDIF
+C
+C   Largest angular momenum value (used to compute
+C        the spherical harmonics)
+C
+        LM_MAX=0
+        DO JTYP=1,N_PROT
+         LMJ=LMAX(JTYP,JE)
+         LM_MAX=MAX(LM_MAX,LMJ)
+        ENDDO
+C
+C   Initialization of TAU(LIN)
+C
+        LIN=0
+        DO JTYP=1,N_PROT
+          NBTYPJ=NATYP(JTYP)
+          LMJ=LMAX(JTYP,JE)
+          DO JNUM=1,NBTYPJ
+            DO LJ=0,LMJ
+              DO MJ=-LJ,LJ
+                DO ITYP=1,N_PROT
+                  NBTYPI=NATYP(ITYP)
+                  LMI=LMAX(ITYP,JE)
+                  DO INUM=1,NBTYPI
+                    DO LI=0,LMI
+                      DO MI=-LI,LI
+                        LIN=LIN+1
+                        TAU(LIN)=ZEROC
+                      ENDDO
+                    ENDDO
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDDO
+C
+C   Matrix inversion for the calculation of TAU
+C
+        IF(I_TEST.EQ.2) GOTO 666
+        CALL INV_MAT_MS(JE,TAU)
+ 666    CONTINUE
+C
+C    Calculation of the LEED formula
+C
+C
+C    Loop over the 'fixed' angle
+C
+  15    DO J_FIXED=1,N_FIXED
+         IF(N_FIXED.GT.1) THEN
+           IF(I_EXT.EQ.0) THEN
+             FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
+             XINCRF=FLOAT(J_FIXED-1)*FIX_STEP
+           ELSE
+             XINCRF=0.
+           ENDIF
+         ELSEIF(N_FIXED.EQ.1) THEN
+           XINCRF=0.
+         ENDIF
+         IF(ABS(I_EXT).GE.1) THEN
+           READ(IUI6,86) JSET,JLINE,THD,PHD
+           IF(I_EXT.EQ.-1) BACKSPACE IUI6
+           THETA0=THD
+           PHI0=PHD
+         ENDIF
+         IF(IPH_1.EQ.1) THEN
+            IF(I_EXT.EQ.0) THEN
+              DPHI=PHI0+XINCRF
+            ELSE
+              DPHI=PHD
+            ENDIF
+            RPHI=DPHI*PIS180
+            IF(IPRINT.GT.0) WRITE(IUO1,66) DPHI
+         ELSE
+            ISAUT=0
+            IF(I_EXT.EQ.0) THEN
+              DTHETA=THETA0+XINCRF
+            ELSE
+              DTHETA=THD
+            ENDIF
+            RTHETA=DTHETA*PIS180
+            IF(ABS(DTHETA).GT.90.) ISAUT=ISAUT+1
+            IF(I_EXT.GE.1) ISAUT=0
+            IF(I_TEST.EQ.2)  ISAUT=0
+            IF(ISAUT.GT.0) GOTO 8
+            IF(IPRINT.GT.0) WRITE(IUO1,65) DTHETA
+            IF((IPRINT.GT.0).AND.(I_TEST.NE.2)) WRITE(IUO1,59)
+            IF((IPRINT.EQ.1).AND.(I_TEST.NE.2)) WRITE(IUO1,60)
+C
+C  THETA-dependent number of PHI points for stereographic
+C     representation (to obtain a uniform sampling density).
+C     (Courtesy of J. Osterwalder - University of Zurich)
+C
+            IF(STEREO.EQ.'YES') THEN
+              N_SCAN=INT((SCAN1-SCAN0)*SIN(RTHETA)/FIX_STEP+
+     &        SMALL)+1
+            ENDIF
+C
+         ENDIF
+         IF((N_FIXED.GT.1).AND.(IMOD.EQ.1)) THEN
+C
+C  When there are several sets of scans (N_FIXED > 1),
+C   the initial position BEAM of the beam is recalculated
+C      for each initial position (RTH,RPH) of the analyzer
+C
+           IF(IPH_1.EQ.1) THEN
+             RTH=THETA0*PIS180
+             RPH=RPHI
+           ELSE
+             RTH=RTHETA
+             RPH=PHI0*PIS180
+           ENDIF
+C
+           R_L(1)=COS(RTH)*COS(RPH)
+           R_L(2)=-SIN(RPH)
+           R_L(3)=SIN(RTH)*COS(RPH)
+           R_L(4)=COS(RTH)*SIN(RPH)
+           R_L(5)=COS(RPH)
+           R_L(6)=SIN(RTH)*SIN(RPH)
+           R_L(7)=-SIN(RTH)
+           R_L(8)=0.
+           R_L(9)=COS(RTH)
+C
+           BEAM(1)=X_BEAM_Z*R_L(1)+Y_BEAM_Z*R_L(2)+Z_BEAM_Z*R_L(3)
+           BEAM(2)=X_BEAM_Z*R_L(4)+Y_BEAM_Z*R_L(5)+Z_BEAM_Z*R_L(6)
+           BEAM(3)=X_BEAM_Z*R_L(7)+Y_BEAM_Z*R_L(8)+Z_BEAM_Z*R_L(9)
+         ENDIF
+C
+C    Loop over the scanned angle
+C
+         DO J_SCAN=1,N_SCAN
+          IF(N_SCAN.GT.1) THEN
+            XINCRS=FLOAT(J_SCAN-1)*(SCAN1-SCAN0)/FLOAT(N_SCAN-1)
+          ELSEIF(N_SCAN.EQ.1) THEN
+            XINCRS=0.
+          ENDIF
+          IF(I_EXT.EQ.-1) THEN
+            READ(IUI6,86) JSET,JLINE,THD,PHD
+            BACKSPACE IUI6
+          ENDIF
+          IF(IPH_1.EQ.1) THEN
+            ISAUT=0
+            IF(I_EXT.EQ.0) THEN
+              DTHETA=THETA0+XINCRS
+            ELSE
+              DTHETA=THD
+            ENDIF
+            RTHETA=DTHETA*PIS180
+            IF(ABS(DTHETA).GT.90.) ISAUT=ISAUT+1
+            IF(I_EXT.GE.1) ISAUT=0
+            IF(I_TEST.EQ.2)  ISAUT=0
+            IF(ISAUT.GT.0) GOTO 8
+            IF(IPRINT.GT.0) WRITE(IUO1,65) DTHETA
+            IF((IPRINT.GT.0).AND.(I_TEST.NE.2)) WRITE(IUO1,59)
+            IF((IPRINT.EQ.1).AND.(I_TEST.NE.2)) WRITE(IUO1,60)
+          ELSE
+            IF(I_EXT.EQ.0) THEN
+              DPHI=PHI0+XINCRS
+            ELSE
+              DPHI=PHD
+            ENDIF
+            RPHI=DPHI*PIS180
+            IF(IPRINT.GT.0) WRITE(IUO1,66) DPHI
+          ENDIF
+C
+C  Loop over the sets of directions to average over (for gaussian average)
+C
+C
+          SSETDIF=0.
+          SSETDIR=0.
+C
+          SSET2DIF=0.
+          SSET2DIR=0.
+C
+          IF(I_EXT.EQ.-1) THEN
+            JREF=INT(NSET)/2+1
+          ELSE
+            JREF=1
+          ENDIF
+C
+          DO J_SET=1,NSET
+           IF(I_EXT.EQ.-1) THEN
+             READ(IUI6,86) JSET,JLINE,THD,PHD,W
+             DTHETA=THD
+             DPHI=PHD
+             RTHETA=DTHETA*PIS180
+             RPHI=DPHI*PIS180
+C
+C  Here, there are several sets of scans (NSET > 1), so
+C   the initial position BEAM of the beam must be
+C   recalculated for each initial position of the analyzer
+C
+             RTH=TH_0(J_SET)*PIS180
+             RPH=PH_0(J_SET)*PIS180
+C
+             IF(IMOD.EQ.1) THEN
+               R_L(1)=COS(RTH)*COS(RPH)
+               R_L(2)=-SIN(RPH)
+               R_L(3)=SIN(RTH)*COS(RPH)
+               R_L(4)=COS(RTH)*SIN(RPH)
+               R_L(5)=COS(RPH)
+               R_L(6)=SIN(RTH)*SIN(RPH)
+               R_L(7)=-SIN(RTH)
+               R_L(8)=0.
+               R_L(9)=COS(RTH)
+C
+               BEAM(1)=X_BEAM_Z*R_L(1)+Y_BEAM_Z*R_L(2)+
+     &         Z_BEAM_Z*R_L(3)
+               BEAM(2)=X_BEAM_Z*R_L(4)+Y_BEAM_Z*R_L(5)+
+     &         Z_BEAM_Z*R_L(6)
+               BEAM(3)=X_BEAM_Z*R_L(7)+Y_BEAM_Z*R_L(8)+
+     &         Z_BEAM_Z*R_L(9)
+C
+             ENDIF
+           ELSE
+             W=1.
+           ENDIF
+C
+           IF(I_EXT.EQ.-1) PRINT 89
+C
+           CALL DIRAN(VINT,ECIN,JEL)
+C
+           IF(J_SET.EQ.JREF) THEN
+             DTHETAP=DTHETA
+             DPHIP=DPHI
+           ENDIF
+C
+           IF(I_EXT.EQ.-1) THEN
+             WRITE(IUO1,88) DTHETA,DPHI
+           ENDIF
+C
+C     ..........          Case IMOD=1 only          ..........
+C
+C  Calculation of the position of the beam when the analyzer is at
+C   (THETA,PHI). DIRBEAM is the direction of the beam and its initial
+C   value (at (THETA0,PHI0)) is BEAM. AXE is the direction of the theta
+C   rotation axis and EPS is defined so that (AXE,DIRBEAM,EPS) is a
+C   direct orthonormal basis. The transform of a vector R by a rotation
+C   of OMEGA about AXE is then given by
+C
+C     R' = R COS(OMEGA) + (AXE.R)(1-COS(OMEGA)) AXE + (AXE^R) SIN(OMEGA)
+C
+C   Here, DIRANA is the internal direction of the analyzer and ANADIR
+C                      its external position
+C
+C   Note that when the initial position of the analyzer is (RTH,RPH)
+C    which coincides with (RTH0,RPH0) only for the first fixed angle
+C
+           IF(IMOD.EQ.1) THEN
+             IF(ITHETA.EQ.1) THEN
+               AXE(1)=-SIN(RPH)
+               AXE(2)=COS(RPH)
+               AXE(3)=0.
+               RANGLE=RTHETA-RTH
+             ELSEIF(IPHI.EQ.1) THEN
+               AXE(1)=0.
+               AXE(2)=0.
+               AXE(3)=1.
+               RANGLE=RPHI-RPH
+              ENDIF
+             CALL PRVECT(AXE,BEAM,EPS,CVECT)
+             PRS=PRSCAL(AXE,BEAM)
+             IF(J_SCAN.EQ.1) THEN
+               DIRBEAM(1)=BEAM(1)
+               DIRBEAM(2)=BEAM(2)
+               DIRBEAM(3)=BEAM(3)
+             ELSE
+               DIRBEAM(1)=BEAM(1)*COS(RANGLE)+PRS*(1.-COS(
+     &         RANGLE))*AXE(1)+SIN(RANGLE)*EPS(1)
+               DIRBEAM(2)=BEAM(2)*COS(RANGLE)+PRS*(1.-COS(
+     &         RANGLE))*AXE(2)+SIN(RANGLE)*EPS(2)
+               DIRBEAM(3)=BEAM(3)*COS(RANGLE)+PRS*(1.-COS(
+     &         RANGLE))*AXE(3)+SIN(RANGLE)*EPS(3)
+             ENDIF
+           ENDIF
+           IF(DIRBEAM(3).GT.1.) DIRBEAM(3)=1.
+           IF(DIRBEAM(3).LT.-1.) DIRBEAM(3)=-1.
+           THETABEAM=ACOS(DIRBEAM(3))
+           IF(I_TEST.EQ.2) THETABEAM=-THETABEAM
+           COEF=DIRBEAM(1)+IC*DIRBEAM(2)
+           CALL ARCSIN(COEF,DIRBEAM(3),PHIBEAM)
+C
+C    Internal direction of the incoming beam BEAMDIR
+C            (DIRBEAM is the external direction)
+C
+           CALL REFRAC(VINT,ECIN,THETABEAM,BEAMTHETA)
+           BEAMDIR(1)=SIN(BEAMTHETA)*COS(PHIBEAM)
+           BEAMDIR(2)=SIN(BEAMTHETA)*SIN(PHIBEAM)
+           BEAMDIR(3)=COS(BEAMTHETA)
+C
+           CALL HARSPH3(NL_M,BEAMTHETA,-PHIBEAM,YLMI,LM_MAX)
+C
+           ANABEAM=ANADIR(1,1)*DIRBEAM(1) + ANADIR(2,1)*DIRBEAM(2)
+     &      +ANADIR(3,1)*DIRBEAM(3)
+C
+           IF(IPRINT.GT.0) THEN
+               WRITE(IUO1,63) (DIRANA(J,1),J=1,3),(BEAMDIR(K),
+     &         K=1,3),ANABEAM
+           ENDIF
+           IF(I_EXT.EQ.-1) PRINT 89
+C
+           SRDIF=0.
+           SRDIR=0.
+C
+C    Loop over the different directions of the analyzer contained in a cone
+C
+           DO JDIR=1,NDIR
+            SIDIF=ZEROC
+            SIDIR=ZEROC
+            CALL HARSPH3(NL_M,THETAR(JDIR),PHIR(JDIR),YLMJ,
+     &      LM_MAX)
+C
+C    Loop over the first atom I encountered by the electron beam
+C                  when entering the solid
+C
+            LIN=0
+            DO ITYP=1,N_PROT
+             NBTYPI=NATYP(ITYP)
+             LMI=LMAX(ITYP,JE)
+             INDI_M=(LMI+1)*(LMI+1)
+             DO INUM=1,NBTYPI
+              IATL=NCORR(INUM,ITYP)
+              XOI=SYM_AT(1,IATL)-EMET(1)
+              YOI=SYM_AT(2,IATL)-EMET(2)
+              ZOI=SYM_AT(3,IATL)-EMET(3)
+              ROI=SQRT(XOI*XOI+YOI*YOI+ZOI*ZOI)
+              ZSURFI=VAL(1)-SYM_AT(3,IATL)
+              IF(IATTS.EQ.1) THEN
+                ATTSI=EXP(-ZSURFI*GAMMA/COS(BEAMTHETA))
+              ENDIF
+              IF(ROI.GT.SMALL) THEN
+                CSTHIR=(XOI*BEAMDIR(1)+YOI*BEAMDIR(2)+ZOI*
+     &          BEAMDIR(3))/ROI
+                CTROIS1=ZOI/ROI
+                CSTHIR2=(XOI*(DIRANA(1,JDIR)-BEAMDIR(1))+YOI*
+     &          (DIRANA(2,JDIR)-BEAMDIR(2))+ZOI*(DIRANA(3,JDIR)-
+     &          BEAMDIR(3)))/ROI
+              ELSE
+                CSTHIR=0.
+                CTROIS1=0.
+                CSTHIR2=0.
+              ENDIF
+              IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 78
+              IF(CTROIS1.GT.1.)  THEN
+                CTROIS1=1.
+              ELSEIF(CTROIS1.LT.-1.) THEN
+                CTROIS1=-1.
+              ENDIF
+              IF(IDCM.GE.1) THEN
+                UJ2(ITYP)=UJ_SQ(ITYP)
+              ENDIF
+              IF(ABS(ZSURFI).LE.SMALL) THEN
+                IF(ABS(CSTHIR-1.).GT.SMALL) THEN
+                  CSKZ2I=(BEAMDIR(3)-CTROIS1)*(BEAMDIR(3)-
+     &            CTROIS1)/(2.-2.*CSTHIR)
+                ELSE
+                  CSKZ2I=1.
+                ENDIF
+                UII=UJ2(ITYP)*(1.+CSKZ2I*(RSJ-1.))
+              ELSE
+                UII=UJ2(ITYP)
+              ENDIF
+              IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
+                XK2UI2=VK2(JE)*UII
+                CALL DWSPH(ITYP,JE,XK2UI2,TLT,ISPEED)
+              ENDIF
+ 78           IF(IDWSPH.EQ.1) THEN
+                DWTER=1.
+                DWTER2=1.
+              ELSE
+                DWTER=EXP(-VK2(JE)*UII*(1.-CSTHIR))
+                DWTER2=EXP(-VK2(JE)*UII*(1.-CSTHIR2))
+              ENDIF
+              ATT_MI=ATTSI*DWTER*CEXP(IC*VK(JE)*ROI*CSTHIR)
+              ATT_MI2=ATTSI*DWTER2*CEXP(-IC*VK(JE)*ROI*CSTHIR2)
+C
+C    Kinematic term
+C
+              SLIDIR=ZEROC
+              DO LI=0,LMI
+                ILI=LI*LI+LI+1
+                DO MI=-LI,LI
+                  INDI=ILI+MI
+                  SLIDIR=SLIDIR+TL(LI,1,ITYP,JE)*YLMJ(INDI)
+     &            *YLMI(INDI)
+                ENDDO
+              ENDDO
+C
+C    Loop over the last atom J encountered by the electron beam
+C                  when exiting the solid
+C
+              SJDIF=ZEROC
+              DO JTYP=1,N_PROT
+               NBTYPJ=NATYP(JTYP)
+               LMJ=LMAX(JTYP,JE)
+               INDJ_M=(LMJ+1)*(LMJ+1)
+               DO JNUM=1,NBTYPJ
+                JATL=NCORR(JNUM,JTYP)
+                XOJ=SYM_AT(1,JATL)-EMET(1)
+                YOJ=SYM_AT(2,JATL)-EMET(2)
+                ZOJ=SYM_AT(3,JATL)-EMET(3)
+                ROJ=SQRT(XOJ*XOJ+YOJ*YOJ+ZOJ*ZOJ)
+                ZSURFJ=VAL(1)-SYM_AT(3,JATL)
+                IF(IATTS.EQ.1) THEN
+                  ATTSJ=EXP(-ZSURFJ*GAMMA/DIRANA(3,JDIR))
+                ENDIF
+                IF(ROJ.GT.SMALL) THEN
+                  CSTHJR=(XOJ*DIRANA(1,JDIR)+YOJ*DIRANA(2,
+     &            JDIR)+ZOJ*DIRANA(3,JDIR))/ROJ
+                  CTROIS1=ZOJ/ROJ
+                ELSE
+                  CSTHJR=0.
+                  CTROIS1=0.
+                ENDIF
+                IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 90
+                IF(CTROIS1.GT.1.)  THEN
+                  CTROIS1=1.
+                ELSEIF(CTROIS1.LT.-1.) THEN
+                  CTROIS1=-1.
+                ENDIF
+                IF(IDCM.EQ.1) THEN
+                  UJ2(JTYP)=UJ_SQ(JTYP)
+                ENDIF
+                IF(ABS(ZSURFJ).LE.SMALL) THEN
+                  IF(ABS(CSTHJR-1.).GT.SMALL) THEN
+                    CSKZ2J=(DIRANA(3,JDIR)-CTROIS1)*(
+     &              DIRANA(3,JDIR)-CTROIS1)/(2.-2.*CSTHJR)
+                  ELSE
+                    CSKZ2J=1.
+                  ENDIF
+                  UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
+                ELSE
+                  UJJ=UJ2(JTYP)
+                ENDIF
+                IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
+                  XK2UJ2=VK2(JE)*UJJ
+                  CALL DWSPH(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                ENDIF
+  90            IF(IDWSPH.EQ.1) THEN
+                  DWTER=1.
+                ELSE
+                  DWTER=EXP(-VK2(JE)*UJJ*(1.-CSTHJR))
+                ENDIF
+                ATT_MJ=ATTSJ*DWTER*CEXP(-IC*VK(JE)*ROJ*
+     &          CSTHJR)
+C
+C    Loop over the angular momentum of atom I
+C
+                SLIDIF=ZEROC
+                DO INDI=1,INDI_M
+C
+C    Loop over the angular momentum of atom J
+C
+                  SLJDIF=ZEROC
+                  DO INDJ=1,INDJ_M
+                    LIN=LIN+1
+                    SLJDIF=SLJDIF+YLMJ(INDJ)*TAU(LIN)
+                  ENDDO
+C
+                  SLIDIF=SLIDIF+SLJDIF*YLMI(INDI)
+                ENDDO
+C
+C     End of the loops over the last atom J
+C
+                SJDIF=SJDIF+SLIDIF*ATT_MJ
+C
+               ENDDO
+              ENDDO
+              SIDIF=SIDIF+SJDIF*ATT_MI
+              SIDIR=SIDIR+SLIDIR*ATT_MI2
+C
+C     End of the loops over the first atom I
+C
+             ENDDO
+            ENDDO
+C
+C     Computing the square modulus
+C
+            SRDIF=SRDIF+CABS(SIDIF)*CABS(SIDIF)
+            SRDIR=SRDIR+CABS(SIDIR)*CABS(SIDIR)
+C
+C     End of the loop on the directions of the analyzer
+C
+           ENDDO
+C
+           SSETDIF=SSETDIF+SRDIF*CFM*W/NDIR
+           SSETDIR=SSETDIR+SRDIR*CFM*W/NDIR
+           IF(ICHKDIR.EQ.2) THEN
+             IF(JSET.EQ.JREF) THEN
+               SSET2DIF=SRDIF*CFM/NDIR
+               SSET2DIR=SRDIR*CFM/NDIR
+             ENDIF
+           ENDIF
+C
+C     End of the loop on the set averaging
+C
+          ENDDO
+C
+          IF(ISOM.EQ.2) THEN
+            WRITE(IOUT,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
+     &      SSETDIR,SSETDIF
+            IF(ICHKDIR.EQ.2) THEN
+              WRITE(IOUT,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
+     &        SSET2DIR,SSET2DIF
+            ENDIF
+          ELSE
+             WRITE(IOUT,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
+     &       SSETDIR,SSETDIF
+             IF(ICHKDIR.EQ.2) THEN
+               WRITE(IOUT,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
+     &         SSET2DIR,SSET2DIF
+             ENDIF
+          ENDIF
+C
+C     End of the loop on the scanned angle
+C
+         ENDDO
+C
+   8     CONTINUE
+C
+C     End of the loop on the fixed angle
+C
+        ENDDO
+C
+C     End of the loop on the energy
+C
+        CLOSE(IUI6)
+       ENDDO
+C
+   3   CONTINUE
+C
+       GO TO 1
+   5   IPLAN=JPLAN-1
+       IJK=IJK+1
+       IF((IJK.EQ.1).AND.(IPRINT.GT.0)) THEN
+         IF(I_TEST.NE.2) WRITE(IUO1,54) IPLAN
+       ENDIF
+   1   CONTINUE
+C
+C     End of the loop on the planes
+C
+      ENDDO
+C
+      IF(ABS(I_EXT).GE.1) CLOSE(IUI6)
+      IF((ISOM.EQ.0).OR.(JFICH.EQ.NFICHLEC)) WRITE(IOUT,*)
+      IF(SPECTRO.EQ.'APC') CLOSE(IOUT)
+      IF(SPECTRO.EQ.'APC') GOTO 7
+c      IF(((NEMET.GT.1).OR.(NPLAN.GT.1)).AND.(ISOM.EQ.0)) THEN
+      IF(((NEMET.GT.1).OR.(NPLAN.GT.0)).AND.(ISOM.EQ.0)) THEN
+        NP=0
+        CALL TREAT_PHD(ISOM,NFICHLEC,JFICH,NP)
+      ENDIF
+      IF(I_EXT.EQ.2) THEN
+         CALL WEIGHT_SUM(ISOM,I_EXT,0,1)
+      ENDIF
+      GOTO 7
+   6  WRITE(IUO1,55)
+C
+   9  FORMAT(9(2X,I1),2X,I2)
+  11  FORMAT(I4,2X,I4,2X,I4)
+  12  FORMAT(2X,A3,11X,A13)
+  13  FORMAT(6X,I1,1X,I3,2X,I4)
+  14  FORMAT(6X,I1,1X,I3,3X,I3)
+  19  FORMAT(2(2X,I1),1X,I2,6(2X,I1),2X,I2)
+  20  FORMAT(2(5X,F6.2,2X,F6.2),2X,I1)
+  21  FORMAT(10X,E12.6,3X,E12.6)
+  22  FORMAT(16X,'INTERNAL CALCULATION OF MEAN SQUARE DISPLACEMENTS',/,
+     &25X,' BY DEBYE UNCORRELATED MODEL:',/)
+  23  FORMAT(21X,'ATOM TYPE ',I5,'  MSD = ',F8.6,' ANG**2')
+  51  FORMAT(/////,2X,'******* PLANE NUMBER ',I3,' DOES NOT CONTAIN ',
+     *'ANY ABSORBER OF TYPE ',I2,' *******')
+  52  FORMAT(/////,2X,'******* PLANE NUMBER ',I3,' POSITION OF ','THE 
+     &ABSORBER : (',F6.3,',',F6.3,',',F6.3,') *******',/,2X,'******* ',
+     &19X,'THIS ABSORBER IS OF TYPE ',I2,20X,' *******')
+  53  FORMAT(//,2X,'ORDER ',I2,'  TOTAL NUMBER OF PATHS     : ',F15.1,/
+     &,10X,'  EFFECTIVE NUMBER OF PATHS : ',F15.1,/,10X,'  MINIMAL 
+     &INTENSITY         : ',E12.6,2X,'No OF THE PATH : ',F15.1,        
+     &                 /,10X,'  MAXIMAL INTENSITY         : ',E12.6,2X,
+     &'No OF THE PATH : ',F15.1)
+  54  FORMAT(//,7X,'DUE TO THE SIZE OF THE CLUSTER, THE SUMMATION',
+     *' HAS BEEN TRUNCATED TO THE ',I2,' TH PLANE')
+  55  FORMAT(///,12X,' <<<<<<<<<<  THIS VALUE OF ILPM IS NOT',
+     *'AVAILABLE  >>>>>>>>>>')
+  56  FORMAT(4X,'LATTICE PARAMETER A = ',F6.3,' ANGSTROEMS',4X,
+     *'MEAN FREE PATH = ',F6.3,' * A',//)
+  57  FORMAT(25X,'CLUSTER RADIUS = ',F6.3,' *A')
+  58  FORMAT(//,2X,'ORDER ',I2,'  TOTAL NUMBER OF PATHS     : ',I10,/,
+     &10X,'  EFFECTIVE NUMBER OF PATHS : ',I10,                /,10X,' 
+     & MINIMAL INTENSITY         : ',E12.6,2X,'No OF THE PATH : ',I10, 
+     &                        /,10X,'  MAXIMAL INTENSITY         : ',
+     &E12.6,             2X,'No OF THE PATH : ',I10)
+  59  FORMAT(//,15X,'THE SCATTERING DIRECTION IS GIVEN INSIDE ',
+     *'THE CRYSTAL')
+  60  FORMAT(7X,'THE POSITIONS OF THE ATOMS ARE GIVEN WITH RESPECT ',
+     *'TO THE ABSORBER')
+  63  FORMAT(///,4X,'..........  DIRECTION OF THE DETECTOR      : (',
+     &F6.3,',',F6.3,',',F6.3,    ')  ..........',/,16X,'DIRECTION OF 
+     &THE BEAM    ',     '      : (',F6.3,',',F6.3,',',F6.3,')',/,16X,
+     &'ANALYZER.BEAM                  :        ',F7.4)
+  65  FORMAT(////,3X,'++++++++++++++++++',9X,
+     *'THETA = ',F6.2,' DEGREES',9X,'++++++++',
+     *'++++++++++',///)
+  66  FORMAT(////,3X,'++++++++++++++++++',9X,
+     *'PHI = ',F6.2,' DEGREES',9X,'++++++++++',
+     *'++++++++++',///)
+  67  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+  68  FORMAT(10X,'  CUT-OFF INTENSITY       : ',E12.6)
+  69  FORMAT(9X,I2,2X,E12.6,7X,E12.6,1X,F6.3,1X,10(I3,2X))
+  70  FORMAT(2X,I2,2X,I10,7X,E12.6,2X,F6.3,7X,I2,7X,10(I3,2X))
+  71  FORMAT(//,1X,'JDIF',4X,'No OF THE PATH',2X,'INTENSITY',3X,
+     &'LENGTH',4X,'ABSORBER',2X,'ORDER OF THE SCATTERERS',/)
+  72  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,
+     &E12.6,2X,E12.6)
+  74  FORMAT(10X,'<===== NUMBER OF PATHS TOO LARGE FOR PRINTING ','====
+     &=>')
+  76  FORMAT(2X,I2,2X,E12.6,7X,E12.6,2X,F6.3,7X,I2,7X,10(I3,2X))
+  77  FORMAT('   ')
+  79  FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
+  80  FORMAT(///)
+  81  FORMAT(//,1X,'RANK',1X,'ORDER',4X,'No PATH',3X,'INTENSITY',3X,
+     &'LENGTH',4X,'ABS',3X,'ORDER OF THE SCATTERERS',/)
+  82  FORMAT(I3,4X,I2,1X,E12.6,3X,E12.6,2X,F6.3,4X,I2,4X,10(I3,1X))
+  83  FORMAT(I3,4X,I2,1X,I10,3X,E12.6,2X,F6.3,4X,I2,4X,10(I3,1X))
+  84  FORMAT(/////,18X,'THE ',I3,' MORE INTENSE PATHS BY DECREASING',' 
+     &ORDER :',/,24X,'(THE LENGTH IS GIVEN IN UNITS ','OF A)')
+  85  FORMAT(/////,25X,' PATHS USED IN THE CALCULATION : ',/,24X,'(THE 
+     &LENGTH IS GIVEN IN UNITS OF A)')
+  86  FORMAT(2X,I3,1X,I4,5X,F8.3,3X,F8.3,3X,E12.6)
+  87  FORMAT(2X,I2,2X,I3,2X,I2,2X,I3,2X,I3,2X,I3,2X,I1,2X,I2,2X,I2,2X,
+     &E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
+  88  FORMAT(/,19X,'TILTED THETA =',F6.2,5X,'TILTED PHI =', F6.2)
+  89  FORMAT(/,4X,'..........................................','.......
+     &..............................')
+C
+   7  RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/main.f

@@ -0,0 +1,21 @@
+      SUBROUTINE RUN(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_, 
+     &  NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_, 
+     &  NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_, 
+     &  N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
+
+        USE DIM_MOD
+        IMPLICIT INTEGER (A-Z)
+CF2PY   INTEGER, INTENT(IN,COPY) :: NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_
+CF2PY   INTEGER, INTENT(IN,COPY) :: NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_ 
+CF2PY   INTEGER, INTENT(IN,COPY) :: NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_
+CF2PY   INTEGER, INTENT(IN,COPY) :: N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_
+
+        CALL ALLOCATION(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_, 
+     &  NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_, 
+     &  NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_, 
+     &  N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
+
+        CALL MAIN_LED_NS_MI()
+        CALL CLOSE_ALL_FILES()
+
+      END SUBROUTINE RUN

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/plotfd.f

@@ -0,0 +1,106 @@
+C
+C=======================================================================
+C
+      SUBROUTINE PLOTFD(A,LMX,ITL,NL,NAT,NE)
+C
+C  This routine prepares the output for a plot of the scattering factor
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD
+      USE FDIF_MOD
+      USE INIT_L_MOD , L => LI, I2 => INITL, I3 => NNL, I4 => LF1, I5 =>
+     & LF2, I10 => ISTEP_LF
+      USE INIT_J_MOD
+      USE OUTFILES_MOD
+      USE OUTUNITS_MOD
+      USE PARCAL_MOD , N3 => NPHI, N4 => NE, N5 => NTHETA, N6 => NEPS
+      USE TYPCAL_MOD , I7 => IFTHET, I8 => IMOD, I9 => IPOL, I12 => I_CP
+     &, I13 => I_EXT, I14 => I_TEST
+      USE VALIN_MOD , U1 => THLUM, U2 => PHILUM, U3 => ELUM, N7 => NONVO
+     &L
+      USE VALFIN_MOD
+C
+C
+C
+      DIMENSION LMX(NATM,NE_M)
+C
+      COMPLEX FSPH,VKE
+C
+C
+C
+      DATA PI,CONV/3.141593,0.512314/
+C
+      OPEN(UNIT=IUO3, FILE=OUTFILE3, STATUS='UNKNOWN')
+      IF(ISPHER.EQ.0) THEN
+         L=0
+         LMAX=0
+      ELSE
+        LMAX=L
+      ENDIF
+      PHITOT=360.
+      THTOT=360.*ITHETA*(1-IPHI)+180.*ITHETA*IPHI
+      NPHI=(NFTHET+1)*IPHI+(1-IPHI)
+      NTHT=(NFTHET+1)*ITHETA*(1-IPHI)+(NFTHET/2+1)*ITHETA*IPHI+
+     *     (1-ITHETA)
+      NE=NFTHET*IE + (1-IE)
+      WRITE(IUO3,1) ISPHER,NL,NAT,L,NTHT,NPHI,NE,E0,EFIN
+      DO 10 JT=1,NTHT
+        DTHETA=THETA1+FLOAT(JT-1)*THTOT/FLOAT(MAX0(NTHT-1,1))
+        RTHETA=DTHETA*PI/180.
+        TEST=SIN(RTHETA)
+        IF(TEST.GE.0.) THEN
+          POZ=PI
+          EPS=1.
+        ELSE
+          POZ=0.
+          EPS=-1.
+        ENDIF
+        BETA=RTHETA*EPS
+        IF(ABS(TEST).LT.0.0001) THEN
+          NPHIM=1
+        ELSE
+          NPHIM=NPHI
+        ENDIF
+        DO 20 JP=1,NPHIM
+          DPHI=PHI1+FLOAT(JP-1)*PHITOT/FLOAT(MAX0(NPHI-1,1))
+          RPHI=DPHI*PI/180.
+          GAMMA=POZ-RPHI
+          DO 30 JE=1,NE
+            IF(NE.EQ.1) THEN
+              ECIN=E0
+            ELSE
+              ECIN=E0+FLOAT(JE-1)*(EFIN-E0)/FLOAT(NE-1)
+            ENDIF
+            IF(ITL.EQ.0) VKE=SQRT(ECIN-ABS(VINT))*CONV*A*(1.,0.)
+            DO 40 JAT=1,NAT
+              IF(L.GT.LMX(JAT,JE)) GOTO 90
+              DO 50 M=-LMAX,LMAX
+                CALL FACDIF1(VKE,R1,R2,THETA0,PHI0,BETA,GAMMA,L,M,FSPH,J
+     &AT,JE,*60)
+                GOTO 70
+  60            WRITE(IUO1,80)
+                STOP
+  70            REFTH=REAL(FSPH)
+                XIMFTH=AIMAG(FSPH)
+                WRITE(IUO3,5) JE,JAT,L,M,REFTH,XIMFTH,DTHETA,DPHI,ECIN
+  50          CONTINUE
+              GOTO 40
+  90          WRITE(IUO1,100) JAT
+              STOP
+  40        CONTINUE
+  30      CONTINUE
+  20    CONTINUE
+  10  CONTINUE
+      CLOSE(IUO3)
+   1  FORMAT(5X,I1,2X,I2,2X,I4,2X,I2,2X,I3,2X,I3,2X,I3,2X,F8.2,2X,F8.2)
+   5  FORMAT(1X,I3,1X,I4,1X,I2,1X,I3,1X,F6.3,1X,F6.3,1X,F6.2,1X,F6.2,1X,
+     &F8.2)
+  80  FORMAT(15X,'<<<<<  WRONG VALUE OF THETA0 : THE DENOMINATOR ','IS Z
+     &ERO  >>>>>')
+ 100  FORMAT(15X,'<<<<<  THE VALUE OF L EST IS TOO LARGE FOR ATOM',' : '
+     &,I2,'  >>>>>')
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/process.py

@@ -0,0 +1,995 @@
+# vim: set et ts=4 sw=4 fdm=indent:
+# coding: utf-8
+
+import re
+import sys
+import os
+import textwrap
+
+
+class Patterns(object):
+    col  = '(?P<comment> |C|\*)'
+    col += '(?P<label>(?: |\d){1,5})'
+    col += '(?P<cont> |\d|&)'
+
+
+    typ  = '(?P<type>'
+    typ += 'BYTE|'
+    typ += 'CHARACTER(?:\*\(\*\)|\*\d+)?|'
+    typ += 'COMPLEX(?:\*8|\*16|\*32)|'
+    typ += 'DOUBLE\s+(?:COMPLEX|PRECISION)|'
+    typ += 'INTEGER(?:\*2|\*4|\*8)?|'
+    typ += 'LOGICAL(?:\*1|\*2|\*4|\*8)?|'
+    typ += 'REAL(?:\*4|\*8|\*16)?|'
+    typ += 'AUTOMATIC|STATIC)'
+
+    nam  = '[a-z][a-z0-9_]*'
+    dim  = '(?:,?.*?(?::.*?)?)+'
+    axs  = '[^:]+(:[^:]+)?'
+
+
+
+
+class BaseInfo(object):
+    def __init__(self, **kwargs):
+        self._attrs = kwargs.keys()
+        for kw,val in kwargs.items():
+            setattr(self, '_' + kw, val)
+    @property
+    def info(self):
+        s = '=== {}:\n'.format(self.__class__.__name__)    
+        for attr in self._attrs:
+            s += '    {}: {}\n'.format(attr, repr(getattr(self, attr)))
+        return s
+
+    def __repr__(self):
+        return '<{}>'.format(self.__class__.__name__)
+
+
+class DimensionInfo(BaseInfo):
+    def __init__(self, **kwargs):
+        opts = {'rank': None, 
+                'extents': None, 
+                'variable': None}
+        opts.update(**kwargs)
+        BaseInfo.__init__(self, **opts)
+
+    @property
+    def rank(self):
+        return len(self.extents)
+    @property
+    def extents(self):
+        return self._extents
+    @property
+    def variable(self):
+        return self._variable
+    @variable.setter
+    def variable(self, value):
+        assert isinstance(value, VariableInfo)
+        self._variable = value
+
+    def __str__(self):
+        s = ''
+        for d in self.extents:
+            s += d[0]
+            if d[1] is not None:
+                s += ':' + d[1]
+            s += ','
+        s = s.strip(',')
+        return s
+
+class VariableInfo(BaseInfo):
+    def __init__(self, **kwargs):
+        opts = {'name': None, 'type': None, 
+                'dimension': None, 'subprogram': None}
+        opts.update(**kwargs)
+        BaseInfo.__init__(self, **opts)
+    @property
+    def name(self):
+        return self._name
+    @property
+    def type(self):
+        return self._type
+    @type.setter
+    def type(self, value):
+        self._type = value
+    @property
+    def dimension(self):
+        return self._dimension
+    @dimension.setter
+    def dimension(self, value):
+        self._dimension = value
+    @property
+    def subprogram(self):
+        return self._subprogram
+    @subprogram.setter
+    def subprogram(self, value):
+        self._subprogram = value
+
+    def __str__(self):
+        s = self.name
+        if self.dimension is not None:
+            s += '(' + str(self.dimension) + ')'
+        return s
+
+class FileInfo(BaseInfo):
+    def __init__(self, **kwargs):
+        opts = {'filename': None, 'content': None, 'subprograms': None}
+        opts.update(**kwargs)
+        BaseInfo.__init__(self, **opts)
+        self._subprograms = find_subprograms('\n'.join(self.content))
+        for sp in self._subprograms:
+            sp.file = self
+        #self._subprograms = None
+    @property
+    def filename(self):
+        return os.path.abspath(self._filename)
+    @property
+    def content(self):
+        with open(self.filename, 'r') as fd:
+            lines = fd.readlines()
+            pat = re.compile('     (?:\d|&)\s*(.*)$')
+            c = []
+            for line in lines:
+                line = line.strip('\n')
+                m = pat.match(line)
+                if m:
+                    c[-1] += m.group(1)
+                else:
+                    c.append(line)
+        return c 
+    @property
+    def subprograms(self):
+        return self._subprograms
+    def __str__(self):
+        return content2str(self.content)
+
+class SubProgramInfo(BaseInfo):
+    def __init__(self, **kwargs):
+        opts = {'name': None, 'content': None, 'type': None, 'file': None, 
+                'l0': None, 'l1': None, 'commons': None}
+        opts.update(**kwargs)
+        BaseInfo.__init__(self, **opts)
+
+    @property
+    def name(self):
+        return self._name
+    @property
+    def content(self):
+        return self._file.content[self.l0:self.l1]
+    @property
+    def type(self):
+        return self._type
+    @property
+    def file(self):
+        return self._file
+    @property
+    def l0(self):
+        return self._l0
+    @property
+    def l1(self):
+        return self._l1
+
+    @file.setter
+    def file(self, value):
+        self._file = value
+    
+    @property
+    def commons(self):
+        self._commons = find_commons('\n'.join(self.content))
+        for c in self._commons:
+            c.subprogram = self
+        return self._commons
+
+    def __str__(self):
+        return content2str(self.content)
+
+    def __repr__(self):
+        s = "{}<{}>".format(self.name, self.type)
+        return s
+
+
+class CommonBlockInfo(BaseInfo):
+    def __init__(self, **kwargs):
+        opts = {'name': None, 'content': None, 'subprogram': None, 'variables': None}
+        opts.update(**kwargs)
+        BaseInfo.__init__(self, **opts)
+
+    def __str__(self):
+        return content2str(self.content)
+
+    def __repr__(self):
+        s = "{}<{:d} variables>".format(self.name, len(self.variables))
+        return s
+    
+    @property
+    def subprogram(self):
+        return self._subprogram
+    @subprogram.setter
+    def subprogram(self, value):
+        self._subprogram = value
+        
+
+    @property
+    def name(self):
+        return self._name
+                
+    @property
+    def content(self):
+        return self._content
+    @property
+    def variables(self):
+        # string to analyse
+        s = self.content[0]
+        m = re.match("^.*COMMON\s*/{}/\s*(.*)$".format(self.name),s, re.I)
+        self._variables = find_variables(m.groups()[0])
+        for v in self._variables:
+            v.subprogram = self.subprogram
+
+        # If the dimension of a variable is None, try to search if a DIMENSION
+        # statement exists in the subprogram
+        dim_defs = [] # list of variables defined in a DIMENSION statement
+        for line in self.subprogram.content:
+            m = re.match("^[^C]\s+DIMENSION\s+(.*)$", line, re.I)
+            if m is not None:
+                s = m.groups()[0]
+                var_list = find_variables(s)
+                for v in var_list:
+                    dim_defs.append(v)
+        dim_defs = Variables(dim_defs)
+        # Now for each variable of the common, if there is no dimension, try to find it in
+        # the dim_defs list
+        for v in self._variables:
+            if v.dimension is None:
+                dim = dim_defs[v.name]
+                if dim is not None:
+                    #print(self.subprogram.name)
+                    #print(v.name, dim)
+                    v.dimension = dim.dimension
+                    #exit()
+
+        # if the type of the variable is None, try to find it in a declaration statement
+        type_defs = [] # list of variables defined with their type
+        for line in self.subprogram.content:
+            var_list = find_type(line)
+            if var_list is not None:
+                for v in var_list:
+                    type_defs.append(v)
+        type_defs = Variables(type_defs)
+        # Now for each variable with no type, try to find it in the type_defs list
+        for v in self._variables:
+            if v.type is None:
+                typ = type_defs[v.name]
+                if typ is not None:
+                    #print(self.subprogram.name)
+                    #print(v.name, typ)
+                    v.type = typ.type
+                    #exit()
+                else:
+                    if re.match("^[A-HO-Z].*", v.name, re.I):
+                        v.type = "REAL"
+                    else:
+                        v.type = "INTEGER"
+                
+
+        return self._variables
+
+            
+class _CommonBlockInfo(BaseInfo):
+    def __init__(self, **kwargs):
+        self.name = kwargs.get('name', None)
+        self.subprogram = kwargs.get('subprogram', None)
+
+    def __init__(self, **kwargs):
+        opts = {'name': None, 'content': None, 'type': None, 'file': None, 
+                'l0': None, 'l1': None}
+        opts.update(**kwargs)
+        BaseInfo.__init__(self, **opts)
+
+    def __str__(self):
+        s  = "Common block name: {}\n".format(self.name)
+        for var in self.variables:
+            s += str(var)
+        return s
+    def __repr__(self):
+        s = '{}'.format(self.name)
+        return s
+
+    def _find_variables(self):
+        content = self.content[0].rstrip()
+        
+        pat = re.compile('^\s*COMMON\s+/{}/\s+(.*)$'.format(self.name), re.IGNORECASE)
+        m = pat.match(content)
+        var_loc = m.group(1)
+
+        p0 = re.compile(r'\(.*[^\)]$')
+        p1 = re.compile('^[a-zA-Z0-9_\*]*\)$')
+        var_list = []
+        var_loc_list = var_loc.split(',')
+        for i, _ in enumerate(var_loc_list):
+            _ = _.strip()
+            if i > 0:
+                if p0.search(var_list[-1]):
+                    var_list[-1] += ',' + _
+                else:
+                    var_list.append(_)
+            else:
+                var_list.append(_)
+
+        variables = []
+        for var in var_list:
+            m = re.match("([a-zA-Z0-9_]+)(\((.*)\))?", var)
+            var_name = m.group(1)
+            v = VariableInfo(name=var_name, subprogram=self.subprogram)
+            
+            #dim_loc = m.groups()[-1]
+            #if dim_loc is not None:
+            #    dim_list = dim_loc.split(',')
+            #    v.dimension = dim_list
+            variables.append(v)
+        return variables
+                
+    @property
+    def content(self):
+        pat = re.compile('\s+.*COMMON\s+/{}/.*$'.format(self.name), re.IGNORECASE)
+        for line in self.subprogram.content:
+            if pat.match(line):
+                return [line.rstrip(),]
+    @property
+    def variables(self):
+        variables_list = self._find_variables()
+        return Variables(variables_list)
+
+
+
+
+class InfoList(object):
+    def __init__(self, elements):
+        self._elements = elements
+        for element in self._elements:
+            setattr(self, element.name, element)
+    def __getitem__(self, item):
+        if isinstance(item, str):
+            for element in self._elements:
+                if element.name == item:
+                    return element
+            return None
+        elif isinstance(item, int):
+            return self._elements[item]
+        else:
+            raise NameError('Unable to retrieve item!')
+    def __str__(self):
+        s  = "nb of {}: {:d}\n".format(self.__class__.__name__, len(self._elements))
+        #s += str([_.name for _ in self._elements])
+        for _ in self._elements:
+            s += _.info
+        return s
+    def __len__(self):
+        return len(self._elements)
+
+class Subprograms(InfoList):
+    def __init__(self, *args, **kwargs):
+        InfoList.__init__(self, *args, **kwargs)
+
+class Commons(InfoList):
+    def __init__(self, *args, **kwargs):
+        InfoList.__init__(self, *args, **kwargs)
+
+class Variables(InfoList):
+    def __init__(self, *args, **kwargs):
+        InfoList.__init__(self, *args, **kwargs)
+
+
+
+
+
+
+
+"""
+class Subprograms(BaseInfo):
+    def __init__(self, subprograms_list):
+        self._subprograms = subprograms_list
+        for sp in self._subprograms:
+            setattr(self, sp.name, sp)
+    def __getitem__(self, item):
+        return self._subprograms[item]
+    def __str__(self):
+        s = "nb of subprograms: {:d}\n".format(len(self._subprograms))
+        return s
+
+class Commons(BaseInfo):
+    def __init__(self, commons_list):
+        self._commons = commons_list
+        for cmn in self._commons:
+            setattr(self, cmn.name, cmn)
+    def __getitem__(self, item):
+        return self._commons[item]
+    def __str__(self):
+        s = "nb of commons: {:d}\n".format(len(self._commons))
+        return s
+
+class Variables(BaseInfo):
+"""
+
+    
+
+
+class VariableInfo2(BaseInfo):
+    def __init__(self, **kwargs):
+        self.name = kwargs.get('name', None)
+        #self.type = kwargs.get('type', None)
+        self.dimension = kwargs.get('dimension', None)
+        self.i = []
+        self.j = []
+        self.subprogram = kwargs.get('subprogram', None)
+        #self._find_type()
+        #self._find_dimension()
+    def __str__(self):
+        s  = "Variable name: {}\n".format(self.name)
+        s += "         type: {}\n".format(self.type)
+        s += "    dimension: {}\n".format(self.dimension)
+        return s
+
+    def _find_implicit(self):
+        content = self.subprogram.content
+        pat = re.compile('^\s*IMPLICIT\s+', re.IGNORECASE)
+
+    def _find_type(self):
+        content = self.subprogram.content
+        pat = re.compile('^\s+((?:INTEGER|REAL|DOUBLE PRECISION|COMPLEX|LOGICAL|CHARACTER)\S*).*{}[\(,]?.*$'.format(self.name), re.IGNORECASE)
+        for line in content:
+            m = pat.match(line)
+            print(line)
+            if m:
+                return m.group(1).strip()
+        return None
+
+    def _find_dimension(self):
+        content = self.subprogram.content
+        dimension = None
+        #pat = re.compile('^\s+DIMENSION.*{}\(([^\(])\).*$'.format(self.name),re.IGNORECASE)
+        pat = re.compile('^\s+DIMENSION.*{}\((.*?)\).*$'.format(self.name),re.IGNORECASE)
+        for line in content:
+            m = pat.match(line)
+            if m:
+                print(line)
+                #dimension = m.group(1).strip()
+                dimension = m.group(1)
+                print(dimension)
+        if dimension is not None:
+            print('Variable: {}, dimension: {}'.format(self.name, dimension))
+    @property
+    def type(self):
+        t = self._find_type()
+        return t
+
+###############################################################################
+# UTILITY FUNCTIONS
+###############################################################################
+    
+def splitline_(line, width=72):
+    result = []
+    i = 0
+    j = len(line)
+    ll = line[i:j]
+
+    if len(ll) > width:
+        s = ''
+        for dec in range(8):
+            s += '{:d}         '.format(dec)
+        print(s)
+        print('0123456789'*7+'012')
+    #print(line)
+
+    while len(ll) > width:
+        breaks = [_.end() for _ in re.finditer('[ ,]', ll)]
+        print(ll)
+        print(breaks)
+
+        for ij, j in enumerate(breaks):
+            tmp = ll[i:j]
+            #print(breaks,i,j,ij, tmp, len(tmp))
+            if len(tmp) <= width and ij < len(breaks)-1:
+                continue
+            else:
+                _ = ll[i:breaks[ij-1]]
+                result.append(_)
+                i = len(_)
+                if i <= 6:
+                    print(j, _)
+                    raise NameError('Impossible to cut line at breaks')
+                ll = '     &' + ll[i:]
+                i = 0
+                break
+    result.append(ll)
+    print(ll)
+    return result
+
+def splitline(line, width=72):
+    if len(line) == 0:
+        return []
+    if line[0].upper() == 'C':
+        return [line,]
+    head = line[:6]
+    L = line[6:]     # the working line
+    # find the indentation
+    m = re.search('^\s*', L)
+    indent = L[m.start():m.end()]
+    # and define the true width to work with
+    W = width - 6 - len(indent)
+    
+    def rule():
+        s = ''
+        for dec in range(20):
+            s += '{:d}         '.format(dec)
+        print(s)
+        print('0123456789'*20)
+
+    # find all places to break the line
+    breaks = [_.end() for _ in re.finditer('[ ,()+-/*=:]', L)]
+
+    # split at breaks
+    indices = [0,] + breaks + [len(L),]
+    indices = zip(indices[:-1], indices[1:])
+    splitted_line = [L[a:b] for a,b in indices]
+
+    # iterate over each element and add it to the previous one if length is < max
+    chain = [splitted_line[0],]
+    for element in splitted_line[1:]:
+        l1 = len(chain[-1])
+        l2 = len(element)
+        if l1+l2 < W:
+            chain[-1] = chain[-1] + element
+        else:
+            chain.append(element)
+    # restore the head of the line
+    chain[0] = head + chain[0]
+    # add the & symbol
+    for i in range(1,len(chain)):
+        chain[i] = "     &" + indent + chain[i]
+    
+    # final check
+    for element in chain:
+        if len(element) > width:
+            rule()
+            print(f"{line}")
+            print(f"breaks at = {breaks}")
+            print(chain)
+            rule()
+            print(element)
+            raise NameError(f"Unable to split line!")
+    
+        
+
+    return chain
+
+
+
+def content2str(content):
+    new_content = []
+    for index, line in enumerate(content):
+        #print(f'{index:>5d}#{line}')
+        multilines = splitline(line.rstrip(), width=72)
+        #print(multilines)
+        new_content += multilines
+        
+    return '\n'.join(new_content)   
+
+
+def split_at_comma(string):
+    """
+    """
+    # remove all spaces from the string
+    line0 = string.replace(' ', '')
+    line  = line0
+    # define some patterns
+    pat0 = re.compile('\(([^\(\)]*)\)', re.I)
+
+    # remove nested blocks in ()'s and replace them with
+    # hash signs (#) to make the treatment easier
+    while True:
+        M = list(pat0.finditer(line))
+        if len(M) == 0: break
+        for m in M:
+            i,j = m.start(), m.end()
+            line = line[:i] + '#'*(j-i) + line[j:]
+
+    # now get indices of ','
+    indices = [_.start() for _ in re.finditer(',', line)]
+    indices = zip([-1,] + indices, indices + [len(line),])
+    # create the list of
+    elements = [line0[i+1:j] for i,j in indices]
+    return elements
+
+def find_dimension(string):
+    """ 
+    Finds the components of a dimension declaration.
+
+    :param string: The argument of a dimension declaration
+    :type string: str
+    :return: A DimensionInfo object.
+    :rtype: DimensionInfo
+
+    :Example:
+
+    >>> dim = find_dimension('I,J,-3:2')
+    >>> print(dim)
+    >>> (3, ())
+
+
+    """
+    # define some patterns
+    pat0 = re.compile('([^:]+):?([^:]+)?', re.I)
+
+    # create the list of axes
+    axl = split_at_comma(string)
+    # get the extents
+    extents = []
+    for ax in axl:
+        m = pat0.match(ax)
+        extents.append(m.groups())
+
+    return DimensionInfo(extents=extents)
+
+def find_variables(string):
+    """ 
+    Finds the name and dimension of variables in a comma separated
+    list of variables.
+
+    :param string: The comma separated variables declaration
+    :type string: str
+    :return: A Variables object.
+    :rtype: Variables
+
+    :Example:
+
+    >>> variables = find_variables('ONE, TWO(3,3)')
+    >>> print(variables)
+    >>> nb of Variables: 2
+    >>> === VariableInfo:
+    >>>     name: 'ONE'
+    >>>     type: None
+    >>>     dimension: None
+    >>>     subprogram: None
+    >>> === VariableInfo:
+    >>>     name: 'TWO'
+    >>>     type: None
+    >>>     dimension: <DimensionInfo>
+    >>>     subprogram: None
+
+    """
+     # create the list of variables
+    var_list = []
+    variables = split_at_comma(string)
+    pat0 = re.compile('({})(?:\((.*)\))?'.format(Patterns.nam), re.I)
+    for var in variables:
+        # extract the variable's name and dimension if any
+        m = pat0.match(var)
+        name = m.group(1)
+        if m.group(2) is not None:
+            dimension = find_dimension(m.group(2))
+        else:
+            dimension = None
+
+        variable = VariableInfo(name=name, dimension=dimension)
+        if isinstance(dimension, DimensionInfo):
+            dimension.variable = variable
+        var_list.append(variable)
+
+    return Variables(var_list)
+
+def find_subprograms(string):
+    lines = string.split('\n')
+    subprograms = []
+    for iline, line in enumerate(lines):
+        patterns = [('SUBROUTINE', re.compile("\s*SUBROUTINE\s+(\w+)\(?.*")),
+                    ('FUNCTION', re.compile("\s*.*FUNCTION\s+(\w+)\(?.*")),
+                    ('PROGRAM', re.compile("\s*PROGRAM\s+(\w+).*"))]
+        for t, pat in patterns:
+            m = pat.match(line)
+            if m is not None:
+                subprog = SubProgramInfo(type=t, 
+                                         name=m.group(1),
+                                         l0=iline)
+                subprograms.append(subprog)
+
+    for i, subprog in enumerate(subprograms):
+        if i < len(subprograms) - 1:
+            subprog._l1 = subprograms[i+1].l0
+        else:
+            subprog._l1 = -1
+
+    return Subprograms(subprograms)
+
+def find_commons(string):
+    pat = re.compile("^\s+COMMON\s*/([a-zA-Z0-9_]+)/(.*)$")
+    commons = []
+    for line in string.split('\n'):
+        # extract the name of the common block
+        m = pat.match(line)
+        if m is not None:
+            # name
+            name = m.group(1)
+            c = CommonBlockInfo(name=name, content=[line,])
+            commons.append(c)
+    return Commons(commons)
+
+
+def find_names(string):
+    """
+    Find the names in expression ie remove (,),+,-,*,/,**,=
+    """
+    m = re.findall('[A-Z][A-Z0-9_]*', string, re.I)
+    return set(m)
+
+
+def find_type(string):
+    """
+    return a Variables object if string is a type declaration
+    """
+    # get out if string is a comment
+    if string.upper().startswith('C'):
+        return None
+
+    pat  = "^\s+"
+    pat += "(BYTE|"
+    pat += "CHARACTER(?:\*[0-9]+)?|CHARACTER\*\(\*\)|"
+    pat += "COMPLEX(?:\*(?:8|16|32))?|"
+    pat += "DOUBLE COMPLEX|"
+    pat += "DOUBLE PRECISION|"
+    pat += "INTEGER(?:\*(?:2|4|8))?|"
+    pat += "LOGICAL(?:\*(?:1|2|4|8))?|"
+    pat += "REAL(?:\*(?:4|8|16))?|"
+    pat += "AUTOMATIC|"
+    pat += "STATIC)"
+    pat += "\s+(.*)$"
+    m = re.match(pat, string, re.I)
+    if m is not None:
+        if re.search("IMPLICIT", string):
+            return None
+        else:
+            var_list = find_variables(m.groups()[1])
+            for var in var_list:
+                var.type = m.groups()[0]
+            return var_list
+
+def find_dim(string):
+    """
+    return a Variables object if string is a dimension declaration
+    """
+    pat  = "^\s+DIMENSION\s+(.*)$"
+    m = re.match(pat, string, re.I)
+    if m is not None:
+        var_list = find_variables(m.groups()[0])
+        return var_list
+
+
+def write_modules(infile):
+    fi = FileInfo(filename=infile)
+
+    # Get all the common blocks defined in the source file
+    all_commons = []
+    for sp in fi.subprograms:
+        for c in sp.commons:
+            if c.name not in [_.name for _ in all_commons]:
+                all_commons.append(c)
+
+    all_commons = Commons(all_commons)
+
+    # a function to create a module fortran code from a CommonBlockInfo object
+    def common2module(cbi):
+        variables = cbi.variables
+        alloc_args = set()
+        module_name = cbi.name.upper() + "_MOD"       
+
+
+        for variable in variables:
+            if variable.dimension is not None:
+                dim_vars = find_names(str(variable.dimension))
+                alloc_args.update(dim_vars)
+
+ 
+        s  = f"MODULE {module_name}\n"
+        s +=  "  IMPLICIT NONE\n"
+
+        # for each variable whose type is defined explicitely
+        for variable in variables:
+            s += f"  {variable.type}"
+            dimension = variable.dimension
+            if dimension is not None:
+                if dimension.rank > 0:
+                    s += f", ALLOCATABLE, DIMENSION(:" + ",:" * (variable.dimension.rank-1) + ")"
+            s += f" :: {variable.name}\n"
+
+        s +=  "CONTAINS\n"
+        #s += f"  SUBROUTINE ALLOC_{cbi.name.upper()}({','.join(alloc_args)})\n"
+        #s +=  "    IMPLICIT INTEGER (A-Z)\n"
+        s += f"  SUBROUTINE ALLOC_{cbi.name.upper()}()\n"
+        s += f"    USE DIM_MOD\n"
+        # for each variable with a defined dimension
+        for variable in variables:
+            if variable.dimension is not None:
+                s += f"    IF (ALLOCATED({variable.name})) THEN\n"
+                s += f"      DEALLOCATE({variable.name})\n"
+                s += f"    ENDIF\n"
+                s += f"    ALLOCATE({variable})\n"
+        
+        s += f"  END SUBROUTINE ALLOC_{cbi.name.upper()}\n"
+        s += f"END MODULE {module_name}\n"
+
+        # indentation
+        s = textwrap.indent(s, prefix="      ")
+        # split in too long
+        content = s.split('\n')
+        s = content2str(content)
+        return s
+
+    # write the modules.f file
+    with open("modules.f", "w") as fd:
+        for c in all_commons:
+            fd.write("C" + "="*71 + "\n")
+            s = common2module(c)
+            fd.write(s)
+            fd.write("\n"*2)
+
+
+
+
+if __name__ == "__main__":
+    #infile = 'inv_mat_ms2_la.f'
+    infile = sys.argv[1]
+
+    # write the modules.f file
+    write_modules(infile)
+    #exit()
+
+    fi = FileInfo(filename=infile)
+
+    # Get all the common blocks defined in the source file
+    all_commons = []
+    for sp in fi.subprograms:
+        for c in sp.commons:
+            if c.name not in [_.name for _ in all_commons]:
+                all_commons.append(c)
+
+    all_commons = Commons(all_commons)
+    content = fi.content
+
+    # write the allocation.f file
+    dim_vars = [
+        "NATP_M", 
+        "NATCLU_M_", 
+        "NAT_EQ_M", 
+        "N_CL_L_M",
+        "NE_M", 
+        "NL_M",
+        "LI_M", 
+        "NEMET_M",
+        "NO_ST_M",
+        "NDIF_M",
+        "NSO_M",
+        "NTEMP_M",
+        "NODES_EX_M",
+        "NSPIN_M",
+        "NTH_M", 
+        "NPH_M",
+        "NDIM_M",
+        "N_TILT_M",
+        "N_ORD_M",
+        "NPATH_M",
+        "NGR_M"]
+
+    s  = f"SUBROUTINE ALLOCATION({', '.join([v+'_' for v in dim_vars])})\n"
+    s += f"  USE DIM_MOD\n"
+    s += f"  IMPLICIT INTEGER (A-Z)\n"
+    for v in dim_vars:
+        s += f"  {v} = {v+'_'}\n"
+    s += f"  CALL INIT_DIM()\n"
+    s += f"END SUBROUTINE ALLOCATION\n"
+
+    # indentation
+    s = textwrap.indent(s, prefix="      ")
+    # split in too long
+    s = content2str(s.split('\n'))
+    
+    with open("allocation.f", "w") as fd:
+        fd.write(s)
+
+
+
+    #exit()
+
+
+    # remove type definitions for variables that are in commons
+    for sp in fi.subprograms:
+        # get the list all all variables in all commons in this subprogram
+        vlist = []
+        for c in sp.commons:
+            for v in c.variables:
+                vlist.append(v.name)
+        for iline, line in enumerate(sp.content):
+            print(f"{sp.l0+iline:05d}: {line}")
+            newline = ''
+            # comment INCLUDE statement
+            if re.search('INCLUDE.*spec.inc', line, re.I):
+                newline = "C" + line
+            # replace the commons by USE statements
+            m = re.match("^.*COMMON\s+/(.*)/.*$", line, re.I)
+            if m is not None:
+                cmn_name = m.groups()[0]
+                # Here we test if the common variables are the same than the module
+                cmn_variables = sp.commons[cmn_name].variables
+                s = f"      USE {cmn_name.upper()}_MOD "
+                modifications = []
+                for i, v in enumerate(cmn_variables):
+                    original = all_commons[cmn_name].variables[i].name
+                    if v.name != original:
+                        modifications.append(f"{v.name} => {original}")
+                s += ", ".join(modifications)
+                newline = s
+
+            # Remove type declaration for variables that are now in modules
+            allv = find_type(line)
+            newallv = []
+            line_ = line
+            if allv is not None:
+                # Here the line is a declaration statement
+                # remove every variables that are also in vlist
+                for v in allv:
+                    if v.name not in vlist:
+                        # keep this variable in the list
+                        newallv.append(str(v))
+                        
+                # if there is no change
+                if len(allv) == len(newallv):
+                    line_ = ""
+                
+                # if no more variables are defined, remove the line
+                elif len(newallv) == 0:
+                    line_ = "C"
+                else:
+                    line_ = "      " + v.type + " " + ",".join(newallv)
+                
+                newline = line_
+
+            # Remove dimension declaration for variables that are now in modules
+            allv = find_dim(line)
+            newallv = []
+            line_ = line
+            if allv is not None:
+                # Here the line is a dimension statement
+                # remove every variables that are also in vlist
+                for v in allv:
+                    if v.name not in vlist:
+                        # keep this variable in the list
+                        #if v.dimension is not None:
+                        newallv.append(str(v))
+                        
+                # if there is no change
+                if len(allv) == len(newallv):
+                    line_ = ""
+                # if no more variables are defined, remove the line
+                elif len(newallv) == 0:
+                    line_ = "C"
+                else:
+                    line_ = "      DIMENSION " + ",".join(newallv)
+                
+                newline = line_
+
+            if newline != '':
+                print(sp.l0, iline, sp.l0+iline)
+                content[sp.l0+iline] = newline
+                print(f">>> {newline}")
+                    
+
+
+
+    # rewrite the file
+    with open(infile + ".new", "w") as fd:
+        fd.write(content2str(content))
+     
+
+
+
+
+

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/treat_led.f

@@ -0,0 +1,785 @@
+C
+C=======================================================================
+C
+      SUBROUTINE TREAT_PHD(ISOM,NFICHLEC,JFICH,NP)
+C
+C  This routine sums up the calculations corresponding to different
+C        absorbers or different planes when this has to be done
+C             (parameter ISOM in the input data file).
+C
+C                                       Last modified : 24 Jan 2013
+C
+C      INCLUDE 'spec.inc'
+      USE DIM_MOD
+      USE OUTUNITS_MOD
+      USE TYPEXP_MOD, DUMMY => SPECTRO
+      USE VALIN_MOD
+      USE VALFIN_MOD
+C
+      PARAMETER(N_HEAD=5000,N_FILES=1000)
+C
+      CHARACTER*3 SPECTRO
+C
+      CHARACTER*13 OUTDATA
+      CHARACTER*72 HEAD(N_HEAD,N_FILES)
+C
+      REAL TAB(NDIM_M,4)
+      REAL ECIN(NE_M),DTHETA(NTH_M),DPHI(NPH_M)
+C
+C
+      DATA JVOL,JTOT/0,-1/
+C
+      REWIND IUO2
+C
+C  Reading and storing the headers:
+C
+      NHEAD=0
+      DO JLINE=1,N_HEAD
+        READ(IUO2,888) HEAD(JLINE,JFICH)
+        NHEAD=NHEAD+1
+        IF(HEAD(JLINE,JFICH)(1:6).EQ.'      ') GOTO 333
+      ENDDO
+C
+ 333  CONTINUE
+C
+      READ(IUO2,15) SPECTRO,OUTDATA
+      READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
+     &IPH_1,I_EXT
+C
+      IF(I_EXT.EQ.2) THEN
+         IPH_1=0
+      ENDIF
+C
+      IF(ISOM.EQ.0) THEN
+C
+C........  ISOM = 0 : case of independent input files  .................
+C
+        READ(IUO2,1) NPLAN,NEMET,NTHETA,NPHI,NE
+C
+        IF(IPH_1.EQ.1) THEN
+          N_FIXED=NPHI
+          FIX0=PHI0
+          FIX1=PHI1
+          N_SCAN=NTHETA
+        ELSE
+          N_FIXED=NTHETA
+          FIX0=THETA0
+          FIX1=THETA1
+          IF(STEREO.EQ.'YES') THEN
+            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/(THETA1-THETA0)+
+     &      0.0001)+1
+            IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
+          ENDIF
+          N_SCAN=NPHI
+        ENDIF
+C
+        IF(I_EXT.EQ.-1) THEN
+          N_SCAN=2*N_SCAN
+        ENDIF
+C
+        IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
+          NDP=NEMET*NTHETA*NPHI*NE
+        ELSEIF(I_EXT.EQ.-1) THEN
+          NDP=NEMET*NTHETA*NPHI*NE*2
+        ELSEIF(I_EXT.EQ.2) THEN
+          NDP=NEMET*NTHETA*NE
+          N_FIXED=NTHETA
+          N_SCAN=NPHI
+          IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
+        ENDIF
+C
+        NTT=NPLAN*NDP
+        IF(NTT.GT.NDIM_M) GOTO 5
+C
+        DO JPLAN=1,NPLAN
+         DO JEMET=1,NEMET
+          DO JE=1,NE
+C
+           DO J_FIXED=1,N_FIXED
+            IF(N_FIXED.GT.1) THEN
+              XINCRF=FLOAT(J_FIXED-1)*(FIX1-FIX0)/FLOAT(
+     &        N_FIXED-1)
+            ELSEIF(N_FIXED.EQ.1) THEN
+              XINCRF=0.
+            ENDIF
+            IF(IPH_1.EQ.1) THEN
+              JPHI=J_FIXED
+            ELSE
+              THETA=THETA0+XINCRF
+              JTHETA=J_FIXED
+              IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 11
+            ENDIF
+            IF(STEREO.EQ.' NO') THEN
+              N_SCAN_R=N_SCAN
+            ELSE
+              RTHETA=THETA*0.017453
+              FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
+              N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.
+     &        0001)+1
+            ENDIF
+C
+            DO J_SCAN=1,N_SCAN_R
+             IF(IPH_1.EQ.1) THEN
+              JTHETA=J_SCAN
+             ELSE
+              JPHI=J_SCAN
+             ENDIF
+C
+             JLIN=(JPLAN-1)*NDP + (JEMET-1)*NE*N_FIXED*N_SCAN + 
+     &       (JE-1)*N_FIXED*N_SCAN +(JTHETA-1)*NPHI + JPHI
+C
+             IF(I_EXT.LE.0) THEN
+               IF(STEREO.EQ.' NO') THEN
+                 JPHI2=JPHI
+               ELSE
+                 JPHI2=(JTHETA-1)*NPHI+JPHI
+               ENDIF
+             ELSE
+               JPHI2=JTHETA
+             ENDIF
+C
+             READ(IUO2,2) JPL
+             IF(JPLAN.EQ.JPL) THEN
+               BACKSPACE IUO2
+               IF(IDICHR.EQ.0) THEN
+                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
+                 ENDIF
+               ELSE
+                 READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),
+     &           TAB(JLIN,4)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
+     &             DPHI(JPHI2),ECIN(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(
+     &             JLIN2,3),TAB(JLIN2,4)
+                 ENDIF
+               ENDIF
+             ELSE
+               BACKSPACE IUO2
+               DO JL=JLIN,JPLAN*NDP
+                 TAB(JL,1)=0.0
+                 TAB(JL,2)=0.0
+                 TAB(JL,3)=0.0
+                 TAB(JL,4)=0.0
+               ENDDO
+               GOTO 10
+             ENDIF
+            ENDDO
+           ENDDO
+  11       CONTINUE
+          ENDDO
+         ENDDO
+  10     CONTINUE
+        ENDDO
+C
+        REWIND IUO2
+C
+C  Skipping the NHEAD lines of headers before rewriting:
+C
+        DO JLINE=1,NHEAD
+          READ(IUO2,888) HEAD(JLINE,JFICH)
+        ENDDO
+C
+        WRITE(IUO2,15) SPECTRO,OUTDATA
+        WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+C
+        DO JE=1,NE
+         DO JTHETA=1,NTHETA
+          IF(STEREO.EQ.' NO') THEN
+            NPHI_R=NPHI
+          ELSE
+            RTHETA=DTHETA(JTHETA)*0.017453
+            FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
+            NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
+            NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
+          ENDIF
+          DO JPHI=1,NPHI_R
+           TOTDIF_1=0.
+           TOTDIR_1=0.
+           VOLDIF_1=0.
+           VOLDIR_1=0.
+           TOTDIF_2=0.
+           TOTDIR_2=0.
+           VOLDIF_2=0.
+           VOLDIR_2=0.
+           IF(I_EXT.EQ.-1) THEN
+             TOTDIF2_1=0.
+             TOTDIR2_1=0.
+             VOLDIF2_1=0.
+             VOLDIR2_1=0.
+             TOTDIF2_2=0.
+             TOTDIR2_2=0.
+             VOLDIF2_2=0.
+             VOLDIR2_2=0.
+           ENDIF
+C
+           DO JPLAN=1,NPLAN
+C
+            SF_1=0.
+            SR_1=0.
+            SF_2=0.
+            SR_2=0.
+            IF(I_EXT.EQ.-1) THEN
+              SF2_1=0.
+              SR2_1=0.
+              SF2_2=0.
+              SR2_2=0.
+            ENDIF
+C
+            DO JEMET=1,NEMET
+             JLIN=(JPLAN-1)*NDP + (JEMET-1)*NE*NTHETA*NPHI + (
+     &       JE-1)*NTHETA*NPHI +(JTHETA-1)*NPHI + JPHI
+             SF_1=SF_1+TAB(JLIN,2)
+             SR_1=SR_1+TAB(JLIN,1)
+             IF(I_EXT.EQ.-1) THEN
+               JLIN2=NTT+JLIN
+               SF2_1=SF2_1+TAB(JLIN2,2)
+               SR2_1=SR2_1+TAB(JLIN2,1)
+             ENDIF
+             IF(IDICHR.GE.1) THEN
+               SF_2=SF_2+TAB(JLIN,4)
+               SR_2=SR_2+TAB(JLIN,3)
+               IF(I_EXT.EQ.-1) THEN
+                 JLIN2=NTT+JLIN
+                 SF2_2=SF2_2+TAB(JLIN2,4)
+                 SR2_2=SR2_2+TAB(JLIN2,3)
+               ENDIF
+             ENDIF
+            ENDDO
+            IF(I_EXT.LE.0) THEN
+               IF(STEREO.EQ.' NO') THEN
+                 JPHI2=JPHI
+               ELSE
+                 JPHI2=(JTHETA-1)*NPHI+JPHI
+               ENDIF
+             ELSE
+              JPHI2=JTHETA
+            ENDIF
+            IF(IDICHR.EQ.0) THEN
+              WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     &        ECIN(JE),SR_1,SF_1
+              IF(I_EXT.EQ.-1) THEN
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(
+     &          JPHI2),ECIN(JE),SR2_1,SF2_1
+              ENDIF
+            ELSE
+              WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     &        ECIN(JE),SR_1,SF_1,SR_2,SF_2
+              IF(I_EXT.EQ.-1) THEN
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(
+     &          JPHI2),ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
+              ENDIF
+            ENDIF
+            IF(JPLAN.GT.NONVOL(JFICH)) THEN
+              VOLDIF_1=VOLDIF_1+SF_1
+              VOLDIR_1=VOLDIR_1+SR_1
+              IF(I_EXT.EQ.-1) THEN
+                VOLDIF2_1=VOLDIF2_1+SF2_1
+                VOLDIR2_1=VOLDIR2_1+SR2_1
+              ENDIF
+              IF(IDICHR.GE.1) THEN
+                VOLDIF_2=VOLDIF_2+SF_2
+                VOLDIR_2=VOLDIR_1+SR_2
+                IF(I_EXT.EQ.-1) THEN
+                  VOLDIF2_2=VOLDIF2_2+SF2_2
+                  VOLDIR2_2=VOLDIR2_1+SR2_2
+                ENDIF
+              ENDIF
+            ENDIF
+            TOTDIF_1=TOTDIF_1+SF_1
+            TOTDIR_1=TOTDIR_1+SR_1
+            IF(I_EXT.EQ.-1) THEN
+              TOTDIF2_1=TOTDIF2_1+SF2_1
+              TOTDIR2_1=TOTDIR2_1+SR2_1
+            ENDIF
+            IF(IDICHR.GE.1) THEN
+              TOTDIF_2=TOTDIF_2+SF_2
+              TOTDIR_2=TOTDIR_2+SR_2
+              IF(I_EXT.EQ.-1) THEN
+                TOTDIF2_2=TOTDIF2_2+SF2_2
+                TOTDIR2_2=TOTDIR2_2+SR2_2
+              ENDIF
+            ENDIF
+           ENDDO
+           IF(IDICHR.EQ.0) THEN
+             WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(
+     &       JE),VOLDIR_1,VOLDIF_1
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),VOLDIR2_1,VOLDIF2_1
+             ENDIF
+             WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(
+     &       JE),TOTDIR_1,TOTDIF_1
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),TOTDIR2_1,TOTDIF2_1
+             ENDIF
+           ELSE
+             WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     &       ECIN(JE),VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+            IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
+             ENDIF
+             WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     &       ECIN(JE),TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
+             ENDIF
+           ENDIF
+          ENDDO
+         ENDDO
+        ENDDO
+C
+      ELSE
+C
+C........ ISOM not= 0 : multiple input files to be summed up  ..........
+C
+        READ(IUO2,7) NTHETA,NPHI,NE
+C
+        IF(IPH_1.EQ.1) THEN
+          N_FIXED=NPHI
+          FIX0=PHI0
+          FIX1=PHI1
+          N_SCAN=NTHETA
+        ELSE
+          N_FIXED=NTHETA
+          FIX0=THETA0
+          FIX1=THETA1
+          IF(STEREO.EQ.'YES') THEN
+            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/(THETA1-THETA0)+
+     &      0.0001)+1
+            IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
+          ENDIF
+          N_SCAN=NPHI
+        ENDIF
+C
+        IF(I_EXT.EQ.-1) THEN
+          N_SCAN=2*N_SCAN
+        ENDIF
+C
+        IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
+          NDP=NTHETA*NPHI*NE
+        ELSEIF(I_EXT.EQ.-1) THEN
+          NDP=NTHETA*NPHI*NE*2
+        ELSEIF(I_EXT.EQ.2) THEN
+          NDP=NTHETA*NE
+          N_FIXED=NTHETA
+          N_SCAN=NPHI
+          IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
+        ENDIF
+C
+        NTT=NFICHLEC*NDP
+        IF(NTT.GT.NDIM_M) GOTO 5
+C
+        IF(ISOM.EQ.1) THEN
+          NPLAN=NP
+          NF=NP
+        ELSEIF(ISOM.EQ.2) THEN
+          NEMET=NFICHLEC
+          NF=NFICHLEC
+          NPLAN=1
+        ENDIF
+C
+        DO JF=1,NF
+C
+C  Reading the headers for each file:
+C
+          IF(JF.GT.1) THEN
+            DO JLINE=1,NHEAD
+              READ(IUO2,888) HEAD(JLINE,JF)
+            ENDDO
+          ENDIF
+C
+          DO JE=1,NE
+C
+           DO J_FIXED=1,N_FIXED
+            IF(N_FIXED.GT.1) THEN
+              XINCRF=FLOAT(J_FIXED-1)*(FIX1-FIX0)/FLOAT(
+     &        N_FIXED-1)
+            ELSEIF(N_FIXED.EQ.1) THEN
+              XINCRF=0.
+            ENDIF
+            IF(IPH_1.EQ.1) THEN
+              JPHI=J_FIXED
+            ELSE
+              THETA=THETA0+XINCRF
+              JTHETA=J_FIXED
+              IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 12
+            ENDIF
+            IF(STEREO.EQ.' NO') THEN
+              N_SCAN_R=N_SCAN
+            ELSE
+              RTHETA=THETA*0.017453
+              FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
+              N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.
+     &        0001)+1
+            ENDIF
+C
+            DO J_SCAN=1,N_SCAN_R
+             IF(IPH_1.EQ.1) THEN
+              JTHETA=J_SCAN
+             ELSE
+              JPHI=J_SCAN
+             ENDIF
+C
+             JLIN=(JF-1)*NDP + (JE-1)*N_FIXED*N_SCAN +(JTHETA-1)
+     &       *NPHI + JPHI
+             IF(I_EXT.LE.0) THEN
+               IF(STEREO.EQ.' NO') THEN
+                 JPHI2=JPHI
+               ELSE
+                 JPHI2=(JTHETA-1)*NPHI+JPHI
+               ENDIF
+             ELSE
+               JPHI2=JTHETA
+             ENDIF
+C
+             IF(ISOM.EQ.1) THEN
+               READ(IUO2,2) JPL
+               IF(JF.EQ.JPL) THEN
+                 BACKSPACE IUO2
+                 IF(IDICHR.EQ.0) THEN
+                   READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),
+     &             DPHI(JPHI2),ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
+                   IF(I_EXT.EQ.-1) THEN
+                     JLIN2=NTT+JLIN
+                     READ(IUO2,25) TAB(JLIN2,1),TAB(
+     &               JLIN2,2)
+                   ENDIF
+                 ELSE
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
+     &             DPHI(JPHI2),ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),TAB(
+     &             JLIN,3),TAB(JLIN,4)
+                   IF(I_EXT.EQ.-1) THEN
+                     JLIN2=NTT+JLIN
+                     READ(IUO2,22) JPL,JEM,DTHETA(
+     &               JTHETA),DPHI(JPHI2),ECIN(JE),TAB(JLIN2,1),TAB(
+     &               JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+                   ENDIF
+                 ENDIF
+               ELSE
+                 BACKSPACE IUO2
+                 DO JLINE=1,NHEAD
+                   BACKSPACE IUO2
+                 ENDDO
+                 DO JL=JLIN,JF*NDP
+                   TAB(JL,1)=0.0
+                   TAB(JL,2)=0.0
+                   TAB(JL,3)=0.0
+                   TAB(JL,4)=0.0
+                 ENDDO
+                 GOTO 13
+               ENDIF
+             ELSEIF(ISOM.EQ.2) THEN
+               IF(IDICHR.EQ.0) THEN
+                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
+                 ENDIF
+               ELSE
+                 READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),
+     &           TAB(JLIN,4)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
+     &             DPHI(JPHI2),ECIN(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(
+     &             JLIN2,3),TAB(JLIN2,4)
+                   ENDIF
+               ENDIF
+             ENDIF
+            ENDDO
+ 12         CONTINUE
+           ENDDO
+          ENDDO
+ 13       CONTINUE
+        ENDDO
+C
+        REWIND IUO2
+C
+C  Writing the headers:
+C
+        DO JLINE=1,2
+          WRITE(IUO2,888) HEAD(JLINE,1)
+        ENDDO
+        DO JF=1,NFICHLEC
+          DO JLINE=3,6
+            WRITE(IUO2,888) HEAD(JLINE,JF)
+          ENDDO
+          WRITE(IUO2,888) HEAD(2,JF)
+        ENDDO
+        DO JLINE=7,NHEAD
+          WRITE(IUO2,888) HEAD(JLINE,1)
+        ENDDO
+C
+        WRITE(IUO2,15) SPECTRO,OUTDATA
+        WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+C
+        IF(ISOM.EQ.1) THEN
+C
+          DO JE=1,NE
+C
+           DO JTHETA=1,NTHETA
+            IF(STEREO.EQ.' NO') THEN
+              NPHI_R=NPHI
+            ELSE
+              RTHETA=DTHETA(JTHETA)*0.017453
+              FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
+              NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.
+     &        0001)+1
+              NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
+            ENDIF
+            DO JPHI=1,NPHI_R
+C
+             TOTDIF_1=0.
+             TOTDIR_1=0.
+             VOLDIF_1=0.
+             VOLDIR_1=0.
+             TOTDIF_2=0.
+             TOTDIR_2=0.
+             VOLDIF_2=0.
+             VOLDIR_2=0.
+             IF(I_EXT.EQ.-1) THEN
+               TOTDIF2_1=0.
+               TOTDIR2_1=0.
+               VOLDIF2_1=0.
+               VOLDIR2_1=0.
+               TOTDIF2_2=0.
+               TOTDIR2_2=0.
+               VOLDIF2_2=0.
+               VOLDIR2_2=0.
+             ENDIF
+C
+             DO JPLAN=1,NPLAN
+              JF=JPLAN
+C
+              JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +(JTHETA-1)*
+     &        NPHI + JPHI
+C
+              SR_1=TAB(JLIN,1)
+              SF_1=TAB(JLIN,2)
+              IF(I_EXT.EQ.-1) THEN
+                 JLIN2=NTT+JLIN
+                 SF2_1=TAB(JLIN2,2)
+                 SR2_1=TAB(JLIN2,1)
+              ENDIF
+              IF(I_EXT.LE.0) THEN
+                IF(STEREO.EQ.' NO') THEN
+                  JPHI2=JPHI
+                ELSE
+                  JPHI2=(JTHETA-1)*NPHI+JPHI
+                ENDIF
+              ELSE
+                JPHI2=JTHETA
+              ENDIF
+              IF(IDICHR.EQ.0) THEN
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(
+     &          JPHI2),ECIN(JE),SR_1,SF_1
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(
+     &            JPHI2),ECIN(JE),SR2_1,SF2_1
+                ENDIF
+              ELSE
+                SR_2=TAB(JLIN,3)
+                SF_2=TAB(JLIN,4)
+                IF(I_EXT.EQ.-1) THEN
+                  JLIN2=NTT+JLIN
+                  SF2_2=TAB(JLIN2,4)
+                  SR2_2=TAB(JLIN2,3)
+                ENDIF
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(
+     &          JPHI2),ECIN(JE),SR_1,SF_1,SR_2,SF_2
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(
+     &            JPHI2),ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
+                ENDIF
+              ENDIF
+              IF(NONVOL(JPLAN).EQ.0) THEN
+                VOLDIF_1=VOLDIF_1+SF_1
+                VOLDIR_1=VOLDIR_1+SR_1
+                IF(I_EXT.EQ.-1) THEN
+                  VOLDIF2_1=VOLDIF2_1+SF2_1
+                  VOLDIR2_1=VOLDIR2_1+SR2_1
+                ENDIF
+                IF(IDICHR.GE.1) THEN
+                  VOLDIF_2=VOLDIF_2+SF_2
+                  VOLDIR_2=VOLDIR_2+SR_2
+                  IF(I_EXT.EQ.-1) THEN
+                    VOLDIF2_2=VOLDIF2_2+SF2_2
+                    VOLDIR2_2=VOLDIR2_1+SR2_2
+                  ENDIF
+                ENDIF
+              ENDIF
+              TOTDIF_1=TOTDIF_1+SF_1
+              TOTDIR_1=TOTDIR_1+SR_1
+              IF(I_EXT.EQ.-1) THEN
+                TOTDIF2_1=TOTDIF2_1+SF2_1
+                TOTDIR2_1=TOTDIR2_1+SR2_1
+              ENDIF
+              IF(IDICHR.GE.1) THEN
+                TOTDIF_2=TOTDIF_2+SF_2
+                TOTDIR_2=TOTDIR_2+SR_2
+                IF(I_EXT.EQ.-1) THEN
+                  TOTDIF2_2=TOTDIF2_2+SF2_2
+                  TOTDIR2_2=TOTDIR2_2+SR2_2
+                ENDIF
+              ENDIF
+             ENDDO
+C
+             IF(IDICHR.EQ.0) THEN
+               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),VOLDIR_1,VOLDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),VOLDIR2_1,VOLDIF2_1
+               ENDIF
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),TOTDIR_1,TOTDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),TOTDIR2_1,TOTDIF2_1
+               ENDIF
+             ELSE
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,
+     &           VOLDIF2_2
+               ENDIF
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     &         ECIN(JE),TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(
+     &           JPHI2),ECIN(JE),TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,
+     &           TOTDIF2_2
+               ENDIF
+             ENDIF
+C
+            ENDDO
+           ENDDO
+          ENDDO
+        ELSEIF(ISOM.EQ.2) THEN
+          DO JE=1,NE
+C
+           DO JTHETA=1,NTHETA
+            IF(STEREO.EQ.' NO') THEN
+              NPHI_R=NPHI
+            ELSE
+              RTHETA=DTHETA(JTHETA)*0.017453
+              FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
+              NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.
+     &        0001)+1
+              NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
+            ENDIF
+            DO JPHI=1,NPHI_R
+C
+              SF_1=0.
+              SR_1=0.
+              SF_2=0.
+              SR_2=0.
+              IF(I_EXT.EQ.-1) THEN
+                SF2_1=0.
+                SR2_1=0.
+                SF2_2=0.
+                SR2_2=0.
+              ENDIF
+C
+              DO JEMET=1,NEMET
+               JF=JEMET
+C
+               JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +(JTHETA-
+     &         1)*NPHI + JPHI
+C
+               SF_1=SF_1+TAB(JLIN,2)
+               SR_1=SR_1+TAB(JLIN,1)
+               IF(I_EXT.EQ.-1) THEN
+                 JLIN2=NTT+JLIN
+                 SF2_1=SF2_1+TAB(JLIN2,2)
+                 SR2_1=SR2_1+TAB(JLIN2,1)
+               ENDIF
+               IF(IDICHR.GE.1) THEN
+                 SF_2=SF_2+TAB(JLIN,4)
+                 SR_2=SR_2+TAB(JLIN,3)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   SF2_2=SF2_2+TAB(JLIN2,4)
+                   SR2_2=SR2_2+TAB(JLIN2,3)
+                 ENDIF
+               ENDIF
+              ENDDO
+              IF(I_EXT.LE.0) THEN
+                IF(STEREO.EQ.' NO') THEN
+                  JPHI2=JPHI
+                ELSE
+                  JPHI2=(JTHETA-1)*NPHI+JPHI
+                ENDIF
+              ELSE
+                JPHI2=JTHETA
+              ENDIF
+              IF(IDICHR.EQ.0) THEN
+                WRITE(IUO2,3) JPL,DTHETA(JTHETA),DPHI(JPHI2),
+     &          ECIN(JE),SR_1,SF_1
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(
+     &            JPHI2),ECIN(JE),SR2_1,SF2_1
+                ENDIF
+              ELSE
+                WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2)
+     &          ,ECIN(JE),SR_1,SF_1,SR_2,SF_2
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(
+     &            JPHI2),ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
+                ENDIF
+              ENDIF
+            ENDDO
+           ENDDO
+          ENDDO
+        ENDIF
+      ENDIF
+C
+      GOTO 6
+C
+   5  WRITE(IUO1,4)
+      STOP
+  35  WRITE(IUO1,36) N_FIXED
+      STOP
+  37  WRITE(IUO1,38) NTHETA*NPHI
+      STOP
+C
+   1  FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
+   2  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+   3  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+   4  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF THE ARRAYS TOO SMALL ',
+     &'IN THE TREAT_PHD SUBROUTINE - INCREASE NDIM_M ','>>>>>>>>>>')
+   7  FORMAT(I4,2X,I4,2X,I4)
+   8  FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
+   9  FORMAT(9(2X,I1),2X,I2)
+  15  FORMAT(2X,A3,11X,A13)
+  22  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,
+     &E12.6,2X,E12.6)
+  23  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,
+     &2X,E12.6)
+  25  FORMAT(37X,E12.6,2X,E12.6)
+  36  FORMAT(//,4X,'<<<<<<<<<<  DIMENSION OF NTH_M OR NPH_M TOO SMALL 
+     &','IN THE INCLUDE FILE >>>>>>>>>>',/,4X,'<<<<<<<<<<              
+     &   SHOULD BE AT LEAST ',I6,'                 >>>>>>>>>>')
+  38  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF NPH_M TOO SMALL ','IN THE 
+     &INCLUDE FILE >>>>>>>>>>',/,8X,'<<<<<<<<<<             SHOULD BE 
+     &AT LEAST ',I6,'             >>>>>>>>>>')
+ 888  FORMAT(A72)
+C
+   6  RETURN
+C
+      END

src/msspec/spec/fortran/led_mi_noso_nosp_nosym/weight_sum.f

@@ -0,0 +1,335 @@
+C
+C=======================================================================
+C
+      SUBROUTINE WEIGHT_SUM(ISOM,I_EXT,I_EXT_A,JEL)
+C
+C   This subroutine performs a weighted sum of the results
+C     corresponding to different directions of the detector.
+C     The directions and weights are read from an external input file
+C
+C   JEL is the electron undetected (i.e. for which the outgoing
+C     directions are integrated over the unit sphere). It is always
+C     1 for one electron spectroscopies (PHD). For APECS, It can be
+C     1 (photoelectron) or 2 (Auger electron) or even 0 (no electron
+C     detected)
+C
+C                                         Last modified : 31 Jan 2007
+C
+      USE DIM_MOD
+      USE INFILES_MOD
+      USE INUNITS_MOD
+      USE OUTUNITS_MOD
+C
+C
+      PARAMETER(N_MAX=5810,NPM=20)
+C
+      REAL*4 W(N_MAX),W_A(N_MAX),ECIN(NE_M)
+      REAL*4 DTHETA(N_MAX),DPHI(N_MAX),DTHETAA(N_MAX),DPHIA(N_MAX)
+      REAL*4 SR_1,SF_1,SR_2,SF_2
+      REAL*4 SUMR_1(NPM,NE_M,N_MAX),SUMR_2(NPM,NE_M,N_MAX)
+      REAL*4 SUMF_1(NPM,NE_M,N_MAX),SUMF_2(NPM,NE_M,N_MAX)
+C
+      CHARACTER*3 SPECTRO,SPECTRO2
+      CHARACTER*5 LIKE
+      CHARACTER*13 OUTDATA
+C
+C
+C
+C
+      DATA JVOL,JTOT/0,-1/
+      DATA LIKE /'-like'/
+C
+      REWIND IUO2
+C
+      READ(IUO2,15) SPECTRO,OUTDATA
+      IF(SPECTRO.NE.'APC') THEN
+        READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+        SPECTRO2='XAS'
+      ELSE
+        READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        READ(IUO2,9) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A,I
+     &THETA_A,IE_A
+        READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+        READ(IUO2,8) NPHI_A,NTHETA_A
+        IF(JEL.EQ.1) THEN
+          SPECTRO2='AED'
+        ELSEIF(JEL.EQ.2) THEN
+          SPECTRO2='PHD'
+        ELSEIF(JEL.EQ.0) THEN
+          SPECTRO2='XAS'
+        ENDIF
+      ENDIF
+C
+      IF(NPLAN.GT.NPM) THEN
+        WRITE(IUO1,4) NPLAN+2
+        STOP
+      ENDIF
+C
+C  Reading the number of angular points
+C
+      IF(SPECTRO.NE.'APC') THEN
+        OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+        READ(IUI6,1) N_POINTS
+        READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+        N_POINTS_A=1
+      ELSE
+        IF(JEL.EQ.1) THEN
+          OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+          READ(IUI6,1) N_POINTS
+          READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+          IF(I_EXT_A.EQ.0) THEN
+            N_POINTS_A=NTHETA_A*NPHI_A
+          ELSE
+            OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
+            READ(IUI9,1) N_POINTS_A
+            READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
+          ENDIF
+          NTHETA0=NTHETA_A
+          NPHI0=NPHI_A
+        ELSEIF(JEL.EQ.2) THEN
+          OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
+          READ(IUI9,1) N_POINTS_A
+          READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
+          IF(I_EXT.EQ.0) THEN
+            N_POINTS=NTHETA*NPHI
+          ELSE
+            OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+            READ(IUI6,1) N_POINTS
+            READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+          ENDIF
+          NTHETA0=NTHETA
+          NPHI0=NPHI
+        ELSEIF(JEL.EQ.0) THEN
+          OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+          OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
+          READ(IUI6,1) N_POINTS
+          READ(IUI9,1) N_POINTS_A
+          READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+          READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
+        ENDIF
+      ENDIF
+C
+      IF(SPECTRO.NE.'APC') THEN
+        NANGLE=1
+      ELSE
+        IF(JEL.EQ.1) THEN
+          NANGLE=N_POINTS_A
+        ELSEIF(JEL.EQ.2) THEN
+          NANGLE=N_POINTS
+        ELSEIF(JEL.EQ.0) THEN
+          NANGLE=1
+        ENDIF
+      ENDIF
+C
+C  Initialization of the arrays
+C
+      DO JE=1,NE
+        DO JANGLE=1,NANGLE
+          DO JPLAN=1,NPLAN+2
+            SUMR_1(JPLAN,JE,JANGLE)=0.
+            SUMF_1(JPLAN,JE,JANGLE)=0.
+            IF(IDICHR.GT.0) THEN
+              SUMR_2(JPLAN,JE,JANGLE)=0.
+              SUMF_2(JPLAN,JE,JANGLE)=0.
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+C
+C  Reading of the data to be angle integrated
+C
+      DO JE=1,NE
+C
+        DO JANGLE=1,N_POINTS
+          IF(I_EXT.NE.0) READ(IUI6,2) TH,PH,W(JANGLE)
+          DO JANGLE_A=1,N_POINTS_A
+            IF((I_EXT_A.NE.0).AND.(JANGLE.EQ.1)) THEN
+               READ(IUI9,2) THA,PHA,W_A(JANGLE_A)
+            ENDIF
+C
+            DO JPLAN=1,NPLAN+2
+C
+              IF(IDICHR.EQ.0) THEN
+                IF(SPECTRO.NE.'APC') THEN
+                  READ(IUO2,3) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE)
+     &,SR_1,SF_1
+                ELSE
+                  READ(IUO2,13) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
+     &),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1
+                ENDIF
+              ELSE
+                IF(SPECTRO.NE.'APC') THEN
+                  READ(IUO2,23) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
+     &),SR_1,SF_1,SR_2,SF_2
+                ELSE
+                  READ(IUO2,24) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
+     &),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1,SR_2,SF_2
+                ENDIF
+              ENDIF
+C
+              IF(JEL.EQ.1) THEN
+                SUMR_1(JPLAN,JE,JANGLE_A)=SUMR_1(JPLAN,JE,JANGLE_A)+SR_1
+     &*W(JANGLE)
+                SUMF_1(JPLAN,JE,JANGLE_A)=SUMF_1(JPLAN,JE,JANGLE_A)+SF_1
+     &*W(JANGLE)
+              ELSEIF(JEL.EQ.2) THEN
+                SUMR_1(JPLAN,JE,JANGLE)=SUMR_1(JPLAN,JE,JANGLE)+SR_1*W_A
+     &(JANGLE_A)
+                SUMF_1(JPLAN,JE,JANGLE)=SUMF_1(JPLAN,JE,JANGLE)+SF_1*W_A
+     &(JANGLE_A)
+              ELSEIF(JEL.EQ.0) THEN
+                SUMR_1(JPLAN,JE,1)=SUMR_1(JPLAN,JE,1)+SR_1*W(JANGLE)*W_A
+     &(JANGLE_A)
+                SUMF_1(JPLAN,JE,1)=SUMF_1(JPLAN,JE,1)+SF_1*W(JANGLE)*W_A
+     &(JANGLE_A)
+              ENDIF
+              IF(IDICHR.GT.0) THEN
+                IF(JEL.EQ.1) THEN
+                  SUMR_2(JPLAN,JE,JANGLE_A)=SUMR_2(JPLAN,JE,JANGLE_A)+SR
+     &_2*W(JANGLE)
+                  SUMF_2(JPLAN,JE,JANGLE_A)=SUMF_2(JPLAN,JE,JANGLE_A)+SF
+     &_2*W(JANGLE)
+                ELSEIF(JEL.EQ.2) THEN
+                  SUMR_2(JPLAN,JE,JANGLE)=SUMR_2(JPLAN,JE,JANGLE)+SR_2*W
+     &_A(JANGLE_A)
+                  SUMF_2(JPLAN,JE,JANGLE)=SUMF_2(JPLAN,JE,JANGLE)+SF_2*W
+     &_A(JANGLE_A)
+                ELSEIF(JEL.EQ.0) THEN
+                  SUMR_2(JPLAN,JE,1)=SUMR_2(JPLAN,JE,1)+SR_2*W(JANGLE)*W
+     &_A(JANGLE_A)
+                  SUMF_2(JPLAN,JE,1)=SUMF_2(JPLAN,JE,1)+SF_2*W(JANGLE)*W
+     &_A(JANGLE_A)
+                ENDIF
+              ENDIF
+C
+            ENDDO
+C
+          ENDDO
+          IF(I_EXT_A.NE.0) THEN
+            REWIND IUI9
+            READ(IUI9,1) NDUM
+            READ(IUI9,1) NDUM
+          ENDIF
+        ENDDO
+C
+        IF(I_EXT.NE.0) THEN
+          REWIND IUI6
+          READ(IUI6,1) NDUM
+          READ(IUI6,1) NDUM
+        ENDIF
+      ENDDO
+C
+      CLOSE(IUI6)
+      CLOSE(IUI9)
+      REWIND IUO2
+C
+      WRITE(IUO2,16) SPECTRO2,LIKE,SPECTRO,OUTDATA
+      IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+        WRITE(IUO2,19) ISPIN,IDICHR,I_SO,ISFLIP
+        WRITE(IUO2,18) NE,NPLAN,ISOM
+      ELSEIF(JEL.EQ.1) THEN
+        WRITE(IUO2,20) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A
+     &,ITHETA_A,IE_A
+        WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
+      ELSEIF(JEL.EQ.2) THEN
+        WRITE(IUO2,20) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
+      ENDIF
+C
+      DO JE=1,NE
+        DO JANGLE=1,NANGLE
+          IF(SPECTRO.EQ.'APC') THEN
+            IF(JEL.EQ.1) THEN
+              THETA=DTHETAA(JANGLE)
+              PHI=DPHIA(JANGLE)
+            ELSEIF(JEL.EQ.2) THEN
+              THETA=DTHETA(JANGLE)
+              PHI=DPHI(JANGLE)
+            ENDIF
+          ENDIF
+C
+          DO JPLAN=1,NPLAN
+            IF(IDICHR.EQ.0) THEN
+              IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+                WRITE(IUO2,33) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
+     &MF_1(JPLAN,JE,JANGLE)
+              ELSE
+                WRITE(IUO2,34) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
+     &JANGLE),SUMF_1(JPLAN,JE,JANGLE)
+              ENDIF
+            ELSE
+              IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+                WRITE(IUO2,43) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
+     &MF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPLAN,JE,JANG
+     &LE)
+              ELSE
+                WRITE(IUO2,44) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
+     &JANGLE),SUMF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPL
+     &AN,JE,JANGLE)
+              ENDIF
+            ENDIF
+          ENDDO
+C
+          IF(IDICHR.EQ.0) THEN
+            IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+              WRITE(IUO2,33) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
+     &F_1(NPLAN+1,JE,JANGLE)
+              WRITE(IUO2,33) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
+     &F_1(NPLAN+2,JE,JANGLE)
+            ELSE
+              WRITE(IUO2,34) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
+     &ANGLE),SUMF_1(NPLAN+1,JE,JANGLE)
+              WRITE(IUO2,34) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
+     &ANGLE),SUMF_1(NPLAN+2,JE,JANGLE)
+            ENDIF
+          ELSE
+            IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+              WRITE(IUO2,43) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
+     &F_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(NPLAN+1,JE
+     &,JANGLE)
+              WRITE(IUO2,43) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
+     &F_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(NPLAN+2,JE
+     &,JANGLE)
+            ELSE
+              WRITE(IUO2,44) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
+     &ANGLE),SUMF_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(
+     &NPLAN+1,JE,JANGLE)
+              WRITE(IUO2,44) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
+     &ANGLE),SUMF_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(
+     &NPLAN+2,JE,JANGLE)
+            ENDIF
+          ENDIF
+C
+        ENDDO
+      ENDDO
+C
+   1  FORMAT(13X,I4)
+   2  FORMAT(15X,F8.3,3X,F8.3,3X,E12.6)
+   3  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+   4  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF THE ARRAYS TOO SMALL ','IN 
+     &THE WEIGHT_SUM SUBROUTINE - INCREASE NPM TO ',I3,'>>>>>>>>>>')
+   5  FORMAT(6X,I1,1X,I3,3X,I3)
+   8  FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
+   9  FORMAT(9(2X,I1),2X,I2)
+  13  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
+     &12.6)
+  15  FORMAT(2X,A3,11X,A13)
+  16  FORMAT(2X,A3,A5,1X,A3,2X,A13)
+  18  FORMAT(I4,2X,I3,2X,I1)
+  19  FORMAT(4(2X,I1))
+  20   FORMAT(8(2X,I1))
+  21   FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
+  23  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
+     &,E12.6)
+  24  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
+     &12.6,2X,E12.6,2X,E12.6)
+  33  FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6)
+  34  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+  43  FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
+  44  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
+     &,E12.6)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/memalloc/allocation.f

@@ -25,6 +25,9 @@
         USE OUTUNITS_MOD
         USE PARCAL_MOD
         USE PARCAL_A_MOD
+        USE CORREXP_MOD
+        USE GAUNT_C_MOD
+        USE Q_ARRAY_MOD
         USE RELADS_MOD
         USE RELAX_MOD
         USE RESEAU_MOD
@@ -136,6 +139,7 @@
         CALL ALLOC_OUTUNITS()
         CALL ALLOC_PARCAL()
         CALL ALLOC_PARCAL_A()
+        CALL ALLOC_Q_ARRAY()
         CALL ALLOC_RELADS()
         CALL ALLOC_RELAX()
         CALL ALLOC_RENORM()
@@ -173,6 +177,7 @@
         CALL ALLOC_C_G()
         CALL ALLOC_C_G_A()
         CALL ALLOC_C_G_M()
+        CALL ALLOC_CORREXP()
         CALL ALLOC_DEXPFAC2()
         CALL ALLOC_DFACTSQ()
         CALL ALLOC_EIGEN()
@@ -186,6 +191,7 @@
         CALL ALLOC_SPECTRUM()
         CALL ALLOC_DIRECT()
         CALL ALLOC_DIRECT_A()
+        CALL ALLOC_GAUNT_C()
         CALL ALLOC_PATH()
         CALL ALLOC_ROT()
         CALL ALLOC_ROT_CUB()

src/msspec/spec/fortran/memalloc/dim_mod.f

@@ -34,6 +34,7 @@ C       ===============================================================
         INTEGER NCG_M
         INTEGER N_BESS, N_GAUNT
         INTEGER NLTWO
+        INTEGER NLMM
 C       ===============================================================
       CONTAINS
         SUBROUTINE INIT_DIM()
@@ -60,9 +61,10 @@ C       ===============================================================
 
 C          N_BESS=100*NL_M
 C          N_GAUNT=5*NL_M
-          N_BESS=200*NL_M
+          N_BESS=300*NL_M
           N_GAUNT=10*NL_M
 
           NLTWO=2*NL_M
+          NLMM=LINMAX*NGR_M
         END SUBROUTINE INIT_DIM
       END MODULE DIM_MOD

src/msspec/spec/fortran/memalloc/modules.f

@@ -192,6 +192,20 @@ C=======================================================================
         END SUBROUTINE ALLOC_COOR
       END MODULE COOR_MOD
 
+C=======================================================================
+      MODULE CORREXP_MOD
+        IMPLICIT NONE
+        COMPLEX*16, ALLOCATABLE, DIMENSION(:,:) :: A
+      CONTAINS
+        SUBROUTINE ALLOC_CORREXP()
+          USE DIM_MOD
+          IF (ALLOCATED(A)) THEN
+            DEALLOCATE(A)
+          ENDIF
+          ALLOCATE(A(NLMM,NLMM))
+        END SUBROUTINE ALLOC_CORREXP
+      END MODULE CORREXP_MOD
+
 C=======================================================================
       MODULE DEBWAL_MOD
         IMPLICIT NONE
@@ -417,6 +431,20 @@ C=======================================================================
         END SUBROUTINE ALLOC_PARCAL_A
       END MODULE PARCAL_A_MOD
 
+C=======================================================================
+      MODULE Q_ARRAY_MOD
+        IMPLICIT NONE
+        REAL, ALLOCATABLE, DIMENSION(:) :: Q
+      CONTAINS
+        SUBROUTINE ALLOC_Q_ARRAY()
+          USE DIM_MOD
+          IF (ALLOCATED(Q)) THEN
+            DEALLOCATE(Q)
+          ENDIF
+          ALLOCATE(Q(NGR_M))
+        END SUBROUTINE ALLOC_Q_ARRAY
+      END MODULE Q_ARRAY_MOD
+
 C=======================================================================
       MODULE RELADS_MOD
         IMPLICIT NONE
@@ -778,6 +806,20 @@ C=======================================================================
         END SUBROUTINE ALLOC_DEXPFAC
       END MODULE DEXPFAC_MOD
 
+C=======================================================================
+      MODULE GAUNT_C_MOD
+        IMPLICIT NONE
+        REAL*8, ALLOCATABLE, DIMENSION(:,:,:) :: GNT
+      CONTAINS
+        SUBROUTINE ALLOC_GAUNT_C()
+          USE DIM_MOD
+          IF (ALLOCATED(GNT)) THEN
+            DEALLOCATE(GNT)
+          ENDIF
+          ALLOCATE(GNT(0:N_GAUNT,LINMAX,LINMAX))
+        END SUBROUTINE ALLOC_GAUNT_C
+      END MODULE GAUNT_C_MOD
+
 C=======================================================================
       MODULE LOGAMAD_MOD
         IMPLICIT NONE

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym.mk

@@ -0,0 +1,11 @@
+memalloc_src               := memalloc/dim_mod.f memalloc/modules.f memalloc/allocation.f 
+cluster_gen_src            := $(wildcard cluster_gen/*.f)
+common_sub_src             := $(wildcard common_sub/*.f)
+renormalization_src        := $(wildcard renormalization/*.f)
+phd_ce_noso_nosp_nosym_src := $(filter-out phd_ce_noso_nosp_nosym/lapack_axb.f, $(wildcard phd_ce_noso_nosp_nosym/*.f))
+
+SRCS   = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(phd_ce_noso_nosp_nosym_src)
+MAIN_F = phd_ce_noso_nosp_nosym/main.f
+SO     = _phd_ce_noso_nosp_nosym.so
+
+include ../../../options.mk

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/cmngr.f

@@ -0,0 +1,41 @@
+C
+C======================================================================
+C
+      SUBROUTINE CMNGR(NAT,NGR,CMN)
+C
+C    input   : NAT,NGR
+C    output  : CMN
+C
+C    This subroutine calculate C(NAT-N,M-N) where,
+C                    1<=M<=NGR<=NAT,1<=N<=M
+C               C(NAT-N,M-N) is stored as CMN(N,M)
+C
+C                                              H.-F. Zhao 2007
+C
+      USE DIM_MOD
+C
+      INTEGER NAT,NGR
+C
+      REAL CMN(NGR_M,NGR_M)
+C
+      IF(NGR.GT.NAT) THEN
+        WRITE(6,*) 'NGR is larger than NAT, which is wrong'
+        STOP
+      ENDIF
+C
+      DO M=1,NGR
+        DO N=1,NGR
+          CMN(N,M)=0.
+        ENDDO
+        CMN(M,M)=1.
+      ENDDO
+C
+      DO M=1,NGR
+        DO N=M-1,1,-1
+          CMN(N,M)=CMN(N+1,M)*FLOAT(NAT-N)/FLOAT(M-N)
+        ENDDO
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/coefpq.f

@@ -0,0 +1,46 @@
+C
+C======================================================================
+C
+      SUBROUTINE COEFPQ(NAT,NGR)
+C
+C  This subroutine computes the P(n,m) and Q(n) coefficients 
+C   involved in the correlation expansion formulation
+C
+C  Reference  : equations (2.15) and (2.16) of 
+C               H. Zhao, D. Sebilleau and Z. Wu, 
+C               J. Phys.: Condens. Matter 20, 275241 (2008)
+C
+C                                                    H.-F. Zhao 2007
+C
+      USE DIM_MOD
+      USE Q_ARRAY_MOD
+C
+      INTEGER NAT,NGR
+C
+      REAL CMN(NGR_M,NGR_M),P(NGR_M,NGR_M)
+C
+C
+      IF(NGR.GT.NAT) THEN
+        WRITE(6,*) 'NGR is larger than NAT, which is wrong'
+        STOP
+      ENDIF
+C
+      CALL CMNGR(NAT,NGR,CMN)
+C
+      DO N=1,NGR
+        P(N,N)=1.
+        Q(N)=P(N,N)
+        DO M=N+1,NGR
+          P(N,M)=0.
+          DO I=N,M-1
+            P(N,M)=P(N,M)-P(N,I)*CMN(I,M)
+          ENDDO
+          Q(N)=Q(N)+P(N,M)
+C
+        ENDDO
+C
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/corexp.f

@@ -0,0 +1,47 @@
+C
+C======================================================================
+C
+      SUBROUTINE COREXP_SAVM(JE,IGR,NGR,NLM,ITYPE,IGS,TAU)
+C
+C  This subroutine call the correlation matrices calculations
+C    for a given order IGR
+C
+C                                         H.-F. Zhao : 2007
+C
+      USE DIM_MOD
+      USE COOR_MOD
+      USE Q_ARRAY_MOD
+      USE TRANS_MOD
+C
+      INTEGER NLM(NGR_M),ITYPE(NGR_M),IGS(NGR_M)
+C
+      REAL QI
+C
+      COMPLEX*16 TAU(LINMAX,LINFMAX,NATCLU_M)
+C
+C
+      DO ITYP=1,N_PROT
+        NBTYP=NATYP(ITYP)
+        NLM(IGR)=LMAX(ITYP,JE)
+        ITYPE(IGR)=ITYP
+        DO NUM=1,NBTYP
+          IGS(IGR)=NCORR(NUM,ITYP)
+C
+          IF(IGS(IGR).GT.IGS(IGR-1)) THEN
+            QI=Q(IGR)
+            CALL MPIS(IGR,NLM,ITYPE,IGS,JE,QI,TAU)
+C
+            IGR=IGR+1
+            IF(IGR.LE.NGR) THEN
+              CALL COREXP_SAVM1(JE,IGR,NGR,NLM,ITYPE,IGS,TAU)
+            ENDIF
+            IGR=IGR-1
+C
+          ENDIF
+C
+        ENDDO
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/corexp1.f

@@ -0,0 +1,19 @@
+C
+C======================================================================
+C
+      SUBROUTINE COREXP_SAVM1(JE,IGR,NGR,NLM,ITYPE,IGS,TAU)
+C
+C  This subroutine allows a recursive use of COREXP_SAVM
+C
+C                                          H.-F. Zhao : 2007
+C
+      USE DIM_MOD
+C
+      INTEGER NLM(NGR_M),ITYPE(NGR_M),IGS(NGR_M)
+      COMPLEX*16 TAU(LINMAX,LINFMAX,NATCLU_M)
+C
+      CALL COREXP_SAVM(JE,IGR,NGR,NLM,ITYPE,IGS,TAU)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/coumat.f

@@ -0,0 +1,121 @@
+C
+C=======================================================================
+C
+      SUBROUTINE COUMAT(ITL,MI,LF,MF,DELTA,RADIAL,MATRIX)
+C
+C  This routine calculates the spin-independent PhD optical matrix
+C       elements for dipolar excitations. It is stored in
+C                          MATRIX(JDIR,JPOL)
+C
+C  Here, the conventions are :
+C
+C             IPOL=1  : linearly polarized light
+C             IPOL=2  : circularly polarized light
+C
+C             JPOL=1  : +/x polarization for circular/linear light
+C             JPOL=2  : -/y polarization for circular/linear light
+C
+C  When IDICHR=0, JDIR = 1,2 and 3 correspond respectively to the x,y
+C       and z directions for the linear polarization. But for IDICHR=1,
+C       these basis directions are those of the position of the light.
+C
+C                                     Last modified :  8 Dec 2008
+C
+      USE DIM_MOD
+C
+      USE INIT_L_MOD , L2 => NNL, L3 => LF1, L4 => LF2, L5 => ISTEP_LF
+      USE SPIN_MOD , I1 => ISPIN, N1 => NSPIN, N2 => NSPIN2, I2 => ISFLI
+     &P, I8 => IR_DIA, N3 => NSTEP
+      USE TYPCAL_MOD , I3 => IPHI, I4 => IE, I5 => ITHETA, I6 => IFTHET,
+     & I7 => IMOD, I9 => I_CP, I10 => I_EXT
+C
+      COMPLEX MATRIX(3,2),SUM_1,SUM_2,DELTA,YLM(3,-1:1),RADIAL
+      COMPLEX ONEC,IC,IL,COEF,PROD
+C
+      REAL RLM(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1),GNT(0:N_GAUNT)
+      REAL THETA(3),PHI(3)
+C
+      DATA PI4S3,C_LIN,SQR2 /4.188790,1.447202,1.414214/
+      DATA PIS2 /1.570796/
+C
+      ONEC=(1.,0.)
+      IC=(0.,1.)
+C
+      IF(INITL.EQ.0) GOTO 2
+C
+      M=MF-MI
+C
+      IF(MOD(LF,4).EQ.0) THEN
+        IL=ONEC
+      ELSEIF(MOD(LF,4).EQ.1) THEN
+        IL=IC
+      ELSEIF(MOD(LF,4).EQ.2) THEN
+        IL=-ONEC
+      ELSEIF(MOD(LF,4).EQ.3) THEN
+        IL=-IC
+      ENDIF
+C
+      CALL GAUNT(LI,MI,LF,MF,GNT)
+C
+      IF(ITL.EQ.0) THEN
+c        COEF=CEXP(IC*DELTA)*CONJG(IL)
+        COEF=CEXP(IC*DELTA)*IL
+      ELSE
+        IF(IDICHR.EQ.0) THEN
+c          COEF=PI4S3*CONJG(IL)
+          COEF=PI4S3*IL
+        ELSE
+c          COEF=C_LIN*CONJG(IL)
+          COEF=C_LIN*IL
+        ENDIF
+      ENDIF
+C
+      PROD=COEF*RADIAL*GNT(1)
+C
+      IF(IDICHR.EQ.0) THEN
+        YLM(1,-1)=(0.345494,0.)
+        YLM(1,0)=(0.,0.)
+        YLM(1,1)=(-0.345494,0.)
+        YLM(2,-1)=(0.,-0.345494)
+        YLM(2,0)=(0.,0.)
+        YLM(2,1)=(0.,-0.345494)
+        YLM(3,-1)=(0.,0.)
+        YLM(3,0)=(0.488602,0.)
+        YLM(3,1)=(0.,0.)
+C
+        DO JDIR=1,3
+          MATRIX(JDIR,1)=PROD*CONJG(YLM(JDIR,M))
+        ENDDO
+C
+      ELSEIF(IDICHR.GE.1) THEN
+C
+        THETA(1)=PIS2
+        PHI(1)=0.
+        THETA(2)=PIS2
+        PHI(2)=PIS2
+        THETA(3)=0.
+        PHI(3)=0.
+C
+        DO JDIR=1,3
+          CALL DJMN(THETA(JDIR),RLM,1)
+          SUM_1=RLM(-1,M,1)*PROD*CEXP((0.,-1.)*M*PHI(JDIR))
+          SUM_2=RLM(1,M,1)*PROD*CEXP((0.,-1.)*M*PHI(JDIR))
+          IF(IPOL.EQ.2) THEN
+            MATRIX(JDIR,1)=SQR2*SUM_1
+            MATRIX(JDIR,2)=SQR2*SUM_2
+          ELSEIF(ABS(IPOL).EQ.1) THEN
+            MATRIX(JDIR,1)=(SUM_2-SUM_1)
+            MATRIX(JDIR,2)=(SUM_2+SUM_1)*IC
+          ENDIF
+        ENDDO
+      ENDIF
+      GOTO 1
+C
+   2  DO JDIR=1,3
+        MATRIX(JDIR,1)=ONEC
+        MATRIX(JDIR,2)=ONEC
+      ENDDO
+C
+   1  RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/dwsph.f

@@ -0,0 +1,85 @@
+C
+C=======================================================================
+C
+      SUBROUTINE DWSPH(JTYP,JE,X,TLT,ISPEED)
+C
+C  This routine recomputes the T-matrix elements taking into account the
+C                mean square displacements.
+C
+C  When the argument X is tiny, no vibrations are taken into account
+C
+C                                      Last modified : 25 Apr 2013
+C
+      USE DIM_MOD
+C
+      USE TRANS_MOD
+C
+      DIMENSION GNT(0:N_GAUNT)
+C
+      COMPLEX TLT(0:NT_M,4,NATM,NE_M),SL1,ZEROC
+C
+      COMPLEX*16 FFL(0:2*NL_M)
+C
+      DATA PI4,EPS /12.566371,1.0E-10/
+C
+      ZEROC=(0.,0.)
+C
+      IF(X.GT.EPS) THEN
+C
+C  Standard case: vibrations
+C
+        IF(ISPEED.LT.0) THEN
+          NSUM_LB=ABS(ISPEED)
+        ENDIF
+C
+        COEF=PI4*EXP(-X)
+        NL2=2*LMAX(JTYP,JE)+2
+        IBESP=5
+        MG1=0
+        MG2=0
+C
+        CALL BESPHE(NL2,IBESP,X,FFL)
+C
+        DO L=0,LMAX(JTYP,JE)
+          XL=FLOAT(L+L+1)
+          SL1=ZEROC
+C
+          DO L1=0,LMAX(JTYP,JE)
+            XL1=FLOAT(L1+L1+1)
+            CALL GAUNT(L,MG1,L1,MG2,GNT)
+            L2MIN=ABS(L1-L)
+            IF(ISPEED.GE.0) THEN
+              L2MAX=L1+L
+            ELSEIF(ISPEED.LT.0) THEN
+              L2MAX=L2MIN+2*(NSUM_LB-1)
+            ENDIF
+            SL2=0.
+C
+            DO L2=L2MIN,L2MAX,2
+              XL2=FLOAT(L2+L2+1)
+              C=SQRT(XL1*XL2/(PI4*XL))
+              SL2=SL2+C*GNT(L2)*REAL(DREAL(FFL(L2)))
+            ENDDO
+C
+            SL1=SL1+SL2*TL(L1,1,JTYP,JE)
+          ENDDO
+C
+          TLT(L,1,JTYP,JE)=COEF*SL1
+C
+        ENDDO
+C
+      ELSE
+C
+C  Argument X tiny: no vibrations
+C
+        DO L=0,LMAX(JTYP,JE)
+C
+          TLT(L,1,JTYP,JE)=TL(L,1,JTYP,JE)
+C
+        ENDDO
+C
+      ENDIF
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/facdif.f

@@ -0,0 +1,26 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF(COSTH,JAT,JE,FTHETA)
+C
+C  This routine computes the plane wave scattering factor
+C
+      USE DIM_MOD
+C
+      USE TRANS_MOD
+C
+      DIMENSION PL(0:100)
+C
+      COMPLEX FTHETA
+C
+      FTHETA=(0.,0.)
+      NL=LMAX(JAT,JE)+1
+      CALL POLLEG(NL,COSTH,PL)
+      DO 20 L=0,NL-1
+        FTHETA=FTHETA+(2*L+1)*TL(L,1,JAT,JE)*PL(L)
+  20  CONTINUE
+      FTHETA=FTHETA/VK(JE)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/facdif1.f

@@ -0,0 +1,113 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF1(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,FSPH,JAT,J
+     &E,*)
+C
+C  This routine computes a spherical wave scattering factor
+C
+C                                        Last modified : 03/04/2006
+C
+      USE DIM_MOD
+      USE APPROX_MOD
+      USE EXPFAC_MOD
+      USE TRANS_MOD
+      USE TYPCAL_MOD , I2 => IPHI, I3 => IE, I4 => ITHETA, I5 => IMOD, I
+     &6 => IPOL, I7 => I_CP, I8 => I_EXT, I9 => I_TEST
+C
+      DIMENSION PLMM(0:100,0:100)
+      DIMENSION D(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
+C
+      COMPLEX HLM(0:NO_ST_M,0:NL_M-1),HLN(0:NO_ST_M,0:NL_M-1),FSPH,RHOJ
+      COMPLEX HLM1,HLM2,HLM3,HLM4,ALMU,BLMU,SLP,SNU,SMU,VKE
+      COMPLEX RHOJK
+C
+C
+      DATA PI/3.141593/
+C
+      A=1.
+      INTER=0
+      IF(ITL.EQ.1) VKE=VK(JE)
+      RHOJ=VKE*RJ
+      RHOJK=VKE*RJK
+      HLM1=(1.,0.)
+      HLM2=(1.,0.)
+      HLM3=(1.,0.)
+      HLM4=(1.,0.)
+      IEM=1
+      CSTH=COS(BETA)
+      IF((IFTHET.EQ.0).OR.(THRJ.LT.0.0001)) THEN
+        INTER=1
+        BLMU=SQRT(4.*PI/FLOAT(2*L+1))*CEXP((0.,-1.)*M*(PHIRJ-PI))
+      ENDIF
+      CALL PLM(CSTH,PLMM,LMAX(JAT,JE))
+      IF(ISPHER.EQ.0) NO1=0
+      IF(ISPHER.EQ.1) THEN
+        IF(NO.EQ.8) THEN
+          NO1=LMAX(JAT,JE)+1
+        ELSE
+          NO1=NO
+        ENDIF
+        CALL POLHAN(ISPHER,NO1,LMAX(JAT,JE),RHOJ,HLM)
+         IF(IEM.EQ.0) THEN
+          HLM4=HLM(0,L)
+        ENDIF
+        IF(RJK.GT.0.0001) THEN
+          NDUM=0
+          CALL POLHAN(ISPHER,NDUM,LMAX(JAT,JE),RHOJK,HLN)
+        ENDIF
+        CALL DJMN(THRJ,D,L)
+        A1=ABS(D(0,M,L))
+        IF(((A1.LT.0.0001).AND.(IFTHET.EQ.1)).AND.(INTER.EQ.0)) RETURN 1
+     &
+      ENDIF
+      MUMAX=MIN0(L,NO1)
+      SMU=(0.,0.)
+      DO 10 MU=0,MUMAX
+        IF(MOD(MU,2).EQ.0) THEN
+          B=1.
+        ELSE
+          B=-1.
+          IF(SIN(BETA).LT.0.) THEN
+            A=-1.
+          ENDIF
+        ENDIF
+        IF(ISPHER.LE.1) THEN
+          ALMU=(1.,0.)
+          C=1.
+        ENDIF
+        IF(ISPHER.EQ.0) GOTO 40
+        IF(INTER.EQ.0) BLMU=CMPLX(D(M,0,L))
+        IF(MU.GT.0) THEN
+          C=B*FLOAT(L+L+1)/EXPF(MU,L)
+          ALMU=(D(M,MU,L)*CEXP((0.,-1.)*MU*GAMMA)+B*
+     *          CEXP((0.,1.)*MU*GAMMA)*D(M,-MU,L))/BLMU
+        ELSE
+          C=1.
+          ALMU=CMPLX(D(M,0,L))/BLMU
+        ENDIF
+  40    SNU=(0.,0.)
+        NU1=INT(0.5*(NO1-MU)+0.0001)
+        NUMAX=MIN0(NU1,L-MU)
+        DO 20 NU=0,NUMAX
+          SLP=(0.,0.)
+          LPMIN=MAX0(MU,NU)
+          DO 30 LP=LPMIN,LMAX(JAT,JE)
+            IF(ISPHER.EQ.1) THEN
+              HLM1=HLM(NU,LP)
+              IF(RJK.GT.0.0001) HLM3=HLN(0,LP)
+            ENDIF
+            SLP=SLP+FLOAT(2*LP+1)*TL(LP,1,JAT,JE)*HLM1*PLMM(LP,MU)*HLM3
+  30      CONTINUE
+          IF(ISPHER.EQ.1) THEN
+            HLM2=HLM(MU+NU,L)
+          ENDIF
+          SNU=SNU+SLP*HLM2
+  20    CONTINUE
+        SMU=SMU+SNU*C*ALMU*A*B
+  10  CONTINUE
+      FSPH=SMU/(VKE*HLM4)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/gaunt_st.f

@@ -0,0 +1,126 @@
+C
+C=======================================================================
+C
+      SUBROUTINE GAUNT_ST(LMAX_T)
+C
+C   This subroutine calculates the Gaunt coefficient G(L2,L3|L1)
+C    using a downward recursion scheme due to Schulten and Gordon 
+C    for the Wigner's 3j symbols. The result is stored as GNT(L3), 
+C    making use of the selection rule M3 = M1 - M2.  
+C     
+C   Ref. :  K. Schulten and R. G. Gordon, J. Math. Phys. 16, 1961 (1975) 
+C
+C   This is the double precision version where the values are stored
+C
+C                                          Last modified : 14 May 2009
+C
+C
+      USE DIM_MOD
+      USE LOGAMAD_MOD
+      USE GAUNT_C_MOD
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+C
+      INTEGER LMAX_T
+C
+      REAL*8 F(0:N_GAUNT),G(0:N_GAUNT),A(0:N_GAUNT),A1(0:N_GAUNT)
+      REAL*8 B(0:N_GAUNT)
+C
+      DATA PI4/12.566370614359D0/
+C
+      DO L1=0,LMAX_T
+        IL1=L1*L1+L1+1
+        DO M1=-L1,L1
+          IND1=IL1+M1
+          LM1=L1+M1
+          KM1=L1-M1
+          DO L2=0,LMAX_T
+            IL2=L2*L2+L2+1
+C
+            IF(MOD(M1,2).EQ.0) THEN
+              COEF=DSQRT(DFLOAT((L1+L1+1)*(L2+L2+1))/PI4)
+            ELSE
+              COEF=-DSQRT(DFLOAT((L1+L1+1)*(L2+L2+1))/PI4)
+            ENDIF
+C
+            L12=L1+L2
+            K12=L1-L2
+            L12_1=L12+L12+1
+            L12_2=L12*L12
+            L12_21=L12*L12+L12+L12+1
+            K12_2=K12*K12
+C
+            F(L12+1)=0.D0
+            G(L12+1)=0.D0
+            A(L12+1)=0.D0
+            A1(L12+1)=0.D0
+            A1(L12)=2.D0*DSQRT(DFLOAT(L1*L2*L12_1*L12_2))
+            D1=GLD(L2+L2+1,1)-GLD(L12_1+1,1)
+            D5=0.5D0*(GLD(L1+L1+1,1)+GLD(L2+L2+1,1)-GLD(L12_1+1,1))
+            D6=GLD(L12+1,1)-GLD(L1+1,1)-GLD(L2+1,1)
+C
+            IF(MOD(K12,2).EQ.0) THEN
+              G(L12)=DEXP(D5+D6)
+            ELSE
+              G(L12)=-DEXP(D5+D6)
+            ENDIF
+C
+            DO M2=-L2,L2
+              IND2=IL2+M2
+C
+              M3=M1-M2
+              LM2=L2+M2
+              KM2=L2-M2
+C
+              DO J=1,N_GAUNT
+                GNT(J,IND2,IND1)=0.D0
+              ENDDO
+C
+              IF((ABS(M1).GT.L1).OR.(ABS(M2).GT.L2)) GOTO 10
+C
+              D2=GLD(L1+L1+1,1)-GLD(LM2+1,1)
+              D3=GLD(L12+M3+1,1)-GLD(KM2+1,1)
+              D4=GLD(L12-M3+1,1)-GLD(LM1+1,1)-GLD(KM1+1,1)
+C
+              IF(MOD(KM1-KM2,2).EQ.0) THEN
+                F(L12)=DSQRT(DEXP(D1+D2+D3+D4))
+              ELSE
+                F(L12)=-DSQRT(DEXP(D1+D2+D3+D4))
+              ENDIF
+C
+              A(L12)=2.D0*DSQRT(DFLOAT(L1*L2*L12_1*(L12_2-M3*M3)))
+              B(L12)=-DFLOAT(L12_1*((L2*L2-L1*L1-K12)*M3+L12*(L12+1)
+     1               *(M2+M1)))
+C
+              IF(ABS(M3).LE.L12) THEN 
+                GNT(L12,IND2,IND1)=COEF*F(L12)*G(L12)*
+     1                              DSQRT(DFLOAT(L12_1))
+              ENDIF
+C
+              JMIN=MAX0(ABS(K12),ABS(M3))
+C
+              DO J=L12-1,JMIN,-1
+                J1=J+1
+                J2=J+2
+                JJ=J*J
+                A1(J)=DSQRT(DFLOAT(JJ*(JJ-K12_2)*(L12_21-JJ)))
+                A(J)=DSQRT(DFLOAT((JJ-K12_2)*(L12_21-JJ)*(JJ-M3*M3)))
+                B(J)=-DFLOAT((J+J1)*(L2*(L2+1)*M3-L1*(L1+1)*M3+J*J1*
+     1                        (M2+M1)))
+                F(J)=-(DFLOAT(J1)*A(J2)*F(J2)+B(J1)*F(J1))/(DFLOAT(J2)*
+     1                 A(J1))
+                G(J)=-(DFLOAT(J1)*A1(J2)*G(J2))/(DFLOAT(J2)*A1(J1))
+C
+                IF(ABS(M3).LE.J) THEN 
+                  GNT(J,IND2,IND1)=COEF*F(J)*G(J)*DSQRT(DFLOAT(J+J1))
+                ENDIF
+              ENDDO
+C
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+C
+  10  RETURN
+C
+      END
+ 

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/main.f

@@ -0,0 +1,21 @@
+      SUBROUTINE RUN(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_, 
+     &  NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_, 
+     &  NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_, 
+     &  N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
+
+        USE DIM_MOD
+        IMPLICIT INTEGER (A-Z)
+CF2PY   INTEGER, INTENT(IN,COPY) :: NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_
+CF2PY   INTEGER, INTENT(IN,COPY) :: NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_ 
+CF2PY   INTEGER, INTENT(IN,COPY) :: NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_
+CF2PY   INTEGER, INTENT(IN,COPY) :: N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_
+
+        CALL ALLOCATION(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_, 
+     &  NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_, 
+     &  NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_, 
+     &  N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
+
+        CALL MAIN_PHD_NS_CE()
+        CALL CLOSE_ALL_FILES()
+
+      END SUBROUTINE RUN

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/mpis.f

@@ -0,0 +1,280 @@
+C
+C
+C======================================================================
+C
+      SUBROUTINE MPIS(N,NLM,ITYP,IGS,JE,QI,TAU)
+C
+C
+C   This subroutine construct the correlation matrices and uses
+C    LU decomposition method to do the matrix inversion.
+C   The inverse matrix which is the contribution of a small atom group 
+C    is kept for further use.
+C
+C                                                  H. -F. Zhao : 2007
+C
+C                                    Last modified (DS) : 13 May 2009
+C
+      USE DIM_MOD
+      USE COOR_MOD
+      USE INIT_L_MOD
+      USE GAUNT_C_MOD
+      USE TRANS_MOD
+      USE CORREXP_MOD
+C
+      INTEGER NLM(NGR_M),ITYP(NGR_M),IGS(NGR_M)
+      COMPLEX*16 TAU(LINMAX,LINFMAX,NATCLU_M)
+C
+      REAL QI
+C
+      COMPLEX*16 ZEROC,ONEC,IC
+C
+      COMPLEX*16 ATTL(0:NT_M,NATM)
+      COMPLEX*16 EXPJN,ATTJN
+      COMPLEX*16 YLM(0:NLTWO,-NLTWO:NLTWO)
+      COMPLEX*16 HL1(0:NLTWO)
+      COMPLEX*16 SUM_L,SUM_L2
+      COMPLEX*16 SUM_L_A,SUM_L2_A,SUM_L_B,SUM_L2_B
+C
+      REAL*8 FOURPI
+      REAL*8 XJN,YJN,ZJN,RJN,KRJN,ZDJN
+      REAL*8 IM_VK,RE_VK
+C
+      INTEGER IPIV(NLMM),ONE_L,IN1
+C
+      COMPLEX*16 FOURPI_IC,IC_L,IC_REF,TEMP,TEMP1,TEMP2,CN1
+      COMPLEX*16 AINV(NLMM,NLMM),IN(NLMM,LINFMAX)
+C
+      DATA FOURPI /12.566370614359D0/
+C
+      ZEROC=(0.D0,0.D0)
+      ONEC=(1.D0,0.D0)
+      IC=(0.D0,1.D0)
+      IBESS=3
+      FOURPI_IC=-IC*FOURPI
+C
+      LM0=LMAX(1,JE)
+      LM0=MIN(LM0,LF2)
+      NRHS=(LM0+1)*(LM0+1)
+      INDJ=0
+C
+      NM=0
+      DO I=1,N-1
+        J=NLM(I)+1
+        NM=NM+J*J
+      ENDDO
+      L=NLM(N)
+      LNMAX=L
+      L=(L+1)*(L+1)
+      NM1=NM+1
+      NML=NM+L
+      NTYP=ITYP(N)
+C
+      DO L=0,LNMAX
+        ATTL(L,N)=DCMPLX(TL(L,1,NTYP,JE))
+      ENDDO
+      IM_VK=-DIMAG(DCMPLX(VK(JE)))
+      RE_VK=DBLE(VK(JE))
+C
+C     set up matrix blocks C((N-1)*1) and D(1*(N-1))
+C
+      I=IGS(N)
+      XN=SYM_AT(1,I)
+      YN=SYM_AT(2,I)
+      ZN=SYM_AT(3,I)
+C
+      DO J=1,N-1
+        JATL=IGS(J)
+        LJMAX=NLM(J)
+        JTYP=ITYP(J)
+        J1=J-1
+C
+        XJN=DBLE(SYM_AT(1,JATL)-XN)
+        YJN=DBLE(SYM_AT(2,JATL)-YN)
+        ZJN=DBLE(SYM_AT(3,JATL)-ZN)
+        RJN=DSQRT(XJN*XJN+YJN*YJN+ZJN*ZJN)
+        KRJN=RE_VK*RJN
+        ATTJN=FOURPI_IC*DEXP(IM_VK*RJN)
+        EXPJN=(XJN+IC*YJN)/RJN
+        ZDJN=ZJN/RJN
+        CALL SPH_HAR2(2*NL_M,ZDJN,EXPJN,YLM,LNMAX+LJMAX)
+        CALL BESPHE2(LNMAX+LJMAX+1,IBESS,KRJN,HL1)
+        DO L=0,LJMAX
+          ATTL(L,J)=ATTJN*DCMPLX(TL(L,1,JTYP,JE))
+        ENDDO
+C
+        II=NM
+        IN1=-1
+        CN1=IC
+        JJ=0
+C
+        DO LN=0,LNMAX
+          ILN=LN*LN+LN+1
+          IN1=-IN1
+          CN1=-CN1*IC
+C
+          DO MLN=-LN,LN
+            INDN=ILN+MLN
+            II=II+1
+            JJ0=J1*INDJ
+            ONE_L=-IN1
+            IC_REF=-CN1*IC
+C
+            DO LJ=0,LJMAX
+              ILJ=LJ*LJ+LJ+1
+              L_MIN=ABS(LJ-LN)
+              L_MAX=LJ+LN
+              ONE_L=-ONE_L
+              IC_REF=IC_REF*IC
+C
+C  Case MLJ equal to zero
+C 
+              JJ1=JJ0+ILJ
+              IF(LJ.GE.LN) THEN
+                IC_L=-IC_REF
+              ELSE
+                IC_L=-ONEC/IC_REF
+              ENDIF
+C
+              SUM_L=ZEROC
+              SUM_L2=ZEROC
+C
+              DO L=L_MIN,L_MAX,2
+                IC_L=-IC_L
+                IF(ABS(MLN).LE.L) THEN
+                  TEMP=IC_L*HL1(L)*GNT(L,ILJ,INDN)
+                  SUM_L=SUM_L+YLM(L,MLN)*TEMP
+                  SUM_L2=SUM_L2+DCONJG(YLM(L,MLN))*TEMP
+                ENDIF
+              ENDDO
+C
+              IF(ONE_L.EQ.-1) SUM_L2=-SUM_L2
+              A(JJ1,II)=ATTL(LJ,J)*SUM_L
+              A(II,JJ1)=ATTJN*ATTL(LN,N)*SUM_L2
+C
+C
+C  Case MLJ not equal to zero
+C 
+              DO MLJ=1,LJ
+                INDJ=ILJ+MLJ
+                INDJN=ILJ-MLJ
+                JJ1=JJ0+INDJ
+                JJ1N=JJ0+INDJN
+                MA=MLN-MLJ
+                MB=MLN+MLJ
+                IF(LJ.GE.LN) THEN
+                  IC_L=-IC_REF
+                ELSE
+                  IC_L=-ONEC/IC_REF
+                ENDIF
+C
+                SUM_L_A=ZEROC
+                SUM_L2_A=ZEROC
+                SUM_L_B=ZEROC
+                SUM_L2_B=ZEROC
+C
+                DO L=L_MIN,L_MAX,2
+                  IC_L=-IC_L
+                  IF(ABS(MA).LE.L) THEN
+                    TEMP1=IC_L*HL1(L)*GNT(L,INDJ,INDN)
+                    SUM_L_A=SUM_L_A+YLM(L,MA)*TEMP1
+                    SUM_L2_A=SUM_L2_A+DCONJG(YLM(L,MA))*TEMP1
+                  ENDIF
+                  IF(ABS(MB).LE.L) THEN
+                    TEMP2=IC_L*HL1(L)*GNT(L,INDJN,INDN)
+                    SUM_L_B=SUM_L_B+YLM(L,MB)*TEMP2
+                    SUM_L2_B=SUM_L2_B+DCONJG(YLM(L,MB))*TEMP2
+                  ENDIF
+                ENDDO
+C
+                IF(ONE_L.EQ.-1) THEN
+                   SUM_L2_A=-SUM_L2_A
+                   SUM_L2_B=-SUM_L2_B
+                ENDIF
+                A(JJ1,II)=ATTL(LJ,J)*SUM_L_A
+                A(II,JJ1)=ATTJN*ATTL(LN,N)*SUM_L2_A
+                A(JJ1N,II)=ATTL(LJ,J)*SUM_L_B
+                A(II,JJ1N)=ATTJN*ATTL(LN,N)*SUM_L2_B
+              ENDDO
+C
+C
+            ENDDO
+            JJ=JJ0+INDJ
+C
+          ENDDO
+        ENDDO
+C
+        JJ=JJ-INDN
+C
+      ENDDO
+C
+C     add B to A
+C
+      DO I=NM1,NML
+        DO J=NM1,NML
+          IF(J.EQ.I) THEN
+            A(J,I)=ONEC
+          ELSE
+            A(J,I)=ZEROC
+          ENDIF
+        ENDDO
+      ENDDO
+C
+C     construct AINV
+C
+      DO I=1,NML
+        DO J=1,NML
+          AINV(J,I)=A(J,I)
+        ENDDO
+      ENDDO
+C
+C
+C          matrix inversion(ax=b)
+C
+      CALL ZGETRF(NML,NML,AINV,NLMM,IPIV,INFO1)
+      IF(INFO1.NE.0) THEN
+        WRITE(6,*) '     --->  INFO1 =',INFO1
+      ELSE
+C
+        DO I=1,NRHS
+          DO J=1,NML
+            IF(J.EQ.I) THEN
+              IN(J,I)=(1.D0,0.D0)
+            ELSE
+              IN(J,I)=(0.D0,0.D0)
+            ENDIF
+          ENDDO
+        ENDDO
+C
+        CALL ZGETRS('N',NML,NRHS,AINV,NLMM,IPIV,IN,NLMM,INFO)
+        IF(INFO.NE.0) THEN
+          WRITE(6,*) '    --->  INFO =',INFO
+        ENDIF
+      ENDIF
+C
+C      sum of tau
+C
+      KLIN=0
+      DO K=1,N
+        KATL=IGS(K)
+        LMK=NLM(K)
+        INDKM=(LMK+1)*(LMK+1)
+C
+        DO INDJ=1,NRHS
+C
+          DO INDK=1,INDKM
+            KLIN=KLIN+1
+C
+            TAU(INDK,INDJ,KATL)=TAU(INDK,INDJ,KATL)
+     1                 +DBLE(QI)*IN(KLIN,INDJ)
+C
+          ENDDO
+          KLIN=KLIN-INDKM
+C
+        ENDDO
+        KLIN=KLIN+INDKM
+C
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/ms_cor.f

@@ -0,0 +1,165 @@
+C
+C
+C======================================================================
+C
+      SUBROUTINE MS_COR(JE,TAU)
+C
+C
+C   This subroutine calculates the scattering path operator by 
+C    the correlation expansion method.
+C
+C   The scattering path operator matrix of each small atom group 
+C    is obtained by using LU decomposition method.
+C
+C   The running time of matrix inversion subroutine used in this program
+C    scales with N^3, the memory occupied scales with N^2. We advise user to
+C    use full MS method to get the scattering path operator, i.e. directly
+C    with matrix inversion method if NGR is larger than 3. If NGR is less
+C    than 4 (i.e <=3) this subroutine will gain time.
+C
+C   This subroutine never gain memory comparing to the subrourine INV_MAT_MS
+C    as I use three large matrices stored in common, each matrix is larger or
+C    as large as the matrix used in INV_MAT_MS.
+C
+C   As I don't find a good way to solve the group problem, where all the contribution
+C    of group IGR<=NGR are collected and each small contribution has to be stored
+C    for the further larger-atom-group contribution, it's better that users change the
+C    parameter NGR_M which is set in included file 'spec.inc' to be NGR or NGR+1
+C    where NGR is the cut-off.user insterested. this subrouitne works for NGR is less
+C    than 6(<=5), if users want to calculate larger NGR, they should modify the code here
+C    to make them workable, the code is marked by 'C' in each lines (about 300 lines
+C    below here), users just release them until to the desired cut-off, the maximum is
+C    9, however, users can enlarge it if they want to. Warning ! NGR_M set in 
+C    included file should be larger than NGR and the figure listed below, don't forget
+C    to compile the code after modification.
+C
+C   Users can modify the code to make it less memory-occupied, however, no matter they
+C    do, the memories that used are more than full MS method used, so the only advantage
+C    that this code has is to gain time when NGR<=3, with command 'common' used here,
+C    the code will run faster.
+C
+C                                                      H.-F. Zhao : 2007
+C
+C                           (Photoelectron case)
+C
+C                                         Last modified : 31 Jan 2008
+C
+C
+C
+      USE DIM_MOD
+      USE COOR_MOD
+      USE INIT_L_MOD
+      USE TRANS_MOD
+      USE APPROX_MOD
+      USE CORREXP_MOD
+      USE Q_ARRAY_MOD
+C
+      COMPLEX*16 TAU1(LINMAX,LINFMAX,NATCLU_M),ONEC,ZEROC
+C
+      INTEGER NLM(NGR_M),ITYP(NGR_M),IGS(NGR_M)
+C
+      COMPLEX TAU(LINMAX,LINFMAX,NATCLU_M),TLJ
+C
+C
+      ONEC=(1.D0,0.D0)
+      ZEROC=(0.D0,0.D0)
+C
+      LM0=LMAX(1,JE)
+      LM0=MIN(LM0,LF2)
+      NRHS=(LM0+1)*(LM0+1)
+C
+      NGR_MAX=NGR_M
+      NGR=NDIF
+C
+      IF(NGR_M.GT.NATCLU) THEN
+        WRITE(6,*) '     --->  NGR_M should be smaller than NATCLU'
+        WRITE(6,*) '     --->  it is reduced to NATCLU=',NATCLU
+        NGR_MAX=NATCLU
+      ENDIF
+C
+      IF(NGR.LT.1) THEN
+        WRITE(6,*) '     --->  NGR < 1, no expansion is done'
+        STOP
+      ELSE
+        IF(NGR.GT.NGR_MAX) THEN
+          WRITE(6,*) '     --->  NGR is too large, reduce to NGR_M=',
+     &                      NGR_MAX
+          NGR=NGR_MAX
+        ENDIF
+      ENDIF
+C
+C      Case NGR = 1
+C
+      IF(NGR.EQ.1) THEN
+        DO LJ=0,LM0
+          ILJ=LJ*LJ+LJ+1
+          TLJ=TL(LJ,1,1,JE)
+          DO MJ=-LJ,LJ
+            INDJ=ILJ+MJ
+            TAU(INDJ,INDJ,1)=TLJ
+          ENDDO
+        ENDDO
+C
+        GOTO 100
+      ENDIF
+C
+C     NGR >=2 case
+C
+C
+      DO INDJ=1,NRHS
+        TAU1(INDJ,INDJ,1)=DBLE(Q(1))*ONEC
+      ENDDO
+C
+C     Constructs the group matrix and inverses it
+C
+      IGR=1
+      LMJ=LMAX(1,JE)
+      NLM(IGR)=LMJ
+      INDJM=(LMJ+1)*(LMJ+1)
+      ITYP(IGR)=1
+      IGS(IGR)=1
+C
+      DO I=1,INDJM
+        DO J=1,INDJM
+          IF (J.EQ.I) THEN
+            A(J,I)=ONEC
+          ELSE
+            A(J,I)=ZEROC
+          ENDIF
+        ENDDO
+      ENDDO
+C
+      IGR=IGR+1
+      CALL COREXP_SAVM(JE,IGR,NGR,NLM,ITYP,IGS,TAU1)
+      IGR=IGR-1
+C
+C     TAU=TAU*tj
+C
+      DO KTYP=1,N_PROT
+        NBTYPK=NATYP(KTYP)
+        LMK=LMAX(KTYP,JE)
+        INDKM=(LMK+1)*(LMK+1)
+        DO KNUM=1,NBTYPK
+          KATL=NCORR(KNUM,KTYP)
+C
+          DO LJ=0,LM0
+            ILJ=LJ*LJ+LJ+1
+            TLJ=TL(LJ,1,1,JE)
+            DO MJ=-LJ,LJ
+              INDJ=ILJ+MJ
+C
+              DO INDK=1,INDKM
+                TAU(INDK,INDJ,KATL)=CMPLX(TAU1(INDK,INDJ,KATL))*TLJ
+              ENDDO
+C
+            ENDDO
+          ENDDO
+C
+        ENDDO
+      ENDDO
+C
+ 100  CONTINUE
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/plotfd.f

@@ -0,0 +1,106 @@
+C
+C=======================================================================
+C
+      SUBROUTINE PLOTFD(A,LMX,ITL,NL,NAT,NE)
+C
+C  This routine prepares the output for a plot of the scattering factor
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD
+      USE FDIF_MOD
+      USE INIT_L_MOD , L => LI, I2 => INITL, I3 => NNL, I4 => LF1, I5 =>
+     & LF2, I10 => ISTEP_LF
+      USE INIT_J_MOD
+      USE OUTFILES_MOD
+      USE OUTUNITS_MOD
+      USE PARCAL_MOD , N3 => NPHI, N4 => NE, N5 => NTHETA, N6 => NEPS
+      USE TYPCAL_MOD , I7 => IFTHET, I8 => IMOD, I9 => IPOL, I12 => I_CP
+     &, I13 => I_EXT, I14 => I_TEST
+      USE VALIN_MOD , U1 => THLUM, U2 => PHILUM, U3 => ELUM, N7 => NONVO
+     &L
+      USE VALFIN_MOD
+C
+C
+C
+      DIMENSION LMX(NATM,NE_M)
+C
+      COMPLEX FSPH,VKE
+C
+C
+C
+      DATA PI,CONV/3.141593,0.512314/
+C
+      OPEN(UNIT=IUO3, FILE=OUTFILE3, STATUS='UNKNOWN')
+      IF(ISPHER.EQ.0) THEN
+         L=0
+         LMAX=0
+      ELSE
+        LMAX=L
+      ENDIF
+      PHITOT=360.
+      THTOT=360.*ITHETA*(1-IPHI)+180.*ITHETA*IPHI
+      NPHI=(NFTHET+1)*IPHI+(1-IPHI)
+      NTHT=(NFTHET+1)*ITHETA*(1-IPHI)+(NFTHET/2+1)*ITHETA*IPHI+
+     *     (1-ITHETA)
+      NE=NFTHET*IE + (1-IE)
+      WRITE(IUO3,1) ISPHER,NL,NAT,L,NTHT,NPHI,NE,E0,EFIN
+      DO 10 JT=1,NTHT
+        DTHETA=THETA1+FLOAT(JT-1)*THTOT/FLOAT(MAX0(NTHT-1,1))
+        RTHETA=DTHETA*PI/180.
+        TEST=SIN(RTHETA)
+        IF(TEST.GE.0.) THEN
+          POZ=PI
+          EPS=1.
+        ELSE
+          POZ=0.
+          EPS=-1.
+        ENDIF
+        BETA=RTHETA*EPS
+        IF(ABS(TEST).LT.0.0001) THEN
+          NPHIM=1
+        ELSE
+          NPHIM=NPHI
+        ENDIF
+        DO 20 JP=1,NPHIM
+          DPHI=PHI1+FLOAT(JP-1)*PHITOT/FLOAT(MAX0(NPHI-1,1))
+          RPHI=DPHI*PI/180.
+          GAMMA=POZ-RPHI
+          DO 30 JE=1,NE
+            IF(NE.EQ.1) THEN
+              ECIN=E0
+            ELSE
+              ECIN=E0+FLOAT(JE-1)*(EFIN-E0)/FLOAT(NE-1)
+            ENDIF
+            IF(ITL.EQ.0) VKE=SQRT(ECIN-ABS(VINT))*CONV*A*(1.,0.)
+            DO 40 JAT=1,NAT
+              IF(L.GT.LMX(JAT,JE)) GOTO 90
+              DO 50 M=-LMAX,LMAX
+                CALL FACDIF1(VKE,R1,R2,THETA0,PHI0,BETA,GAMMA,L,M,FSPH,J
+     &AT,JE,*60)
+                GOTO 70
+  60            WRITE(IUO1,80)
+                STOP
+  70            REFTH=REAL(FSPH)
+                XIMFTH=AIMAG(FSPH)
+                WRITE(IUO3,5) JE,JAT,L,M,REFTH,XIMFTH,DTHETA,DPHI,ECIN
+  50          CONTINUE
+              GOTO 40
+  90          WRITE(IUO1,100) JAT
+              STOP
+  40        CONTINUE
+  30      CONTINUE
+  20    CONTINUE
+  10  CONTINUE
+      CLOSE(IUO3)
+   1  FORMAT(5X,I1,2X,I2,2X,I4,2X,I2,2X,I3,2X,I3,2X,I3,2X,F8.2,2X,F8.2)
+   5  FORMAT(1X,I3,1X,I4,1X,I2,1X,I3,1X,F6.3,1X,F6.3,1X,F6.2,1X,F6.2,1X,
+     &F8.2)
+  80  FORMAT(15X,'<<<<<  WRONG VALUE OF THETA0 : THE DENOMINATOR ','IS Z
+     &ERO  >>>>>')
+ 100  FORMAT(15X,'<<<<<  THE VALUE OF L EST IS TOO LARGE FOR ATOM',' : '
+     &,I2,'  >>>>>')
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/treat_phd.f

@@ -0,0 +1,769 @@
+C
+C=======================================================================
+C
+      SUBROUTINE TREAT_PHD(ISOM,NFICHLEC,JFICH,NP)
+C
+C  This routine sums up the calculations corresponding to different
+C        absorbers or different planes when this has to be done
+C             (parameter ISOM in the input data file).
+C
+C                                       Last modified : 24 Jan 2013
+C
+      USE DIM_MOD
+      USE OUTUNITS_MOD
+      USE TYPEXP_MOD , DUMMY => SPECTRO
+      USE VALIN_MOD
+      USE VALFIN_MOD
+C
+      PARAMETER(N_HEAD=5000,N_FILES=1000)
+C
+      CHARACTER*3 SPECTRO
+C
+      CHARACTER*13 OUTDATA
+      CHARACTER*72 HEAD(N_HEAD,N_FILES)
+C
+      REAL TAB(NDIM_M,4)
+      REAL ECIN(NE_M),DTHETA(NTH_M),DPHI(NPH_M)
+C
+C
+      DATA JVOL,JTOT/0,-1/
+C
+      REWIND IUO2
+C
+C  Reading and storing the headers:
+C
+      NHEAD=0
+      DO JLINE=1,N_HEAD
+        READ(IUO2,888) HEAD(JLINE,JFICH)
+        NHEAD=NHEAD+1
+        IF(HEAD(JLINE,JFICH)(1:6).EQ.'      ') GOTO 333
+      ENDDO
+C
+ 333  CONTINUE
+C
+      READ(IUO2,15) SPECTRO,OUTDATA
+      READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,IPH_1
+     &,I_EXT
+C
+      IF(I_EXT.EQ.2) THEN
+         IPH_1=0
+      ENDIF
+C
+      IF(ISOM.EQ.0) THEN
+C
+C........  ISOM = 0 : case of independent input files  .................
+C
+        READ(IUO2,1) NPLAN,NEMET,NTHETA,NPHI,NE
+C
+        IF(IPH_1.EQ.1) THEN
+          N_FIXED=NPHI
+          FIX0=PHI0
+          FIX1=PHI1
+          N_SCAN=NTHETA
+        ELSE
+          N_FIXED=NTHETA
+          FIX0=THETA0
+          FIX1=THETA1
+          IF(STEREO.EQ.'YES') THEN
+            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/(THETA1-THETA0)+0.0001)
+     &+1
+            IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
+          ENDIF
+          N_SCAN=NPHI
+        ENDIF
+C
+        IF(I_EXT.EQ.-1) THEN
+          N_SCAN=2*N_SCAN
+        ENDIF
+C
+        IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
+          NDP=NEMET*NTHETA*NPHI*NE
+        ELSEIF(I_EXT.EQ.-1) THEN
+          NDP=NEMET*NTHETA*NPHI*NE*2
+        ELSEIF(I_EXT.EQ.2) THEN
+          NDP=NEMET*NTHETA*NE
+          N_FIXED=NTHETA
+          N_SCAN=NPHI
+          IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
+        ENDIF
+C
+        NTT=NPLAN*NDP
+        IF(NTT.GT.NDIM_M) GOTO 5
+C
+        DO JPLAN=1,NPLAN
+         DO JEMET=1,NEMET
+          DO JE=1,NE
+C
+           DO J_FIXED=1,N_FIXED
+            IF(N_FIXED.GT.1) THEN
+              XINCRF=FLOAT(J_FIXED-1)*(FIX1-FIX0)/FLOAT(N_FIXED-1)
+            ELSEIF(N_FIXED.EQ.1) THEN
+              XINCRF=0.
+            ENDIF
+            IF(IPH_1.EQ.1) THEN
+              JPHI=J_FIXED
+            ELSE
+              THETA=THETA0+XINCRF
+              JTHETA=J_FIXED
+              IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 11
+            ENDIF
+            IF(STEREO.EQ.' NO') THEN
+              N_SCAN_R=N_SCAN
+            ELSE
+              RTHETA=THETA*0.017453
+              FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
+              N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
+            ENDIF
+C
+            DO J_SCAN=1,N_SCAN_R
+             IF(IPH_1.EQ.1) THEN
+              JTHETA=J_SCAN
+             ELSE
+              JPHI=J_SCAN
+             ENDIF
+C
+             JLIN=(JPLAN-1)*NDP + (JEMET-1)*NE*N_FIXED*N_SCAN + (JE-1)*N
+     &_FIXED*N_SCAN +(JTHETA-1)*NPHI + JPHI
+C
+             IF(I_EXT.LE.0) THEN
+               IF(STEREO.EQ.' NO') THEN
+                 JPHI2=JPHI
+               ELSE
+                 JPHI2=(JTHETA-1)*NPHI+JPHI
+               ENDIF
+             ELSE
+               JPHI2=JTHETA
+             ENDIF
+C
+             READ(IUO2,2) JPL
+             IF(JPLAN.EQ.JPL) THEN
+               BACKSPACE IUO2
+               IF(IDICHR.EQ.0) THEN
+                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+     &),TAB(JLIN,1),TAB(JLIN,2)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
+                 ENDIF
+               ELSE
+                 READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(J
+     &E),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),TAB(JLIN,4)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN
+     &(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+                 ENDIF
+               ENDIF
+             ELSE
+               BACKSPACE IUO2
+               DO JL=JLIN,JPLAN*NDP
+                 TAB(JL,1)=0.0
+                 TAB(JL,2)=0.0
+                 TAB(JL,3)=0.0
+                 TAB(JL,4)=0.0
+               ENDDO
+               GOTO 10
+             ENDIF
+            ENDDO
+           ENDDO
+  11       CONTINUE
+          ENDDO
+         ENDDO
+  10     CONTINUE
+        ENDDO
+C
+        REWIND IUO2
+C
+C  Skipping the NHEAD lines of headers before rewriting:
+C
+        DO JLINE=1,NHEAD
+          READ(IUO2,888) HEAD(JLINE,JFICH)
+        ENDDO
+C
+        WRITE(IUO2,15) SPECTRO,OUTDATA
+        WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+C
+        DO JE=1,NE
+         DO JTHETA=1,NTHETA
+          IF(STEREO.EQ.' NO') THEN
+            NPHI_R=NPHI
+          ELSE
+            RTHETA=DTHETA(JTHETA)*0.017453
+            FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
+            NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
+            NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
+          ENDIF
+          DO JPHI=1,NPHI_R
+           TOTDIF_1=0.
+           TOTDIR_1=0.
+           VOLDIF_1=0.
+           VOLDIR_1=0.
+           TOTDIF_2=0.
+           TOTDIR_2=0.
+           VOLDIF_2=0.
+           VOLDIR_2=0.
+           IF(I_EXT.EQ.-1) THEN
+             TOTDIF2_1=0.
+             TOTDIR2_1=0.
+             VOLDIF2_1=0.
+             VOLDIR2_1=0.
+             TOTDIF2_2=0.
+             TOTDIR2_2=0.
+             VOLDIF2_2=0.
+             VOLDIR2_2=0.
+           ENDIF
+C
+           DO JPLAN=1,NPLAN
+C
+            SF_1=0.
+            SR_1=0.
+            SF_2=0.
+            SR_2=0.
+            IF(I_EXT.EQ.-1) THEN
+              SF2_1=0.
+              SR2_1=0.
+              SF2_2=0.
+              SR2_2=0.
+            ENDIF
+C
+            DO JEMET=1,NEMET
+             JLIN=(JPLAN-1)*NDP + (JEMET-1)*NE*NTHETA*NPHI + (JE-1)*NTHE
+     &TA*NPHI +(JTHETA-1)*NPHI + JPHI
+             SF_1=SF_1+TAB(JLIN,2)
+             SR_1=SR_1+TAB(JLIN,1)
+             IF(I_EXT.EQ.-1) THEN
+               JLIN2=NTT+JLIN
+               SF2_1=SF2_1+TAB(JLIN2,2)
+               SR2_1=SR2_1+TAB(JLIN2,1)
+             ENDIF
+             IF(IDICHR.GE.1) THEN
+               SF_2=SF_2+TAB(JLIN,4)
+               SR_2=SR_2+TAB(JLIN,3)
+               IF(I_EXT.EQ.-1) THEN
+                 JLIN2=NTT+JLIN
+                 SF2_2=SF2_2+TAB(JLIN2,4)
+                 SR2_2=SR2_2+TAB(JLIN2,3)
+               ENDIF
+             ENDIF
+            ENDDO
+            IF(I_EXT.LE.0) THEN
+               IF(STEREO.EQ.' NO') THEN
+                 JPHI2=JPHI
+               ELSE
+                 JPHI2=(JTHETA-1)*NPHI+JPHI
+               ENDIF
+             ELSE
+              JPHI2=JTHETA
+            ENDIF
+            IF(IDICHR.EQ.0) THEN
+              WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),SR
+     &_1,SF_1
+              IF(I_EXT.EQ.-1) THEN
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     &SR2_1,SF2_1
+              ENDIF
+            ELSE
+              WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),S
+     &R_1,SF_1,SR_2,SF_2
+              IF(I_EXT.EQ.-1) THEN
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+     &,SR2_1,SF2_1,SR2_2,SF2_2
+              ENDIF
+            ENDIF
+            IF(JPLAN.GT.NONVOL(JFICH)) THEN
+              VOLDIF_1=VOLDIF_1+SF_1
+              VOLDIR_1=VOLDIR_1+SR_1
+              IF(I_EXT.EQ.-1) THEN
+                VOLDIF2_1=VOLDIF2_1+SF2_1
+                VOLDIR2_1=VOLDIR2_1+SR2_1
+              ENDIF
+              IF(IDICHR.GE.1) THEN
+                VOLDIF_2=VOLDIF_2+SF_2
+                VOLDIR_2=VOLDIR_1+SR_2
+                IF(I_EXT.EQ.-1) THEN
+                  VOLDIF2_2=VOLDIF2_2+SF2_2
+                  VOLDIR2_2=VOLDIR2_1+SR2_2
+                ENDIF
+              ENDIF
+            ENDIF
+            TOTDIF_1=TOTDIF_1+SF_1
+            TOTDIR_1=TOTDIR_1+SR_1
+            IF(I_EXT.EQ.-1) THEN
+              TOTDIF2_1=TOTDIF2_1+SF2_1
+              TOTDIR2_1=TOTDIR2_1+SR2_1
+            ENDIF
+            IF(IDICHR.GE.1) THEN
+              TOTDIF_2=TOTDIF_2+SF_2
+              TOTDIR_2=TOTDIR_2+SR_2
+              IF(I_EXT.EQ.-1) THEN
+                TOTDIF2_2=TOTDIF2_2+SF2_2
+                TOTDIR2_2=TOTDIR2_2+SR2_2
+              ENDIF
+            ENDIF
+           ENDDO
+           IF(IDICHR.EQ.0) THEN
+             WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VOLD
+     &IR_1,VOLDIF_1
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VO
+     &LDIR2_1,VOLDIF2_1
+             ENDIF
+             WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TOTD
+     &IR_1,TOTDIF_1
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TO
+     &TDIR2_1,TOTDIF2_1
+             ENDIF
+           ELSE
+             WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VOL
+     &DIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+            IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),V
+     &OLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
+             ENDIF
+             WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TOT
+     &DIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),T
+     &OTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
+             ENDIF
+           ENDIF
+          ENDDO
+         ENDDO
+        ENDDO
+C
+      ELSE
+C
+C........ ISOM not= 0 : multiple input files to be summed up  ..........
+C
+        READ(IUO2,7) NTHETA,NPHI,NE
+C
+        IF(IPH_1.EQ.1) THEN
+          N_FIXED=NPHI
+          FIX0=PHI0
+          FIX1=PHI1
+          N_SCAN=NTHETA
+        ELSE
+          N_FIXED=NTHETA
+          FIX0=THETA0
+          FIX1=THETA1
+          IF(STEREO.EQ.'YES') THEN
+            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/(THETA1-THETA0)+0.0001)
+     &+1
+            IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
+          ENDIF
+          N_SCAN=NPHI
+        ENDIF
+C
+        IF(I_EXT.EQ.-1) THEN
+          N_SCAN=2*N_SCAN
+        ENDIF
+C
+        IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
+          NDP=NTHETA*NPHI*NE
+        ELSEIF(I_EXT.EQ.-1) THEN
+          NDP=NTHETA*NPHI*NE*2
+        ELSEIF(I_EXT.EQ.2) THEN
+          NDP=NTHETA*NE
+          N_FIXED=NTHETA
+          N_SCAN=NPHI
+          IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
+        ENDIF
+C
+        NTT=NFICHLEC*NDP
+        IF(NTT.GT.NDIM_M) GOTO 5
+C
+        IF(ISOM.EQ.1) THEN
+          NPLAN=NP
+          NF=NP
+        ELSEIF(ISOM.EQ.2) THEN
+          NEMET=NFICHLEC
+          NF=NFICHLEC
+          NPLAN=1
+        ENDIF
+C
+        DO JF=1,NF
+C
+C  Reading the headers for each file:
+C
+          IF(JF.GT.1) THEN
+            DO JLINE=1,NHEAD
+              READ(IUO2,888) HEAD(JLINE,JF)
+            ENDDO
+          ENDIF
+C
+          DO JE=1,NE
+C
+           DO J_FIXED=1,N_FIXED
+            IF(N_FIXED.GT.1) THEN
+              XINCRF=FLOAT(J_FIXED-1)*(FIX1-FIX0)/FLOAT(N_FIXED-1)
+            ELSEIF(N_FIXED.EQ.1) THEN
+              XINCRF=0.
+            ENDIF
+            IF(IPH_1.EQ.1) THEN
+              JPHI=J_FIXED
+            ELSE
+              THETA=THETA0+XINCRF
+              JTHETA=J_FIXED
+              IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 12
+            ENDIF
+            IF(STEREO.EQ.' NO') THEN
+              N_SCAN_R=N_SCAN
+            ELSE
+              RTHETA=THETA*0.017453
+              FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
+              N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
+            ENDIF
+C
+            DO J_SCAN=1,N_SCAN_R
+             IF(IPH_1.EQ.1) THEN
+              JTHETA=J_SCAN
+             ELSE
+              JPHI=J_SCAN
+             ENDIF
+C
+             JLIN=(JF-1)*NDP + (JE-1)*N_FIXED*N_SCAN +(JTHETA-1)*NPHI + 
+     &JPHI
+             IF(I_EXT.LE.0) THEN
+               IF(STEREO.EQ.' NO') THEN
+                 JPHI2=JPHI
+               ELSE
+                 JPHI2=(JTHETA-1)*NPHI+JPHI
+               ENDIF
+             ELSE
+               JPHI2=JTHETA
+             ENDIF
+C
+             IF(ISOM.EQ.1) THEN
+               READ(IUO2,2) JPL
+               IF(JF.EQ.JPL) THEN
+                 BACKSPACE IUO2
+                 IF(IDICHR.EQ.0) THEN
+                   READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(
+     &JE),TAB(JLIN,1),TAB(JLIN,2)
+                   IF(I_EXT.EQ.-1) THEN
+                     JLIN2=NTT+JLIN
+                     READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
+                   ENDIF
+                 ELSE
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN
+     &(JE),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),TAB(JLIN,4)
+                   IF(I_EXT.EQ.-1) THEN
+                     JLIN2=NTT+JLIN
+                     READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),EC
+     &IN(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+                   ENDIF
+                 ENDIF
+               ELSE
+                 BACKSPACE IUO2
+                 DO JLINE=1,NHEAD
+                   BACKSPACE IUO2
+                 ENDDO
+                 DO JL=JLIN,JF*NDP
+                   TAB(JL,1)=0.0
+                   TAB(JL,2)=0.0
+                   TAB(JL,3)=0.0
+                   TAB(JL,4)=0.0
+                 ENDDO
+                 GOTO 13
+               ENDIF
+             ELSEIF(ISOM.EQ.2) THEN
+               IF(IDICHR.EQ.0) THEN
+                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+     &),TAB(JLIN,1),TAB(JLIN,2)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
+                 ENDIF
+               ELSE
+                 READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(J
+     &E),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),TAB(JLIN,4)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN
+     &(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+                   ENDIF
+               ENDIF
+             ENDIF
+            ENDDO
+ 12         CONTINUE
+           ENDDO
+          ENDDO
+ 13       CONTINUE
+        ENDDO
+C
+        REWIND IUO2
+C
+C  Writing the headers:
+C
+        DO JLINE=1,2
+          WRITE(IUO2,888) HEAD(JLINE,1)
+        ENDDO
+        DO JF=1,NFICHLEC
+          DO JLINE=3,6
+            WRITE(IUO2,888) HEAD(JLINE,JF)
+          ENDDO
+          WRITE(IUO2,888) HEAD(2,JF)
+        ENDDO
+        DO JLINE=7,NHEAD
+          WRITE(IUO2,888) HEAD(JLINE,1)
+        ENDDO
+C
+        WRITE(IUO2,15) SPECTRO,OUTDATA
+        WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+C
+        IF(ISOM.EQ.1) THEN
+C
+          DO JE=1,NE
+C
+           DO JTHETA=1,NTHETA
+            IF(STEREO.EQ.' NO') THEN
+              NPHI_R=NPHI
+            ELSE
+              RTHETA=DTHETA(JTHETA)*0.017453
+              FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
+              NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
+              NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
+            ENDIF
+            DO JPHI=1,NPHI_R
+C
+             TOTDIF_1=0.
+             TOTDIR_1=0.
+             VOLDIF_1=0.
+             VOLDIR_1=0.
+             TOTDIF_2=0.
+             TOTDIR_2=0.
+             VOLDIF_2=0.
+             VOLDIR_2=0.
+             IF(I_EXT.EQ.-1) THEN
+               TOTDIF2_1=0.
+               TOTDIR2_1=0.
+               VOLDIF2_1=0.
+               VOLDIR2_1=0.
+               TOTDIF2_2=0.
+               TOTDIR2_2=0.
+               VOLDIF2_2=0.
+               VOLDIR2_2=0.
+             ENDIF
+C
+             DO JPLAN=1,NPLAN
+              JF=JPLAN
+C
+              JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +(JTHETA-1)*NPHI + JP
+     &HI
+C
+              SR_1=TAB(JLIN,1)
+              SF_1=TAB(JLIN,2)
+              IF(I_EXT.EQ.-1) THEN
+                 JLIN2=NTT+JLIN
+                 SF2_1=TAB(JLIN2,2)
+                 SR2_1=TAB(JLIN2,1)
+              ENDIF
+              IF(I_EXT.LE.0) THEN
+                IF(STEREO.EQ.' NO') THEN
+                  JPHI2=JPHI
+                ELSE
+                  JPHI2=(JTHETA-1)*NPHI+JPHI
+                ENDIF
+              ELSE
+                JPHI2=JTHETA
+              ENDIF
+              IF(IDICHR.EQ.0) THEN
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     &SR_1,SF_1
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+     &),SR2_1,SF2_1
+                ENDIF
+              ELSE
+                SR_2=TAB(JLIN,3)
+                SF_2=TAB(JLIN,4)
+                IF(I_EXT.EQ.-1) THEN
+                  JLIN2=NTT+JLIN
+                  SF2_2=TAB(JLIN2,4)
+                  SR2_2=TAB(JLIN2,3)
+                ENDIF
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+     &,SR_1,SF_1,SR_2,SF_2
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(J
+     &E),SR2_1,SF2_1,SR2_2,SF2_2
+                ENDIF
+              ENDIF
+              IF(NONVOL(JPLAN).EQ.0) THEN
+                VOLDIF_1=VOLDIF_1+SF_1
+                VOLDIR_1=VOLDIR_1+SR_1
+                IF(I_EXT.EQ.-1) THEN
+                  VOLDIF2_1=VOLDIF2_1+SF2_1
+                  VOLDIR2_1=VOLDIR2_1+SR2_1
+                ENDIF
+                IF(IDICHR.GE.1) THEN
+                  VOLDIF_2=VOLDIF_2+SF_2
+                  VOLDIR_2=VOLDIR_2+SR_2
+                  IF(I_EXT.EQ.-1) THEN
+                    VOLDIF2_2=VOLDIF2_2+SF2_2
+                    VOLDIR2_2=VOLDIR2_1+SR2_2
+                  ENDIF
+                ENDIF
+              ENDIF
+              TOTDIF_1=TOTDIF_1+SF_1
+              TOTDIR_1=TOTDIR_1+SR_1
+              IF(I_EXT.EQ.-1) THEN
+                TOTDIF2_1=TOTDIF2_1+SF2_1
+                TOTDIR2_1=TOTDIR2_1+SR2_1
+              ENDIF
+              IF(IDICHR.GE.1) THEN
+                TOTDIF_2=TOTDIF_2+SF_2
+                TOTDIR_2=TOTDIR_2+SR_2
+                IF(I_EXT.EQ.-1) THEN
+                  TOTDIF2_2=TOTDIF2_2+SF2_2
+                  TOTDIR2_2=TOTDIR2_2+SR2_2
+                ENDIF
+              ENDIF
+             ENDDO
+C
+             IF(IDICHR.EQ.0) THEN
+               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VO
+     &LDIR_1,VOLDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     &VOLDIR2_1,VOLDIF2_1
+               ENDIF
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TO
+     &TDIR_1,TOTDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     &TOTDIR2_1,TOTDIF2_1
+               ENDIF
+             ELSE
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),V
+     &OLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+     &,VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
+               ENDIF
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),T
+     &OTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+     &,TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
+               ENDIF
+             ENDIF
+C
+            ENDDO
+           ENDDO
+          ENDDO
+        ELSEIF(ISOM.EQ.2) THEN
+          DO JE=1,NE
+C
+           DO JTHETA=1,NTHETA
+            IF(STEREO.EQ.' NO') THEN
+              NPHI_R=NPHI
+            ELSE
+              RTHETA=DTHETA(JTHETA)*0.017453
+              FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
+              NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
+              NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
+            ENDIF
+            DO JPHI=1,NPHI_R
+C
+              SF_1=0.
+              SR_1=0.
+              SF_2=0.
+              SR_2=0.
+              IF(I_EXT.EQ.-1) THEN
+                SF2_1=0.
+                SR2_1=0.
+                SF2_2=0.
+                SR2_2=0.
+              ENDIF
+C
+              DO JEMET=1,NEMET
+               JF=JEMET
+C
+               JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +(JTHETA-1)*NPHI + J
+     &PHI
+C
+               SF_1=SF_1+TAB(JLIN,2)
+               SR_1=SR_1+TAB(JLIN,1)
+               IF(I_EXT.EQ.-1) THEN
+                 JLIN2=NTT+JLIN
+                 SF2_1=SF2_1+TAB(JLIN2,2)
+                 SR2_1=SR2_1+TAB(JLIN2,1)
+               ENDIF
+               IF(IDICHR.GE.1) THEN
+                 SF_2=SF_2+TAB(JLIN,4)
+                 SR_2=SR_2+TAB(JLIN,3)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   SF2_2=SF2_2+TAB(JLIN2,4)
+                   SR2_2=SR2_2+TAB(JLIN2,3)
+                 ENDIF
+               ENDIF
+              ENDDO
+              IF(I_EXT.LE.0) THEN
+                IF(STEREO.EQ.' NO') THEN
+                  JPHI2=JPHI
+                ELSE
+                  JPHI2=(JTHETA-1)*NPHI+JPHI
+                ENDIF
+              ELSE
+                JPHI2=JTHETA
+              ENDIF
+              IF(IDICHR.EQ.0) THEN
+                WRITE(IUO2,3) JPL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),SR
+     &_1,SF_1
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+     &),SR2_1,SF2_1
+                ENDIF
+              ELSE
+                WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),S
+     &R_1,SF_1,SR_2,SF_2
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(J
+     &E),SR2_1,SF2_1,SR2_2,SF2_2
+                ENDIF
+              ENDIF
+            ENDDO
+           ENDDO
+          ENDDO
+        ENDIF
+      ENDIF
+C
+      GOTO 6
+C
+   5  WRITE(IUO1,4)
+      STOP
+  35  WRITE(IUO1,36) N_FIXED
+      STOP
+  37  WRITE(IUO1,38) NTHETA*NPHI
+      STOP
+C
+   1  FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
+   2  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+   3  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+   4  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF THE ARRAYS TOO SMALL ','IN 
+     &THE TREAT_PHD SUBROUTINE - INCREASE NDIM_M ','>>>>>>>>>>')
+   7  FORMAT(I4,2X,I4,2X,I4)
+   8  FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
+   9  FORMAT(9(2X,I1),2X,I2)
+  15  FORMAT(2X,A3,11X,A13)
+  22  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E1
+     &2.6,2X,E12.6)
+  23  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
+     &,E12.6)
+  25  FORMAT(37X,E12.6,2X,E12.6)
+  36  FORMAT(//,4X,'<<<<<<<<<<  DIMENSION OF NTH_M OR NPH_M TOO SMALL ',
+     &'IN THE INCLUDE FILE >>>>>>>>>>',/,4X,'<<<<<<<<<<                 
+     &SHOULD BE AT LEAST ',I6,'                 >>>>>>>>>>')
+  38  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF NPH_M TOO SMALL ','IN THE I
+     &NCLUDE FILE >>>>>>>>>>',/,8X,'<<<<<<<<<<             SHOULD BE AT 
+     &LEAST ',I6,'             >>>>>>>>>>')
+ 888  FORMAT(A72)
+C
+   6  RETURN
+C
+      END

src/msspec/spec/fortran/phd_ce_noso_nosp_nosym/weight_sum.f

@@ -0,0 +1,335 @@
+C
+C=======================================================================
+C
+      SUBROUTINE WEIGHT_SUM(ISOM,I_EXT,I_EXT_A,JEL)
+C
+C   This subroutine performs a weighted sum of the results
+C     corresponding to different directions of the detector.
+C     The directions and weights are read from an external input file
+C
+C   JEL is the electron undetected (i.e. for which the outgoing
+C     directions are integrated over the unit sphere). It is always
+C     1 for one electron spectroscopies (PHD). For APECS, It can be
+C     1 (photoelectron) or 2 (Auger electron) or even 0 (no electron
+C     detected)
+C
+C                                         Last modified : 31 Jan 2007
+C
+      USE DIM_MOD
+      USE INFILES_MOD
+      USE INUNITS_MOD
+      USE OUTUNITS_MOD
+C
+C
+      PARAMETER(N_MAX=5810,NPM=20)
+C
+      REAL*4 W(N_MAX),W_A(N_MAX),ECIN(NE_M)
+      REAL*4 DTHETA(N_MAX),DPHI(N_MAX),DTHETAA(N_MAX),DPHIA(N_MAX)
+      REAL*4 SR_1,SF_1,SR_2,SF_2
+      REAL*4 SUMR_1(NPM,NE_M,N_MAX),SUMR_2(NPM,NE_M,N_MAX)
+      REAL*4 SUMF_1(NPM,NE_M,N_MAX),SUMF_2(NPM,NE_M,N_MAX)
+C
+      CHARACTER*3 SPECTRO,SPECTRO2
+      CHARACTER*5 LIKE
+      CHARACTER*13 OUTDATA
+C
+C
+C
+C
+      DATA JVOL,JTOT/0,-1/
+      DATA LIKE /'-like'/
+C
+      REWIND IUO2
+C
+      READ(IUO2,15) SPECTRO,OUTDATA
+      IF(SPECTRO.NE.'APC') THEN
+        READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+        SPECTRO2='XAS'
+      ELSE
+        READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        READ(IUO2,9) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A,I
+     &THETA_A,IE_A
+        READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
+        READ(IUO2,8) NPHI_A,NTHETA_A
+        IF(JEL.EQ.1) THEN
+          SPECTRO2='AED'
+        ELSEIF(JEL.EQ.2) THEN
+          SPECTRO2='PHD'
+        ELSEIF(JEL.EQ.0) THEN
+          SPECTRO2='XAS'
+        ENDIF
+      ENDIF
+C
+      IF(NPLAN.GT.NPM) THEN
+        WRITE(IUO1,4) NPLAN+2
+        STOP
+      ENDIF
+C
+C  Reading the number of angular points
+C
+      IF(SPECTRO.NE.'APC') THEN
+        OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+        READ(IUI6,1) N_POINTS
+        READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+        N_POINTS_A=1
+      ELSE
+        IF(JEL.EQ.1) THEN
+          OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+          READ(IUI6,1) N_POINTS
+          READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+          IF(I_EXT_A.EQ.0) THEN
+            N_POINTS_A=NTHETA_A*NPHI_A
+          ELSE
+            OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
+            READ(IUI9,1) N_POINTS_A
+            READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
+          ENDIF
+          NTHETA0=NTHETA_A
+          NPHI0=NPHI_A
+        ELSEIF(JEL.EQ.2) THEN
+          OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
+          READ(IUI9,1) N_POINTS_A
+          READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
+          IF(I_EXT.EQ.0) THEN
+            N_POINTS=NTHETA*NPHI
+          ELSE
+            OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+            READ(IUI6,1) N_POINTS
+            READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+          ENDIF
+          NTHETA0=NTHETA
+          NPHI0=NPHI
+        ELSEIF(JEL.EQ.0) THEN
+          OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
+          OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
+          READ(IUI6,1) N_POINTS
+          READ(IUI9,1) N_POINTS_A
+          READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
+          READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
+        ENDIF
+      ENDIF
+C
+      IF(SPECTRO.NE.'APC') THEN
+        NANGLE=1
+      ELSE
+        IF(JEL.EQ.1) THEN
+          NANGLE=N_POINTS_A
+        ELSEIF(JEL.EQ.2) THEN
+          NANGLE=N_POINTS
+        ELSEIF(JEL.EQ.0) THEN
+          NANGLE=1
+        ENDIF
+      ENDIF
+C
+C  Initialization of the arrays
+C
+      DO JE=1,NE
+        DO JANGLE=1,NANGLE
+          DO JPLAN=1,NPLAN+2
+            SUMR_1(JPLAN,JE,JANGLE)=0.
+            SUMF_1(JPLAN,JE,JANGLE)=0.
+            IF(IDICHR.GT.0) THEN
+              SUMR_2(JPLAN,JE,JANGLE)=0.
+              SUMF_2(JPLAN,JE,JANGLE)=0.
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+C
+C  Reading of the data to be angle integrated
+C
+      DO JE=1,NE
+C
+        DO JANGLE=1,N_POINTS
+          IF(I_EXT.NE.0) READ(IUI6,2) TH,PH,W(JANGLE)
+          DO JANGLE_A=1,N_POINTS_A
+            IF((I_EXT_A.NE.0).AND.(JANGLE.EQ.1)) THEN
+               READ(IUI9,2) THA,PHA,W_A(JANGLE_A)
+            ENDIF
+C
+            DO JPLAN=1,NPLAN+2
+C
+              IF(IDICHR.EQ.0) THEN
+                IF(SPECTRO.NE.'APC') THEN
+                  READ(IUO2,3) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE)
+     &,SR_1,SF_1
+                ELSE
+                  READ(IUO2,13) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
+     &),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1
+                ENDIF
+              ELSE
+                IF(SPECTRO.NE.'APC') THEN
+                  READ(IUO2,23) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
+     &),SR_1,SF_1,SR_2,SF_2
+                ELSE
+                  READ(IUO2,24) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
+     &),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1,SR_2,SF_2
+                ENDIF
+              ENDIF
+C
+              IF(JEL.EQ.1) THEN
+                SUMR_1(JPLAN,JE,JANGLE_A)=SUMR_1(JPLAN,JE,JANGLE_A)+SR_1
+     &*W(JANGLE)
+                SUMF_1(JPLAN,JE,JANGLE_A)=SUMF_1(JPLAN,JE,JANGLE_A)+SF_1
+     &*W(JANGLE)
+              ELSEIF(JEL.EQ.2) THEN
+                SUMR_1(JPLAN,JE,JANGLE)=SUMR_1(JPLAN,JE,JANGLE)+SR_1*W_A
+     &(JANGLE_A)
+                SUMF_1(JPLAN,JE,JANGLE)=SUMF_1(JPLAN,JE,JANGLE)+SF_1*W_A
+     &(JANGLE_A)
+              ELSEIF(JEL.EQ.0) THEN
+                SUMR_1(JPLAN,JE,1)=SUMR_1(JPLAN,JE,1)+SR_1*W(JANGLE)*W_A
+     &(JANGLE_A)
+                SUMF_1(JPLAN,JE,1)=SUMF_1(JPLAN,JE,1)+SF_1*W(JANGLE)*W_A
+     &(JANGLE_A)
+              ENDIF
+              IF(IDICHR.GT.0) THEN
+                IF(JEL.EQ.1) THEN
+                  SUMR_2(JPLAN,JE,JANGLE_A)=SUMR_2(JPLAN,JE,JANGLE_A)+SR
+     &_2*W(JANGLE)
+                  SUMF_2(JPLAN,JE,JANGLE_A)=SUMF_2(JPLAN,JE,JANGLE_A)+SF
+     &_2*W(JANGLE)
+                ELSEIF(JEL.EQ.2) THEN
+                  SUMR_2(JPLAN,JE,JANGLE)=SUMR_2(JPLAN,JE,JANGLE)+SR_2*W
+     &_A(JANGLE_A)
+                  SUMF_2(JPLAN,JE,JANGLE)=SUMF_2(JPLAN,JE,JANGLE)+SF_2*W
+     &_A(JANGLE_A)
+                ELSEIF(JEL.EQ.0) THEN
+                  SUMR_2(JPLAN,JE,1)=SUMR_2(JPLAN,JE,1)+SR_2*W(JANGLE)*W
+     &_A(JANGLE_A)
+                  SUMF_2(JPLAN,JE,1)=SUMF_2(JPLAN,JE,1)+SF_2*W(JANGLE)*W
+     &_A(JANGLE_A)
+                ENDIF
+              ENDIF
+C
+            ENDDO
+C
+          ENDDO
+          IF(I_EXT_A.NE.0) THEN
+            REWIND IUI9
+            READ(IUI9,1) NDUM
+            READ(IUI9,1) NDUM
+          ENDIF
+        ENDDO
+C
+        IF(I_EXT.NE.0) THEN
+          REWIND IUI6
+          READ(IUI6,1) NDUM
+          READ(IUI6,1) NDUM
+        ENDIF
+      ENDDO
+C
+      CLOSE(IUI6)
+      CLOSE(IUI9)
+      REWIND IUO2
+C
+      WRITE(IUO2,16) SPECTRO2,LIKE,SPECTRO,OUTDATA
+      IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+        WRITE(IUO2,19) ISPIN,IDICHR,I_SO,ISFLIP
+        WRITE(IUO2,18) NE,NPLAN,ISOM
+      ELSEIF(JEL.EQ.1) THEN
+        WRITE(IUO2,20) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A
+     &,ITHETA_A,IE_A
+        WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
+      ELSEIF(JEL.EQ.2) THEN
+        WRITE(IUO2,20) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
+        WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
+      ENDIF
+C
+      DO JE=1,NE
+        DO JANGLE=1,NANGLE
+          IF(SPECTRO.EQ.'APC') THEN
+            IF(JEL.EQ.1) THEN
+              THETA=DTHETAA(JANGLE)
+              PHI=DPHIA(JANGLE)
+            ELSEIF(JEL.EQ.2) THEN
+              THETA=DTHETA(JANGLE)
+              PHI=DPHI(JANGLE)
+            ENDIF
+          ENDIF
+C
+          DO JPLAN=1,NPLAN
+            IF(IDICHR.EQ.0) THEN
+              IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+                WRITE(IUO2,33) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
+     &MF_1(JPLAN,JE,JANGLE)
+              ELSE
+                WRITE(IUO2,34) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
+     &JANGLE),SUMF_1(JPLAN,JE,JANGLE)
+              ENDIF
+            ELSE
+              IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+                WRITE(IUO2,43) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
+     &MF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPLAN,JE,JANG
+     &LE)
+              ELSE
+                WRITE(IUO2,44) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
+     &JANGLE),SUMF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPL
+     &AN,JE,JANGLE)
+              ENDIF
+            ENDIF
+          ENDDO
+C
+          IF(IDICHR.EQ.0) THEN
+            IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+              WRITE(IUO2,33) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
+     &F_1(NPLAN+1,JE,JANGLE)
+              WRITE(IUO2,33) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
+     &F_1(NPLAN+2,JE,JANGLE)
+            ELSE
+              WRITE(IUO2,34) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
+     &ANGLE),SUMF_1(NPLAN+1,JE,JANGLE)
+              WRITE(IUO2,34) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
+     &ANGLE),SUMF_1(NPLAN+2,JE,JANGLE)
+            ENDIF
+          ELSE
+            IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
+              WRITE(IUO2,43) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
+     &F_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(NPLAN+1,JE
+     &,JANGLE)
+              WRITE(IUO2,43) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
+     &F_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(NPLAN+2,JE
+     &,JANGLE)
+            ELSE
+              WRITE(IUO2,44) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
+     &ANGLE),SUMF_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(
+     &NPLAN+1,JE,JANGLE)
+              WRITE(IUO2,44) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
+     &ANGLE),SUMF_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(
+     &NPLAN+2,JE,JANGLE)
+            ENDIF
+          ENDIF
+C
+        ENDDO
+      ENDDO
+C
+   1  FORMAT(13X,I4)
+   2  FORMAT(15X,F8.3,3X,F8.3,3X,E12.6)
+   3  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+   4  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF THE ARRAYS TOO SMALL ','IN 
+     &THE WEIGHT_SUM SUBROUTINE - INCREASE NPM TO ',I3,'>>>>>>>>>>')
+   5  FORMAT(6X,I1,1X,I3,3X,I3)
+   8  FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
+   9  FORMAT(9(2X,I1),2X,I2)
+  13  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
+     &12.6)
+  15  FORMAT(2X,A3,11X,A13)
+  16  FORMAT(2X,A3,A5,1X,A3,2X,A13)
+  18  FORMAT(I4,2X,I3,2X,I1)
+  19  FORMAT(4(2X,I1))
+  20   FORMAT(8(2X,I1))
+  21   FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
+  23  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
+     &,E12.6)
+  24  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
+     &12.6,2X,E12.6,2X,E12.6)
+  33  FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6)
+  34  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
+  43  FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
+  44  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
+     &,E12.6)
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/phd_mi_noso_nosp_nosym.mk

@@ -2,7 +2,7 @@ memalloc_src               := memalloc/dim_mod.f memalloc/modules.f memalloc/all
 cluster_gen_src            := $(wildcard cluster_gen/*.f)
 common_sub_src             := $(wildcard common_sub/*.f)
 renormalization_src        := $(wildcard renormalization/*.f)
-phd_mi_noso_nosp_nosym_src := $(wildcard phd_mi_noso_nosp_nosym/*.f)
+phd_mi_noso_nosp_nosym_src := $(filter-out phd_mi_noso_nosp_nosym/lapack_axb.f, $(wildcard phd_mi_noso_nosp_nosym/*.f))
 
 SRCS   = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(phd_mi_noso_nosp_nosym_src)
 MAIN_F = phd_mi_noso_nosp_nosym/main.f

src/msspec/spec/fortran/phd_se_noso_nosp_nosym/pathop.f

@@ -115,7 +115,7 @@ C  Renormalization of the path
 C
       IF(I_REN.GE.1) THEN
          COEF=COEF*C_REN(JORDP)
-         write(354,*) JORDP,C_REN(JORDP)
+C         write(354,*) JORDP,C_REN(JORDP)
       ENDIF
 C
 C   Call of the subroutines used for the R-A termination matrix

src/msspec/tests.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -16,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/tests.py
-# Last modified: ven. 10 avril 2020 17:33:28
-# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 import os

src/msspec/utils.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -18,8 +19,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/utils.py
-# Last modified: Thu, 06 Oct 2022 18:19:16 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1665073156 +0200
+# Last modified: Thu, 06 Oct 2022 18:27:24 +0200
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1665073644 +0200
 
 
 """
@@ -70,7 +71,7 @@ class ForeignPotential(object):
         self.phagen_data = {'types': []}
 
     def write(self, filename, prototypical_atoms):
-        LOGGER.debug(f"Writing Phagen input potential file: {filename}")
+        LOGGER.debug("Writing Phagen input potential file: {}".format(filename))
 
         def DEPRECATEDappend_atom_potential(atom):
             Z = atom.number
@@ -81,8 +82,8 @@ class ForeignPotential(object):
                     itypes.append(i)
             # Check now that we have only one type in the list
             # otherwise we do not know yet how to deal with this.
-            assert len(itypes) > 0, f"Cannot find the data for atom with Z={Z}"
-            assert len(itypes) == 1, f"Too many datasets for atom with Z={Z}"
+            assert len(itypes) > 0, "Cannot find the data for atom with Z={}".format(Z)
+            assert len(itypes) == 1, "Too many datasets for atom with Z={}".format(Z)
             # So far so good, let's write the block
             t = self.phagen_data['types'][itypes[0]]
             s = "{:<7d}{:<10d}{:1.4f}\n".format(
@@ -95,7 +96,7 @@ class ForeignPotential(object):
         def append_atom_potential(atom):
             line_fmt = "{:+1.8e} " * 4 + "\n"
             atom_type = atom.get('atom_type')
-            assert atom_type != None, f"Unable get the atom type!"
+            assert atom_type != None, "Unable get the atom type!"
             for t in self.phagen_data['types']:
                 if t['atom_type'] == atom_type:
                     s = "{:<7d}{:<10d}{:1.4f}\n".format(
@@ -138,7 +139,7 @@ class SPRKKRPotential(ForeignPotential):
         self.potfile = potfile
         self.load_sprkkr_atom_types()
         for f in exported_files:
-            LOGGER.info(f"Loading file {f}...")
+            LOGGER.info("Loading file {}...".format(f))
             # get the IT from the filename
             m=re.match('SPRKKR-IT_(?P<IT>\d+)-PHAGEN.*', os.path.basename(f))
             it = int(m.group('IT'))
@@ -192,7 +193,7 @@ class SPRKKRPotential(ForeignPotential):
             return data
 
         # load info in *.pot file
-        LOGGER.info(f"Loading SPRKKR *.pot file {self.potfile}...")
+        LOGGER.info("Loading SPRKKR *.pot file {}...".format(self.potfile))
         with open(self.potfile, 'r') as fd:
             content = fd.read()
 
@@ -233,7 +234,7 @@ class SPRKKRPotential(ForeignPotential):
                     IT = occupation['ITOQ']
                     atom = self.atoms[i]
                     atom.set('atom_type', IT)
-            LOGGER.debug(f"Site #{IQ} is type #{IT}, atom {atom}")
+            LOGGER.debug("Site #{} is type #{}, atom {}".format(IQ, IT, atom))
 
 
 
@@ -314,34 +315,13 @@ def cut_cylinder(atoms, axis="z", radius=None):
     :return: The modified atom cluster
     :rtype: ase.Atoms
     """
-    if radius is None:
-        raise ValueError("radius not set")
-
-    new_atoms = atoms.copy()
-
-    dims = {"x": 0, "y": 1, "z": 2}
-    if axis in dims:
-        axis = dims[axis]
-    else:
-        raise ValueError("axis not valid, must be 'x','y', or 'z'")
-
-    del_list = []
-    for index, position in enumerate(new_atoms.positions):
-        # calculating the distance of the atom to the given axis
-        r = 0
-        for dim in range(3):
-            if dim != axis:
-                r = r + position[dim]**2
-        r = np.sqrt(r)
-
-        if r > radius:
-            del_list.append(index)
-
-    del_list.reverse()
-    for index in del_list:
-        del new_atoms[index]
-
-    return new_atoms
+    if axis not in ('z',):
+        raise ValueError("axis value != 'z' is not supported yet.")
+    X, Y, Z = atoms.positions.T
+    R = np.sqrt(X**2 + Y **2)
+    T = np.arctan2(Y, X)
+    i = np.where(R <= radius)[0]
+    return atoms[i]
 
 
 def cut_cone(atoms, radius, z=0):
@@ -429,11 +409,15 @@ def cut_plane(atoms, x=None, y=None, z=None):
 
     dim_values = np.array(dim_values)
 
-    def constraint(coordinates):
-        return np.all(np.logical_and(coordinates >= dim_values[:, 0],
-                                     coordinates <= dim_values[:, 1]))
+    X, Y, Z = atoms.positions.T
+    i0 = np.where(X                     >= dim_values[0, 0])[0]
+    i1 = np.where(X[i0]                 <= dim_values[0, 1])[0]
+    i2 = np.where(Y[i0][i1]             >= dim_values[1, 0])[0]
+    i3 = np.where(Y[i0][i1][i2]         <= dim_values[1, 1])[0]
+    i4 = np.where(Z[i0][i1][i2][i3]     >= dim_values[2, 0])[0]
+    i5 = np.where(Z[i0][i1][i2][i3][i4] <= dim_values[2, 1])[0]
+    indices = np.arange(len(atoms))[i0][i1][i2][i3][i4][i5]
 
-    indices = np.where(list(map(constraint, atoms.positions)))[0]
     return atoms[indices]
 
 

src/msspec/version.py

@@ -1,4 +1,5 @@
 #!/usr/bin/env python
+# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -16,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/version.py
-# Last modified: Thu, 06 Oct 2022 18:19:16 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1665073156 +0200
+# Last modified: Wed, 26 Oct 2022 17:15:24 +0200
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1666797324 +0200
 
 
 import os
@@ -26,28 +27,29 @@ from importlib.metadata import version
 import subprocess
 
 # find the version number
-# 1- If it fails, try to read it from the distribution file
-# 2- Try to read it from the git info
-# 3- If it fails, try to read it from the VERSION file
+# 1- Try to read it from the git info
+# 2- If it fails, try to read it from the VERSION file
+# 3- If it fails, try to read it from the distribution file
 
 PKGNAME = 'msspec'
 
-try:
-    __version__ = version(PKGNAME)
-except Exception as err:
-    try:
-        p = subprocess.run(["git", "describe"], capture_output=True, text=True)
-        if p.stdout not in ("", None):
-            __version__ = p.stdout.strip()
-        else:
-            raise NameError("git describe failed!")
-    except Exception as err:
-        try:
 thisfile_path = os.path.abspath(__file__)
 thisfile_dir = os.path.dirname(thisfile_path)
-            versionfile = os.path.join(thisfile_dir, "../VERSION")
+
+try:
+    cmd = ["git describe|sed 's/-\([0-9]\+\)-.*/.dev\\1/g'"]
+    result = subprocess.run(cmd, stdout=subprocess.PIPE, stderr=subprocess.DEVNULL, 
+            shell=True, cwd=thisfile_dir)
+    __version__ = result.stdout.decode('utf-8').strip()
+    if __version__ == "":
+        raise
+except Exception as err:
+    try:
+        versionfile = os.path.join(thisfile_dir, "./VERSION")
         with open(versionfile, "r") as fd:
             __version__ = fd.readline().strip()
     except Exception as err:
-            print("Unable to get the version number!")
-            __version__ = "9.9.9"
+        try:
+            __version__ = version(PKGNAME)
+        except Exception as err:
+            __version__ = "0.0.0"

src/options.mk

@@ -1,6 +1,6 @@
 PYTHON   = python
 PYMAJ    = 3
-PYMIN    = 6
+PYMIN    = 5
 
 FC       = gfortran
 F2PY     = f2py3 --f77exec=$(FC) --f90exec=$(FC)
@@ -31,7 +31,7 @@ IFORT_FFLAGS_DBG =
 ################################################################################
 # F2PY CONFIGURATION                                                           #
 ################################################################################
-F2PYFLAGS     = --opt=-O2
+F2PYFLAGS     = --opt=-O2 -llapack
 F2PYFLAGS_DBG = --debug-capi --debug
 ################################################################################
 
@@ -41,7 +41,7 @@ F2PYFLAGS_DBG = --debug-capi --debug
 # /!\ DO NOT EDIT BELOW THAT LINE (unlesss you know what you're doing...)      #
 # CORE CONFIGURATION                                                           #
 ################################################################################
-VERSION:=$(shell git describe)
+VERSION:=$(shell git describe|sed 's/-\([0-9]\+\)-.*/.dev\1/g')
 VENV_PATH := $(INSTALL_PREFIX)/src/msspec_venv_$(VERSION)
 
 

src/pip.freeze

@@ -2,7 +2,7 @@ ase
 h5py
 ipython
 lxml
-matplotlib==3.4.3
+matplotlib
 numpy
 Pint
 pandas

src/pyproject.toml

@@ -0,0 +1,3 @@
+[build-system]
+requires = ["setuptools>=45", "setuptools_scm[toml]>=6.2"]
+build-backend = "setuptools.build_meta"

src/setup.cfg

@@ -0,0 +1,55 @@
+[metadata]
+name = msspec
+version = attr: msspec.version.__version__
+author = Didier Sébilleau, Sylvain Tricot
+author_email = sylvain.tricot@univ-rennes1.fr
+url = https://msspec.cnrs.fr
+description = A multiple scattering package for sepectroscopies using electrons to probe materials
+long_description = MsSpec is a Fortran package to compute the
+                   cross-section of several spectroscopies involving one (or more)
+                   electron(s) as the probe. This package provides a python interface to
+                   control all the steps of the calculation.
+
+                   Available spectroscopies:
+                       * Photoelectron diffraction
+                       * Auger electron diffraction
+                       * Low energy electron diffraction
+                       * X-Ray absorption spectroscopy
+                       * Auger Photoelectron coincidence spectroscopy
+                       * Computation of the spectral radius""",
+keywords = spectroscopy atom electron photon multiple scattering
+license = GPL
+classifiers =
+    Development Status :: 3 - Alpha
+    Environment :: Console
+    Intended Audience :: Science/Research
+    License :: OSI Approved :: GNU General Public License (GPL)
+    Natural Language :: English
+    Operating System :: Microsoft :: Windows :: Windows 10
+    Operating System :: POSIX :: Linux
+    Operating System :: MacOS :: MacOS X
+    Programming Language :: Fortran
+    Programming Language :: Python :: 3 :: Only
+    Topic :: Scientific/Engineering :: Physics
+
+[options]
+packages = find:
+zip_safe = False
+install_requires =
+    setuptools_scm
+    ase
+    h5py
+    ipython
+    lxml
+    matplotlib
+    numpy
+    Pint
+    pandas
+    pycairo
+    scipy
+    terminaltables
+
+[options.package_data]
+msspec.phagen = fortran/*.so
+msspec.spec = fortran/*.so
+msspec = VERSION