Merge branch 'hotfix/1.7.post13'

Numpy does not allow anylonger types np.int or np.float.
These are replaced simply by int and float python native types.

Jenkinsfile

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

Makefile

@@ -32,10 +32,17 @@ devel: venv pybinding wx
 	@$(INSIDE_VENV) pip install -e src/
 
 
+light: VENV_PATH = ./_venv
+light: venv
+	@$(INSIDE_VENV) pip install src/
+
+
 _build_wx/wxPython.target:
 	@$(INSIDE_VENV) echo "Building wxPython for your `python --version 2>&1` under Linux $(DISTRO_RELEASE)..."
 	# Create a folder to build wx into
 	@mkdir -p _build_wx
+	@$(INSIDE_VENV) pip install attrdict sip
+	# TODO: attrdict is no longer compatible with collections package. The build will fail
 	# download the wheel or the source if it cannot find a wheel
 	@$(INSIDE_VENV) cd _build_wx && pip download -f https://extras.wxpython.org/wxPython4/extras/linux/gtk3/$(DISTRO_RELEASE) wxPython
 	# Build the source if a tar.gz was downloaded

src/msspec/__init__.py

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

src/msspec/calcio.py

@@ -1,25 +1,5 @@
-#!/usr/bin/env python
 # coding: utf-8
-#
+# vim: set et ts=4 sw=4 fdm=indent mouse=a cc=+1 tw=80:
-# Copyright © 2016-2020 - Rennes Physics Institute
-#
-# This file is part of msspec.
-#
-# msspec is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-# msspec is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-# You should have received a copy of the GNU General Public License
-# along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
-#
-# Source file  : src/msspec/calcio.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
-
 
 """
 Module calcio
@@ -747,15 +727,15 @@ class SpecIO(object):
         content += line
 
         nat = p.extra_nat
-        nra_arr = np.ones((nat), dtype=np.int)
+        nra_arr = np.ones((nat), dtype=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=np.int)
+            ibwd_arr = np.ones((nat), dtype=int)
         else:
-            ibwd_arr = np.zeros((nat), dtype=np.int)
+            ibwd_arr = np.zeros((nat), dtype=int)
         thbwd_arr = np.ones((nat))
         for at in p.extra_atoms:
             i = at.get('proto_index') - 1
@@ -930,7 +910,7 @@ class SpecIO(object):
         if content != old_content:
             with open(filename, 'w') as fd:
                 fd.write(content)
-                LOGGER.debug("Writing Spec input file written in {}".format(filename))
+                LOGGER.debug(f"Writing Spec input file written in {filename}")
             modified = True
 
         return modified
@@ -1275,13 +1255,13 @@ class CompCurveIO(object):
         data = []
         for i in range(1, 13):
             #data.append(np.loadtxt(prefix + f'{i:02d}' + '.txt')[-1])
-            results = np.loadtxt(prefix + '{:02d}'.format(i) + '.txt')
+            results = np.loadtxt(prefix + f'{i:02d}' + '.txt')
             results = results.reshape((-1, 2))
             data.append(results[index,1])
         suffix = 'ren'
         exp = {'int': None, 'ren': None, 'chi': None, 'cdf': None}
         exp_ren = np.loadtxt(os.path.join('exp', 'div',
-                                          'experiment_{}.txt'.format(suffix)))
+                                          f'experiment_{suffix}.txt'))
         calc_ren = np.loadtxt(os.path.join('calc', 'div',
-                                           'calculation{:d}_{}.txt'.format(index,suffix)))
+                                           f'calculation{index:d}_{suffix}.txt'))
         return data, exp_ren, calc_ren

src/msspec/calculator.py

@@ -1,5 +1,4 @@
 #!/usr/bin/env python
-# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -17,8 +16,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/calculator.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Last modified: ven. 10 avril 2020 17:19:24
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
+# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
 
 
 """
@@ -302,7 +301,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=np.float).flatten()
+        #return np.array(ke, dtype=float).flatten()
         return ke
 
 
@@ -384,7 +383,7 @@ class _MSCALCULATOR(Calculator):
                'NODES_EX_M' : 3,
                'NSPIN_M'    : 1, # to change for spin dependent
                'NTH_M'      : 2000,
-               'NPH_M'      : 2000,
+               'NPH_M'      : 8000,
                'NDIM_M'     : 100000,
                'N_TILT_M'   : 11, # to change see extdir.f
                'N_ORD_M'    : 250,
