Added AED with series expansion.

WIP

Dockerfile

@@ -1,112 +1,24 @@
 # Get the base Python image
-FROM alpine:edge AS builder
+FROM python:latest
-
-# Variables
-ARG branch="devel"
-ARG login="" password=""
-ARG folder=/opt/msspec user=msspec
 
 # Install system dependencies
-# tools
+RUN apt-get update && apt-get install -y virtualenv gfortran libgtk-3-dev nano
-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 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}
+RUN useradd -ms /bin/bash -d /opt/msspec msspec
 
 # Set the working directory in the container
-#USER ${user}
+USER msspec
+RUN mkdir -p /opt/msspec/code
+WORKDIR /opt/msspec/code
 
-#RUN virtualenv --system-site-packages ${folder}/.local/src/msspec_venv
+# Fetch the code
-#RUN source ${folder}/.local/src/msspec_venv/bin/activate && pip install src/dist/msspec*.tar.gz
+RUN git clone https://git.ipr.univ-rennes1.fr/epsi/msspec_python3.git .
-#RUN make -C src frontend PYTHON=python3 NO_VENV=1 VENV_PATH=${folder}/.local/src/msspec_venv
+#COPY --chown=msspec:msspec . .
 
-
-
-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
-#COPY --from=builder ${folder}/.local ${folder}/.local
+ENV PATH=/opt/msspec/.local/bin:$PATH
-#COPY --from=builder /usr/lib/python3.10/site-packages /usr/lib/python3.10/site-packages
+RUN make install VERBOSE=1
-
-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"]

Makefile

@@ -1,7 +1,7 @@
 include src/options.mk
 
 
-.PHONY: pybinding install devel venv doc clean _attrdict
+.PHONY: pybinding install devel venv doc clean
 
 
 pybinding:
@@ -11,20 +11,19 @@ pybinding:
 venv:
 ifeq ($(NO_VENV),0)
 	@virtualenv --python=$(PYTHON_EXE) --prompt="(msspec-$(VERSION)) " $(VENV_PATH)
-	$(INSIDE_VENV) python -m ensurepip --upgrade
+	$(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
 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)*.whl
+	@+$(INSIDE_VENV) pip install src/dist/msspec-$(VERSION).tar.gz
 	@echo "Do not forget to check that $(INSTALL_PREFIX)/bin is set in your \$$PATH"
 
 
@@ -33,37 +32,18 @@ devel: venv pybinding wx
 	@$(INSIDE_VENV) pip install -e src/
 
 
-light: VENV_PATH = ./_venv
+_build_wx/wxPython.target:
-light: venv
-	@$(INSIDE_VENV) pip install src/
-
-nogui: VENV_PATH = ./_venv
-nogui: venv pybinding
-	@$(INSIDE_VENV) pip install -e src/
-
-
-_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
 	# 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 sip; \
+            pip install requests; \
             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,8 +18,7 @@ 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

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

src/Makefile

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

src/msspec.sh.template

@@ -2,11 +2,12 @@
 
 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 msspec!!"
+   echo "ERROR: Unable to find version $VERSION of msspec!!"
    exit 1
 fi
 
@@ -14,10 +15,6 @@ 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]"
@@ -95,7 +92,7 @@ while getopts "hvil:p:eu" option; do
          ;;
       u) uninstall
          ;;
-      v) show_version
+      v) echo $VERSION
          ;;
       *|h) show_help
          ;;

src/msspec/calcio.py

@@ -747,15 +747,15 @@ class SpecIO(object):
         content += line
 
         nat = p.extra_nat
-        nra_arr = np.ones((nat), dtype=int)
+        nra_arr = np.ones((nat), dtype=np.int)
         thfwd_arr = np.ones((nat))
         path_filtering = p.extra_parameters['calculation'].get_parameter(
             'path_filtering').value
         if (path_filtering is not None and
                 'backward_scattering' in path_filtering):
-            ibwd_arr = np.ones((nat), dtype=int)
+            ibwd_arr = np.ones((nat), dtype=np.int)
         else:
-            ibwd_arr = np.zeros((nat), dtype=int)
+            ibwd_arr = np.zeros((nat), dtype=np.int)
         thbwd_arr = np.ones((nat))
         for at in p.extra_atoms:
             i = at.get('proto_index') - 1

src/msspec/calculator.py

@@ -17,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/calculator.py
-# Last modified: Tue, 25 Oct 2022 16:21:38 +0200
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1666707698 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """
@@ -97,7 +97,6 @@ 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 _comp_curves
 from msspec.utils import get_atom_index
 
@@ -303,7 +302,7 @@ class _MSCALCULATOR(Calculator):
         wf = 4.5
         source_energy = self.source_parameters.get_parameter('energy').value
         ke = source_energy - binding_energy - wf
-        #return np.array(ke, dtype=float).flatten()
+        #return np.array(ke, dtype=np.float).flatten()
         return ke
 
 
@@ -385,7 +384,7 @@ class _MSCALCULATOR(Calculator):
                'NODES_EX_M' : 3,
                'NSPIN_M'    : 1, # to change for spin dependent
                'NTH_M'      : 2000,
-               'NPH_M'      : 8000,
+               'NPH_M'      : 2000,
                'NDIM_M'     : 100000,
                'N_TILT_M'   : 11, # to change see extdir.f
                'N_ORD_M'    : 250,
@@ -406,8 +405,6 @@ 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,
@@ -619,7 +616,7 @@ class _PED(_MSCALCULATOR):
     def _get_scan(self, scan_type='theta', phi=0,
                   theta=np.linspace(-70, 70, 141), level=None,
                   kinetic_energy=None, data=None,
-                  malloc={}, other_parameters={}):
+                  malloc={}):
         LOGGER.info("Computting the %s scan...", scan_type)
         if data:
             self.iodata = data
@@ -654,13 +651,6 @@ class _PED(_MSCALCULATOR):
 
         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)
 
@@ -749,7 +739,7 @@ class _PED(_MSCALCULATOR):
 
                 view = dset.add_view("E = {:.2f} eV".format(ke), title=title,
                                      xlabel=xlabel, ylabel=ylabel,
-                                     projection='stereo', colorbar=True, autoscale=False)
+                                     projection='stereo', colorbar=True, autoscale=True)
                 view.select('theta', 'phi', 'cross_section')
 
 
@@ -862,7 +852,7 @@ class _PED(_MSCALCULATOR):
         return self.iodata
 
     def get_scattering_factors(self, level='1s', kinetic_energy=None,
-                               data=None, **kwargs):
+                               data=None):
         """Computes the scattering factors of all prototypical atoms in the
         cluster.
 
@@ -881,11 +871,11 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='scatf', level=level, data=data,
-                              kinetic_energy=kinetic_energy, **kwargs)
+                              kinetic_energy=kinetic_energy)
         return data
 
     def get_theta_scan(self, phi=0, theta=np.linspace(-70, 70, 141),
-                       level=None, kinetic_energy=None, data=None, **kwargs):
+                       level=None, kinetic_energy=None, data=None):
         """Computes a polar scan of the emitted photoelectrons.
 
         :param phi: The azimuthal angle in degrees. See
@@ -902,12 +892,11 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='theta', level=level, theta=theta,
-                              phi=phi, kinetic_energy=kinetic_energy,
+                              phi=phi, kinetic_energy=kinetic_energy, data=data)
-                              data=data, **kwargs)
         return data
 
     def get_phi_scan(self, phi=np.linspace(0, 359, 359), theta=0,
-                     level=None, kinetic_energy=None, data=None, **kwargs):
+                     level=None, kinetic_energy=None, data=None):
         """Computes an azimuthal scan of the emitted photoelectrons.
 
         :param phi: All the values of the azimuthal angle to be computed. See
@@ -924,13 +913,12 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='phi', level=level, theta=theta,
-                              phi=phi, kinetic_energy=kinetic_energy,
+                              phi=phi, kinetic_energy=kinetic_energy, data=data)
-                              data=data, **kwargs)
         return data
 
     def get_theta_phi_scan(self, phi=np.linspace(0, 360),
                            theta=np.linspace(0, 90, 45), level=None,
-                           kinetic_energy=None, data=None, **kwargs):
+                           kinetic_energy=None, data=None):
         """Computes a stereographic scan of the emitted photoelectrons.
 
         The azimuth ranges from 0 to 360° and the polar angle ranges from 0 to
@@ -947,11 +935,11 @@ class _PED(_MSCALCULATOR):
         """
         data = self._get_scan(scan_type='theta_phi', level=level, theta=theta,
                               phi=phi, kinetic_energy=kinetic_energy, data=data,
-                              **kwargs)
+                              malloc={'NPH_M': 8000})
         return data
 
     def get_energy_scan(self, phi=0, theta=0,
-                        level=None, kinetic_energy=None, data=None, **kwargs):
+                        level=None, kinetic_energy=None, data=None):
         """Computes an energy scan of the emitted photoelectrons.
 
         :param phi: All the values of the azimuthal angle to be computed. See
@@ -968,8 +956,7 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='energy', level=level, theta=theta,
-                              phi=phi, kinetic_energy=kinetic_energy,
+                              phi=phi, kinetic_energy=kinetic_energy, data=data)
-                              data=data, **kwargs)
         return data
 
 

src/msspec/iodata.py

@@ -17,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/iodata.py
-# Last modified: Wed, 26 Feb 2025 11:10:17 +0100
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes.fr>
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """
@@ -79,26 +79,19 @@ import ase.io
 from ase.io.extxyz import read_xyz, write_xyz
 import h5py
 import numpy as np
+import wx.grid
 from lxml import etree
+from matplotlib.backends.backend_wxagg import FigureCanvasWxAgg as FigureCanvas
 #from matplotlib.backends.backend_wxagg import FigureCanvasWx as FigureCanvas
 from matplotlib.backends.backend_agg import FigureCanvasAgg
-#from matplotlib.backends.backend_cairo import FigureCanvasCairo as FigureCanvasAgg
+from matplotlib.backends.backend_wxagg import NavigationToolbar2WxAgg
 from matplotlib.figure import Figure
 from terminaltables import AsciiTable
 
 import msspec
+from msspec.msspecgui.msspec.gui.clusterviewer import ClusterViewer
 from msspec.misc import LOGGER
 
-try:
-    import wx.grid
-    from matplotlib.backends.backend_wxagg import FigureCanvasWxAgg as FigureCanvas
-    from matplotlib.backends.backend_wxagg import NavigationToolbar2WxAgg
-    from msspec.msspecgui.msspec.gui.clusterviewer import ClusterViewer
-    has_gui = True
-except ImportError:
-    LOGGER.warning('No modules for GUI')
-    has_gui = False
-
 
 def cols2matrix(x, y, z, nx=88*1+1, ny=360*1+1):
     # mix the values of existing theta and new theta and return the
@@ -803,17 +796,11 @@ class Data(object):
         """Pops up a grphical window to show all the defined views of the Data object.
 
         """
-        if has_gui:
         app = wx.App(False)
         app.SetAppName('MsSpec Data Viewer')
         frame = _DataWindow(self)
         frame.Show(True)
         app.MainLoop()
-        else:
-            print('**** INFORMATION ****')
-            print('You can not use the Data.view() method since ther is no')
-            print('graphical user interface available in this version of MsSpec.')
-            print("Install WxPython if you need it or use Data.export(...) method instead.")
 
 
 class _DataSetView(object):
@@ -898,18 +885,15 @@ class _DataSetView(object):
                         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 = 2 * np.tan(np.radians(theta/2.))
-                        #R_ticks = 2 * np.tan(np.radians(theta_ticks/2.))
+                        R_ticks = 2 * np.tan(np.radians(theta_ticks/2.))
-                        R = theta/90.
-                        R_ticks = theta_ticks/90.
                     #R = np.tan(np.radians(theta/2.))
                     X, Y = np.meshgrid(np.radians(phi), R)
-                    im = axes.pcolormesh(X, Y, Xsec, shading='gouraud')
+                    im = axes.pcolormesh(X, Y, Xsec)
                     axes.set_yticks(R_ticks)
                     axes.set_yticklabels(theta_ticks)
 
-                    cbar = figure.colorbar(im)
+                    figure.colorbar(im)
-                    #im.set_clim(0, 0.0275)
 
                 elif proj == 'polar':
                     values[0] = np.radians(values[0])
@@ -932,7 +916,6 @@ class _DataSetView(object):
             axes.set_ylabel(opts['ylabel'])
             axes.set_xlim(*opts['xlim'])
             axes.set_ylim(*opts['ylim'])
-            #axes.set_axis_off()
             #axes.set_pickradius(5)
             if label:
                 axes.legend()
@@ -1023,8 +1006,7 @@ class _DataSetView(object):
         s += '\tconditions : %s\n' % str(self._selection_conditions)
         return s
 
-if has_gui:
+class _GridWindow(wx.Frame):
-    class _GridWindow(wx.Frame):
     def __init__(self, dset, parent=None):
         title = 'Data: ' + dset.title
         wx.Frame.__init__(self, parent, title=title, size=(640, 480))
@@ -1038,7 +1020,7 @@ if has_gui:
             for iv, v in enumerate(dset[c]):
                 grid.SetCellValue(iv, ic, str(v))
 
-    class _ParametersWindow(wx.Frame):
+class _ParametersWindow(wx.Frame):
     def __init__(self, dset, parent=None):
         title = 'Parameters: ' + dset.title
         wx.Frame.__init__(self, parent, title=title, size=(400, 480))
@@ -1066,7 +1048,7 @@ if has_gui:
         tree.ExpandAll()
         tree.SelectItem(root)
 
-    class _DataWindow(wx.Frame):
+class _DataWindow(wx.Frame):
     def __init__(self, data):
         assert isinstance(data, (Data, DataSet))
 

src/msspec/iodata_gi.py

@@ -235,8 +235,8 @@ class DataSet(object):
                          float: '{:<20.10e}', complex: 's'}
         self._formats = ((np.integer, '{:<20d}'),
                          (np.floating, '{:<20.10e}'),
-                         (complex, '({0.real:<.10e} {0.imag:<.10e}j)'),
+                         (np.complex, '({0.real:<.10e} {0.imag:<.10e}j)'),
-                         (bool, '{:s}'),
+                         (np.bool, '{:s}'),
                          (str, '{:s}'))
 
 
@@ -450,13 +450,9 @@ 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'])
-        s.seek(0)
+        return ase.io.read(s, format='xyz')
-        #return ase.io.read(s, format='xyz')
-        cluster = list(read_xyz(s))[-1]
-        return cluster
 
 
     def select(self, *args, **kwargs):
@@ -789,13 +785,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][...]})
+                    dset.add_columns(**{h5dset: fd['DATA'][dset_name][h5dset].value})
 
             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'][...].tobytes()
+                xml = fd['MsSpec viewer metainfo']['info'].value.tostring()
                 root = etree.fromstring(xml)
                 for elt0 in root.iter('parameters'):
                     dset_name = elt0.attrib['dataset']
@@ -858,7 +854,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):
@@ -951,8 +947,7 @@ 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'):
@@ -966,7 +961,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, shading='gouraud')
+                    im = axes.pcolormesh(X, Y, Xsec)
                     axes.set_yticks(R_ticks)
                     axes.set_yticklabels(theta_ticks)
 
@@ -974,7 +969,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':
@@ -985,7 +980,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'])
@@ -993,7 +988,6 @@ 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'])
@@ -1248,7 +1242,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, modal=True)
+                             transient_for=self, flags=Gtk.DialogFlags.MODAL)
             dlg.add_buttons(Gtk.STOCK_YES, Gtk.ResponseType.YES,
                             Gtk.STOCK_NO, Gtk.ResponseType.NO)
             dlg.set_default_size(150, 100)
@@ -1480,14 +1474,9 @@ class OLD_DataWindow(wx.Frame):
         cluster_viewer = ClusterViewer(win, size=wx.Size(480, 340))
 
         dset = self.data[self._current_dset]
-        #s = StringIO()
+        s = StringIO()
-        #s.write(dset.get_parameter(group='Cluster', name='cluster')['value'])
+        s.write(dset.get_parameter(group='Cluster', name='cluster')['value'])
-        #_s = dset.get_parameter(group='Cluster', name='cluster')['value']
+        atoms = ase.io.read(s, format='xyz')
-        #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.)
@@ -1688,7 +1677,7 @@ class OLD_DataWindow(wx.Frame):
 
 
 if __name__ == "__main__":
-    if False:
+    if True:
         data = Data('all my data')
         dset = data.add_dset('Dataset 0')
         X = np.arange(0, 20)
@@ -1724,7 +1713,6 @@ if __name__ == "__main__":
         view.select('x', 'y')
 
         data.view()
-        exit()
+    #import sys
-    import sys
+    #data = Data.load(sys.argv[1])
-    data = Data.load(sys.argv[1])
+    #data.view()
-    data.view()

src/msspec/looper.py

@@ -17,8 +17,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/looper.py
-# Last modified: Wed, 26 Feb 2025 11:15:54 +0100
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes.fr>
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 from collections import OrderedDict
 from functools import partial
@@ -92,8 +92,9 @@ class Sweep:
 
 
 class SweepRange:
-    def __init__(self, *sweeps):
+    def __init__(self, *sweeps, passindex=False):
         self.sweeps = sweeps
+        self.passindex = passindex
         self.index = 0
 
         # First check that sweeps that are linked to another on are all included
@@ -157,6 +158,7 @@ class SweepRange:
                     for s in [sweep,] + children:
                         key, value = s[idx]
                         row[key] = value
+                if self.passindex:
                     row['sweep_index'] = i
             return row
         else:
@@ -164,8 +166,9 @@ class SweepRange:
 
     @property
     def columns(self):
-        cols  = ['sweep_index']
+        cols = [sweep.key for sweep in self.sweeps]
-        cols += [sweep.key for sweep in self.sweeps]
+        if self.passindex:
+            cols.append('sweep_index')
         return cols
 
     @property
@@ -199,27 +202,31 @@ class Looper:
         logger.debug("Pipeline called with {}".format(x))
         return self.pipeline(**x)
 
-    def run(self, *sweeps, ncpu=1, **kwargs):
+    def run(self, *sweeps, ncpu=1, passindex=False):
         logger.info("Loop starts...")
         # prepare the list of inputs
-        sr = SweepRange(*sweeps)
+        sr = SweepRange(*sweeps, passindex=passindex)
         items = sr.items
 
         data = []
 
-        t0 = time.time()
-
         if ncpu == 1:
             # serial processing...
             logger.info("serial processing...")
+            t0 = time.time()
+
             for i, values in enumerate(items):
-                values.update(kwargs)
                 result = self._wrapper(values)
                 data.append(result)
+
+            t1 = time.time()
+            dt = t1 - t0
+            logger.info("Processed {:d} sets of inputs in {:.3f} seconds".format(
+                len(sr), dt))
+
         else:
             # Parallel processing...
             chunksize = 1 #int(nsets/ncpu)
-            [values.update(kwargs) for values in items]
             logger.info(("Parallel processing over {:d} cpu (chunksize={:d})..."
                          "").format(ncpu, chunksize))
             t0 = time.time()
@@ -236,16 +243,14 @@ class Looper:
 
         # Create the DataFrame
         dfdata = []
-        columns = sr.columns + list(kwargs.keys()) + ['output',]
+        columns = sr.columns + ['output',]
 
         for i in range(len(sr)):
             row = list(items[i].values())
             row.append(data[i])
             dfdata.append(row)
 
-
         df = pd.DataFrame(dfdata, columns=columns)
-        df = df.drop(columns=['sweep_index'])
 
         self.data = df
 
@@ -254,14 +259,14 @@ class Looper:
         # of corresponding dict of parameters {'keyA': [val0,...valn],
         # 'keyB': [val0,...valn], ...}
 
-        # all_xy = []
+        all_xy = []
-        # for irow, row in df.iterrows():
+        for irow, row in df.iterrows():
-            # all_xy.append(row.output[0])
+            all_xy.append(row.output[0])
-            # all_xy.append(row.output[1])
+            all_xy.append(row.output[1])
-        # parameters = df.to_dict()
+        parameters = df.to_dict()
-        # parameters.pop('output')
+        parameters.pop('output')
 
-        return self.data #all_xy, parameters
+        return all_xy, parameters
 
 
 
@@ -271,16 +276,17 @@ class Looper:
 if __name__ == "__main__":
     import numpy as np
     import time
-    import logging
-
-
-    logging.basicConfig(level=logging.DEBUG)
 
+    logger.setLevel(logging.DEBUG)
 
 
     def bar(**kwargs):
-        i = kwargs.get('sweep_index')
+        return 0
-        return np.linspace(0,i,10)
+
+    def post_process(data):
+        x = data.x.unique()
+        y = data.y.unique()
+
 
     theta = Sweep(key='theta', comments="The polar angle",
                   start=-70, stop=70, num=3,
@@ -308,16 +314,7 @@ if __name__ == "__main__":
 
     looper = Looper()
     looper.pipeline = bar
-    other_kws = {'un':1, 'deux':2}
+    data = looper.run(emitter, emitter_plane, uij, theta, levels, ncpu=4,
-    data = looper.run(emitter, emitter_plane, uij, theta, levels, ncpu=4, **other_kws)
+                      passindex=True)
-
-    # Print the dataframe
     print(data)
-
+    #print(data[data.emitter_plane.eq(0)].theta.unique())
-    # Accessing the parameters and ouput values for a given sweep (e.g the last one)
-    print(looper.data.iloc[-1])
-
-    # Post-process the output values. For example here, the output is a 1D-array,
-    # make the sum of sweeps with 'Sr' emitter
-    X = np.array([ x for x in data[data.emitter == 'Sr'].output]).sum(axis=0)
-    print(X)

src/msspec/parameters.py

@@ -19,8 +19,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/parameters.py
-# Last modified: Tue, 15 Feb 2022 15:37:28 +0100
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """
@@ -839,17 +839,6 @@ class GlobalParameters(BaseParameters):
         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.')
@@ -1322,8 +1311,8 @@ class ScanParameters(BaseParameters):
         #    LOGGER.error('Incompatible options!')
         #    raise ValueError(msg)
 
-        # p._value = np.array(p.value, dtype=float).flatten()
+        # p._value = np.array(p.value, dtype=np.float).flatten()
-        arr = np.array(p.value, dtype=float).flatten()
+        arr = np.array(p.value, dtype=np.float).flatten()
 
         theta0 = arr[0]
         theta1 = arr[-1]
@@ -1357,7 +1346,7 @@ class ScanParameters(BaseParameters):
        #    LOGGER.error('Incompatible options')
        #    raise ValueError(msg)
 
-        arr = np.array(p.value, dtype=float).flatten()
+        arr = np.array(p.value, dtype=np.float).flatten()
 
         phi0 = arr[0]
         phi1 = arr[-1]
@@ -1551,7 +1540,7 @@ class CalculationParameters(BaseParameters):
             Parameter('cutoff_factor', types=(int, float),
                       limits=(1e-4, 999.9999), default=0.01, private=False),
             Parameter('mean_free_path', types=(int, float, str),
-                      default='SeahDench', #allowed_values=('mono', 'SeahDench'),
+                      default='SeahDench', allowed_values=('mono', 'SeahDench'),
                       doc="""
             The electron mean free path value. You can either:
             - Enter a value (in Angströms), in this case any value <=0 will disable the damping

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

@@ -28,7 +28,7 @@ c
       integer fl_, rdx_
 c
       parameter ( rdx_     =  1600,
-     $            lmax_    =  80,
+     $            lmax_    =  50,
      $            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 ) .or. ( i .ge. size(r_real) )) then
+        if ( r_real ( i ) > r_in ) then
 
           exit
 

src/msspec/spec/fortran/Makefile

@@ -1,6 +1,6 @@
-.PHONY: all phd_se phd_mi phd_ce eig_mi eig_pw comp_curve clean
+.PHONY: all phd_se phd_mi aed_se aed_mi eig_mi eig_pw comp_curve clean
 
-all: phd_se phd_mi phd_ce eig_mi eig_pw comp_curve
+all: phd_se phd_mi aed_se aed_mi eig_mi eig_pw comp_curve
 
 phd_se:
 	@+$(MAKE) -f phd_se_noso_nosp_nosym.mk all
@@ -8,8 +8,11 @@ phd_se:
 phd_mi:
 	@+$(MAKE) -f phd_mi_noso_nosp_nosym.mk all
 
-phd_ce:
+aed_se:
-	@+$(MAKE) -f phd_ce_noso_nosp_nosym.mk all
+	@+$(MAKE) -f aed_se_mu_noso_nosp_nosym.mk all
+
+aed_mi:
+	@+$(MAKE) -f aed_mi_mu_noso_nosp_nosym.mk all
 
 eig_mi:
 	@+$(MAKE) -f eig_mi.mk all
@@ -23,7 +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 aed_se_mu_noso_nosp_nosym.mk $@
+	@+$(MAKE) -f aed_mi_mu_noso_nosp_nosym.mk $@
 	@+$(MAKE) -f eig_mi.mk $@
 	@+$(MAKE) -f eig_pw.mk $@
 	@+$(MAKE) -f comp_curve.mk $@

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym.mk