@@ -616,7 +615,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={}):
+                  malloc={}, other_parameters={}):
         LOGGER.info("Computting the %s scan...", scan_type)
         if data:
             self.iodata = data
@@ -651,6 +650,13 @@ 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)
 
@@ -852,7 +858,7 @@ class _PED(_MSCALCULATOR):
         return self.iodata
 
     def get_scattering_factors(self, level='1s', kinetic_energy=None,
-                               data=None):
+                               data=None, **kwargs):
         """Computes the scattering factors of all prototypical atoms in the
         cluster.
 
@@ -871,11 +877,11 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='scatf', level=level, data=data,
-                              kinetic_energy=kinetic_energy)
+                              kinetic_energy=kinetic_energy, **kwargs)
         return data
 
     def get_theta_scan(self, phi=0, theta=np.linspace(-70, 70, 141),
-                       level=None, kinetic_energy=None, data=None):
+                       level=None, kinetic_energy=None, data=None, **kwargs):
         """Computes a polar scan of the emitted photoelectrons.
 
         :param phi: The azimuthal angle in degrees. See
@@ -892,11 +898,12 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='theta', level=level, theta=theta,
-                              phi=phi, kinetic_energy=kinetic_energy, data=data)
+                              phi=phi, kinetic_energy=kinetic_energy,
+                              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):
+                     level=None, kinetic_energy=None, data=None, **kwargs):
         """Computes an azimuthal scan of the emitted photoelectrons.
 
         :param phi: All the values of the azimuthal angle to be computed. See
@@ -913,12 +920,13 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='phi', level=level, theta=theta,
-                              phi=phi, kinetic_energy=kinetic_energy, data=data)
+                              phi=phi, kinetic_energy=kinetic_energy,
+                              data=data, **kwargs)
         return data
 
     def get_theta_phi_scan(self, phi=np.linspace(0, 360),
                            theta=np.linspace(0, 90, 45), level=None,
-                           kinetic_energy=None, data=None):
+                           kinetic_energy=None, data=None, **kwargs):
         """Computes a stereographic scan of the emitted photoelectrons.
 
         The azimuth ranges from 0 to 360° and the polar angle ranges from 0 to
@@ -935,11 +943,11 @@ class _PED(_MSCALCULATOR):
         """
         data = self._get_scan(scan_type='theta_phi', level=level, theta=theta,
                               phi=phi, kinetic_energy=kinetic_energy, data=data,
-                              malloc={'NPH_M': 8000})
+                              **kwargs)
         return data
 
     def get_energy_scan(self, phi=0, theta=0,
-                        level=None, kinetic_energy=None, data=None):
+                        level=None, kinetic_energy=None, data=None, **kwargs):
         """Computes an energy scan of the emitted photoelectrons.
 
         :param phi: All the values of the azimuthal angle to be computed. See