@@ -0,0 +1,12 @@
+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)
+#aed_mi_mu_noso_nosp_nosym_src := $(wildcard aed_mi_mu_noso_nosp_nosym/*.f)
+aed_mi_mu_noso_nosp_nosym_src := $(filter-out aed_mi_mu_noso_nosp_nosym/lapack_axb.f, $(wildcard aed_mi_mu_noso_nosp_nosym/*.f))
+
+SRCS   = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(aed_mi_mu_noso_nosp_nosym_src)
+MAIN_F = aed_mi_mu_noso_nosp_nosym/main.f
+SO     = _aed_mi_mu_noso_nosp_nosym.so
+
+include ../../../options.mk

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/aeddif_mi_mu.f

@@ -0,0 +1,789 @@
+C
+C=======================================================================
+C
+      SUBROUTINE AEDDIF_MI_MU(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOK,
+     1                        NATCLU,NFICHLEC,JFICH,NP,LE_MIN,LE_MAX)
+C
+C   This subroutine computes the AED formula in the spin-independent case
+C        from a multiplet resolved initial core state L1. The 
+C        intermediate state that gives its energy is L2 while the 
+C        core hole that is filled in the process is noted LC. The 
+C        multiplet is characterized by the integer angular momentum 
+C        variables (L_MUL,S_MUL,J_MUL)
+C
+C   Alternatively, it can compute the AED amplitude for the APECS process.
+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
+      USE DIM_MOD
+
+      USE ALGORITHM_MOD
+      USE AMPLI_MOD
+      USE APPROX_MOD
+      USE COOR_MOD, NTCLU => NATCLU, NTP => NATYP
+      USE DEBWAL_MOD
+      USE DIRECT_A_MOD, DIRANA => DIRANA_A, ANADIR => ANADIR_A, 
+     &                  RTHETA => RTHEXT_A, RPHI => RPHI_A,
+     &                  THETAR => THETAR_A, PHIR => PHIR_A
+      USE EXTREM_MOD
+      USE FIXSCAN_A_MOD, N_FIXED => N_FIXED_A, N_SCAN => N_SCAN_A,
+     &                   IPH_1 => IPH_1_A, FIX0 => FIX0_A, 
+     &                   FIX1 => FIX1_A, SCAN0 => SCAN0_A, 
+     &                   SCAN1 => SCAN1_A
+      USE INFILES_MOD
+      USE INUNITS_MOD
+      USE INIT_J_MOD
+      USE INIT_L_MOD
+      USE INIT_M_MOD
+      USE LIMAMA_MOD
+      USE MOYEN_A_MOD, IMOY => IMOY_A, NDIR => NDIR_A,
+     &                 ACCEPT => ACCEPT_A, ICHKDIR => ICHKDIR_A
+      USE OUTFILES_MOD
+      USE OUTUNITS_MOD
+      USE PARCAL_A_MOD, NPHI => NPHI_A, NE => NE_A, 
+     &                  NTHETA => NTHETA_A, NFTHET => NFTHET_A
+      USE RESEAU_MOD
+      USE SPIN_MOD
+      USE TESTPB_MOD
+      USE TESTS_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
+     &                LMAX => LMAX_A
+      USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
+     &                  IFTHET => IFTHET_A, IMOD => IMOD_A,
+     &                  I_CP => I_CP_A, I_EXT => I_EXT_A,
+     &                  I_TEST => I_TEST_A
+      USE TYPEM_MOD
+      USE TYPEXP_MOD
+      USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
+     &                 PHI1 => PHI1_A, THETA1 => THETA1_A
+      USE VALIN_MOD, P0 => PHI0, T0 => THETA0, TM => THLUM, 
+     &               PM => PHILUM, EM => ELUM
+C
+      COMPLEX IC,ONEC,ZEROC,PW(0:NDIF_M)
+      COMPLEX TLT(0:NT_M,4,NATM,NE_M),RHOMI
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLMR(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLME(0:NL_M,-NL_M:NL_M)
+      COMPLEX R2,M_COUL(0:NL_M,-NL_M:NL_M,2,-LI_M:LI_M,2)
+      COMPLEX SJDIR_1,SJDIF_1
+      COMPLEX RHOK(0:NT_M,NATM,0:40,2,NSPIN2_M),COU
+      COMPLEX SLJDIF,ATT_M,SLE_1
+      COMPLEX SL0DIF,SMJDIF
+C
+      DIMENSION VAL(NATCLU_M),NATYP(NATM)
+      DIMENSION EMET(3),COORD(3,NATCLU_M)
+      DIMENSION R(NDIF_M),XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),JPA(NDIF_M)
+C
+      CHARACTER*7 STAT
+      CHARACTER*24 INFILE
+      CHARACTER*24 OUTFILE
+C
+      DATA PIS180 /0.017453/
+      DATA EV,SMALL /13.60583,0.0001/
+      DATA BOHR /0.529177/
+C
+      ALGO1='  '
+      ALGO2='MI'
+      ALGO3='  '
+      ALGO4='  '
+C
+      IC=(0.,1.)
+      ONEC=(1.,0.)
+      ZEROC=(0.,0.)
+      NSCAT=NATCLU-1
+      ATTSE=1.
+      ATTSJ=1.
+      ZSURF=VAL(1)
+C
+      I_DIR=0
+      NSET=1
+      JEL=2
+C
+      IF(SPECTRO.EQ.'AED') THEN
+        IOUT=IUO2
+        OUTFILE=OUTFILE2
+        STAT='UNKNOWN'
+        IF(ABS(I_EXT).GE.1) THEN
+          ISET=IUI6
+          INFILE=INFILE6
+        ENDIF
+      ELSEIF(SPECTRO.EQ.'APC') THEN
+        IOUT=IUSCR2
+        OUTFILE='res/auger.amp'
+        STAT='UNKNOWN'
+        IF(ABS(I_EXT).GE.1) THEN
+          ISET=IUI9
+          INFILE=INFILE9
+        ENDIF
+      ENDIF
+C
+      LF1=LE_MIN
+      LF2=LE_MAX
+      ISTEP_LF=2
+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
+        WRITE(IOUT,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
+     1                IPH_1,I_EXT
+      ENDIF
+C
+      IF(ISOM.EQ.0) THEN
+        WRITE(IOUT,79) NPLAN,NEMET,NTHETA,NPHI,NE
+      ELSEIF((ISOM.NE.0).AND.(JFICH.EQ.1)) THEN
+        WRITE(IOUT,11) NTHETA,NPHI,NE
+      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
+C   Loop over the different absorbers in a given plane
+C
+       DO JEMET=1,NEMET
+        CALL EMETT(JEMET,IEMET,Z,SYM_AT,NATYP,EMET,NTYPEM,
+     1             JNEM,*4)
+        GO TO 2                                                          
+   4    IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN          
+          IF(I_TEST.NE.2) WRITE(IUO1,51) JPLAN,NTYPEM                                        
+        ENDIF                                                             
+        GO TO 3  
+   2    IF((ABS(EMET(3)).GT.COUPUR).AND.(IBAS.EQ.1)) GOTO 5                 
+        IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN          
+          IF(I_TEST.NE.2) THEN 
+            WRITE(IUO1,52) JPLAN,EMET(1),EMET(2),EMET(3),NTYPEM  
+          ENDIF               
+        ENDIF
+        IF(ISOM.EQ.1) NP=JPLAN 
+        ZSURFE=VAL(1)-EMET(3) 
+        JTE=IEMET(JEMET)     
+        JATLEM=JNEM                   
+C
+C   Loop over the energies
+C     
+        DO JE=1,NE
+         FMIN(0)=1.
+         FMAX(0)=1.
+         IF(I_TEST.NE.1) THEN                      
+CST           VKR=REAL(VK(JE))
+           VKR=ABS(VK(JE))
+         ELSE
+           VKR=1.
+         ENDIF
+CST         ECIN=VKR*VKR*BOHR*BOHR*EV/(A*A)+VINT
+         ECIN=E0_A/(A*A)+VINT
+         IF(I_TEST.NE.1) THEN                      
+           CFM=2.*VKR
+         ELSE
+           CFM=1.
+         ENDIF
+         CALL LPM(ECIN,XLPM,*6)                                           
+         XLPM1=XLPM/A                                                      
+         GAMMA=1./(2.*XLPM1)                                               
+         IF(IPOTC.EQ.0) THEN
+           VK(JE)=VK(JE)+IC*GAMMA
+         ENDIF
+         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((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_A(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=ISET, FILE=INFILE, STATUS='OLD')
+           READ(ISET,13) I_DIR,NSET,N_DUM1
+           READ(ISET,14) I_DUM1,N_DUM2,N_DUM3
+         ENDIF
+C
+C   Initialization of TAU(INDJ,LINFMAX,JTYP)
+C
+         JATL=0
+         DO JTYP=1,N_PROT
+           NBTYP=NATYP(JTYP)
+           LMJ=LMAX(JTYP,JE)
+           DO JNUM=1,NBTYP
+             JATL=JATL+1
+             DO LE=LE_MIN,LE_MAX,2
+               ILE=LE*LE+LE+1
+               DO ME=-LE,LE
+                 INDE=ILE+ME
+                 DO LJ=0,LMJ
+                   ILJ=LJ*LJ+LJ+1
+                   DO MJ=-LJ,LJ 
+                     INDJ=ILJ+MJ
+                     TAU(INDJ,INDE,JATL)=ZEROC
+                   ENDDO
+                 ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+         ENDDO
+C
+C   Storage of the coupling matrix elements M_COUL 
+C
+         DO MC=-LI,LI
+           DO ISC=1,2
+             SC=FLOAT(ISC)-1.5
+             DO LA=LE_MIN,LE_MAX,2
+               DO MA=-LA,LA
+                 DO ISA=1,2
+                   SA=FLOAT(ISA)-1.5
+                   CALL COUMAT_AM(LA,MA,SA,MC,SC,JTE,RHOK,COU)
+                   M_COUL(LA,MA,ISA,MC,ISC)=COU
+                 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_A(JE,TAU)
+ 666    CONTINUE
+C
+C    Calculation of the Auger Electron Diffraction 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(ISET,86) JSET,JLINE,THD,PHD
+            IF(I_EXT.EQ.-1) BACKSPACE ISET
+          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
+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(ISET,86) JSET,JLINE,THD,PHD
+             BACKSPACE ISET
+           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
+           SSETDIR_1=0.
+           SSETDIF_1=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(ISET,86) JSET,JLINE,THD,PHD,W
+             DTHETA=THD
+             DPHI=PHD
+             RTHETA=DTHETA*PIS180
+             RPHI=DPHI*PIS180
+           ELSE
+             W=1.
+           ENDIF
+C
+           IF(I_EXT.EQ.-1) PRINT 89
+C                                    
+           CALL DIRAN(VINT,ECIN,JEL)
+           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
+           WRITE(IUO1,61) (DIRANA(J,1),J=1,3)
+C
+           SRDIF_1=0.
+           SRDIR_1=0.
+C
+C    Loop over the different directions of the analyzer contained in a cone
+C
+          DO JDIR=1,NDIR
+            IF(IATTS.EQ.1) THEN
+              ATTSE=EXP(-ZSURFE*GAMMA/DIRANA(3,JDIR))
+            ENDIF
+C
+            SSCDIR_1=0.
+            SSCDIF_1=0.
+C
+C    Loop over the equiprobable quantum numbers MC,SC and SA 
+C         corresponding respectively to the core hole (MC and spin SC)
+C         and to the outgoing Auger electron (SA). The sum over the 
+C         equiprobable azimuthal quantum number MJ of the multiplet 
+C         configuration is suppressed here as, because of the selection 
+C         rules, one has MJ = MA + MC + SA + SC
+C
+            LME=LMAX(1,JE)
+            CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLME,LME)
+C
+            DO ISC=1,2
+             SC=FLOAT(ISC)-1.5
+C
+             SMCDIR_1=0.
+             SMCDIF_1=0.
+C
+             DO MC=-LI,LI
+C
+              SSADIR_1=0.
+              SSADIF_1=0.
+C
+              DO ISA=1,2
+               SA=FLOAT(ISA)-1.5
+C
+                SMJMDIR_1=0.
+                SMJMDIF_1=0.
+C
+                DO MJM=-J_MUL,J_MUL
+C
+                 SJDIR_1=ZEROC
+                 SJDIF_1=ZEROC
+C
+C    Calculation of the direct emission (used a a reference for the output)
+C
+                 DO L_E=LE_MIN,LE_MAX,2
+                  ILE=L_E*L_E+L_E+1
+                  IF(ISPEED.EQ.1) THEN
+                    R2=TL(L_E,1,1,JE)
+                  ELSE
+                    R2=TLT(L_E,1,1,JE)
+                  ENDIF
+                  M_E=MJM-MC-ISA-ISC+3
+                  IF(ABS(M_E).GT.L_E) GOTO 444
+                  INDE=ILE+M_E
+                  SJDIR_1=SJDIR_1+YLME(L_E,M_E)*ATTSE*
+     1                            M_COUL(L_E,M_E,ISA,MC,ISC)*R2
+C                  
+C    Contribution of the absorber to TAU (initialization of SJDIF)
+C
+                  IF(I_TEST.EQ.2) GOTO 444
+                  SL0DIF=ZEROC
+                  DO L0=0,LME
+                    IL0=L0*L0+L0+1
+                    SL0DIF=SL0DIF+YLME(L0,0)*TAU(IL0,INDE,1)
+                    DO M0=1,L0
+                     IND01=IL0+M0
+                     IND02=IL0-M0
+                     SL0DIF=SL0DIF+(YLME(L0,M0)*
+     1                              TAU(IND01,INDE,1)+
+     2                              YLME(L0,-M0)*
+     3                              TAU(IND02,INDE,1))
+                    ENDDO
+                  ENDDO
+
+                  SJDIF_1=SJDIF_1+SL0DIF*M_COUL(L_E,M_E,ISA,MC,ISC)
+ 444              CONTINUE
+                 ENDDO
+                 SJDIF_1=SJDIF_1*ATTSE
+C
+C    Loop over the last atom J encountered by the photoelectron 
+C                  before escaping the solid
+C
+                 IF(I_TEST.EQ.2) GOTO 111
+                 DO JTYP=2,N_PROT
+                  NBTYP=NATYP(JTYP)
+                  LMJ=LMAX(JTYP,JE)
+                  DO JNUM=1,NBTYP
+                   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)
+                   CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLMR,
+     1                         LMJ)
+                   IF(IATTS.EQ.1) THEN
+                     ATTSJ=EXP(-ZSURFJ*GAMMA/DIRANA(3,JDIR))
+                   ENDIF
+                   CSTHJR=(XOJ*DIRANA(1,JDIR)+YOJ*DIRANA(2,JDIR)+
+     1                     ZOJ*DIRANA(3,JDIR))/ROJ
+                   IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 78
+                   CTROIS1=ZOJ/ROJ
+                   IF(CTROIS1.GT.1.)  THEN
+                     CTROIS1=1.
+                   ELSEIF(CTROIS1.LT.-1.) THEN
+                     CTROIS1=-1.
+                   ENDIF
+                   IF(IDCM.GE.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)*
+     1                        (DIRANA(3,JDIR)-CTROIS1)/(2.
+     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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                   ENDIF
+ 78                IF(IDWSPH.EQ.1) THEN
+                     DWTER=1.
+                   ELSE
+                     DWTER=EXP(-VK2(JE)*UJJ*(1.-CSTHJR))
+                   ENDIF
+                   IF(JATL.EQ.JATLEM) THEN
+                     ATT_M=ATTSE*DWTER
+                   ELSE
+                     ATT_M=ATTSJ*DWTER*CEXP(-IC*VK(JE)*ROJ*CSTHJR)
+                   ENDIF
+C
+                   SLE_1=ZEROC
+                   DO L_E=LE_MIN,LE_MAX,2
+                     ILE=L_E*L_E+L_E+1
+                     M_E=MJM-MC-ISA-ISC+3
+                     IF(ABS(M_E).GT.L_E) GOTO 555
+                     INDE=ILE+M_E
+                     SLJDIF=ZEROC
+                     DO LJ=0,LMJ
+                       ILJ=LJ*LJ+LJ+1
+                       SMJDIF=YLMR(LJ,0)*TAU(ILJ,INDE,JATL)
+                       IF(LJ.GT.0) THEN
+                         DO MJ=1,LJ
+                           INDJ1=ILJ+MJ
+                           INDJ2=ILJ-MJ
+                           SMJDIF=SMJDIF+(YLMR(LJ,MJ)*
+     1                                    TAU(INDJ1,INDE,JATL)+
+     2                                    YLMR(LJ,-MJ)*
+     3                                    TAU(INDJ2,INDE,JATL))
+                         ENDDO
+                       ENDIF  
+                       SLJDIF=SLJDIF+SMJDIF
+                     ENDDO
+                     SLE_1=SLE_1+SLJDIF*M_COUL(L_E,M_E,ISA,MC,ISC)
+  555                CONTINUE
+                   ENDDO
+                   SJDIF_1=SJDIF_1+SLE_1*ATT_M
+C
+C     End of the loops over the last atom J 
+C
+                  ENDDO
+                 ENDDO
+C
+C     Writing the amplitudes in file IOUT for APECS
+C
+ 111             IF(SPECTRO.EQ.'APC') THEN
+                   IF(I_TEST.EQ.2) SJDIF_1=SJDIR_1
+                   WRITE(IOUT,87) JFICH,JPLAN,JEMET,JE,J_FIXED,J_SCAN,
+     1                            JDIR,ISC,MC,ISA,MJM,SJDIR_1,SJDIF_1
+                 ELSE
+C
+C     Computing the square modulus
+C
+                   SSADIF_1=SSADIF_1+CABS(SJDIF_1)*CABS(SJDIF_1)
+                   SSADIR_1=SSADIR_1+CABS(SJDIR_1)*CABS(SJDIR_1)
+C
+                 ENDIF
+C
+C     End of the loop over MJM
+C
+                ENDDO
+C
+                SMJMDIF_1=SMJMDIF_1+SSADIF_1           
+                SMJMDIR_1=SMJMDIR_1+SSADIR_1           
+C
+C     End of the loop over SA
+C
+              ENDDO
+C
+              SMCDIF_1=SMCDIF_1+SMJMDIF_1           
+              SMCDIR_1=SMCDIR_1+SMJMDIR_1           
+C
+C     End of the loop over MC
+C
+             ENDDO
+C
+             SSCDIF_1=SSCDIF_1+SMCDIF_1           
+             SSCDIR_1=SSCDIR_1+SMCDIR_1           
+C
+C     End of the loop over SC
+C
+            ENDDO
+C
+            IF(SPECTRO.EQ.'APC') GOTO 220
+            SRDIR_1=SRDIR_1+SSCDIR_1*VKR*CFM/NDIR
+            SRDIF_1=SRDIF_1+SSCDIF_1*VKR*CFM/NDIR
+ 220        CONTINUE
+C
+C     End of the loop on the directions of the analyzer
+C
+           ENDDO
+C
+            IF(SPECTRO.EQ.'APC') GOTO 221
+            SSETDIR_1=SSETDIR_1+SRDIR_1*W
+            SSETDIF_1=SSETDIF_1+SRDIF_1*W
+            IF(ICHKDIR.EQ.2) THEN
+              IF(JSET.EQ.JREF) THEN
+                SSET2DIR_1=SRDIR_1
+                SSET2DIF_1=SRDIF_1
+              ENDIF
+            ENDIF
+ 221        CONTINUE
+C
+C     End of the loop on the set averaging 
+C
+           ENDDO
+C
+            IF(SPECTRO.EQ.'APC') GOTO 222
+            IF(ISOM.EQ.2) THEN
+              WRITE(IOUT,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
+     1                       SSETDIR_1,SSETDIF_1
+              IF(ICHKDIR.EQ.2) THEN
+               WRITE(IUO2,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
+     1                        SSET2DIR_1,SSET2DIF_1 
+              ENDIF
+            ELSE
+              WRITE(IOUT,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
+     1                       SSETDIR_1,SSETDIF_1 
+              IF(ICHKDIR.EQ.2) THEN
+               WRITE(IUO2,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
+     1                        SSET2DIR_1,SSET2DIF_1 
+              ENDIF
+            ENDIF
+ 222        CONTINUE
+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(ISET)
+        ENDDO
+C
+   3    CONTINUE
+C
+C     End of the loop on the emitters
+C
+       ENDDO
+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(ISET)
+      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_AED(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)
+  13  FORMAT(6X,I1,1X,I3,2X,I4)
+  14  FORMAT(6X,I1,1X,I3,3X,I3)
+  22  FORMAT(16X,'INTERNAL CALCULATION OF MEAN SQUARE DISPLACEMENTS',/,
+     1       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 ',
+     1'THE ABSORBER : (',F6.3,',',F6.3,',',F6.3,') *******',/,2X,
+     2'******* ',19X,'THIS ABSORBER IS OF TYPE ',I2,20X,' *******')          
+  53  FORMAT(//,2X,'ORDER ',I2,'  TOTAL NUMBER OF PATHS     : ',F15.1,
+     1             /,10X,'  EFFECTIVE NUMBER OF PATHS : ',F15.1,
+     2             /,10X,'  MINIMAL INTENSITY         : ',E12.6,
+     3             2X,'No OF THE PATH : ',F15.1,                         
+     4             /,10X,'  MAXIMAL INTENSITY         : ',E12.6,
+     5             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,
+     1             /,10X,'  EFFECTIVE NUMBER OF PATHS : ',I10,                
+     2             /,10X,'  MINIMAL INTENSITY         : ',E12.6,
+     3             2X,'No OF THE PATH : ',I10,                         
+     4             /,10X,'  MAXIMAL INTENSITY         : ',E12.6,             
+     5             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')                                                  
+  61  FORMAT(///,4X,'..........  DIRECTION OF THE DETECTOR      : (',
+     1      F6.3,',',F6.3,',',F6.3,')  ..........')                                       
+  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,
+     1       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,
+     1       'INTENSITY',3X,'LENGTH',4X,'ABSORBER',2X,
+     2       'ORDER OF THE SCATTERERS',/)
+  74  FORMAT(10X,'<===== NUMBER OF PATHS TOO LARGE FOR PRINTING ',
+     1       '=====>')
+  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,
+     1       'INTENSITY',3X,'LENGTH',4X,'ABS',3X,
+     2       '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',
+     1      ' ORDER :',/,24X,'(THE LENGTH IS GIVEN IN UNITS ',
+     2      'OF A)')
+  85  FORMAT(/////,25X,' PATHS USED IN THE CALCULATION : ',
+     1       /,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,I2,2X,I2,2X,I2,
+     1       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 =', 
+     1         F6.2) 
+  89  FORMAT(/,4X,'..........................................',
+     1         '.....................................')    
+C
+   7  RETURN
+C
+      END

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/axb_mat_ms_la_a.f

@@ -0,0 +1,198 @@
+C
+C=======================================================================
+C
+      SUBROUTINE INV_MAT_MS_A(JE,TAU)
+C
+C   This subroutine stores the multiple scattering matrix and computes 
+C     the scattering path operator TAU^{j 0} exactly, without explicitely 
+C     using the inverse matrix.
+C
+C                           (Auger electron case)
+C
+C                                         Last modified : 31 Jul 2007
+C
+      USE DIM_MOD
+C
+      USE COOR_MOD
+      USE INIT_L_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, VK2 =>
+     &                VK2_A, IPOTC => IPOTC_A, ITL => ITL_A, 
+     &                LMAX => LMAX_A
+C
+C      PARAMETER(NLTWO=2*NL_M)
+C
+      COMPLEX*16 HL1(0:2*NL_M),SM(LINMAXA*NATCLU_M,LINMAXA*NATCLU_M)
+      COMPLEX*16 IN(LINMAXA*NATCLU_M,LINMAXA)
+      COMPLEX*16 SUM_L,ONEC,IC,ZEROC
+      COMPLEX*16 YLM(0:2*NL_M,-2*NL_M:2*NL_M),TLJ,TLK,EXPKJ
+C
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+C
+      REAL*8 PI,ATTKJ,GNT(0:N_GAUNT),XKJ,YKJ,ZKJ,RKJ,ZDKJ,KRKJ
+C
+      INTEGER IPIV(LINMAXA*NATCLU_M)
+C
+      CHARACTER*1 CH
+C
+      DATA PI /3.1415926535898D0/
+C
+      ONEC=(1.D0,0.D0)
+      IC=(0.D0,1.D0)
+      ZEROC=(0.D0,0.D0)
+      IBESS=3
+      CH='N'
+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)*
+     1                                   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
+                         IF(JTYP.EQ.1) THEN
+                            IN(KLIN,JLIN)=ONEC
+                         ENDIF
+                      ELSE
+                         SM(KLIN,JLIN)=-TLK*SUM_L
+                         IF(JTYP.EQ.1) THEN
+                            IN(KLIN,JLIN)=ZEROC
+                         ENDIF
+                      ENDIF
+C
+                    ENDDO
+                  ENDDO
+C
+                ENDDO
+              ENDDO
+C
+            ENDDO
+          ENDDO
+C
+        ENDDO
+      ENDDO
+C
+      LW2=(LMAX(1,JE)+1)*(LMAX(1,JE)+1)
+C
+C   Partial inversion of the multiple scattering matrix MS and 
+C     multiplication by T : the LAPACK subroutine performing 
+C
+C                          A * x = b
+C
+C     is used where b is the block column corresponding to 
+C     the absorber 0 in the identity matrix. x is then TAU^{j 0}.
+C
+      CALL ZGETRF(JLIN,JLIN,SM,LINMAXA*NATCLU_M,IPIV,INFO1)
+      IF(INFO1.NE.0) THEN
+         WRITE(6,*) '     --->  INFO1 =',INFO1
+      ELSE
+        CALL ZGETRS(CH,JLIN,LW2,SM,LINMAXA*NATCLU_M,IPIV,
+     1              IN,LINMAXA*NATCLU_M,INFO)
+      ENDIF
+C
+C   Storage of the Tau matrix
+C
+      JLIN=0
+      DO JTYP=1,N_PROT
+        NBTYPJ=NATYP(JTYP)
+        LMJ=LMAX(JTYP,JE) 
+        DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+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)
+C
+                  DO LK=0,LMK
+                    ILK=LK*LK+LK+1
+                    DO MK=-LK,LK
+                      INDK=ILK+MK
+                      KLIN=KLIN+1
+                      IF((JATL.EQ.1).AND.(LJ.LE.LF2)) THEN
+                        TAU(INDK,INDJ,KATL)=CMPLX(IN(KLIN,JLIN)*TLJ)
+                      ENDIF
+                    ENDDO
+                  ENDDO
+C
+                ENDDO
+              ENDDO
+C
+            ENDDO
+          ENDDO
+C
+        ENDDO
+      ENDDO
+C
+      RETURN
+C
+      END
+

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/coumat_am.f

@@ -0,0 +1,140 @@
+C
+C=======================================================================
+C
+      SUBROUTINE COUMAT_AM(LA,MA,SA,MC,SC,JE,RHOK_A,MATRIX_AM)
+C
+C  This routine calculates the multiplet-resolved spin-independent
+C   Coulomb matrix elements occuring in the Auger process. They 
+C   are stored in MATRIX_AM. The multiplet component is characterized 
+C   by the quantum numbers (L,S,J) which are read from the input 
+C   data file.
+C
+C  Here, the conventions are (direct process D):
+C
+C        (LC,MC)  : core hole filled by intermediate electron 
+C        (L1,M1)  : Auger electron before excitation
+C        (L2,M2)  : intermediate electron that fills the core hole
+C        (LA,MA)  : Auger electron after excitation
+C
+C  In the exchange process E, the roles of (L1,M1) and (L2,M2) 
+C    are interchanged.
+C
+C  Note that the Clebsch-Gordan corresponding to the spin-orbit 
+C    resolved core state is not included in the formula here. This 
+C    is because in APECS, it appears also in the dipole matrix 
+C    element and it is therefore useless to calculate it twice.
+C    Therefore, it must be implemented into the cross-section 
+C    subroutine.
+C
+C  The factor i**LA comes from the particular normalization used 
+C    in the phagen code
+C
+C                                        Last modified :  8 Dec 2008
+C
+      USE DIM_MOD
+C
+      USE C_G_M_MOD
+      USE INIT_A_MOD, LC => LI_C, L2 => LI_I, L1 => LI_A
+      USE TYPCAL_A_MOD, I1 => IPHI_A, I2 => IE_A, I3 => ITHETA_A,
+     1                  I4 => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A,
+     2                  I7 => I_EXT_A, I_TEST => I_TEST_A
+      USE INIT_M_MOD
+C
+      COMPLEX RHOK_A(0:NT_M,NATM,0:40,2,NSPIN2_M)
+      COMPLEX ZEROC,ONEC,MATRIX_AM
+      COMPLEX SUM_LB,SUM_M1,IC,IL
+C
+      REAL*4 CG1(0:N_GAUNT),CG2(0:N_GAUNT)
+      REAL*4 GNT1(0:N_GAUNT),GNT2(0:N_GAUNT),GNT3(0:N_GAUNT)
+      REAL*4 GNT4(0:N_GAUNT)
+C
+      REAL*8 ZEROD
+C
+      DATA PI4,ONEOSQ2,HALF /12.566371,0.707107,0.5/
+C
+      ZEROC=(0.,0.)
+      ONEC=(1.,0.)
+      IC=(0.,1.)
+      ZEROD=0.D0
+C
+      IF(I_TEST.EQ.1) GOTO 2
+C
+      IF(MOD(LA,4).EQ.0) THEN
+        IL=ONEC
+      ELSEIF(MOD(LA,4).EQ.1) THEN
+        IL=IC
+      ELSEIF(MOD(LA,4).EQ.2) THEN
+        IL=-ONEC
+      ELSEIF(MOD(LA,4).EQ.3) THEN
+        IL=-IC
+      ENDIF
+C
+      IF(I_SHELL.EQ.0) THEN
+        COEF1=ONEOSQ2*PI4
+      ELSEIF(I_SHELL.EQ.1) THEN
+        COEF1=HALF*PI4
+      ENDIF
+C
+      IF(MOD(S_MUL,2).EQ.0) THEN
+        SIGN1=1.
+      ELSE
+        SIGN1=-1.
+      ENDIF
+C
+C   Values of MJ, ML and MS given by the Clebsch-Gordan
+C
+      ML=MA+MC
+      MS=INT(SA+SC+0.0001)
+      MJ=ML+MS
+C
+C  Storage indices for the spin Clebsch-Gordan :
+C
+C               ISA(C) = 1 for -1/2 and 2 for 1/2
+C               IS = 1 for S_MUL=0 and 2 for S_MUL=1
+C
+      IS=S_MUL+1
+      ISA=INT(SA+1.5001)
+      ISC=INT(SC+1.5001)
+C
+C  Bounds of the sum over LB
+C
+      LB_MAX_D=MIN(L1+LA,L2+LC)
+      LB_MIN_D=MAX(ABS(L1-LA),ABS(L2-LC))
+      LB_MAX_E=MIN(L2+LA,L1+LC)
+      LB_MIN_E=MAX(ABS(L2-LA),ABS(L1-LC))
+      LB_MIN=MIN(LB_MIN_D,LB_MIN_E)
+      LB_MAX=MAX(LB_MAX_D,LB_MAX_E)
+C
+      N_CG=2
+      CALL N_J(DFLOAT(L_MUL),DFLOAT(ML),DFLOAT(S_MUL),DFLOAT(MS),
+     1         ZEROD,CG1,I_INT1,N_CG)
+C
+      SUM_M1=ZEROC
+      DO M1=-L1,L1
+        M2=ML-M1
+C
+        CALL N_J(DFLOAT(L1),DFLOAT(M1),DFLOAT(L2),DFLOAT(ML-M1),
+     1           ZEROD,CG2,I_INT2,N_CG)
+        CALL GAUNT(L1,M1,LA,MA,GNT1)      
+        CALL GAUNT(LC,MC,L2,M2,GNT2)      
+        CALL GAUNT(L2,M2,LA,MA,GNT3)      
+        CALL GAUNT(LC,MC,L1,M1,GNT4)
+C      
+        SUM_LB=ZEROC
+        DO LB=LB_MIN,LB_MAX
+          SUM_LB=SUM_LB+(RHOK_A(LA,JE,LB,1,1)*GNT1(LB)*GNT2(LB)+
+     1                   RHOK_A(LA,JE,LB,2,1)*GNT3(LB)*GNT4(LB)*
+     2                   SIGN1)/FLOAT(LB+LB+1)
+        ENDDO
+        SUM_M1=SUM_M1+SUM_LB*CG2(L_MUL)
+      ENDDO
+C
+      MATRIX_AM=SUM_M1*CG1(J_MUL)*CG_S(ISA,ISC,IS)*COEF1*IL
+C
+      GOTO 1
+C
+   2  MATRIX_AM=ONEC
+C
+   1  RETURN                             
+C
+      END

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/dwsph_a.f

@@ -1,7 +1,7 @@
 C
 C=======================================================================
 C
-      SUBROUTINE DWSPH(JTYP,JE,X,TLT,ISPEED)
+      SUBROUTINE DWSPH_A(JTYP,JE,X,TLT,ISPEED)
 C
 C  This routine recomputes the T-matrix elements taking into account the
 C                mean square displacements.
@@ -12,7 +12,9 @@ C                                      Last modified : 25 Apr 2013
 C
       USE DIM_MOD
 C
-      USE TRANS_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, VK2 =>
+     &                VK2_A, IPOTC => IPOTC_A, ITL => ITL_A, 
+     &                LMAX => LMAX_A
 C
       DIMENSION GNT(0:N_GAUNT)
 C
@@ -83,3 +85,4 @@ C
       RETURN
 C
       END
+ 

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/facdif1_a.f

@@ -1,19 +1,23 @@
 C
 C=======================================================================
 C
-      SUBROUTINE FACDIF1(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,FSPH,JAT,J
+      SUBROUTINE FACDIF1_A(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,
-     &E,*)
+     1                     FSPH,JAT,JE,*)
 C
 C  This routine computes a spherical wave scattering factor
 C
 C                                            Last modified : 03/04/2006
 C
       USE DIM_MOD
+C
       USE APPROX_MOD
       USE EXPFAC_MOD
-      USE TRANS_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, 
-      USE TYPCAL_MOD , I2 => IPHI, I3 => IE, I4 => ITHETA, I5 => IMOD, I
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A, 
-     &6 => IPOL, I7 => I_CP, I8 => I_EXT, I9 => I_TEST
+     &                LMAX => LMAX_A
+      USE TYPCAL_A_MOD, I2 => IPHI_A, I3 => IE_A, I4 => ITHETA_A, 
+     &                  IFTHET => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A, 
+     &                  I7 => I_EXT_A, I8 => I_TEST_A
 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)
@@ -21,7 +25,6 @@ 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
@@ -59,7 +62,6 @@ C
         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.)

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/facdif_a.f

@@ -0,0 +1,28 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF_A(COSTH,JAT,JE,FTHETA)
+C
+C  This routine computes the plane wave scattering factor
+C
+      USE DIM_MOD
+C
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
+     &                LMAX => LMAX_A
+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/aed_mi_mu_noso_nosp_nosym/main.f

@@ -15,7 +15,7 @@ CF2PY   INTEGER, INTENT(IN,COPY) :: N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_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 MAIN_AED_MU_MI()
         CALL CLOSE_ALL_FILES()
 
       END SUBROUTINE RUN

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/main_aed_mu_mi.f

@@ -4,8 +4,8 @@ C           ************************************************************
 C           * ******************************************************** *
 C           * *                                                      * *
 C           * *         MULTIPLE-SCATTERING SPIN-INDEPENDENT         * *
-C           * *            PHOTOELECTRON DIFFRACTION CODE            * *
+C           * *           AUGER ELECTRON DIFFRACTION CODE            * *
-C           * *            BASED ON CORRELATION EXPANSION            * *
+C           * *                USING MATRIX INVERSION                * *
 C           * *                                                      * *
 C           * ******************************************************** *
 C           ************************************************************
@@ -43,6 +43,14 @@ C
 C                * AEDDIF    : computes the Auger electron diffraction
 C                              formula 
 C
+C                * FINDPATHS : generates the multiple scattering 
+C                              paths the electron will follow
+C
+C                * PATHOP    : calculates the contribution of a given
+C                              path to the scattering path operator
+C
+C                * MATDIF    : computes the Rehr-Albers scattering
+C                              matrices
 C
 C     A subroutine called NAME_A is the Auger equivalent of subroutine 
 C     NAME. The essentail difference between NAME and NAME_A is that 
@@ -69,12 +77,13 @@ C  Last modified : 10 Jan 2016
 C
 C=======================================================================
 C
-      SUBROUTINE MAIN_PHD_NS_CE()
+      SUBROUTINE MAIN_AED_MU_MI()
 C
 C  This routine reads the various input files and calls the subroutine
 C               performing the requested calculation
 C
       USE DIM_MOD
+C
       USE ADSORB_MOD
       USE APPROX_MOD
       USE ATOMS_MOD
@@ -122,45 +131,38 @@ C
       DIMENSION IBWD_TMP(NATP_M),RTHFWD_TMP(NATP_M),RTHBWD_TMP(NATP_M)
       DIMENSION UJ2_TMP(NATM),RHOT_TMP(NATM),XMT_TMP(NATM)
 C
-      COMPLEX TLSTAR
+      COMPLEX TLSTAR,RHOR(NE_M,NATM,0:18,2,NSPIN2_M)
-      COMPLEX RHOR(NE_M,NATM,0:18,5,NSPIN2_M)
       COMPLEX TLSTAR_A
       COMPLEX RHOR_A(0:NT_M,NATM,0:40,2,NSPIN2_M),RAD_D,RAD_E
-      COMPLEX RHOR1STAR,RHOR2STAR,RHOR3STAR,RHOR4STAR,RHOR5STAR
+      COMPLEX RHOR1STAR,RHOR2STAR
 C
       INTEGER INV(2)
 C
       CHARACTER RIEN
       CHARACTER*1 B
       CHARACTER*2 R
-C
-C
-C
-C
-C
-C
       CHARACTER*30 TUNIT,DUMMY
 C
       DATA PI,BOHR,SMALL/3.141593,0.529177,0.001/
-      DATA INV /0,0/
+      DATA INV /1,0/
 C
       LE_MAX=0
 C
-C!      READ(*,776) NFICHLEC
+CST   READ(*,776) NFICHLEC
-C!      READ(*,776) ICOM
+CST   READ(*,776) ICOM 
-C!      DO JF=1,NFICHLEC
+CST   DO JF=1,NFICHLEC
-C!        READ(*,777) INDATA(JF)
+CST     READ(*,777) INDATA(JF)
-C!      ENDDO
+CST   ENDDO 
 C
 C..........  Loop on the data files  ..........
 C 
       NFICHLEC=1
-      ICOM = 5
+      ICOM=5 
       DO JFICH=1,NFICHLEC
-C!      OPEN(UNIT=ICOM, FILE=INDATA(JFICH), STATUS='OLD')
+CST   OPEN(UNIT=ICOM, FILE=INDATA(JFICH), STATUS='OLD')
       OPEN(UNIT=ICOM, FILE='../input/spec.dat', STATUS='OLD')
-      CALL READ_DATA(ICOM,NFICHLEC,JFICH,ITRTL,*2,*1,*55,*74,*99,*504,*5
+      CALL READ_DATA(ICOM,NFICHLEC,JFICH,ITRTL,*2,*1,*55,*74,*99,*504,
-     &20,*540,*550,*570,*580,*590,*630)
+     1               *520,*540,*550,*570,*580,*590,*630)
 C
 C..........  Atomic case index  ..........
 C
@@ -188,13 +190,13 @@ C
         N_EL=1
       ENDIF
       IF((INTERACT.EQ.'COULOMB').OR.(INTERACT.EQ.'DIPCOUL')) THEN
-        IF(I_MULT.EQ.0) THEN
+c        IF(I_MULT.EQ.0) THEN
           LE_MIN=ABS(LI_C-ABS(LI_I-LI_A))
           LE_MAX=LI_C+LI_A+LI_I
-        ELSE
+c        ELSE
-          LE_MIN=ABS(LI_C-L_MUL)
+c          LE_MIN=ABS(LI_C-L_MUL)
-          LE_MAX=LI_C+L_MUL
+c          LE_MAX=LI_C+L_MUL
-        ENDIF
+c        ENDIF
       ENDIF
 C
 C..........  Test of the dimensions against the input values  ..........
@@ -332,25 +334,12 @@ C
                  READ(IUI3,102) RIEN
               ENDDO
             ENDIF
-C
-C  Reading or regular (RHOR) and irregular (RHOI) radial integrals
-C
-C                  1-2 : dipole terms
-C                  3-5 : quadrupole terms
-C
             DO JEMET=1,NEMET
-C
               JM=IEMET(JEMET)
-              READ(IUI3,105) RHOR1STAR,RHOR2STAR,RHOR3STAR,RHOR4STAR,
+              READ(IUI3,105) RHOR1STAR,RHOR2STAR
-     1                       RHOR5STAR
               RHOR(JE,JM,NNL,1,1)=CONJG(RHOR1STAR)
               RHOR(JE,JM,NNL,2,1)=CONJG(RHOR2STAR)    
-              RHOR(JE,JM,NNL,3,1)=CONJG(RHOR3STAR)    
-              RHOR(JE,JM,NNL,4,1)=CONJG(RHOR4STAR)    
-              RHOR(JE,JM,NNL,5,1)=CONJG(RHOR5STAR)
-C    
             ENDDO
-C
   333       VK(JE)=VK(JE)*A
             VK2(JE)=CABS(VK(JE)*VK(JE))
           ENDDO
@@ -394,6 +383,9 @@ C
           READ(IRD1,530) E_MIN_A,E_MAX_A,DE_A
         ENDIF
         IF(ITL_A.EQ.1) THEN
+          READ(IRD2, *) RIEN
+          READ(IRD2, *) RIEN
+          READ(IRD2, *) RIEN
           READ(IRD2,107) LI_C2,LI_I2,LI_A2
           READ(IRD2,117) LE_MIN1,N_CHANNEL
           LE_MAX1=LE_MIN1+N_CHANNEL-1
@@ -470,7 +462,8 @@ C
                 IF(LMAX_MODE_A.EQ.0) THEN
                   READ(IRD1,9) VK_A(JE),TLSTAR
                 ELSE
-                  READ(IRD1,7) VK_A(JE),TLSTAR
+CST                  READ(IRD1,7) VK_A(JE),TLSTAR
+                  READ(IRD1,9) VK_A(JE),TLSTAR
                 ENDIF
                 TL_A(L,1,JAT,JE)=CONJG(TLSTAR)
                 VK_A(JE)=CONJG(VK_A(JE))
@@ -525,27 +518,6 @@ C
 C
       ENDIF
 C
-C..........    Checking maximum value for l_max     ..........
-C..........    and storage of Gaunt coefficients    ..........
-C
-      LM_PE=0
-      DO JAT=1,NAT2
-        DO JE=1,NE
-          LM_PE=MAX(LM_PE,LMAX(JAT,JE))
-        ENDDO
-      ENDDO
-C
-      LM_AE=0
-      DO JAT=1,NAT2_A
-        DO JE=1,NE_A
-          LM_AE=MAX(LM_AE,LMAX_A(JAT,JE))
-        ENDDO
-      ENDDO
-C
-      LM_PA=MAX(LM_PE,LM_AE)
-      CALL GAUNT_ST(LM_PA)
-      CALL COEFPQ(MAX(NAT2,NAT2_A),NDIF)
-C
 C..........  Check of the consistency of the two TL and radial ..........
 C..........           matrix elements for APECS                ..........
 C
@@ -573,13 +545,13 @@ C..........  Calculation of the scattering factor (only)  ..........
 C
       IF((IFTHET.EQ.0).AND.(IFTHET_A.EQ.0)) GO TO 8   
       IF(IFTHET.EQ.1) THEN 
-        CALL PLOTFD(A,LMAX,ITL,NL1,NAT2,NE)
+c        CALL PLOTFD(A,LMAX,ITL,NL1,NAT2,NE)
       ELSEIF(IFTHET_A.EQ.1) THEN
 c        CALL PLOTFD_A(A,LMAX_A,ITL_A,NL1_A,NAT2_A,NE_A)
       ENDIF
       WRITE(IUO1,57)                                                        
 CST      STOP
-      GO TO 999
+      GOTO 999
 C
    8  IF(IBAS.EQ.0) THEN
 C
@@ -1214,22 +1186,23 @@ C..........  the PhD, LEED, AED, EXAFS or APECS calculation  ..........
 C
  566    IF(ISPIN.EQ.0) THEN
           IF(SPECTRO.EQ.'PHD') THEN
-            CALL PHDDIF_CE(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR,
+c            CALL PHDDIF_MI(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR,
-     1                     NATCLU,NFICHLEC,JFICH,NP)
+c     1                     NATCLU,NFICHLEC,JFICH,NP)
           ELSEIF(SPECTRO.EQ.'LED') THEN
-c            CALL LEDDIF_CE(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR,
+c            CALL LEDDIF_MI(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR,
 c     1                     NATCLU,NFICHLEC,JFICH,NP)
           ELSEIF(SPECTRO.EQ.'AED') THEN
-c            CALL AEDDIF_CE(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR_A,
+            CALL AEDDIF_MI_MU(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,
-c     1                     NATCLU,NFICHLEC,JFICH,NP,LE_MIN,LE_MAX)
+     1                        RHOR_A,NATCLU,NFICHLEC,JFICH,NP,LE_MIN,
+     2                        LE_MAX)
           ELSEIF(SPECTRO.EQ.'XAS') THEN
-c            CALL XASDIF_CE(NPLAN,VAL,ZEM,IPHA,RHOR,NFICHLEC,JFICH,NP)
+c            CALL XASDIF_MI(NPLAN,VAL,ZEM,IPHA,RHOR,NFICHLEC,JFICH,NP)
           ELSEIF(SPECTRO.EQ.'APC') THEN
 c            IF(J_EL.EQ.1) THEN
-c              CALL PHDDIF_CE(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR,
+c              CALL PHDDIF_MI(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR,
 c     1                    NATCLU,NFICHLEC,JFICH,NP)
 c            ELSEIF(J_EL.EQ.2) THEN
-c              CALL AEDDIF_CE(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR_A,
+c              CALL AEDDIF_MI(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOR_A,
 c     1                    NATCLU,NFICHLEC,JFICH,NP,LE_MIN,LE_MAX)
 c            ENDIF
           ENDIF
@@ -1300,7 +1273,7 @@ C
         WRITE(IUO1,562)
       ENDIF
       IF(ISOM.EQ.0) CLOSE(IUO2)
-      IF((ISOM.EQ.0).AND.(NFICHLEC.NE.1)) CLOSE(IUO1)
+CST      IF((ISOM.EQ.0).AND.(NFICHLEC.NE.1)) CLOSE(IUO1)
 C
 C..........  End of the loop on the data files  ..........
 C
@@ -1310,7 +1283,7 @@ C
         JFF=1
         IF(ISPIN.EQ.0) THEN
           IF(SPECTRO.NE.'XAS') THEN
-            CALL TREAT_PHD(ISOM,NFICHLEC,JFF,NP)
+            CALL TREAT_AED(ISOM,NFICHLEC,JFF,NP)
           ELSE
 c            CALL TREAT_XAS(ISOM,NFICHLEC,NP)
           ENDIF   
@@ -1324,10 +1297,10 @@ c          ENDIF
         ENDIF
       ENDIF
 C
-      IF((ISOM.NE.0).OR.(NFICHLEC.EQ.1)) CLOSE(IUO1)
+CST      IF((ISOM.NE.0).OR.(NFICHLEC.EQ.1)) CLOSE(IUO1)
       IF(ISOM.NE.0) CLOSE(IUO2)
 CST      STOP
-      GO TO 999  
+      GOTO 999
 C
    1  WRITE(IUO1,60)
       STOP
@@ -1395,7 +1368,7 @@ C
    3  FORMAT(5(5X,I4))
    7  FORMAT(3X,F9.4,1X,F9.4,5X,F12.9,5X,F12.9)
 CST   9  FORMAT(3X,F9.4,1X,F9.4,5X,E12.6,5X,E12.6)
-   9  FORMAT(3X,F9.4,1X,F9.4,E18.6,5X,E18.6)
+   9  FORMAT(3X,F9.4,1X,F9.4,E18.6,E18.6)
   17  FORMAT(12X,'ATOM NUMBER ',I4,10X,'CORRESPONDING TRANSLATIONS ',
      1': (',I3,',',I3,',',I3,')')
   18  FORMAT('            ',/)                                    

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/plotfd_a.f

@@ -1,7 +1,7 @@
 C
 C=======================================================================
 C
-      SUBROUTINE PLOTFD(A,LMX,ITL,NL,NAT,NE)
+      SUBROUTINE PLOTFD_A(A,LMX,ITL,NL,NAT,NE)
 C
 C  This routine prepares the output for a plot of the scattering factor
 C
@@ -9,25 +9,25 @@ C
 C
       USE APPROX_MOD
       USE FDIF_MOD
-      USE INIT_L_MOD , L => LI, I2 => INITL, I3 => NNL, I4 => LF1, I5 =>
+      USE INIT_L_MOD, L => LI, I2 => INITL, I3 => NNL, I4 => LF1,
-     & LF2, I10 => ISTEP_LF
+     &                I5 => LF2, I10 => ISTEP_LF
       USE INIT_J_MOD
       USE OUTFILES_MOD
-      USE OUTUNITS_MOD
+      USE PARCAL_A_MOD, N3 => NPHI_A, N4 => NE_A, N5 => NTHETA_A,
-      USE PARCAL_MOD , N3 => NPHI, N4 => NE, N5 => NTHETA, N6 => NEPS
+     &                  NFTHET => NFTHET_A
-      USE TYPCAL_MOD , I7 => IFTHET, I8 => IMOD, I9 => IPOL, I12 => I_CP
+      USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
-     &, I13 => I_EXT, I14 => I_TEST
+     &                  IFTHET => IFTHET_A, IMOD => IMOD_A, 
-      USE VALIN_MOD , U1 => THLUM, U2 => PHILUM, U3 => ELUM, N7 => NONVO
+     &                  I_CP => I_CP_A, I_EXT => I_EXT_A,
-     &L
+     &                  I_TEST => I_TEST_A
-      USE VALFIN_MOD
+      USE VALIN_MOD, PHI00 => PHI0, THETA00 => THETA0, U1 => THLUM,
-C
+     &               U2 => PHILUM, U3 => ELUM, N7 => NONVOL
-C
+      USE VALFIN_MOD, PHI11 => PHI1, THETA11 => THETA1
+      USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A, 
+     &                 PHI1 => PHI1_A, THETA1 => THETA1_A
 C 
       DIMENSION LMX(NATM,NE_M)
 C
       COMPLEX FSPH,VKE
-C
-C
 C
       DATA PI,CONV/3.141593,0.512314/
 C
@@ -76,8 +76,8 @@ C
             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
+                CALL FACDIF1_A(VKE,R1,R2,THETA0,PHI0,BETA,GAMMA,L,M,
-     &AT,JE,*60)
+     1                         FSPH,JAT,JE,*60)
                 GOTO 70
   60            WRITE(IUO1,80)
                 STOP                    
@@ -94,12 +94,12 @@ C
   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,
+   5  FORMAT(1X,I3,1X,I4,1X,I2,1X,I3,1X,F6.3,1X,F6.3,1X,F6.2,
-     &F8.2)
+     1       1X,F6.2,1X,F8.2)
-  80  FORMAT(15X,'<<<<<  WRONG VALUE OF THETA0 : THE DENOMINATOR ','IS Z
+  80  FORMAT(15X,'<<<<<  WRONG VALUE OF THETA0 : THE DENOMINATOR ',
-     &ERO  >>>>>')
+     1           'IS ZERO  >>>>>')
- 100  FORMAT(15X,'<<<<<  THE VALUE OF L EST IS TOO LARGE FOR ATOM',' : '
+ 100  FORMAT(15X,'<<<<<  THE VALUE OF L EST IS TOO LARGE FOR ATOM',
-     &,I2,'  >>>>>')
+     1           ' : ',I2,'  >>>>>')
 C
       RETURN
 C

src/msspec/spec/fortran/aed_mi_mu_noso_nosp_nosym/treat_aed.f

@@ -1,7 +1,7 @@
 C
 C=======================================================================
 C
-      SUBROUTINE TREAT_PHD(ISOM,NFICHLEC,JFICH,NP)
+      SUBROUTINE TREAT_AED(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 
@@ -10,21 +10,22 @@ C
 C                                       Last modified : 24 Jan 2013
 C
       USE DIM_MOD
+C
       USE OUTUNITS_MOD
-      USE TYPEXP_MOD , DUMMY => SPECTRO
+      USE TYPEXP_MOD, DUMMY => SPECTRO
-      USE VALIN_MOD
+      USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
-      USE VALFIN_MOD
+     &                 PHI1 => PHI1_A, THETA1 => THETA1_A
+      USE VALIN_MOD, P0 => PHI0, T0 => THETA0
+      USE VALFIN_MOD, P1 => PHI1, T1 => THETA1
 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                              
@@ -42,8 +43,8 @@ C
  333  CONTINUE
 C
       READ(IUO2,15) SPECTRO,OUTDATA
-      READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,IPH_1
+      READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
-     &,I_EXT
+     1             IPH_1,I_EXT
 C
       IF(I_EXT.EQ.2) THEN
          IPH_1=0
@@ -65,8 +66,8 @@ C
           FIX0=THETA0
           FIX1=THETA1
           IF(STEREO.EQ.'YES') THEN
-            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/(THETA1-THETA0)+0.0001)
+            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/
-     &+1
+     1               (THETA1-THETA0)+0.0001)+1
             IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
           ENDIF
           N_SCAN=NPHI
@@ -96,7 +97,8 @@ C
 C
            DO J_FIXED=1,N_FIXED
             IF(N_FIXED.GT.1) THEN
-              XINCRF=FLOAT(J_FIXED-1)*(FIX1-FIX0)/FLOAT(N_FIXED-1)
+              XINCRF=FLOAT(J_FIXED-1)*
+     1               (FIX1-FIX0)/FLOAT(N_FIXED-1)
             ELSEIF(N_FIXED.EQ.1) THEN
               XINCRF=0.
             ENDIF
@@ -122,8 +124,10 @@ C
               JPHI=J_SCAN
              ENDIF
 C
-             JLIN=(JPLAN-1)*NDP + (JEMET-1)*NE*N_FIXED*N_SCAN + (JE-1)*N
+             JLIN=(JPLAN-1)*NDP + 
-     &_FIXED*N_SCAN +(JTHETA-1)*NPHI + JPHI
+     1            (JEMET-1)*NE*N_FIXED*N_SCAN + 
+     2            (JE-1)*N_FIXED*N_SCAN +
+     3            (JTHETA-1)*NPHI + JPHI
 C
              IF(I_EXT.LE.0) THEN
                IF(STEREO.EQ.' NO') THEN
@@ -139,19 +143,21 @@ C
              IF(JPLAN.EQ.JPL) THEN
                BACKSPACE IUO2
                IF(IDICHR.EQ.0) THEN
-                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &),TAB(JLIN,1),TAB(JLIN,2)
+     1                        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
+                 READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &E),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),TAB(JLIN,4)
+     1                         ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
+     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
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+     1                         ECIN(JE),TAB(JLIN2,1),TAB(JLIN2,2),
+     2                         TAB(JLIN2,3),TAB(JLIN2,4)
                  ENDIF
                ENDIF
              ELSE
@@ -228,8 +234,10 @@ C
             ENDIF
 C
             DO JEMET=1,NEMET
-             JLIN=(JPLAN-1)*NDP + (JEMET-1)*NE*NTHETA*NPHI + (JE-1)*NTHE
+             JLIN=(JPLAN-1)*NDP + 
-     &TA*NPHI +(JTHETA-1)*NPHI + JPHI
+     1            (JEMET-1)*NE*NTHETA*NPHI + 
+     2            (JE-1)*NTHETA*NPHI +
+     3            (JTHETA-1)*NPHI + JPHI
              SF_1=SF_1+TAB(JLIN,2)
              SR_1=SR_1+TAB(JLIN,1)
              IF(I_EXT.EQ.-1) THEN
@@ -257,18 +265,18 @@ C
               JPHI2=JTHETA
             ENDIF
             IF(IDICHR.EQ.0) THEN
-              WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),SR
+              WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &_1,SF_1
+     1                      ECIN(JE),SR_1,SF_1
               IF(I_EXT.EQ.-1) THEN
-                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &SR2_1,SF2_1
+     1                        ECIN(JE),SR2_1,SF2_1
               ENDIF
             ELSE
-              WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),S
+              WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &R_1,SF_1,SR_2,SF_2
+     1                       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)
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &,SR2_1,SF2_1,SR2_2,SF2_2
+     1                         ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
               ENDIF
             ENDIF
             IF(JPLAN.GT.NONVOL(JFICH)) THEN
@@ -303,30 +311,30 @@ C
             ENDIF
            ENDDO
            IF(IDICHR.EQ.0) THEN
-             WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VOLD
+             WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &IR_1,VOLDIF_1
+     1                     VOLDIR_1,VOLDIF_1
              IF(I_EXT.EQ.-1) THEN
-               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VO
+               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &LDIR2_1,VOLDIF2_1
+     1                       VOLDIR2_1,VOLDIF2_1
              ENDIF
-             WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TOTD
+             WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &IR_1,TOTDIF_1
+     1                     TOTDIR_1,TOTDIF_1
              IF(I_EXT.EQ.-1) THEN
-               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TO
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &TDIR2_1,TOTDIF2_1
+     1                       TOTDIR2_1,TOTDIF2_1
              ENDIF
            ELSE
-             WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),VOL
+             WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &DIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+     1                      VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
             IF(I_EXT.EQ.-1) THEN
-               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),V
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &OLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
+     1                        VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
              ENDIF
-             WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),TOT
+             WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &DIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+     1                      TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
              IF(I_EXT.EQ.-1) THEN
-               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),T
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &OTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
+     1                        TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
              ENDIF
            ENDIF
           ENDDO
@@ -349,8 +357,8 @@ C
           FIX0=THETA0
           FIX1=THETA1
           IF(STEREO.EQ.'YES') THEN
-            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/(THETA1-THETA0)+0.0001)
+            NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/
-     &+1
+     1               (THETA1-THETA0)+0.0001)+1
             IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
           ENDIF
           N_SCAN=NPHI
@@ -397,7 +405,8 @@ C
 C
            DO J_FIXED=1,N_FIXED
             IF(N_FIXED.GT.1) THEN
-              XINCRF=FLOAT(J_FIXED-1)*(FIX1-FIX0)/FLOAT(N_FIXED-1)
+              XINCRF=FLOAT(J_FIXED-1)*
+     1               (FIX1-FIX0)/FLOAT(N_FIXED-1)
             ELSEIF(N_FIXED.EQ.1) THEN
               XINCRF=0.
             ENDIF
@@ -423,8 +432,9 @@ C
               JPHI=J_SCAN
              ENDIF
 C
-             JLIN=(JF-1)*NDP + (JE-1)*N_FIXED*N_SCAN +(JTHETA-1)*NPHI + 
+             JLIN=(JF-1)*NDP + (JE-1)*N_FIXED*N_SCAN +
-     &JPHI
+     1            (JTHETA-1)*NPHI + JPHI
+
              IF(I_EXT.LE.0) THEN
                IF(STEREO.EQ.' NO') THEN
                  JPHI2=JPHI
@@ -440,19 +450,22 @@ C
                IF(JF.EQ.JPL) THEN
                  BACKSPACE IUO2
                  IF(IDICHR.EQ.0) THEN
-                   READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(
+                   READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &JE),TAB(JLIN,1),TAB(JLIN,2)
+     1                          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
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &(JE),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),TAB(JLIN,4)
+     1                           ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
+     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
+                     READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
-     &IN(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+     1                             DPHI(JPHI2),ECIN(JE),
+     2                             TAB(JLIN2,1),TAB(JLIN2,2),
+     3                             TAB(JLIN2,3),TAB(JLIN2,4)
                    ENDIF
                  ENDIF       
                ELSE
@@ -470,19 +483,22 @@ C
                ENDIF          
              ELSEIF(ISOM.EQ.2) THEN
                IF(IDICHR.EQ.0) THEN
-                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+                 READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &),TAB(JLIN,1),TAB(JLIN,2)
+     1                        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
+                 READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
-     &E),TAB(JLIN,1),TAB(JLIN,2),TAB(JLIN,3),TAB(JLIN,4)
+     1                         ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
+     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
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
-     &(JE),TAB(JLIN2,1),TAB(JLIN2,2),TAB(JLIN2,3),TAB(JLIN2,4)
+     1                           DPHI(JPHI2),ECIN(JE),
+     2                           TAB(JLIN2,1),TAB(JLIN2,2),
+     3                           TAB(JLIN2,3),TAB(JLIN2,4)
                    ENDIF
                ENDIF
              ENDIF
@@ -551,8 +567,8 @@ C
              DO JPLAN=1,NPLAN
               JF=JPLAN
 C
-              JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +(JTHETA-1)*NPHI + JP
+              JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +
-     &HI
+     1             (JTHETA-1)*NPHI + JPHI
 C
               SR_1=TAB(JLIN,1)
               SF_1=TAB(JLIN,2)
@@ -571,11 +587,11 @@ C
                 JPHI2=JTHETA
               ENDIF
               IF(IDICHR.EQ.0) THEN
-                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &SR_1,SF_1
+     1                        ECIN(JE),SR_1,SF_1
                 IF(I_EXT.EQ.-1) THEN
-                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &),SR2_1,SF2_1
+     1                          ECIN(JE),SR2_1,SF2_1
                 ENDIF
               ELSE
                 SR_2=TAB(JLIN,3)
@@ -585,11 +601,11 @@ C
                   SF2_2=TAB(JLIN2,4)
                   SR2_2=TAB(JLIN2,3)
                 ENDIF
-                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &,SR_1,SF_1,SR_2,SF_2
+     1                         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
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &E),SR2_1,SF2_1,SR2_2,SF2_2
+     1                           ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
                 ENDIF
               ENDIF
               IF(NONVOL(JPLAN).EQ.0) THEN
@@ -625,30 +641,32 @@ C
              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
+     1                       VOLDIR_1,VOLDIF_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) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     1                         ECIN(JE),VOLDIR2_1,VOLDIF2_1
+               ENDIF
                WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &TOTDIR2_1,TOTDIF2_1
+     1                       TOTDIR_1,TOTDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     1                         ECIN(JE),TOTDIR2_1,TOTDIF2_1
                ENDIF
              ELSE
-               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),V
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &OLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+     1                        VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
                IF(I_EXT.EQ.-1) THEN
-                 WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+                 WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
-     &,VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
+     1                          ECIN(JE),VOLDIR2_1,VOLDIF2_1,
+     3                          VOLDIR2_2,VOLDIF2_2
                ENDIF
-               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),T
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
-     &OTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+     1                        TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
                IF(I_EXT.EQ.-1) THEN
-                 WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE)
+                 WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
-     &,TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
+     1                          ECIN(JE),TOTDIR2_1,TOTDIF2_1,
+     3                          TOTDIR2_2,TOTDIF2_2
                ENDIF
              ENDIF
 C
@@ -683,8 +701,8 @@ C
               DO JEMET=1,NEMET
                JF=JEMET
 C
-               JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +(JTHETA-1)*NPHI + J
+               JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +
-     &PHI
+     1              (JTHETA-1)*NPHI + JPHI
 C
                SF_1=SF_1+TAB(JLIN,2)
                SR_1=SR_1+TAB(JLIN,1)
@@ -713,18 +731,18 @@ C
                 JPHI2=JTHETA
               ENDIF
               IF(IDICHR.EQ.0) THEN
-                WRITE(IUO2,3) JPL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),SR
+                WRITE(IUO2,3) JPL,DTHETA(JTHETA),DPHI(JPHI2),
-     &_1,SF_1
+     1                        ECIN(JE),SR_1,SF_1
                 IF(I_EXT.EQ.-1) THEN
-                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &),SR2_1,SF2_1
+     1                          ECIN(JE),SR2_1,SF2_1
                 ENDIF
               ELSE
-                WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),S
+                WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2),
-     &R_1,SF_1,SR_2,SF_2
+     1                        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
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
-     &E),SR2_1,SF2_1,SR2_2,SF2_2
+     1                           ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
                 ENDIF
               ENDIF
             ENDDO
@@ -743,25 +761,29 @@ C
       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)
+   2  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
+     1       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 
+   4  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF THE ARRAYS TOO SMALL ',
-     &THE TREAT_PHD SUBROUTINE - INCREASE NDIM_M ','>>>>>>>>>>')
+     1       'IN THE TREAT_AED SUBROUTINE - INCREASE NDIM_M ',
+     2       '>>>>>>>>>>')
    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
+  22  FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
-     &2.6,2X,E12.6)
+     1       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
+  23  FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,
-     &,E12.6)
+     1       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,'<<<<<<<<<<                 
+     1       'IN THE INCLUDE FILE >>>>>>>>>>',/,4X,
-     &SHOULD BE AT LEAST ',I6,'                 >>>>>>>>>>')
+     2        '<<<<<<<<<<                 SHOULD BE AT LEAST ',I6,
-  38  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF NPH_M TOO SMALL ','IN THE I
+     3        '                 >>>>>>>>>>')
-     &NCLUDE FILE >>>>>>>>>>',/,8X,'<<<<<<<<<<             SHOULD BE AT 
+  38  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF NPH_M TOO SMALL ',
-     &LEAST ',I6,'             >>>>>>>>>>')
+     1       'IN THE INCLUDE FILE >>>>>>>>>>',/,8X,
+     2        '<<<<<<<<<<             SHOULD BE AT LEAST ',I6,
+     3        '             >>>>>>>>>>')
  888  FORMAT(A72)
 C
    6  RETURN

src/msspec/spec/fortran/aed_se_mu_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)
+aed_se_mu_noso_nosp_nosym_src := $(wildcard aed_se_mu_noso_nosp_nosym/*.f)
+
+SRCS   = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(aed_se_mu_noso_nosp_nosym_src)
+MAIN_F = aed_se_mu_noso_nosp_nosym/main.f
+SO     = _aed_se_mu_noso_nosp_nosym.so
+
+include ../../../options.mk

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/aeddif_se_mu.f

@@ -0,0 +1,998 @@
+C
+C=======================================================================
+C
+      SUBROUTINE AEDDIF_SE_MU(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOK,
+     1                        NATCLU,NFICHLEC,JFICH,NP,LE_MIN,LE_MAX)
+C
+C   This subroutine computes the AED formula in the spin-independent case
+C        from a multiplet resolved initial core state L1. The 
+C        intermediate state that gives its energy is L2 while the 
+C        core hole that is filled in the process is noted LC. The 
+C        multiplet is characterized by the integer angular momentum 
+C        variables (L_MUL,S_MUL,J_MUL)
+C
+C   Alternatively, it can compute the AED amplitude for the APECS process.
+C
+C   The calculation is performed using a series expansion for the 
+C           expression of the scattering path operator
+C
+C                                        Last modified : 26 Apr 2013
+C
+      USE DIM_MOD
+C
+      USE ALGORITHM_MOD
+      USE AMPLI_MOD
+      USE APPROX_MOD
+      USE COOR_MOD, NTCLU => NATCLU, NTP => NATYP
+      USE DEBWAL_MOD
+      USE DIRECT_A_MOD, DIRANA => DIRANA_A, ANADIR => ANADIR_A,
+     &                  RTHETA => RTHEXT_A, RPHI => RPHI_A,
+     &                  THETAR => THETAR_A, PHIR => PHIR_A
+      USE EXTREM_MOD
+      USE FIXSCAN_A_MOD, N_FIXED => N_FIXED_A, N_SCAN => N_SCAN_A,
+     &                   IPH_1 => IPH_1_A, FIX0 => FIX0_A, 
+     &                   FIX1 => FIX1_A, SCAN0 => SCAN0_A, 
+     &                   SCAN1 => SCAN1_A
+      USE INFILES_MOD
+      USE INUNITS_MOD
+      USE INIT_J_MOD
+      USE INIT_L_MOD
+      USE INIT_M_MOD
+      USE LIMAMA_MOD
+      USE LINLBD_MOD
+      USE MOYEN_A_MOD, IMOY => IMOY_A, NDIR => NDIR_A,
+     &                 ACCEPT => ACCEPT_A, ICHKDIR => ICHKDIR_A
+      USE OUTFILES_MOD
+      USE OUTUNITS_MOD
+      USE PARCAL_A_MOD, NPHI => NPHI_A, NE => NE_A, 
+     &                  NTHETA => NTHETA_A, NFTHET => NFTHET_A     
+      USE PATH_MOD
+      USE PRINTP_MOD
+      USE RESEAU_MOD
+      USE SPIN_MOD
+      USE TESTPA_MOD
+      USE TESTPB_MOD
+      USE TESTS_MOD
+      USE TL_AED_MOD, DLT = > DLT_A, TL => TL_A, VK => VK_A,
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
+     &                LMAX => LMAX_A
+      USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A, 
+     &                  IFTHET => IFTHET_A, IMOD => IMOD_A, 
+     &                  I_CP => I_CP_A, I_EXT => I_EXT_A, 
+     &                  I_TEST => I_TEST_A
+      USE TYPEM_MOD
+      USE TYPEXP_MOD
+      USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A, 
+     &                 PHI1 => PHI1_A, THETA1 => THETA1_A
+      USE VALIN_MOD, P0 => PHI0, T0 => THETA0, TM => THLUM, 
+     &               PM => PHILUM, EM => ELUM
+C
+      REAL NPATH1(0:NDIF_M),NOPA
+C
+      COMPLEX IC,ONEC,ZEROC,PW(0:NDIF_M)
+      COMPLEX TLT(0:NT_M,4,NATM,NE_M),RHOMI
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLMR(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLME(0:NL_M,-NL_M:NL_M)
+      COMPLEX R2,M_COUL(0:NL_M,-NL_M:NL_M,2,-LI_M:LI_M,2)
+      COMPLEX SJDIR_1,SJDIF_1
+      COMPLEX RHOK(0:NT_M,NATM,0:40,2,NSPIN2_M),COU
+      COMPLEX SLJDIF,ATT_M,SLE_1
+      COMPLEX SL0DIF,SMJDIF
+C
+      DIMENSION VAL(NATCLU_M),NATYP(NATM)
+      DIMENSION EMET(3),COORD(3,NATCLU_M)
+      DIMENSION R(NDIF_M),XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),JPA(NDIF_M)
+C
+      CHARACTER*7  STAT
+      CHARACTER*24 INFILE
+      CHARACTER*24 OUTFILE
+C
+      DATA PIS180 /0.017453/
+      DATA EV,SMALL /13.60583,0.0001/
+      DATA BOHR /0.529177/
+C
+      ALGO1='  '
+      ALGO2='SE'
+      ALGO3='  '
+      ALGO4='  '
+C
+      IC=(0.,1.)
+      ONEC=(1.,0.)
+      ZEROC=(0.,0.)
+      NSCAT=NATCLU-1
+      ATTSE=1.
+      ATTSJ=1.
+      NPATH2(0)=1.
+      NPATH(0)=1.
+      NPMA(0)=1.
+      NPMI(0)=1.
+      ZSURF=VAL(1)
+C
+      I_DIR=0
+      NSET=1
+      JEL=2
+C
+      IF(SPECTRO.EQ.'AED') THEN
+        IOUT=IUO2
+        OUTFILE=OUTFILE2
+        STAT='UNKNOWN'
+        IF(ABS(I_EXT).GE.1) THEN
+          ISET=IUI6
+          INFILE=INFILE6
+        ENDIF
+      ELSEIF(SPECTRO.EQ.'APC') THEN
+        IOUT=IUSCR2
+        OUTFILE='res/auger.amp'
+        STAT='UNKNOWN'
+        IF(ABS(I_EXT).GE.1) THEN
+          ISET=IUI9
+          INFILE=INFILE9
+        ENDIF
+      ENDIF
+C
+      LF1=LE_MIN
+      LF2=LE_MAX
+      ISTEP_LF=2
+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
+        WRITE(IOUT,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
+     1                IPH_1,I_EXT
+      ENDIF
+C
+      IF(ISOM.EQ.0) THEN
+        WRITE(IOUT,79) NPLAN,NEMET,NTHETA,NPHI,NE
+      ELSEIF((ISOM.NE.0).AND.(JFICH.EQ.1)) THEN
+        WRITE(IOUT,11) NTHETA,NPHI,NE
+      ENDIF
+C
+C   Construction of the linear index LAMBDA=(MU,NU)
+C
+      LAMBDA0=0
+      DO N_O=0,NO
+        NMX=N_O/2
+        DO NU=0,NMX
+          DO MU=-N_O,N_O
+            NMU=2*NU+ABS(MU)
+            IF(NMU.EQ.N_O) THEN
+              LAMBDA0=LAMBDA0+1
+              LBD(MU,NU)=LAMBDA0  
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+      LBDMAX=LAMBDA0
+      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
+C   Loop over the different absorbers in a given plane
+C
+       DO JEMET=1,NEMET
+        CALL EMETT(JEMET,IEMET,Z,SYM_AT,NATYP,EMET,NTYPEM,
+     1             JNEM,*4)
+        GO TO 2                                                          
+   4    IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN          
+          IF(I_TEST.NE.2) WRITE(IUO1,51) JPLAN,NTYPEM                                        
+        ENDIF                                                             
+        GO TO 3  
+   2    IF((ABS(EMET(3)).GT.COUPUR).AND.(IBAS.EQ.1)) GOTO 5                 
+        IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN          
+          IF(I_TEST.NE.2) THEN 
+            WRITE(IUO1,52) JPLAN,EMET(1),EMET(2),EMET(3),NTYPEM  
+          ENDIF               
+        ENDIF
+        IF(ISOM.EQ.1) NP=JPLAN 
+        ZSURFE=VAL(1)-EMET(3) 
+        JTE=IEMET(JEMET)                        
+C
+C   Loop over the energies
+C     
+        DO JE=1,NE
+         FMIN(0)=1.
+         FMAX(0)=1.
+         IF(I_TEST.NE.1) THEN                      
+           VKR=REAL(VK(JE))
+         ELSE
+           VKR=1.
+         ENDIF
+         ECIN=VKR*VKR*BOHR*BOHR*EV/(A*A)+VINT
+         IF(I_TEST.NE.1) THEN                      
+           CFM=2.*VKR
+         ELSE
+           CFM=1.
+         ENDIF
+         CALL LPM(ECIN,XLPM,*6)                                           
+         XLPM1=XLPM/A                                                      
+         GAMMA=1./(2.*XLPM1)                                               
+         IF(IPOTC.EQ.0) THEN
+           VK(JE)=VK(JE)+IC*GAMMA
+         ENDIF
+         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((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_A(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=ISET, FILE=INFILE, STATUS='OLD')
+           READ(ISET,13) I_DIR,NSET,N_DUM1
+           READ(ISET,14) I_DUM1,N_DUM2,N_DUM3
+         ENDIF
+C
+C   Initialization of TAU(INDJ,LINFMAX,JTYP)
+C
+         JATL=0
+         DO JTYP=1,N_PROT
+           NBTYP=NATYP(JTYP)
+           LMJ=LMAX(JTYP,JE)
+           DO JNUM=1,NBTYP
+             JATL=JATL+1
+             DO LE=LE_MIN,LE_MAX,2
+               ILE=LE*LE+LE+1
+               DO ME=-LE,LE
+                 INDE=ILE+ME
+                 DO LJ=0,LMJ
+                   ILJ=LJ*LJ+LJ+1
+                   DO MJ=-LJ,LJ 
+                     INDJ=ILJ+MJ
+                     TAU(INDJ,INDE,JATL)=ZEROC
+                   ENDDO
+                 ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+         ENDDO
+C
+C   Storage of the coupling matrix elements M_COUL 
+C
+         DO MC=-LI,LI
+           DO ISC=1,2
+             SC=FLOAT(ISC)-1.5
+             DO LA=LE_MIN,LE_MAX,2
+               DO MA=-LA,LA
+                 DO ISA=1,2
+                   SA=FLOAT(ISA)-1.5
+                   CALL COUMAT_AM(LA,MA,SA,MC,SC,JTE,RHOK,COU)
+                   M_COUL(LA,MA,ISA,MC,ISC)=COU
+                 ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+         ENDDO
+C
+C    Calculation of the scattering path operator TAU
+C
+         IF(I_TEST.EQ.2) GOTO 666
+         PW(0)=ONEC
+         PW(1)=ONEC
+         ND=0
+         TH01=0.
+         PHI01=0.
+         RHO01=ZEROC
+         THMI=0.
+         PHMI=0.
+         RHOMI=ZEROC
+         JATLEM=JNEM
+         IF(NTYPEM.GT.1) THEN
+           DO JAEM=NTYPEM-1,1,-1
+             JATLEM=JATLEM+NATYP(JAEM)
+           ENDDO
+         ENDIF
+         DO JD=1,NDIF
+           NPATH2(JD)=0.
+           NPATH(JD)=0.
+           IT(JD)=0
+           IN(JD)=0
+           FMIN(JD)=1.E+20
+           FMAX(JD)=0.
+         ENDDO
+         NTHOF=0
+C
+C     Calculation of the maximal intensity for the paths of order NCUT
+C      (plane waves). This will be taken as a reference for the IPW filter.
+C     
+         IF(IPW.EQ.1) THEN
+           NDIFOLD=NDIF
+           NOOLD=NO
+           ISPHEROLD=ISPHER
+           NDIF=NCUT
+           NO=0
+           ISPHER=0
+           IREF=1
+           IPW=0
+           IJ=0
+           DIJ=0.
+           FREF=0.
+           CALL FINDPATHS_A(ND,NTYPEM,JATLEM,I_CP,R,XR,YR,ZR,RHOMI,
+     1                      THMI,PHMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+           NDIF=NDIFOLD
+           NO=NOOLD
+           ISPHER=ISPHEROLD
+           PW(0)=ONEC
+           PW(1)=ONEC
+           IPW=1
+           ND=0
+           TH01=0.
+           PHI01=0.
+           RHO01=ZEROC
+           THMI=0.
+           PHMI=0.
+           RHOMI=ZEROC
+           JATLEM=JNEM
+           IF(NTYPEM.GT.1) THEN
+             DO JAEM=NTYPEM-1,1,-1
+               JATLEM=JATLEM+NATYP(JAEM)
+             ENDDO
+           ENDIF
+           DO JD=1,NDIF
+             NPATH2(JD)=0.
+             NPATH(JD)=0.
+             IT(JD)=0
+             IN(JD)=0
+             FMIN(JD)=1.E+20
+             FMAX(JD)=0.
+           ENDDO
+           NTHOF=0
+C
+C   New initialization of TAU(INDJ,INDF,JATL) after the PW calculation
+C
+           JATL=0
+           DO JTYP=1,N_PROT
+             NBTYP=NATYP(JTYP)
+             LMJ=LMAX(JTYP,JE)
+             DO JNUM=1,NBTYP
+               JATL=JATL+1
+               DO LE=LE_MIN,LE_MAX,2
+                 ILE=LE*LE+LE+1
+                 DO ME=-LE,LE
+                   INDE=ILE+ME
+                   DO LJ=0,LMJ
+                     ILJ=LJ*LJ+LJ+1
+                     DO MJ=-LJ,LJ 
+                       INDJ=ILJ+MJ
+                       TAU(INDJ,INDE,JATL)=ZEROC
+                     ENDDO
+                   ENDDO
+                 ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+         ENDIF
+C
+C   Generation and print-out of the paths
+C
+         IF (NPATHP.GT.0) THEN
+           DO JP=1,NPATHP-1
+             FMN(JP)=0.
+             PATH(JP)=0.
+             JON(JP)=0
+           ENDDO
+           FMN(NPATHP)=-1.
+           PATH(NPATHP)=0.
+           JON(NPATHP)=0
+         ENDIF
+         IREF=0
+         IJ=1
+         IF(IPRINT.EQ.3) THEN
+           OPEN(UNIT=IUSCR, STATUS='SCRATCH')
+         ENDIF
+         DIJ=0.
+         CALL FINDPATHS_A(ND,NTYPEM,JATLEM,I_CP,R,XR,YR,ZR,RHOMI,
+     1                    THMI,PHMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+         IF(NPATHP.EQ.0) GOTO 15
+         IF(NSCAT.GT.1) THEN
+           XPATOT=REAL((DFLOAT(NSCAT)**DFLOAT(NDIF+1) -1.D0)/
+     1                  DFLOAT(NSCAT-1))
+         ELSE
+           XPATOT=FLOAT(NDIF+1)
+         ENDIF
+         IF(XPATOT.LT.2.14748E+09) THEN 
+           NPATOT=INT(XPATOT)
+           IF(NPATOT.LT.NPATHP) NPATHP=NPATOT-1
+         ENDIF
+         WRITE(IUO1,84) NPATHP
+         WRITE(IUO1,81) 
+         DO JPT=1,NPATHP
+           IF(PATH(NPATHP).GT.2.14E+09) THEN
+             WRITE(IUO1,82) JPT,JON(JPT),PATH(JPT),FMN(JPT),DMN(JPT),
+     1                      JNEM,(JPON(JPT,KD),KD=1,JON(JPT))
+           ELSE
+             WRITE(IUO1,83) JPT,JON(JPT),INT(PATH(JPT)),FMN(JPT),
+     1                      DMN(JPT),JNEM,(JPON(JPT,KD),KD=1,JON(JPT))
+           ENDIF
+         ENDDO
+         IF(IPRINT.EQ.3) THEN
+           IF(XPATOT.GT.2.14748E+09) GOTO 172
+           WRITE(IUO1,85) 
+           WRITE(IUO1,71)
+           NPATOT=INT(XPATOT)
+           DO JOP=0,NDIF
+             IF(JOP.EQ.0) THEN
+               XINT0=FMAX(0)
+               DIST0=0.
+               WRITE(IUO1,70) JOP,JOP+1,XINT0,DIST0,JNEM
+               GOTO 75
+             ENDIF
+             WRITE(IUO1,77)
+             DO JLINE=1,NPATOT-1
+               READ(IUSCR,69,ERR=75,END=75) JOPA,NOPA,XMAX,DIST0,
+     1                              (JPA(KD),KD=1,JOPA)
+               IF(JOPA.EQ.JOP) THEN
+                 IF(NOPA.GT.2.14E+09) THEN
+                  WRITE(IUO1,76) JOPA,NOPA,XMAX,DIST0,JNEM,
+     1                              (JPA(KD),KD=1,JOPA)
+                 ELSE
+                  WRITE(IUO1,70) JOPA,INT(NOPA),XMAX,DIST0,JNEM,
+     1                              (JPA(KD),KD=1,JOPA)
+                 ENDIF
+               ENDIF
+             ENDDO
+             IF(JOP.EQ.NDIF) WRITE(IUO1,80)
+  75         REWIND IUSCR
+           ENDDO
+           GOTO 73
+  172      WRITE(IUO1,74)
+           CLOSE(IUSCR,STATUS='DELETE')
+  73     ENDIF
+         DO JD=0,NDIF
+           NPATH1(JD)=REAL(DFLOAT(NSCAT)**DFLOAT(JD))
+           IF(NPATH1(JD).GT.2.14E+09) THEN
+             IF(FMIN(JD).EQ.0.1E+21) FMIN(JD)=0.
+             WRITE(IUO1,53) JD,NPATH1(JD),NPATH2(JD),FMIN(JD),NPMI(JD),
+     1                   FMAX(JD),NPMA(JD)
+             IF((IPW.EQ.1).AND.(JD.GT.NCUT)) WRITE(IUO1,68) FREF*PCTINT
+           ELSE
+             IF(FMIN(JD).EQ.0.1E+21) FMIN(JD)=0.
+             WRITE(IUO1,58) JD,INT(NPATH1(JD)+0.1),
+     1                      INT(NPATH2(JD)+0.1),FMIN(JD),
+     2                      INT(NPMI(JD)+0.1),FMAX(JD),
+     3                      INT(NPMA(JD)+0.1)
+             IF((IPW.EQ.1).AND.(JD.GT.NCUT)) WRITE(IUO1,68) FREF*PCTINT
+           ENDIF
+         ENDDO
+ 666     CONTINUE
+C
+C    Calculation of the Auger Electron Diffraction 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(ISET,86) JSET,JLINE,THD,PHD
+            IF(I_EXT.EQ.-1) BACKSPACE ISET
+          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
+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(ISET,86) JSET,JLINE,THD,PHD
+             BACKSPACE ISET
+           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
+           SSETDIR_1=0.
+           SSETDIF_1=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(ISET,86) JSET,JLINE,THD,PHD,W
+             DTHETA=THD
+             DPHI=PHD
+             RTHETA=DTHETA*PIS180
+             RPHI=DPHI*PIS180
+           ELSE
+             W=1.
+           ENDIF
+C
+           IF(I_EXT.EQ.-1) PRINT 89
+C                                    
+           CALL DIRAN(VINT,ECIN,JEL)
+           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
+           WRITE(IUO1,61) (DIRANA(J,1),J=1,3)
+C
+           SRDIF_1=0.
+           SRDIR_1=0.
+C
+C    Loop over the different directions of the analyzer contained in a cone
+C
+          DO JDIR=1,NDIR
+            IF(IATTS.EQ.1) THEN
+              ATTSE=EXP(-ZSURFE*GAMMA/DIRANA(3,JDIR))
+            ENDIF
+C
+            SSCDIR_1=0.
+            SSCDIF_1=0.
+C
+C    Loop over the equiprobable quantum numbers MC,SC and SA 
+C         corresponding respectively to the core hole (MC and spin SC)
+C         and to the outgoing Auger electron (SA). The sum over the 
+C         equiprobable azimuthal quantum number MJ of the multiplet 
+C         configuration is suppressed here as, because of the selection 
+C         rules, one has MJ = MA + MC + SA + SC
+C
+            LME=LMAX(1,JE)
+            CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLME,LME)
+C
+            DO ISC=1,2
+             SC=FLOAT(ISC)-1.5
+C
+             SMCDIR_1=0.
+             SMCDIF_1=0.
+C
+             DO MC=-LI,LI
+C
+              SSADIR_1=0.
+              SSADIF_1=0.
+C
+              DO ISA=1,2
+               SA=FLOAT(ISA)-1.5
+C
+                SMJMDIR_1=0.
+                SMJMDIF_1=0.
+C
+                DO MJM=-J_MUL,J_MUL
+C
+                 SJDIR_1=ZEROC
+                 SJDIF_1=ZEROC
+C
+C    Calculation of the direct emission (used a a reference for the 
+C      output), which is not contained in the calculation of TAU
+C
+                 DO L_E=LE_MIN,LE_MAX,2
+                  ILE=L_E*L_E+L_E+1
+                  IF(ISPEED.EQ.1) THEN
+                    R2=TL(L_E,1,1,JE)
+                  ELSE
+                    R2=TLT(L_E,1,1,JE)
+                  ENDIF
+                  M_E=MJM-MC-ISA-ISC+3
+                  IF(ABS(M_E).GT.L_E) GOTO 444
+                  INDE=ILE+M_E
+                  SJDIR_1=SJDIR_1+YLME(L_E,M_E)*ATTSE*
+     1                            M_COUL(L_E,M_E,ISA,MC,ISC)*R2
+C                  
+C    Contribution of the absorber to TAU (initialization of SJDIF)
+C
+                  IF(I_TEST.EQ.2) GOTO 444
+                  SL0DIF=ZEROC
+                  DO L0=0,LME
+                    IL0=L0*L0+L0+1
+                    SL0DIF=SL0DIF+YLME(L0,0)*TAU(IL0,INDE,1)
+                    DO M0=1,L0
+                     IND01=IL0+M0
+                     IND02=IL0-M0
+                     SL0DIF=SL0DIF+(YLME(L0,M0)*
+     1                              TAU(IND01,INDE,1)+
+     2                              YLME(L0,-M0)*
+     3                              TAU(IND02,INDE,1))
+                    ENDDO
+                  ENDDO
+
+                  SJDIF_1=SJDIF_1+SL0DIF*M_COUL(L_E,M_E,ISA,MC,ISC)
+ 444              CONTINUE
+                 ENDDO
+                 SJDIF_1=SJDIF_1*ATTSE
+C
+C    Loop over the last atom J encountered by the photoelectron 
+C                  before escaping the solid
+C
+                 IF(I_TEST.EQ.2) GOTO 111
+                 DO JTYP=2,N_PROT
+                  NBTYP=NATYP(JTYP)
+                  LMJ=LMAX(JTYP,JE)
+                  DO JNUM=1,NBTYP
+                   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)
+                   CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLMR,
+     1                         LMJ)
+                   IF(IATTS.EQ.1) THEN
+                     ATTSJ=EXP(-ZSURFJ*GAMMA/DIRANA(3,JDIR))
+                   ENDIF
+                   CSTHJR=(XOJ*DIRANA(1,JDIR)+YOJ*DIRANA(2,JDIR)+
+     1                     ZOJ*DIRANA(3,JDIR))/ROJ
+                   IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 78
+                   CTROIS1=ZOJ/ROJ
+                   IF(CTROIS1.GT.1.)  THEN
+                     CTROIS1=1.
+                   ELSEIF(CTROIS1.LT.-1.) THEN
+                     CTROIS1=-1.
+                   ENDIF
+                   IF(IDCM.GE.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)*
+     1                        (DIRANA(3,JDIR)-CTROIS1)/(2.
+     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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                   ENDIF
+ 78                IF(IDWSPH.EQ.1) THEN
+                     DWTER=1.
+                   ELSE
+                     DWTER=EXP(-VK2(JE)*UJJ*(1.-CSTHJR))
+                   ENDIF
+                   IF(JATL.EQ.JATLEM) THEN
+                     ATT_M=ATTSE*DWTER
+                   ELSE
+                     ATT_M=ATTSJ*DWTER*CEXP(-IC*VK(JE)*ROJ*CSTHJR)
+                   ENDIF
+C
+                   SLE_1=ZEROC
+                   DO L_E=LE_MIN,LE_MAX,2
+                     ILE=L_E*L_E+L_E+1
+                     M_E=MJM-MC-ISA-ISC+3
+                     IF(ABS(M_E).GT.L_E) GOTO 555
+                     INDE=ILE+M_E
+                     SLJDIF=ZEROC
+                     DO LJ=0,LMJ
+                       ILJ=LJ*LJ+LJ+1
+                       SMJDIF=YLMR(LJ,0)*TAU(ILJ,INDE,JATL)
+                       IF(LJ.GT.0) THEN
+                         DO MJ=1,LJ
+                           INDJ1=ILJ+MJ
+                           INDJ2=ILJ-MJ
+                           SMJDIF=SMJDIF+(YLMR(LJ,MJ)*
+     1                                    TAU(INDJ1,INDE,JATL)+
+     2                                    YLMR(LJ,-MJ)*
+     3                                    TAU(INDJ2,INDE,JATL))
+                         ENDDO
+                       ENDIF  
+                       SLJDIF=SLJDIF+SMJDIF
+                     ENDDO
+                     SLE_1=SLE_1+SLJDIF*M_COUL(L_E,M_E,ISA,MC,ISC)
+  555                CONTINUE
+                   ENDDO
+                   SJDIF_1=SJDIF_1+SLE_1*ATT_M
+C
+C     End of the loops over the last atom J 
+C
+                  ENDDO
+                 ENDDO
+C
+C     Writing the amplitudes in file IOUT for APECS
+C
+ 111             IF(SPECTRO.EQ.'APC') THEN
+                   WRITE(IOUT,87) JFICH,JPLAN,JEMET,JE,J_FIXED,J_SCAN,
+     1                            JDIR,ISC,MC,ISA,MJM,SJDIR_1,
+     2                            SJDIR_1+SJDIF_1
+                 ELSE
+C
+C     Computing the square modulus
+C
+                   SSADIF_1=SSADIF_1+CABS(SJDIR_1+SJDIF_1)*
+     1                               CABS(SJDIR_1+SJDIF_1)
+                   SSADIR_1=SSADIR_1+CABS(SJDIR_1)*CABS(SJDIR_1)
+C
+                 ENDIF
+C
+C     End of the loop over MJM
+C
+                ENDDO
+C
+                SMJMDIF_1=SMJMDIF_1+SSADIF_1           
+                SMJMDIR_1=SMJMDIR_1+SSADIR_1           
+C
+C     End of the loop over SA
+C
+              ENDDO
+C
+              SMCDIF_1=SMCDIF_1+SMJMDIF_1           
+              SMCDIR_1=SMCDIR_1+SMJMDIR_1           
+C
+C     End of the loop over MC
+C
+             ENDDO
+C
+             SSCDIF_1=SSCDIF_1+SMCDIF_1           
+             SSCDIR_1=SSCDIR_1+SMCDIR_1           
+C
+C     End of the loop over SC
+C
+            ENDDO
+C
+            IF(SPECTRO.EQ.'APC') GOTO 220
+            SRDIR_1=SRDIR_1+SSCDIR_1*VKR*CFM/NDIR
+            SRDIF_1=SRDIF_1+SSCDIF_1*VKR*CFM/NDIR
+ 220        CONTINUE
+C
+C     End of the loop on the directions of the analyzer
+C
+           ENDDO
+C
+            IF(SPECTRO.EQ.'APC') GOTO 221
+            SSETDIR_1=SSETDIR_1+SRDIR_1*W
+            SSETDIF_1=SSETDIF_1+SRDIF_1*W
+            IF(ICHKDIR.EQ.2) THEN
+              IF(JSET.EQ.JREF) THEN
+                SSET2DIR_1=SRDIR_1
+                SSET2DIF_1=SRDIF_1
+              ENDIF
+            ENDIF
+ 221        CONTINUE
+C
+C     End of the loop on the set averaging 
+C
+           ENDDO
+C
+            IF(SPECTRO.EQ.'APC') GOTO 222
+            IF(ISOM.EQ.2) THEN
+              WRITE(IOUT,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
+     1                       SSETDIR_1,SSETDIF_1
+              IF(ICHKDIR.EQ.2) THEN
+               WRITE(IUO2,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
+     1                        SSET2DIR_1,SSET2DIF_1 
+              ENDIF
+            ELSE
+              WRITE(IOUT,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
+     1                       SSETDIR_1,SSETDIF_1 
+              IF(ICHKDIR.EQ.2) THEN
+               WRITE(IUO2,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
+     1                        SSET2DIR_1,SSET2DIF_1 
+              ENDIF
+            ENDIF
+ 222        CONTINUE
+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(ISET)
+        ENDDO
+C
+   3    CONTINUE
+C
+C     End of the loop on the emitters
+C
+       ENDDO
+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(ISET)
+      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_AED(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)
+  13  FORMAT(6X,I1,1X,I3,2X,I4)
+  14  FORMAT(6X,I1,1X,I3,3X,I3)
+  22  FORMAT(16X,'INTERNAL CALCULATION OF MEAN SQUARE DISPLACEMENTS',/,
+     1       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 ',
+     1'THE ABSORBER : (',F6.3,',',F6.3,',',F6.3,') *******',/,2X,
+     2'******* ',19X,'THIS ABSORBER IS OF TYPE ',I2,20X,' *******')          
+  53  FORMAT(//,2X,'ORDER ',I2,'  TOTAL NUMBER OF PATHS     : ',F15.1,
+     1             /,10X,'  EFFECTIVE NUMBER OF PATHS : ',F15.1,
+     2             /,10X,'  MINIMAL INTENSITY         : ',E12.6,
+     3             2X,'No OF THE PATH : ',F15.1,                         
+     4             /,10X,'  MAXIMAL INTENSITY         : ',E12.6,
+     5             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,
+     1             /,10X,'  EFFECTIVE NUMBER OF PATHS : ',I10,                
+     2             /,10X,'  MINIMAL INTENSITY         : ',E12.6,
+     3             2X,'No OF THE PATH : ',I10,                         
+     4             /,10X,'  MAXIMAL INTENSITY         : ',E12.6,             
+     5             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')                                                  
+  61  FORMAT(///,4X,'..........  DIRECTION OF THE DETECTOR      : (',
+     1      F6.3,',',F6.3,',',F6.3,')  ..........')                                       
+  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,
+     1       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,
+     1       'INTENSITY',3X,'LENGTH',4X,'ABSORBER',2X,
+     2       'ORDER OF THE SCATTERERS',/)
+  74  FORMAT(10X,'<===== NUMBER OF PATHS TOO LARGE FOR PRINTING ',
+     1       '=====>')
+  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,
+     1       'INTENSITY',3X,'LENGTH',4X,'ABS',3X,
+     2       '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',
+     1      ' ORDER :',/,24X,'(THE LENGTH IS GIVEN IN UNITS ',
+     2      'OF A)')
+  85  FORMAT(/////,25X,' PATHS USED IN THE CALCULATION : ',
+     1       /,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,I2,2X,I2,2X,I2,
+     1       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 =', 
+     1         F6.2) 
+  89  FORMAT(/,4X,'..........................................',
+     1         '.....................................')    
+C
+   7  RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/coumat_am.f

@@ -0,0 +1,140 @@
+C
+C=======================================================================
+C
+      SUBROUTINE COUMAT_AM(LA,MA,SA,MC,SC,JE,RHOK_A,MATRIX_AM)
+C
+C  This routine calculates the multiplet-resolved spin-independent
+C   Coulomb matrix elements occuring in the Auger process. They 
+C   are stored in MATRIX_AM. The multiplet component is characterized 
+C   by the quantum numbers (L,S,J) which are read from the input 
+C   data file.
+C
+C  Here, the conventions are (direct process D):
+C
+C        (LC,MC)  : core hole filled by intermediate electron 
+C        (L1,M1)  : Auger electron before excitation
+C        (L2,M2)  : intermediate electron that fills the core hole
+C        (LA,MA)  : Auger electron after excitation
+C
+C  In the exchange process E, the roles of (L1,M1) and (L2,M2) 
+C    are interchanged.
+C
+C  Note that the Clebsch-Gordan corresponding to the spin-orbit 
+C    resolved core state is not included in the formula here. This 
+C    is because in APECS, it appears also in the dipole matrix 
+C    element and it is therefore useless to calculate it twice.
+C    Therefore, it must be implemented into the cross-section 
+C    subroutine.
+C
+C  The factor i**LA comes from the particular normalization used 
+C    in the phagen code
+C
+C                                        Last modified :  8 Dec 2008
+C
+      USE DIM_MOD
+C
+      USE C_G_M_MOD
+      USE INIT_A_MOD, LC => LI_C, L2 => LI_I, L1 => LI_A
+      USE TYPCAL_A_MOD, I1 => IPHI_A, I2 => IE_A, I3 => ITHETA_A,
+     1                  I4 => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A,
+     2                  I7 => I_EXT_A, I_TEST => I_TEST_A
+      USE INIT_M_MOD
+C
+      COMPLEX RHOK_A(0:NT_M,NATM,0:40,2,NSPIN2_M)
+      COMPLEX ZEROC,ONEC,MATRIX_AM
+      COMPLEX SUM_LB,SUM_M1,IC,IL
+C
+      REAL*4 CG1(0:N_GAUNT),CG2(0:N_GAUNT)
+      REAL*4 GNT1(0:N_GAUNT),GNT2(0:N_GAUNT),GNT3(0:N_GAUNT)
+      REAL*4 GNT4(0:N_GAUNT)
+C
+      REAL*8 ZEROD
+C
+      DATA PI4,ONEOSQ2,HALF /12.566371,0.707107,0.5/
+C
+      ZEROC=(0.,0.)
+      ONEC=(1.,0.)
+      IC=(0.,1.)
+      ZEROD=0.D0
+C
+      IF(I_TEST.EQ.1) GOTO 2
+C
+      IF(MOD(LA,4).EQ.0) THEN
+        IL=ONEC
+      ELSEIF(MOD(LA,4).EQ.1) THEN
+        IL=IC
+      ELSEIF(MOD(LA,4).EQ.2) THEN
+        IL=-ONEC
+      ELSEIF(MOD(LA,4).EQ.3) THEN
+        IL=-IC
+      ENDIF
+C
+      IF(I_SHELL.EQ.0) THEN
+        COEF1=ONEOSQ2*PI4
+      ELSEIF(I_SHELL.EQ.1) THEN
+        COEF1=HALF*PI4
+      ENDIF
+C
+      IF(MOD(S_MUL,2).EQ.0) THEN
+        SIGN1=1.
+      ELSE
+        SIGN1=-1.
+      ENDIF
+C
+C   Values of MJ, ML and MS given by the Clebsch-Gordan
+C
+      ML=MA+MC
+      MS=INT(SA+SC+0.0001)
+      MJ=ML+MS
+C
+C  Storage indices for the spin Clebsch-Gordan :
+C
+C               ISA(C) = 1 for -1/2 and 2 for 1/2
+C               IS = 1 for S_MUL=0 and 2 for S_MUL=1
+C
+      IS=S_MUL+1
+      ISA=INT(SA+1.5001)
+      ISC=INT(SC+1.5001)
+C
+C  Bounds of the sum over LB
+C
+      LB_MAX_D=MIN(L1+LA,L2+LC)
+      LB_MIN_D=MAX(ABS(L1-LA),ABS(L2-LC))
+      LB_MAX_E=MIN(L2+LA,L1+LC)
+      LB_MIN_E=MAX(ABS(L2-LA),ABS(L1-LC))
+      LB_MIN=MIN(LB_MIN_D,LB_MIN_E)
+      LB_MAX=MAX(LB_MAX_D,LB_MAX_E)
+C
+      N_CG=2
+      CALL N_J(DFLOAT(L_MUL),DFLOAT(ML),DFLOAT(S_MUL),DFLOAT(MS),
+     1         ZEROD,CG1,I_INT1,N_CG)
+C
+      SUM_M1=ZEROC
+      DO M1=-L1,L1
+        M2=ML-M1
+C
+        CALL N_J(DFLOAT(L1),DFLOAT(M1),DFLOAT(L2),DFLOAT(ML-M1),
+     1           ZEROD,CG2,I_INT2,N_CG)
+        CALL GAUNT(L1,M1,LA,MA,GNT1)      
+        CALL GAUNT(LC,MC,L2,M2,GNT2)      
+        CALL GAUNT(L2,M2,LA,MA,GNT3)      
+        CALL GAUNT(LC,MC,L1,M1,GNT4)
+C      
+        SUM_LB=ZEROC
+        DO LB=LB_MIN,LB_MAX
+          SUM_LB=SUM_LB+(RHOK_A(LA,JE,LB,1,1)*GNT1(LB)*GNT2(LB)+
+     1                   RHOK_A(LA,JE,LB,2,1)*GNT3(LB)*GNT4(LB)*
+     2                   SIGN1)/FLOAT(LB+LB+1)
+        ENDDO
+        SUM_M1=SUM_M1+SUM_LB*CG2(L_MUL)
+      ENDDO
+C
+      MATRIX_AM=SUM_M1*CG1(J_MUL)*CG_S(ISA,ISC,IS)*COEF1*IL
+C
+      GOTO 1
+C
+   2  MATRIX_AM=ONEC
+C
+   1  RETURN                             
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/dwsph_a.f

@@ -0,0 +1,88 @@
+C
+C=======================================================================
+C
+      SUBROUTINE DWSPH_A(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 TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, VK2 =>
+     &                VK2_A, IPOTC => IPOTC_A, ITL => ITL_A, 
+     &                LMAX => LMAX_A
+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/aed_se_mu_noso_nosp_nosym/facdif1_a.f

@@ -0,0 +1,115 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF1_A(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,
+     1                     FSPH,JAT,JE,*)
+C
+C  This routine computes a spherical wave scattering factor
+C
+C                                            Last modified : 03/04/2006
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD
+      USE EXPFAC_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, 
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A, 
+     &                LMAX => LMAX_A
+      USE TYPCAL_A_MOD, I2 => IPHI_A, I3 => IE_A, I4 => ITHETA_A, 
+     &                  IFTHET => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A, 
+     &                  I7 => I_EXT_A, I8 => I_TEST_A
+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
+      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/aed_se_mu_noso_nosp_nosym/facdif_a.f

@@ -0,0 +1,28 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FACDIF_A(COSTH,JAT,JE,FTHETA)
+C
+C  This routine computes the plane wave scattering factor
+C
+      USE DIM_MOD
+C
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
+     &                LMAX => LMAX_A
+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/aed_se_mu_noso_nosp_nosym/findpaths1_a.f

@@ -0,0 +1,369 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FINDPATHS_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
+     1                       PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+C
+C  This routine generates all the paths and filters them according to the
+C      criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH). 
+C      It corresponds to the spin-independent case from a non spin-orbit
+C                    resolved initial core state LI
+C
+C                                          Last modified : 31 Jul 2007
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
+      USE COOR_MOD
+      USE DEBWAL_MOD
+      USE INIT_L_MOD
+      USE PATH_MOD
+      USE ROT_MOD
+      USE TESTPA_MOD
+      USE TESTPB_MOD
+      USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
+     &                IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
+      USE TLDW_MOD
+      USE VARIA_MOD
+C
+      DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
+C
+      COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
+      COMPLEX IC,COMPL1,PW(0:NDIF_M)
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
+C
+      DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
+C
+      IC=(0.,1.)
+      IEULER=1
+C
+      IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
+      IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
+C
+C    I_CP = 0 : all open paths generated
+C    I_CP = 1 : only closed paths generated 
+C
+      IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+        N_TYP=N_PROT
+      ELSE
+        N_TYP=1
+      ENDIF
+C
+      DO JTYP=1,N_TYP
+       IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
+       IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
+       ND=ND+1
+C
+C     I_ABS = 0 : the atom before the scatterer is not the absorber
+C     I_ABS = 1 : the atom before the scatterer is the absorber
+C     I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
+C
+       IF(ND.EQ.1) THEN
+         I_ABS=1
+       ELSE
+         I_ABS=0
+       ENDIF
+C
+       IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+         NBTYPJ=NATYP(JTYP)
+       ELSE
+         NBTYPJ=1
+       ENDIF
+C
+       DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+          IF(JATL.EQ.IATL) GOTO 12
+          XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
+          YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
+          ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
+          R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+          DIJ=DIJ+R(ND)
+          IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          JPOS(ND,1)=JTYP
+          JPOS(ND,2)=JNUM
+          JPOS(ND,3)=JATL
+          NPATH(ND)=NPATH(ND)+1.
+          IF(ND.GT.1) THEN
+            COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+            IF(IFWD.EQ.1) THEN
+              IF(IBWD(ITYP).EQ.0) THEN
+                IF(COSTHMIJ.LT.COSFWDI) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ELSEIF(IBWD(ITYP).EQ.1) THEN
+                IF((COSTHMIJ.GT.COSBWDI).AND.
+     1                      (COSTHMIJ.LT.-SMALL)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+                IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDIF
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          RHOIJ=VK(JE)*R(ND)
+          CTROIS1=ZR(ND)/R(ND)
+          IF(CTROIS1.GT.1.)  THEN
+            CTROIS1=1.
+          ELSEIF(CTROIS1.LT.-1.) THEN
+            CTROIS1=-1.
+          ENDIF
+          THIJ=ACOS(CTROIS1)
+          COMPL1= XR(ND)+IC*YR(ND)
+          CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
+          IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
+            IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
+            ZSURFI=ZSURF-ZR(ND-1)
+            IF(IDCM.EQ.1) THEN
+              UJ2(ITYP)=SIG2(R(ND-1),ITYP)
+            ENDIF
+            IF(ABS(ZSURFI).LE.SMALL) THEN 
+              IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
+                CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
+     1                  -2.*COSTHMIJ)
+              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_A(ITYP,JE,XK2UI2,TLT,ISPEED)
+            ENDIF
+ 40         IF(IDWSPH.EQ.1) THEN
+              DW(ND-1)=1.
+            ELSE
+              DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
+            ENDIF
+          ENDIF
+          IF(ND.EQ.1) THEN
+            RHO01=RHOIJ
+            TH01=THIJ
+            PHI01=PHIIJ
+            CALL DJMN2(TH01,RLM01,LF2,2)
+            GOTO 30
+          ENDIF
+          IF(IPW.EQ.1) THEN
+            CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
+            PWI=FTHETA*DW(ND-1)/R(ND)
+            PW(ND)=PW(ND-1)*PWI
+            CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+            LMJ=LMAX(ITYP,JE)
+            IF(ND.GT.NCUT) THEN
+              IT(ND)=1
+            ELSE
+              IT(ND)=0
+            ENDIF
+            CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+            CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
+            XMAXT=0.
+            DO LJ=0,LMJ
+              CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
+              DO LF=LF1,LF2,ISTEP_LF
+                PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                XMAXT=AMAX1(XMAXT,CABS(PW1))
+              ENDDO
+            ENDDO
+            IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1         IT(ND)=0
+          ENDIF
+          IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
+          CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
+          CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
+     1                  AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
+  30      CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
+          CEXDW(ND)=CEX(ND)*DW(ND-1)
+          IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+            IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
+              CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
+     1                      PHIIJ,FREF,IJ,DIJ,TAU)
+              NPATH2(ND)=NPATH2(ND)+1.
+            ENDIF
+          ENDIF
+          IF(ND.EQ.NDIF) GOTO 42
+          I_ABS=0
+C
+          IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+            N_TYP=N_PROT
+          ELSE
+            N_TYP=1
+          ENDIF
+C
+          DO KTYP=1,N_TYP
+            ND=ND+1
+            IF(ND.GT.NDIF) GOTO 20
+C
+            IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+              NBTYPK=NATYP(KTYP)
+            ELSE
+              NBTYPK=1
+            ENDIF
+C
+            DO KNUM=1,NBTYPK
+              KATL=NCORR(KNUM,KTYP)
+              IF(KATL.EQ.JATL) GOTO 22
+              JPOS(ND,1)=KTYP
+              JPOS(ND,2)=KNUM
+              JPOS(ND,3)=KATL
+              XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
+              YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
+              ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
+              R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+              DIJ=DIJ+R(ND)
+              IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              RHOJK=R(ND)*VK(JE)
+              NPATH(ND)=NPATH(ND)+1.
+              COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                  ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+              IF(IFWD.EQ.1) THEN
+                IF(IBWD(JTYP).EQ.0) THEN
+                  IF(COSTHIJK.LT.COSFWDJ) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ELSEIF(IBWD(JTYP).EQ.1) THEN
+                  IF((COSTHIJK.GT.COSBWDJ).AND. 
+     1                        (COSTHIJK.LT.-SMALL)) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                  IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
+     1                            THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              CTROIS1=ZR(ND)/R(ND)
+              IF(CTROIS1.GT.1)  THEN
+                CTROIS1=1.
+              ELSEIF(CTROIS1.LT.-1.) THEN
+                CTROIS1=-1.
+              ENDIF
+              THJK=ACOS(CTROIS1)
+              COMPL1= XR(ND)+IC*YR(ND)
+              IF(ND-1.LT.NDIF) THEN
+                IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
+                ZSURFJ=ZSURF-ZR(ND-1)
+                IF(IDCM.EQ.1) THEN
+                  UJ2(JTYP)=SIG2(R(ND-1),JTYP)
+                ENDIF
+                IF(ABS(ZSURFJ).LE.SMALL) THEN
+                  IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
+                    CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
+     1                      -2.*COSTHIJK)
+                  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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                ENDIF
+ 50             IF(IDWSPH.EQ.1) THEN
+                  DW(ND-1)=1.
+                ELSE
+                  DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
+                ENDIF
+              ENDIF
+              IF(IPW.EQ.1) THEN
+                CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
+     1                      JE,FTHETA)
+                PWI=FTHETA*DW(ND-1)/R(ND)
+                PW(ND)=PW(ND-1)*PWI
+                CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+                LMJ=LMAX(JTYP,JE)
+                IF(ND.GT.NCUT) THEN
+                  IT(ND)=1
+                ELSE
+                  IT(ND)=0
+                ENDIF
+                CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+                CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
+                XMAXT=0.
+                DO LJ=0,LMJ
+                  CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
+                  DO LF=LF1,LF2,ISTEP_LF
+                    PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                    XMAXT=AMAX1(XMAXT,CABS(PW1))
+                  ENDDO
+                ENDDO
+                IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1            IT(ND)=0
+              ENDIF
+              IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32 
+              IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+              ENDIF
+              CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
+              IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+              CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
+     1                      ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
+              CEX(ND)=CEXP(IC*RHOJK)/R(ND)
+              CEXDW(ND)=CEX(ND)*DW(ND-1)
+              IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+                IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
+                  CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
+     1                          THJK,PHIJK,FREF,IJ,DIJ,TAU)
+                  NPATH2(ND)=NPATH2(ND)+1.
+                ENDIF
+              ENDIF
+              IF(ND.EQ.NDIF) GOTO 32
+              CALL FINDPATHS2_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
+     1                  THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+  32          DIJ=DIJ-R(ND)
+  22          IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+              IT(ND-1)=0
+              IN(ND-1)=0
+            ENDDO
+  20        CONTINUE
+            ND=ND-1
+          ENDDO
+  42      DIJ=DIJ-R(ND)
+  12      IF(ND.GT.1) THEN
+            IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+            IT(ND-1)=0
+            IN(ND-1)=0
+          ENDIF
+       ENDDO
+       ND=ND-1
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/findpaths2_a.f

@@ -0,0 +1,370 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FINDPATHS2_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
+     1                        PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+C
+C  This routine generates all the paths and filters them according to the
+C      criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH). 
+C      It corresponds to the spin-independent case from a non spin-orbit
+C                    resolved initial core state LI
+C
+C                                          Last modified : 31 Jul 2007
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
+      USE COOR_MOD
+      USE DEBWAL_MOD
+      USE INIT_L_MOD
+      USE PATH_MOD
+      USE ROT_MOD
+      USE TESTPA_MOD
+      USE TESTPB_MOD
+      USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
+     &                IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
+      USE TLDW_MOD
+      USE VARIA_MOD
+C
+      DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
+C
+      COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
+      COMPLEX IC,COMPL1,PW(0:NDIF_M)
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
+C
+      DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
+C
+      IC=(0.,1.)
+      IEULER=1
+C
+      IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
+      IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
+C
+C    I_CP = 0 : all open paths generated
+C    I_CP = 1 : only closed paths generated 
+C
+      IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+        N_TYP=N_PROT
+      ELSE
+        N_TYP=1
+      ENDIF
+C
+      DO JTYP=1,N_TYP
+       IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
+       IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
+       ND=ND+1
+C
+C     I_ABS = 0 : the atom before the scatterer is not the absorber
+C     I_ABS = 1 : the atom before the scatterer is the absorber
+C     I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
+C
+       IF(ND.EQ.1) THEN
+         I_ABS=1
+       ELSE
+         I_ABS=0
+       ENDIF
+C
+       IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+         NBTYPJ=NATYP(JTYP)
+       ELSE
+         NBTYPJ=1
+       ENDIF
+C
+       DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+          IF(JATL.EQ.IATL) GOTO 12
+          XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
+          YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
+          ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
+          R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+          DIJ=DIJ+R(ND)
+          IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          JPOS(ND,1)=JTYP
+          JPOS(ND,2)=JNUM
+          JPOS(ND,3)=JATL
+          NPATH(ND)=NPATH(ND)+1.
+          IF(ND.GT.1) THEN
+            COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+            IF(IFWD.EQ.1) THEN
+              IF(IBWD(ITYP).EQ.0) THEN
+                IF(COSTHMIJ.LT.COSFWDI) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ELSEIF(IBWD(ITYP).EQ.1) THEN
+                IF((COSTHMIJ.GT.COSBWDI).AND.
+     1                      (COSTHMIJ.LT.-SMALL)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+                IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDIF
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          RHOIJ=VK(JE)*R(ND)
+          CTROIS1=ZR(ND)/R(ND)
+          IF(CTROIS1.GT.1.)  THEN
+            CTROIS1=1.
+          ELSEIF(CTROIS1.LT.-1.) THEN
+            CTROIS1=-1.
+          ENDIF
+          THIJ=ACOS(CTROIS1)
+          COMPL1= XR(ND)+IC*YR(ND)
+          CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
+          IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
+            IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
+            ZSURFI=ZSURF-ZR(ND-1)
+            IF(IDCM.EQ.1) THEN
+              UJ2(ITYP)=SIG2(R(ND-1),ITYP)
+            ENDIF
+            IF(ABS(ZSURFI).LE.SMALL) THEN 
+              IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
+                CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
+     1                  -2.*COSTHMIJ)
+              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_A(ITYP,JE,XK2UI2,TLT,ISPEED)
+            ENDIF
+ 40         IF(IDWSPH.EQ.1) THEN
+              DW(ND-1)=1.
+            ELSE
+              DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
+            ENDIF
+          ENDIF
+          IF(ND.EQ.1) THEN
+            RHO01=RHOIJ
+            TH01=THIJ
+            PHI01=PHIIJ
+            CALL DJMN2(TH01,RLM01,LF2,2)
+            GOTO 30
+          ENDIF
+          IF(IPW.EQ.1) THEN
+            CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
+            PWI=FTHETA*DW(ND-1)/R(ND)
+            PW(ND)=PW(ND-1)*PWI
+            CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+            LMJ=LMAX(ITYP,JE)
+            IF(ND.GT.NCUT) THEN
+              IT(ND)=1
+            ELSE
+              IT(ND)=0
+            ENDIF
+            CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+            CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
+            XMAXT=0.
+            DO LJ=0,LMJ
+              CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
+              DO LF=LF1,LF2,ISTEP_LF
+                PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                XMAXT=AMAX1(XMAXT,CABS(PW1))
+              ENDDO
+            ENDDO
+            IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1         IT(ND)=0
+          ENDIF
+          IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
+          CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
+          IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+          CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
+     1                  AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
+  30      CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
+          CEXDW(ND)=CEX(ND)*DW(ND-1)
+          IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+            IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
+              CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
+     1                      PHIIJ,FREF,IJ,DIJ,TAU)
+              NPATH2(ND)=NPATH2(ND)+1.
+            ENDIF
+          ENDIF
+          IF(ND.EQ.NDIF) GOTO 42
+          I_ABS=0
+C
+          IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+            N_TYP=N_PROT
+          ELSE
+            N_TYP=1
+          ENDIF
+C
+          DO KTYP=1,N_TYP
+            ND=ND+1
+            IF(ND.GT.NDIF) GOTO 20
+C
+            IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+              NBTYPK=NATYP(KTYP)
+            ELSE
+              NBTYPK=1
+            ENDIF
+C
+            DO KNUM=1,NBTYPK
+              KATL=NCORR(KNUM,KTYP)
+              IF(KATL.EQ.JATL) GOTO 22
+              JPOS(ND,1)=KTYP
+              JPOS(ND,2)=KNUM
+              JPOS(ND,3)=KATL
+              XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
+              YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
+              ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
+              R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+              DIJ=DIJ+R(ND)
+              IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              RHOJK=R(ND)*VK(JE)
+              NPATH(ND)=NPATH(ND)+1.
+              COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                  ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+              IF(IFWD.EQ.1) THEN
+                IF(IBWD(JTYP).EQ.0) THEN
+                  IF(COSTHIJK.LT.COSFWDJ) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ELSEIF(IBWD(JTYP).EQ.1) THEN
+                  IF((COSTHIJK.GT.COSBWDJ).AND. 
+     1                        (COSTHIJK.LT.-SMALL)) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                  IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
+     1                            THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              CTROIS1=ZR(ND)/R(ND)
+              IF(CTROIS1.GT.1)  THEN
+                CTROIS1=1.
+              ELSEIF(CTROIS1.LT.-1.) THEN
+                CTROIS1=-1.
+              ENDIF
+              THJK=ACOS(CTROIS1)
+              COMPL1= XR(ND)+IC*YR(ND)
+              IF(ND-1.LT.NDIF) THEN
+                IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
+                ZSURFJ=ZSURF-ZR(ND-1)
+                IF(IDCM.EQ.1) THEN
+                  UJ2(JTYP)=SIG2(R(ND-1),JTYP)
+                ENDIF
+                IF(ABS(ZSURFJ).LE.SMALL) THEN
+                  IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
+                    CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
+     1                      -2.*COSTHIJK)
+                  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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                ENDIF
+ 50             IF(IDWSPH.EQ.1) THEN
+                  DW(ND-1)=1.
+                ELSE
+                  DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
+                ENDIF
+              ENDIF
+              IF(IPW.EQ.1) THEN
+                CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
+     1                      JE,FTHETA)
+                PWI=FTHETA*DW(ND-1)/R(ND)
+                PW(ND)=PW(ND-1)*PWI
+                CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+                LMJ=LMAX(JTYP,JE)
+                IF(ND.GT.NCUT) THEN
+                  IT(ND)=1
+                ELSE
+                  IT(ND)=0
+                ENDIF
+                CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+                CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
+                XMAXT=0.
+                DO LJ=0,LMJ
+                  CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
+                  DO LF=LF1,LF2,ISTEP_LF
+                    PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                    XMAXT=AMAX1(XMAXT,CABS(PW1))
+                  ENDDO
+                ENDDO
+                IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1            IT(ND)=0
+              ENDIF
+              IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32 
+              IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+              ENDIF
+              CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
+              IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+              CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
+     1                      ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
+              CEX(ND)=CEXP(IC*RHOJK)/R(ND)
+              CEXDW(ND)=CEX(ND)*DW(ND-1)
+              IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+                IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
+                  CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
+     1                          THJK,PHIJK,FREF,IJ,DIJ,TAU)
+                  NPATH2(ND)=NPATH2(ND)+1.
+                ENDIF
+              ENDIF
+              IF(ND.EQ.NDIF) GOTO 32
+              CALL FINDPATHS3_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
+     1                  THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+  32          DIJ=DIJ-R(ND)
+  22          IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+              IT(ND-1)=0
+              IN(ND-1)=0
+            ENDDO
+  20        CONTINUE
+            ND=ND-1
+          ENDDO
+  42      DIJ=DIJ-R(ND)
+  12      IF(ND.GT.1) THEN
+            IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+            IT(ND-1)=0
+            IN(ND-1)=0
+          ENDIF
+       ENDDO
+       ND=ND-1
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/findpaths3_a.f

@@ -0,0 +1,370 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FINDPATHS3_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
+     1                       PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+C
+C  This routine generates all the paths and filters them according to the
+C      criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH). 
+C      It corresponds to the spin-independent case from a non spin-orbit
+C                    resolved initial core state LI
+C
+C                                          Last modified : 31 Jul 2007
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
+      USE COOR_MOD
+      USE DEBWAL_MOD
+      USE INIT_L_MOD
+      USE PATH_MOD
+      USE ROT_MOD
+      USE TESTPA_MOD
+      USE TESTPB_MOD
+      USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
+     &                IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
+      USE TLDW_MOD
+      USE VARIA_MOD
+C
+      DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
+C
+      COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
+      COMPLEX IC,COMPL1,PW(0:NDIF_M)
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
+C
+      DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
+C
+      IC=(0.,1.)
+      IEULER=1
+C
+      IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
+      IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
+C
+C    I_CP = 0 : all open paths generated
+C    I_CP = 1 : only closed paths generated 
+C
+      IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+        N_TYP=N_PROT
+      ELSE
+        N_TYP=1
+      ENDIF
+C
+      DO JTYP=1,N_TYP
+       IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
+       IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
+       ND=ND+1
+C
+C     I_ABS = 0 : the atom before the scatterer is not the absorber
+C     I_ABS = 1 : the atom before the scatterer is the absorber
+C     I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
+C
+       IF(ND.EQ.1) THEN
+         I_ABS=1
+       ELSE
+         I_ABS=0
+       ENDIF
+C
+       IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+         NBTYPJ=NATYP(JTYP)
+       ELSE
+         NBTYPJ=1
+       ENDIF
+C
+       DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+          IF(JATL.EQ.IATL) GOTO 12
+          XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
+          YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
+          ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
+          R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+          DIJ=DIJ+R(ND)
+          IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          JPOS(ND,1)=JTYP
+          JPOS(ND,2)=JNUM
+          JPOS(ND,3)=JATL
+          NPATH(ND)=NPATH(ND)+1.
+          IF(ND.GT.1) THEN
+            COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+            IF(IFWD.EQ.1) THEN
+              IF(IBWD(ITYP).EQ.0) THEN
+                IF(COSTHMIJ.LT.COSFWDI) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ELSEIF(IBWD(ITYP).EQ.1) THEN
+                IF((COSTHMIJ.GT.COSBWDI).AND.
+     1                      (COSTHMIJ.LT.-SMALL)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+                IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDIF
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          RHOIJ=VK(JE)*R(ND)
+          CTROIS1=ZR(ND)/R(ND)
+          IF(CTROIS1.GT.1.)  THEN
+            CTROIS1=1.
+          ELSEIF(CTROIS1.LT.-1.) THEN
+            CTROIS1=-1.
+          ENDIF
+          THIJ=ACOS(CTROIS1)
+          COMPL1= XR(ND)+IC*YR(ND)
+          CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
+          IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
+            IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
+            ZSURFI=ZSURF-ZR(ND-1)
+            IF(IDCM.EQ.1) THEN
+              UJ2(ITYP)=SIG2(R(ND-1),ITYP)
+            ENDIF
+            IF(ABS(ZSURFI).LE.SMALL) THEN 
+              IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
+                CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
+     1                  -2.*COSTHMIJ)
+              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_A(ITYP,JE,XK2UI2,TLT,ISPEED)
+            ENDIF
+ 40         IF(IDWSPH.EQ.1) THEN
+              DW(ND-1)=1.
+            ELSE
+              DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
+            ENDIF
+          ENDIF
+          IF(ND.EQ.1) THEN
+            RHO01=RHOIJ
+            TH01=THIJ
+            PHI01=PHIIJ
+            CALL DJMN2(TH01,RLM01,LF2,2)
+            GOTO 30
+          ENDIF
+          IF(IPW.EQ.1) THEN
+            CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
+            PWI=FTHETA*DW(ND-1)/R(ND)
+            PW(ND)=PW(ND-1)*PWI
+            CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+            LMJ=LMAX(ITYP,JE)
+            IF(ND.GT.NCUT) THEN
+              IT(ND)=1
+            ELSE
+              IT(ND)=0
+            ENDIF
+            CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+            CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
+            XMAXT=0.
+            DO LJ=0,LMJ
+              CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
+              DO LF=LF1,LF2,ISTEP_LF
+                PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                XMAXT=AMAX1(XMAXT,CABS(PW1))
+              ENDDO
+            ENDDO
+            IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1         IT(ND)=0
+          ENDIF
+          IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
+          CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
+          IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+          CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
+     1                  AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
+  30      CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
+          CEXDW(ND)=CEX(ND)*DW(ND-1)
+          IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+            IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
+              CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
+     1                      PHIIJ,FREF,IJ,DIJ,TAU)
+              NPATH2(ND)=NPATH2(ND)+1.
+            ENDIF
+          ENDIF
+          IF(ND.EQ.NDIF) GOTO 42
+          I_ABS=0
+C
+          IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+            N_TYP=N_PROT
+          ELSE
+            N_TYP=1
+          ENDIF
+C
+          DO KTYP=1,N_TYP
+            ND=ND+1
+            IF(ND.GT.NDIF) GOTO 20
+C
+            IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+              NBTYPK=NATYP(KTYP)
+            ELSE
+              NBTYPK=1
+            ENDIF
+C
+            DO KNUM=1,NBTYPK
+              KATL=NCORR(KNUM,KTYP)
+              IF(KATL.EQ.JATL) GOTO 22
+              JPOS(ND,1)=KTYP
+              JPOS(ND,2)=KNUM
+              JPOS(ND,3)=KATL
+              XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
+              YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
+              ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
+              R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+              DIJ=DIJ+R(ND)
+              IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              RHOJK=R(ND)*VK(JE)
+              NPATH(ND)=NPATH(ND)+1.
+              COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                  ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+              IF(IFWD.EQ.1) THEN
+                IF(IBWD(JTYP).EQ.0) THEN
+                  IF(COSTHIJK.LT.COSFWDJ) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ELSEIF(IBWD(JTYP).EQ.1) THEN
+                  IF((COSTHIJK.GT.COSBWDJ).AND. 
+     1                        (COSTHIJK.LT.-SMALL)) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                  IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
+     1                            THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              CTROIS1=ZR(ND)/R(ND)
+              IF(CTROIS1.GT.1)  THEN
+                CTROIS1=1.
+              ELSEIF(CTROIS1.LT.-1.) THEN
+                CTROIS1=-1.
+              ENDIF
+              THJK=ACOS(CTROIS1)
+              COMPL1= XR(ND)+IC*YR(ND)
+              IF(ND-1.LT.NDIF) THEN
+                IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
+                ZSURFJ=ZSURF-ZR(ND-1)
+                IF(IDCM.EQ.1) THEN
+                  UJ2(JTYP)=SIG2(R(ND-1),JTYP)
+                ENDIF
+                IF(ABS(ZSURFJ).LE.SMALL) THEN
+                  IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
+                    CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
+     1                      -2.*COSTHIJK)
+                  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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                ENDIF
+ 50             IF(IDWSPH.EQ.1) THEN
+                  DW(ND-1)=1.
+                ELSE
+                  DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
+                ENDIF
+              ENDIF
+              IF(IPW.EQ.1) THEN
+                CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
+     1                        JE,FTHETA)
+                PWI=FTHETA*DW(ND-1)/R(ND)
+                PW(ND)=PW(ND-1)*PWI
+                CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+                LMJ=LMAX(JTYP,JE)
+                IF(ND.GT.NCUT) THEN
+                  IT(ND)=1
+                ELSE
+                  IT(ND)=0
+                ENDIF
+                CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+                CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
+                XMAXT=0.
+                DO LJ=0,LMJ
+                  CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
+                  DO LF=LF1,LF2,ISTEP_LF
+                    PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                    XMAXT=AMAX1(XMAXT,CABS(PW1))
+                  ENDDO
+                ENDDO
+                IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1            IT(ND)=0
+              ENDIF
+              IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32 
+              IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+              ENDIF
+              CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
+              IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+              CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
+     1                      ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
+              CEX(ND)=CEXP(IC*RHOJK)/R(ND)
+              CEXDW(ND)=CEX(ND)*DW(ND-1)
+              IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+                IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
+                  CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
+     1                          THJK,PHIJK,FREF,IJ,DIJ,TAU)
+                  NPATH2(ND)=NPATH2(ND)+1.
+                ENDIF
+              ENDIF
+              IF(ND.EQ.NDIF) GOTO 32
+              CALL FINDPATHS4_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
+     1                  THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+  32          DIJ=DIJ-R(ND)
+  22          IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+              IT(ND-1)=0
+              IN(ND-1)=0
+            ENDDO
+  20        CONTINUE
+            ND=ND-1
+          ENDDO
+  42      DIJ=DIJ-R(ND)
+  12      IF(ND.GT.1) THEN
+            IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+            IT(ND-1)=0
+            IN(ND-1)=0
+          ENDIF
+       ENDDO
+       ND=ND-1
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/findpaths4_a.f

@@ -0,0 +1,370 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FINDPATHS4_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
+     1                        PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+C
+C  This routine generates all the paths and filters them according to the
+C      criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH). 
+C      It corresponds to the spin-independent case from a non spin-orbit
+C                    resolved initial core state LI
+C
+C                                          Last modified : 31 Jul 2007
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
+      USE COOR_MOD
+      USE DEBWAL_MOD
+      USE INIT_L_MOD
+      USE PATH_MOD
+      USE ROT_MOD
+      USE TESTPA_MOD
+      USE TESTPB_MOD
+      USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
+     &                IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
+      USE TLDW_MOD
+      USE VARIA_MOD
+C
+      DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
+C
+      COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
+      COMPLEX IC,COMPL1,PW(0:NDIF_M)
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
+C
+      DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
+C
+      IC=(0.,1.)
+      IEULER=1
+C
+      IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
+      IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
+C
+C    I_CP = 0 : all open paths generated
+C    I_CP = 1 : only closed paths generated 
+C
+      IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+        N_TYP=N_PROT
+      ELSE
+        N_TYP=1
+      ENDIF
+C
+      DO JTYP=1,N_TYP
+       IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
+       IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
+       ND=ND+1
+C
+C     I_ABS = 0 : the atom before the scatterer is not the absorber
+C     I_ABS = 1 : the atom before the scatterer is the absorber
+C     I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
+C
+       IF(ND.EQ.1) THEN
+         I_ABS=1
+       ELSE
+         I_ABS=0
+       ENDIF
+C
+       IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+         NBTYPJ=NATYP(JTYP)
+       ELSE
+         NBTYPJ=1
+       ENDIF
+C
+       DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+          IF(JATL.EQ.IATL) GOTO 12
+          XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
+          YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
+          ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
+          R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+          DIJ=DIJ+R(ND)
+          IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          JPOS(ND,1)=JTYP
+          JPOS(ND,2)=JNUM
+          JPOS(ND,3)=JATL
+          NPATH(ND)=NPATH(ND)+1.
+          IF(ND.GT.1) THEN
+            COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+            IF(IFWD.EQ.1) THEN
+              IF(IBWD(ITYP).EQ.0) THEN
+                IF(COSTHMIJ.LT.COSFWDI) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ELSEIF(IBWD(ITYP).EQ.1) THEN
+                IF((COSTHMIJ.GT.COSBWDI).AND.
+     1                      (COSTHMIJ.LT.-SMALL)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+                IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDIF
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          RHOIJ=VK(JE)*R(ND)
+          CTROIS1=ZR(ND)/R(ND)
+          IF(CTROIS1.GT.1.)  THEN
+            CTROIS1=1.
+          ELSEIF(CTROIS1.LT.-1.) THEN
+            CTROIS1=-1.
+          ENDIF
+          THIJ=ACOS(CTROIS1)
+          COMPL1= XR(ND)+IC*YR(ND)
+          CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
+          IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
+            IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
+            ZSURFI=ZSURF-ZR(ND-1)
+            IF(IDCM.EQ.1) THEN
+              UJ2(ITYP)=SIG2(R(ND-1),ITYP)
+            ENDIF
+            IF(ABS(ZSURFI).LE.SMALL) THEN 
+              IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
+                CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
+     1                  -2.*COSTHMIJ)
+              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_A(ITYP,JE,XK2UI2,TLT,ISPEED)
+            ENDIF
+ 40         IF(IDWSPH.EQ.1) THEN
+              DW(ND-1)=1.
+            ELSE
+              DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
+            ENDIF
+          ENDIF
+          IF(ND.EQ.1) THEN
+            RHO01=RHOIJ
+            TH01=THIJ
+            PHI01=PHIIJ
+            CALL DJMN2(TH01,RLM01,LF2,2)
+            GOTO 30
+          ENDIF
+          IF(IPW.EQ.1) THEN
+            CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
+            PWI=FTHETA*DW(ND-1)/R(ND)
+            PW(ND)=PW(ND-1)*PWI
+            CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+            LMJ=LMAX(ITYP,JE)
+            IF(ND.GT.NCUT) THEN
+              IT(ND)=1
+            ELSE
+              IT(ND)=0
+            ENDIF
+            CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+            CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
+            XMAXT=0.
+            DO LJ=0,LMJ
+              CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
+              DO LF=LF1,LF2,ISTEP_LF
+                PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                XMAXT=AMAX1(XMAXT,CABS(PW1))
+              ENDDO
+            ENDDO
+            IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1         IT(ND)=0
+          ENDIF
+          IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
+          CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
+          IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+          CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
+     1                  AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
+  30      CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
+          CEXDW(ND)=CEX(ND)*DW(ND-1)
+          IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+            IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
+              CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
+     1                      PHIIJ,FREF,IJ,DIJ,TAU)
+              NPATH2(ND)=NPATH2(ND)+1.
+            ENDIF
+          ENDIF
+          IF(ND.EQ.NDIF) GOTO 42
+          I_ABS=0
+C
+          IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+            N_TYP=N_PROT
+          ELSE
+            N_TYP=1
+          ENDIF
+C
+          DO KTYP=1,N_TYP
+            ND=ND+1
+            IF(ND.GT.NDIF) GOTO 20
+C
+            IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+              NBTYPK=NATYP(KTYP)
+            ELSE
+              NBTYPK=1
+            ENDIF
+C
+            DO KNUM=1,NBTYPK
+              KATL=NCORR(KNUM,KTYP)
+              IF(KATL.EQ.JATL) GOTO 22
+              JPOS(ND,1)=KTYP
+              JPOS(ND,2)=KNUM
+              JPOS(ND,3)=KATL
+              XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
+              YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
+              ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
+              R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+              DIJ=DIJ+R(ND)
+              IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              RHOJK=R(ND)*VK(JE)
+              NPATH(ND)=NPATH(ND)+1.
+              COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                  ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+              IF(IFWD.EQ.1) THEN
+                IF(IBWD(JTYP).EQ.0) THEN
+                  IF(COSTHIJK.LT.COSFWDJ) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ELSEIF(IBWD(JTYP).EQ.1) THEN
+                  IF((COSTHIJK.GT.COSBWDJ).AND. 
+     1                        (COSTHIJK.LT.-SMALL)) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                  IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
+     1                            THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              CTROIS1=ZR(ND)/R(ND)
+              IF(CTROIS1.GT.1)  THEN
+                CTROIS1=1.
+              ELSEIF(CTROIS1.LT.-1.) THEN
+                CTROIS1=-1.
+              ENDIF
+              THJK=ACOS(CTROIS1)
+              COMPL1= XR(ND)+IC*YR(ND)
+              IF(ND-1.LT.NDIF) THEN
+                IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
+                ZSURFJ=ZSURF-ZR(ND-1)
+                IF(IDCM.EQ.1) THEN
+                  UJ2(JTYP)=SIG2(R(ND-1),JTYP)
+                ENDIF
+                IF(ABS(ZSURFJ).LE.SMALL) THEN
+                  IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
+                    CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
+     1                      -2.*COSTHIJK)
+                  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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                ENDIF
+ 50             IF(IDWSPH.EQ.1) THEN
+                  DW(ND-1)=1.
+                ELSE
+                  DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
+                ENDIF
+              ENDIF
+              IF(IPW.EQ.1) THEN
+                CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
+     1                        JE,FTHETA)
+                PWI=FTHETA*DW(ND-1)/R(ND)
+                PW(ND)=PW(ND-1)*PWI
+                CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+                LMJ=LMAX(JTYP,JE)
+                IF(ND.GT.NCUT) THEN
+                  IT(ND)=1
+                ELSE
+                  IT(ND)=0
+                ENDIF
+                CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+                CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
+                XMAXT=0.
+                DO LJ=0,LMJ
+                  CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
+                  DO LF=LF1,LF2,ISTEP_LF
+                    PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                    XMAXT=AMAX1(XMAXT,CABS(PW1))
+                  ENDDO
+                ENDDO
+                IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1            IT(ND)=0
+              ENDIF
+              IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32 
+              IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+              ENDIF
+              CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
+              IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+              CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
+     1                      ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
+              CEX(ND)=CEXP(IC*RHOJK)/R(ND)
+              CEXDW(ND)=CEX(ND)*DW(ND-1)
+              IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+                IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
+                  CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
+     1                          THJK,PHIJK,FREF,IJ,DIJ,TAU)
+                  NPATH2(ND)=NPATH2(ND)+1.
+                ENDIF
+              ENDIF
+              IF(ND.EQ.NDIF) GOTO 32
+              CALL FINDPATHS5_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
+     1                  THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+  32          DIJ=DIJ-R(ND)
+  22          IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+              IT(ND-1)=0
+              IN(ND-1)=0
+            ENDDO
+  20        CONTINUE
+            ND=ND-1
+          ENDDO
+  42      DIJ=DIJ-R(ND)
+  12      IF(ND.GT.1) THEN
+            IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+            IT(ND-1)=0
+            IN(ND-1)=0
+          ENDIF
+       ENDDO
+       ND=ND-1
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/findpaths5_a.f

@@ -0,0 +1,370 @@
+C
+C=======================================================================
+C
+      SUBROUTINE FINDPATHS5_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
+     1                        PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+C
+C  This routine generates all the paths and filters them according to the
+C      criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH). 
+C      It corresponds to the spin-independent case from a non spin-orbit
+C                    resolved initial core state LI
+C
+C                                          Last modified : 31 Jul 2007
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
+      USE COOR_MOD
+      USE DEBWAL_MOD
+      USE INIT_L_MOD
+      USE PATH_MOD
+      USE ROT_MOD
+      USE TESTPA_MOD
+      USE TESTPB_MOD
+      USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
+     &                IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
+      USE TLDW_MOD
+      USE VARIA_MOD
+C
+      DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
+      DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
+C
+      COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
+      COMPLEX IC,COMPL1,PW(0:NDIF_M)
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
+      COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
+C
+      DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
+C
+      IC=(0.,1.)
+      IEULER=1
+C
+      IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
+      IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
+C
+C    I_CP = 0 : all open paths generated
+C    I_CP = 1 : only closed paths generated 
+C
+      IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+        N_TYP=N_PROT
+      ELSE
+        N_TYP=1
+      ENDIF
+C
+      DO JTYP=1,N_TYP
+       IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
+       IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
+       ND=ND+1
+C
+C     I_ABS = 0 : the atom before the scatterer is not the absorber
+C     I_ABS = 1 : the atom before the scatterer is the absorber
+C     I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
+C
+       IF(ND.EQ.1) THEN
+         I_ABS=1
+       ELSE
+         I_ABS=0
+       ENDIF
+C
+       IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+         NBTYPJ=NATYP(JTYP)
+       ELSE
+         NBTYPJ=1
+       ENDIF
+C
+       DO JNUM=1,NBTYPJ
+          JATL=NCORR(JNUM,JTYP)
+          IF(JATL.EQ.IATL) GOTO 12
+          XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
+          YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
+          ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
+          R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+          DIJ=DIJ+R(ND)
+          IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          JPOS(ND,1)=JTYP
+          JPOS(ND,2)=JNUM
+          JPOS(ND,3)=JATL
+          NPATH(ND)=NPATH(ND)+1.
+          IF(ND.GT.1) THEN
+            COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+            IF(IFWD.EQ.1) THEN
+              IF(IBWD(ITYP).EQ.0) THEN
+                IF(COSTHMIJ.LT.COSFWDI) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ELSEIF(IBWD(ITYP).EQ.1) THEN
+                IF((COSTHMIJ.GT.COSBWDI).AND.
+     1                      (COSTHMIJ.LT.-SMALL)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+                IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
+                  NTHOF=NTHOF+1
+                  IN(ND-1)=1
+                  IF(NTHOF.GT.NTHOUT) THEN
+                    IT(ND-1)=1
+                  ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDIF
+          IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
+          RHOIJ=VK(JE)*R(ND)
+          CTROIS1=ZR(ND)/R(ND)
+          IF(CTROIS1.GT.1.)  THEN
+            CTROIS1=1.
+          ELSEIF(CTROIS1.LT.-1.) THEN
+            CTROIS1=-1.
+          ENDIF
+          THIJ=ACOS(CTROIS1)
+          COMPL1= XR(ND)+IC*YR(ND)
+          CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
+          IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
+            IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
+            ZSURFI=ZSURF-ZR(ND-1)
+            IF(IDCM.EQ.1) THEN
+              UJ2(ITYP)=SIG2(R(ND-1),ITYP)
+            ENDIF
+            IF(ABS(ZSURFI).LE.SMALL) THEN 
+              IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
+                CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
+     1                  -2.*COSTHMIJ)
+              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_A(ITYP,JE,XK2UI2,TLT,ISPEED)
+            ENDIF
+ 40         IF(IDWSPH.EQ.1) THEN
+              DW(ND-1)=1.
+            ELSE
+              DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
+            ENDIF
+          ENDIF
+          IF(ND.EQ.1) THEN
+            RHO01=RHOIJ
+            TH01=THIJ
+            PHI01=PHIIJ
+            CALL DJMN2(TH01,RLM01,LF2,2)
+            GOTO 30
+          ENDIF
+          IF(IPW.EQ.1) THEN
+            CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
+            PWI=FTHETA*DW(ND-1)/R(ND)
+            PW(ND)=PW(ND-1)*PWI
+            CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+            LMJ=LMAX(ITYP,JE)
+            IF(ND.GT.NCUT) THEN
+              IT(ND)=1
+            ELSE
+              IT(ND)=0
+            ENDIF
+            CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+            CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
+            XMAXT=0.
+            DO LJ=0,LMJ
+              CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
+              DO LF=LF1,LF2,ISTEP_LF
+                PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                XMAXT=AMAX1(XMAXT,CABS(PW1))
+              ENDDO
+            ENDDO
+            IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1         IT(ND)=0
+          ENDIF
+          IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
+          CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
+          IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+          CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
+     1                  AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
+  30      CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
+          CEXDW(ND)=CEX(ND)*DW(ND-1)
+          IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+            IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
+              CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
+     1                      PHIIJ,FREF,IJ,DIJ,TAU)
+              NPATH2(ND)=NPATH2(ND)+1.
+            ENDIF
+          ENDIF
+          IF(ND.EQ.NDIF) GOTO 42
+          I_ABS=0
+C
+          IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
+            N_TYP=N_PROT
+          ELSE
+            N_TYP=1
+          ENDIF
+C
+          DO KTYP=1,N_TYP
+            ND=ND+1
+            IF(ND.GT.NDIF) GOTO 20
+C
+            IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
+              NBTYPK=NATYP(KTYP)
+            ELSE
+              NBTYPK=1
+            ENDIF
+C
+            DO KNUM=1,NBTYPK
+              KATL=NCORR(KNUM,KTYP)
+              IF(KATL.EQ.JATL) GOTO 22
+              JPOS(ND,1)=KTYP
+              JPOS(ND,2)=KNUM
+              JPOS(ND,3)=KATL
+              XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
+              YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
+              ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
+              R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
+              DIJ=DIJ+R(ND)
+              IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              RHOJK=R(ND)*VK(JE)
+              NPATH(ND)=NPATH(ND)+1.
+              COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
+     1                  ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
+              IF(IFWD.EQ.1) THEN
+                IF(IBWD(JTYP).EQ.0) THEN
+                  IF(COSTHIJK.LT.COSFWDJ) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ELSEIF(IBWD(JTYP).EQ.1) THEN
+                  IF((COSTHIJK.GT.COSBWDJ).AND. 
+     1                        (COSTHIJK.LT.-SMALL)) THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                  IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
+     1                            THEN
+                    NTHOF=NTHOF+1
+                    IN(ND-1)=1
+                    IF(NTHOF.GT.NTHOUT) THEN
+                      IT(ND-1)=1
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF
+              IF(IT(ND-1).EQ.1) GOTO 32 
+              CTROIS1=ZR(ND)/R(ND)
+              IF(CTROIS1.GT.1)  THEN
+                CTROIS1=1.
+              ELSEIF(CTROIS1.LT.-1.) THEN
+                CTROIS1=-1.
+              ENDIF
+              THJK=ACOS(CTROIS1)
+              COMPL1= XR(ND)+IC*YR(ND)
+              IF(ND-1.LT.NDIF) THEN
+                IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
+                ZSURFJ=ZSURF-ZR(ND-1)
+                IF(IDCM.EQ.1) THEN
+                  UJ2(JTYP)=SIG2(R(ND-1),JTYP)
+                ENDIF
+                IF(ABS(ZSURFJ).LE.SMALL) THEN
+                  IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
+                    CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
+     1                      -2.*COSTHIJK)
+                  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_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
+                ENDIF
+ 50             IF(IDWSPH.EQ.1) THEN
+                  DW(ND-1)=1.
+                ELSE
+                  DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
+                ENDIF
+              ENDIF
+              IF(IPW.EQ.1) THEN
+                CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
+     1                        JE,FTHETA)
+                PWI=FTHETA*DW(ND-1)/R(ND)
+                PW(ND)=PW(ND-1)*PWI
+                CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+                LMJ=LMAX(JTYP,JE)
+                IF(ND.GT.NCUT) THEN
+                  IT(ND)=1
+                ELSE
+                  IT(ND)=0
+                ENDIF
+                CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
+                CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
+                XMAXT=0.
+                DO LJ=0,LMJ
+                  CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
+                  DO LF=LF1,LF2,ISTEP_LF
+                    PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
+                    XMAXT=AMAX1(XMAXT,CABS(PW1))
+                  ENDDO
+                ENDDO
+                IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
+     1            IT(ND)=0
+              ENDIF
+              IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32 
+              IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
+                CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
+              ENDIF
+              CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
+              IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
+              CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
+     1                      ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
+              CEX(ND)=CEXP(IC*RHOJK)/R(ND)
+              CEXDW(ND)=CEX(ND)*DW(ND-1)
+              IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
+                IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
+                  CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
+     1                          THJK,PHIJK,FREF,IJ,DIJ,TAU)
+                  NPATH2(ND)=NPATH2(ND)+1.
+                ENDIF
+              ENDIF
+              IF(ND.EQ.NDIF) GOTO 32
+c              CALL FINDPATHS_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
+c     1                  THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
+  32          DIJ=DIJ-R(ND)
+  22          IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+              IT(ND-1)=0
+              IN(ND-1)=0
+            ENDDO
+  20        CONTINUE
+            ND=ND-1
+          ENDDO
+  42      DIJ=DIJ-R(ND)
+  12      IF(ND.GT.1) THEN
+            IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
+            IT(ND-1)=0
+            IN(ND-1)=0
+          ENDIF
+       ENDDO
+       ND=ND-1
+      ENDDO
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_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_AED_MU_SE()
+        CALL CLOSE_ALL_FILES()
+
+      END SUBROUTINE RUN

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/matdif_a.f

@@ -0,0 +1,349 @@
+C
+C=======================================================================
+C
+      SUBROUTINE MATDIF_A(NO,ND,LF,JTYP,KTYP,JE,I_ABS,ISPEED,ISPHER,
+     1                      A21,B21,C21,RHO1,RHO2)
+C
+C  This routine calculates the Rehr-Albers scattering matrix 
+C     F_{LAMBDA1,LAMBDA2}. The result is stored in the COMMON block 
+C     /SCATMAT/ as F21(NSPIN2_M,NLAMBDA_M,NLAMBDA_M,NDIF_M). It is more 
+C     specifically designed for the Auger electron.
+C
+C                                         Last modified :  3 Aug 2007
+C
+      USE DIM_MOD
+C
+      USE EXPFAC_MOD
+      USE LBD_MOD
+      USE LINLBD_MOD
+      USE RA_MOD
+      USE SCATMAT_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, 
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
+     &                LMAX => LMAX_A
+      USE TLDW_MOD
+C
+      REAL RLM(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
+C
+      COMPLEX HLM1(0:NO_ST_M,0:NL_M-1),HLM2(0:NO_ST_M,0:NL_M-1)
+      COMPLEX SL,RHO1,RHO2,IC,ZEROC,ONEC,ONEOVK
+      COMPLEX SL_2_1,SL_2_2
+      COMPLEX EXP1,EXP2,PROD1,PROD2
+C
+      DATA PI,SMALL /3.141593,0.0001/
+C
+      IC=(0.,1.)
+      ZEROC=(0.,0.)
+      ONEC=(1.,0.)
+      ONEOVK=1./VK(JE)
+      IB=0
+      LMJ=LMAX(JTYP,JE)
+      IF(ABS(ABS(B21)-PI).LT.SMALL) IB=-1
+      IF(ABS(B21).LT.SMALL) IB=1
+      IF(NO.EQ.8) THEN
+        NN2=LMAX(JTYP,JE)+1
+      ELSE
+        NN2=NO
+      ENDIF
+C
+C  NO is atom-dependent and is decreased with the rank of the scatterer
+C    in the path when I_NO > 0. Here LAMBDA1 depends on the scatterer JTYP
+C    while LAMBDA2 depends on the next atom (KTYP) in the path
+C
+      IF(I_NO.EQ.0) THEN
+        NO1=N_RA(JTYP)
+        NO2=N_RA(KTYP)
+      ELSE
+        NO1=MAX(N_RA(JTYP)-(ND-1)/I_NO,0)
+        NO2=MAX(N_RA(KTYP)-ND/I_NO,0)
+      ENDIF
+      IF(I_ABS.EQ.0) THEN
+        NUMAX1=NO1/2
+        NUMAX2=NO2/2
+      ELSEIF(I_ABS.EQ.1) THEN
+        NUMAX1=MIN0(LF,NO1/2)
+        NUMAX2=NO2/2
+      ELSEIF(I_ABS.EQ.2) THEN
+        NUMAX1=NO1/2
+        NUMAX2=MIN0(LF,NO2/2)
+      ENDIF
+      LBDM(1,ND)=(NO1+1)*(NO1+2)/2
+      LBDM(2,ND)=(NO2+1)*(NO2+2)/2
+C
+      EXP2=-EXP(-IC*A21)
+      EXP1=EXP(-IC*C21)
+C
+      DO LAMBDA1=1,LBDMAX
+        DO LAMBDA2=1,LBDMAX
+          F21(1,LAMBDA2,LAMBDA1,ND)=ZEROC
+        ENDDO
+      ENDDO
+C
+      IF(ABS(RHO1-RHO2).GT.SMALL) THEN
+         CALL POLHAN(ISPHER,NUMAX1,LMJ,RHO1,HLM1)
+         CALL POLHAN(ISPHER,NN2,LMJ,RHO2,HLM2)
+         NEQUAL=0
+      ELSE
+         CALL POLHAN(ISPHER,NN2,LMJ,RHO1,HLM1)
+         NEQUAL=1
+      ENDIF
+C
+C  Calculation of the scattering matrix when the scattering angle
+C              is different from 0 and pi
+C
+      IF(IB.EQ.0) THEN
+        CALL DJMN(B21,RLM,LMJ)
+        DO NU1=0,NUMAX1
+          MUMAX1=NO1-2*NU1
+          IF(I_ABS.EQ.1) MUMAX1=MIN(LF-NU1,MUMAX1)
+          DO NU2=0,NUMAX2
+            MUMAX2=NO2-2*NU2
+C
+C  Case MU1 = 0
+C
+            LAMBDA1=LBD(0,NU1)
+C
+C    Case MU2 = 0
+C
+            LAMBDA2=LBD(0,NU2)
+            LMIN=MAX(NU1,NU2)
+            SL=ZEROC
+            DO L=LMIN,LMJ
+              IF(NEQUAL.EQ.1) THEN 
+                HLM2(NU2,L)=HLM1(NU2,L)
+              ENDIF
+              IF(ISPEED.EQ.1) THEN
+                SL=SL+FLOAT(L+L+1)*RLM(0,0,L)*
+     1               TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+              ELSE
+                SL=SL+FLOAT(L+L+1)*RLM(0,0,L)*
+     1               TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+              ENDIF
+            ENDDO
+            F21(1,LAMBDA2,LAMBDA1,ND)=SL*ONEOVK
+C
+C    Case MU2 > 0
+C
+            PROD2=ONEC
+            SIG2=1.
+            DO MU2=1,MUMAX2
+              LAMBDA2_1=LBD(MU2,NU2)
+              LAMBDA2_2=LBD(-MU2,NU2)
+              PROD2=PROD2*EXP2
+              SIG2=-SIG2
+              LMIN=MAX(NU1,MU2+NU2)
+              SL=ZEROC
+              DO L=LMIN,LMJ
+                IF(NEQUAL.EQ.1) THEN 
+                  HLM2(MU2+NU2,L)=HLM1(MU2+NU2,L)
+                ENDIF
+                C1=EXPF(0,L)/EXPF(MU2,L)
+                IF(ISPEED.EQ.1) THEN
+                  SL=SL+FLOAT(L+L+1)*RLM(MU2,0,L)*C1*
+     1                 TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU2+NU2,L)
+                ELSE
+                  SL=SL+FLOAT(L+L+1)*RLM(MU2,0,L)*C1*
+     1                 TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU2+NU2,L)
+                ENDIF
+              ENDDO
+              F21(1,LAMBDA2_1,LAMBDA1,ND)=SL*PROD2*ONEOVK*SIG2
+              F21(1,LAMBDA2_2,LAMBDA1,ND)=SL*ONEOVK/PROD2
+            ENDDO
+C
+C  Case MU1 > 0
+C
+            PROD1=ONEC
+            SIG1=1.
+            DO MU1=1,MUMAX1
+              LAMBDA1_1=LBD(MU1,NU1)
+              LAMBDA1_2=LBD(-MU1,NU1)
+              PROD1=PROD1*EXP1
+              SIG1=-SIG1
+C
+C    Case MU2 = 0
+C
+              LAMBDA2=LBD(0,NU2)
+              LMIN=MAX(MU1,NU1,NU2)
+              SL=ZEROC
+              DO L=LMIN,LMJ
+                IF(NEQUAL.EQ.1) THEN 
+                  HLM2(NU2,L)=HLM1(NU2,L)
+                ENDIF
+                C1=EXPF(MU1,L)/EXPF(0,L)
+                IF(ISPEED.EQ.1) THEN
+                  SL=SL+FLOAT(L+L+1)*RLM(0,MU1,L)*C1*
+     1                 TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+                ELSE
+                  SL=SL+FLOAT(L+L+1)*RLM(0,MU1,L)*C1*
+     1                 TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+                ENDIF
+              ENDDO
+              F21(1,LAMBDA2,LAMBDA1_1,ND)=SL*PROD1*ONEOVK*SIG1
+              F21(1,LAMBDA2,LAMBDA1_2,ND)=SL*ONEOVK/PROD1
+C
+C    Case MU2 > 0
+C
+              PROD2=ONEC
+              SIG2=SIG1
+              DO MU2=1,MUMAX2
+                LAMBDA2_1=LBD(MU2,NU2)
+                LAMBDA2_2=LBD(-MU2,NU2)
+                PROD2=PROD2*EXP2
+                SIG2=-SIG2
+                LMIN=MAX(MU1,NU1,MU2+NU2)
+                SL_2_1=ZEROC
+                SL_2_2=ZEROC
+                DO L=LMIN,LMJ
+                  IF(NEQUAL.EQ.1) THEN 
+                    HLM2(MU2+NU2,L)=HLM1(MU2+NU2,L)
+                  ENDIF
+                  C1=EXPF(MU1,L)/EXPF(MU2,L)
+                  IF(ISPEED.EQ.1) THEN
+                    SL=FLOAT(L+L+1)*C1*TL(L,1,JTYP,JE)*
+     1                   HLM1(NU1,L)*HLM2(MU2+NU2,L)
+                  ELSE
+                    SL=FLOAT(L+L+1)*C1*TLT(L,1,JTYP,JE)*
+     1                   HLM1(NU1,L)*HLM2(MU2+NU2,L)
+                  ENDIF
+                  SL_2_1=SL_2_1+SL*RLM(MU2,-MU1,L)
+                  SL_2_2=SL_2_2+SL*RLM(MU2,MU1,L)
+                ENDDO
+                F21(1,LAMBDA2_1,LAMBDA1_1,ND)=SL_2_2*PROD1*PROD2*
+     1                                          ONEOVK*SIG2
+                F21(1,LAMBDA2_2,LAMBDA1_1,ND)=SL_2_1*PROD1
+     1                                          *ONEOVK/PROD2
+                F21(1,LAMBDA2_1,LAMBDA1_2,ND)=SL_2_1*ONEOVK*PROD2*SIG2/
+     1                                          PROD1
+                F21(1,LAMBDA2_2,LAMBDA1_2,ND)=SL_2_2*ONEOVK/
+     1                                          (PROD1*PROD2)
+
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDDO
+C
+C  Calculation of the scattering matrix when the scattering angle
+C     is equal to 0 (forward scattering) or pi (backscattering)
+C
+      ELSEIF(IB.EQ.1) THEN
+        DO NU1=0,NUMAX1
+          DO NU2=0,NUMAX2
+            MUMAX1=MIN0(NO1-2*NU1,NO1-2*NU2)
+            IF(I_ABS.EQ.1) MUMAX1=MIN0(LF-NU1,MUMAX1)
+C
+C  Case MU = 0
+C
+            LAMBDA1=LBD(0,NU1)
+            LAMBDA2=LBD(0,NU2)
+            LMIN=MAX(NU1,NU2)
+            SL=ZEROC
+            DO L=LMIN,LMJ
+              IF(NEQUAL.EQ.1) THEN
+                 HLM2(NU2,L)=HLM1(NU2,L)
+              ENDIF
+              IF(ISPEED.EQ.1) THEN
+                SL=SL+FLOAT(L+L+1)*
+     1             TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+              ELSE
+                SL=SL+FLOAT(L+L+1)*
+     1             TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+              ENDIF
+            ENDDO
+            F21(1,LAMBDA2,LAMBDA1,ND)=SL*ONEOVK
+C
+C  Case MU > 0
+C
+            CST1=1.
+            DO MU=1,MUMAX1
+              LAMBDA1=LBD(MU,NU2)
+              LAMBDA2=LBD(-MU,NU2)
+              CST1=-CST1
+              LMIN=MAX(NU1,MU+NU2)
+              SL=ZEROC
+              DO L=LMIN,LMJ
+                IF(NEQUAL.EQ.1) THEN
+                   HLM2(MU+NU2,L)=HLM1(MU+NU2,L)
+                ENDIF
+                IF(ISPEED.EQ.1) THEN
+                  SL=SL+FLOAT(L+L+1)*CST1
+     1               *TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
+                ELSE
+                  SL=SL+FLOAT(L+L+1)*CST1
+     1               *TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
+                ENDIF
+              ENDDO
+              F21(1,LAMBDA1,LAMBDA1,ND)=SL*ONEOVK
+              F21(1,LAMBDA2,LAMBDA2,ND)=SL*ONEOVK
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSEIF(IB.EQ.-1) THEN
+        DO NU1=0,NUMAX1
+          DO NU2=0,NUMAX2
+            MUMAX1=MIN0(NO1-2*NU1,NO1-2*NU2)
+            IF(I_ABS.EQ.1) MUMAX1=MIN0(LF-NU1,MUMAX1)
+C
+C  Case MU = 0
+C
+            LAMBDA1=LBD(0,NU1)
+            LAMBDA2=LBD(0,NU2)
+            LMIN=MAX(NU1,NU2)
+            SL=ZEROC
+            DO L=LMIN,LMJ
+              IF(NEQUAL.EQ.1) THEN
+                 HLM2(NU2,L)=HLM1(NU2,L)
+              ENDIF
+              IF(MOD(L,2).EQ.0) THEN
+                CST2=1.0
+              ELSE
+                CST2=-1.0
+              ENDIF
+              IF(ISPEED.EQ.1) THEN
+                SL=SL+FLOAT(L+L+1)*CST2
+     1             *TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+              ELSE
+                SL=SL+FLOAT(L+L+1)*CST2
+     1             *TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
+              ENDIF
+            ENDDO
+            F21(1,LAMBDA2,LAMBDA1,ND)=SL*ONEOVK
+C
+C  Case MU > 0
+C
+            CST1=1.
+            DO MU=1,MUMAX1
+              MUP=-MU
+              LAMBDA1_1=LBD(MUP,NU1)
+              LAMBDA1_2=LBD(-MUP,NU1)
+              LAMBDA2_1=LBD(MU,NU2)
+              LAMBDA2_2=LBD(-MU,NU2)
+              CST1=-CST1
+              LMIN=MAX(NU1,MU+NU2)
+              SL=ZEROC
+              DO L=LMIN,LMJ
+                IF(NEQUAL.EQ.1) THEN
+                   HLM2(MU+NU2,L)=HLM1(MU+NU2,L)
+                ENDIF
+                IF(MOD(L,2).EQ.0) THEN
+                  CST2=CST1
+                ELSE
+                  CST2=-CST1
+                ENDIF
+                IF(ISPEED.EQ.1) THEN
+                  SL=SL+FLOAT(L+L+1)*CST2
+     1               *TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
+                ELSE
+                  SL=SL+FLOAT(L+L+1)*CST2
+     1               *TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
+                ENDIF
+              ENDDO
+              F21(1,LAMBDA2_1,LAMBDA1_1,ND)=SL*ONEOVK
+              F21(1,LAMBDA2_2,LAMBDA1_2,ND)=SL*ONEOVK
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+C
+      RETURN
+C
+      END 

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/pathop_a.f

@@ -0,0 +1,551 @@
+C
+C=======================================================================
+C
+      SUBROUTINE PATHOP_A(JPOS,JORDP,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
+     1                    PHIIJ,FREF,IJ,D,TAU)
+C
+C  This subroutine calculates the contribution of a given path to 
+C    the scattering path operator TAU. It is designed for the Auger
+C    electron
+C
+C                                           Last modified :  3 Aug 2007
+C
+      USE DIM_MOD
+C
+      USE APPROX_MOD
+      USE EXPFAC_MOD
+      USE EXTREM_MOD
+      USE INIT_L_MOD
+      USE INIT_J_MOD
+      USE LBD_MOD
+      USE LINLBD_MOD
+      USE OUTUNITS_MOD
+      USE PATH_MOD
+      USE PRINTP_MOD
+      USE RA_MOD
+      USE ROT_MOD
+      USE SCATMAT_MOD, F => F21
+      USE TESTS_MOD
+      USE TLDW_MOD
+      USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, 
+     &                VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
+     &                LMAX => LMAX_A
+      USE VARIA_MOD
+C
+      INTEGER JPOS(NDIF_M,3),AMU1
+C
+      REAL RLMIJ(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
+C
+      COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
+      COMPLEX H(NLAMBDA_M,NLAMBDA_M)
+      COMPLEX G(NLAMBDA_M,NLAMBDA_M)
+      COMPLEX HLM01(0:NO_ST_M,0:NL_M-1),HLMIJ(0:NO_ST_M,0:NL_M-1)
+      COMPLEX SUM_NUJ_0,SUM_MUJ_0,SUM_NU1_0
+      COMPLEX SUM_NUJ_1,SUM_MUJ_1,SUM_NU1_1
+      COMPLEX SUM_NU1_2,SUM_NU1_3
+      COMPLEX RHO01,RHOIJ
+      COMPLEX RLMF_0,RLMF_1
+      COMPLEX CF,CJ,OVK
+      COMPLEX EXP_J,EXP_F,SUM_1
+      COMPLEX TL_J
+      COMPLEX COEF,ONEC,ZEROC
+C
+      DATA PI,XCOMP /3.141593,1.E-10/
+C
+      ZEROC=(0.,0.)
+      ONEC=(1.,0.)
+C
+      OVK=(1.,0.)/VK(JE)
+      IF(NPATHP.GT.0) THEN
+        FM1=FMIN(JORDP)
+        XMAX=0.
+      ENDIF
+      EXP_J=CEXP((0.,-1.)*(PHIIJ-PI))
+      EXP_F=CEXP((0.,1.)*PHI01)
+      JTYP=JPOS(JORDP,1)
+      ITYP=JPOS(1,1)
+      JATL=JPOS(JORDP,3)
+      IF(I_CP.EQ.0) THEN
+        LMJ=LMAX(JTYP,JE)
+      ELSE
+        LMJ=LF2
+      ENDIF
+      IF(NO.EQ.8) THEN
+        NN2=LMJ+1
+      ELSE
+        NN2=NO
+      ENDIF
+      IF(NO.GT.LF2) THEN
+        NN=LF2
+      ELSE
+        NN=NO
+      ENDIF
+C
+C  NO is atom-dependent and is decreased with the rank of the scatterer
+C    in the path when I_NO > 0 (except for the first scatterer ITYP for 
+C    which there is no such decrease)
+C
+      NO1=N_RA(ITYP)
+      IF(I_NO.EQ.0) THEN
+        IF(IJ.EQ.1) THEN
+          NOJ=N_RA(JTYP)
+        ELSE
+          NOJ=0
+        ENDIF
+      ELSE
+        IF(IJ.EQ.1) THEN
+          NOJ= MAX(N_RA(JTYP)-(JORDP-1)/I_NO,0)
+        ELSE
+          NOJ=0
+        ENDIF
+      ENDIF
+      NUMX=NO1/2
+      NUMAXJ=NOJ/2
+C
+C   Calculation of the attenuation coefficients along the path
+C
+      COEF=CEX(1)*OVK
+      DO JSC=2,JORDP
+        COEF=COEF*CEXDW(JSC)
+      ENDDO
+C
+C   Call of the subroutines used for the R-A termination matrix
+C      This termination matrix is now merged into PATHOP
+C
+      CALL DJMN2(-THIJ,RLMIJ,LMJ,1)
+      CALL POLHAN(ISPHER,NN,LF2,RHO01,HLM01)
+      CALL POLHAN(ISPHER,NN2,LMJ,RHOIJ,HLMIJ)
+C
+      LBD1M1=LBDM(1,1)
+      LBD1M2=LBDM(2,1)
+C
+C   Calculation of the L-independent part of TAU, called H
+C
+      IF(JORDP.GE.3) THEN
+        DO JPAT=2,JORDP-1
+          LBD2M=LBDM(1,JPAT)
+          LBD3M=LBDM(2,JPAT)
+          DO LAMBDA1=1,LBD1M1
+            DO LAMBDA3=1,LBD3M
+              SUM_1=ZEROC
+              DO LAMBDA2=1,LBD2M
+                IF(JPAT.GT.2) THEN
+                  SUM_1=SUM_1+H(LAMBDA2,LAMBDA1)*
+     1                        F(1,LAMBDA3,LAMBDA2,JPAT)
+                ELSE
+                  SUM_1=SUM_1+F(1,LAMBDA2,LAMBDA1,1)*
+     1                        F(1,LAMBDA3,LAMBDA2,2)
+                ENDIF
+              ENDDO
+              G(LAMBDA3,LAMBDA1)=SUM_1
+            ENDDO
+          ENDDO
+          DO LAMBDA1=1,LBD1M1
+            DO LAMBDA2=1,LBD3M
+              H(LAMBDA2,LAMBDA1)=G(LAMBDA2,LAMBDA1)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSEIF(JORDP.EQ.2) THEN
+        DO LAMBDA1=1,LBD1M1
+          DO LAMBDA2=1,LBD1M2
+            H(LAMBDA2,LAMBDA1)=F(1,LAMBDA2,LAMBDA1,1)
+          ENDDO
+        ENDDO
+      ELSEIF(JORDP.EQ.1) THEN
+        DO LAMBDA1=1,LBD1M1
+          DO LAMBDA2=1,LBD1M1
+            H(LAMBDA2,LAMBDA1)=ONEC
+          ENDDO
+        ENDDO
+      ENDIF
+C
+C   Calculation of the path operator TAU 
+C
+      DO LF=LF1,LF2,ISTEP_LF
+        ILF=LF*LF+LF+1
+C                 
+        NU1MAX1=MIN(LF,NUMX)
+C
+C  Case MF = 0
+C
+        DO LJ=0,LMJ
+          ILJ=LJ*LJ+LJ+1
+          NUJMAX=MIN(LJ,NUMAXJ)
+          IF(JORDP.EQ.1) THEN 
+            NU1MAX=MIN(NU1MAX1,LJ)
+          ELSE
+            NU1MAX=NU1MAX1
+          ENDIF
+C
+          IF(ISPEED.EQ.1) THEN
+            TL_J=COEF*TL(LF,1,1,JE)*TL(LJ,1,JTYP,JE)
+          ELSE
+            TL_J=COEF*TLT(LF,1,1,JE)*TLT(LJ,1,JTYP,JE)
+          ENDIF
+C
+C    Case MJ = 0
+C
+          SUM_NU1_0=ZEROC
+C
+          DO NU1=0,NU1MAX
+            IF(JORDP.GT.1) THEN
+              MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
+            ELSE
+              MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ) 
+            ENDIF
+C
+            DO MU1=-MU1MAX,MU1MAX
+              LAMBDA1=LBD(MU1,NU1)
+              AMU1=ABS(MU1)
+C
+              RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,0,LF)
+C
+              SUM_NUJ_0=ZEROC
+C
+              IF(JORDP.GT.1) THEN
+                DO NUJ=0,NUJMAX
+                  MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
+C
+                  SUM_MUJ_0=ZEROC
+C
+                  DO MUJ=-MUJMAX,MUJMAX
+C
+                    LAMBDAJ=LBD(MUJ,NUJ)
+C
+                    SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
+     1                                      RLMIJ(MUJ,0,LJ)
+
+                  ENDDO
+C
+                  SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
+C
+                ENDDO
+              ELSE
+                SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,0,LJ)
+              ENDIF
+C
+              SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
+C
+            ENDDO
+C
+          ENDDO
+C
+          TAU(ILJ,ILF,JATL)=TAU(ILJ,ILF,JATL)+
+     1                                  TL_J*SUM_NU1_0
+C
+          IF(NPATHP.EQ.0) GOTO 35
+C
+          FM2=FMAX(JORDP)
+          XINT=CABS(TL_J*SUM_NU1_0)
+          XMAX=AMAX1(XINT,XMAX)
+          FMAX(JORDP)=AMAX1(FM2,XINT)
+          IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
+     1       NPATH(JORDP)
+          IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
+              FREF=FMAX(JORDP)
+          ENDIF
+ 35       CONTINUE
+C
+C    Case MJ > 0
+C
+          CJ=ONEC
+          DO MJ=1,LJ
+            INDJ=ILJ+MJ
+            INDJP=ILJ-MJ
+            CJ=CJ*EXP_J
+C
+            SUM_NU1_0=ZEROC
+            SUM_NU1_1=ZEROC
+C
+            DO NU1=0,NU1MAX
+              IF(JORDP.GT.1) THEN
+                MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
+              ELSE
+                MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ) 
+              ENDIF
+C
+              DO MU1=-MU1MAX,MU1MAX
+                LAMBDA1=LBD(MU1,NU1)
+                AMU1=ABS(MU1)
+C
+                RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,0,LF)
+C
+                SUM_NUJ_0=ZEROC
+                SUM_NUJ_1=ZEROC
+C
+                IF(JORDP.GT.1) THEN
+                  DO NUJ=0,NUJMAX
+                    MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
+C
+                    SUM_MUJ_0=ZEROC
+                    SUM_MUJ_1=ZEROC
+C
+                    DO MUJ=-MUJMAX,MUJMAX
+C
+                      LAMBDAJ=LBD(MUJ,NUJ)
+C
+                      SUM_MUJ_1=SUM_MUJ_1+H(LAMBDAJ,LAMBDA1)*
+     1                                    RLMIJ(MUJ,-MJ,LJ)
+                      SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
+     1                                    RLMIJ(MUJ,MJ,LJ)
+C
+                    ENDDO
+C
+                    SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
+                    SUM_NUJ_1=SUM_NUJ_1+SUM_MUJ_1*HLMIJ(NUJ,LJ)
+C
+                  ENDDO
+                ELSE
+                  SUM_NUJ_1=HLMIJ(NU1,LJ)*RLMIJ(MU1,-MJ,LJ)
+                  SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,MJ,LJ)
+                ENDIF
+C
+                SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
+                SUM_NU1_1=SUM_NU1_1+RLMF_0*SUM_NUJ_1
+C
+              ENDDO
+C
+            ENDDO
+C
+            TAU(INDJP,ILF,JATL)=TAU(INDJP,ILF,JATL)+
+     1                                  CONJG(CJ)*TL_J*SUM_NU1_1
+            TAU(INDJ,ILF,JATL)=TAU(INDJ,ILF,JATL)+
+     1                                  CJ*TL_J*SUM_NU1_0
+C
+            IF(NPATHP.EQ.0) GOTO 45
+C
+            FM2=FMAX(JORDP)
+            XINT1=CABS(CJ*TL_J*SUM_NU1_0)
+            XINT2=CABS(CONJG(CJ)*TL_J*SUM_NU1_1)
+            XMAX=AMAX1(XINT1,XINT2,XMAX)
+            FMAX(JORDP)=AMAX1(FM2,XINT1,XINT2)
+            IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
+     1           NPATH(JORDP)
+            IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
+                FREF=FMAX(JORDP)
+            ENDIF
+ 45         CONTINUE
+          ENDDO
+        ENDDO
+C
+C  Case MF > 0
+C
+        CF=ONEC
+        DO MF=1,LF
+          INDF=ILF+MF
+          INDFP=ILF-MF
+          CF=CF*EXP_F
+C
+          DO LJ=0,LMJ
+            ILJ=LJ*LJ+LJ+1
+            NUJMAX=MIN(LJ,NUMAXJ)
+            IF(JORDP.EQ.1) THEN 
+              NU1MAX=MIN(NU1MAX1,LJ)
+            ELSE
+              NU1MAX=NU1MAX1
+            ENDIF
+C
+            IF(ISPEED.EQ.1) THEN
+              TL_J=COEF*TL(LF,1,1,JE)*TL(LJ,1,JTYP,JE)
+            ELSE
+              TL_J=COEF*TLT(LF,1,1,JE)*TLT(LJ,1,JTYP,JE)
+            ENDIF
+C
+C    Case MJ = 0
+C
+            SUM_NU1_0=ZEROC
+            SUM_NU1_1=ZEROC
+C
+            DO NU1=0,NU1MAX
+              IF(JORDP.GT.1) THEN
+                MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
+              ELSE
+                MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ) 
+              ENDIF
+C
+              DO MU1=-MU1MAX,MU1MAX
+                LAMBDA1=LBD(MU1,NU1)
+                AMU1=ABS(MU1)
+C
+                RLMF_1=HLM01(AMU1+NU1,LF)*RLM01(MU1,-MF,LF)
+                RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,MF,LF)
+C
+                SUM_NUJ_0=ZEROC
+C
+                IF(JORDP.GT.1) THEN
+                  DO NUJ=0,NUJMAX
+                    MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
+C
+                    SUM_MUJ_0=ZEROC
+C
+                    DO MUJ=-MUJMAX,MUJMAX
+C
+                      LAMBDAJ=LBD(MUJ,NUJ)
+C
+                      SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
+     1                                        RLMIJ(MUJ,0,LJ)          
+C
+                    ENDDO
+C
+                    SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
+C
+                  ENDDO
+                ELSE
+                  SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,0,LJ)
+                ENDIF
+C
+                SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
+                SUM_NU1_1=SUM_NU1_1+RLMF_1*SUM_NUJ_0
+C
+              ENDDO
+C
+            ENDDO
+C
+            TAU(ILJ,INDF,JATL)=TAU(ILJ,INDF,JATL)+
+     1                                    CF*TL_J*
+     2                                    SUM_NU1_0 
+            TAU(ILJ,INDFP,JATL)=TAU(ILJ,INDFP,JATL)+
+     1                                    CONJG(CF)*TL_J*
+     2                                    SUM_NU1_1
+C
+            IF(NPATHP.EQ.0) GOTO 25
+C
+            FM2=FMAX(JORDP)
+            XINT1=CABS(CF*TL_J*SUM_NU1_0)
+            XINT2=CABS(CONJG(CF)*TL_J*SUM_NU1_1)
+            XMAX=AMAX1(XINT1,XINT2,XMAX)
+            FMAX(JORDP)=AMAX1(FM2,XINT1,XINT2)
+            IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
+     1         NPATH(JORDP)
+            IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
+                FREF=FMAX(JORDP)
+            ENDIF
+ 25         CONTINUE
+C
+C    Case MJ > 0
+C
+            CJ=ONEC
+            DO MJ=1,LJ
+              INDJ=ILJ+MJ
+              INDJP=ILJ-MJ
+              CJ=CJ*EXP_J
+C
+              SUM_NU1_0=ZEROC
+              SUM_NU1_1=ZEROC
+              SUM_NU1_2=ZEROC
+              SUM_NU1_3=ZEROC
+C
+              DO NU1=0,NU1MAX
+                IF(JORDP.GT.1) THEN
+                  MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
+                ELSE
+                  MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ) 
+                ENDIF
+C
+                DO MU1=-MU1MAX,MU1MAX
+                  LAMBDA1=LBD(MU1,NU1)
+                  AMU1=ABS(MU1)
+C
+                  RLMF_1=HLM01(AMU1+NU1,LF)*RLM01(MU1,-MF,LF)
+                  RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,MF,LF)
+C
+                  SUM_NUJ_0=ZEROC
+                  SUM_NUJ_1=ZEROC
+C
+                  IF(JORDP.GT.1) THEN
+                    DO NUJ=0,NUJMAX
+                      MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
+C
+                      SUM_MUJ_0=ZEROC
+                      SUM_MUJ_1=ZEROC
+C
+                      DO MUJ=-MUJMAX,MUJMAX
+C
+                        LAMBDAJ=LBD(MUJ,NUJ)
+C
+                        SUM_MUJ_1=SUM_MUJ_1+H(LAMBDAJ,LAMBDA1)*
+     1                                      RLMIJ(MUJ,-MJ,LJ)
+                        SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
+     1                                      RLMIJ(MUJ,MJ,LJ)
+C
+                      ENDDO
+C
+                      SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
+                      SUM_NUJ_1=SUM_NUJ_1+SUM_MUJ_1*HLMIJ(NUJ,LJ)
+C
+                    ENDDO
+                  ELSE
+                    SUM_NUJ_1=HLMIJ(NU1,LJ)*RLMIJ(MU1,-MJ,LJ)
+                    SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,MJ,LJ)
+                  ENDIF
+C
+                  SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
+                  SUM_NU1_1=SUM_NU1_1+RLMF_0*SUM_NUJ_1
+                  SUM_NU1_2=SUM_NU1_2+RLMF_1*SUM_NUJ_0
+                  SUM_NU1_3=SUM_NU1_3+RLMF_1*SUM_NUJ_1
+C
+                ENDDO
+C
+              ENDDO
+C
+              TAU(INDJP,INDF,JATL)=TAU(INDJP,INDF,JATL)+
+     1                                    CF*CONJG(CJ)*TL_J*SUM_NU1_1
+              TAU(INDJP,INDFP,JATL)=TAU(INDJP,INDFP,JATL)+
+     1                                    CONJG(CF*CJ)*TL_J*SUM_NU1_3
+              TAU(INDJ,INDF,JATL)=TAU(INDJ,INDF,JATL)+
+     1                                    CF*CJ*TL_J*SUM_NU1_0
+              TAU(INDJ,INDFP,JATL)=TAU(INDJ,INDFP,JATL)+
+     1                                    CONJG(CF)*CJ*TL_J*SUM_NU1_2
+C
+              IF(NPATHP.EQ.0) GOTO 15
+C
+              FM2=FMAX(JORDP)
+              XINT1=CABS(CF*CJ*TL_J*SUM_NU1_0)
+              XINT2=CABS(CF*CONJG(CJ)*TL_J*SUM_NU1_1)
+              XINT3=CABS(CONJG(CF)*CJ*TL_J*SUM_NU1_2)
+              XINT4=CABS(CONJG(CF*CJ)*TL_J*SUM_NU1_3)
+              XMAX=AMAX1(XINT1,XINT2,XINT3,XINT4,XMAX)
+              FMAX(JORDP)=AMAX1(FM2,XINT1,XINT2,XINT3,XINT4)
+              IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
+     1             NPATH(JORDP)
+              IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
+                  FREF=FMAX(JORDP)
+              ENDIF
+ 15           CONTINUE
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO 
+C
+      IF(NPATHP.EQ.0) GOTO 16
+      FMIN(JORDP)=AMIN1(FM1,XMAX)
+      IF(XMAX.GT.FMN(NPATHP)) THEN
+        CALL LOCATE(FMN,NPATHP,XMAX,JMX)
+        DO KF=NPATHP,JMX+2,-1
+          FMN(KF)=FMN(KF-1)
+          JON(KF)=JON(KF-1)
+          PATH(KF)=PATH(KF-1)
+          DMN(KF)=DMN(KF-1)
+          DO KD=1,10
+            JPON(KF,KD)=JPON(KF-1,KD)
+          ENDDO
+        ENDDO
+        FMN(JMX+1)=XMAX
+        JON(JMX+1)=JORDP
+        PATH(JMX+1)=NPATH(JORDP)
+        DMN(JMX+1)=D
+        DO KD=1,JORDP 
+          JPON(JMX+1,KD)=JPOS(KD,3)
+        ENDDO
+      ENDIF
+      IF((FMIN(JORDP)-FM1).LT.-XCOMP) NPMI(JORDP)=NPATH(JORDP)
+      IF((IPRINT.EQ.3).AND.(IJ.EQ.1)) THEN
+        WRITE(IUSCR,1) JORDP,NPATH(JORDP),XMAX,D,(JPOS(KD,3),KD=1,JORDP)
+      ENDIF
+C
+  16  RETURN
+C
+   1  FORMAT(9X,I2,2X,E12.6,7X,E12.6,1X,F6.3,1X,10(I3,2X))
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/plotfd_a.f

@@ -0,0 +1,106 @@
+C
+C=======================================================================
+C
+      SUBROUTINE PLOTFD_A(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 PARCAL_A_MOD, N3 => NPHI_A, N4 => NE_A, N5 => NTHETA_A,
+     &                  NFTHET => NFTHET_A
+      USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
+     &                  IFTHET => IFTHET_A, IMOD => IMOD_A, 
+     &                  I_CP => I_CP_A, I_EXT => I_EXT_A,
+     &                  I_TEST => I_TEST_A
+      USE VALIN_MOD, PHI00 => PHI0, THETA00 => THETA0, U1 => THLUM,
+     &               U2 => PHILUM, U3 => ELUM, N7 => NONVOL
+      USE VALFIN_MOD, PHI11 => PHI1, THETA11 => THETA1
+      USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A, 
+     &                 PHI1 => PHI1_A, THETA1 => THETA1_A
+C 
+      DIMENSION LMX(NATM,NE_M)
+C
+      COMPLEX FSPH,VKE
+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_A(VKE,R1,R2,THETA0,PHI0,BETA,GAMMA,L,M,
+     1                         FSPH,JAT,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,
+     1       1X,F6.2,1X,F8.2)
+  80  FORMAT(15X,'<<<<<  WRONG VALUE OF THETA0 : THE DENOMINATOR ',
+     1           'IS ZERO  >>>>>')
+ 100  FORMAT(15X,'<<<<<  THE VALUE OF L EST IS TOO LARGE FOR ATOM',
+     1           ' : ',I2,'  >>>>>')
+C
+      RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_noso_nosp_nosym/treat_aed.f

@@ -0,0 +1,791 @@
+C
+C=======================================================================
+C
+      SUBROUTINE TREAT_AED(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
+C
+      USE OUTUNITS_MOD
+      USE TYPEXP_MOD, DUMMY => SPECTRO
+      USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
+     &                 PHI1 => PHI1_A, THETA1 => THETA1_A
+      USE VALIN_MOD, P0 => PHI0, T0 => THETA0
+      USE VALFIN_MOD, P1 => PHI1, T1 => THETA1
+C
+      PARAMETER(N_HEAD=5000,N_FILES=1000)
+C
+      CHARACTER*3 SPECTRO
+      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 
+      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,
+     1             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)/
+     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)*
+     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 + 
+     1            (JEMET-1)*NE*N_FIXED*N_SCAN + 
+     2            (JE-1)*N_FIXED*N_SCAN +
+     3            (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),
+     1                        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),
+     1                         ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
+     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),
+     1                         ECIN(JE),TAB(JLIN2,1),TAB(JLIN2,2),
+     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 + 
+     1            (JEMET-1)*NE*NTHETA*NPHI + 
+     2            (JE-1)*NTHETA*NPHI +
+     3            (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),
+     1                      ECIN(JE),SR_1,SF_1
+              IF(I_EXT.EQ.-1) THEN
+                WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                        ECIN(JE),SR2_1,SF2_1
+              ENDIF
+            ELSE
+              WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                       ECIN(JE),SR_1,SF_1,SR_2,SF_2
+              IF(I_EXT.EQ.-1) THEN
+                WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                         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),
+     1                     VOLDIR_1,VOLDIF_1
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                       VOLDIR2_1,VOLDIF2_1
+             ENDIF
+             WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                     TOTDIR_1,TOTDIF_1
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                       TOTDIR2_1,TOTDIF2_1
+             ENDIF
+           ELSE
+             WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                      VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+            IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                        VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
+             ENDIF
+             WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                      TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+             IF(I_EXT.EQ.-1) THEN
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                        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)/
+     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)*
+     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 +
+     1            (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),
+     1                          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),
+     1                           ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
+     2                           TAB(JLIN,3),TAB(JLIN,4)   
+                   IF(I_EXT.EQ.-1) THEN
+                     JLIN2=NTT+JLIN
+                     READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
+     1                             DPHI(JPHI2),ECIN(JE),
+     2                             TAB(JLIN2,1),TAB(JLIN2,2),
+     3                             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),
+     1                        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),
+     1                         ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
+     2                         TAB(JLIN,3),TAB(JLIN,4)
+                 IF(I_EXT.EQ.-1) THEN
+                   JLIN2=NTT+JLIN
+                   READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
+     1                           DPHI(JPHI2),ECIN(JE),
+     2                           TAB(JLIN2,1),TAB(JLIN2,2),
+     3                           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 +
+     1             (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),
+     1                        ECIN(JE),SR_1,SF_1
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                          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),
+     1                         ECIN(JE),SR_1,SF_1,SR_2,SF_2
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                           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),
+     1                       VOLDIR_1,VOLDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     1                         ECIN(JE),VOLDIR2_1,VOLDIF2_1
+               ENDIF
+               WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                       TOTDIR_1,TOTDIF_1
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     1                         ECIN(JE),TOTDIR2_1,TOTDIF2_1
+               ENDIF
+             ELSE
+               WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                        VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
+     1                          ECIN(JE),VOLDIR2_1,VOLDIF2_1,
+     3                          VOLDIR2_2,VOLDIF2_2
+               ENDIF
+               WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
+     1                        TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
+               IF(I_EXT.EQ.-1) THEN
+                 WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
+     1                          ECIN(JE),TOTDIR2_1,TOTDIF2_1,
+     3                          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 +
+     1              (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),
+     1                        ECIN(JE),SR_1,SF_1
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                          ECIN(JE),SR2_1,SF2_1
+                ENDIF
+              ELSE
+                WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2),
+     1                        ECIN(JE),SR_1,SF_1,SR_2,SF_2
+                IF(I_EXT.EQ.-1) THEN
+                  WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
+     1                           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,
+     1       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 ',
+     1       'IN THE TREAT_AED SUBROUTINE - INCREASE NDIM_M ',
+     2       '>>>>>>>>>>')
+   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,
+     1       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,
+     1       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 ',
+     1       'IN THE INCLUDE FILE >>>>>>>>>>',/,4X,
+     2        '<<<<<<<<<<                 SHOULD BE AT LEAST ',I6,
+     3        '                 >>>>>>>>>>')
+  38  FORMAT(//,8X,'<<<<<<<<<<  DIMENSION OF NPH_M TOO SMALL ',
+     1       'IN THE INCLUDE FILE >>>>>>>>>>',/,8X,
+     2        '<<<<<<<<<<             SHOULD BE AT LEAST ',I6,
+     3        '             >>>>>>>>>>')
+ 888  FORMAT(A72)
+C
+   6  RETURN
+C
+      END

src/msspec/spec/fortran/aed_se_mu_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/eig/common/eig_mat_ms.f

@@ -178,10 +178,6 @@ 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

@@ -1,37 +0,0 @@
-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,8 +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)
-#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/memalloc/allocation.f

@@ -25,9 +25,6 @@
         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
@@ -139,7 +136,6 @@
         CALL ALLOC_OUTUNITS()
         CALL ALLOC_PARCAL()
         CALL ALLOC_PARCAL_A()
-        CALL ALLOC_Q_ARRAY()
         CALL ALLOC_RELADS()
         CALL ALLOC_RELAX()
         CALL ALLOC_RENORM()
@@ -177,7 +173,6 @@
         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()
@@ -191,7 +186,6 @@
         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,7 +34,6 @@ C       ===============================================================
         INTEGER NCG_M
         INTEGER N_BESS, N_GAUNT
         INTEGER NLTWO
-        INTEGER NLMM
 C       ===============================================================
       CONTAINS
         SUBROUTINE INIT_DIM()
@@ -61,10 +60,9 @@ C       ===============================================================
 
 C          N_BESS=100*NL_M
 C          N_GAUNT=5*NL_M
-          N_BESS=300*NL_M
+          N_BESS=200*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,20 +192,6 @@ 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
@@ -431,20 +417,6 @@ 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
@@ -806,20 +778,6 @@ 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

@@ -1,11 +0,0 @@
-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

@@ -1,41 +0,0 @@
-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

@@ -1,46 +0,0 @@
-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

@@ -1,47 +0,0 @@
-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

@@ -1,19 +0,0 @@
-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

@@ -1,121 +0,0 @@
-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/facdif.f

@@ -1,26 +0,0 @@
-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/gaunt_st.f

@@ -1,126 +0,0 @@
-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/mpis.f

@@ -1,280 +0,0 @@
-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

@@ -1,165 +0,0 @@
-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_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 := $(filter-out phd_mi_noso_nosp_nosym/lapack_axb.f, $(wildcard phd_mi_noso_nosp_nosym/*.f))
+phd_mi_noso_nosp_nosym_src := $(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)
-C         write(354,*) JORDP,C_REN(JORDP)
+         write(354,*) JORDP,C_REN(JORDP)
       ENDIF
 C
 C   Call of the subroutines used for the R-A termination matrix

src/msspec/utils.py

@@ -19,8 +19,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/utils.py
-# Last modified: Wed, 26 Feb 2025 11:15:03 +0100
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes.fr>
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 """
@@ -39,11 +39,7 @@ import ase.atom
 from ase import Atom
 from ase import Atoms
 
-try:
+from msspec.iodata import Data
-    from msspec.iodata import Data
-except ImportError as err:
-    print(err)
-
 from msspec.misc import LOGGER
 
 
@@ -315,13 +311,34 @@ def cut_cylinder(atoms, axis="z", radius=None):
     :return: The modified atom cluster
     :rtype: ase.Atoms
     """
-    if axis not in ('z',):
+    if radius is None:
-        raise ValueError("axis value != 'z' is not supported yet.")
+        raise ValueError("radius not set")
-    X, Y, Z = atoms.positions.T
+
-    R = np.sqrt(X**2 + Y **2)
+    new_atoms = atoms.copy()
-    T = np.arctan2(Y, X)
+
-    i = np.where(R <= radius)[0]
+    dims = {"x": 0, "y": 1, "z": 2}
-    return atoms[i]
+    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
 
 
 def cut_cone(atoms, radius, z=0):
@@ -409,15 +426,11 @@ def cut_plane(atoms, x=None, y=None, z=None):
 
     dim_values = np.array(dim_values)
 
-    X, Y, Z = atoms.positions.T
+    def constraint(coordinates):
-    i0 = np.where(X                     >= dim_values[0, 0])[0]
+        return np.all(np.logical_and(coordinates >= dim_values[:, 0],
-    i1 = np.where(X[i0]                 <= dim_values[0, 1])[0]
+                                     coordinates <= dim_values[:, 1]))
-    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]
 
 
@@ -464,16 +477,12 @@ def hemispherical_cluster(cluster, emitter_tag=0, emitter_plane=0, diameter=0,
     a = cell[:, 0].max()    # a lattice parameter
 
     # the number of planes in the cluster
-    p = len(np.unique(np.round(cluster.get_positions()[:, 2], 4)))
+    p = np.alen(np.unique(np.round(cluster.get_positions()[:, 2], 4)))
     # the symbol of your emitter
     symbol = cluster[np.where(cluster.get_tags() == emitter_tag)[0][0]].symbol
 
-    if shape.lower() in ('spherical'):
     assert (diameter != 0 or planes != 0), \
         "At least one of diameter or planes parameter must be use."
-    elif shape.lower() in ('cylindrical'):
-        assert (diameter != 0 and planes != 0), \
-            "Diameter and planes parameters must be defined for cylindrical shape."
 
     if diameter == 0:
         # calculate the minimal diameter according to the number of planes
@@ -483,7 +492,6 @@ def hemispherical_cluster(cluster, emitter_tag=0, emitter_plane=0, diameter=0,
 
     # number of repetition in each direction
     rep = int(3*min_diameter/min(a, c))
-    #print("rep = ", rep)
 
     # repeat the cluster
     cluster = cluster.repeat((rep, rep, rep))
@@ -547,7 +555,7 @@ def hemispherical_cluster(cluster, emitter_tag=0, emitter_plane=0, diameter=0,
         xplan, yplan = get_xypos(cluster, zplan)
         radius = np.sqrt(xplan**2 + yplan**2 + zplan**2)
 
-        if diameter != 0 and shape in ('spherical'):
+        if diameter != 0:
             assert (radius <= diameter/2), ("The number of planes is too high "
                                             "compared to the diameter.")
         radius = max(radius, diameter/2)
@@ -574,96 +582,9 @@ def hemispherical_cluster(cluster, emitter_tag=0, emitter_plane=0, diameter=0,
     # an array of all unique remaining z
     all_z = np.sort(np.unique(np.round(cluster.get_positions()[:, 2], 4)))
 
-    assert emitter_plane < len(all_z), ("There are not enough existing "
+    assert emitter_plane < np.alen(all_z), ("There are not enough existing "
                                             "plans.")
     ze = all_z[- emitter_plane - 1]         # the z-coordinate of the emitter
     Atoms.translate(cluster, [0, 0, -ze])   # put the emitter in (0,0,0)
 
     return cluster
-
-def shape_cluster(primitive, emitter_tag=0, emitter_plane=0, diameter=0,
-                          planes=0, shape='spherical'):
-
-    """Creates and returns a cluster based on an Atoms object and some
-    parameters.
-
-    :param cluster: the Atoms object used to create the cluster
-    :type  cluster: Atoms object
-    :param emitter_tag: the tag of your emitter
-    :type  emitter_tag: integer
-    :param diameter: the diameter of your cluster in Angströms
-    :type  diameter: float
-    :param planes: the number of planes of your cluster
-    :type  planes: integer
-    :param emitter_plane: the plane where your emitter will be starting by 0
-                          for the first plane
-    :type  emitter_plane: integer
-
-    See :ref:`hemispherical_cluster_faq` for more informations.
-    """
-    # We need the radius of the cluster and the number of planes
-    if shape.lower() in ('ispherical', 'cylindrical'):
-        assert (nplanes != 0 and diameter != 0), "nplanes and diameter cannot be zero for '{}' shape".format(shape)
-    elif shape.lower() in ('spherical'):
-        if diameter <= 0:
-            # find the diameter based on the number of planes
-            assert planes != 0, "planes should be > 0"
-
-
-    n = 3
-    natoms = 0
-    while True:
-        n += 2
-        cluster = primitive.copy()
-        # Repeat the primitive cell
-        cluster = cluster.repeat((n, n, n))
-        center_cluster(cluster)
-
-        # Find the emitter closest to the origin
-        all_tags = cluster.get_tags()
-        are_emitters = all_tags == emitter_tag
-        _ie = np.linalg.norm(cluster[are_emitters].positions, axis=1).argmin()
-        ie = np.nonzero(are_emitters)[0][_ie]
-        # Translate the cluster to this emitter position
-        cluster.translate(-cluster[ie].position)
-        # cut plane at surface and at bottom
-        all_z = np.unique(cluster.positions[:,2])
-        try:
-            zsurf = all_z[all_z >= 0][emitter_plane]
-        except IndexError:
-            # There are not enough planes above the emitter
-            zsurf = all_z.max()
-        try:
-            zbottom = all_z[all_z <= 0][::-1][planes - (emitter_plane+1)]
-        except IndexError:
-            # There are not enough planes below the emitter
-            zbottom = all_z.min()
-        cluster = cut_plane(cluster, z=[zbottom,zsurf])
-        # spherical shape
-        if shape.lower() in ('spherical'):
-            cluster = cut_sphere(cluster, radius=diameter/2, center=(0,0,zsurf))
-        if shape.lower() in ('ispherical'):
-            cluster = cut_sphere(cluster, radius=diameter/2, center=(0,0,0))
-        elif shape.lower() in ('cylindrical'):
-            cluster = cut_cylinder(cluster, radius=diameter/2)
-        else:
-            raise NameError("Unknown shape")
-        cluster.set_cell(primitive.cell)
-        if len(cluster) <= natoms:
-            break
-        else:
-            natoms = len(cluster)
-
-
-    return cluster
-
-
-
-
-
-
-
-
-
-
-

src/msspec/version.py

@@ -17,39 +17,39 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/version.py
-# Last modified: Wed, 26 Oct 2022 17:15:24 +0200
+# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1666797324 +0200
+# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 import os
 
-from importlib.metadata import version
+from pkg_resources import DistributionNotFound
-import subprocess
+from pkg_resources import get_distribution
+from pkg_resources import parse_version
 
 # find the version number
 # 1- Try to read it from the git info
-# 2- If it fails, try to read it from the VERSION file
+# 2- If it fails, try to read it from the distribution file
-# 3- If it fails, try to read it from the distribution file
+# 3- If it fails, try to read it from the VERSION file
-
-PKGNAME = 'msspec'
-
-thisfile_path = os.path.abspath(__file__)
-thisfile_dir = os.path.dirname(thisfile_path)
 
 try:
-    cmd = ["git describe|sed 's/-\([0-9]\+\)-.*/.dev\\1/g'"]
+    from setuptools_scm import get_version
-    result = subprocess.run(cmd, stdout=subprocess.PIPE, stderr=subprocess.DEVNULL, 
+    v = get_version(root='../../', relative_to=__file__, version_scheme="post-release")
-            shell=True, cwd=thisfile_dir)
+    v = parse_version(v)
-    __version__ = result.stdout.decode('utf-8').strip()
+    if v._version.post[-1] == 0:
-    if __version__ == "":
+        __version__ = v.base_version
-        raise
+    else:
+        __version__ = v.public
 except Exception as err:
     try:
-        versionfile = os.path.join(thisfile_dir, "./VERSION")
+        __version__ = get_distribution(__name__.strip('.version')).version
-        with open(versionfile, "r") as fd:
-            __version__ = fd.readline().strip()
     except Exception as err:
         try:
-            __version__ = version(PKGNAME)
+            thisfile_path = os.path.abspath(__file__)
+            thisfile_dir = os.path.dirname(thisfile_path)
+            versionfile = os.path.join(thisfile_dir, "../VERSION")
+            with open(versionfile, "r") as fd:
+                __version__ = fd.readline()
         except Exception as err:
-            __version__ = "0.0.0"
+            print("Unable to get the version number!")
+            __version__ = "9.9.9"

src/options.mk

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

src/pyproject.toml

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

src/setup.cfg

@@ -1,55 +0,0 @@
-[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

tests/aed/test.py

@@ -0,0 +1,83 @@
+# coding: utf8
+
+import numpy as np
+from ase.build import bulk
+from ase.lattice.tetragonal import SimpleTetragonalFactory
+from msspec.calculator import MSSPEC, XRaySource
+from msspec.utils import hemispherical_cluster, get_atom_index
+import logging
+
+logging.basicConfig(level=logging.INFO)
+
+
+do_ped = False
+
+# Define a Rocksalt Factory class (to tetragonalize the unit cell)
+class RocksaltFactory(SimpleTetragonalFactory):
+    bravais_basis = [[0, 0, 0], [0.5, 0.5, 0], [0.5, 0, 0.5], [0, 0.5, 0.5],
+                     [0, 0, 0.5], [0.5, 0, 0], [0, 0.5, 0], [0.5, 0.5, 0.5]]
+    element_basis = (0, 0, 0, 0, 1, 1, 1, 1)
+Rocksalt = RocksaltFactory()
+
+
+a0 = 4.09
+a_perp = 4.25
+MgO = Rocksalt(('Mg', 'O'),
+               latticeconstant={'a': a0, 'c/a': a_perp/a0},
+               size=(1,1,1))
+
+
+for atom in MgO:
+   atom.set('mean_square_vibration', 0.01)
+   atom.set('forward_angle', 20.)
+   if atom.symbol == 'Mg':
+      atom.tag = 1
+      atom.set('mt_radius', 0.63)
+   else:
+      atom.tag = 2
+      atom.set('mt_radius', 1.415)
+
+
+#cluster = hemispherical_cluster(MgO, emitter_tag=1, emitter_plane=1, planes=4, diameter=4.5*a0)
+cluster = hemispherical_cluster(MgO, emitter_tag=1, emitter_plane=1, planes=2)
+cluster.absorber = get_atom_index(cluster, 0, 0, 0)
+#cluster.edit()
+#exit()
+
+if do_ped:
+    calc = MSSPEC(spectroscopy='PED', algorithm='inversion')
+else:
+    calc = MSSPEC(spectroscopy='AED', algorithm='inversion')
+calc.set_atoms(cluster)
+
+calc.muffintin_parameters.ionicity = {'Mg': 0.1, 'O': -0.1}
+
+calc.tmatrix_parameters.exchange_correlation = 'hedin_lundqvist_complex'
+calc.tmatrix_parameters.lmax_mode            = 'true_ke'
+#calc.tmatrix_parameters.tl_threshold         = 1e-6
+
+calc.source_parameters.energy = XRaySource.AL_KALPHA
+calc.source_parameters.theta  = -55.
+calc.source_parameters.phi    = 0
+
+calc.detector_parameters.angular_acceptance = 2.
+calc.detector_parameters.average_sampling   = 'high'
+
+calc.calculation_parameters.scattering_order    = 4
+calc.calculation_parameters.RA_cutoff           = 2
+calc.calculation_parameters.path_filtering      = 'forward_scattering'
+calc.calculation_parameters.off_cone_events     = 1
+calc.calculation_parameters.vibrational_damping = 'averaged_tl'
+calc.calculation_parameters.vibration_scaling   = 3.
+
+if do_ped:
+    calc.muffintin_parameters.interstitial_potential = 14
+    data = calc.get_theta_scan(phi=0, theta=np.arange(-5, 60.5, 0.5),
+                               level='2p',
+                               kinetic_energy=1200)
+else:
+    data = calc.get_theta_scan(phi=0, theta=np.arange(-5, 60.5, 0.5),
+                               edge='KL2L2', multiplet='1D2',
+                               kinetic_energy=1200)
+
+data.save('results.hdf5')