@@ -956,7 +964,8 @@ class _PED(_MSCALCULATOR):
 
         """
         data = self._get_scan(scan_type='energy', level=level, theta=theta,
-                              phi=phi, kinetic_energy=kinetic_energy, data=data)
+                              phi=phi, kinetic_energy=kinetic_energy,
+                              data=data, **kwargs)
         return data
 
 
@@ -1123,7 +1132,7 @@ class RFACTOR(object):
         for i in range(noif):
             X, Y = args[2*i], args[2*i+1]
             fname = os.path.join('calc',
-                                 'calculation{:d}.txt'.format(self.stack_count))
+                                 f'calculation{self.stack_count:d}.txt')
             # And save to the working space
             np.savetxt(fname, np.transpose([X, Y]))
             self.stack_count += 1
@@ -1131,7 +1140,7 @@ class RFACTOR(object):
         # Update the list of input calculation files
         self._params.calc_filename = []
         for i in range(self.stack_count):
-            fname = os.path.join('calc', 'calculation{:d}.txt'.format(i))
+            fname = os.path.join('calc', f'calculation{i:d}.txt')
             self._params.calc_filename.append(fname)
 
         # Write the input file
@@ -1226,23 +1235,23 @@ class RFACTOR(object):
             dset_values.x, dset_values.yref = exp_data.T
             # Append the calculated values
             ycalc = calc_data[:,1]
-            dset_values.add_columns(**{"calc{:d}".format(i): ycalc})
+            dset_values.add_columns(**{f"calc{i:d}": ycalc})
-            dset_rfc.add_columns(**{'variable_set{:d}'.format(i): rfc})
+            dset_rfc.add_columns(**{f'variable_set{i:d}': rfc})
 
         # Plot the curves
         view_values.select('x', 'yref', legend='Reference values')
         title = ''
         for k,v in self.best_values.items():
-            title += '{}={} '.format(k, v)
+            title += f'{k}={v} '
-        view_values.select('x', "calc{:d}".format(self.index),
+        view_values.select('x', f"calc{self.index:d}",
                            legend="Best calculated values")
         view_values.set_plot_options(title=title)
 
         view_results.select('counts')
 
         for i in range(self.stack_count):
-            view_rfc.select('rfactor_number', 'variable_set{:d}'.format(i),
+            view_rfc.select('rfactor_number', f'variable_set{i:d}',
-                            legend="variables set #{:d}".format(i))
+                            legend=f"variables set #{i:d}")
         # Save the parameters
         for p in self.get_parameters():
             bundle = {'group': str(p.group),

src/msspec/cli.py

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

src/msspec/create_tests_results.py

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

src/msspec/data/__init__.py

@@ -1,24 +1,5 @@
-#!/usr/bin/env python
+# -*- encoding: utf-8 -*-
-# coding: utf-8
+# vim: set fdm=indent ts=4 sw=4 sts=4 et ai tw=80 cc=+0 mouse=a nu : #
-#
-# Copyright © 2016-2020 - Rennes Physics Institute
-#
-# This file is part of msspec.
-#
-# msspec is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-# msspec is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-# You should have received a copy of the GNU General Public License
-# along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
-#
-# Source file  : src/msspec/data/__init__.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 
 from .electron_be import electron_be

src/msspec/data/electron_be.py

@@ -1,24 +1,4 @@
-#!/usr/bin/env python
 # coding: utf-8
-#
-# Copyright © 2016-2020 - Rennes Physics Institute
-#
-# This file is part of msspec.
-#
-# msspec is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-# msspec is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-# You should have received a copy of the GNU General Public License
-# along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
-#
-# Source file  : src/msspec/data/electron_be.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 """
 Module electron_be

src/msspec/iodata.py

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

src/msspec/iodata_gi.py

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

src/msspec/iodata_wx.py

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

src/msspec/looper.py

@@ -1,24 +1,6 @@
-#!/usr/bin/env python
+# coding: utf8
-# coding: utf-8
+# -*- encoding: future_fstrings -*-
-#
+# vim: set et sw=4 ts=4 nu tw=79 cc=+1:
-# Copyright © 2016-2020 - Rennes Physics Institute
-#
-# This file is part of msspec.
-#
-# msspec is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-# msspec is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-# You should have received a copy of the GNU General Public License
-# along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
-#
-# Source file  : src/msspec/looper.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
 
 from collections import OrderedDict
 from functools import partial
@@ -39,7 +21,7 @@ class Variable:
         self.doc = doc
 
     def __repr__(self):
-        return "<Variable(\'{}\')>".format(self.name)
+        return f"<Variable(\'{self.name}\')>"
 
 class Sweep:
     def __init__(self, key, comments="", unit=None,

src/msspec/misc.py

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

src/msspec/parameters.py

@@ -1,5 +1,4 @@
 #!/usr/bin/env python
-# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -19,8 +18,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/parameters.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Last modified: ven. 10 avril 2020 17:31:50
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
+# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
 
 
 """
@@ -1311,8 +1310,8 @@ class ScanParameters(BaseParameters):
         #    LOGGER.error('Incompatible options!')
         #    raise ValueError(msg)
 
-        # p._value = np.array(p.value, dtype=np.float).flatten()
+        # p._value = np.array(p.value, dtype=float).flatten()
-        arr = np.array(p.value, dtype=np.float).flatten()
+        arr = np.array(p.value, dtype=float).flatten()
 
         theta0 = arr[0]
         theta1 = arr[-1]
@@ -1346,7 +1345,7 @@ class ScanParameters(BaseParameters):
        #    LOGGER.error('Incompatible options')
        #    raise ValueError(msg)
 
-        arr = np.array(p.value, dtype=np.float).flatten()
+        arr = np.array(p.value, dtype=float).flatten()
 
         phi0 = arr[0]
         phi1 = arr[-1]
@@ -1540,7 +1539,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
@@ -2013,20 +2012,20 @@ class CompCurveGeneralParameters(BaseParameters):
         value = p.allowed_values.index(p.value)
         self.compcurve_parameters.general_norm = value
         LOGGER.info("Curve Comparison: Normalization mode set to "
-                    "\"{}\"".format(p.value))
+                    f"\"{p.value}\"")
 
     def bind_rescale(self, p):
         self.compcurve_parameters.general_iscale = int(p.value)
         state = "deactivated"
         if p.value:
             state = "activated"
-        LOGGER.info("Curve Comparison: Rescaling of data {}".format(state))
+        LOGGER.info(f"Curve Comparison: Rescaling of data {state}")
 
     def bind_function(self, p):
         value = p.allowed_values.index(p.value)
         self.compcurve_parameters.general_icur = value
         LOGGER.info("Curve Comparison: Type of data used for comparison "
-                    "set to \"{}\"".format(p.value))
+                    f"set to \"{p.value}\"")
 
 
 

src/msspec/spec/fortran/Makefile

@@ -1,6 +1,6 @@
-.PHONY: all phd_se phd_mi aed_se aed_mi eig_mi eig_pw comp_curve clean
+.PHONY: all phd_se phd_mi eig_mi eig_pw comp_curve clean
 
-all: phd_se phd_mi aed_se aed_mi eig_mi eig_pw comp_curve
+all: phd_se phd_mi eig_mi eig_pw comp_curve
 
 phd_se:
 	@+$(MAKE) -f phd_se_noso_nosp_nosym.mk all
@@ -8,12 +8,6 @@ phd_se:
 phd_mi:
 	@+$(MAKE) -f phd_mi_noso_nosp_nosym.mk all
 
-aed_se:
-	@+$(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
 
@@ -26,8 +20,6 @@ comp_curve:
 clean::
 	@+$(MAKE) -f phd_se_noso_nosp_nosym.mk $@
 	@+$(MAKE) -f phd_mi_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

@@ -1,12 +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)
-#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

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

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

@@ -1,140 +0,0 @@
-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,88 +0,0 @@
-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_mi_mu_noso_nosp_nosym/facdif1_a.f

@@ -1,115 +0,0 @@
-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_mi_mu_noso_nosp_nosym/facdif_a.f

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

@@ -1,21 +0,0 @@
-      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_MI()
-        CALL CLOSE_ALL_FILES()
-
-      END SUBROUTINE RUN

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

@@ -1,106 +0,0 @@
-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_mi_mu_noso_nosp_nosym/treat_aed.f

@@ -1,791 +0,0 @@
-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_mi_mu_noso_nosp_nosym/weight_sum.f

@@ -1,335 +0,0 @@
-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/aed_se_mu_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)
-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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@@ -1,335 +0,0 @@
-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/tests.py

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

src/msspec/utils.py

@@ -1,5 +1,4 @@
 #!/usr/bin/env python
-# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -19,8 +18,8 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/utils.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Last modified: Thu, 06 Oct 2022 18:19:16 +0200
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1665073156 +0200
 
 
 """
@@ -39,7 +38,11 @@ import ase.atom
 from ase import Atom
 from ase import Atoms
 
-from msspec.iodata import Data
+try:
+    from msspec.iodata import Data
+except ImportError as err:
+    print(err)
+
 from msspec.misc import LOGGER
 
 
@@ -67,7 +70,7 @@ class ForeignPotential(object):
         self.phagen_data = {'types': []}
 
     def write(self, filename, prototypical_atoms):
-        LOGGER.debug("Writing Phagen input potential file: {}".format(filename))
+        LOGGER.debug(f"Writing Phagen input potential file: {filename}")
 
         def DEPRECATEDappend_atom_potential(atom):
             Z = atom.number
@@ -78,8 +81,8 @@ class ForeignPotential(object):
                     itypes.append(i)
             # Check now that we have only one type in the list
             # otherwise we do not know yet how to deal with this.
-            assert len(itypes) > 0, "Cannot find the data for atom with Z={}".format(Z)
+            assert len(itypes) > 0, f"Cannot find the data for atom with Z={Z}"
-            assert len(itypes) == 1, "Too many datasets for atom with Z={}".format(Z)
+            assert len(itypes) == 1, f"Too many datasets for atom with Z={Z}"
             # So far so good, let's write the block
             t = self.phagen_data['types'][itypes[0]]
             s = "{:<7d}{:<10d}{:1.4f}\n".format(
@@ -92,7 +95,7 @@ class ForeignPotential(object):
         def append_atom_potential(atom):
             line_fmt = "{:+1.8e} " * 4 + "\n"
             atom_type = atom.get('atom_type')
-            assert atom_type != None, "Unable get the atom type!"
+            assert atom_type != None, f"Unable get the atom type!"
             for t in self.phagen_data['types']:
                 if t['atom_type'] == atom_type:
                     s = "{:<7d}{:<10d}{:1.4f}\n".format(
@@ -135,7 +138,7 @@ class SPRKKRPotential(ForeignPotential):
         self.potfile = potfile
         self.load_sprkkr_atom_types()
         for f in exported_files:
-            LOGGER.info("Loading file {}...".format(f))
+            LOGGER.info(f"Loading file {f}...")
             # get the IT from the filename
             m=re.match('SPRKKR-IT_(?P<IT>\d+)-PHAGEN.*', os.path.basename(f))
             it = int(m.group('IT'))
@@ -189,7 +192,7 @@ class SPRKKRPotential(ForeignPotential):
             return data
 
         # load info in *.pot file
-        LOGGER.info("Loading SPRKKR *.pot file {}...".format(self.potfile))
+        LOGGER.info(f"Loading SPRKKR *.pot file {self.potfile}...")
         with open(self.potfile, 'r') as fd:
             content = fd.read()
 
@@ -230,7 +233,7 @@ class SPRKKRPotential(ForeignPotential):
                     IT = occupation['ITOQ']
                     atom = self.atoms[i]
                     atom.set('atom_type', IT)
-            LOGGER.debug("Site #{} is type #{}, atom {}".format(IQ, IT, atom))
+            LOGGER.debug(f"Site #{IQ} is type #{IT}, atom {atom}")
 
 
 
@@ -477,7 +480,7 @@ 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 = np.alen(np.unique(np.round(cluster.get_positions()[:, 2], 4)))
+    p = len(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
 
@@ -582,7 +585,7 @@ 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 < np.alen(all_z), ("There are not enough existing "
+    assert emitter_plane < len(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)

src/msspec/version.py

@@ -1,5 +1,4 @@
 #!/usr/bin/env python
-# coding: utf-8
 #
 # Copyright © 2016-2020 - Rennes Physics Institute
 #
@@ -17,39 +16,38 @@
 # along with this msspec.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Source file  : src/msspec/version.py
-# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
+# Last modified: Thu, 06 Oct 2022 18:19:16 +0200
-# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
+# Committed by : Sylvain Tricot <sylvain.tricot@univ-rennes1.fr> 1665073156 +0200
 
 
 import os
 
-from pkg_resources import DistributionNotFound
+from importlib.metadata import version
-from pkg_resources import get_distribution
+import subprocess
-from pkg_resources import parse_version
 
 # find the version number
-# 1- Try to read it from the git info
+# 1- If it fails, try to read it from the distribution file
-# 2- If it fails, try to read it from the distribution file
+# 2- Try to read it from the git info
 # 3- If it fails, try to read it from the VERSION file
 
+PKGNAME = 'msspec'
+
 try:
-    from setuptools_scm import get_version
+    __version__ = version(PKGNAME)
-    v = get_version(root='../../', relative_to=__file__, version_scheme="post-release")
-    v = parse_version(v)
-    if v._version.post[-1] == 0:
-        __version__ = v.base_version
-    else:
-        __version__ = v.public
 except Exception as err:
     try:
-        __version__ = get_distribution(__name__.strip('.version')).version
+        p = subprocess.run(["git", "describe"], capture_output=True, text=True)
+        if p.stdout not in ("", None):
+            __version__ = p.stdout.strip()
+        else:
+            raise NameError("git describe failed!")
     except Exception as err:
         try:
             thisfile_path = os.path.abspath(__file__)
             thisfile_dir = os.path.dirname(thisfile_path)
             versionfile = os.path.join(thisfile_dir, "../VERSION")
             with open(versionfile, "r") as fd:
-                __version__ = fd.readline()
+                __version__ = fd.readline().strip()
         except Exception as err:
             print("Unable to get the version number!")
             __version__ = "9.9.9"

src/options.mk

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

src/pip.freeze

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

tests/aed/test.py

@@ -1,83 +0,0 @@
-# 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')