Compare commits
6 Commits
master
...
feature/ae
| Author | SHA1 | Date |
|---|---|---|
 Sylvain Tricot
|
e17a4525cc | |
|
Sylvain Tricot
|
8983368e97 | |
|
Sylvain Tricot
|
9f6306675f | |
|
Sylvain Tricot
|
369e743197 | |
|
Sylvain Tricot
|
ec0fc248ce | |
|
Sylvain Tricot
|
0d6db43597 |
|
|
@ -13,9 +13,9 @@ pipeline {
|
|||
}
|
||||
stage('Syncing website...') {
|
||||
steps {
|
||||
// echo 'Syncing website...'
|
||||
echo 'Syncing website only in master branch, not here in devel branch...'
|
||||
// sh 'rm -rf $HOME/www/*'
|
||||
sh 'cp -a ./doc/build/html/* $HOME/www/'
|
||||
// sh 'cp -a ./doc/build/html/* $HOME/www/'
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -16,8 +17,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/__init__.py
|
||||
# Last modified: ven. 10 avril 2020 17:22:12
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
import ase
|
||||
|
|
|
|||
|
|
@ -1,5 +1,25 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
# vim: set et ts=4 sw=4 fdm=indent mouse=a cc=+1 tw=80:
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
# This file is part of msspec.
|
||||
#
|
||||
# msspec is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
# msspec is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/calcio.py
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
Module calcio
|
||||
|
|
@ -910,7 +930,7 @@ class SpecIO(object):
|
|||
if content != old_content:
|
||||
with open(filename, 'w') as fd:
|
||||
fd.write(content)
|
||||
LOGGER.debug(f"Writing Spec input file written in {filename}")
|
||||
LOGGER.debug("Writing Spec input file written in {}".format(filename))
|
||||
modified = True
|
||||
|
||||
return modified
|
||||
|
|
@ -1255,13 +1275,13 @@ class CompCurveIO(object):
|
|||
data = []
|
||||
for i in range(1, 13):
|
||||
#data.append(np.loadtxt(prefix + f'{i:02d}' + '.txt')[-1])
|
||||
results = np.loadtxt(prefix + f'{i:02d}' + '.txt')
|
||||
results = np.loadtxt(prefix + '{:02d}'.format(i) + '.txt')
|
||||
results = results.reshape((-1, 2))
|
||||
data.append(results[index,1])
|
||||
suffix = 'ren'
|
||||
exp = {'int': None, 'ren': None, 'chi': None, 'cdf': None}
|
||||
exp_ren = np.loadtxt(os.path.join('exp', 'div',
|
||||
f'experiment_{suffix}.txt'))
|
||||
'experiment_{}.txt'.format(suffix)))
|
||||
calc_ren = np.loadtxt(os.path.join('calc', 'div',
|
||||
f'calculation{index:d}_{suffix}.txt'))
|
||||
'calculation{:d}_{}.txt'.format(index,suffix)))
|
||||
return data, exp_ren, calc_ren
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -16,8 +17,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/calculator.py
|
||||
# Last modified: ven. 10 avril 2020 17:19:24
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
@ -1122,7 +1123,7 @@ class RFACTOR(object):
|
|||
for i in range(noif):
|
||||
X, Y = args[2*i], args[2*i+1]
|
||||
fname = os.path.join('calc',
|
||||
f'calculation{self.stack_count:d}.txt')
|
||||
'calculation{:d}.txt'.format(self.stack_count))
|
||||
# And save to the working space
|
||||
np.savetxt(fname, np.transpose([X, Y]))
|
||||
self.stack_count += 1
|
||||
|
|
@ -1130,7 +1131,7 @@ class RFACTOR(object):
|
|||
# Update the list of input calculation files
|
||||
self._params.calc_filename = []
|
||||
for i in range(self.stack_count):
|
||||
fname = os.path.join('calc', f'calculation{i:d}.txt')
|
||||
fname = os.path.join('calc', 'calculation{:d}.txt'.format(i))
|
||||
self._params.calc_filename.append(fname)
|
||||
|
||||
# Write the input file
|
||||
|
|
@ -1225,23 +1226,23 @@ class RFACTOR(object):
|
|||
dset_values.x, dset_values.yref = exp_data.T
|
||||
# Append the calculated values
|
||||
ycalc = calc_data[:,1]
|
||||
dset_values.add_columns(**{f"calc{i:d}": ycalc})
|
||||
dset_rfc.add_columns(**{f'variable_set{i:d}': rfc})
|
||||
dset_values.add_columns(**{"calc{:d}".format(i): ycalc})
|
||||
dset_rfc.add_columns(**{'variable_set{:d}'.format(i): rfc})
|
||||
|
||||
# Plot the curves
|
||||
view_values.select('x', 'yref', legend='Reference values')
|
||||
title = ''
|
||||
for k,v in self.best_values.items():
|
||||
title += f'{k}={v} '
|
||||
view_values.select('x', f"calc{self.index:d}",
|
||||
title += '{}={} '.format(k, v)
|
||||
view_values.select('x', "calc{:d}".format(self.index),
|
||||
legend="Best calculated values")
|
||||
view_values.set_plot_options(title=title)
|
||||
|
||||
view_results.select('counts')
|
||||
|
||||
for i in range(self.stack_count):
|
||||
view_rfc.select('rfactor_number', f'variable_set{i:d}',
|
||||
legend=f"variables set #{i:d}")
|
||||
view_rfc.select('rfactor_number', 'variable_set{:d}'.format(i),
|
||||
legend="variables set #{:d}".format(i))
|
||||
# Save the parameters
|
||||
for p in self.get_parameters():
|
||||
bundle = {'group': str(p.group),
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -18,8 +19,8 @@
|
|||
# along with msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/cli.py
|
||||
# Last modified: jeu. 04 juin 2020 16:54:12
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
import sys
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -18,8 +19,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/create_tests_results.py
|
||||
# Last modified: ven. 10 avril 2020 17:29:16
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
from msspec.tests import create_tests_results
|
||||
|
|
|
|||
|
|
@ -1,5 +1,24 @@
|
|||
# -*- encoding: utf-8 -*-
|
||||
# vim: set fdm=indent ts=4 sw=4 sts=4 et ai tw=80 cc=+0 mouse=a nu : #
|
||||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
# This file is part of msspec.
|
||||
#
|
||||
# msspec is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
# msspec is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/data/__init__.py
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
from .electron_be import electron_be
|
||||
|
|
|
|||
|
|
@ -1,4 +1,24 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
# This file is part of msspec.
|
||||
#
|
||||
# msspec is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
# msspec is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/data/electron_be.py
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
"""
|
||||
Module electron_be
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -16,8 +17,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/iodata.py
|
||||
# Last modified: ven. 10 avril 2020 17:23:11
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
@ -442,24 +443,24 @@ class DataSet(object):
|
|||
for k, v in parameters.items():
|
||||
if k == 'Cluster':
|
||||
continue
|
||||
s += f"# {k}:\n"
|
||||
s += "# {}:\n".format(k)
|
||||
if not(isinstance(v, list)):
|
||||
v = [v,]
|
||||
for p in v:
|
||||
s += f"# {p['name']} = {p['value']} {p['unit']}\n"
|
||||
s += "# {} = {} {}\n".format(p['name'], p['value'], p['unit'])
|
||||
return s
|
||||
|
||||
colnames = self.columns()
|
||||
with open(filename, mode) as fd:
|
||||
# write the date and time of export
|
||||
now = datetime.now()
|
||||
fd.write(f"# Data exported on {now}\n")
|
||||
fd.write("# Data exported on {}\n".format(now))
|
||||
fd.write(rule)
|
||||
|
||||
# Append notes
|
||||
fd.write("# NOTES:\n")
|
||||
for line in self.notes.split('\n'):
|
||||
fd.write(f"# {line}\n")
|
||||
fd.write("# {}\n".format(line))
|
||||
fd.write(rule)
|
||||
|
||||
# Append parameters
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -15,9 +16,9 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/iodata.py
|
||||
# Last modified: ven. 10 avril 2020 17:23:11
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Source file : src/msspec/iodata_gi.py
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
@ -491,24 +492,24 @@ class DataSet(object):
|
|||
for k, v in parameters.items():
|
||||
if k == 'Cluster':
|
||||
continue
|
||||
s += f"# {k}:\n"
|
||||
s += "# {}:\n".format(k)
|
||||
if not(isinstance(v, list)):
|
||||
v = [v,]
|
||||
for p in v:
|
||||
s += f"# {p['name']} = {p['value']} {p['unit']}\n"
|
||||
s += "# {} = {} {}\n".format(p['name'], p['value'], p['unit'])
|
||||
return s
|
||||
|
||||
colnames = self.columns()
|
||||
with open(filename, mode) as fd:
|
||||
# write the date and time of export
|
||||
now = datetime.now()
|
||||
fd.write(f"# Data exported on {now}\n")
|
||||
fd.write("# Data exported on {}\n".format(now))
|
||||
fd.write(rule)
|
||||
|
||||
# Append notes
|
||||
fd.write("# NOTES:\n")
|
||||
for line in self.notes.split('\n'):
|
||||
fd.write(f"# {line}\n")
|
||||
fd.write("# {}\n".format(line))
|
||||
fd.write(rule)
|
||||
|
||||
# Append parameters
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -15,9 +16,9 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/iodata.py
|
||||
# Last modified: ven. 10 avril 2020 17:23:11
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Source file : src/msspec/iodata_wx.py
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
@ -437,24 +438,24 @@ class DataSet(object):
|
|||
for k, v in parameters.items():
|
||||
if k == 'Cluster':
|
||||
continue
|
||||
s += f"# {k}:\n"
|
||||
s += "# {}:\n".format(k)
|
||||
if not(isinstance(v, list)):
|
||||
v = [v,]
|
||||
for p in v:
|
||||
s += f"# {p['name']} = {p['value']} {p['unit']}\n"
|
||||
s += "# {} = {} {}\n".format(p['name'], p['value'], p['unit'])
|
||||
return s
|
||||
|
||||
colnames = self.columns()
|
||||
with open(filename, mode) as fd:
|
||||
# write the date and time of export
|
||||
now = datetime.now()
|
||||
fd.write(f"# Data exported on {now}\n")
|
||||
fd.write("# Data exported on {}\n".format(now))
|
||||
fd.write(rule)
|
||||
|
||||
# Append notes
|
||||
fd.write("# NOTES:\n")
|
||||
for line in self.notes.split('\n'):
|
||||
fd.write(f"# {line}\n")
|
||||
fd.write("# {}\n".format(line))
|
||||
fd.write(rule)
|
||||
|
||||
# Append parameters
|
||||
|
|
|
|||
|
|
@ -1,6 +1,24 @@
|
|||
# coding: utf8
|
||||
# -*- encoding: future_fstrings -*-
|
||||
# vim: set et sw=4 ts=4 nu tw=79 cc=+1:
|
||||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
# This file is part of msspec.
|
||||
#
|
||||
# msspec is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
# msspec is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/looper.py
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
from collections import OrderedDict
|
||||
from functools import partial
|
||||
|
|
@ -21,7 +39,7 @@ class Variable:
|
|||
self.doc = doc
|
||||
|
||||
def __repr__(self):
|
||||
return f"<Variable(\'{self.name}\')>"
|
||||
return "<Variable(\'{}\')>".format(self.name)
|
||||
|
||||
class Sweep:
|
||||
def __init__(self, key, comments="", unit=None,
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -18,8 +19,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/misc.py
|
||||
# Last modified: ven. 10 avril 2020 17:30:42
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -18,8 +19,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/parameters.py
|
||||
# Last modified: ven. 10 avril 2020 17:31:50
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
@ -2012,20 +2013,20 @@ class CompCurveGeneralParameters(BaseParameters):
|
|||
value = p.allowed_values.index(p.value)
|
||||
self.compcurve_parameters.general_norm = value
|
||||
LOGGER.info("Curve Comparison: Normalization mode set to "
|
||||
f"\"{p.value}\"")
|
||||
"\"{}\"".format(p.value))
|
||||
|
||||
def bind_rescale(self, p):
|
||||
self.compcurve_parameters.general_iscale = int(p.value)
|
||||
state = "deactivated"
|
||||
if p.value:
|
||||
state = "activated"
|
||||
LOGGER.info(f"Curve Comparison: Rescaling of data {state}")
|
||||
LOGGER.info("Curve Comparison: Rescaling of data {}".format(state))
|
||||
|
||||
def bind_function(self, p):
|
||||
value = p.allowed_values.index(p.value)
|
||||
self.compcurve_parameters.general_icur = value
|
||||
LOGGER.info("Curve Comparison: Type of data used for comparison "
|
||||
f"set to \"{p.value}\"")
|
||||
"set to \"{}\"".format(p.value))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
.PHONY: all phd_se phd_mi eig_mi eig_pw comp_curve clean
|
||||
.PHONY: all phd_se phd_mi aed_se aed_mi eig_mi eig_pw comp_curve clean
|
||||
|
||||
all: phd_se phd_mi eig_mi eig_pw comp_curve
|
||||
all: phd_se phd_mi aed_se aed_mi eig_mi eig_pw comp_curve
|
||||
|
||||
phd_se:
|
||||
@+$(MAKE) -f phd_se_noso_nosp_nosym.mk all
|
||||
|
|
@ -8,6 +8,12 @@ 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
|
||||
|
||||
|
|
@ -20,6 +26,8 @@ comp_curve:
|
|||
clean::
|
||||
@+$(MAKE) -f phd_se_noso_nosp_nosym.mk $@
|
||||
@+$(MAKE) -f phd_mi_noso_nosp_nosym.mk $@
|
||||
@+$(MAKE) -f 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 $@
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
memalloc_src := memalloc/dim_mod.f memalloc/modules.f memalloc/allocation.f
|
||||
cluster_gen_src := $(wildcard cluster_gen/*.f)
|
||||
common_sub_src := $(wildcard common_sub/*.f)
|
||||
renormalization_src := $(wildcard renormalization/*.f)
|
||||
#aed_mi_mu_noso_nosp_nosym_src := $(wildcard aed_mi_mu_noso_nosp_nosym/*.f)
|
||||
aed_mi_mu_noso_nosp_nosym_src := $(filter-out aed_mi_mu_noso_nosp_nosym/lapack_axb.f, $(wildcard aed_mi_mu_noso_nosp_nosym/*.f))
|
||||
|
||||
SRCS = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(aed_mi_mu_noso_nosp_nosym_src)
|
||||
MAIN_F = aed_mi_mu_noso_nosp_nosym/main.f
|
||||
SO = _aed_mi_mu_noso_nosp_nosym.so
|
||||
|
||||
include ../../../options.mk
|
||||
|
|
@ -0,0 +1,789 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE AEDDIF_MI_MU(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOK,
|
||||
1 NATCLU,NFICHLEC,JFICH,NP,LE_MIN,LE_MAX)
|
||||
C
|
||||
C This subroutine computes the AED formula in the spin-independent case
|
||||
C from a multiplet resolved initial core state L1. The
|
||||
C intermediate state that gives its energy is L2 while the
|
||||
C core hole that is filled in the process is noted LC. The
|
||||
C multiplet is characterized by the integer angular momentum
|
||||
C variables (L_MUL,S_MUL,J_MUL)
|
||||
C
|
||||
C Alternatively, it can compute the AED amplitude for the APECS process.
|
||||
C
|
||||
C The calculation is performed using a matrix inversion for the
|
||||
C expression of the scattering path operator
|
||||
C
|
||||
C The matrix inversion is performed using the LAPACK inversion
|
||||
C routines for a general complex matrix
|
||||
C
|
||||
C Last modified : 26 Apr 2013
|
||||
C
|
||||
USE DIM_MOD
|
||||
|
||||
USE ALGORITHM_MOD
|
||||
USE AMPLI_MOD
|
||||
USE APPROX_MOD
|
||||
USE COOR_MOD, NTCLU => NATCLU, NTP => NATYP
|
||||
USE DEBWAL_MOD
|
||||
USE DIRECT_A_MOD, DIRANA => DIRANA_A, ANADIR => ANADIR_A,
|
||||
& RTHETA => RTHEXT_A, RPHI => RPHI_A,
|
||||
& THETAR => THETAR_A, PHIR => PHIR_A
|
||||
USE EXTREM_MOD
|
||||
USE FIXSCAN_A_MOD, N_FIXED => N_FIXED_A, N_SCAN => N_SCAN_A,
|
||||
& IPH_1 => IPH_1_A, FIX0 => FIX0_A,
|
||||
& FIX1 => FIX1_A, SCAN0 => SCAN0_A,
|
||||
& SCAN1 => SCAN1_A
|
||||
USE INFILES_MOD
|
||||
USE INUNITS_MOD
|
||||
USE INIT_J_MOD
|
||||
USE INIT_L_MOD
|
||||
USE INIT_M_MOD
|
||||
USE LIMAMA_MOD
|
||||
USE MOYEN_A_MOD, IMOY => IMOY_A, NDIR => NDIR_A,
|
||||
& ACCEPT => ACCEPT_A, ICHKDIR => ICHKDIR_A
|
||||
USE OUTFILES_MOD
|
||||
USE OUTUNITS_MOD
|
||||
USE PARCAL_A_MOD, NPHI => NPHI_A, NE => NE_A,
|
||||
& NTHETA => NTHETA_A, NFTHET => NFTHET_A
|
||||
USE RESEAU_MOD
|
||||
USE SPIN_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TESTS_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
|
||||
& IFTHET => IFTHET_A, IMOD => IMOD_A,
|
||||
& I_CP => I_CP_A, I_EXT => I_EXT_A,
|
||||
& I_TEST => I_TEST_A
|
||||
USE TYPEM_MOD
|
||||
USE TYPEXP_MOD
|
||||
USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
|
||||
& PHI1 => PHI1_A, THETA1 => THETA1_A
|
||||
USE VALIN_MOD, P0 => PHI0, T0 => THETA0, TM => THLUM,
|
||||
& PM => PHILUM, EM => ELUM
|
||||
C
|
||||
COMPLEX IC,ONEC,ZEROC,PW(0:NDIF_M)
|
||||
COMPLEX TLT(0:NT_M,4,NATM,NE_M),RHOMI
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLMR(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLME(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX R2,M_COUL(0:NL_M,-NL_M:NL_M,2,-LI_M:LI_M,2)
|
||||
COMPLEX SJDIR_1,SJDIF_1
|
||||
COMPLEX RHOK(0:NT_M,NATM,0:40,2,NSPIN2_M),COU
|
||||
COMPLEX SLJDIF,ATT_M,SLE_1
|
||||
COMPLEX SL0DIF,SMJDIF
|
||||
C
|
||||
DIMENSION VAL(NATCLU_M),NATYP(NATM)
|
||||
DIMENSION EMET(3),COORD(3,NATCLU_M)
|
||||
DIMENSION R(NDIF_M),XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),JPA(NDIF_M)
|
||||
C
|
||||
CHARACTER*7 STAT
|
||||
CHARACTER*24 INFILE
|
||||
CHARACTER*24 OUTFILE
|
||||
C
|
||||
DATA PIS180 /0.017453/
|
||||
DATA EV,SMALL /13.60583,0.0001/
|
||||
DATA BOHR /0.529177/
|
||||
C
|
||||
ALGO1=' '
|
||||
ALGO2='MI'
|
||||
ALGO3=' '
|
||||
ALGO4=' '
|
||||
C
|
||||
IC=(0.,1.)
|
||||
ONEC=(1.,0.)
|
||||
ZEROC=(0.,0.)
|
||||
NSCAT=NATCLU-1
|
||||
ATTSE=1.
|
||||
ATTSJ=1.
|
||||
ZSURF=VAL(1)
|
||||
C
|
||||
I_DIR=0
|
||||
NSET=1
|
||||
JEL=2
|
||||
C
|
||||
IF(SPECTRO.EQ.'AED') THEN
|
||||
IOUT=IUO2
|
||||
OUTFILE=OUTFILE2
|
||||
STAT='UNKNOWN'
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
ISET=IUI6
|
||||
INFILE=INFILE6
|
||||
ENDIF
|
||||
ELSEIF(SPECTRO.EQ.'APC') THEN
|
||||
IOUT=IUSCR2
|
||||
OUTFILE='res/auger.amp'
|
||||
STAT='UNKNOWN'
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
ISET=IUI9
|
||||
INFILE=INFILE9
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
LF1=LE_MIN
|
||||
LF2=LE_MAX
|
||||
ISTEP_LF=2
|
||||
C
|
||||
IF((ISOM.EQ.0).OR.(JFICH.EQ.1)) THEN
|
||||
OPEN(UNIT=IOUT, FILE=OUTFILE, STATUS=STAT)
|
||||
ENDIF
|
||||
C
|
||||
C Writing the headers in the output file
|
||||
C
|
||||
CALL HEADERS(IOUT)
|
||||
C
|
||||
IF((ISOM.EQ.0).OR.((ISOM.GT.0).AND.(JFICH.EQ.1))) THEN
|
||||
WRITE(IOUT,12) SPECTRO
|
||||
WRITE(IOUT,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
|
||||
1 IPH_1,I_EXT
|
||||
ENDIF
|
||||
C
|
||||
IF(ISOM.EQ.0) THEN
|
||||
WRITE(IOUT,79) NPLAN,NEMET,NTHETA,NPHI,NE
|
||||
ELSEIF((ISOM.NE.0).AND.(JFICH.EQ.1)) THEN
|
||||
WRITE(IOUT,11) NTHETA,NPHI,NE
|
||||
ENDIF
|
||||
IJK=0
|
||||
C
|
||||
C Loop over the planes
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
Z=VAL(JPLAN)
|
||||
IF((IPHA.EQ.1).OR.(IPHA.EQ.2)) THEN
|
||||
DZZEM=ABS(Z-ZEM)
|
||||
IF(DZZEM.LT.SMALL) GOTO 10
|
||||
GOTO 1
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
C
|
||||
C Loop over the different absorbers in a given plane
|
||||
C
|
||||
DO JEMET=1,NEMET
|
||||
CALL EMETT(JEMET,IEMET,Z,SYM_AT,NATYP,EMET,NTYPEM,
|
||||
1 JNEM,*4)
|
||||
GO TO 2
|
||||
4 IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN
|
||||
IF(I_TEST.NE.2) WRITE(IUO1,51) JPLAN,NTYPEM
|
||||
ENDIF
|
||||
GO TO 3
|
||||
2 IF((ABS(EMET(3)).GT.COUPUR).AND.(IBAS.EQ.1)) GOTO 5
|
||||
IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN
|
||||
IF(I_TEST.NE.2) THEN
|
||||
WRITE(IUO1,52) JPLAN,EMET(1),EMET(2),EMET(3),NTYPEM
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ISOM.EQ.1) NP=JPLAN
|
||||
ZSURFE=VAL(1)-EMET(3)
|
||||
JTE=IEMET(JEMET)
|
||||
JATLEM=JNEM
|
||||
C
|
||||
C Loop over the energies
|
||||
C
|
||||
DO JE=1,NE
|
||||
FMIN(0)=1.
|
||||
FMAX(0)=1.
|
||||
IF(I_TEST.NE.1) THEN
|
||||
CST VKR=REAL(VK(JE))
|
||||
VKR=ABS(VK(JE))
|
||||
ELSE
|
||||
VKR=1.
|
||||
ENDIF
|
||||
CST ECIN=VKR*VKR*BOHR*BOHR*EV/(A*A)+VINT
|
||||
ECIN=E0_A/(A*A)+VINT
|
||||
IF(I_TEST.NE.1) THEN
|
||||
CFM=2.*VKR
|
||||
ELSE
|
||||
CFM=1.
|
||||
ENDIF
|
||||
CALL LPM(ECIN,XLPM,*6)
|
||||
XLPM1=XLPM/A
|
||||
GAMMA=1./(2.*XLPM1)
|
||||
IF(IPOTC.EQ.0) THEN
|
||||
VK(JE)=VK(JE)+IC*GAMMA
|
||||
ENDIF
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,56) A,XLPM1
|
||||
IF((IPRINT.GT.0).AND.(IBAS.EQ.1)) THEN
|
||||
IF(I_TEST.NE.2) WRITE(IUO1,57) COUPUR
|
||||
ENDIF
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) THEN
|
||||
IF(IDCM.GE.1) WRITE(IUO1,22)
|
||||
DO JAT=1,N_PROT
|
||||
IF(IDCM.EQ.0) THEN
|
||||
XK2UJ2=VK2(JE)*UJ2(JAT)
|
||||
ELSE
|
||||
XK2UJ2=VK2(JE)*UJ_SQ(JAT)
|
||||
WRITE(IUO1,23) JAT,UJ_SQ(JAT)*A*A
|
||||
ENDIF
|
||||
CALL DWSPH_A(JAT,JE,XK2UJ2,TLT,ISPEED)
|
||||
DO LAT=0,LMAX(JAT,JE)
|
||||
TL(LAT,1,JAT,JE)=TLT(LAT,1,JAT,JE)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
OPEN(UNIT=ISET, FILE=INFILE, STATUS='OLD')
|
||||
READ(ISET,13) I_DIR,NSET,N_DUM1
|
||||
READ(ISET,14) I_DUM1,N_DUM2,N_DUM3
|
||||
ENDIF
|
||||
C
|
||||
C Initialization of TAU(INDJ,LINFMAX,JTYP)
|
||||
C
|
||||
JATL=0
|
||||
DO JTYP=1,N_PROT
|
||||
NBTYP=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYP
|
||||
JATL=JATL+1
|
||||
DO LE=LE_MIN,LE_MAX,2
|
||||
ILE=LE*LE+LE+1
|
||||
DO ME=-LE,LE
|
||||
INDE=ILE+ME
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
DO MJ=-LJ,LJ
|
||||
INDJ=ILJ+MJ
|
||||
TAU(INDJ,INDE,JATL)=ZEROC
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Storage of the coupling matrix elements M_COUL
|
||||
C
|
||||
DO MC=-LI,LI
|
||||
DO ISC=1,2
|
||||
SC=FLOAT(ISC)-1.5
|
||||
DO LA=LE_MIN,LE_MAX,2
|
||||
DO MA=-LA,LA
|
||||
DO ISA=1,2
|
||||
SA=FLOAT(ISA)-1.5
|
||||
CALL COUMAT_AM(LA,MA,SA,MC,SC,JTE,RHOK,COU)
|
||||
M_COUL(LA,MA,ISA,MC,ISC)=COU
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Matrix inversion for the calculation of TAU
|
||||
C
|
||||
IF(I_TEST.EQ.2) GOTO 666
|
||||
CALL INV_MAT_MS_A(JE,TAU)
|
||||
666 CONTINUE
|
||||
C
|
||||
C Calculation of the Auger Electron Diffraction formula
|
||||
C
|
||||
C
|
||||
C Loop over the 'fixed' angle
|
||||
C
|
||||
15 DO J_FIXED=1,N_FIXED
|
||||
IF(N_FIXED.GT.1) THEN
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
XINCRF=FLOAT(J_FIXED-1)*FIX_STEP
|
||||
ELSE
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
ELSEIF(N_FIXED.EQ.1) THEN
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
READ(ISET,86) JSET,JLINE,THD,PHD
|
||||
IF(I_EXT.EQ.-1) BACKSPACE ISET
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DPHI=PHI0+XINCRF
|
||||
ELSE
|
||||
DPHI=PHD
|
||||
ENDIF
|
||||
RPHI=DPHI*PIS180
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,66) DPHI
|
||||
ELSE
|
||||
ISAUT=0
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DTHETA=THETA0+XINCRF
|
||||
ELSE
|
||||
DTHETA=THD
|
||||
ENDIF
|
||||
RTHETA=DTHETA*PIS180
|
||||
IF(ABS(DTHETA).GT.90.) ISAUT=ISAUT+1
|
||||
IF(I_EXT.GE.1) ISAUT=0
|
||||
IF(I_TEST.EQ.2) ISAUT=0
|
||||
IF(ISAUT.GT.0) GOTO 8
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,65) DTHETA
|
||||
IF((IPRINT.GT.0).AND.(I_TEST.NE.2)) WRITE(IUO1,59)
|
||||
IF((IPRINT.EQ.1).AND.(I_TEST.NE.2)) WRITE(IUO1,60)
|
||||
C
|
||||
C THETA-dependent number of PHI points for stereographic
|
||||
C representation (to obtain a uniform sampling density).
|
||||
C (Courtesy of J. Osterwalder - University of Zurich)
|
||||
C
|
||||
IF(STEREO.EQ.'YES') THEN
|
||||
N_SCAN=INT((SCAN1-SCAN0)*SIN(RTHETA)/FIX_STEP+SMALL)+1
|
||||
ENDIF
|
||||
C
|
||||
ENDIF
|
||||
C
|
||||
C Loop over the scanned angle
|
||||
C
|
||||
DO J_SCAN=1,N_SCAN
|
||||
IF(N_SCAN.GT.1) THEN
|
||||
XINCRS=FLOAT(J_SCAN-1)*(SCAN1-SCAN0)/FLOAT(N_SCAN-1)
|
||||
ELSEIF(N_SCAN.EQ.1) THEN
|
||||
XINCRS=0.
|
||||
ENDIF
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
READ(ISET,86) JSET,JLINE,THD,PHD
|
||||
BACKSPACE ISET
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
ISAUT=0
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DTHETA=THETA0+XINCRS
|
||||
ELSE
|
||||
DTHETA=THD
|
||||
ENDIF
|
||||
RTHETA=DTHETA*PIS180
|
||||
IF(ABS(DTHETA).GT.90.) ISAUT=ISAUT+1
|
||||
IF(I_EXT.GE.1) ISAUT=0
|
||||
IF(I_TEST.EQ.2) ISAUT=0
|
||||
IF(ISAUT.GT.0) GOTO 8
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,65) DTHETA
|
||||
IF((IPRINT.GT.0).AND.(I_TEST.NE.2)) WRITE(IUO1,59)
|
||||
IF((IPRINT.EQ.1).AND.(I_TEST.NE.2)) WRITE(IUO1,60)
|
||||
ELSE
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DPHI=PHI0+XINCRS
|
||||
ELSE
|
||||
DPHI=PHD
|
||||
ENDIF
|
||||
RPHI=DPHI*PIS180
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,66) DPHI
|
||||
ENDIF
|
||||
C
|
||||
C Loop over the sets of directions to average over (for gaussian average)
|
||||
C
|
||||
C
|
||||
SSETDIR_1=0.
|
||||
SSETDIF_1=0.
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JREF=INT(NSET)/2+1
|
||||
ELSE
|
||||
JREF=1
|
||||
ENDIF
|
||||
C
|
||||
DO J_SET=1,NSET
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
READ(ISET,86) JSET,JLINE,THD,PHD,W
|
||||
DTHETA=THD
|
||||
DPHI=PHD
|
||||
RTHETA=DTHETA*PIS180
|
||||
RPHI=DPHI*PIS180
|
||||
ELSE
|
||||
W=1.
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) PRINT 89
|
||||
C
|
||||
CALL DIRAN(VINT,ECIN,JEL)
|
||||
IF(J_SET.EQ.JREF) THEN
|
||||
DTHETAP=DTHETA
|
||||
DPHIP=DPHI
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO1,88) DTHETA,DPHI
|
||||
ENDIF
|
||||
C
|
||||
WRITE(IUO1,61) (DIRANA(J,1),J=1,3)
|
||||
C
|
||||
SRDIF_1=0.
|
||||
SRDIR_1=0.
|
||||
C
|
||||
C Loop over the different directions of the analyzer contained in a cone
|
||||
C
|
||||
DO JDIR=1,NDIR
|
||||
IF(IATTS.EQ.1) THEN
|
||||
ATTSE=EXP(-ZSURFE*GAMMA/DIRANA(3,JDIR))
|
||||
ENDIF
|
||||
C
|
||||
SSCDIR_1=0.
|
||||
SSCDIF_1=0.
|
||||
C
|
||||
C Loop over the equiprobable quantum numbers MC,SC and SA
|
||||
C corresponding respectively to the core hole (MC and spin SC)
|
||||
C and to the outgoing Auger electron (SA). The sum over the
|
||||
C equiprobable azimuthal quantum number MJ of the multiplet
|
||||
C configuration is suppressed here as, because of the selection
|
||||
C rules, one has MJ = MA + MC + SA + SC
|
||||
C
|
||||
LME=LMAX(1,JE)
|
||||
CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLME,LME)
|
||||
C
|
||||
DO ISC=1,2
|
||||
SC=FLOAT(ISC)-1.5
|
||||
C
|
||||
SMCDIR_1=0.
|
||||
SMCDIF_1=0.
|
||||
C
|
||||
DO MC=-LI,LI
|
||||
C
|
||||
SSADIR_1=0.
|
||||
SSADIF_1=0.
|
||||
C
|
||||
DO ISA=1,2
|
||||
SA=FLOAT(ISA)-1.5
|
||||
C
|
||||
SMJMDIR_1=0.
|
||||
SMJMDIF_1=0.
|
||||
C
|
||||
DO MJM=-J_MUL,J_MUL
|
||||
C
|
||||
SJDIR_1=ZEROC
|
||||
SJDIF_1=ZEROC
|
||||
C
|
||||
C Calculation of the direct emission (used a a reference for the output)
|
||||
C
|
||||
DO L_E=LE_MIN,LE_MAX,2
|
||||
ILE=L_E*L_E+L_E+1
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
R2=TL(L_E,1,1,JE)
|
||||
ELSE
|
||||
R2=TLT(L_E,1,1,JE)
|
||||
ENDIF
|
||||
M_E=MJM-MC-ISA-ISC+3
|
||||
IF(ABS(M_E).GT.L_E) GOTO 444
|
||||
INDE=ILE+M_E
|
||||
SJDIR_1=SJDIR_1+YLME(L_E,M_E)*ATTSE*
|
||||
1 M_COUL(L_E,M_E,ISA,MC,ISC)*R2
|
||||
C
|
||||
C Contribution of the absorber to TAU (initialization of SJDIF)
|
||||
C
|
||||
IF(I_TEST.EQ.2) GOTO 444
|
||||
SL0DIF=ZEROC
|
||||
DO L0=0,LME
|
||||
IL0=L0*L0+L0+1
|
||||
SL0DIF=SL0DIF+YLME(L0,0)*TAU(IL0,INDE,1)
|
||||
DO M0=1,L0
|
||||
IND01=IL0+M0
|
||||
IND02=IL0-M0
|
||||
SL0DIF=SL0DIF+(YLME(L0,M0)*
|
||||
1 TAU(IND01,INDE,1)+
|
||||
2 YLME(L0,-M0)*
|
||||
3 TAU(IND02,INDE,1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
||||
SJDIF_1=SJDIF_1+SL0DIF*M_COUL(L_E,M_E,ISA,MC,ISC)
|
||||
444 CONTINUE
|
||||
ENDDO
|
||||
SJDIF_1=SJDIF_1*ATTSE
|
||||
C
|
||||
C Loop over the last atom J encountered by the photoelectron
|
||||
C before escaping the solid
|
||||
C
|
||||
IF(I_TEST.EQ.2) GOTO 111
|
||||
DO JTYP=2,N_PROT
|
||||
NBTYP=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYP
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
XOJ=SYM_AT(1,JATL)-EMET(1)
|
||||
YOJ=SYM_AT(2,JATL)-EMET(2)
|
||||
ZOJ=SYM_AT(3,JATL)-EMET(3)
|
||||
ROJ=SQRT(XOJ*XOJ+YOJ*YOJ+ZOJ*ZOJ)
|
||||
ZSURFJ=VAL(1)-SYM_AT(3,JATL)
|
||||
CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLMR,
|
||||
1 LMJ)
|
||||
IF(IATTS.EQ.1) THEN
|
||||
ATTSJ=EXP(-ZSURFJ*GAMMA/DIRANA(3,JDIR))
|
||||
ENDIF
|
||||
CSTHJR=(XOJ*DIRANA(1,JDIR)+YOJ*DIRANA(2,JDIR)+
|
||||
1 ZOJ*DIRANA(3,JDIR))/ROJ
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 78
|
||||
CTROIS1=ZOJ/ROJ
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
IF(IDCM.GE.1) THEN
|
||||
UJ2(JTYP)=UJ_SQ(JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(CSTHJR-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(DIRANA(3,JDIR)-CTROIS1)*
|
||||
1 (DIRANA(3,JDIR)-CTROIS1)/(2.
|
||||
2 -2.*CSTHJR)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
78 IF(IDWSPH.EQ.1) THEN
|
||||
DWTER=1.
|
||||
ELSE
|
||||
DWTER=EXP(-VK2(JE)*UJJ*(1.-CSTHJR))
|
||||
ENDIF
|
||||
IF(JATL.EQ.JATLEM) THEN
|
||||
ATT_M=ATTSE*DWTER
|
||||
ELSE
|
||||
ATT_M=ATTSJ*DWTER*CEXP(-IC*VK(JE)*ROJ*CSTHJR)
|
||||
ENDIF
|
||||
C
|
||||
SLE_1=ZEROC
|
||||
DO L_E=LE_MIN,LE_MAX,2
|
||||
ILE=L_E*L_E+L_E+1
|
||||
M_E=MJM-MC-ISA-ISC+3
|
||||
IF(ABS(M_E).GT.L_E) GOTO 555
|
||||
INDE=ILE+M_E
|
||||
SLJDIF=ZEROC
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
SMJDIF=YLMR(LJ,0)*TAU(ILJ,INDE,JATL)
|
||||
IF(LJ.GT.0) THEN
|
||||
DO MJ=1,LJ
|
||||
INDJ1=ILJ+MJ
|
||||
INDJ2=ILJ-MJ
|
||||
SMJDIF=SMJDIF+(YLMR(LJ,MJ)*
|
||||
1 TAU(INDJ1,INDE,JATL)+
|
||||
2 YLMR(LJ,-MJ)*
|
||||
3 TAU(INDJ2,INDE,JATL))
|
||||
ENDDO
|
||||
ENDIF
|
||||
SLJDIF=SLJDIF+SMJDIF
|
||||
ENDDO
|
||||
SLE_1=SLE_1+SLJDIF*M_COUL(L_E,M_E,ISA,MC,ISC)
|
||||
555 CONTINUE
|
||||
ENDDO
|
||||
SJDIF_1=SJDIF_1+SLE_1*ATT_M
|
||||
C
|
||||
C End of the loops over the last atom J
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Writing the amplitudes in file IOUT for APECS
|
||||
C
|
||||
111 IF(SPECTRO.EQ.'APC') THEN
|
||||
IF(I_TEST.EQ.2) SJDIF_1=SJDIR_1
|
||||
WRITE(IOUT,87) JFICH,JPLAN,JEMET,JE,J_FIXED,J_SCAN,
|
||||
1 JDIR,ISC,MC,ISA,MJM,SJDIR_1,SJDIF_1
|
||||
ELSE
|
||||
C
|
||||
C Computing the square modulus
|
||||
C
|
||||
SSADIF_1=SSADIF_1+CABS(SJDIF_1)*CABS(SJDIF_1)
|
||||
SSADIR_1=SSADIR_1+CABS(SJDIR_1)*CABS(SJDIR_1)
|
||||
C
|
||||
ENDIF
|
||||
C
|
||||
C End of the loop over MJM
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SMJMDIF_1=SMJMDIF_1+SSADIF_1
|
||||
SMJMDIR_1=SMJMDIR_1+SSADIR_1
|
||||
C
|
||||
C End of the loop over SA
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SMCDIF_1=SMCDIF_1+SMJMDIF_1
|
||||
SMCDIR_1=SMCDIR_1+SMJMDIR_1
|
||||
C
|
||||
C End of the loop over MC
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SSCDIF_1=SSCDIF_1+SMCDIF_1
|
||||
SSCDIR_1=SSCDIR_1+SMCDIR_1
|
||||
C
|
||||
C End of the loop over SC
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(SPECTRO.EQ.'APC') GOTO 220
|
||||
SRDIR_1=SRDIR_1+SSCDIR_1*VKR*CFM/NDIR
|
||||
SRDIF_1=SRDIF_1+SSCDIF_1*VKR*CFM/NDIR
|
||||
220 CONTINUE
|
||||
C
|
||||
C End of the loop on the directions of the analyzer
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(SPECTRO.EQ.'APC') GOTO 221
|
||||
SSETDIR_1=SSETDIR_1+SRDIR_1*W
|
||||
SSETDIF_1=SSETDIF_1+SRDIF_1*W
|
||||
IF(ICHKDIR.EQ.2) THEN
|
||||
IF(JSET.EQ.JREF) THEN
|
||||
SSET2DIR_1=SRDIR_1
|
||||
SSET2DIF_1=SRDIF_1
|
||||
ENDIF
|
||||
ENDIF
|
||||
221 CONTINUE
|
||||
C
|
||||
C End of the loop on the set averaging
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(SPECTRO.EQ.'APC') GOTO 222
|
||||
IF(ISOM.EQ.2) THEN
|
||||
WRITE(IOUT,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
|
||||
1 SSETDIR_1,SSETDIF_1
|
||||
IF(ICHKDIR.EQ.2) THEN
|
||||
WRITE(IUO2,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
|
||||
1 SSET2DIR_1,SSET2DIF_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IOUT,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
|
||||
1 SSETDIR_1,SSETDIF_1
|
||||
IF(ICHKDIR.EQ.2) THEN
|
||||
WRITE(IUO2,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
|
||||
1 SSET2DIR_1,SSET2DIF_1
|
||||
ENDIF
|
||||
ENDIF
|
||||
222 CONTINUE
|
||||
C
|
||||
C End of the loop on the scanned angle
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
8 CONTINUE
|
||||
C
|
||||
C End of the loop on the fixed angle
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
C End of the loop on the energy
|
||||
C
|
||||
CLOSE(ISET)
|
||||
ENDDO
|
||||
C
|
||||
3 CONTINUE
|
||||
C
|
||||
C End of the loop on the emitters
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
GO TO 1
|
||||
5 IPLAN=JPLAN-1
|
||||
IJK=IJK+1
|
||||
IF((IJK.EQ.1).AND.(IPRINT.GT.0)) THEN
|
||||
IF(I_TEST.NE.2) WRITE(IUO1,54) IPLAN
|
||||
ENDIF
|
||||
1 CONTINUE
|
||||
C
|
||||
C End of the loop on the planes
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(ABS(I_EXT).GE.1) CLOSE(ISET)
|
||||
IF((ISOM.EQ.0).OR.(JFICH.EQ.NFICHLEC)) WRITE(IOUT,*)
|
||||
IF(SPECTRO.EQ.'APC') CLOSE(IOUT)
|
||||
IF(SPECTRO.EQ.'APC') GOTO 7
|
||||
c IF(((NEMET.GT.1).OR.(NPLAN.GT.1)).AND.(ISOM.EQ.0)) THEN
|
||||
IF(((NEMET.GT.1).OR.(NPLAN.GT.0)).AND.(ISOM.EQ.0)) THEN
|
||||
NP=0
|
||||
CALL TREAT_AED(ISOM,NFICHLEC,JFICH,NP)
|
||||
ENDIF
|
||||
IF(I_EXT.EQ.2) THEN
|
||||
CALL WEIGHT_SUM(ISOM,I_EXT,0,1)
|
||||
ENDIF
|
||||
GOTO 7
|
||||
6 WRITE(IUO1,55)
|
||||
C
|
||||
9 FORMAT(9(2X,I1),2X,I2)
|
||||
11 FORMAT(I4,2X,I4,2X,I4)
|
||||
12 FORMAT(2X,A3)
|
||||
13 FORMAT(6X,I1,1X,I3,2X,I4)
|
||||
14 FORMAT(6X,I1,1X,I3,3X,I3)
|
||||
22 FORMAT(16X,'INTERNAL CALCULATION OF MEAN SQUARE DISPLACEMENTS',/,
|
||||
1 25X,' BY DEBYE UNCORRELATED MODEL:',/)
|
||||
23 FORMAT(21X,'ATOM TYPE ',I5,' MSD = ',F8.6,' ANG**2')
|
||||
51 FORMAT(/////,2X,'******* PLANE NUMBER ',I3,' DOES NOT CONTAIN ',
|
||||
*'ANY ABSORBER OF TYPE ',I2,' *******')
|
||||
52 FORMAT(/////,2X,'******* PLANE NUMBER ',I3,' POSITION OF ',
|
||||
1'THE ABSORBER : (',F6.3,',',F6.3,',',F6.3,') *******',/,2X,
|
||||
2'******* ',19X,'THIS ABSORBER IS OF TYPE ',I2,20X,' *******')
|
||||
53 FORMAT(//,2X,'ORDER ',I2,' TOTAL NUMBER OF PATHS : ',F15.1,
|
||||
1 /,10X,' EFFECTIVE NUMBER OF PATHS : ',F15.1,
|
||||
2 /,10X,' MINIMAL INTENSITY : ',E12.6,
|
||||
3 2X,'No OF THE PATH : ',F15.1,
|
||||
4 /,10X,' MAXIMAL INTENSITY : ',E12.6,
|
||||
5 2X,'No OF THE PATH : ',F15.1)
|
||||
54 FORMAT(//,7X,'DUE TO THE SIZE OF THE CLUSTER, THE SUMMATION',
|
||||
*' HAS BEEN TRUNCATED TO THE ',I2,' TH PLANE')
|
||||
55 FORMAT(///,12X,' <<<<<<<<<< THIS VALUE OF ILPM IS NOT',
|
||||
*'AVAILABLE >>>>>>>>>>')
|
||||
56 FORMAT(4X,'LATTICE PARAMETER A = ',F6.3,' ANGSTROEMS',4X,
|
||||
*'MEAN FREE PATH = ',F6.3,' * A',//)
|
||||
57 FORMAT(25X,'CLUSTER RADIUS = ',F6.3,' *A')
|
||||
58 FORMAT(//,2X,'ORDER ',I2,' TOTAL NUMBER OF PATHS : ',I10,
|
||||
1 /,10X,' EFFECTIVE NUMBER OF PATHS : ',I10,
|
||||
2 /,10X,' MINIMAL INTENSITY : ',E12.6,
|
||||
3 2X,'No OF THE PATH : ',I10,
|
||||
4 /,10X,' MAXIMAL INTENSITY : ',E12.6,
|
||||
5 2X,'No OF THE PATH : ',I10)
|
||||
59 FORMAT(//,15X,'THE SCATTERING DIRECTION IS GIVEN INSIDE ',
|
||||
*'THE CRYSTAL')
|
||||
60 FORMAT(7X,'THE POSITIONS OF THE ATOMS ARE GIVEN WITH RESPECT ',
|
||||
*'TO THE ABSORBER')
|
||||
61 FORMAT(///,4X,'.......... DIRECTION OF THE DETECTOR : (',
|
||||
1 F6.3,',',F6.3,',',F6.3,') ..........')
|
||||
65 FORMAT(////,3X,'++++++++++++++++++',9X,
|
||||
*'THETA = ',F6.2,' DEGREES',9X,'++++++++',
|
||||
*'++++++++++',///)
|
||||
66 FORMAT(////,3X,'++++++++++++++++++',9X,
|
||||
*'PHI = ',F6.2,' DEGREES',9X,'++++++++++',
|
||||
*'++++++++++',///)
|
||||
67 FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
|
||||
1 2X,E12.6)
|
||||
68 FORMAT(10X,' CUT-OFF INTENSITY : ',E12.6)
|
||||
69 FORMAT(9X,I2,2X,E12.6,7X,E12.6,1X,F6.3,1X,10(I3,2X))
|
||||
70 FORMAT(2X,I2,2X,I10,7X,E12.6,2X,F6.3,7X,I2,7X,10(I3,2X))
|
||||
71 FORMAT(//,1X,'JDIF',4X,'No OF THE PATH',2X,
|
||||
1 'INTENSITY',3X,'LENGTH',4X,'ABSORBER',2X,
|
||||
2 'ORDER OF THE SCATTERERS',/)
|
||||
74 FORMAT(10X,'<===== NUMBER OF PATHS TOO LARGE FOR PRINTING ',
|
||||
1 '=====>')
|
||||
76 FORMAT(2X,I2,2X,E12.6,7X,E12.6,2X,F6.3,7X,I2,7X,10(I3,2X))
|
||||
77 FORMAT(' ')
|
||||
79 FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
|
||||
80 FORMAT(///)
|
||||
81 FORMAT(//,1X,'RANK',1X,'ORDER',4X,'No PATH',3X,
|
||||
1 'INTENSITY',3X,'LENGTH',4X,'ABS',3X,
|
||||
2 'ORDER OF THE SCATTERERS',/)
|
||||
82 FORMAT(I3,4X,I2,1X,E12.6,3X,E12.6,2X,F6.3,4X,I2,4X,10(I3,1X))
|
||||
83 FORMAT(I3,4X,I2,1X,I10,3X,E12.6,2X,F6.3,4X,I2,4X,10(I3,1X))
|
||||
84 FORMAT(/////,18X,'THE ',I3,' MORE INTENSE PATHS BY DECREASING',
|
||||
1 ' ORDER :',/,24X,'(THE LENGTH IS GIVEN IN UNITS ',
|
||||
2 'OF A)')
|
||||
85 FORMAT(/////,25X,' PATHS USED IN THE CALCULATION : ',
|
||||
1 /,24X,'(THE LENGTH IS GIVEN IN UNITS OF A)')
|
||||
86 FORMAT(2X,I3,1X,I4,5X,F8.3,3X,F8.3,3X,E12.6)
|
||||
87 FORMAT(2X,I2,2X,I3,2X,I2,2X,I3,2X,I3,2X,I3,2X,I2,2X,I2,2X,I2,
|
||||
1 2X,I2,2X,I2,2X,E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
|
||||
88 FORMAT(/,19X,'TILTED THETA =',F6.2,5X,'TILTED PHI =',
|
||||
1 F6.2)
|
||||
89 FORMAT(/,4X,'..........................................',
|
||||
1 '.....................................')
|
||||
C
|
||||
7 RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,198 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE INV_MAT_MS_A(JE,TAU)
|
||||
C
|
||||
C This subroutine stores the multiple scattering matrix and computes
|
||||
C the scattering path operator TAU^{j 0} exactly, without explicitely
|
||||
C using the inverse matrix.
|
||||
C
|
||||
C (Auger electron case)
|
||||
C
|
||||
C Last modified : 31 Jul 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE COOR_MOD
|
||||
USE INIT_L_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, VK2 =>
|
||||
& VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
C
|
||||
C PARAMETER(NLTWO=2*NL_M)
|
||||
C
|
||||
COMPLEX*16 HL1(0:2*NL_M),SM(LINMAXA*NATCLU_M,LINMAXA*NATCLU_M)
|
||||
COMPLEX*16 IN(LINMAXA*NATCLU_M,LINMAXA)
|
||||
COMPLEX*16 SUM_L,ONEC,IC,ZEROC
|
||||
COMPLEX*16 YLM(0:2*NL_M,-2*NL_M:2*NL_M),TLJ,TLK,EXPKJ
|
||||
C
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
C
|
||||
REAL*8 PI,ATTKJ,GNT(0:N_GAUNT),XKJ,YKJ,ZKJ,RKJ,ZDKJ,KRKJ
|
||||
C
|
||||
INTEGER IPIV(LINMAXA*NATCLU_M)
|
||||
C
|
||||
CHARACTER*1 CH
|
||||
C
|
||||
DATA PI /3.1415926535898D0/
|
||||
C
|
||||
ONEC=(1.D0,0.D0)
|
||||
IC=(0.D0,1.D0)
|
||||
ZEROC=(0.D0,0.D0)
|
||||
IBESS=3
|
||||
CH='N'
|
||||
C
|
||||
C Construction of the multiple scattering matrix MS = (I-GoT).
|
||||
C Elements are stored using a linear index LINJ representing
|
||||
C (J,LJ)
|
||||
C
|
||||
JLIN=0
|
||||
DO JTYP=1,N_PROT
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
XJ=SYM_AT(1,JATL)
|
||||
YJ=SYM_AT(2,JATL)
|
||||
ZJ=SYM_AT(3,JATL)
|
||||
C
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
TLJ=DCMPLX(TL(LJ,1,JTYP,JE))
|
||||
DO MJ=-LJ,LJ
|
||||
INDJ=ILJ+MJ
|
||||
JLIN=JLIN+1
|
||||
C
|
||||
KLIN=0
|
||||
DO KTYP=1,N_PROT
|
||||
NBTYPK=NATYP(KTYP)
|
||||
LMK=LMAX(KTYP,JE)
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
IF(KATL.NE.JATL) THEN
|
||||
XKJ=DBLE(SYM_AT(1,KATL)-XJ)
|
||||
YKJ=DBLE(SYM_AT(2,KATL)-YJ)
|
||||
ZKJ=DBLE(SYM_AT(3,KATL)-ZJ)
|
||||
RKJ=DSQRT(XKJ*XKJ+YKJ*YKJ+ZKJ*ZKJ)
|
||||
KRKJ=DBLE(VK(JE))*RKJ
|
||||
ATTKJ=DEXP(-DIMAG(DCMPLX(VK(JE)))*RKJ)
|
||||
EXPKJ=(XKJ+IC*YKJ)/RKJ
|
||||
ZDKJ=ZKJ/RKJ
|
||||
CALL SPH_HAR2(2*NL_M,ZDKJ,EXPKJ,YLM,LMJ+LMK)
|
||||
CALL BESPHE2(LMJ+LMK+1,IBESS,KRKJ,HL1)
|
||||
ENDIF
|
||||
C
|
||||
DO LK=0,LMK
|
||||
ILK=LK*LK+LK+1
|
||||
L_MIN=ABS(LK-LJ)
|
||||
L_MAX=LK+LJ
|
||||
TLK=DCMPLX(TL(LK,1,KTYP,JE))
|
||||
DO MK=-LK,LK
|
||||
INDK=ILK+MK
|
||||
KLIN=KLIN+1
|
||||
SM(KLIN,JLIN)=ZEROC
|
||||
SUM_L=ZEROC
|
||||
IF(KATL.NE.JATL) THEN
|
||||
CALL GAUNT2(LK,MK,LJ,MJ,GNT)
|
||||
C
|
||||
DO L=L_MIN,L_MAX,2
|
||||
M=MJ-MK
|
||||
IF(ABS(M).LE.L) THEN
|
||||
SUM_L=SUM_L+(IC**L)*HL1(L)*
|
||||
1 YLM(L,M)*GNT(L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
SUM_L=SUM_L*ATTKJ*4.D0*PI*IC
|
||||
ELSE
|
||||
SUM_L=ZEROC
|
||||
ENDIF
|
||||
C
|
||||
IF(KLIN.EQ.JLIN) THEN
|
||||
SM(KLIN,JLIN)=ONEC-TLK*SUM_L
|
||||
IF(JTYP.EQ.1) THEN
|
||||
IN(KLIN,JLIN)=ONEC
|
||||
ENDIF
|
||||
ELSE
|
||||
SM(KLIN,JLIN)=-TLK*SUM_L
|
||||
IF(JTYP.EQ.1) THEN
|
||||
IN(KLIN,JLIN)=ZEROC
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
LW2=(LMAX(1,JE)+1)*(LMAX(1,JE)+1)
|
||||
C
|
||||
C Partial inversion of the multiple scattering matrix MS and
|
||||
C multiplication by T : the LAPACK subroutine performing
|
||||
C
|
||||
C A * x = b
|
||||
C
|
||||
C is used where b is the block column corresponding to
|
||||
C the absorber 0 in the identity matrix. x is then TAU^{j 0}.
|
||||
C
|
||||
CALL ZGETRF(JLIN,JLIN,SM,LINMAXA*NATCLU_M,IPIV,INFO1)
|
||||
IF(INFO1.NE.0) THEN
|
||||
WRITE(6,*) ' ---> INFO1 =',INFO1
|
||||
ELSE
|
||||
CALL ZGETRS(CH,JLIN,LW2,SM,LINMAXA*NATCLU_M,IPIV,
|
||||
1 IN,LINMAXA*NATCLU_M,INFO)
|
||||
ENDIF
|
||||
C
|
||||
C Storage of the Tau matrix
|
||||
C
|
||||
JLIN=0
|
||||
DO JTYP=1,N_PROT
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
C
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
TLJ=DCMPLX(TL(LJ,1,JTYP,JE))
|
||||
DO MJ=-LJ,LJ
|
||||
INDJ=ILJ+MJ
|
||||
JLIN=JLIN+1
|
||||
C
|
||||
KLIN=0
|
||||
DO KTYP=1,N_PROT
|
||||
NBTYPK=NATYP(KTYP)
|
||||
LMK=LMAX(KTYP,JE)
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
C
|
||||
DO LK=0,LMK
|
||||
ILK=LK*LK+LK+1
|
||||
DO MK=-LK,LK
|
||||
INDK=ILK+MK
|
||||
KLIN=KLIN+1
|
||||
IF((JATL.EQ.1).AND.(LJ.LE.LF2)) THEN
|
||||
TAU(INDK,INDJ,KATL)=CMPLX(IN(KLIN,JLIN)*TLJ)
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE COUMAT_AM(LA,MA,SA,MC,SC,JE,RHOK_A,MATRIX_AM)
|
||||
C
|
||||
C This routine calculates the multiplet-resolved spin-independent
|
||||
C Coulomb matrix elements occuring in the Auger process. They
|
||||
C are stored in MATRIX_AM. The multiplet component is characterized
|
||||
C by the quantum numbers (L,S,J) which are read from the input
|
||||
C data file.
|
||||
C
|
||||
C Here, the conventions are (direct process D):
|
||||
C
|
||||
C (LC,MC) : core hole filled by intermediate electron
|
||||
C (L1,M1) : Auger electron before excitation
|
||||
C (L2,M2) : intermediate electron that fills the core hole
|
||||
C (LA,MA) : Auger electron after excitation
|
||||
C
|
||||
C In the exchange process E, the roles of (L1,M1) and (L2,M2)
|
||||
C are interchanged.
|
||||
C
|
||||
C Note that the Clebsch-Gordan corresponding to the spin-orbit
|
||||
C resolved core state is not included in the formula here. This
|
||||
C is because in APECS, it appears also in the dipole matrix
|
||||
C element and it is therefore useless to calculate it twice.
|
||||
C Therefore, it must be implemented into the cross-section
|
||||
C subroutine.
|
||||
C
|
||||
C The factor i**LA comes from the particular normalization used
|
||||
C in the phagen code
|
||||
C
|
||||
C Last modified : 8 Dec 2008
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE C_G_M_MOD
|
||||
USE INIT_A_MOD, LC => LI_C, L2 => LI_I, L1 => LI_A
|
||||
USE TYPCAL_A_MOD, I1 => IPHI_A, I2 => IE_A, I3 => ITHETA_A,
|
||||
1 I4 => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A,
|
||||
2 I7 => I_EXT_A, I_TEST => I_TEST_A
|
||||
USE INIT_M_MOD
|
||||
C
|
||||
COMPLEX RHOK_A(0:NT_M,NATM,0:40,2,NSPIN2_M)
|
||||
COMPLEX ZEROC,ONEC,MATRIX_AM
|
||||
COMPLEX SUM_LB,SUM_M1,IC,IL
|
||||
C
|
||||
REAL*4 CG1(0:N_GAUNT),CG2(0:N_GAUNT)
|
||||
REAL*4 GNT1(0:N_GAUNT),GNT2(0:N_GAUNT),GNT3(0:N_GAUNT)
|
||||
REAL*4 GNT4(0:N_GAUNT)
|
||||
C
|
||||
REAL*8 ZEROD
|
||||
C
|
||||
DATA PI4,ONEOSQ2,HALF /12.566371,0.707107,0.5/
|
||||
C
|
||||
ZEROC=(0.,0.)
|
||||
ONEC=(1.,0.)
|
||||
IC=(0.,1.)
|
||||
ZEROD=0.D0
|
||||
C
|
||||
IF(I_TEST.EQ.1) GOTO 2
|
||||
C
|
||||
IF(MOD(LA,4).EQ.0) THEN
|
||||
IL=ONEC
|
||||
ELSEIF(MOD(LA,4).EQ.1) THEN
|
||||
IL=IC
|
||||
ELSEIF(MOD(LA,4).EQ.2) THEN
|
||||
IL=-ONEC
|
||||
ELSEIF(MOD(LA,4).EQ.3) THEN
|
||||
IL=-IC
|
||||
ENDIF
|
||||
C
|
||||
IF(I_SHELL.EQ.0) THEN
|
||||
COEF1=ONEOSQ2*PI4
|
||||
ELSEIF(I_SHELL.EQ.1) THEN
|
||||
COEF1=HALF*PI4
|
||||
ENDIF
|
||||
C
|
||||
IF(MOD(S_MUL,2).EQ.0) THEN
|
||||
SIGN1=1.
|
||||
ELSE
|
||||
SIGN1=-1.
|
||||
ENDIF
|
||||
C
|
||||
C Values of MJ, ML and MS given by the Clebsch-Gordan
|
||||
C
|
||||
ML=MA+MC
|
||||
MS=INT(SA+SC+0.0001)
|
||||
MJ=ML+MS
|
||||
C
|
||||
C Storage indices for the spin Clebsch-Gordan :
|
||||
C
|
||||
C ISA(C) = 1 for -1/2 and 2 for 1/2
|
||||
C IS = 1 for S_MUL=0 and 2 for S_MUL=1
|
||||
C
|
||||
IS=S_MUL+1
|
||||
ISA=INT(SA+1.5001)
|
||||
ISC=INT(SC+1.5001)
|
||||
C
|
||||
C Bounds of the sum over LB
|
||||
C
|
||||
LB_MAX_D=MIN(L1+LA,L2+LC)
|
||||
LB_MIN_D=MAX(ABS(L1-LA),ABS(L2-LC))
|
||||
LB_MAX_E=MIN(L2+LA,L1+LC)
|
||||
LB_MIN_E=MAX(ABS(L2-LA),ABS(L1-LC))
|
||||
LB_MIN=MIN(LB_MIN_D,LB_MIN_E)
|
||||
LB_MAX=MAX(LB_MAX_D,LB_MAX_E)
|
||||
C
|
||||
N_CG=2
|
||||
CALL N_J(DFLOAT(L_MUL),DFLOAT(ML),DFLOAT(S_MUL),DFLOAT(MS),
|
||||
1 ZEROD,CG1,I_INT1,N_CG)
|
||||
C
|
||||
SUM_M1=ZEROC
|
||||
DO M1=-L1,L1
|
||||
M2=ML-M1
|
||||
C
|
||||
CALL N_J(DFLOAT(L1),DFLOAT(M1),DFLOAT(L2),DFLOAT(ML-M1),
|
||||
1 ZEROD,CG2,I_INT2,N_CG)
|
||||
CALL GAUNT(L1,M1,LA,MA,GNT1)
|
||||
CALL GAUNT(LC,MC,L2,M2,GNT2)
|
||||
CALL GAUNT(L2,M2,LA,MA,GNT3)
|
||||
CALL GAUNT(LC,MC,L1,M1,GNT4)
|
||||
C
|
||||
SUM_LB=ZEROC
|
||||
DO LB=LB_MIN,LB_MAX
|
||||
SUM_LB=SUM_LB+(RHOK_A(LA,JE,LB,1,1)*GNT1(LB)*GNT2(LB)+
|
||||
1 RHOK_A(LA,JE,LB,2,1)*GNT3(LB)*GNT4(LB)*
|
||||
2 SIGN1)/FLOAT(LB+LB+1)
|
||||
ENDDO
|
||||
SUM_M1=SUM_M1+SUM_LB*CG2(L_MUL)
|
||||
ENDDO
|
||||
C
|
||||
MATRIX_AM=SUM_M1*CG1(J_MUL)*CG_S(ISA,ISC,IS)*COEF1*IL
|
||||
C
|
||||
GOTO 1
|
||||
C
|
||||
2 MATRIX_AM=ONEC
|
||||
C
|
||||
1 RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE DWSPH_A(JTYP,JE,X,TLT,ISPEED)
|
||||
C
|
||||
C This routine recomputes the T-matrix elements taking into account the
|
||||
C mean square displacements.
|
||||
C
|
||||
C When the argument X is tiny, no vibrations are taken into account
|
||||
C
|
||||
C Last modified : 25 Apr 2013
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, VK2 =>
|
||||
& VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
C
|
||||
DIMENSION GNT(0:N_GAUNT)
|
||||
C
|
||||
COMPLEX TLT(0:NT_M,4,NATM,NE_M),SL1,ZEROC
|
||||
C
|
||||
COMPLEX*16 FFL(0:2*NL_M)
|
||||
C
|
||||
DATA PI4,EPS /12.566371,1.0E-10/
|
||||
C
|
||||
ZEROC=(0.,0.)
|
||||
C
|
||||
IF(X.GT.EPS) THEN
|
||||
C
|
||||
C Standard case: vibrations
|
||||
C
|
||||
IF(ISPEED.LT.0) THEN
|
||||
NSUM_LB=ABS(ISPEED)
|
||||
ENDIF
|
||||
C
|
||||
COEF=PI4*EXP(-X)
|
||||
NL2=2*LMAX(JTYP,JE)+2
|
||||
IBESP=5
|
||||
MG1=0
|
||||
MG2=0
|
||||
C
|
||||
CALL BESPHE(NL2,IBESP,X,FFL)
|
||||
C
|
||||
DO L=0,LMAX(JTYP,JE)
|
||||
XL=FLOAT(L+L+1)
|
||||
SL1=ZEROC
|
||||
C
|
||||
DO L1=0,LMAX(JTYP,JE)
|
||||
XL1=FLOAT(L1+L1+1)
|
||||
CALL GAUNT(L,MG1,L1,MG2,GNT)
|
||||
L2MIN=ABS(L1-L)
|
||||
IF(ISPEED.GE.0) THEN
|
||||
L2MAX=L1+L
|
||||
ELSEIF(ISPEED.LT.0) THEN
|
||||
L2MAX=L2MIN+2*(NSUM_LB-1)
|
||||
ENDIF
|
||||
SL2=0.
|
||||
C
|
||||
DO L2=L2MIN,L2MAX,2
|
||||
XL2=FLOAT(L2+L2+1)
|
||||
C=SQRT(XL1*XL2/(PI4*XL))
|
||||
SL2=SL2+C*GNT(L2)*REAL(DREAL(FFL(L2)))
|
||||
ENDDO
|
||||
C
|
||||
SL1=SL1+SL2*TL(L1,1,JTYP,JE)
|
||||
ENDDO
|
||||
C
|
||||
TLT(L,1,JTYP,JE)=COEF*SL1
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ELSE
|
||||
C
|
||||
C Argument X tiny: no vibrations
|
||||
C
|
||||
DO L=0,LMAX(JTYP,JE)
|
||||
C
|
||||
TLT(L,1,JTYP,JE)=TL(L,1,JTYP,JE)
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDIF
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FACDIF1_A(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,
|
||||
1 FSPH,JAT,JE,*)
|
||||
C
|
||||
C This routine computes a spherical wave scattering factor
|
||||
C
|
||||
C Last modified : 03/04/2006
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD
|
||||
USE EXPFAC_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
USE TYPCAL_A_MOD, I2 => IPHI_A, I3 => IE_A, I4 => ITHETA_A,
|
||||
& IFTHET => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A,
|
||||
& I7 => I_EXT_A, I8 => I_TEST_A
|
||||
C
|
||||
DIMENSION PLMM(0:100,0:100)
|
||||
DIMENSION D(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
|
||||
C
|
||||
COMPLEX HLM(0:NO_ST_M,0:NL_M-1),HLN(0:NO_ST_M,0:NL_M-1),FSPH,RHOJ
|
||||
COMPLEX HLM1,HLM2,HLM3,HLM4,ALMU,BLMU,SLP,SNU,SMU,VKE
|
||||
COMPLEX RHOJK
|
||||
C
|
||||
DATA PI/3.141593/
|
||||
C
|
||||
A=1.
|
||||
INTER=0
|
||||
IF(ITL.EQ.1) VKE=VK(JE)
|
||||
RHOJ=VKE*RJ
|
||||
RHOJK=VKE*RJK
|
||||
HLM1=(1.,0.)
|
||||
HLM2=(1.,0.)
|
||||
HLM3=(1.,0.)
|
||||
HLM4=(1.,0.)
|
||||
IEM=1
|
||||
CSTH=COS(BETA)
|
||||
IF((IFTHET.EQ.0).OR.(THRJ.LT.0.0001)) THEN
|
||||
INTER=1
|
||||
BLMU=SQRT(4.*PI/FLOAT(2*L+1))*CEXP((0.,-1.)*M*(PHIRJ-PI))
|
||||
ENDIF
|
||||
CALL PLM(CSTH,PLMM,LMAX(JAT,JE))
|
||||
IF(ISPHER.EQ.0) NO1=0
|
||||
IF(ISPHER.EQ.1) THEN
|
||||
IF(NO.EQ.8) THEN
|
||||
NO1=LMAX(JAT,JE)+1
|
||||
ELSE
|
||||
NO1=NO
|
||||
ENDIF
|
||||
CALL POLHAN(ISPHER,NO1,LMAX(JAT,JE),RHOJ,HLM)
|
||||
IF(IEM.EQ.0) THEN
|
||||
HLM4=HLM(0,L)
|
||||
ENDIF
|
||||
IF(RJK.GT.0.0001) THEN
|
||||
NDUM=0
|
||||
CALL POLHAN(ISPHER,NDUM,LMAX(JAT,JE),RHOJK,HLN)
|
||||
ENDIF
|
||||
CALL DJMN(THRJ,D,L)
|
||||
A1=ABS(D(0,M,L))
|
||||
IF(((A1.LT.0.0001).AND.(IFTHET.EQ.1)).AND.(INTER.EQ.0)) RETURN 1
|
||||
ENDIF
|
||||
MUMAX=MIN0(L,NO1)
|
||||
SMU=(0.,0.)
|
||||
DO 10 MU=0,MUMAX
|
||||
IF(MOD(MU,2).EQ.0) THEN
|
||||
B=1.
|
||||
ELSE
|
||||
B=-1.
|
||||
IF(SIN(BETA).LT.0.) THEN
|
||||
A=-1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ISPHER.LE.1) THEN
|
||||
ALMU=(1.,0.)
|
||||
C=1.
|
||||
ENDIF
|
||||
IF(ISPHER.EQ.0) GOTO 40
|
||||
IF(INTER.EQ.0) BLMU=CMPLX(D(M,0,L))
|
||||
IF(MU.GT.0) THEN
|
||||
C=B*FLOAT(L+L+1)/EXPF(MU,L)
|
||||
ALMU=(D(M,MU,L)*CEXP((0.,-1.)*MU*GAMMA)+B*
|
||||
* CEXP((0.,1.)*MU*GAMMA)*D(M,-MU,L))/BLMU
|
||||
ELSE
|
||||
C=1.
|
||||
ALMU=CMPLX(D(M,0,L))/BLMU
|
||||
ENDIF
|
||||
40 SNU=(0.,0.)
|
||||
NU1=INT(0.5*(NO1-MU)+0.0001)
|
||||
NUMAX=MIN0(NU1,L-MU)
|
||||
DO 20 NU=0,NUMAX
|
||||
SLP=(0.,0.)
|
||||
LPMIN=MAX0(MU,NU)
|
||||
DO 30 LP=LPMIN,LMAX(JAT,JE)
|
||||
IF(ISPHER.EQ.1) THEN
|
||||
HLM1=HLM(NU,LP)
|
||||
IF(RJK.GT.0.0001) HLM3=HLN(0,LP)
|
||||
ENDIF
|
||||
SLP=SLP+FLOAT(2*LP+1)*TL(LP,1,JAT,JE)*HLM1*PLMM(LP,MU)*HLM3
|
||||
30 CONTINUE
|
||||
IF(ISPHER.EQ.1) THEN
|
||||
HLM2=HLM(MU+NU,L)
|
||||
ENDIF
|
||||
SNU=SNU+SLP*HLM2
|
||||
20 CONTINUE
|
||||
SMU=SMU+SNU*C*ALMU*A*B
|
||||
10 CONTINUE
|
||||
FSPH=SMU/(VKE*HLM4)
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FACDIF_A(COSTH,JAT,JE,FTHETA)
|
||||
C
|
||||
C This routine computes the plane wave scattering factor
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
C
|
||||
DIMENSION PL(0:100)
|
||||
C
|
||||
COMPLEX FTHETA
|
||||
C
|
||||
FTHETA=(0.,0.)
|
||||
NL=LMAX(JAT,JE)+1
|
||||
CALL POLLEG(NL,COSTH,PL)
|
||||
DO 20 L=0,NL-1
|
||||
FTHETA=FTHETA+(2*L+1)*TL(L,1,JAT,JE)*PL(L)
|
||||
20 CONTINUE
|
||||
FTHETA=FTHETA/VK(JE)
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,21 @@
|
|||
SUBROUTINE RUN(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_,
|
||||
& NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_,
|
||||
& NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_,
|
||||
& N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
|
||||
|
||||
USE DIM_MOD
|
||||
IMPLICIT INTEGER (A-Z)
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_
|
||||
|
||||
CALL ALLOCATION(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_,
|
||||
& NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_,
|
||||
& NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_,
|
||||
& N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
|
||||
|
||||
CALL MAIN_AED_MU_MI()
|
||||
CALL CLOSE_ALL_FILES()
|
||||
|
||||
END SUBROUTINE RUN
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,106 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE PLOTFD_A(A,LMX,ITL,NL,NAT,NE)
|
||||
C
|
||||
C This routine prepares the output for a plot of the scattering factor
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD
|
||||
USE FDIF_MOD
|
||||
USE INIT_L_MOD, L => LI, I2 => INITL, I3 => NNL, I4 => LF1,
|
||||
& I5 => LF2, I10 => ISTEP_LF
|
||||
USE INIT_J_MOD
|
||||
USE OUTFILES_MOD
|
||||
USE PARCAL_A_MOD, N3 => NPHI_A, N4 => NE_A, N5 => NTHETA_A,
|
||||
& NFTHET => NFTHET_A
|
||||
USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
|
||||
& IFTHET => IFTHET_A, IMOD => IMOD_A,
|
||||
& I_CP => I_CP_A, I_EXT => I_EXT_A,
|
||||
& I_TEST => I_TEST_A
|
||||
USE VALIN_MOD, PHI00 => PHI0, THETA00 => THETA0, U1 => THLUM,
|
||||
& U2 => PHILUM, U3 => ELUM, N7 => NONVOL
|
||||
USE VALFIN_MOD, PHI11 => PHI1, THETA11 => THETA1
|
||||
USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
|
||||
& PHI1 => PHI1_A, THETA1 => THETA1_A
|
||||
C
|
||||
DIMENSION LMX(NATM,NE_M)
|
||||
C
|
||||
COMPLEX FSPH,VKE
|
||||
C
|
||||
DATA PI,CONV/3.141593,0.512314/
|
||||
C
|
||||
OPEN(UNIT=IUO3, FILE=OUTFILE3, STATUS='UNKNOWN')
|
||||
IF(ISPHER.EQ.0) THEN
|
||||
L=0
|
||||
LMAX=0
|
||||
ELSE
|
||||
LMAX=L
|
||||
ENDIF
|
||||
PHITOT=360.
|
||||
THTOT=360.*ITHETA*(1-IPHI)+180.*ITHETA*IPHI
|
||||
NPHI=(NFTHET+1)*IPHI+(1-IPHI)
|
||||
NTHT=(NFTHET+1)*ITHETA*(1-IPHI)+(NFTHET/2+1)*ITHETA*IPHI+
|
||||
* (1-ITHETA)
|
||||
NE=NFTHET*IE + (1-IE)
|
||||
WRITE(IUO3,1) ISPHER,NL,NAT,L,NTHT,NPHI,NE,E0,EFIN
|
||||
DO 10 JT=1,NTHT
|
||||
DTHETA=THETA1+FLOAT(JT-1)*THTOT/FLOAT(MAX0(NTHT-1,1))
|
||||
RTHETA=DTHETA*PI/180.
|
||||
TEST=SIN(RTHETA)
|
||||
IF(TEST.GE.0.) THEN
|
||||
POZ=PI
|
||||
EPS=1.
|
||||
ELSE
|
||||
POZ=0.
|
||||
EPS=-1.
|
||||
ENDIF
|
||||
BETA=RTHETA*EPS
|
||||
IF(ABS(TEST).LT.0.0001) THEN
|
||||
NPHIM=1
|
||||
ELSE
|
||||
NPHIM=NPHI
|
||||
ENDIF
|
||||
DO 20 JP=1,NPHIM
|
||||
DPHI=PHI1+FLOAT(JP-1)*PHITOT/FLOAT(MAX0(NPHI-1,1))
|
||||
RPHI=DPHI*PI/180.
|
||||
GAMMA=POZ-RPHI
|
||||
DO 30 JE=1,NE
|
||||
IF(NE.EQ.1) THEN
|
||||
ECIN=E0
|
||||
ELSE
|
||||
ECIN=E0+FLOAT(JE-1)*(EFIN-E0)/FLOAT(NE-1)
|
||||
ENDIF
|
||||
IF(ITL.EQ.0) VKE=SQRT(ECIN-ABS(VINT))*CONV*A*(1.,0.)
|
||||
DO 40 JAT=1,NAT
|
||||
IF(L.GT.LMX(JAT,JE)) GOTO 90
|
||||
DO 50 M=-LMAX,LMAX
|
||||
CALL FACDIF1_A(VKE,R1,R2,THETA0,PHI0,BETA,GAMMA,L,M,
|
||||
1 FSPH,JAT,JE,*60)
|
||||
GOTO 70
|
||||
60 WRITE(IUO1,80)
|
||||
STOP
|
||||
70 REFTH=REAL(FSPH)
|
||||
XIMFTH=AIMAG(FSPH)
|
||||
WRITE(IUO3,5) JE,JAT,L,M,REFTH,XIMFTH,DTHETA,DPHI,ECIN
|
||||
50 CONTINUE
|
||||
GOTO 40
|
||||
90 WRITE(IUO1,100) JAT
|
||||
STOP
|
||||
40 CONTINUE
|
||||
30 CONTINUE
|
||||
20 CONTINUE
|
||||
10 CONTINUE
|
||||
CLOSE(IUO3)
|
||||
1 FORMAT(5X,I1,2X,I2,2X,I4,2X,I2,2X,I3,2X,I3,2X,I3,2X,F8.2,2X,F8.2)
|
||||
5 FORMAT(1X,I3,1X,I4,1X,I2,1X,I3,1X,F6.3,1X,F6.3,1X,F6.2,
|
||||
1 1X,F6.2,1X,F8.2)
|
||||
80 FORMAT(15X,'<<<<< WRONG VALUE OF THETA0 : THE DENOMINATOR ',
|
||||
1 'IS ZERO >>>>>')
|
||||
100 FORMAT(15X,'<<<<< THE VALUE OF L EST IS TOO LARGE FOR ATOM',
|
||||
1 ' : ',I2,' >>>>>')
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,791 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE TREAT_AED(ISOM,NFICHLEC,JFICH,NP)
|
||||
C
|
||||
C This routine sums up the calculations corresponding to different
|
||||
C absorbers or different planes when this has to be done
|
||||
C (parameter ISOM in the input data file).
|
||||
C
|
||||
C Last modified : 24 Jan 2013
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE OUTUNITS_MOD
|
||||
USE TYPEXP_MOD, DUMMY => SPECTRO
|
||||
USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
|
||||
& PHI1 => PHI1_A, THETA1 => THETA1_A
|
||||
USE VALIN_MOD, P0 => PHI0, T0 => THETA0
|
||||
USE VALFIN_MOD, P1 => PHI1, T1 => THETA1
|
||||
C
|
||||
PARAMETER(N_HEAD=5000,N_FILES=1000)
|
||||
C
|
||||
CHARACTER*3 SPECTRO
|
||||
CHARACTER*13 OUTDATA
|
||||
CHARACTER*72 HEAD(N_HEAD,N_FILES)
|
||||
C
|
||||
REAL TAB(NDIM_M,4)
|
||||
REAL ECIN(NE_M),DTHETA(NTH_M),DPHI(NPH_M)
|
||||
C
|
||||
DATA JVOL,JTOT/0,-1/
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
C Reading and storing the headers:
|
||||
C
|
||||
NHEAD=0
|
||||
DO JLINE=1,N_HEAD
|
||||
READ(IUO2,888) HEAD(JLINE,JFICH)
|
||||
NHEAD=NHEAD+1
|
||||
IF(HEAD(JLINE,JFICH)(1:6).EQ.' ') GOTO 333
|
||||
ENDDO
|
||||
C
|
||||
333 CONTINUE
|
||||
C
|
||||
READ(IUO2,15) SPECTRO,OUTDATA
|
||||
READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
|
||||
1 IPH_1,I_EXT
|
||||
C
|
||||
IF(I_EXT.EQ.2) THEN
|
||||
IPH_1=0
|
||||
ENDIF
|
||||
C
|
||||
IF(ISOM.EQ.0) THEN
|
||||
C
|
||||
C........ ISOM = 0 : case of independent input files .................
|
||||
C
|
||||
READ(IUO2,1) NPLAN,NEMET,NTHETA,NPHI,NE
|
||||
C
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
N_FIXED=NPHI
|
||||
FIX0=PHI0
|
||||
FIX1=PHI1
|
||||
N_SCAN=NTHETA
|
||||
ELSE
|
||||
N_FIXED=NTHETA
|
||||
FIX0=THETA0
|
||||
FIX1=THETA1
|
||||
IF(STEREO.EQ.'YES') THEN
|
||||
NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/
|
||||
1 (THETA1-THETA0)+0.0001)+1
|
||||
IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
|
||||
ENDIF
|
||||
N_SCAN=NPHI
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
N_SCAN=2*N_SCAN
|
||||
ENDIF
|
||||
C
|
||||
IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
|
||||
NDP=NEMET*NTHETA*NPHI*NE
|
||||
ELSEIF(I_EXT.EQ.-1) THEN
|
||||
NDP=NEMET*NTHETA*NPHI*NE*2
|
||||
ELSEIF(I_EXT.EQ.2) THEN
|
||||
NDP=NEMET*NTHETA*NE
|
||||
N_FIXED=NTHETA
|
||||
N_SCAN=NPHI
|
||||
IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
|
||||
ENDIF
|
||||
C
|
||||
NTT=NPLAN*NDP
|
||||
IF(NTT.GT.NDIM_M) GOTO 5
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
DO JEMET=1,NEMET
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO J_FIXED=1,N_FIXED
|
||||
IF(N_FIXED.GT.1) THEN
|
||||
XINCRF=FLOAT(J_FIXED-1)*
|
||||
1 (FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
ELSEIF(N_FIXED.EQ.1) THEN
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JPHI=J_FIXED
|
||||
ELSE
|
||||
THETA=THETA0+XINCRF
|
||||
JTHETA=J_FIXED
|
||||
IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 11
|
||||
ENDIF
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
N_SCAN_R=N_SCAN
|
||||
ELSE
|
||||
RTHETA=THETA*0.017453
|
||||
FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
C
|
||||
DO J_SCAN=1,N_SCAN_R
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JTHETA=J_SCAN
|
||||
ELSE
|
||||
JPHI=J_SCAN
|
||||
ENDIF
|
||||
C
|
||||
JLIN=(JPLAN-1)*NDP +
|
||||
1 (JEMET-1)*NE*N_FIXED*N_SCAN +
|
||||
2 (JE-1)*N_FIXED*N_SCAN +
|
||||
3 (JTHETA-1)*NPHI + JPHI
|
||||
C
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
C
|
||||
READ(IUO2,2) JPL
|
||||
IF(JPLAN.EQ.JPL) THEN
|
||||
BACKSPACE IUO2
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
|
||||
ENDIF
|
||||
ELSE
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
|
||||
2 TAB(JLIN,3),TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN2,1),TAB(JLIN2,2),
|
||||
2 TAB(JLIN2,3),TAB(JLIN2,4)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
BACKSPACE IUO2
|
||||
DO JL=JLIN,JPLAN*NDP
|
||||
TAB(JL,1)=0.0
|
||||
TAB(JL,2)=0.0
|
||||
TAB(JL,3)=0.0
|
||||
TAB(JL,4)=0.0
|
||||
ENDDO
|
||||
GOTO 10
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
11 CONTINUE
|
||||
ENDDO
|
||||
ENDDO
|
||||
10 CONTINUE
|
||||
ENDDO
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
C Skipping the NHEAD lines of headers before rewriting:
|
||||
C
|
||||
DO JLINE=1,NHEAD
|
||||
READ(IUO2,888) HEAD(JLINE,JFICH)
|
||||
ENDDO
|
||||
C
|
||||
WRITE(IUO2,15) SPECTRO,OUTDATA
|
||||
WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
C
|
||||
DO JE=1,NE
|
||||
DO JTHETA=1,NTHETA
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
NPHI_R=NPHI
|
||||
ELSE
|
||||
RTHETA=DTHETA(JTHETA)*0.017453
|
||||
FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
|
||||
NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
DO JPHI=1,NPHI_R
|
||||
TOTDIF_1=0.
|
||||
TOTDIR_1=0.
|
||||
VOLDIF_1=0.
|
||||
VOLDIR_1=0.
|
||||
TOTDIF_2=0.
|
||||
TOTDIR_2=0.
|
||||
VOLDIF_2=0.
|
||||
VOLDIR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=0.
|
||||
TOTDIR2_1=0.
|
||||
VOLDIF2_1=0.
|
||||
VOLDIR2_1=0.
|
||||
TOTDIF2_2=0.
|
||||
TOTDIR2_2=0.
|
||||
VOLDIF2_2=0.
|
||||
VOLDIR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
C
|
||||
SF_1=0.
|
||||
SR_1=0.
|
||||
SF_2=0.
|
||||
SR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
SF2_1=0.
|
||||
SR2_1=0.
|
||||
SF2_2=0.
|
||||
SR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JEMET=1,NEMET
|
||||
JLIN=(JPLAN-1)*NDP +
|
||||
1 (JEMET-1)*NE*NTHETA*NPHI +
|
||||
2 (JE-1)*NTHETA*NPHI +
|
||||
3 (JTHETA-1)*NPHI + JPHI
|
||||
SF_1=SF_1+TAB(JLIN,2)
|
||||
SR_1=SR_1+TAB(JLIN,1)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_1=SF2_1+TAB(JLIN2,2)
|
||||
SR2_1=SR2_1+TAB(JLIN2,1)
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
SF_2=SF_2+TAB(JLIN,4)
|
||||
SR_2=SR_2+TAB(JLIN,3)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_2=SF2_2+TAB(JLIN2,4)
|
||||
SR2_2=SR2_2+TAB(JLIN2,3)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1,SR_2,SF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(JPLAN.GT.NONVOL(JFICH)) THEN
|
||||
VOLDIF_1=VOLDIF_1+SF_1
|
||||
VOLDIR_1=VOLDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_1=VOLDIF2_1+SF2_1
|
||||
VOLDIR2_1=VOLDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
VOLDIF_2=VOLDIF_2+SF_2
|
||||
VOLDIR_2=VOLDIR_1+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_2=VOLDIF2_2+SF2_2
|
||||
VOLDIR2_2=VOLDIR2_1+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
TOTDIF_1=TOTDIF_1+SF_1
|
||||
TOTDIR_1=TOTDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=TOTDIF2_1+SF2_1
|
||||
TOTDIR2_1=TOTDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
TOTDIF_2=TOTDIF_2+SF_2
|
||||
TOTDIR_2=TOTDIR_2+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_2=TOTDIF2_2+SF2_2
|
||||
TOTDIR2_2=TOTDIR2_2+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR2_1,VOLDIF2_1
|
||||
ENDIF
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR2_1,TOTDIF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
|
||||
ENDIF
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ELSE
|
||||
C
|
||||
C........ ISOM not= 0 : multiple input files to be summed up ..........
|
||||
C
|
||||
READ(IUO2,7) NTHETA,NPHI,NE
|
||||
C
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
N_FIXED=NPHI
|
||||
FIX0=PHI0
|
||||
FIX1=PHI1
|
||||
N_SCAN=NTHETA
|
||||
ELSE
|
||||
N_FIXED=NTHETA
|
||||
FIX0=THETA0
|
||||
FIX1=THETA1
|
||||
IF(STEREO.EQ.'YES') THEN
|
||||
NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/
|
||||
1 (THETA1-THETA0)+0.0001)+1
|
||||
IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
|
||||
ENDIF
|
||||
N_SCAN=NPHI
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
N_SCAN=2*N_SCAN
|
||||
ENDIF
|
||||
C
|
||||
IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
|
||||
NDP=NTHETA*NPHI*NE
|
||||
ELSEIF(I_EXT.EQ.-1) THEN
|
||||
NDP=NTHETA*NPHI*NE*2
|
||||
ELSEIF(I_EXT.EQ.2) THEN
|
||||
NDP=NTHETA*NE
|
||||
N_FIXED=NTHETA
|
||||
N_SCAN=NPHI
|
||||
IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
|
||||
ENDIF
|
||||
C
|
||||
NTT=NFICHLEC*NDP
|
||||
IF(NTT.GT.NDIM_M) GOTO 5
|
||||
C
|
||||
IF(ISOM.EQ.1) THEN
|
||||
NPLAN=NP
|
||||
NF=NP
|
||||
ELSEIF(ISOM.EQ.2) THEN
|
||||
NEMET=NFICHLEC
|
||||
NF=NFICHLEC
|
||||
NPLAN=1
|
||||
ENDIF
|
||||
C
|
||||
DO JF=1,NF
|
||||
C
|
||||
C Reading the headers for each file:
|
||||
C
|
||||
IF(JF.GT.1) THEN
|
||||
DO JLINE=1,NHEAD
|
||||
READ(IUO2,888) HEAD(JLINE,JF)
|
||||
ENDDO
|
||||
ENDIF
|
||||
C
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO J_FIXED=1,N_FIXED
|
||||
IF(N_FIXED.GT.1) THEN
|
||||
XINCRF=FLOAT(J_FIXED-1)*
|
||||
1 (FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
ELSEIF(N_FIXED.EQ.1) THEN
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JPHI=J_FIXED
|
||||
ELSE
|
||||
THETA=THETA0+XINCRF
|
||||
JTHETA=J_FIXED
|
||||
IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 12
|
||||
ENDIF
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
N_SCAN_R=N_SCAN
|
||||
ELSE
|
||||
RTHETA=THETA*0.017453
|
||||
FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
C
|
||||
DO J_SCAN=1,N_SCAN_R
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JTHETA=J_SCAN
|
||||
ELSE
|
||||
JPHI=J_SCAN
|
||||
ENDIF
|
||||
C
|
||||
JLIN=(JF-1)*NDP + (JE-1)*N_FIXED*N_SCAN +
|
||||
1 (JTHETA-1)*NPHI + JPHI
|
||||
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
C
|
||||
IF(ISOM.EQ.1) THEN
|
||||
READ(IUO2,2) JPL
|
||||
IF(JF.EQ.JPL) THEN
|
||||
BACKSPACE IUO2
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
|
||||
ENDIF
|
||||
ELSE
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
|
||||
2 TAB(JLIN,3),TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
|
||||
1 DPHI(JPHI2),ECIN(JE),
|
||||
2 TAB(JLIN2,1),TAB(JLIN2,2),
|
||||
3 TAB(JLIN2,3),TAB(JLIN2,4)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
BACKSPACE IUO2
|
||||
DO JLINE=1,NHEAD
|
||||
BACKSPACE IUO2
|
||||
ENDDO
|
||||
DO JL=JLIN,JF*NDP
|
||||
TAB(JL,1)=0.0
|
||||
TAB(JL,2)=0.0
|
||||
TAB(JL,3)=0.0
|
||||
TAB(JL,4)=0.0
|
||||
ENDDO
|
||||
GOTO 13
|
||||
ENDIF
|
||||
ELSEIF(ISOM.EQ.2) THEN
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
|
||||
ENDIF
|
||||
ELSE
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
|
||||
2 TAB(JLIN,3),TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
|
||||
1 DPHI(JPHI2),ECIN(JE),
|
||||
2 TAB(JLIN2,1),TAB(JLIN2,2),
|
||||
3 TAB(JLIN2,3),TAB(JLIN2,4)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
12 CONTINUE
|
||||
ENDDO
|
||||
ENDDO
|
||||
13 CONTINUE
|
||||
ENDDO
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
C Writing the headers:
|
||||
C
|
||||
DO JLINE=1,2
|
||||
WRITE(IUO2,888) HEAD(JLINE,1)
|
||||
ENDDO
|
||||
DO JF=1,NFICHLEC
|
||||
DO JLINE=3,6
|
||||
WRITE(IUO2,888) HEAD(JLINE,JF)
|
||||
ENDDO
|
||||
WRITE(IUO2,888) HEAD(2,JF)
|
||||
ENDDO
|
||||
DO JLINE=7,NHEAD
|
||||
WRITE(IUO2,888) HEAD(JLINE,1)
|
||||
ENDDO
|
||||
C
|
||||
WRITE(IUO2,15) SPECTRO,OUTDATA
|
||||
WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
C
|
||||
IF(ISOM.EQ.1) THEN
|
||||
C
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO JTHETA=1,NTHETA
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
NPHI_R=NPHI
|
||||
ELSE
|
||||
RTHETA=DTHETA(JTHETA)*0.017453
|
||||
FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
|
||||
NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
DO JPHI=1,NPHI_R
|
||||
C
|
||||
TOTDIF_1=0.
|
||||
TOTDIR_1=0.
|
||||
VOLDIF_1=0.
|
||||
VOLDIR_1=0.
|
||||
TOTDIF_2=0.
|
||||
TOTDIR_2=0.
|
||||
VOLDIF_2=0.
|
||||
VOLDIR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=0.
|
||||
TOTDIR2_1=0.
|
||||
VOLDIF2_1=0.
|
||||
VOLDIR2_1=0.
|
||||
TOTDIF2_2=0.
|
||||
TOTDIR2_2=0.
|
||||
VOLDIF2_2=0.
|
||||
VOLDIR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
JF=JPLAN
|
||||
C
|
||||
JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +
|
||||
1 (JTHETA-1)*NPHI + JPHI
|
||||
C
|
||||
SR_1=TAB(JLIN,1)
|
||||
SF_1=TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_1=TAB(JLIN2,2)
|
||||
SR2_1=TAB(JLIN2,1)
|
||||
ENDIF
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
SR_2=TAB(JLIN,3)
|
||||
SF_2=TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_2=TAB(JLIN2,4)
|
||||
SR2_2=TAB(JLIN2,3)
|
||||
ENDIF
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1,SR_2,SF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(NONVOL(JPLAN).EQ.0) THEN
|
||||
VOLDIF_1=VOLDIF_1+SF_1
|
||||
VOLDIR_1=VOLDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_1=VOLDIF2_1+SF2_1
|
||||
VOLDIR2_1=VOLDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
VOLDIF_2=VOLDIF_2+SF_2
|
||||
VOLDIR_2=VOLDIR_2+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_2=VOLDIF2_2+SF2_2
|
||||
VOLDIR2_2=VOLDIR2_1+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
TOTDIF_1=TOTDIF_1+SF_1
|
||||
TOTDIR_1=TOTDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=TOTDIF2_1+SF2_1
|
||||
TOTDIR2_1=TOTDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
TOTDIF_2=TOTDIF_2+SF_2
|
||||
TOTDIR_2=TOTDIR_2+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_2=TOTDIF2_2+SF2_2
|
||||
TOTDIR2_2=TOTDIR2_2+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),VOLDIR2_1,VOLDIF2_1
|
||||
ENDIF
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TOTDIR2_1,TOTDIF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),VOLDIR2_1,VOLDIF2_1,
|
||||
3 VOLDIR2_2,VOLDIF2_2
|
||||
ENDIF
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TOTDIR2_1,TOTDIF2_1,
|
||||
3 TOTDIR2_2,TOTDIF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSEIF(ISOM.EQ.2) THEN
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO JTHETA=1,NTHETA
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
NPHI_R=NPHI
|
||||
ELSE
|
||||
RTHETA=DTHETA(JTHETA)*0.017453
|
||||
FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
|
||||
NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
DO JPHI=1,NPHI_R
|
||||
C
|
||||
SF_1=0.
|
||||
SR_1=0.
|
||||
SF_2=0.
|
||||
SR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
SF2_1=0.
|
||||
SR2_1=0.
|
||||
SF2_2=0.
|
||||
SR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JEMET=1,NEMET
|
||||
JF=JEMET
|
||||
C
|
||||
JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +
|
||||
1 (JTHETA-1)*NPHI + JPHI
|
||||
C
|
||||
SF_1=SF_1+TAB(JLIN,2)
|
||||
SR_1=SR_1+TAB(JLIN,1)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_1=SF2_1+TAB(JLIN2,2)
|
||||
SR2_1=SR2_1+TAB(JLIN2,1)
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
SF_2=SF_2+TAB(JLIN,4)
|
||||
SR_2=SR_2+TAB(JLIN,3)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_2=SF2_2+TAB(JLIN2,4)
|
||||
SR2_2=SR2_2+TAB(JLIN2,3)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JPL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1,SR_2,SF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
GOTO 6
|
||||
C
|
||||
5 WRITE(IUO1,4)
|
||||
STOP
|
||||
35 WRITE(IUO1,36) N_FIXED
|
||||
STOP
|
||||
37 WRITE(IUO1,38) NTHETA*NPHI
|
||||
STOP
|
||||
C
|
||||
1 FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
|
||||
2 FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
|
||||
1 2X,E12.6)
|
||||
3 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
4 FORMAT(//,8X,'<<<<<<<<<< DIMENSION OF THE ARRAYS TOO SMALL ',
|
||||
1 'IN THE TREAT_AED SUBROUTINE - INCREASE NDIM_M ',
|
||||
2 '>>>>>>>>>>')
|
||||
7 FORMAT(I4,2X,I4,2X,I4)
|
||||
8 FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
|
||||
9 FORMAT(9(2X,I1),2X,I2)
|
||||
15 FORMAT(2X,A3,11X,A13)
|
||||
22 FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
|
||||
1 2X,E12.6,2X,E12.6,2X,E12.6)
|
||||
23 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,
|
||||
1 2X,E12.6,2X,E12.6)
|
||||
25 FORMAT(37X,E12.6,2X,E12.6)
|
||||
36 FORMAT(//,4X,'<<<<<<<<<< DIMENSION OF NTH_M OR NPH_M TOO SMALL ',
|
||||
1 'IN THE INCLUDE FILE >>>>>>>>>>',/,4X,
|
||||
2 '<<<<<<<<<< SHOULD BE AT LEAST ',I6,
|
||||
3 ' >>>>>>>>>>')
|
||||
38 FORMAT(//,8X,'<<<<<<<<<< DIMENSION OF NPH_M TOO SMALL ',
|
||||
1 'IN THE INCLUDE FILE >>>>>>>>>>',/,8X,
|
||||
2 '<<<<<<<<<< SHOULD BE AT LEAST ',I6,
|
||||
3 ' >>>>>>>>>>')
|
||||
888 FORMAT(A72)
|
||||
C
|
||||
6 RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,335 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE WEIGHT_SUM(ISOM,I_EXT,I_EXT_A,JEL)
|
||||
C
|
||||
C This subroutine performs a weighted sum of the results
|
||||
C corresponding to different directions of the detector.
|
||||
C The directions and weights are read from an external input file
|
||||
C
|
||||
C JEL is the electron undetected (i.e. for which the outgoing
|
||||
C directions are integrated over the unit sphere). It is always
|
||||
C 1 for one electron spectroscopies (PHD). For APECS, It can be
|
||||
C 1 (photoelectron) or 2 (Auger electron) or even 0 (no electron
|
||||
C detected)
|
||||
C
|
||||
C Last modified : 31 Jan 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
USE INFILES_MOD
|
||||
USE INUNITS_MOD
|
||||
USE OUTUNITS_MOD
|
||||
C
|
||||
C
|
||||
PARAMETER(N_MAX=5810,NPM=20)
|
||||
C
|
||||
REAL*4 W(N_MAX),W_A(N_MAX),ECIN(NE_M)
|
||||
REAL*4 DTHETA(N_MAX),DPHI(N_MAX),DTHETAA(N_MAX),DPHIA(N_MAX)
|
||||
REAL*4 SR_1,SF_1,SR_2,SF_2
|
||||
REAL*4 SUMR_1(NPM,NE_M,N_MAX),SUMR_2(NPM,NE_M,N_MAX)
|
||||
REAL*4 SUMF_1(NPM,NE_M,N_MAX),SUMF_2(NPM,NE_M,N_MAX)
|
||||
C
|
||||
CHARACTER*3 SPECTRO,SPECTRO2
|
||||
CHARACTER*5 LIKE
|
||||
CHARACTER*13 OUTDATA
|
||||
C
|
||||
C
|
||||
C
|
||||
C
|
||||
DATA JVOL,JTOT/0,-1/
|
||||
DATA LIKE /'-like'/
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
READ(IUO2,15) SPECTRO,OUTDATA
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
SPECTRO2='XAS'
|
||||
ELSE
|
||||
READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
READ(IUO2,9) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A,I
|
||||
&THETA_A,IE_A
|
||||
READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
READ(IUO2,8) NPHI_A,NTHETA_A
|
||||
IF(JEL.EQ.1) THEN
|
||||
SPECTRO2='AED'
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
SPECTRO2='PHD'
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
SPECTRO2='XAS'
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
IF(NPLAN.GT.NPM) THEN
|
||||
WRITE(IUO1,4) NPLAN+2
|
||||
STOP
|
||||
ENDIF
|
||||
C
|
||||
C Reading the number of angular points
|
||||
C
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
N_POINTS_A=1
|
||||
ELSE
|
||||
IF(JEL.EQ.1) THEN
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
IF(I_EXT_A.EQ.0) THEN
|
||||
N_POINTS_A=NTHETA_A*NPHI_A
|
||||
ELSE
|
||||
OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
|
||||
READ(IUI9,1) N_POINTS_A
|
||||
READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
|
||||
ENDIF
|
||||
NTHETA0=NTHETA_A
|
||||
NPHI0=NPHI_A
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
|
||||
READ(IUI9,1) N_POINTS_A
|
||||
READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
N_POINTS=NTHETA*NPHI
|
||||
ELSE
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
ENDIF
|
||||
NTHETA0=NTHETA
|
||||
NPHI0=NPHI
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI9,1) N_POINTS_A
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
NANGLE=1
|
||||
ELSE
|
||||
IF(JEL.EQ.1) THEN
|
||||
NANGLE=N_POINTS_A
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
NANGLE=N_POINTS
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
NANGLE=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
C Initialization of the arrays
|
||||
C
|
||||
DO JE=1,NE
|
||||
DO JANGLE=1,NANGLE
|
||||
DO JPLAN=1,NPLAN+2
|
||||
SUMR_1(JPLAN,JE,JANGLE)=0.
|
||||
SUMF_1(JPLAN,JE,JANGLE)=0.
|
||||
IF(IDICHR.GT.0) THEN
|
||||
SUMR_2(JPLAN,JE,JANGLE)=0.
|
||||
SUMF_2(JPLAN,JE,JANGLE)=0.
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Reading of the data to be angle integrated
|
||||
C
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO JANGLE=1,N_POINTS
|
||||
IF(I_EXT.NE.0) READ(IUI6,2) TH,PH,W(JANGLE)
|
||||
DO JANGLE_A=1,N_POINTS_A
|
||||
IF((I_EXT_A.NE.0).AND.(JANGLE.EQ.1)) THEN
|
||||
READ(IUI9,2) THA,PHA,W_A(JANGLE_A)
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN+2
|
||||
C
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
READ(IUO2,3) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE)
|
||||
&,SR_1,SF_1
|
||||
ELSE
|
||||
READ(IUO2,13) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
|
||||
&),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1
|
||||
ENDIF
|
||||
ELSE
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
READ(IUO2,23) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
|
||||
&),SR_1,SF_1,SR_2,SF_2
|
||||
ELSE
|
||||
READ(IUO2,24) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
|
||||
&),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1,SR_2,SF_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
IF(JEL.EQ.1) THEN
|
||||
SUMR_1(JPLAN,JE,JANGLE_A)=SUMR_1(JPLAN,JE,JANGLE_A)+SR_1
|
||||
&*W(JANGLE)
|
||||
SUMF_1(JPLAN,JE,JANGLE_A)=SUMF_1(JPLAN,JE,JANGLE_A)+SF_1
|
||||
&*W(JANGLE)
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
SUMR_1(JPLAN,JE,JANGLE)=SUMR_1(JPLAN,JE,JANGLE)+SR_1*W_A
|
||||
&(JANGLE_A)
|
||||
SUMF_1(JPLAN,JE,JANGLE)=SUMF_1(JPLAN,JE,JANGLE)+SF_1*W_A
|
||||
&(JANGLE_A)
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
SUMR_1(JPLAN,JE,1)=SUMR_1(JPLAN,JE,1)+SR_1*W(JANGLE)*W_A
|
||||
&(JANGLE_A)
|
||||
SUMF_1(JPLAN,JE,1)=SUMF_1(JPLAN,JE,1)+SF_1*W(JANGLE)*W_A
|
||||
&(JANGLE_A)
|
||||
ENDIF
|
||||
IF(IDICHR.GT.0) THEN
|
||||
IF(JEL.EQ.1) THEN
|
||||
SUMR_2(JPLAN,JE,JANGLE_A)=SUMR_2(JPLAN,JE,JANGLE_A)+SR
|
||||
&_2*W(JANGLE)
|
||||
SUMF_2(JPLAN,JE,JANGLE_A)=SUMF_2(JPLAN,JE,JANGLE_A)+SF
|
||||
&_2*W(JANGLE)
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
SUMR_2(JPLAN,JE,JANGLE)=SUMR_2(JPLAN,JE,JANGLE)+SR_2*W
|
||||
&_A(JANGLE_A)
|
||||
SUMF_2(JPLAN,JE,JANGLE)=SUMF_2(JPLAN,JE,JANGLE)+SF_2*W
|
||||
&_A(JANGLE_A)
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
SUMR_2(JPLAN,JE,1)=SUMR_2(JPLAN,JE,1)+SR_2*W(JANGLE)*W
|
||||
&_A(JANGLE_A)
|
||||
SUMF_2(JPLAN,JE,1)=SUMF_2(JPLAN,JE,1)+SF_2*W(JANGLE)*W
|
||||
&_A(JANGLE_A)
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
IF(I_EXT_A.NE.0) THEN
|
||||
REWIND IUI9
|
||||
READ(IUI9,1) NDUM
|
||||
READ(IUI9,1) NDUM
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
IF(I_EXT.NE.0) THEN
|
||||
REWIND IUI6
|
||||
READ(IUI6,1) NDUM
|
||||
READ(IUI6,1) NDUM
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
CLOSE(IUI6)
|
||||
CLOSE(IUI9)
|
||||
REWIND IUO2
|
||||
C
|
||||
WRITE(IUO2,16) SPECTRO2,LIKE,SPECTRO,OUTDATA
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,19) ISPIN,IDICHR,I_SO,ISFLIP
|
||||
WRITE(IUO2,18) NE,NPLAN,ISOM
|
||||
ELSEIF(JEL.EQ.1) THEN
|
||||
WRITE(IUO2,20) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A
|
||||
&,ITHETA_A,IE_A
|
||||
WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
WRITE(IUO2,20) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
|
||||
ENDIF
|
||||
C
|
||||
DO JE=1,NE
|
||||
DO JANGLE=1,NANGLE
|
||||
IF(SPECTRO.EQ.'APC') THEN
|
||||
IF(JEL.EQ.1) THEN
|
||||
THETA=DTHETAA(JANGLE)
|
||||
PHI=DPHIA(JANGLE)
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
THETA=DTHETA(JANGLE)
|
||||
PHI=DPHI(JANGLE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,33) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
|
||||
&MF_1(JPLAN,JE,JANGLE)
|
||||
ELSE
|
||||
WRITE(IUO2,34) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
|
||||
&JANGLE),SUMF_1(JPLAN,JE,JANGLE)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,43) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
|
||||
&MF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPLAN,JE,JANG
|
||||
&LE)
|
||||
ELSE
|
||||
WRITE(IUO2,44) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
|
||||
&JANGLE),SUMF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPL
|
||||
&AN,JE,JANGLE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,33) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+1,JE,JANGLE)
|
||||
WRITE(IUO2,33) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+2,JE,JANGLE)
|
||||
ELSE
|
||||
WRITE(IUO2,34) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+1,JE,JANGLE)
|
||||
WRITE(IUO2,34) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+2,JE,JANGLE)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,43) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(NPLAN+1,JE
|
||||
&,JANGLE)
|
||||
WRITE(IUO2,43) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(NPLAN+2,JE
|
||||
&,JANGLE)
|
||||
ELSE
|
||||
WRITE(IUO2,44) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(
|
||||
&NPLAN+1,JE,JANGLE)
|
||||
WRITE(IUO2,44) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(
|
||||
&NPLAN+2,JE,JANGLE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
1 FORMAT(13X,I4)
|
||||
2 FORMAT(15X,F8.3,3X,F8.3,3X,E12.6)
|
||||
3 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
4 FORMAT(//,8X,'<<<<<<<<<< DIMENSION OF THE ARRAYS TOO SMALL ','IN
|
||||
&THE WEIGHT_SUM SUBROUTINE - INCREASE NPM TO ',I3,'>>>>>>>>>>')
|
||||
5 FORMAT(6X,I1,1X,I3,3X,I3)
|
||||
8 FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
|
||||
9 FORMAT(9(2X,I1),2X,I2)
|
||||
13 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
|
||||
&12.6)
|
||||
15 FORMAT(2X,A3,11X,A13)
|
||||
16 FORMAT(2X,A3,A5,1X,A3,2X,A13)
|
||||
18 FORMAT(I4,2X,I3,2X,I1)
|
||||
19 FORMAT(4(2X,I1))
|
||||
20 FORMAT(8(2X,I1))
|
||||
21 FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
|
||||
23 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
|
||||
&,E12.6)
|
||||
24 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
|
||||
&12.6,2X,E12.6,2X,E12.6)
|
||||
33 FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
34 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
43 FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
|
||||
44 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
|
||||
&,E12.6)
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
memalloc_src := memalloc/dim_mod.f memalloc/modules.f memalloc/allocation.f
|
||||
cluster_gen_src := $(wildcard cluster_gen/*.f)
|
||||
common_sub_src := $(wildcard common_sub/*.f)
|
||||
renormalization_src := $(wildcard renormalization/*.f)
|
||||
aed_se_mu_noso_nosp_nosym_src := $(wildcard aed_se_mu_noso_nosp_nosym/*.f)
|
||||
|
||||
SRCS = $(memalloc_src) $(cluster_gen_src) $(common_sub_src) $(renormalization_src) $(aed_se_mu_noso_nosp_nosym_src)
|
||||
MAIN_F = aed_se_mu_noso_nosp_nosym/main.f
|
||||
SO = _aed_se_mu_noso_nosp_nosym.so
|
||||
|
||||
include ../../../options.mk
|
||||
|
|
@ -0,0 +1,998 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE AEDDIF_SE_MU(NPLAN,VAL,ZEM,IPHA,NAT2,COORD,NATYP,RHOK,
|
||||
1 NATCLU,NFICHLEC,JFICH,NP,LE_MIN,LE_MAX)
|
||||
C
|
||||
C This subroutine computes the AED formula in the spin-independent case
|
||||
C from a multiplet resolved initial core state L1. The
|
||||
C intermediate state that gives its energy is L2 while the
|
||||
C core hole that is filled in the process is noted LC. The
|
||||
C multiplet is characterized by the integer angular momentum
|
||||
C variables (L_MUL,S_MUL,J_MUL)
|
||||
C
|
||||
C Alternatively, it can compute the AED amplitude for the APECS process.
|
||||
C
|
||||
C The calculation is performed using a series expansion for the
|
||||
C expression of the scattering path operator
|
||||
C
|
||||
C Last modified : 26 Apr 2013
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE ALGORITHM_MOD
|
||||
USE AMPLI_MOD
|
||||
USE APPROX_MOD
|
||||
USE COOR_MOD, NTCLU => NATCLU, NTP => NATYP
|
||||
USE DEBWAL_MOD
|
||||
USE DIRECT_A_MOD, DIRANA => DIRANA_A, ANADIR => ANADIR_A,
|
||||
& RTHETA => RTHEXT_A, RPHI => RPHI_A,
|
||||
& THETAR => THETAR_A, PHIR => PHIR_A
|
||||
USE EXTREM_MOD
|
||||
USE FIXSCAN_A_MOD, N_FIXED => N_FIXED_A, N_SCAN => N_SCAN_A,
|
||||
& IPH_1 => IPH_1_A, FIX0 => FIX0_A,
|
||||
& FIX1 => FIX1_A, SCAN0 => SCAN0_A,
|
||||
& SCAN1 => SCAN1_A
|
||||
USE INFILES_MOD
|
||||
USE INUNITS_MOD
|
||||
USE INIT_J_MOD
|
||||
USE INIT_L_MOD
|
||||
USE INIT_M_MOD
|
||||
USE LIMAMA_MOD
|
||||
USE LINLBD_MOD
|
||||
USE MOYEN_A_MOD, IMOY => IMOY_A, NDIR => NDIR_A,
|
||||
& ACCEPT => ACCEPT_A, ICHKDIR => ICHKDIR_A
|
||||
USE OUTFILES_MOD
|
||||
USE OUTUNITS_MOD
|
||||
USE PARCAL_A_MOD, NPHI => NPHI_A, NE => NE_A,
|
||||
& NTHETA => NTHETA_A, NFTHET => NFTHET_A
|
||||
USE PATH_MOD
|
||||
USE PRINTP_MOD
|
||||
USE RESEAU_MOD
|
||||
USE SPIN_MOD
|
||||
USE TESTPA_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TESTS_MOD
|
||||
USE TL_AED_MOD, DLT = > DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
|
||||
& IFTHET => IFTHET_A, IMOD => IMOD_A,
|
||||
& I_CP => I_CP_A, I_EXT => I_EXT_A,
|
||||
& I_TEST => I_TEST_A
|
||||
USE TYPEM_MOD
|
||||
USE TYPEXP_MOD
|
||||
USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
|
||||
& PHI1 => PHI1_A, THETA1 => THETA1_A
|
||||
USE VALIN_MOD, P0 => PHI0, T0 => THETA0, TM => THLUM,
|
||||
& PM => PHILUM, EM => ELUM
|
||||
C
|
||||
REAL NPATH1(0:NDIF_M),NOPA
|
||||
C
|
||||
COMPLEX IC,ONEC,ZEROC,PW(0:NDIF_M)
|
||||
COMPLEX TLT(0:NT_M,4,NATM,NE_M),RHOMI
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLMR(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLME(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX R2,M_COUL(0:NL_M,-NL_M:NL_M,2,-LI_M:LI_M,2)
|
||||
COMPLEX SJDIR_1,SJDIF_1
|
||||
COMPLEX RHOK(0:NT_M,NATM,0:40,2,NSPIN2_M),COU
|
||||
COMPLEX SLJDIF,ATT_M,SLE_1
|
||||
COMPLEX SL0DIF,SMJDIF
|
||||
C
|
||||
DIMENSION VAL(NATCLU_M),NATYP(NATM)
|
||||
DIMENSION EMET(3),COORD(3,NATCLU_M)
|
||||
DIMENSION R(NDIF_M),XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),JPA(NDIF_M)
|
||||
C
|
||||
CHARACTER*7 STAT
|
||||
CHARACTER*24 INFILE
|
||||
CHARACTER*24 OUTFILE
|
||||
C
|
||||
DATA PIS180 /0.017453/
|
||||
DATA EV,SMALL /13.60583,0.0001/
|
||||
DATA BOHR /0.529177/
|
||||
C
|
||||
ALGO1=' '
|
||||
ALGO2='SE'
|
||||
ALGO3=' '
|
||||
ALGO4=' '
|
||||
C
|
||||
IC=(0.,1.)
|
||||
ONEC=(1.,0.)
|
||||
ZEROC=(0.,0.)
|
||||
NSCAT=NATCLU-1
|
||||
ATTSE=1.
|
||||
ATTSJ=1.
|
||||
NPATH2(0)=1.
|
||||
NPATH(0)=1.
|
||||
NPMA(0)=1.
|
||||
NPMI(0)=1.
|
||||
ZSURF=VAL(1)
|
||||
C
|
||||
I_DIR=0
|
||||
NSET=1
|
||||
JEL=2
|
||||
C
|
||||
IF(SPECTRO.EQ.'AED') THEN
|
||||
IOUT=IUO2
|
||||
OUTFILE=OUTFILE2
|
||||
STAT='UNKNOWN'
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
ISET=IUI6
|
||||
INFILE=INFILE6
|
||||
ENDIF
|
||||
ELSEIF(SPECTRO.EQ.'APC') THEN
|
||||
IOUT=IUSCR2
|
||||
OUTFILE='res/auger.amp'
|
||||
STAT='UNKNOWN'
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
ISET=IUI9
|
||||
INFILE=INFILE9
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
LF1=LE_MIN
|
||||
LF2=LE_MAX
|
||||
ISTEP_LF=2
|
||||
C
|
||||
IF((ISOM.EQ.0).OR.(JFICH.EQ.1)) THEN
|
||||
OPEN(UNIT=IOUT, FILE=OUTFILE, STATUS=STAT)
|
||||
ENDIF
|
||||
C
|
||||
C Writing the headers in the output file
|
||||
C
|
||||
CALL HEADERS(IOUT)
|
||||
C
|
||||
IF((ISOM.EQ.0).OR.((ISOM.GT.0).AND.(JFICH.EQ.1))) THEN
|
||||
WRITE(IOUT,12) SPECTRO
|
||||
WRITE(IOUT,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
|
||||
1 IPH_1,I_EXT
|
||||
ENDIF
|
||||
C
|
||||
IF(ISOM.EQ.0) THEN
|
||||
WRITE(IOUT,79) NPLAN,NEMET,NTHETA,NPHI,NE
|
||||
ELSEIF((ISOM.NE.0).AND.(JFICH.EQ.1)) THEN
|
||||
WRITE(IOUT,11) NTHETA,NPHI,NE
|
||||
ENDIF
|
||||
C
|
||||
C Construction of the linear index LAMBDA=(MU,NU)
|
||||
C
|
||||
LAMBDA0=0
|
||||
DO N_O=0,NO
|
||||
NMX=N_O/2
|
||||
DO NU=0,NMX
|
||||
DO MU=-N_O,N_O
|
||||
NMU=2*NU+ABS(MU)
|
||||
IF(NMU.EQ.N_O) THEN
|
||||
LAMBDA0=LAMBDA0+1
|
||||
LBD(MU,NU)=LAMBDA0
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
LBDMAX=LAMBDA0
|
||||
IJK=0
|
||||
C
|
||||
C Loop over the planes
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
Z=VAL(JPLAN)
|
||||
IF((IPHA.EQ.1).OR.(IPHA.EQ.2)) THEN
|
||||
DZZEM=ABS(Z-ZEM)
|
||||
IF(DZZEM.LT.SMALL) GOTO 10
|
||||
GOTO 1
|
||||
ENDIF
|
||||
10 CONTINUE
|
||||
C
|
||||
C Loop over the different absorbers in a given plane
|
||||
C
|
||||
DO JEMET=1,NEMET
|
||||
CALL EMETT(JEMET,IEMET,Z,SYM_AT,NATYP,EMET,NTYPEM,
|
||||
1 JNEM,*4)
|
||||
GO TO 2
|
||||
4 IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN
|
||||
IF(I_TEST.NE.2) WRITE(IUO1,51) JPLAN,NTYPEM
|
||||
ENDIF
|
||||
GO TO 3
|
||||
2 IF((ABS(EMET(3)).GT.COUPUR).AND.(IBAS.EQ.1)) GOTO 5
|
||||
IF((ISORT1.EQ.0).AND.(IPRINT.GT.0)) THEN
|
||||
IF(I_TEST.NE.2) THEN
|
||||
WRITE(IUO1,52) JPLAN,EMET(1),EMET(2),EMET(3),NTYPEM
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ISOM.EQ.1) NP=JPLAN
|
||||
ZSURFE=VAL(1)-EMET(3)
|
||||
JTE=IEMET(JEMET)
|
||||
C
|
||||
C Loop over the energies
|
||||
C
|
||||
DO JE=1,NE
|
||||
FMIN(0)=1.
|
||||
FMAX(0)=1.
|
||||
IF(I_TEST.NE.1) THEN
|
||||
VKR=REAL(VK(JE))
|
||||
ELSE
|
||||
VKR=1.
|
||||
ENDIF
|
||||
ECIN=VKR*VKR*BOHR*BOHR*EV/(A*A)+VINT
|
||||
IF(I_TEST.NE.1) THEN
|
||||
CFM=2.*VKR
|
||||
ELSE
|
||||
CFM=1.
|
||||
ENDIF
|
||||
CALL LPM(ECIN,XLPM,*6)
|
||||
XLPM1=XLPM/A
|
||||
GAMMA=1./(2.*XLPM1)
|
||||
IF(IPOTC.EQ.0) THEN
|
||||
VK(JE)=VK(JE)+IC*GAMMA
|
||||
ENDIF
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,56) A,XLPM1
|
||||
IF((IPRINT.GT.0).AND.(IBAS.EQ.1)) THEN
|
||||
IF(I_TEST.NE.2) WRITE(IUO1,57) COUPUR
|
||||
ENDIF
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) THEN
|
||||
IF(IDCM.GE.1) WRITE(IUO1,22)
|
||||
DO JAT=1,N_PROT
|
||||
IF(IDCM.EQ.0) THEN
|
||||
XK2UJ2=VK2(JE)*UJ2(JAT)
|
||||
ELSE
|
||||
XK2UJ2=VK2(JE)*UJ_SQ(JAT)
|
||||
WRITE(IUO1,23) JAT,UJ_SQ(JAT)*A*A
|
||||
ENDIF
|
||||
CALL DWSPH_A(JAT,JE,XK2UJ2,TLT,ISPEED)
|
||||
DO LAT=0,LMAX(JAT,JE)
|
||||
TL(LAT,1,JAT,JE)=TLT(LAT,1,JAT,JE)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
OPEN(UNIT=ISET, FILE=INFILE, STATUS='OLD')
|
||||
READ(ISET,13) I_DIR,NSET,N_DUM1
|
||||
READ(ISET,14) I_DUM1,N_DUM2,N_DUM3
|
||||
ENDIF
|
||||
C
|
||||
C Initialization of TAU(INDJ,LINFMAX,JTYP)
|
||||
C
|
||||
JATL=0
|
||||
DO JTYP=1,N_PROT
|
||||
NBTYP=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYP
|
||||
JATL=JATL+1
|
||||
DO LE=LE_MIN,LE_MAX,2
|
||||
ILE=LE*LE+LE+1
|
||||
DO ME=-LE,LE
|
||||
INDE=ILE+ME
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
DO MJ=-LJ,LJ
|
||||
INDJ=ILJ+MJ
|
||||
TAU(INDJ,INDE,JATL)=ZEROC
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Storage of the coupling matrix elements M_COUL
|
||||
C
|
||||
DO MC=-LI,LI
|
||||
DO ISC=1,2
|
||||
SC=FLOAT(ISC)-1.5
|
||||
DO LA=LE_MIN,LE_MAX,2
|
||||
DO MA=-LA,LA
|
||||
DO ISA=1,2
|
||||
SA=FLOAT(ISA)-1.5
|
||||
CALL COUMAT_AM(LA,MA,SA,MC,SC,JTE,RHOK,COU)
|
||||
M_COUL(LA,MA,ISA,MC,ISC)=COU
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Calculation of the scattering path operator TAU
|
||||
C
|
||||
IF(I_TEST.EQ.2) GOTO 666
|
||||
PW(0)=ONEC
|
||||
PW(1)=ONEC
|
||||
ND=0
|
||||
TH01=0.
|
||||
PHI01=0.
|
||||
RHO01=ZEROC
|
||||
THMI=0.
|
||||
PHMI=0.
|
||||
RHOMI=ZEROC
|
||||
JATLEM=JNEM
|
||||
IF(NTYPEM.GT.1) THEN
|
||||
DO JAEM=NTYPEM-1,1,-1
|
||||
JATLEM=JATLEM+NATYP(JAEM)
|
||||
ENDDO
|
||||
ENDIF
|
||||
DO JD=1,NDIF
|
||||
NPATH2(JD)=0.
|
||||
NPATH(JD)=0.
|
||||
IT(JD)=0
|
||||
IN(JD)=0
|
||||
FMIN(JD)=1.E+20
|
||||
FMAX(JD)=0.
|
||||
ENDDO
|
||||
NTHOF=0
|
||||
C
|
||||
C Calculation of the maximal intensity for the paths of order NCUT
|
||||
C (plane waves). This will be taken as a reference for the IPW filter.
|
||||
C
|
||||
IF(IPW.EQ.1) THEN
|
||||
NDIFOLD=NDIF
|
||||
NOOLD=NO
|
||||
ISPHEROLD=ISPHER
|
||||
NDIF=NCUT
|
||||
NO=0
|
||||
ISPHER=0
|
||||
IREF=1
|
||||
IPW=0
|
||||
IJ=0
|
||||
DIJ=0.
|
||||
FREF=0.
|
||||
CALL FINDPATHS_A(ND,NTYPEM,JATLEM,I_CP,R,XR,YR,ZR,RHOMI,
|
||||
1 THMI,PHMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
NDIF=NDIFOLD
|
||||
NO=NOOLD
|
||||
ISPHER=ISPHEROLD
|
||||
PW(0)=ONEC
|
||||
PW(1)=ONEC
|
||||
IPW=1
|
||||
ND=0
|
||||
TH01=0.
|
||||
PHI01=0.
|
||||
RHO01=ZEROC
|
||||
THMI=0.
|
||||
PHMI=0.
|
||||
RHOMI=ZEROC
|
||||
JATLEM=JNEM
|
||||
IF(NTYPEM.GT.1) THEN
|
||||
DO JAEM=NTYPEM-1,1,-1
|
||||
JATLEM=JATLEM+NATYP(JAEM)
|
||||
ENDDO
|
||||
ENDIF
|
||||
DO JD=1,NDIF
|
||||
NPATH2(JD)=0.
|
||||
NPATH(JD)=0.
|
||||
IT(JD)=0
|
||||
IN(JD)=0
|
||||
FMIN(JD)=1.E+20
|
||||
FMAX(JD)=0.
|
||||
ENDDO
|
||||
NTHOF=0
|
||||
C
|
||||
C New initialization of TAU(INDJ,INDF,JATL) after the PW calculation
|
||||
C
|
||||
JATL=0
|
||||
DO JTYP=1,N_PROT
|
||||
NBTYP=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYP
|
||||
JATL=JATL+1
|
||||
DO LE=LE_MIN,LE_MAX,2
|
||||
ILE=LE*LE+LE+1
|
||||
DO ME=-LE,LE
|
||||
INDE=ILE+ME
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
DO MJ=-LJ,LJ
|
||||
INDJ=ILJ+MJ
|
||||
TAU(INDJ,INDE,JATL)=ZEROC
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
C
|
||||
C Generation and print-out of the paths
|
||||
C
|
||||
IF (NPATHP.GT.0) THEN
|
||||
DO JP=1,NPATHP-1
|
||||
FMN(JP)=0.
|
||||
PATH(JP)=0.
|
||||
JON(JP)=0
|
||||
ENDDO
|
||||
FMN(NPATHP)=-1.
|
||||
PATH(NPATHP)=0.
|
||||
JON(NPATHP)=0
|
||||
ENDIF
|
||||
IREF=0
|
||||
IJ=1
|
||||
IF(IPRINT.EQ.3) THEN
|
||||
OPEN(UNIT=IUSCR, STATUS='SCRATCH')
|
||||
ENDIF
|
||||
DIJ=0.
|
||||
CALL FINDPATHS_A(ND,NTYPEM,JATLEM,I_CP,R,XR,YR,ZR,RHOMI,
|
||||
1 THMI,PHMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
IF(NPATHP.EQ.0) GOTO 15
|
||||
IF(NSCAT.GT.1) THEN
|
||||
XPATOT=REAL((DFLOAT(NSCAT)**DFLOAT(NDIF+1) -1.D0)/
|
||||
1 DFLOAT(NSCAT-1))
|
||||
ELSE
|
||||
XPATOT=FLOAT(NDIF+1)
|
||||
ENDIF
|
||||
IF(XPATOT.LT.2.14748E+09) THEN
|
||||
NPATOT=INT(XPATOT)
|
||||
IF(NPATOT.LT.NPATHP) NPATHP=NPATOT-1
|
||||
ENDIF
|
||||
WRITE(IUO1,84) NPATHP
|
||||
WRITE(IUO1,81)
|
||||
DO JPT=1,NPATHP
|
||||
IF(PATH(NPATHP).GT.2.14E+09) THEN
|
||||
WRITE(IUO1,82) JPT,JON(JPT),PATH(JPT),FMN(JPT),DMN(JPT),
|
||||
1 JNEM,(JPON(JPT,KD),KD=1,JON(JPT))
|
||||
ELSE
|
||||
WRITE(IUO1,83) JPT,JON(JPT),INT(PATH(JPT)),FMN(JPT),
|
||||
1 DMN(JPT),JNEM,(JPON(JPT,KD),KD=1,JON(JPT))
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(IPRINT.EQ.3) THEN
|
||||
IF(XPATOT.GT.2.14748E+09) GOTO 172
|
||||
WRITE(IUO1,85)
|
||||
WRITE(IUO1,71)
|
||||
NPATOT=INT(XPATOT)
|
||||
DO JOP=0,NDIF
|
||||
IF(JOP.EQ.0) THEN
|
||||
XINT0=FMAX(0)
|
||||
DIST0=0.
|
||||
WRITE(IUO1,70) JOP,JOP+1,XINT0,DIST0,JNEM
|
||||
GOTO 75
|
||||
ENDIF
|
||||
WRITE(IUO1,77)
|
||||
DO JLINE=1,NPATOT-1
|
||||
READ(IUSCR,69,ERR=75,END=75) JOPA,NOPA,XMAX,DIST0,
|
||||
1 (JPA(KD),KD=1,JOPA)
|
||||
IF(JOPA.EQ.JOP) THEN
|
||||
IF(NOPA.GT.2.14E+09) THEN
|
||||
WRITE(IUO1,76) JOPA,NOPA,XMAX,DIST0,JNEM,
|
||||
1 (JPA(KD),KD=1,JOPA)
|
||||
ELSE
|
||||
WRITE(IUO1,70) JOPA,INT(NOPA),XMAX,DIST0,JNEM,
|
||||
1 (JPA(KD),KD=1,JOPA)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(JOP.EQ.NDIF) WRITE(IUO1,80)
|
||||
75 REWIND IUSCR
|
||||
ENDDO
|
||||
GOTO 73
|
||||
172 WRITE(IUO1,74)
|
||||
CLOSE(IUSCR,STATUS='DELETE')
|
||||
73 ENDIF
|
||||
DO JD=0,NDIF
|
||||
NPATH1(JD)=REAL(DFLOAT(NSCAT)**DFLOAT(JD))
|
||||
IF(NPATH1(JD).GT.2.14E+09) THEN
|
||||
IF(FMIN(JD).EQ.0.1E+21) FMIN(JD)=0.
|
||||
WRITE(IUO1,53) JD,NPATH1(JD),NPATH2(JD),FMIN(JD),NPMI(JD),
|
||||
1 FMAX(JD),NPMA(JD)
|
||||
IF((IPW.EQ.1).AND.(JD.GT.NCUT)) WRITE(IUO1,68) FREF*PCTINT
|
||||
ELSE
|
||||
IF(FMIN(JD).EQ.0.1E+21) FMIN(JD)=0.
|
||||
WRITE(IUO1,58) JD,INT(NPATH1(JD)+0.1),
|
||||
1 INT(NPATH2(JD)+0.1),FMIN(JD),
|
||||
2 INT(NPMI(JD)+0.1),FMAX(JD),
|
||||
3 INT(NPMA(JD)+0.1)
|
||||
IF((IPW.EQ.1).AND.(JD.GT.NCUT)) WRITE(IUO1,68) FREF*PCTINT
|
||||
ENDIF
|
||||
ENDDO
|
||||
666 CONTINUE
|
||||
C
|
||||
C Calculation of the Auger Electron Diffraction formula
|
||||
C
|
||||
C
|
||||
C Loop over the 'fixed' angle
|
||||
C
|
||||
15 DO J_FIXED=1,N_FIXED
|
||||
IF(N_FIXED.GT.1) THEN
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
XINCRF=FLOAT(J_FIXED-1)*FIX_STEP
|
||||
ELSE
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
ELSEIF(N_FIXED.EQ.1) THEN
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
IF(ABS(I_EXT).GE.1) THEN
|
||||
READ(ISET,86) JSET,JLINE,THD,PHD
|
||||
IF(I_EXT.EQ.-1) BACKSPACE ISET
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DPHI=PHI0+XINCRF
|
||||
ELSE
|
||||
DPHI=PHD
|
||||
ENDIF
|
||||
RPHI=DPHI*PIS180
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,66) DPHI
|
||||
ELSE
|
||||
ISAUT=0
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DTHETA=THETA0+XINCRF
|
||||
ELSE
|
||||
DTHETA=THD
|
||||
ENDIF
|
||||
RTHETA=DTHETA*PIS180
|
||||
IF(ABS(DTHETA).GT.90.) ISAUT=ISAUT+1
|
||||
IF(I_EXT.GE.1) ISAUT=0
|
||||
IF(I_TEST.EQ.2) ISAUT=0
|
||||
IF(ISAUT.GT.0) GOTO 8
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,65) DTHETA
|
||||
IF((IPRINT.GT.0).AND.(I_TEST.NE.2)) WRITE(IUO1,59)
|
||||
IF((IPRINT.EQ.1).AND.(I_TEST.NE.2)) WRITE(IUO1,60)
|
||||
C
|
||||
C THETA-dependent number of PHI points for stereographic
|
||||
C representation (to obtain a uniform sampling density).
|
||||
C (Courtesy of J. Osterwalder - University of Zurich)
|
||||
C
|
||||
IF(STEREO.EQ.'YES') THEN
|
||||
N_SCAN=INT((SCAN1-SCAN0)*SIN(RTHETA)/FIX_STEP+SMALL)+1
|
||||
ENDIF
|
||||
C
|
||||
ENDIF
|
||||
C
|
||||
C Loop over the scanned angle
|
||||
C
|
||||
DO J_SCAN=1,N_SCAN
|
||||
IF(N_SCAN.GT.1) THEN
|
||||
XINCRS=FLOAT(J_SCAN-1)*(SCAN1-SCAN0)/FLOAT(N_SCAN-1)
|
||||
ELSEIF(N_SCAN.EQ.1) THEN
|
||||
XINCRS=0.
|
||||
ENDIF
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
READ(ISET,86) JSET,JLINE,THD,PHD
|
||||
BACKSPACE ISET
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
ISAUT=0
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DTHETA=THETA0+XINCRS
|
||||
ELSE
|
||||
DTHETA=THD
|
||||
ENDIF
|
||||
RTHETA=DTHETA*PIS180
|
||||
IF(ABS(DTHETA).GT.90.) ISAUT=ISAUT+1
|
||||
IF(I_EXT.GE.1) ISAUT=0
|
||||
IF(I_TEST.EQ.2) ISAUT=0
|
||||
IF(ISAUT.GT.0) GOTO 8
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,65) DTHETA
|
||||
IF((IPRINT.GT.0).AND.(I_TEST.NE.2)) WRITE(IUO1,59)
|
||||
IF((IPRINT.EQ.1).AND.(I_TEST.NE.2)) WRITE(IUO1,60)
|
||||
ELSE
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
DPHI=PHI0+XINCRS
|
||||
ELSE
|
||||
DPHI=PHD
|
||||
ENDIF
|
||||
RPHI=DPHI*PIS180
|
||||
IF(IPRINT.GT.0) WRITE(IUO1,66) DPHI
|
||||
ENDIF
|
||||
C
|
||||
C Loop over the sets of directions to average over (for gaussian average)
|
||||
C
|
||||
C
|
||||
SSETDIR_1=0.
|
||||
SSETDIF_1=0.
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JREF=INT(NSET)/2+1
|
||||
ELSE
|
||||
JREF=1
|
||||
ENDIF
|
||||
C
|
||||
DO J_SET=1,NSET
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
READ(ISET,86) JSET,JLINE,THD,PHD,W
|
||||
DTHETA=THD
|
||||
DPHI=PHD
|
||||
RTHETA=DTHETA*PIS180
|
||||
RPHI=DPHI*PIS180
|
||||
ELSE
|
||||
W=1.
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) PRINT 89
|
||||
C
|
||||
CALL DIRAN(VINT,ECIN,JEL)
|
||||
IF(J_SET.EQ.JREF) THEN
|
||||
DTHETAP=DTHETA
|
||||
DPHIP=DPHI
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO1,88) DTHETA,DPHI
|
||||
ENDIF
|
||||
C
|
||||
WRITE(IUO1,61) (DIRANA(J,1),J=1,3)
|
||||
C
|
||||
SRDIF_1=0.
|
||||
SRDIR_1=0.
|
||||
C
|
||||
C Loop over the different directions of the analyzer contained in a cone
|
||||
C
|
||||
DO JDIR=1,NDIR
|
||||
IF(IATTS.EQ.1) THEN
|
||||
ATTSE=EXP(-ZSURFE*GAMMA/DIRANA(3,JDIR))
|
||||
ENDIF
|
||||
C
|
||||
SSCDIR_1=0.
|
||||
SSCDIF_1=0.
|
||||
C
|
||||
C Loop over the equiprobable quantum numbers MC,SC and SA
|
||||
C corresponding respectively to the core hole (MC and spin SC)
|
||||
C and to the outgoing Auger electron (SA). The sum over the
|
||||
C equiprobable azimuthal quantum number MJ of the multiplet
|
||||
C configuration is suppressed here as, because of the selection
|
||||
C rules, one has MJ = MA + MC + SA + SC
|
||||
C
|
||||
LME=LMAX(1,JE)
|
||||
CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLME,LME)
|
||||
C
|
||||
DO ISC=1,2
|
||||
SC=FLOAT(ISC)-1.5
|
||||
C
|
||||
SMCDIR_1=0.
|
||||
SMCDIF_1=0.
|
||||
C
|
||||
DO MC=-LI,LI
|
||||
C
|
||||
SSADIR_1=0.
|
||||
SSADIF_1=0.
|
||||
C
|
||||
DO ISA=1,2
|
||||
SA=FLOAT(ISA)-1.5
|
||||
C
|
||||
SMJMDIR_1=0.
|
||||
SMJMDIF_1=0.
|
||||
C
|
||||
DO MJM=-J_MUL,J_MUL
|
||||
C
|
||||
SJDIR_1=ZEROC
|
||||
SJDIF_1=ZEROC
|
||||
C
|
||||
C Calculation of the direct emission (used a a reference for the
|
||||
C output), which is not contained in the calculation of TAU
|
||||
C
|
||||
DO L_E=LE_MIN,LE_MAX,2
|
||||
ILE=L_E*L_E+L_E+1
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
R2=TL(L_E,1,1,JE)
|
||||
ELSE
|
||||
R2=TLT(L_E,1,1,JE)
|
||||
ENDIF
|
||||
M_E=MJM-MC-ISA-ISC+3
|
||||
IF(ABS(M_E).GT.L_E) GOTO 444
|
||||
INDE=ILE+M_E
|
||||
SJDIR_1=SJDIR_1+YLME(L_E,M_E)*ATTSE*
|
||||
1 M_COUL(L_E,M_E,ISA,MC,ISC)*R2
|
||||
C
|
||||
C Contribution of the absorber to TAU (initialization of SJDIF)
|
||||
C
|
||||
IF(I_TEST.EQ.2) GOTO 444
|
||||
SL0DIF=ZEROC
|
||||
DO L0=0,LME
|
||||
IL0=L0*L0+L0+1
|
||||
SL0DIF=SL0DIF+YLME(L0,0)*TAU(IL0,INDE,1)
|
||||
DO M0=1,L0
|
||||
IND01=IL0+M0
|
||||
IND02=IL0-M0
|
||||
SL0DIF=SL0DIF+(YLME(L0,M0)*
|
||||
1 TAU(IND01,INDE,1)+
|
||||
2 YLME(L0,-M0)*
|
||||
3 TAU(IND02,INDE,1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
||||
SJDIF_1=SJDIF_1+SL0DIF*M_COUL(L_E,M_E,ISA,MC,ISC)
|
||||
444 CONTINUE
|
||||
ENDDO
|
||||
SJDIF_1=SJDIF_1*ATTSE
|
||||
C
|
||||
C Loop over the last atom J encountered by the photoelectron
|
||||
C before escaping the solid
|
||||
C
|
||||
IF(I_TEST.EQ.2) GOTO 111
|
||||
DO JTYP=2,N_PROT
|
||||
NBTYP=NATYP(JTYP)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
DO JNUM=1,NBTYP
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
XOJ=SYM_AT(1,JATL)-EMET(1)
|
||||
YOJ=SYM_AT(2,JATL)-EMET(2)
|
||||
ZOJ=SYM_AT(3,JATL)-EMET(3)
|
||||
ROJ=SQRT(XOJ*XOJ+YOJ*YOJ+ZOJ*ZOJ)
|
||||
ZSURFJ=VAL(1)-SYM_AT(3,JATL)
|
||||
CALL HARSPH(NL_M,THETAR(JDIR),PHIR(JDIR),YLMR,
|
||||
1 LMJ)
|
||||
IF(IATTS.EQ.1) THEN
|
||||
ATTSJ=EXP(-ZSURFJ*GAMMA/DIRANA(3,JDIR))
|
||||
ENDIF
|
||||
CSTHJR=(XOJ*DIRANA(1,JDIR)+YOJ*DIRANA(2,JDIR)+
|
||||
1 ZOJ*DIRANA(3,JDIR))/ROJ
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 78
|
||||
CTROIS1=ZOJ/ROJ
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
IF(IDCM.GE.1) THEN
|
||||
UJ2(JTYP)=UJ_SQ(JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(CSTHJR-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(DIRANA(3,JDIR)-CTROIS1)*
|
||||
1 (DIRANA(3,JDIR)-CTROIS1)/(2.
|
||||
2 -2.*CSTHJR)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
78 IF(IDWSPH.EQ.1) THEN
|
||||
DWTER=1.
|
||||
ELSE
|
||||
DWTER=EXP(-VK2(JE)*UJJ*(1.-CSTHJR))
|
||||
ENDIF
|
||||
IF(JATL.EQ.JATLEM) THEN
|
||||
ATT_M=ATTSE*DWTER
|
||||
ELSE
|
||||
ATT_M=ATTSJ*DWTER*CEXP(-IC*VK(JE)*ROJ*CSTHJR)
|
||||
ENDIF
|
||||
C
|
||||
SLE_1=ZEROC
|
||||
DO L_E=LE_MIN,LE_MAX,2
|
||||
ILE=L_E*L_E+L_E+1
|
||||
M_E=MJM-MC-ISA-ISC+3
|
||||
IF(ABS(M_E).GT.L_E) GOTO 555
|
||||
INDE=ILE+M_E
|
||||
SLJDIF=ZEROC
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
SMJDIF=YLMR(LJ,0)*TAU(ILJ,INDE,JATL)
|
||||
IF(LJ.GT.0) THEN
|
||||
DO MJ=1,LJ
|
||||
INDJ1=ILJ+MJ
|
||||
INDJ2=ILJ-MJ
|
||||
SMJDIF=SMJDIF+(YLMR(LJ,MJ)*
|
||||
1 TAU(INDJ1,INDE,JATL)+
|
||||
2 YLMR(LJ,-MJ)*
|
||||
3 TAU(INDJ2,INDE,JATL))
|
||||
ENDDO
|
||||
ENDIF
|
||||
SLJDIF=SLJDIF+SMJDIF
|
||||
ENDDO
|
||||
SLE_1=SLE_1+SLJDIF*M_COUL(L_E,M_E,ISA,MC,ISC)
|
||||
555 CONTINUE
|
||||
ENDDO
|
||||
SJDIF_1=SJDIF_1+SLE_1*ATT_M
|
||||
C
|
||||
C End of the loops over the last atom J
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Writing the amplitudes in file IOUT for APECS
|
||||
C
|
||||
111 IF(SPECTRO.EQ.'APC') THEN
|
||||
WRITE(IOUT,87) JFICH,JPLAN,JEMET,JE,J_FIXED,J_SCAN,
|
||||
1 JDIR,ISC,MC,ISA,MJM,SJDIR_1,
|
||||
2 SJDIR_1+SJDIF_1
|
||||
ELSE
|
||||
C
|
||||
C Computing the square modulus
|
||||
C
|
||||
SSADIF_1=SSADIF_1+CABS(SJDIR_1+SJDIF_1)*
|
||||
1 CABS(SJDIR_1+SJDIF_1)
|
||||
SSADIR_1=SSADIR_1+CABS(SJDIR_1)*CABS(SJDIR_1)
|
||||
C
|
||||
ENDIF
|
||||
C
|
||||
C End of the loop over MJM
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SMJMDIF_1=SMJMDIF_1+SSADIF_1
|
||||
SMJMDIR_1=SMJMDIR_1+SSADIR_1
|
||||
C
|
||||
C End of the loop over SA
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SMCDIF_1=SMCDIF_1+SMJMDIF_1
|
||||
SMCDIR_1=SMCDIR_1+SMJMDIR_1
|
||||
C
|
||||
C End of the loop over MC
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SSCDIF_1=SSCDIF_1+SMCDIF_1
|
||||
SSCDIR_1=SSCDIR_1+SMCDIR_1
|
||||
C
|
||||
C End of the loop over SC
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(SPECTRO.EQ.'APC') GOTO 220
|
||||
SRDIR_1=SRDIR_1+SSCDIR_1*VKR*CFM/NDIR
|
||||
SRDIF_1=SRDIF_1+SSCDIF_1*VKR*CFM/NDIR
|
||||
220 CONTINUE
|
||||
C
|
||||
C End of the loop on the directions of the analyzer
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(SPECTRO.EQ.'APC') GOTO 221
|
||||
SSETDIR_1=SSETDIR_1+SRDIR_1*W
|
||||
SSETDIF_1=SSETDIF_1+SRDIF_1*W
|
||||
IF(ICHKDIR.EQ.2) THEN
|
||||
IF(JSET.EQ.JREF) THEN
|
||||
SSET2DIR_1=SRDIR_1
|
||||
SSET2DIF_1=SRDIF_1
|
||||
ENDIF
|
||||
ENDIF
|
||||
221 CONTINUE
|
||||
C
|
||||
C End of the loop on the set averaging
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(SPECTRO.EQ.'APC') GOTO 222
|
||||
IF(ISOM.EQ.2) THEN
|
||||
WRITE(IOUT,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
|
||||
1 SSETDIR_1,SSETDIF_1
|
||||
IF(ICHKDIR.EQ.2) THEN
|
||||
WRITE(IUO2,67) JPLAN,JFICH,DTHETAP,DPHIP,ECIN,
|
||||
1 SSET2DIR_1,SSET2DIF_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IOUT,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
|
||||
1 SSETDIR_1,SSETDIF_1
|
||||
IF(ICHKDIR.EQ.2) THEN
|
||||
WRITE(IUO2,67) JPLAN,JEMET,DTHETAP,DPHIP,ECIN,
|
||||
1 SSET2DIR_1,SSET2DIF_1
|
||||
ENDIF
|
||||
ENDIF
|
||||
222 CONTINUE
|
||||
C
|
||||
C End of the loop on the scanned angle
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
8 CONTINUE
|
||||
C
|
||||
C End of the loop on the fixed angle
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
C End of the loop on the energy
|
||||
C
|
||||
CLOSE(ISET)
|
||||
ENDDO
|
||||
C
|
||||
3 CONTINUE
|
||||
C
|
||||
C End of the loop on the emitters
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
GO TO 1
|
||||
5 IPLAN=JPLAN-1
|
||||
IJK=IJK+1
|
||||
IF((IJK.EQ.1).AND.(IPRINT.GT.0)) THEN
|
||||
IF(I_TEST.NE.2) WRITE(IUO1,54) IPLAN
|
||||
ENDIF
|
||||
1 CONTINUE
|
||||
C
|
||||
C End of the loop on the planes
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
IF(ABS(I_EXT).GE.1) CLOSE(ISET)
|
||||
IF((ISOM.EQ.0).OR.(JFICH.EQ.NFICHLEC)) WRITE(IOUT,*)
|
||||
IF(SPECTRO.EQ.'APC') CLOSE(IOUT)
|
||||
IF(SPECTRO.EQ.'APC') GOTO 7
|
||||
c IF(((NEMET.GT.1).OR.(NPLAN.GT.1)).AND.(ISOM.EQ.0)) THEN
|
||||
IF(((NEMET.GT.1).OR.(NPLAN.GT.0)).AND.(ISOM.EQ.0)) THEN
|
||||
NP=0
|
||||
CALL TREAT_AED(ISOM,NFICHLEC,JFICH,NP)
|
||||
ENDIF
|
||||
IF(I_EXT.EQ.2) THEN
|
||||
CALL WEIGHT_SUM(ISOM,I_EXT,0,1)
|
||||
ENDIF
|
||||
GOTO 7
|
||||
6 WRITE(IUO1,55)
|
||||
C
|
||||
9 FORMAT(9(2X,I1),2X,I2)
|
||||
11 FORMAT(I4,2X,I4,2X,I4)
|
||||
12 FORMAT(2X,A3)
|
||||
13 FORMAT(6X,I1,1X,I3,2X,I4)
|
||||
14 FORMAT(6X,I1,1X,I3,3X,I3)
|
||||
22 FORMAT(16X,'INTERNAL CALCULATION OF MEAN SQUARE DISPLACEMENTS',/,
|
||||
1 25X,' BY DEBYE UNCORRELATED MODEL:',/)
|
||||
23 FORMAT(21X,'ATOM TYPE ',I5,' MSD = ',F8.6,' ANG**2')
|
||||
51 FORMAT(/////,2X,'******* PLANE NUMBER ',I3,' DOES NOT CONTAIN ',
|
||||
*'ANY ABSORBER OF TYPE ',I2,' *******')
|
||||
52 FORMAT(/////,2X,'******* PLANE NUMBER ',I3,' POSITION OF ',
|
||||
1'THE ABSORBER : (',F6.3,',',F6.3,',',F6.3,') *******',/,2X,
|
||||
2'******* ',19X,'THIS ABSORBER IS OF TYPE ',I2,20X,' *******')
|
||||
53 FORMAT(//,2X,'ORDER ',I2,' TOTAL NUMBER OF PATHS : ',F15.1,
|
||||
1 /,10X,' EFFECTIVE NUMBER OF PATHS : ',F15.1,
|
||||
2 /,10X,' MINIMAL INTENSITY : ',E12.6,
|
||||
3 2X,'No OF THE PATH : ',F15.1,
|
||||
4 /,10X,' MAXIMAL INTENSITY : ',E12.6,
|
||||
5 2X,'No OF THE PATH : ',F15.1)
|
||||
54 FORMAT(//,7X,'DUE TO THE SIZE OF THE CLUSTER, THE SUMMATION',
|
||||
*' HAS BEEN TRUNCATED TO THE ',I2,' TH PLANE')
|
||||
55 FORMAT(///,12X,' <<<<<<<<<< THIS VALUE OF ILPM IS NOT',
|
||||
*'AVAILABLE >>>>>>>>>>')
|
||||
56 FORMAT(4X,'LATTICE PARAMETER A = ',F6.3,' ANGSTROEMS',4X,
|
||||
*'MEAN FREE PATH = ',F6.3,' * A',//)
|
||||
57 FORMAT(25X,'CLUSTER RADIUS = ',F6.3,' *A')
|
||||
58 FORMAT(//,2X,'ORDER ',I2,' TOTAL NUMBER OF PATHS : ',I10,
|
||||
1 /,10X,' EFFECTIVE NUMBER OF PATHS : ',I10,
|
||||
2 /,10X,' MINIMAL INTENSITY : ',E12.6,
|
||||
3 2X,'No OF THE PATH : ',I10,
|
||||
4 /,10X,' MAXIMAL INTENSITY : ',E12.6,
|
||||
5 2X,'No OF THE PATH : ',I10)
|
||||
59 FORMAT(//,15X,'THE SCATTERING DIRECTION IS GIVEN INSIDE ',
|
||||
*'THE CRYSTAL')
|
||||
60 FORMAT(7X,'THE POSITIONS OF THE ATOMS ARE GIVEN WITH RESPECT ',
|
||||
*'TO THE ABSORBER')
|
||||
61 FORMAT(///,4X,'.......... DIRECTION OF THE DETECTOR : (',
|
||||
1 F6.3,',',F6.3,',',F6.3,') ..........')
|
||||
65 FORMAT(////,3X,'++++++++++++++++++',9X,
|
||||
*'THETA = ',F6.2,' DEGREES',9X,'++++++++',
|
||||
*'++++++++++',///)
|
||||
66 FORMAT(////,3X,'++++++++++++++++++',9X,
|
||||
*'PHI = ',F6.2,' DEGREES',9X,'++++++++++',
|
||||
*'++++++++++',///)
|
||||
67 FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
|
||||
1 2X,E12.6)
|
||||
68 FORMAT(10X,' CUT-OFF INTENSITY : ',E12.6)
|
||||
69 FORMAT(9X,I2,2X,E12.6,7X,E12.6,1X,F6.3,1X,10(I3,2X))
|
||||
70 FORMAT(2X,I2,2X,I10,7X,E12.6,2X,F6.3,7X,I2,7X,10(I3,2X))
|
||||
71 FORMAT(//,1X,'JDIF',4X,'No OF THE PATH',2X,
|
||||
1 'INTENSITY',3X,'LENGTH',4X,'ABSORBER',2X,
|
||||
2 'ORDER OF THE SCATTERERS',/)
|
||||
74 FORMAT(10X,'<===== NUMBER OF PATHS TOO LARGE FOR PRINTING ',
|
||||
1 '=====>')
|
||||
76 FORMAT(2X,I2,2X,E12.6,7X,E12.6,2X,F6.3,7X,I2,7X,10(I3,2X))
|
||||
77 FORMAT(' ')
|
||||
79 FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
|
||||
80 FORMAT(///)
|
||||
81 FORMAT(//,1X,'RANK',1X,'ORDER',4X,'No PATH',3X,
|
||||
1 'INTENSITY',3X,'LENGTH',4X,'ABS',3X,
|
||||
2 'ORDER OF THE SCATTERERS',/)
|
||||
82 FORMAT(I3,4X,I2,1X,E12.6,3X,E12.6,2X,F6.3,4X,I2,4X,10(I3,1X))
|
||||
83 FORMAT(I3,4X,I2,1X,I10,3X,E12.6,2X,F6.3,4X,I2,4X,10(I3,1X))
|
||||
84 FORMAT(/////,18X,'THE ',I3,' MORE INTENSE PATHS BY DECREASING',
|
||||
1 ' ORDER :',/,24X,'(THE LENGTH IS GIVEN IN UNITS ',
|
||||
2 'OF A)')
|
||||
85 FORMAT(/////,25X,' PATHS USED IN THE CALCULATION : ',
|
||||
1 /,24X,'(THE LENGTH IS GIVEN IN UNITS OF A)')
|
||||
86 FORMAT(2X,I3,1X,I4,5X,F8.3,3X,F8.3,3X,E12.6)
|
||||
87 FORMAT(2X,I2,2X,I3,2X,I2,2X,I3,2X,I3,2X,I3,2X,I2,2X,I2,2X,I2,
|
||||
1 2X,I2,2X,I2,2X,E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
|
||||
88 FORMAT(/,19X,'TILTED THETA =',F6.2,5X,'TILTED PHI =',
|
||||
1 F6.2)
|
||||
89 FORMAT(/,4X,'..........................................',
|
||||
1 '.....................................')
|
||||
C
|
||||
7 RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE COUMAT_AM(LA,MA,SA,MC,SC,JE,RHOK_A,MATRIX_AM)
|
||||
C
|
||||
C This routine calculates the multiplet-resolved spin-independent
|
||||
C Coulomb matrix elements occuring in the Auger process. They
|
||||
C are stored in MATRIX_AM. The multiplet component is characterized
|
||||
C by the quantum numbers (L,S,J) which are read from the input
|
||||
C data file.
|
||||
C
|
||||
C Here, the conventions are (direct process D):
|
||||
C
|
||||
C (LC,MC) : core hole filled by intermediate electron
|
||||
C (L1,M1) : Auger electron before excitation
|
||||
C (L2,M2) : intermediate electron that fills the core hole
|
||||
C (LA,MA) : Auger electron after excitation
|
||||
C
|
||||
C In the exchange process E, the roles of (L1,M1) and (L2,M2)
|
||||
C are interchanged.
|
||||
C
|
||||
C Note that the Clebsch-Gordan corresponding to the spin-orbit
|
||||
C resolved core state is not included in the formula here. This
|
||||
C is because in APECS, it appears also in the dipole matrix
|
||||
C element and it is therefore useless to calculate it twice.
|
||||
C Therefore, it must be implemented into the cross-section
|
||||
C subroutine.
|
||||
C
|
||||
C The factor i**LA comes from the particular normalization used
|
||||
C in the phagen code
|
||||
C
|
||||
C Last modified : 8 Dec 2008
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE C_G_M_MOD
|
||||
USE INIT_A_MOD, LC => LI_C, L2 => LI_I, L1 => LI_A
|
||||
USE TYPCAL_A_MOD, I1 => IPHI_A, I2 => IE_A, I3 => ITHETA_A,
|
||||
1 I4 => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A,
|
||||
2 I7 => I_EXT_A, I_TEST => I_TEST_A
|
||||
USE INIT_M_MOD
|
||||
C
|
||||
COMPLEX RHOK_A(0:NT_M,NATM,0:40,2,NSPIN2_M)
|
||||
COMPLEX ZEROC,ONEC,MATRIX_AM
|
||||
COMPLEX SUM_LB,SUM_M1,IC,IL
|
||||
C
|
||||
REAL*4 CG1(0:N_GAUNT),CG2(0:N_GAUNT)
|
||||
REAL*4 GNT1(0:N_GAUNT),GNT2(0:N_GAUNT),GNT3(0:N_GAUNT)
|
||||
REAL*4 GNT4(0:N_GAUNT)
|
||||
C
|
||||
REAL*8 ZEROD
|
||||
C
|
||||
DATA PI4,ONEOSQ2,HALF /12.566371,0.707107,0.5/
|
||||
C
|
||||
ZEROC=(0.,0.)
|
||||
ONEC=(1.,0.)
|
||||
IC=(0.,1.)
|
||||
ZEROD=0.D0
|
||||
C
|
||||
IF(I_TEST.EQ.1) GOTO 2
|
||||
C
|
||||
IF(MOD(LA,4).EQ.0) THEN
|
||||
IL=ONEC
|
||||
ELSEIF(MOD(LA,4).EQ.1) THEN
|
||||
IL=IC
|
||||
ELSEIF(MOD(LA,4).EQ.2) THEN
|
||||
IL=-ONEC
|
||||
ELSEIF(MOD(LA,4).EQ.3) THEN
|
||||
IL=-IC
|
||||
ENDIF
|
||||
C
|
||||
IF(I_SHELL.EQ.0) THEN
|
||||
COEF1=ONEOSQ2*PI4
|
||||
ELSEIF(I_SHELL.EQ.1) THEN
|
||||
COEF1=HALF*PI4
|
||||
ENDIF
|
||||
C
|
||||
IF(MOD(S_MUL,2).EQ.0) THEN
|
||||
SIGN1=1.
|
||||
ELSE
|
||||
SIGN1=-1.
|
||||
ENDIF
|
||||
C
|
||||
C Values of MJ, ML and MS given by the Clebsch-Gordan
|
||||
C
|
||||
ML=MA+MC
|
||||
MS=INT(SA+SC+0.0001)
|
||||
MJ=ML+MS
|
||||
C
|
||||
C Storage indices for the spin Clebsch-Gordan :
|
||||
C
|
||||
C ISA(C) = 1 for -1/2 and 2 for 1/2
|
||||
C IS = 1 for S_MUL=0 and 2 for S_MUL=1
|
||||
C
|
||||
IS=S_MUL+1
|
||||
ISA=INT(SA+1.5001)
|
||||
ISC=INT(SC+1.5001)
|
||||
C
|
||||
C Bounds of the sum over LB
|
||||
C
|
||||
LB_MAX_D=MIN(L1+LA,L2+LC)
|
||||
LB_MIN_D=MAX(ABS(L1-LA),ABS(L2-LC))
|
||||
LB_MAX_E=MIN(L2+LA,L1+LC)
|
||||
LB_MIN_E=MAX(ABS(L2-LA),ABS(L1-LC))
|
||||
LB_MIN=MIN(LB_MIN_D,LB_MIN_E)
|
||||
LB_MAX=MAX(LB_MAX_D,LB_MAX_E)
|
||||
C
|
||||
N_CG=2
|
||||
CALL N_J(DFLOAT(L_MUL),DFLOAT(ML),DFLOAT(S_MUL),DFLOAT(MS),
|
||||
1 ZEROD,CG1,I_INT1,N_CG)
|
||||
C
|
||||
SUM_M1=ZEROC
|
||||
DO M1=-L1,L1
|
||||
M2=ML-M1
|
||||
C
|
||||
CALL N_J(DFLOAT(L1),DFLOAT(M1),DFLOAT(L2),DFLOAT(ML-M1),
|
||||
1 ZEROD,CG2,I_INT2,N_CG)
|
||||
CALL GAUNT(L1,M1,LA,MA,GNT1)
|
||||
CALL GAUNT(LC,MC,L2,M2,GNT2)
|
||||
CALL GAUNT(L2,M2,LA,MA,GNT3)
|
||||
CALL GAUNT(LC,MC,L1,M1,GNT4)
|
||||
C
|
||||
SUM_LB=ZEROC
|
||||
DO LB=LB_MIN,LB_MAX
|
||||
SUM_LB=SUM_LB+(RHOK_A(LA,JE,LB,1,1)*GNT1(LB)*GNT2(LB)+
|
||||
1 RHOK_A(LA,JE,LB,2,1)*GNT3(LB)*GNT4(LB)*
|
||||
2 SIGN1)/FLOAT(LB+LB+1)
|
||||
ENDDO
|
||||
SUM_M1=SUM_M1+SUM_LB*CG2(L_MUL)
|
||||
ENDDO
|
||||
C
|
||||
MATRIX_AM=SUM_M1*CG1(J_MUL)*CG_S(ISA,ISC,IS)*COEF1*IL
|
||||
C
|
||||
GOTO 1
|
||||
C
|
||||
2 MATRIX_AM=ONEC
|
||||
C
|
||||
1 RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE DWSPH_A(JTYP,JE,X,TLT,ISPEED)
|
||||
C
|
||||
C This routine recomputes the T-matrix elements taking into account the
|
||||
C mean square displacements.
|
||||
C
|
||||
C When the argument X is tiny, no vibrations are taken into account
|
||||
C
|
||||
C Last modified : 25 Apr 2013
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A, VK2 =>
|
||||
& VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
C
|
||||
DIMENSION GNT(0:N_GAUNT)
|
||||
C
|
||||
COMPLEX TLT(0:NT_M,4,NATM,NE_M),SL1,ZEROC
|
||||
C
|
||||
COMPLEX*16 FFL(0:2*NL_M)
|
||||
C
|
||||
DATA PI4,EPS /12.566371,1.0E-10/
|
||||
C
|
||||
ZEROC=(0.,0.)
|
||||
C
|
||||
IF(X.GT.EPS) THEN
|
||||
C
|
||||
C Standard case: vibrations
|
||||
C
|
||||
IF(ISPEED.LT.0) THEN
|
||||
NSUM_LB=ABS(ISPEED)
|
||||
ENDIF
|
||||
C
|
||||
COEF=PI4*EXP(-X)
|
||||
NL2=2*LMAX(JTYP,JE)+2
|
||||
IBESP=5
|
||||
MG1=0
|
||||
MG2=0
|
||||
C
|
||||
CALL BESPHE(NL2,IBESP,X,FFL)
|
||||
C
|
||||
DO L=0,LMAX(JTYP,JE)
|
||||
XL=FLOAT(L+L+1)
|
||||
SL1=ZEROC
|
||||
C
|
||||
DO L1=0,LMAX(JTYP,JE)
|
||||
XL1=FLOAT(L1+L1+1)
|
||||
CALL GAUNT(L,MG1,L1,MG2,GNT)
|
||||
L2MIN=ABS(L1-L)
|
||||
IF(ISPEED.GE.0) THEN
|
||||
L2MAX=L1+L
|
||||
ELSEIF(ISPEED.LT.0) THEN
|
||||
L2MAX=L2MIN+2*(NSUM_LB-1)
|
||||
ENDIF
|
||||
SL2=0.
|
||||
C
|
||||
DO L2=L2MIN,L2MAX,2
|
||||
XL2=FLOAT(L2+L2+1)
|
||||
C=SQRT(XL1*XL2/(PI4*XL))
|
||||
SL2=SL2+C*GNT(L2)*REAL(DREAL(FFL(L2)))
|
||||
ENDDO
|
||||
C
|
||||
SL1=SL1+SL2*TL(L1,1,JTYP,JE)
|
||||
ENDDO
|
||||
C
|
||||
TLT(L,1,JTYP,JE)=COEF*SL1
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ELSE
|
||||
C
|
||||
C Argument X tiny: no vibrations
|
||||
C
|
||||
DO L=0,LMAX(JTYP,JE)
|
||||
C
|
||||
TLT(L,1,JTYP,JE)=TL(L,1,JTYP,JE)
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDIF
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FACDIF1_A(VKE,RJ,RJK,THRJ,PHIRJ,BETA,GAMMA,L,M,
|
||||
1 FSPH,JAT,JE,*)
|
||||
C
|
||||
C This routine computes a spherical wave scattering factor
|
||||
C
|
||||
C Last modified : 03/04/2006
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD
|
||||
USE EXPFAC_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
USE TYPCAL_A_MOD, I2 => IPHI_A, I3 => IE_A, I4 => ITHETA_A,
|
||||
& IFTHET => IFTHET_A, I5 => IMOD_A, I6 => I_CP_A,
|
||||
& I7 => I_EXT_A, I8 => I_TEST_A
|
||||
C
|
||||
DIMENSION PLMM(0:100,0:100)
|
||||
DIMENSION D(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
|
||||
C
|
||||
COMPLEX HLM(0:NO_ST_M,0:NL_M-1),HLN(0:NO_ST_M,0:NL_M-1),FSPH,RHOJ
|
||||
COMPLEX HLM1,HLM2,HLM3,HLM4,ALMU,BLMU,SLP,SNU,SMU,VKE
|
||||
COMPLEX RHOJK
|
||||
C
|
||||
DATA PI/3.141593/
|
||||
C
|
||||
A=1.
|
||||
INTER=0
|
||||
IF(ITL.EQ.1) VKE=VK(JE)
|
||||
RHOJ=VKE*RJ
|
||||
RHOJK=VKE*RJK
|
||||
HLM1=(1.,0.)
|
||||
HLM2=(1.,0.)
|
||||
HLM3=(1.,0.)
|
||||
HLM4=(1.,0.)
|
||||
IEM=1
|
||||
CSTH=COS(BETA)
|
||||
IF((IFTHET.EQ.0).OR.(THRJ.LT.0.0001)) THEN
|
||||
INTER=1
|
||||
BLMU=SQRT(4.*PI/FLOAT(2*L+1))*CEXP((0.,-1.)*M*(PHIRJ-PI))
|
||||
ENDIF
|
||||
CALL PLM(CSTH,PLMM,LMAX(JAT,JE))
|
||||
IF(ISPHER.EQ.0) NO1=0
|
||||
IF(ISPHER.EQ.1) THEN
|
||||
IF(NO.EQ.8) THEN
|
||||
NO1=LMAX(JAT,JE)+1
|
||||
ELSE
|
||||
NO1=NO
|
||||
ENDIF
|
||||
CALL POLHAN(ISPHER,NO1,LMAX(JAT,JE),RHOJ,HLM)
|
||||
IF(IEM.EQ.0) THEN
|
||||
HLM4=HLM(0,L)
|
||||
ENDIF
|
||||
IF(RJK.GT.0.0001) THEN
|
||||
NDUM=0
|
||||
CALL POLHAN(ISPHER,NDUM,LMAX(JAT,JE),RHOJK,HLN)
|
||||
ENDIF
|
||||
CALL DJMN(THRJ,D,L)
|
||||
A1=ABS(D(0,M,L))
|
||||
IF(((A1.LT.0.0001).AND.(IFTHET.EQ.1)).AND.(INTER.EQ.0)) RETURN 1
|
||||
ENDIF
|
||||
MUMAX=MIN0(L,NO1)
|
||||
SMU=(0.,0.)
|
||||
DO 10 MU=0,MUMAX
|
||||
IF(MOD(MU,2).EQ.0) THEN
|
||||
B=1.
|
||||
ELSE
|
||||
B=-1.
|
||||
IF(SIN(BETA).LT.0.) THEN
|
||||
A=-1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ISPHER.LE.1) THEN
|
||||
ALMU=(1.,0.)
|
||||
C=1.
|
||||
ENDIF
|
||||
IF(ISPHER.EQ.0) GOTO 40
|
||||
IF(INTER.EQ.0) BLMU=CMPLX(D(M,0,L))
|
||||
IF(MU.GT.0) THEN
|
||||
C=B*FLOAT(L+L+1)/EXPF(MU,L)
|
||||
ALMU=(D(M,MU,L)*CEXP((0.,-1.)*MU*GAMMA)+B*
|
||||
* CEXP((0.,1.)*MU*GAMMA)*D(M,-MU,L))/BLMU
|
||||
ELSE
|
||||
C=1.
|
||||
ALMU=CMPLX(D(M,0,L))/BLMU
|
||||
ENDIF
|
||||
40 SNU=(0.,0.)
|
||||
NU1=INT(0.5*(NO1-MU)+0.0001)
|
||||
NUMAX=MIN0(NU1,L-MU)
|
||||
DO 20 NU=0,NUMAX
|
||||
SLP=(0.,0.)
|
||||
LPMIN=MAX0(MU,NU)
|
||||
DO 30 LP=LPMIN,LMAX(JAT,JE)
|
||||
IF(ISPHER.EQ.1) THEN
|
||||
HLM1=HLM(NU,LP)
|
||||
IF(RJK.GT.0.0001) HLM3=HLN(0,LP)
|
||||
ENDIF
|
||||
SLP=SLP+FLOAT(2*LP+1)*TL(LP,1,JAT,JE)*HLM1*PLMM(LP,MU)*HLM3
|
||||
30 CONTINUE
|
||||
IF(ISPHER.EQ.1) THEN
|
||||
HLM2=HLM(MU+NU,L)
|
||||
ENDIF
|
||||
SNU=SNU+SLP*HLM2
|
||||
20 CONTINUE
|
||||
SMU=SMU+SNU*C*ALMU*A*B
|
||||
10 CONTINUE
|
||||
FSPH=SMU/(VKE*HLM4)
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FACDIF_A(COSTH,JAT,JE,FTHETA)
|
||||
C
|
||||
C This routine computes the plane wave scattering factor
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
C
|
||||
DIMENSION PL(0:100)
|
||||
C
|
||||
COMPLEX FTHETA
|
||||
C
|
||||
FTHETA=(0.,0.)
|
||||
NL=LMAX(JAT,JE)+1
|
||||
CALL POLLEG(NL,COSTH,PL)
|
||||
DO 20 L=0,NL-1
|
||||
FTHETA=FTHETA+(2*L+1)*TL(L,1,JAT,JE)*PL(L)
|
||||
20 CONTINUE
|
||||
FTHETA=FTHETA/VK(JE)
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,369 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FINDPATHS_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
|
||||
1 PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
C
|
||||
C This routine generates all the paths and filters them according to the
|
||||
C criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH).
|
||||
C It corresponds to the spin-independent case from a non spin-orbit
|
||||
C resolved initial core state LI
|
||||
C
|
||||
C Last modified : 31 Jul 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
|
||||
USE COOR_MOD
|
||||
USE DEBWAL_MOD
|
||||
USE INIT_L_MOD
|
||||
USE PATH_MOD
|
||||
USE ROT_MOD
|
||||
USE TESTPA_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
|
||||
& IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
|
||||
USE TLDW_MOD
|
||||
USE VARIA_MOD
|
||||
C
|
||||
DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
|
||||
C
|
||||
COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
|
||||
COMPLEX IC,COMPL1,PW(0:NDIF_M)
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
|
||||
C
|
||||
DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
|
||||
C
|
||||
IC=(0.,1.)
|
||||
IEULER=1
|
||||
C
|
||||
IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
|
||||
IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
|
||||
C
|
||||
C I_CP = 0 : all open paths generated
|
||||
C I_CP = 1 : only closed paths generated
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO JTYP=1,N_TYP
|
||||
IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
|
||||
IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
|
||||
ND=ND+1
|
||||
C
|
||||
C I_ABS = 0 : the atom before the scatterer is not the absorber
|
||||
C I_ABS = 1 : the atom before the scatterer is the absorber
|
||||
C I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
|
||||
C
|
||||
IF(ND.EQ.1) THEN
|
||||
I_ABS=1
|
||||
ELSE
|
||||
I_ABS=0
|
||||
ENDIF
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
ELSE
|
||||
NBTYPJ=1
|
||||
ENDIF
|
||||
C
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
IF(JATL.EQ.IATL) GOTO 12
|
||||
XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
|
||||
YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
|
||||
ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
JPOS(ND,1)=JTYP
|
||||
JPOS(ND,2)=JNUM
|
||||
JPOS(ND,3)=JATL
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
IF(ND.GT.1) THEN
|
||||
COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(ITYP).EQ.0) THEN
|
||||
IF(COSTHMIJ.LT.COSFWDI) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(ITYP).EQ.1) THEN
|
||||
IF((COSTHMIJ.GT.COSBWDI).AND.
|
||||
1 (COSTHMIJ.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
RHOIJ=VK(JE)*R(ND)
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THIJ=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
|
||||
IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
|
||||
ZSURFI=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(ITYP)=SIG2(R(ND-1),ITYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFI).LE.SMALL) THEN
|
||||
IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
|
||||
CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
|
||||
1 -2.*COSTHMIJ)
|
||||
ELSE
|
||||
CSKZ2I=1.
|
||||
ENDIF
|
||||
UII=UJ2(ITYP)*(1.+CSKZ2I*(RSJ-1.))
|
||||
ELSE
|
||||
UII=UJ2(ITYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UI2=VK2(JE)*UII
|
||||
CALL DWSPH_A(ITYP,JE,XK2UI2,TLT,ISPEED)
|
||||
ENDIF
|
||||
40 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.1) THEN
|
||||
RHO01=RHOIJ
|
||||
TH01=THIJ
|
||||
PHI01=PHIIJ
|
||||
CALL DJMN2(TH01,RLM01,LF2,2)
|
||||
GOTO 30
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
LMJ=LMAX(ITYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
|
||||
CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
|
||||
CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
|
||||
1 AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
|
||||
30 CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
|
||||
1 PHIIJ,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 42
|
||||
I_ABS=0
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO KTYP=1,N_TYP
|
||||
ND=ND+1
|
||||
IF(ND.GT.NDIF) GOTO 20
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPK=NATYP(KTYP)
|
||||
ELSE
|
||||
NBTYPK=1
|
||||
ENDIF
|
||||
C
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
IF(KATL.EQ.JATL) GOTO 22
|
||||
JPOS(ND,1)=KTYP
|
||||
JPOS(ND,2)=KNUM
|
||||
JPOS(ND,3)=KATL
|
||||
XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
|
||||
YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
|
||||
ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
RHOJK=R(ND)*VK(JE)
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(JTYP).EQ.0) THEN
|
||||
IF(COSTHIJK.LT.COSFWDJ) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(JTYP).EQ.1) THEN
|
||||
IF((COSTHIJK.GT.COSBWDJ).AND.
|
||||
1 (COSTHIJK.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
|
||||
1 THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THJK=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
IF(ND-1.LT.NDIF) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
|
||||
ZSURFJ=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(JTYP)=SIG2(R(ND-1),JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
|
||||
1 -2.*COSTHIJK)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
50 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
|
||||
1 JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32
|
||||
IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
ENDIF
|
||||
CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
|
||||
1 ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
|
||||
CEX(ND)=CEXP(IC*RHOJK)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
|
||||
1 THJK,PHIJK,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 32
|
||||
CALL FINDPATHS2_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
|
||||
1 THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
32 DIJ=DIJ-R(ND)
|
||||
22 IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDDO
|
||||
20 CONTINUE
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
42 DIJ=DIJ-R(ND)
|
||||
12 IF(ND.GT.1) THEN
|
||||
IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDIF
|
||||
ENDDO
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,370 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FINDPATHS2_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
|
||||
1 PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
C
|
||||
C This routine generates all the paths and filters them according to the
|
||||
C criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH).
|
||||
C It corresponds to the spin-independent case from a non spin-orbit
|
||||
C resolved initial core state LI
|
||||
C
|
||||
C Last modified : 31 Jul 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
|
||||
USE COOR_MOD
|
||||
USE DEBWAL_MOD
|
||||
USE INIT_L_MOD
|
||||
USE PATH_MOD
|
||||
USE ROT_MOD
|
||||
USE TESTPA_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
|
||||
& IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
|
||||
USE TLDW_MOD
|
||||
USE VARIA_MOD
|
||||
C
|
||||
DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
|
||||
C
|
||||
COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
|
||||
COMPLEX IC,COMPL1,PW(0:NDIF_M)
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
|
||||
C
|
||||
DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
|
||||
C
|
||||
IC=(0.,1.)
|
||||
IEULER=1
|
||||
C
|
||||
IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
|
||||
IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
|
||||
C
|
||||
C I_CP = 0 : all open paths generated
|
||||
C I_CP = 1 : only closed paths generated
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO JTYP=1,N_TYP
|
||||
IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
|
||||
IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
|
||||
ND=ND+1
|
||||
C
|
||||
C I_ABS = 0 : the atom before the scatterer is not the absorber
|
||||
C I_ABS = 1 : the atom before the scatterer is the absorber
|
||||
C I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
|
||||
C
|
||||
IF(ND.EQ.1) THEN
|
||||
I_ABS=1
|
||||
ELSE
|
||||
I_ABS=0
|
||||
ENDIF
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
ELSE
|
||||
NBTYPJ=1
|
||||
ENDIF
|
||||
C
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
IF(JATL.EQ.IATL) GOTO 12
|
||||
XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
|
||||
YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
|
||||
ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
JPOS(ND,1)=JTYP
|
||||
JPOS(ND,2)=JNUM
|
||||
JPOS(ND,3)=JATL
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
IF(ND.GT.1) THEN
|
||||
COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(ITYP).EQ.0) THEN
|
||||
IF(COSTHMIJ.LT.COSFWDI) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(ITYP).EQ.1) THEN
|
||||
IF((COSTHMIJ.GT.COSBWDI).AND.
|
||||
1 (COSTHMIJ.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
RHOIJ=VK(JE)*R(ND)
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THIJ=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
|
||||
IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
|
||||
ZSURFI=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(ITYP)=SIG2(R(ND-1),ITYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFI).LE.SMALL) THEN
|
||||
IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
|
||||
CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
|
||||
1 -2.*COSTHMIJ)
|
||||
ELSE
|
||||
CSKZ2I=1.
|
||||
ENDIF
|
||||
UII=UJ2(ITYP)*(1.+CSKZ2I*(RSJ-1.))
|
||||
ELSE
|
||||
UII=UJ2(ITYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UI2=VK2(JE)*UII
|
||||
CALL DWSPH_A(ITYP,JE,XK2UI2,TLT,ISPEED)
|
||||
ENDIF
|
||||
40 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.1) THEN
|
||||
RHO01=RHOIJ
|
||||
TH01=THIJ
|
||||
PHI01=PHIIJ
|
||||
CALL DJMN2(TH01,RLM01,LF2,2)
|
||||
GOTO 30
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
LMJ=LMAX(ITYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
|
||||
CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
|
||||
1 AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
|
||||
30 CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
|
||||
1 PHIIJ,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 42
|
||||
I_ABS=0
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO KTYP=1,N_TYP
|
||||
ND=ND+1
|
||||
IF(ND.GT.NDIF) GOTO 20
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPK=NATYP(KTYP)
|
||||
ELSE
|
||||
NBTYPK=1
|
||||
ENDIF
|
||||
C
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
IF(KATL.EQ.JATL) GOTO 22
|
||||
JPOS(ND,1)=KTYP
|
||||
JPOS(ND,2)=KNUM
|
||||
JPOS(ND,3)=KATL
|
||||
XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
|
||||
YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
|
||||
ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
RHOJK=R(ND)*VK(JE)
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(JTYP).EQ.0) THEN
|
||||
IF(COSTHIJK.LT.COSFWDJ) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(JTYP).EQ.1) THEN
|
||||
IF((COSTHIJK.GT.COSBWDJ).AND.
|
||||
1 (COSTHIJK.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
|
||||
1 THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THJK=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
IF(ND-1.LT.NDIF) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
|
||||
ZSURFJ=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(JTYP)=SIG2(R(ND-1),JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
|
||||
1 -2.*COSTHIJK)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
50 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
|
||||
1 JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32
|
||||
IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
ENDIF
|
||||
CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
|
||||
1 ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
|
||||
CEX(ND)=CEXP(IC*RHOJK)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
|
||||
1 THJK,PHIJK,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 32
|
||||
CALL FINDPATHS3_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
|
||||
1 THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
32 DIJ=DIJ-R(ND)
|
||||
22 IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDDO
|
||||
20 CONTINUE
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
42 DIJ=DIJ-R(ND)
|
||||
12 IF(ND.GT.1) THEN
|
||||
IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDIF
|
||||
ENDDO
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,370 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FINDPATHS3_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
|
||||
1 PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
C
|
||||
C This routine generates all the paths and filters them according to the
|
||||
C criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH).
|
||||
C It corresponds to the spin-independent case from a non spin-orbit
|
||||
C resolved initial core state LI
|
||||
C
|
||||
C Last modified : 31 Jul 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
|
||||
USE COOR_MOD
|
||||
USE DEBWAL_MOD
|
||||
USE INIT_L_MOD
|
||||
USE PATH_MOD
|
||||
USE ROT_MOD
|
||||
USE TESTPA_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
|
||||
& IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
|
||||
USE TLDW_MOD
|
||||
USE VARIA_MOD
|
||||
C
|
||||
DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
|
||||
C
|
||||
COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
|
||||
COMPLEX IC,COMPL1,PW(0:NDIF_M)
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
|
||||
C
|
||||
DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
|
||||
C
|
||||
IC=(0.,1.)
|
||||
IEULER=1
|
||||
C
|
||||
IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
|
||||
IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
|
||||
C
|
||||
C I_CP = 0 : all open paths generated
|
||||
C I_CP = 1 : only closed paths generated
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO JTYP=1,N_TYP
|
||||
IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
|
||||
IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
|
||||
ND=ND+1
|
||||
C
|
||||
C I_ABS = 0 : the atom before the scatterer is not the absorber
|
||||
C I_ABS = 1 : the atom before the scatterer is the absorber
|
||||
C I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
|
||||
C
|
||||
IF(ND.EQ.1) THEN
|
||||
I_ABS=1
|
||||
ELSE
|
||||
I_ABS=0
|
||||
ENDIF
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
ELSE
|
||||
NBTYPJ=1
|
||||
ENDIF
|
||||
C
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
IF(JATL.EQ.IATL) GOTO 12
|
||||
XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
|
||||
YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
|
||||
ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
JPOS(ND,1)=JTYP
|
||||
JPOS(ND,2)=JNUM
|
||||
JPOS(ND,3)=JATL
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
IF(ND.GT.1) THEN
|
||||
COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(ITYP).EQ.0) THEN
|
||||
IF(COSTHMIJ.LT.COSFWDI) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(ITYP).EQ.1) THEN
|
||||
IF((COSTHMIJ.GT.COSBWDI).AND.
|
||||
1 (COSTHMIJ.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
RHOIJ=VK(JE)*R(ND)
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THIJ=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
|
||||
IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
|
||||
ZSURFI=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(ITYP)=SIG2(R(ND-1),ITYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFI).LE.SMALL) THEN
|
||||
IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
|
||||
CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
|
||||
1 -2.*COSTHMIJ)
|
||||
ELSE
|
||||
CSKZ2I=1.
|
||||
ENDIF
|
||||
UII=UJ2(ITYP)*(1.+CSKZ2I*(RSJ-1.))
|
||||
ELSE
|
||||
UII=UJ2(ITYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UI2=VK2(JE)*UII
|
||||
CALL DWSPH_A(ITYP,JE,XK2UI2,TLT,ISPEED)
|
||||
ENDIF
|
||||
40 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.1) THEN
|
||||
RHO01=RHOIJ
|
||||
TH01=THIJ
|
||||
PHI01=PHIIJ
|
||||
CALL DJMN2(TH01,RLM01,LF2,2)
|
||||
GOTO 30
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
LMJ=LMAX(ITYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
|
||||
CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
|
||||
1 AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
|
||||
30 CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
|
||||
1 PHIIJ,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 42
|
||||
I_ABS=0
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO KTYP=1,N_TYP
|
||||
ND=ND+1
|
||||
IF(ND.GT.NDIF) GOTO 20
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPK=NATYP(KTYP)
|
||||
ELSE
|
||||
NBTYPK=1
|
||||
ENDIF
|
||||
C
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
IF(KATL.EQ.JATL) GOTO 22
|
||||
JPOS(ND,1)=KTYP
|
||||
JPOS(ND,2)=KNUM
|
||||
JPOS(ND,3)=KATL
|
||||
XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
|
||||
YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
|
||||
ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
RHOJK=R(ND)*VK(JE)
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(JTYP).EQ.0) THEN
|
||||
IF(COSTHIJK.LT.COSFWDJ) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(JTYP).EQ.1) THEN
|
||||
IF((COSTHIJK.GT.COSBWDJ).AND.
|
||||
1 (COSTHIJK.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
|
||||
1 THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THJK=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
IF(ND-1.LT.NDIF) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
|
||||
ZSURFJ=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(JTYP)=SIG2(R(ND-1),JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
|
||||
1 -2.*COSTHIJK)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
50 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
|
||||
1 JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32
|
||||
IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
ENDIF
|
||||
CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
|
||||
1 ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
|
||||
CEX(ND)=CEXP(IC*RHOJK)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
|
||||
1 THJK,PHIJK,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 32
|
||||
CALL FINDPATHS4_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
|
||||
1 THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
32 DIJ=DIJ-R(ND)
|
||||
22 IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDDO
|
||||
20 CONTINUE
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
42 DIJ=DIJ-R(ND)
|
||||
12 IF(ND.GT.1) THEN
|
||||
IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDIF
|
||||
ENDDO
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,370 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FINDPATHS4_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
|
||||
1 PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
C
|
||||
C This routine generates all the paths and filters them according to the
|
||||
C criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH).
|
||||
C It corresponds to the spin-independent case from a non spin-orbit
|
||||
C resolved initial core state LI
|
||||
C
|
||||
C Last modified : 31 Jul 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
|
||||
USE COOR_MOD
|
||||
USE DEBWAL_MOD
|
||||
USE INIT_L_MOD
|
||||
USE PATH_MOD
|
||||
USE ROT_MOD
|
||||
USE TESTPA_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
|
||||
& IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
|
||||
USE TLDW_MOD
|
||||
USE VARIA_MOD
|
||||
C
|
||||
DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
|
||||
C
|
||||
COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
|
||||
COMPLEX IC,COMPL1,PW(0:NDIF_M)
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
|
||||
C
|
||||
DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
|
||||
C
|
||||
IC=(0.,1.)
|
||||
IEULER=1
|
||||
C
|
||||
IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
|
||||
IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
|
||||
C
|
||||
C I_CP = 0 : all open paths generated
|
||||
C I_CP = 1 : only closed paths generated
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO JTYP=1,N_TYP
|
||||
IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
|
||||
IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
|
||||
ND=ND+1
|
||||
C
|
||||
C I_ABS = 0 : the atom before the scatterer is not the absorber
|
||||
C I_ABS = 1 : the atom before the scatterer is the absorber
|
||||
C I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
|
||||
C
|
||||
IF(ND.EQ.1) THEN
|
||||
I_ABS=1
|
||||
ELSE
|
||||
I_ABS=0
|
||||
ENDIF
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
ELSE
|
||||
NBTYPJ=1
|
||||
ENDIF
|
||||
C
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
IF(JATL.EQ.IATL) GOTO 12
|
||||
XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
|
||||
YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
|
||||
ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
JPOS(ND,1)=JTYP
|
||||
JPOS(ND,2)=JNUM
|
||||
JPOS(ND,3)=JATL
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
IF(ND.GT.1) THEN
|
||||
COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(ITYP).EQ.0) THEN
|
||||
IF(COSTHMIJ.LT.COSFWDI) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(ITYP).EQ.1) THEN
|
||||
IF((COSTHMIJ.GT.COSBWDI).AND.
|
||||
1 (COSTHMIJ.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
RHOIJ=VK(JE)*R(ND)
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THIJ=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
|
||||
IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
|
||||
ZSURFI=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(ITYP)=SIG2(R(ND-1),ITYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFI).LE.SMALL) THEN
|
||||
IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
|
||||
CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
|
||||
1 -2.*COSTHMIJ)
|
||||
ELSE
|
||||
CSKZ2I=1.
|
||||
ENDIF
|
||||
UII=UJ2(ITYP)*(1.+CSKZ2I*(RSJ-1.))
|
||||
ELSE
|
||||
UII=UJ2(ITYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UI2=VK2(JE)*UII
|
||||
CALL DWSPH_A(ITYP,JE,XK2UI2,TLT,ISPEED)
|
||||
ENDIF
|
||||
40 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.1) THEN
|
||||
RHO01=RHOIJ
|
||||
TH01=THIJ
|
||||
PHI01=PHIIJ
|
||||
CALL DJMN2(TH01,RLM01,LF2,2)
|
||||
GOTO 30
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
LMJ=LMAX(ITYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
|
||||
CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
|
||||
1 AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
|
||||
30 CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
|
||||
1 PHIIJ,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 42
|
||||
I_ABS=0
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO KTYP=1,N_TYP
|
||||
ND=ND+1
|
||||
IF(ND.GT.NDIF) GOTO 20
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPK=NATYP(KTYP)
|
||||
ELSE
|
||||
NBTYPK=1
|
||||
ENDIF
|
||||
C
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
IF(KATL.EQ.JATL) GOTO 22
|
||||
JPOS(ND,1)=KTYP
|
||||
JPOS(ND,2)=KNUM
|
||||
JPOS(ND,3)=KATL
|
||||
XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
|
||||
YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
|
||||
ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
RHOJK=R(ND)*VK(JE)
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(JTYP).EQ.0) THEN
|
||||
IF(COSTHIJK.LT.COSFWDJ) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(JTYP).EQ.1) THEN
|
||||
IF((COSTHIJK.GT.COSBWDJ).AND.
|
||||
1 (COSTHIJK.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
|
||||
1 THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THJK=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
IF(ND-1.LT.NDIF) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
|
||||
ZSURFJ=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(JTYP)=SIG2(R(ND-1),JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
|
||||
1 -2.*COSTHIJK)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
50 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
|
||||
1 JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32
|
||||
IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
ENDIF
|
||||
CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
|
||||
1 ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
|
||||
CEX(ND)=CEXP(IC*RHOJK)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
|
||||
1 THJK,PHIJK,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 32
|
||||
CALL FINDPATHS5_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
|
||||
1 THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
32 DIJ=DIJ-R(ND)
|
||||
22 IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDDO
|
||||
20 CONTINUE
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
42 DIJ=DIJ-R(ND)
|
||||
12 IF(ND.GT.1) THEN
|
||||
IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDIF
|
||||
ENDDO
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,370 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE FINDPATHS5_A(ND,ITYP,IATL,I_CP,R,XR,YR,ZR,RHOMI,THMI,
|
||||
1 PHIMI,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
C
|
||||
C This routine generates all the paths and filters them according to the
|
||||
C criteria given in the input data file (IFSPH,IFWD,IPW,ILENGTH).
|
||||
C It corresponds to the spin-independent case from a non spin-orbit
|
||||
C resolved initial core state LI
|
||||
C
|
||||
C Last modified : 31 Jul 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD, ILE => ILENGTH, RLE => RLENGTH
|
||||
USE COOR_MOD
|
||||
USE DEBWAL_MOD
|
||||
USE INIT_L_MOD
|
||||
USE PATH_MOD
|
||||
USE ROT_MOD
|
||||
USE TESTPA_MOD
|
||||
USE TESTPB_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A,TL => TL_A, VK => VK_A, VK2 => VK2_A,
|
||||
& IPOTC => IPOTC_A, ITL => ITL_A, LMAX => LMAX_A
|
||||
USE TLDW_MOD
|
||||
USE VARIA_MOD
|
||||
C
|
||||
DIMENSION XR(NDIF_M),YR(NDIF_M),ZR(NDIF_M)
|
||||
DIMENSION JPOS(NDIF_M,3),R(NDIF_M)
|
||||
C
|
||||
COMPLEX PW1,PWI,FTHETA,RHOMI,RHOIJ,RHOJK
|
||||
COMPLEX IC,COMPL1,PW(0:NDIF_M)
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX YLM1(0:NL_M,-NL_M:NL_M)
|
||||
COMPLEX YLM2(0:NL_M,-NL_M:NL_M),CTL,CTL2
|
||||
C
|
||||
DATA XCOMP,PI4,SMALL /1.E-10,12.566371,0.0001/
|
||||
C
|
||||
IC=(0.,1.)
|
||||
IEULER=1
|
||||
C
|
||||
IF(IFWD.EQ.1) COSFWDI=COS(RTHFWD(ITYP))
|
||||
IF(IBWD(ITYP).EQ.1) COSBWDI=COS(RTHBWD(ITYP))
|
||||
C
|
||||
C I_CP = 0 : all open paths generated
|
||||
C I_CP = 1 : only closed paths generated
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO JTYP=1,N_TYP
|
||||
IF(IFWD.EQ.1) COSFWDJ=COS(RTHFWD(JTYP))
|
||||
IF(IBWD(JTYP).EQ.1) COSBWDJ=COS(RTHBWD(JTYP))
|
||||
ND=ND+1
|
||||
C
|
||||
C I_ABS = 0 : the atom before the scatterer is not the absorber
|
||||
C I_ABS = 1 : the atom before the scatterer is the absorber
|
||||
C I_ABS = 2 : the atom after the scatterer is the absorber (XAS only)
|
||||
C
|
||||
IF(ND.EQ.1) THEN
|
||||
I_ABS=1
|
||||
ELSE
|
||||
I_ABS=0
|
||||
ENDIF
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPJ=NATYP(JTYP)
|
||||
ELSE
|
||||
NBTYPJ=1
|
||||
ENDIF
|
||||
C
|
||||
DO JNUM=1,NBTYPJ
|
||||
JATL=NCORR(JNUM,JTYP)
|
||||
IF(JATL.EQ.IATL) GOTO 12
|
||||
XR(ND)=SYM_AT(1,JATL)-SYM_AT(1,IATL)
|
||||
YR(ND)=SYM_AT(2,JATL)-SYM_AT(2,IATL)
|
||||
ZR(ND)=SYM_AT(3,JATL)-SYM_AT(3,IATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
JPOS(ND,1)=JTYP
|
||||
JPOS(ND,2)=JNUM
|
||||
JPOS(ND,3)=JATL
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
IF(ND.GT.1) THEN
|
||||
COSTHMIJ=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(ITYP).EQ.0) THEN
|
||||
IF(COSTHMIJ.LT.COSFWDI) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(ITYP).EQ.1) THEN
|
||||
IF((COSTHMIJ.GT.COSBWDI).AND.
|
||||
1 (COSTHMIJ.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHMIJ.LT.COSFWDI).AND.(COSTHMIJ.GE.0.)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).AND.(ND.GT.1)) GOTO 42
|
||||
RHOIJ=VK(JE)*R(ND)
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1.) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THIJ=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIIJ)
|
||||
IF((ND.GT.1).AND.((ND-1).LT.NDIF)) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 40
|
||||
ZSURFI=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(ITYP)=SIG2(R(ND-1),ITYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFI).LE.SMALL) THEN
|
||||
IF(ABS(COSTHMIJ-1.).GT.SMALL) THEN
|
||||
CSKZ2I=(CTROIS1-COS(THMI))*(CTROIS1-COS(THMI))/(2.
|
||||
1 -2.*COSTHMIJ)
|
||||
ELSE
|
||||
CSKZ2I=1.
|
||||
ENDIF
|
||||
UII=UJ2(ITYP)*(1.+CSKZ2I*(RSJ-1.))
|
||||
ELSE
|
||||
UII=UJ2(ITYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UI2=VK2(JE)*UII
|
||||
CALL DWSPH_A(ITYP,JE,XK2UI2,TLT,ISPEED)
|
||||
ENDIF
|
||||
40 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UII*(1.-COSTHMIJ))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.1) THEN
|
||||
RHO01=RHOIJ
|
||||
TH01=THIJ
|
||||
PHI01=PHIIJ
|
||||
CALL DJMN2(TH01,RLM01,LF2,2)
|
||||
GOTO 30
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHMIJ,JPOS(ND-1,1),JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
LMJ=LMAX(ITYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THIJ,PHIIJ,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,JTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 42
|
||||
CALL EULER(THIJ,PHIIJ,THMI,PHIMI,AMIJ,BMIJ,CMIJ,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,ITYP,JTYP,JE,I_ABS,ISPEED,ISPHER,
|
||||
1 AMIJ,BMIJ,CMIJ,RHOMI,RHOIJ)
|
||||
30 CEX(ND)=CEXP(IC*RHOIJ)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(JATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
|
||||
1 PHIIJ,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 42
|
||||
I_ABS=0
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF-1)) THEN
|
||||
N_TYP=N_PROT
|
||||
ELSE
|
||||
N_TYP=1
|
||||
ENDIF
|
||||
C
|
||||
DO KTYP=1,N_TYP
|
||||
ND=ND+1
|
||||
IF(ND.GT.NDIF) GOTO 20
|
||||
C
|
||||
IF((I_CP.EQ.0).OR.(ND.NE.NDIF)) THEN
|
||||
NBTYPK=NATYP(KTYP)
|
||||
ELSE
|
||||
NBTYPK=1
|
||||
ENDIF
|
||||
C
|
||||
DO KNUM=1,NBTYPK
|
||||
KATL=NCORR(KNUM,KTYP)
|
||||
IF(KATL.EQ.JATL) GOTO 22
|
||||
JPOS(ND,1)=KTYP
|
||||
JPOS(ND,2)=KNUM
|
||||
JPOS(ND,3)=KATL
|
||||
XR(ND)=SYM_AT(1,KATL)-SYM_AT(1,JATL)
|
||||
YR(ND)=SYM_AT(2,KATL)-SYM_AT(2,JATL)
|
||||
ZR(ND)=SYM_AT(3,KATL)-SYM_AT(3,JATL)
|
||||
R(ND)=SQRT(XR(ND)*XR(ND)+YR(ND)*YR(ND)+ZR(ND)*ZR(ND))
|
||||
DIJ=DIJ+R(ND)
|
||||
IF((ILE.EQ.1).AND.(DIJ.GT.RLE)) IT(ND-1)=1
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
RHOJK=R(ND)*VK(JE)
|
||||
NPATH(ND)=NPATH(ND)+1.
|
||||
COSTHIJK=(XR(ND)*XR(ND-1)+YR(ND)*YR(ND-1)+
|
||||
1 ZR(ND)*ZR(ND-1))/(R(ND)*R(ND-1))
|
||||
IF(IFWD.EQ.1) THEN
|
||||
IF(IBWD(JTYP).EQ.0) THEN
|
||||
IF(COSTHIJK.LT.COSFWDJ) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF(IBWD(JTYP).EQ.1) THEN
|
||||
IF((COSTHIJK.GT.COSBWDJ).AND.
|
||||
1 (COSTHIJK.LT.-SMALL)) THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF((COSTHIJK.LT.COSFWDJ).AND.(COSTHIJK.GE.0.))
|
||||
1 THEN
|
||||
NTHOF=NTHOF+1
|
||||
IN(ND-1)=1
|
||||
IF(NTHOF.GT.NTHOUT) THEN
|
||||
IT(ND-1)=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IT(ND-1).EQ.1) GOTO 32
|
||||
CTROIS1=ZR(ND)/R(ND)
|
||||
IF(CTROIS1.GT.1) THEN
|
||||
CTROIS1=1.
|
||||
ELSEIF(CTROIS1.LT.-1.) THEN
|
||||
CTROIS1=-1.
|
||||
ENDIF
|
||||
THJK=ACOS(CTROIS1)
|
||||
COMPL1= XR(ND)+IC*YR(ND)
|
||||
IF(ND-1.LT.NDIF) THEN
|
||||
IF((IDWSPH.EQ.1).AND.(ISPEED.EQ.1)) GOTO 50
|
||||
ZSURFJ=ZSURF-ZR(ND-1)
|
||||
IF(IDCM.EQ.1) THEN
|
||||
UJ2(JTYP)=SIG2(R(ND-1),JTYP)
|
||||
ENDIF
|
||||
IF(ABS(ZSURFJ).LE.SMALL) THEN
|
||||
IF(ABS(COSTHIJK-1.).GT.SMALL) THEN
|
||||
CSKZ2J=(CTROIS1-COS(THIJ))*(CTROIS1-COS(THIJ))/(2.
|
||||
1 -2.*COSTHIJK)
|
||||
ELSE
|
||||
CSKZ2J=1.
|
||||
ENDIF
|
||||
UJJ=UJ2(JTYP)*(1.+CSKZ2J*(RSJ-1.))
|
||||
ELSE
|
||||
UJJ=UJ2(JTYP)
|
||||
ENDIF
|
||||
IF((ISPEED.EQ.0).AND.(IDWSPH.EQ.1)) THEN
|
||||
XK2UJ2=VK2(JE)*UJJ
|
||||
CALL DWSPH_A(JTYP,JE,XK2UJ2,TLT,ISPEED)
|
||||
ENDIF
|
||||
50 IF(IDWSPH.EQ.1) THEN
|
||||
DW(ND-1)=1.
|
||||
ELSE
|
||||
DW(ND-1)=EXP(-VK2(JE)*UJJ*(1.-COSTHIJK))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(IPW.EQ.1) THEN
|
||||
CALL FACDIF_A(COSTHIJK,JPOS(ND-1,1),
|
||||
1 JE,FTHETA)
|
||||
PWI=FTHETA*DW(ND-1)/R(ND)
|
||||
PW(ND)=PW(ND-1)*PWI
|
||||
CTL2=PI4*PW(ND)*CEX(1)/VK(JE)
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
IF(ND.GT.NCUT) THEN
|
||||
IT(ND)=1
|
||||
ELSE
|
||||
IT(ND)=0
|
||||
ENDIF
|
||||
CALL HARSPH2(NL_M,TH01,PHI01,YLM1,LF2)
|
||||
CALL HARSPH2(NL_M,THJK,PHIJK,YLM2,LMJ)
|
||||
XMAXT=0.
|
||||
DO LJ=0,LMJ
|
||||
CTL=CTL2*TL(LJ,1,KTYP,JE)*YLM2(LJ,0)
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
PW1=CTL*YLM1(LF,0)*TL(LF,1,1,JE)
|
||||
XMAXT=AMAX1(XMAXT,CABS(PW1))
|
||||
ENDDO
|
||||
ENDDO
|
||||
IF((PCTINT*FREF-XMAXT.LT.-XCOMP).AND.(ND.GT.NCUT))
|
||||
1 IT(ND)=0
|
||||
ENDIF
|
||||
IF((IT(ND-1).EQ.1).OR.(IT(ND).EQ.1)) GOTO 32
|
||||
IF((ND.LT.NDIF).OR.(IPW.EQ.0)) THEN
|
||||
CALL ARCSIN(COMPL1,CTROIS1,PHIJK)
|
||||
ENDIF
|
||||
CALL EULER(THJK,PHIJK,THIJ,PHIIJ,AIJK,BIJK,CIJK,IEULER)
|
||||
IF((I_CP.EQ.1).AND.(ND.EQ.NDIF)) I_ABS=2
|
||||
CALL MATDIF_A(NO,ND-1,LF2,JTYP,KTYP,JE,I_ABS,ISPEED,
|
||||
1 ISPHER,AIJK,BIJK,CIJK,RHOIJ,RHOJK)
|
||||
CEX(ND)=CEXP(IC*RHOJK)/R(ND)
|
||||
CEXDW(ND)=CEX(ND)*DW(ND-1)
|
||||
IF((IJ.EQ.1).OR.(ND.EQ.NCUT)) THEN
|
||||
IF((I_CP.EQ.0).OR.(KATL.EQ.1)) THEN
|
||||
CALL PATHOP_A(JPOS,ND,JE,I_CP,RHO01,PHI01,RHOJK,
|
||||
1 THJK,PHIJK,FREF,IJ,DIJ,TAU)
|
||||
NPATH2(ND)=NPATH2(ND)+1.
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(ND.EQ.NDIF) GOTO 32
|
||||
c CALL FINDPATHS_A(ND,KTYP,KATL,I_CP,R,XR,YR,ZR,RHOJK,
|
||||
c 1 THJK,PHIJK,ZSURF,JPOS,PW,JE,FREF,DIJ,TAU)
|
||||
32 DIJ=DIJ-R(ND)
|
||||
22 IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDDO
|
||||
20 CONTINUE
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
42 DIJ=DIJ-R(ND)
|
||||
12 IF(ND.GT.1) THEN
|
||||
IF(IN(ND-1).EQ.1) NTHOF=NTHOF-1
|
||||
IT(ND-1)=0
|
||||
IN(ND-1)=0
|
||||
ENDIF
|
||||
ENDDO
|
||||
ND=ND-1
|
||||
ENDDO
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
SUBROUTINE RUN(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_,
|
||||
& NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_,
|
||||
& NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_,
|
||||
& N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
|
||||
|
||||
USE DIM_MOD
|
||||
IMPLICIT INTEGER (A-Z)
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_
|
||||
CF2PY INTEGER, INTENT(IN,COPY) :: N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_
|
||||
|
||||
CALL ALLOCATION(NATP_M_, NATCLU_M_, NAT_EQ_M_, N_CL_L_M_,
|
||||
& NE_M_, NL_M_, LI_M_, NEMET_M_, NO_ST_M_, NDIF_M_, NSO_M_,
|
||||
& NTEMP_M_, NODES_EX_M_, NSPIN_M_, NTH_M_, NPH_M_, NDIM_M_,
|
||||
& N_TILT_M_, N_ORD_M_, NPATH_M_, NGR_M_)
|
||||
|
||||
CALL MAIN_AED_MU_SE()
|
||||
CALL CLOSE_ALL_FILES()
|
||||
|
||||
END SUBROUTINE RUN
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,349 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE MATDIF_A(NO,ND,LF,JTYP,KTYP,JE,I_ABS,ISPEED,ISPHER,
|
||||
1 A21,B21,C21,RHO1,RHO2)
|
||||
C
|
||||
C This routine calculates the Rehr-Albers scattering matrix
|
||||
C F_{LAMBDA1,LAMBDA2}. The result is stored in the COMMON block
|
||||
C /SCATMAT/ as F21(NSPIN2_M,NLAMBDA_M,NLAMBDA_M,NDIF_M). It is more
|
||||
C specifically designed for the Auger electron.
|
||||
C
|
||||
C Last modified : 3 Aug 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE EXPFAC_MOD
|
||||
USE LBD_MOD
|
||||
USE LINLBD_MOD
|
||||
USE RA_MOD
|
||||
USE SCATMAT_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
USE TLDW_MOD
|
||||
C
|
||||
REAL RLM(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
|
||||
C
|
||||
COMPLEX HLM1(0:NO_ST_M,0:NL_M-1),HLM2(0:NO_ST_M,0:NL_M-1)
|
||||
COMPLEX SL,RHO1,RHO2,IC,ZEROC,ONEC,ONEOVK
|
||||
COMPLEX SL_2_1,SL_2_2
|
||||
COMPLEX EXP1,EXP2,PROD1,PROD2
|
||||
C
|
||||
DATA PI,SMALL /3.141593,0.0001/
|
||||
C
|
||||
IC=(0.,1.)
|
||||
ZEROC=(0.,0.)
|
||||
ONEC=(1.,0.)
|
||||
ONEOVK=1./VK(JE)
|
||||
IB=0
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
IF(ABS(ABS(B21)-PI).LT.SMALL) IB=-1
|
||||
IF(ABS(B21).LT.SMALL) IB=1
|
||||
IF(NO.EQ.8) THEN
|
||||
NN2=LMAX(JTYP,JE)+1
|
||||
ELSE
|
||||
NN2=NO
|
||||
ENDIF
|
||||
C
|
||||
C NO is atom-dependent and is decreased with the rank of the scatterer
|
||||
C in the path when I_NO > 0. Here LAMBDA1 depends on the scatterer JTYP
|
||||
C while LAMBDA2 depends on the next atom (KTYP) in the path
|
||||
C
|
||||
IF(I_NO.EQ.0) THEN
|
||||
NO1=N_RA(JTYP)
|
||||
NO2=N_RA(KTYP)
|
||||
ELSE
|
||||
NO1=MAX(N_RA(JTYP)-(ND-1)/I_NO,0)
|
||||
NO2=MAX(N_RA(KTYP)-ND/I_NO,0)
|
||||
ENDIF
|
||||
IF(I_ABS.EQ.0) THEN
|
||||
NUMAX1=NO1/2
|
||||
NUMAX2=NO2/2
|
||||
ELSEIF(I_ABS.EQ.1) THEN
|
||||
NUMAX1=MIN0(LF,NO1/2)
|
||||
NUMAX2=NO2/2
|
||||
ELSEIF(I_ABS.EQ.2) THEN
|
||||
NUMAX1=NO1/2
|
||||
NUMAX2=MIN0(LF,NO2/2)
|
||||
ENDIF
|
||||
LBDM(1,ND)=(NO1+1)*(NO1+2)/2
|
||||
LBDM(2,ND)=(NO2+1)*(NO2+2)/2
|
||||
C
|
||||
EXP2=-EXP(-IC*A21)
|
||||
EXP1=EXP(-IC*C21)
|
||||
C
|
||||
DO LAMBDA1=1,LBDMAX
|
||||
DO LAMBDA2=1,LBDMAX
|
||||
F21(1,LAMBDA2,LAMBDA1,ND)=ZEROC
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
IF(ABS(RHO1-RHO2).GT.SMALL) THEN
|
||||
CALL POLHAN(ISPHER,NUMAX1,LMJ,RHO1,HLM1)
|
||||
CALL POLHAN(ISPHER,NN2,LMJ,RHO2,HLM2)
|
||||
NEQUAL=0
|
||||
ELSE
|
||||
CALL POLHAN(ISPHER,NN2,LMJ,RHO1,HLM1)
|
||||
NEQUAL=1
|
||||
ENDIF
|
||||
C
|
||||
C Calculation of the scattering matrix when the scattering angle
|
||||
C is different from 0 and pi
|
||||
C
|
||||
IF(IB.EQ.0) THEN
|
||||
CALL DJMN(B21,RLM,LMJ)
|
||||
DO NU1=0,NUMAX1
|
||||
MUMAX1=NO1-2*NU1
|
||||
IF(I_ABS.EQ.1) MUMAX1=MIN(LF-NU1,MUMAX1)
|
||||
DO NU2=0,NUMAX2
|
||||
MUMAX2=NO2-2*NU2
|
||||
C
|
||||
C Case MU1 = 0
|
||||
C
|
||||
LAMBDA1=LBD(0,NU1)
|
||||
C
|
||||
C Case MU2 = 0
|
||||
C
|
||||
LAMBDA2=LBD(0,NU2)
|
||||
LMIN=MAX(NU1,NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(NU2,L)=HLM1(NU2,L)
|
||||
ENDIF
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*RLM(0,0,L)*
|
||||
1 TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*RLM(0,0,L)*
|
||||
1 TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA2,LAMBDA1,ND)=SL*ONEOVK
|
||||
C
|
||||
C Case MU2 > 0
|
||||
C
|
||||
PROD2=ONEC
|
||||
SIG2=1.
|
||||
DO MU2=1,MUMAX2
|
||||
LAMBDA2_1=LBD(MU2,NU2)
|
||||
LAMBDA2_2=LBD(-MU2,NU2)
|
||||
PROD2=PROD2*EXP2
|
||||
SIG2=-SIG2
|
||||
LMIN=MAX(NU1,MU2+NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(MU2+NU2,L)=HLM1(MU2+NU2,L)
|
||||
ENDIF
|
||||
C1=EXPF(0,L)/EXPF(MU2,L)
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*RLM(MU2,0,L)*C1*
|
||||
1 TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU2+NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*RLM(MU2,0,L)*C1*
|
||||
1 TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU2+NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA2_1,LAMBDA1,ND)=SL*PROD2*ONEOVK*SIG2
|
||||
F21(1,LAMBDA2_2,LAMBDA1,ND)=SL*ONEOVK/PROD2
|
||||
ENDDO
|
||||
C
|
||||
C Case MU1 > 0
|
||||
C
|
||||
PROD1=ONEC
|
||||
SIG1=1.
|
||||
DO MU1=1,MUMAX1
|
||||
LAMBDA1_1=LBD(MU1,NU1)
|
||||
LAMBDA1_2=LBD(-MU1,NU1)
|
||||
PROD1=PROD1*EXP1
|
||||
SIG1=-SIG1
|
||||
C
|
||||
C Case MU2 = 0
|
||||
C
|
||||
LAMBDA2=LBD(0,NU2)
|
||||
LMIN=MAX(MU1,NU1,NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(NU2,L)=HLM1(NU2,L)
|
||||
ENDIF
|
||||
C1=EXPF(MU1,L)/EXPF(0,L)
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*RLM(0,MU1,L)*C1*
|
||||
1 TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*RLM(0,MU1,L)*C1*
|
||||
1 TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA2,LAMBDA1_1,ND)=SL*PROD1*ONEOVK*SIG1
|
||||
F21(1,LAMBDA2,LAMBDA1_2,ND)=SL*ONEOVK/PROD1
|
||||
C
|
||||
C Case MU2 > 0
|
||||
C
|
||||
PROD2=ONEC
|
||||
SIG2=SIG1
|
||||
DO MU2=1,MUMAX2
|
||||
LAMBDA2_1=LBD(MU2,NU2)
|
||||
LAMBDA2_2=LBD(-MU2,NU2)
|
||||
PROD2=PROD2*EXP2
|
||||
SIG2=-SIG2
|
||||
LMIN=MAX(MU1,NU1,MU2+NU2)
|
||||
SL_2_1=ZEROC
|
||||
SL_2_2=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(MU2+NU2,L)=HLM1(MU2+NU2,L)
|
||||
ENDIF
|
||||
C1=EXPF(MU1,L)/EXPF(MU2,L)
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=FLOAT(L+L+1)*C1*TL(L,1,JTYP,JE)*
|
||||
1 HLM1(NU1,L)*HLM2(MU2+NU2,L)
|
||||
ELSE
|
||||
SL=FLOAT(L+L+1)*C1*TLT(L,1,JTYP,JE)*
|
||||
1 HLM1(NU1,L)*HLM2(MU2+NU2,L)
|
||||
ENDIF
|
||||
SL_2_1=SL_2_1+SL*RLM(MU2,-MU1,L)
|
||||
SL_2_2=SL_2_2+SL*RLM(MU2,MU1,L)
|
||||
ENDDO
|
||||
F21(1,LAMBDA2_1,LAMBDA1_1,ND)=SL_2_2*PROD1*PROD2*
|
||||
1 ONEOVK*SIG2
|
||||
F21(1,LAMBDA2_2,LAMBDA1_1,ND)=SL_2_1*PROD1
|
||||
1 *ONEOVK/PROD2
|
||||
F21(1,LAMBDA2_1,LAMBDA1_2,ND)=SL_2_1*ONEOVK*PROD2*SIG2/
|
||||
1 PROD1
|
||||
F21(1,LAMBDA2_2,LAMBDA1_2,ND)=SL_2_2*ONEOVK/
|
||||
1 (PROD1*PROD2)
|
||||
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Calculation of the scattering matrix when the scattering angle
|
||||
C is equal to 0 (forward scattering) or pi (backscattering)
|
||||
C
|
||||
ELSEIF(IB.EQ.1) THEN
|
||||
DO NU1=0,NUMAX1
|
||||
DO NU2=0,NUMAX2
|
||||
MUMAX1=MIN0(NO1-2*NU1,NO1-2*NU2)
|
||||
IF(I_ABS.EQ.1) MUMAX1=MIN0(LF-NU1,MUMAX1)
|
||||
C
|
||||
C Case MU = 0
|
||||
C
|
||||
LAMBDA1=LBD(0,NU1)
|
||||
LAMBDA2=LBD(0,NU2)
|
||||
LMIN=MAX(NU1,NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(NU2,L)=HLM1(NU2,L)
|
||||
ENDIF
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*
|
||||
1 TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*
|
||||
1 TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA2,LAMBDA1,ND)=SL*ONEOVK
|
||||
C
|
||||
C Case MU > 0
|
||||
C
|
||||
CST1=1.
|
||||
DO MU=1,MUMAX1
|
||||
LAMBDA1=LBD(MU,NU2)
|
||||
LAMBDA2=LBD(-MU,NU2)
|
||||
CST1=-CST1
|
||||
LMIN=MAX(NU1,MU+NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(MU+NU2,L)=HLM1(MU+NU2,L)
|
||||
ENDIF
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*CST1
|
||||
1 *TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*CST1
|
||||
1 *TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA1,LAMBDA1,ND)=SL*ONEOVK
|
||||
F21(1,LAMBDA2,LAMBDA2,ND)=SL*ONEOVK
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSEIF(IB.EQ.-1) THEN
|
||||
DO NU1=0,NUMAX1
|
||||
DO NU2=0,NUMAX2
|
||||
MUMAX1=MIN0(NO1-2*NU1,NO1-2*NU2)
|
||||
IF(I_ABS.EQ.1) MUMAX1=MIN0(LF-NU1,MUMAX1)
|
||||
C
|
||||
C Case MU = 0
|
||||
C
|
||||
LAMBDA1=LBD(0,NU1)
|
||||
LAMBDA2=LBD(0,NU2)
|
||||
LMIN=MAX(NU1,NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(NU2,L)=HLM1(NU2,L)
|
||||
ENDIF
|
||||
IF(MOD(L,2).EQ.0) THEN
|
||||
CST2=1.0
|
||||
ELSE
|
||||
CST2=-1.0
|
||||
ENDIF
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*CST2
|
||||
1 *TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*CST2
|
||||
1 *TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA2,LAMBDA1,ND)=SL*ONEOVK
|
||||
C
|
||||
C Case MU > 0
|
||||
C
|
||||
CST1=1.
|
||||
DO MU=1,MUMAX1
|
||||
MUP=-MU
|
||||
LAMBDA1_1=LBD(MUP,NU1)
|
||||
LAMBDA1_2=LBD(-MUP,NU1)
|
||||
LAMBDA2_1=LBD(MU,NU2)
|
||||
LAMBDA2_2=LBD(-MU,NU2)
|
||||
CST1=-CST1
|
||||
LMIN=MAX(NU1,MU+NU2)
|
||||
SL=ZEROC
|
||||
DO L=LMIN,LMJ
|
||||
IF(NEQUAL.EQ.1) THEN
|
||||
HLM2(MU+NU2,L)=HLM1(MU+NU2,L)
|
||||
ENDIF
|
||||
IF(MOD(L,2).EQ.0) THEN
|
||||
CST2=CST1
|
||||
ELSE
|
||||
CST2=-CST1
|
||||
ENDIF
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
SL=SL+FLOAT(L+L+1)*CST2
|
||||
1 *TL(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
|
||||
ELSE
|
||||
SL=SL+FLOAT(L+L+1)*CST2
|
||||
1 *TLT(L,1,JTYP,JE)*HLM1(NU1,L)*HLM2(MU+NU2,L)
|
||||
ENDIF
|
||||
ENDDO
|
||||
F21(1,LAMBDA2_1,LAMBDA1_1,ND)=SL*ONEOVK
|
||||
F21(1,LAMBDA2_2,LAMBDA1_2,ND)=SL*ONEOVK
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,551 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE PATHOP_A(JPOS,JORDP,JE,I_CP,RHO01,PHI01,RHOIJ,THIJ,
|
||||
1 PHIIJ,FREF,IJ,D,TAU)
|
||||
C
|
||||
C This subroutine calculates the contribution of a given path to
|
||||
C the scattering path operator TAU. It is designed for the Auger
|
||||
C electron
|
||||
C
|
||||
C Last modified : 3 Aug 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD
|
||||
USE EXPFAC_MOD
|
||||
USE EXTREM_MOD
|
||||
USE INIT_L_MOD
|
||||
USE INIT_J_MOD
|
||||
USE LBD_MOD
|
||||
USE LINLBD_MOD
|
||||
USE OUTUNITS_MOD
|
||||
USE PATH_MOD
|
||||
USE PRINTP_MOD
|
||||
USE RA_MOD
|
||||
USE ROT_MOD
|
||||
USE SCATMAT_MOD, F => F21
|
||||
USE TESTS_MOD
|
||||
USE TLDW_MOD
|
||||
USE TL_AED_MOD, DLT => DLT_A, TL => TL_A, VK => VK_A,
|
||||
& VK2 => VK2_A, IPOTC => IPOTC_A, ITL => ITL_A,
|
||||
& LMAX => LMAX_A
|
||||
USE VARIA_MOD
|
||||
C
|
||||
INTEGER JPOS(NDIF_M,3),AMU1
|
||||
C
|
||||
REAL RLMIJ(1-NL_M:NL_M-1,1-NL_M:NL_M-1,0:NL_M-1)
|
||||
C
|
||||
COMPLEX TAU(LINMAXA,LINFMAX,NATCLU_M)
|
||||
COMPLEX H(NLAMBDA_M,NLAMBDA_M)
|
||||
COMPLEX G(NLAMBDA_M,NLAMBDA_M)
|
||||
COMPLEX HLM01(0:NO_ST_M,0:NL_M-1),HLMIJ(0:NO_ST_M,0:NL_M-1)
|
||||
COMPLEX SUM_NUJ_0,SUM_MUJ_0,SUM_NU1_0
|
||||
COMPLEX SUM_NUJ_1,SUM_MUJ_1,SUM_NU1_1
|
||||
COMPLEX SUM_NU1_2,SUM_NU1_3
|
||||
COMPLEX RHO01,RHOIJ
|
||||
COMPLEX RLMF_0,RLMF_1
|
||||
COMPLEX CF,CJ,OVK
|
||||
COMPLEX EXP_J,EXP_F,SUM_1
|
||||
COMPLEX TL_J
|
||||
COMPLEX COEF,ONEC,ZEROC
|
||||
C
|
||||
DATA PI,XCOMP /3.141593,1.E-10/
|
||||
C
|
||||
ZEROC=(0.,0.)
|
||||
ONEC=(1.,0.)
|
||||
C
|
||||
OVK=(1.,0.)/VK(JE)
|
||||
IF(NPATHP.GT.0) THEN
|
||||
FM1=FMIN(JORDP)
|
||||
XMAX=0.
|
||||
ENDIF
|
||||
EXP_J=CEXP((0.,-1.)*(PHIIJ-PI))
|
||||
EXP_F=CEXP((0.,1.)*PHI01)
|
||||
JTYP=JPOS(JORDP,1)
|
||||
ITYP=JPOS(1,1)
|
||||
JATL=JPOS(JORDP,3)
|
||||
IF(I_CP.EQ.0) THEN
|
||||
LMJ=LMAX(JTYP,JE)
|
||||
ELSE
|
||||
LMJ=LF2
|
||||
ENDIF
|
||||
IF(NO.EQ.8) THEN
|
||||
NN2=LMJ+1
|
||||
ELSE
|
||||
NN2=NO
|
||||
ENDIF
|
||||
IF(NO.GT.LF2) THEN
|
||||
NN=LF2
|
||||
ELSE
|
||||
NN=NO
|
||||
ENDIF
|
||||
C
|
||||
C NO is atom-dependent and is decreased with the rank of the scatterer
|
||||
C in the path when I_NO > 0 (except for the first scatterer ITYP for
|
||||
C which there is no such decrease)
|
||||
C
|
||||
NO1=N_RA(ITYP)
|
||||
IF(I_NO.EQ.0) THEN
|
||||
IF(IJ.EQ.1) THEN
|
||||
NOJ=N_RA(JTYP)
|
||||
ELSE
|
||||
NOJ=0
|
||||
ENDIF
|
||||
ELSE
|
||||
IF(IJ.EQ.1) THEN
|
||||
NOJ= MAX(N_RA(JTYP)-(JORDP-1)/I_NO,0)
|
||||
ELSE
|
||||
NOJ=0
|
||||
ENDIF
|
||||
ENDIF
|
||||
NUMX=NO1/2
|
||||
NUMAXJ=NOJ/2
|
||||
C
|
||||
C Calculation of the attenuation coefficients along the path
|
||||
C
|
||||
COEF=CEX(1)*OVK
|
||||
DO JSC=2,JORDP
|
||||
COEF=COEF*CEXDW(JSC)
|
||||
ENDDO
|
||||
C
|
||||
C Call of the subroutines used for the R-A termination matrix
|
||||
C This termination matrix is now merged into PATHOP
|
||||
C
|
||||
CALL DJMN2(-THIJ,RLMIJ,LMJ,1)
|
||||
CALL POLHAN(ISPHER,NN,LF2,RHO01,HLM01)
|
||||
CALL POLHAN(ISPHER,NN2,LMJ,RHOIJ,HLMIJ)
|
||||
C
|
||||
LBD1M1=LBDM(1,1)
|
||||
LBD1M2=LBDM(2,1)
|
||||
C
|
||||
C Calculation of the L-independent part of TAU, called H
|
||||
C
|
||||
IF(JORDP.GE.3) THEN
|
||||
DO JPAT=2,JORDP-1
|
||||
LBD2M=LBDM(1,JPAT)
|
||||
LBD3M=LBDM(2,JPAT)
|
||||
DO LAMBDA1=1,LBD1M1
|
||||
DO LAMBDA3=1,LBD3M
|
||||
SUM_1=ZEROC
|
||||
DO LAMBDA2=1,LBD2M
|
||||
IF(JPAT.GT.2) THEN
|
||||
SUM_1=SUM_1+H(LAMBDA2,LAMBDA1)*
|
||||
1 F(1,LAMBDA3,LAMBDA2,JPAT)
|
||||
ELSE
|
||||
SUM_1=SUM_1+F(1,LAMBDA2,LAMBDA1,1)*
|
||||
1 F(1,LAMBDA3,LAMBDA2,2)
|
||||
ENDIF
|
||||
ENDDO
|
||||
G(LAMBDA3,LAMBDA1)=SUM_1
|
||||
ENDDO
|
||||
ENDDO
|
||||
DO LAMBDA1=1,LBD1M1
|
||||
DO LAMBDA2=1,LBD3M
|
||||
H(LAMBDA2,LAMBDA1)=G(LAMBDA2,LAMBDA1)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSEIF(JORDP.EQ.2) THEN
|
||||
DO LAMBDA1=1,LBD1M1
|
||||
DO LAMBDA2=1,LBD1M2
|
||||
H(LAMBDA2,LAMBDA1)=F(1,LAMBDA2,LAMBDA1,1)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSEIF(JORDP.EQ.1) THEN
|
||||
DO LAMBDA1=1,LBD1M1
|
||||
DO LAMBDA2=1,LBD1M1
|
||||
H(LAMBDA2,LAMBDA1)=ONEC
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
C
|
||||
C Calculation of the path operator TAU
|
||||
C
|
||||
DO LF=LF1,LF2,ISTEP_LF
|
||||
ILF=LF*LF+LF+1
|
||||
C
|
||||
NU1MAX1=MIN(LF,NUMX)
|
||||
C
|
||||
C Case MF = 0
|
||||
C
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
NUJMAX=MIN(LJ,NUMAXJ)
|
||||
IF(JORDP.EQ.1) THEN
|
||||
NU1MAX=MIN(NU1MAX1,LJ)
|
||||
ELSE
|
||||
NU1MAX=NU1MAX1
|
||||
ENDIF
|
||||
C
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
TL_J=COEF*TL(LF,1,1,JE)*TL(LJ,1,JTYP,JE)
|
||||
ELSE
|
||||
TL_J=COEF*TLT(LF,1,1,JE)*TLT(LJ,1,JTYP,JE)
|
||||
ENDIF
|
||||
C
|
||||
C Case MJ = 0
|
||||
C
|
||||
SUM_NU1_0=ZEROC
|
||||
C
|
||||
DO NU1=0,NU1MAX
|
||||
IF(JORDP.GT.1) THEN
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
|
||||
ELSE
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ)
|
||||
ENDIF
|
||||
C
|
||||
DO MU1=-MU1MAX,MU1MAX
|
||||
LAMBDA1=LBD(MU1,NU1)
|
||||
AMU1=ABS(MU1)
|
||||
C
|
||||
RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,0,LF)
|
||||
C
|
||||
SUM_NUJ_0=ZEROC
|
||||
C
|
||||
IF(JORDP.GT.1) THEN
|
||||
DO NUJ=0,NUJMAX
|
||||
MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
|
||||
C
|
||||
SUM_MUJ_0=ZEROC
|
||||
C
|
||||
DO MUJ=-MUJMAX,MUJMAX
|
||||
C
|
||||
LAMBDAJ=LBD(MUJ,NUJ)
|
||||
C
|
||||
SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
|
||||
1 RLMIJ(MUJ,0,LJ)
|
||||
|
||||
ENDDO
|
||||
C
|
||||
SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
|
||||
C
|
||||
ENDDO
|
||||
ELSE
|
||||
SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,0,LJ)
|
||||
ENDIF
|
||||
C
|
||||
SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
TAU(ILJ,ILF,JATL)=TAU(ILJ,ILF,JATL)+
|
||||
1 TL_J*SUM_NU1_0
|
||||
C
|
||||
IF(NPATHP.EQ.0) GOTO 35
|
||||
C
|
||||
FM2=FMAX(JORDP)
|
||||
XINT=CABS(TL_J*SUM_NU1_0)
|
||||
XMAX=AMAX1(XINT,XMAX)
|
||||
FMAX(JORDP)=AMAX1(FM2,XINT)
|
||||
IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
|
||||
1 NPATH(JORDP)
|
||||
IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
|
||||
FREF=FMAX(JORDP)
|
||||
ENDIF
|
||||
35 CONTINUE
|
||||
C
|
||||
C Case MJ > 0
|
||||
C
|
||||
CJ=ONEC
|
||||
DO MJ=1,LJ
|
||||
INDJ=ILJ+MJ
|
||||
INDJP=ILJ-MJ
|
||||
CJ=CJ*EXP_J
|
||||
C
|
||||
SUM_NU1_0=ZEROC
|
||||
SUM_NU1_1=ZEROC
|
||||
C
|
||||
DO NU1=0,NU1MAX
|
||||
IF(JORDP.GT.1) THEN
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
|
||||
ELSE
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ)
|
||||
ENDIF
|
||||
C
|
||||
DO MU1=-MU1MAX,MU1MAX
|
||||
LAMBDA1=LBD(MU1,NU1)
|
||||
AMU1=ABS(MU1)
|
||||
C
|
||||
RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,0,LF)
|
||||
C
|
||||
SUM_NUJ_0=ZEROC
|
||||
SUM_NUJ_1=ZEROC
|
||||
C
|
||||
IF(JORDP.GT.1) THEN
|
||||
DO NUJ=0,NUJMAX
|
||||
MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
|
||||
C
|
||||
SUM_MUJ_0=ZEROC
|
||||
SUM_MUJ_1=ZEROC
|
||||
C
|
||||
DO MUJ=-MUJMAX,MUJMAX
|
||||
C
|
||||
LAMBDAJ=LBD(MUJ,NUJ)
|
||||
C
|
||||
SUM_MUJ_1=SUM_MUJ_1+H(LAMBDAJ,LAMBDA1)*
|
||||
1 RLMIJ(MUJ,-MJ,LJ)
|
||||
SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
|
||||
1 RLMIJ(MUJ,MJ,LJ)
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
|
||||
SUM_NUJ_1=SUM_NUJ_1+SUM_MUJ_1*HLMIJ(NUJ,LJ)
|
||||
C
|
||||
ENDDO
|
||||
ELSE
|
||||
SUM_NUJ_1=HLMIJ(NU1,LJ)*RLMIJ(MU1,-MJ,LJ)
|
||||
SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,MJ,LJ)
|
||||
ENDIF
|
||||
C
|
||||
SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
|
||||
SUM_NU1_1=SUM_NU1_1+RLMF_0*SUM_NUJ_1
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
TAU(INDJP,ILF,JATL)=TAU(INDJP,ILF,JATL)+
|
||||
1 CONJG(CJ)*TL_J*SUM_NU1_1
|
||||
TAU(INDJ,ILF,JATL)=TAU(INDJ,ILF,JATL)+
|
||||
1 CJ*TL_J*SUM_NU1_0
|
||||
C
|
||||
IF(NPATHP.EQ.0) GOTO 45
|
||||
C
|
||||
FM2=FMAX(JORDP)
|
||||
XINT1=CABS(CJ*TL_J*SUM_NU1_0)
|
||||
XINT2=CABS(CONJG(CJ)*TL_J*SUM_NU1_1)
|
||||
XMAX=AMAX1(XINT1,XINT2,XMAX)
|
||||
FMAX(JORDP)=AMAX1(FM2,XINT1,XINT2)
|
||||
IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
|
||||
1 NPATH(JORDP)
|
||||
IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
|
||||
FREF=FMAX(JORDP)
|
||||
ENDIF
|
||||
45 CONTINUE
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Case MF > 0
|
||||
C
|
||||
CF=ONEC
|
||||
DO MF=1,LF
|
||||
INDF=ILF+MF
|
||||
INDFP=ILF-MF
|
||||
CF=CF*EXP_F
|
||||
C
|
||||
DO LJ=0,LMJ
|
||||
ILJ=LJ*LJ+LJ+1
|
||||
NUJMAX=MIN(LJ,NUMAXJ)
|
||||
IF(JORDP.EQ.1) THEN
|
||||
NU1MAX=MIN(NU1MAX1,LJ)
|
||||
ELSE
|
||||
NU1MAX=NU1MAX1
|
||||
ENDIF
|
||||
C
|
||||
IF(ISPEED.EQ.1) THEN
|
||||
TL_J=COEF*TL(LF,1,1,JE)*TL(LJ,1,JTYP,JE)
|
||||
ELSE
|
||||
TL_J=COEF*TLT(LF,1,1,JE)*TLT(LJ,1,JTYP,JE)
|
||||
ENDIF
|
||||
C
|
||||
C Case MJ = 0
|
||||
C
|
||||
SUM_NU1_0=ZEROC
|
||||
SUM_NU1_1=ZEROC
|
||||
C
|
||||
DO NU1=0,NU1MAX
|
||||
IF(JORDP.GT.1) THEN
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
|
||||
ELSE
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ)
|
||||
ENDIF
|
||||
C
|
||||
DO MU1=-MU1MAX,MU1MAX
|
||||
LAMBDA1=LBD(MU1,NU1)
|
||||
AMU1=ABS(MU1)
|
||||
C
|
||||
RLMF_1=HLM01(AMU1+NU1,LF)*RLM01(MU1,-MF,LF)
|
||||
RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,MF,LF)
|
||||
C
|
||||
SUM_NUJ_0=ZEROC
|
||||
C
|
||||
IF(JORDP.GT.1) THEN
|
||||
DO NUJ=0,NUJMAX
|
||||
MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
|
||||
C
|
||||
SUM_MUJ_0=ZEROC
|
||||
C
|
||||
DO MUJ=-MUJMAX,MUJMAX
|
||||
C
|
||||
LAMBDAJ=LBD(MUJ,NUJ)
|
||||
C
|
||||
SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
|
||||
1 RLMIJ(MUJ,0,LJ)
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
|
||||
C
|
||||
ENDDO
|
||||
ELSE
|
||||
SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,0,LJ)
|
||||
ENDIF
|
||||
C
|
||||
SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
|
||||
SUM_NU1_1=SUM_NU1_1+RLMF_1*SUM_NUJ_0
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
TAU(ILJ,INDF,JATL)=TAU(ILJ,INDF,JATL)+
|
||||
1 CF*TL_J*
|
||||
2 SUM_NU1_0
|
||||
TAU(ILJ,INDFP,JATL)=TAU(ILJ,INDFP,JATL)+
|
||||
1 CONJG(CF)*TL_J*
|
||||
2 SUM_NU1_1
|
||||
C
|
||||
IF(NPATHP.EQ.0) GOTO 25
|
||||
C
|
||||
FM2=FMAX(JORDP)
|
||||
XINT1=CABS(CF*TL_J*SUM_NU1_0)
|
||||
XINT2=CABS(CONJG(CF)*TL_J*SUM_NU1_1)
|
||||
XMAX=AMAX1(XINT1,XINT2,XMAX)
|
||||
FMAX(JORDP)=AMAX1(FM2,XINT1,XINT2)
|
||||
IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
|
||||
1 NPATH(JORDP)
|
||||
IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
|
||||
FREF=FMAX(JORDP)
|
||||
ENDIF
|
||||
25 CONTINUE
|
||||
C
|
||||
C Case MJ > 0
|
||||
C
|
||||
CJ=ONEC
|
||||
DO MJ=1,LJ
|
||||
INDJ=ILJ+MJ
|
||||
INDJP=ILJ-MJ
|
||||
CJ=CJ*EXP_J
|
||||
C
|
||||
SUM_NU1_0=ZEROC
|
||||
SUM_NU1_1=ZEROC
|
||||
SUM_NU1_2=ZEROC
|
||||
SUM_NU1_3=ZEROC
|
||||
C
|
||||
DO NU1=0,NU1MAX
|
||||
IF(JORDP.GT.1) THEN
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1)
|
||||
ELSE
|
||||
MU1MAX=MIN(LF-NU1,NO1-NU1-NU1,LJ)
|
||||
ENDIF
|
||||
C
|
||||
DO MU1=-MU1MAX,MU1MAX
|
||||
LAMBDA1=LBD(MU1,NU1)
|
||||
AMU1=ABS(MU1)
|
||||
C
|
||||
RLMF_1=HLM01(AMU1+NU1,LF)*RLM01(MU1,-MF,LF)
|
||||
RLMF_0=HLM01(AMU1+NU1,LF)*RLM01(MU1,MF,LF)
|
||||
C
|
||||
SUM_NUJ_0=ZEROC
|
||||
SUM_NUJ_1=ZEROC
|
||||
C
|
||||
IF(JORDP.GT.1) THEN
|
||||
DO NUJ=0,NUJMAX
|
||||
MUJMAX=MIN(LJ,NOJ-NUJ-NUJ)
|
||||
C
|
||||
SUM_MUJ_0=ZEROC
|
||||
SUM_MUJ_1=ZEROC
|
||||
C
|
||||
DO MUJ=-MUJMAX,MUJMAX
|
||||
C
|
||||
LAMBDAJ=LBD(MUJ,NUJ)
|
||||
C
|
||||
SUM_MUJ_1=SUM_MUJ_1+H(LAMBDAJ,LAMBDA1)*
|
||||
1 RLMIJ(MUJ,-MJ,LJ)
|
||||
SUM_MUJ_0=SUM_MUJ_0+H(LAMBDAJ,LAMBDA1)*
|
||||
1 RLMIJ(MUJ,MJ,LJ)
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
SUM_NUJ_0=SUM_NUJ_0+SUM_MUJ_0*HLMIJ(NUJ,LJ)
|
||||
SUM_NUJ_1=SUM_NUJ_1+SUM_MUJ_1*HLMIJ(NUJ,LJ)
|
||||
C
|
||||
ENDDO
|
||||
ELSE
|
||||
SUM_NUJ_1=HLMIJ(NU1,LJ)*RLMIJ(MU1,-MJ,LJ)
|
||||
SUM_NUJ_0=HLMIJ(NU1,LJ)*RLMIJ(MU1,MJ,LJ)
|
||||
ENDIF
|
||||
C
|
||||
SUM_NU1_0=SUM_NU1_0+RLMF_0*SUM_NUJ_0
|
||||
SUM_NU1_1=SUM_NU1_1+RLMF_0*SUM_NUJ_1
|
||||
SUM_NU1_2=SUM_NU1_2+RLMF_1*SUM_NUJ_0
|
||||
SUM_NU1_3=SUM_NU1_3+RLMF_1*SUM_NUJ_1
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
TAU(INDJP,INDF,JATL)=TAU(INDJP,INDF,JATL)+
|
||||
1 CF*CONJG(CJ)*TL_J*SUM_NU1_1
|
||||
TAU(INDJP,INDFP,JATL)=TAU(INDJP,INDFP,JATL)+
|
||||
1 CONJG(CF*CJ)*TL_J*SUM_NU1_3
|
||||
TAU(INDJ,INDF,JATL)=TAU(INDJ,INDF,JATL)+
|
||||
1 CF*CJ*TL_J*SUM_NU1_0
|
||||
TAU(INDJ,INDFP,JATL)=TAU(INDJ,INDFP,JATL)+
|
||||
1 CONJG(CF)*CJ*TL_J*SUM_NU1_2
|
||||
C
|
||||
IF(NPATHP.EQ.0) GOTO 15
|
||||
C
|
||||
FM2=FMAX(JORDP)
|
||||
XINT1=CABS(CF*CJ*TL_J*SUM_NU1_0)
|
||||
XINT2=CABS(CF*CONJG(CJ)*TL_J*SUM_NU1_1)
|
||||
XINT3=CABS(CONJG(CF)*CJ*TL_J*SUM_NU1_2)
|
||||
XINT4=CABS(CONJG(CF*CJ)*TL_J*SUM_NU1_3)
|
||||
XMAX=AMAX1(XINT1,XINT2,XINT3,XINT4,XMAX)
|
||||
FMAX(JORDP)=AMAX1(FM2,XINT1,XINT2,XINT3,XINT4)
|
||||
IF((FMAX(JORDP)-FM2).GT.XCOMP) NPMA(JORDP)=
|
||||
1 NPATH(JORDP)
|
||||
IF((IREF.EQ.1).AND.(JORDP.EQ.NCUT)) THEN
|
||||
FREF=FMAX(JORDP)
|
||||
ENDIF
|
||||
15 CONTINUE
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
IF(NPATHP.EQ.0) GOTO 16
|
||||
FMIN(JORDP)=AMIN1(FM1,XMAX)
|
||||
IF(XMAX.GT.FMN(NPATHP)) THEN
|
||||
CALL LOCATE(FMN,NPATHP,XMAX,JMX)
|
||||
DO KF=NPATHP,JMX+2,-1
|
||||
FMN(KF)=FMN(KF-1)
|
||||
JON(KF)=JON(KF-1)
|
||||
PATH(KF)=PATH(KF-1)
|
||||
DMN(KF)=DMN(KF-1)
|
||||
DO KD=1,10
|
||||
JPON(KF,KD)=JPON(KF-1,KD)
|
||||
ENDDO
|
||||
ENDDO
|
||||
FMN(JMX+1)=XMAX
|
||||
JON(JMX+1)=JORDP
|
||||
PATH(JMX+1)=NPATH(JORDP)
|
||||
DMN(JMX+1)=D
|
||||
DO KD=1,JORDP
|
||||
JPON(JMX+1,KD)=JPOS(KD,3)
|
||||
ENDDO
|
||||
ENDIF
|
||||
IF((FMIN(JORDP)-FM1).LT.-XCOMP) NPMI(JORDP)=NPATH(JORDP)
|
||||
IF((IPRINT.EQ.3).AND.(IJ.EQ.1)) THEN
|
||||
WRITE(IUSCR,1) JORDP,NPATH(JORDP),XMAX,D,(JPOS(KD,3),KD=1,JORDP)
|
||||
ENDIF
|
||||
C
|
||||
16 RETURN
|
||||
C
|
||||
1 FORMAT(9X,I2,2X,E12.6,7X,E12.6,1X,F6.3,1X,10(I3,2X))
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE PLOTFD_A(A,LMX,ITL,NL,NAT,NE)
|
||||
C
|
||||
C This routine prepares the output for a plot of the scattering factor
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE APPROX_MOD
|
||||
USE FDIF_MOD
|
||||
USE INIT_L_MOD, L => LI, I2 => INITL, I3 => NNL, I4 => LF1,
|
||||
& I5 => LF2, I10 => ISTEP_LF
|
||||
USE INIT_J_MOD
|
||||
USE OUTFILES_MOD
|
||||
USE PARCAL_A_MOD, N3 => NPHI_A, N4 => NE_A, N5 => NTHETA_A,
|
||||
& NFTHET => NFTHET_A
|
||||
USE TYPCAL_A_MOD, IPHI => IPHI_A, IE => IE_A, ITHETA => ITHETA_A,
|
||||
& IFTHET => IFTHET_A, IMOD => IMOD_A,
|
||||
& I_CP => I_CP_A, I_EXT => I_EXT_A,
|
||||
& I_TEST => I_TEST_A
|
||||
USE VALIN_MOD, PHI00 => PHI0, THETA00 => THETA0, U1 => THLUM,
|
||||
& U2 => PHILUM, U3 => ELUM, N7 => NONVOL
|
||||
USE VALFIN_MOD, PHI11 => PHI1, THETA11 => THETA1
|
||||
USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
|
||||
& PHI1 => PHI1_A, THETA1 => THETA1_A
|
||||
C
|
||||
DIMENSION LMX(NATM,NE_M)
|
||||
C
|
||||
COMPLEX FSPH,VKE
|
||||
C
|
||||
DATA PI,CONV/3.141593,0.512314/
|
||||
C
|
||||
OPEN(UNIT=IUO3, FILE=OUTFILE3, STATUS='UNKNOWN')
|
||||
IF(ISPHER.EQ.0) THEN
|
||||
L=0
|
||||
LMAX=0
|
||||
ELSE
|
||||
LMAX=L
|
||||
ENDIF
|
||||
PHITOT=360.
|
||||
THTOT=360.*ITHETA*(1-IPHI)+180.*ITHETA*IPHI
|
||||
NPHI=(NFTHET+1)*IPHI+(1-IPHI)
|
||||
NTHT=(NFTHET+1)*ITHETA*(1-IPHI)+(NFTHET/2+1)*ITHETA*IPHI+
|
||||
* (1-ITHETA)
|
||||
NE=NFTHET*IE + (1-IE)
|
||||
WRITE(IUO3,1) ISPHER,NL,NAT,L,NTHT,NPHI,NE,E0,EFIN
|
||||
DO 10 JT=1,NTHT
|
||||
DTHETA=THETA1+FLOAT(JT-1)*THTOT/FLOAT(MAX0(NTHT-1,1))
|
||||
RTHETA=DTHETA*PI/180.
|
||||
TEST=SIN(RTHETA)
|
||||
IF(TEST.GE.0.) THEN
|
||||
POZ=PI
|
||||
EPS=1.
|
||||
ELSE
|
||||
POZ=0.
|
||||
EPS=-1.
|
||||
ENDIF
|
||||
BETA=RTHETA*EPS
|
||||
IF(ABS(TEST).LT.0.0001) THEN
|
||||
NPHIM=1
|
||||
ELSE
|
||||
NPHIM=NPHI
|
||||
ENDIF
|
||||
DO 20 JP=1,NPHIM
|
||||
DPHI=PHI1+FLOAT(JP-1)*PHITOT/FLOAT(MAX0(NPHI-1,1))
|
||||
RPHI=DPHI*PI/180.
|
||||
GAMMA=POZ-RPHI
|
||||
DO 30 JE=1,NE
|
||||
IF(NE.EQ.1) THEN
|
||||
ECIN=E0
|
||||
ELSE
|
||||
ECIN=E0+FLOAT(JE-1)*(EFIN-E0)/FLOAT(NE-1)
|
||||
ENDIF
|
||||
IF(ITL.EQ.0) VKE=SQRT(ECIN-ABS(VINT))*CONV*A*(1.,0.)
|
||||
DO 40 JAT=1,NAT
|
||||
IF(L.GT.LMX(JAT,JE)) GOTO 90
|
||||
DO 50 M=-LMAX,LMAX
|
||||
CALL FACDIF1_A(VKE,R1,R2,THETA0,PHI0,BETA,GAMMA,L,M,
|
||||
1 FSPH,JAT,JE,*60)
|
||||
GOTO 70
|
||||
60 WRITE(IUO1,80)
|
||||
STOP
|
||||
70 REFTH=REAL(FSPH)
|
||||
XIMFTH=AIMAG(FSPH)
|
||||
WRITE(IUO3,5) JE,JAT,L,M,REFTH,XIMFTH,DTHETA,DPHI,ECIN
|
||||
50 CONTINUE
|
||||
GOTO 40
|
||||
90 WRITE(IUO1,100) JAT
|
||||
STOP
|
||||
40 CONTINUE
|
||||
30 CONTINUE
|
||||
20 CONTINUE
|
||||
10 CONTINUE
|
||||
CLOSE(IUO3)
|
||||
1 FORMAT(5X,I1,2X,I2,2X,I4,2X,I2,2X,I3,2X,I3,2X,I3,2X,F8.2,2X,F8.2)
|
||||
5 FORMAT(1X,I3,1X,I4,1X,I2,1X,I3,1X,F6.3,1X,F6.3,1X,F6.2,
|
||||
1 1X,F6.2,1X,F8.2)
|
||||
80 FORMAT(15X,'<<<<< WRONG VALUE OF THETA0 : THE DENOMINATOR ',
|
||||
1 'IS ZERO >>>>>')
|
||||
100 FORMAT(15X,'<<<<< THE VALUE OF L EST IS TOO LARGE FOR ATOM',
|
||||
1 ' : ',I2,' >>>>>')
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,791 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE TREAT_AED(ISOM,NFICHLEC,JFICH,NP)
|
||||
C
|
||||
C This routine sums up the calculations corresponding to different
|
||||
C absorbers or different planes when this has to be done
|
||||
C (parameter ISOM in the input data file).
|
||||
C
|
||||
C Last modified : 24 Jan 2013
|
||||
C
|
||||
USE DIM_MOD
|
||||
C
|
||||
USE OUTUNITS_MOD
|
||||
USE TYPEXP_MOD, DUMMY => SPECTRO
|
||||
USE VALEX_A_MOD, PHI0 => PHI0_A, THETA0 => THETA0_A,
|
||||
& PHI1 => PHI1_A, THETA1 => THETA1_A
|
||||
USE VALIN_MOD, P0 => PHI0, T0 => THETA0
|
||||
USE VALFIN_MOD, P1 => PHI1, T1 => THETA1
|
||||
C
|
||||
PARAMETER(N_HEAD=5000,N_FILES=1000)
|
||||
C
|
||||
CHARACTER*3 SPECTRO
|
||||
CHARACTER*13 OUTDATA
|
||||
CHARACTER*72 HEAD(N_HEAD,N_FILES)
|
||||
C
|
||||
REAL TAB(NDIM_M,4)
|
||||
REAL ECIN(NE_M),DTHETA(NTH_M),DPHI(NPH_M)
|
||||
C
|
||||
DATA JVOL,JTOT/0,-1/
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
C Reading and storing the headers:
|
||||
C
|
||||
NHEAD=0
|
||||
DO JLINE=1,N_HEAD
|
||||
READ(IUO2,888) HEAD(JLINE,JFICH)
|
||||
NHEAD=NHEAD+1
|
||||
IF(HEAD(JLINE,JFICH)(1:6).EQ.' ') GOTO 333
|
||||
ENDDO
|
||||
C
|
||||
333 CONTINUE
|
||||
C
|
||||
READ(IUO2,15) SPECTRO,OUTDATA
|
||||
READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE,
|
||||
1 IPH_1,I_EXT
|
||||
C
|
||||
IF(I_EXT.EQ.2) THEN
|
||||
IPH_1=0
|
||||
ENDIF
|
||||
C
|
||||
IF(ISOM.EQ.0) THEN
|
||||
C
|
||||
C........ ISOM = 0 : case of independent input files .................
|
||||
C
|
||||
READ(IUO2,1) NPLAN,NEMET,NTHETA,NPHI,NE
|
||||
C
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
N_FIXED=NPHI
|
||||
FIX0=PHI0
|
||||
FIX1=PHI1
|
||||
N_SCAN=NTHETA
|
||||
ELSE
|
||||
N_FIXED=NTHETA
|
||||
FIX0=THETA0
|
||||
FIX1=THETA1
|
||||
IF(STEREO.EQ.'YES') THEN
|
||||
NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/
|
||||
1 (THETA1-THETA0)+0.0001)+1
|
||||
IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
|
||||
ENDIF
|
||||
N_SCAN=NPHI
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
N_SCAN=2*N_SCAN
|
||||
ENDIF
|
||||
C
|
||||
IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
|
||||
NDP=NEMET*NTHETA*NPHI*NE
|
||||
ELSEIF(I_EXT.EQ.-1) THEN
|
||||
NDP=NEMET*NTHETA*NPHI*NE*2
|
||||
ELSEIF(I_EXT.EQ.2) THEN
|
||||
NDP=NEMET*NTHETA*NE
|
||||
N_FIXED=NTHETA
|
||||
N_SCAN=NPHI
|
||||
IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
|
||||
ENDIF
|
||||
C
|
||||
NTT=NPLAN*NDP
|
||||
IF(NTT.GT.NDIM_M) GOTO 5
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
DO JEMET=1,NEMET
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO J_FIXED=1,N_FIXED
|
||||
IF(N_FIXED.GT.1) THEN
|
||||
XINCRF=FLOAT(J_FIXED-1)*
|
||||
1 (FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
ELSEIF(N_FIXED.EQ.1) THEN
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JPHI=J_FIXED
|
||||
ELSE
|
||||
THETA=THETA0+XINCRF
|
||||
JTHETA=J_FIXED
|
||||
IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 11
|
||||
ENDIF
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
N_SCAN_R=N_SCAN
|
||||
ELSE
|
||||
RTHETA=THETA*0.017453
|
||||
FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
C
|
||||
DO J_SCAN=1,N_SCAN_R
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JTHETA=J_SCAN
|
||||
ELSE
|
||||
JPHI=J_SCAN
|
||||
ENDIF
|
||||
C
|
||||
JLIN=(JPLAN-1)*NDP +
|
||||
1 (JEMET-1)*NE*N_FIXED*N_SCAN +
|
||||
2 (JE-1)*N_FIXED*N_SCAN +
|
||||
3 (JTHETA-1)*NPHI + JPHI
|
||||
C
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
C
|
||||
READ(IUO2,2) JPL
|
||||
IF(JPLAN.EQ.JPL) THEN
|
||||
BACKSPACE IUO2
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
|
||||
ENDIF
|
||||
ELSE
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
|
||||
2 TAB(JLIN,3),TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN2,1),TAB(JLIN2,2),
|
||||
2 TAB(JLIN2,3),TAB(JLIN2,4)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
BACKSPACE IUO2
|
||||
DO JL=JLIN,JPLAN*NDP
|
||||
TAB(JL,1)=0.0
|
||||
TAB(JL,2)=0.0
|
||||
TAB(JL,3)=0.0
|
||||
TAB(JL,4)=0.0
|
||||
ENDDO
|
||||
GOTO 10
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
11 CONTINUE
|
||||
ENDDO
|
||||
ENDDO
|
||||
10 CONTINUE
|
||||
ENDDO
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
C Skipping the NHEAD lines of headers before rewriting:
|
||||
C
|
||||
DO JLINE=1,NHEAD
|
||||
READ(IUO2,888) HEAD(JLINE,JFICH)
|
||||
ENDDO
|
||||
C
|
||||
WRITE(IUO2,15) SPECTRO,OUTDATA
|
||||
WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
C
|
||||
DO JE=1,NE
|
||||
DO JTHETA=1,NTHETA
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
NPHI_R=NPHI
|
||||
ELSE
|
||||
RTHETA=DTHETA(JTHETA)*0.017453
|
||||
FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
|
||||
NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
DO JPHI=1,NPHI_R
|
||||
TOTDIF_1=0.
|
||||
TOTDIR_1=0.
|
||||
VOLDIF_1=0.
|
||||
VOLDIR_1=0.
|
||||
TOTDIF_2=0.
|
||||
TOTDIR_2=0.
|
||||
VOLDIF_2=0.
|
||||
VOLDIR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=0.
|
||||
TOTDIR2_1=0.
|
||||
VOLDIF2_1=0.
|
||||
VOLDIR2_1=0.
|
||||
TOTDIF2_2=0.
|
||||
TOTDIR2_2=0.
|
||||
VOLDIF2_2=0.
|
||||
VOLDIR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
C
|
||||
SF_1=0.
|
||||
SR_1=0.
|
||||
SF_2=0.
|
||||
SR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
SF2_1=0.
|
||||
SR2_1=0.
|
||||
SF2_2=0.
|
||||
SR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JEMET=1,NEMET
|
||||
JLIN=(JPLAN-1)*NDP +
|
||||
1 (JEMET-1)*NE*NTHETA*NPHI +
|
||||
2 (JE-1)*NTHETA*NPHI +
|
||||
3 (JTHETA-1)*NPHI + JPHI
|
||||
SF_1=SF_1+TAB(JLIN,2)
|
||||
SR_1=SR_1+TAB(JLIN,1)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_1=SF2_1+TAB(JLIN2,2)
|
||||
SR2_1=SR2_1+TAB(JLIN2,1)
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
SF_2=SF_2+TAB(JLIN,4)
|
||||
SR_2=SR_2+TAB(JLIN,3)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_2=SF2_2+TAB(JLIN2,4)
|
||||
SR2_2=SR2_2+TAB(JLIN2,3)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1,SR_2,SF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(JPLAN.GT.NONVOL(JFICH)) THEN
|
||||
VOLDIF_1=VOLDIF_1+SF_1
|
||||
VOLDIR_1=VOLDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_1=VOLDIF2_1+SF2_1
|
||||
VOLDIR2_1=VOLDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
VOLDIF_2=VOLDIF_2+SF_2
|
||||
VOLDIR_2=VOLDIR_1+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_2=VOLDIF2_2+SF2_2
|
||||
VOLDIR2_2=VOLDIR2_1+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
TOTDIF_1=TOTDIF_1+SF_1
|
||||
TOTDIR_1=TOTDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=TOTDIF2_1+SF2_1
|
||||
TOTDIR2_1=TOTDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
TOTDIF_2=TOTDIF_2+SF_2
|
||||
TOTDIR_2=TOTDIR_2+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_2=TOTDIF2_2+SF2_2
|
||||
TOTDIR2_2=TOTDIR2_2+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR2_1,VOLDIF2_1
|
||||
ENDIF
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR2_1,TOTDIF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR2_1,VOLDIF2_1,VOLDIR2_2,VOLDIF2_2
|
||||
ENDIF
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR2_1,TOTDIF2_1,TOTDIR2_2,TOTDIF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
ELSE
|
||||
C
|
||||
C........ ISOM not= 0 : multiple input files to be summed up ..........
|
||||
C
|
||||
READ(IUO2,7) NTHETA,NPHI,NE
|
||||
C
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
N_FIXED=NPHI
|
||||
FIX0=PHI0
|
||||
FIX1=PHI1
|
||||
N_SCAN=NTHETA
|
||||
ELSE
|
||||
N_FIXED=NTHETA
|
||||
FIX0=THETA0
|
||||
FIX1=THETA1
|
||||
IF(STEREO.EQ.'YES') THEN
|
||||
NPHI=INT((PHI1-PHI0)*FLOAT(NTHETA-1)/
|
||||
1 (THETA1-THETA0)+0.0001)+1
|
||||
IF(NTHETA*NPHI.GT.NPH_M) GOTO 37
|
||||
ENDIF
|
||||
N_SCAN=NPHI
|
||||
ENDIF
|
||||
C
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
N_SCAN=2*N_SCAN
|
||||
ENDIF
|
||||
C
|
||||
IF((I_EXT.EQ.0).OR.(I_EXT.EQ.1)) THEN
|
||||
NDP=NTHETA*NPHI*NE
|
||||
ELSEIF(I_EXT.EQ.-1) THEN
|
||||
NDP=NTHETA*NPHI*NE*2
|
||||
ELSEIF(I_EXT.EQ.2) THEN
|
||||
NDP=NTHETA*NE
|
||||
N_FIXED=NTHETA
|
||||
N_SCAN=NPHI
|
||||
IF((N_FIXED.GT.NTH_M).OR.(N_FIXED.GT.NPH_M)) GOTO 35
|
||||
ENDIF
|
||||
C
|
||||
NTT=NFICHLEC*NDP
|
||||
IF(NTT.GT.NDIM_M) GOTO 5
|
||||
C
|
||||
IF(ISOM.EQ.1) THEN
|
||||
NPLAN=NP
|
||||
NF=NP
|
||||
ELSEIF(ISOM.EQ.2) THEN
|
||||
NEMET=NFICHLEC
|
||||
NF=NFICHLEC
|
||||
NPLAN=1
|
||||
ENDIF
|
||||
C
|
||||
DO JF=1,NF
|
||||
C
|
||||
C Reading the headers for each file:
|
||||
C
|
||||
IF(JF.GT.1) THEN
|
||||
DO JLINE=1,NHEAD
|
||||
READ(IUO2,888) HEAD(JLINE,JF)
|
||||
ENDDO
|
||||
ENDIF
|
||||
C
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO J_FIXED=1,N_FIXED
|
||||
IF(N_FIXED.GT.1) THEN
|
||||
XINCRF=FLOAT(J_FIXED-1)*
|
||||
1 (FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
ELSEIF(N_FIXED.EQ.1) THEN
|
||||
XINCRF=0.
|
||||
ENDIF
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JPHI=J_FIXED
|
||||
ELSE
|
||||
THETA=THETA0+XINCRF
|
||||
JTHETA=J_FIXED
|
||||
IF((ABS(THETA).GT.90.).AND.(I_EXT.NE.2)) GOTO 12
|
||||
ENDIF
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
N_SCAN_R=N_SCAN
|
||||
ELSE
|
||||
RTHETA=THETA*0.017453
|
||||
FIX_STEP=(FIX1-FIX0)/FLOAT(N_FIXED-1)
|
||||
N_SCAN_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
C
|
||||
DO J_SCAN=1,N_SCAN_R
|
||||
IF(IPH_1.EQ.1) THEN
|
||||
JTHETA=J_SCAN
|
||||
ELSE
|
||||
JPHI=J_SCAN
|
||||
ENDIF
|
||||
C
|
||||
JLIN=(JF-1)*NDP + (JE-1)*N_FIXED*N_SCAN +
|
||||
1 (JTHETA-1)*NPHI + JPHI
|
||||
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
C
|
||||
IF(ISOM.EQ.1) THEN
|
||||
READ(IUO2,2) JPL
|
||||
IF(JF.EQ.JPL) THEN
|
||||
BACKSPACE IUO2
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
|
||||
ENDIF
|
||||
ELSE
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
|
||||
2 TAB(JLIN,3),TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
|
||||
1 DPHI(JPHI2),ECIN(JE),
|
||||
2 TAB(JLIN2,1),TAB(JLIN2,2),
|
||||
3 TAB(JLIN2,3),TAB(JLIN2,4)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
BACKSPACE IUO2
|
||||
DO JLINE=1,NHEAD
|
||||
BACKSPACE IUO2
|
||||
ENDDO
|
||||
DO JL=JLIN,JF*NDP
|
||||
TAB(JL,1)=0.0
|
||||
TAB(JL,2)=0.0
|
||||
TAB(JL,3)=0.0
|
||||
TAB(JL,4)=0.0
|
||||
ENDDO
|
||||
GOTO 13
|
||||
ENDIF
|
||||
ELSEIF(ISOM.EQ.2) THEN
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
READ(IUO2,2) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,25) TAB(JLIN2,1),TAB(JLIN2,2)
|
||||
ENDIF
|
||||
ELSE
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TAB(JLIN,1),TAB(JLIN,2),
|
||||
2 TAB(JLIN,3),TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
READ(IUO2,22) JPL,JEM,DTHETA(JTHETA),
|
||||
1 DPHI(JPHI2),ECIN(JE),
|
||||
2 TAB(JLIN2,1),TAB(JLIN2,2),
|
||||
3 TAB(JLIN2,3),TAB(JLIN2,4)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
12 CONTINUE
|
||||
ENDDO
|
||||
ENDDO
|
||||
13 CONTINUE
|
||||
ENDDO
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
C Writing the headers:
|
||||
C
|
||||
DO JLINE=1,2
|
||||
WRITE(IUO2,888) HEAD(JLINE,1)
|
||||
ENDDO
|
||||
DO JF=1,NFICHLEC
|
||||
DO JLINE=3,6
|
||||
WRITE(IUO2,888) HEAD(JLINE,JF)
|
||||
ENDDO
|
||||
WRITE(IUO2,888) HEAD(2,JF)
|
||||
ENDDO
|
||||
DO JLINE=7,NHEAD
|
||||
WRITE(IUO2,888) HEAD(JLINE,1)
|
||||
ENDDO
|
||||
C
|
||||
WRITE(IUO2,15) SPECTRO,OUTDATA
|
||||
WRITE(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
WRITE(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
C
|
||||
IF(ISOM.EQ.1) THEN
|
||||
C
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO JTHETA=1,NTHETA
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
NPHI_R=NPHI
|
||||
ELSE
|
||||
RTHETA=DTHETA(JTHETA)*0.017453
|
||||
FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
|
||||
NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
DO JPHI=1,NPHI_R
|
||||
C
|
||||
TOTDIF_1=0.
|
||||
TOTDIR_1=0.
|
||||
VOLDIF_1=0.
|
||||
VOLDIR_1=0.
|
||||
TOTDIF_2=0.
|
||||
TOTDIR_2=0.
|
||||
VOLDIF_2=0.
|
||||
VOLDIR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=0.
|
||||
TOTDIR2_1=0.
|
||||
VOLDIF2_1=0.
|
||||
VOLDIR2_1=0.
|
||||
TOTDIF2_2=0.
|
||||
TOTDIR2_2=0.
|
||||
VOLDIF2_2=0.
|
||||
VOLDIR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
JF=JPLAN
|
||||
C
|
||||
JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +
|
||||
1 (JTHETA-1)*NPHI + JPHI
|
||||
C
|
||||
SR_1=TAB(JLIN,1)
|
||||
SF_1=TAB(JLIN,2)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_1=TAB(JLIN2,2)
|
||||
SR2_1=TAB(JLIN2,1)
|
||||
ENDIF
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
SR_2=TAB(JLIN,3)
|
||||
SF_2=TAB(JLIN,4)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_2=TAB(JLIN2,4)
|
||||
SR2_2=TAB(JLIN2,3)
|
||||
ENDIF
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1,SR_2,SF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF(NONVOL(JPLAN).EQ.0) THEN
|
||||
VOLDIF_1=VOLDIF_1+SF_1
|
||||
VOLDIR_1=VOLDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_1=VOLDIF2_1+SF2_1
|
||||
VOLDIR2_1=VOLDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
VOLDIF_2=VOLDIF_2+SF_2
|
||||
VOLDIR_2=VOLDIR_2+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
VOLDIF2_2=VOLDIF2_2+SF2_2
|
||||
VOLDIR2_2=VOLDIR2_1+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
TOTDIF_1=TOTDIF_1+SF_1
|
||||
TOTDIR_1=TOTDIR_1+SR_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_1=TOTDIF2_1+SF2_1
|
||||
TOTDIR2_1=TOTDIR2_1+SR2_1
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
TOTDIF_2=TOTDIF_2+SF_2
|
||||
TOTDIR_2=TOTDIR_2+SR_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
TOTDIF2_2=TOTDIF2_2+SF2_2
|
||||
TOTDIR2_2=TOTDIR2_2+SR2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),VOLDIR2_1,VOLDIF2_1
|
||||
ENDIF
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TOTDIR2_1,TOTDIF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 VOLDIR_1,VOLDIF_1,VOLDIR_2,VOLDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JVOL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),VOLDIR2_1,VOLDIF2_1,
|
||||
3 VOLDIR2_2,VOLDIF2_2
|
||||
ENDIF
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),ECIN(JE),
|
||||
1 TOTDIR_1,TOTDIF_1,TOTDIR_2,TOTDIF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JTOT,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),TOTDIR2_1,TOTDIF2_1,
|
||||
3 TOTDIR2_2,TOTDIF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSEIF(ISOM.EQ.2) THEN
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO JTHETA=1,NTHETA
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
NPHI_R=NPHI
|
||||
ELSE
|
||||
RTHETA=DTHETA(JTHETA)*0.017453
|
||||
FIX_STEP=(THETA1-THETA0)/FLOAT(NTHETA-1)
|
||||
NPHI_R=INT((PHI1-PHI0)*SIN(RTHETA)/FIX_STEP+0.0001)+1
|
||||
NPHI=INT((PHI1-PHI0)/FIX_STEP+0.0001)+1
|
||||
ENDIF
|
||||
DO JPHI=1,NPHI_R
|
||||
C
|
||||
SF_1=0.
|
||||
SR_1=0.
|
||||
SF_2=0.
|
||||
SR_2=0.
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
SF2_1=0.
|
||||
SR2_1=0.
|
||||
SF2_2=0.
|
||||
SR2_2=0.
|
||||
ENDIF
|
||||
C
|
||||
DO JEMET=1,NEMET
|
||||
JF=JEMET
|
||||
C
|
||||
JLIN=(JF-1)*NDP + (JE-1)*NTHETA*NPHI +
|
||||
1 (JTHETA-1)*NPHI + JPHI
|
||||
C
|
||||
SF_1=SF_1+TAB(JLIN,2)
|
||||
SR_1=SR_1+TAB(JLIN,1)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_1=SF2_1+TAB(JLIN2,2)
|
||||
SR2_1=SR2_1+TAB(JLIN2,1)
|
||||
ENDIF
|
||||
IF(IDICHR.GE.1) THEN
|
||||
SF_2=SF_2+TAB(JLIN,4)
|
||||
SR_2=SR_2+TAB(JLIN,3)
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
JLIN2=NTT+JLIN
|
||||
SF2_2=SF2_2+TAB(JLIN2,4)
|
||||
SR2_2=SR2_2+TAB(JLIN2,3)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
IF(I_EXT.LE.0) THEN
|
||||
IF(STEREO.EQ.' NO') THEN
|
||||
JPHI2=JPHI
|
||||
ELSE
|
||||
JPHI2=(JTHETA-1)*NPHI+JPHI
|
||||
ENDIF
|
||||
ELSE
|
||||
JPHI2=JTHETA
|
||||
ENDIF
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
WRITE(IUO2,3) JPL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,3) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1
|
||||
ENDIF
|
||||
ELSE
|
||||
WRITE(IUO2,23) JPL,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR_1,SF_1,SR_2,SF_2
|
||||
IF(I_EXT.EQ.-1) THEN
|
||||
WRITE(IUO2,23) JPLAN,DTHETA(JTHETA),DPHI(JPHI2),
|
||||
1 ECIN(JE),SR2_1,SF2_1,SR2_2,SF2_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
GOTO 6
|
||||
C
|
||||
5 WRITE(IUO1,4)
|
||||
STOP
|
||||
35 WRITE(IUO1,36) N_FIXED
|
||||
STOP
|
||||
37 WRITE(IUO1,38) NTHETA*NPHI
|
||||
STOP
|
||||
C
|
||||
1 FORMAT(2X,I3,2X,I2,2X,I4,2X,I4,2X,I4)
|
||||
2 FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
|
||||
1 2X,E12.6)
|
||||
3 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
4 FORMAT(//,8X,'<<<<<<<<<< DIMENSION OF THE ARRAYS TOO SMALL ',
|
||||
1 'IN THE TREAT_AED SUBROUTINE - INCREASE NDIM_M ',
|
||||
2 '>>>>>>>>>>')
|
||||
7 FORMAT(I4,2X,I4,2X,I4)
|
||||
8 FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
|
||||
9 FORMAT(9(2X,I1),2X,I2)
|
||||
15 FORMAT(2X,A3,11X,A13)
|
||||
22 FORMAT(2X,I3,2X,I2,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,
|
||||
1 2X,E12.6,2X,E12.6,2X,E12.6)
|
||||
23 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,
|
||||
1 2X,E12.6,2X,E12.6)
|
||||
25 FORMAT(37X,E12.6,2X,E12.6)
|
||||
36 FORMAT(//,4X,'<<<<<<<<<< DIMENSION OF NTH_M OR NPH_M TOO SMALL ',
|
||||
1 'IN THE INCLUDE FILE >>>>>>>>>>',/,4X,
|
||||
2 '<<<<<<<<<< SHOULD BE AT LEAST ',I6,
|
||||
3 ' >>>>>>>>>>')
|
||||
38 FORMAT(//,8X,'<<<<<<<<<< DIMENSION OF NPH_M TOO SMALL ',
|
||||
1 'IN THE INCLUDE FILE >>>>>>>>>>',/,8X,
|
||||
2 '<<<<<<<<<< SHOULD BE AT LEAST ',I6,
|
||||
3 ' >>>>>>>>>>')
|
||||
888 FORMAT(A72)
|
||||
C
|
||||
6 RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -0,0 +1,335 @@
|
|||
C
|
||||
C=======================================================================
|
||||
C
|
||||
SUBROUTINE WEIGHT_SUM(ISOM,I_EXT,I_EXT_A,JEL)
|
||||
C
|
||||
C This subroutine performs a weighted sum of the results
|
||||
C corresponding to different directions of the detector.
|
||||
C The directions and weights are read from an external input file
|
||||
C
|
||||
C JEL is the electron undetected (i.e. for which the outgoing
|
||||
C directions are integrated over the unit sphere). It is always
|
||||
C 1 for one electron spectroscopies (PHD). For APECS, It can be
|
||||
C 1 (photoelectron) or 2 (Auger electron) or even 0 (no electron
|
||||
C detected)
|
||||
C
|
||||
C Last modified : 31 Jan 2007
|
||||
C
|
||||
USE DIM_MOD
|
||||
USE INFILES_MOD
|
||||
USE INUNITS_MOD
|
||||
USE OUTUNITS_MOD
|
||||
C
|
||||
C
|
||||
PARAMETER(N_MAX=5810,NPM=20)
|
||||
C
|
||||
REAL*4 W(N_MAX),W_A(N_MAX),ECIN(NE_M)
|
||||
REAL*4 DTHETA(N_MAX),DPHI(N_MAX),DTHETAA(N_MAX),DPHIA(N_MAX)
|
||||
REAL*4 SR_1,SF_1,SR_2,SF_2
|
||||
REAL*4 SUMR_1(NPM,NE_M,N_MAX),SUMR_2(NPM,NE_M,N_MAX)
|
||||
REAL*4 SUMF_1(NPM,NE_M,N_MAX),SUMF_2(NPM,NE_M,N_MAX)
|
||||
C
|
||||
CHARACTER*3 SPECTRO,SPECTRO2
|
||||
CHARACTER*5 LIKE
|
||||
CHARACTER*13 OUTDATA
|
||||
C
|
||||
C
|
||||
C
|
||||
C
|
||||
DATA JVOL,JTOT/0,-1/
|
||||
DATA LIKE /'-like'/
|
||||
C
|
||||
REWIND IUO2
|
||||
C
|
||||
READ(IUO2,15) SPECTRO,OUTDATA
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
SPECTRO2='XAS'
|
||||
ELSE
|
||||
READ(IUO2,9) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
READ(IUO2,9) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A,I
|
||||
&THETA_A,IE_A
|
||||
READ(IUO2,8) NPHI,NTHETA,NE,NPLAN,ISOM
|
||||
READ(IUO2,8) NPHI_A,NTHETA_A
|
||||
IF(JEL.EQ.1) THEN
|
||||
SPECTRO2='AED'
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
SPECTRO2='PHD'
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
SPECTRO2='XAS'
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
IF(NPLAN.GT.NPM) THEN
|
||||
WRITE(IUO1,4) NPLAN+2
|
||||
STOP
|
||||
ENDIF
|
||||
C
|
||||
C Reading the number of angular points
|
||||
C
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
N_POINTS_A=1
|
||||
ELSE
|
||||
IF(JEL.EQ.1) THEN
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
IF(I_EXT_A.EQ.0) THEN
|
||||
N_POINTS_A=NTHETA_A*NPHI_A
|
||||
ELSE
|
||||
OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
|
||||
READ(IUI9,1) N_POINTS_A
|
||||
READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
|
||||
ENDIF
|
||||
NTHETA0=NTHETA_A
|
||||
NPHI0=NPHI_A
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
|
||||
READ(IUI9,1) N_POINTS_A
|
||||
READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
|
||||
IF(I_EXT.EQ.0) THEN
|
||||
N_POINTS=NTHETA*NPHI
|
||||
ELSE
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
ENDIF
|
||||
NTHETA0=NTHETA
|
||||
NPHI0=NPHI
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
OPEN(UNIT=IUI6, FILE=INFILE6, STATUS='OLD')
|
||||
OPEN(UNIT=IUI9, FILE=INFILE9, STATUS='OLD')
|
||||
READ(IUI6,1) N_POINTS
|
||||
READ(IUI9,1) N_POINTS_A
|
||||
READ(IUI6,5) I_DIM,N_DUM1,N_DUM2
|
||||
READ(IUI9,5) I_DIM,N_DUM1,N_DUM2
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
NANGLE=1
|
||||
ELSE
|
||||
IF(JEL.EQ.1) THEN
|
||||
NANGLE=N_POINTS_A
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
NANGLE=N_POINTS
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
NANGLE=1
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
C Initialization of the arrays
|
||||
C
|
||||
DO JE=1,NE
|
||||
DO JANGLE=1,NANGLE
|
||||
DO JPLAN=1,NPLAN+2
|
||||
SUMR_1(JPLAN,JE,JANGLE)=0.
|
||||
SUMF_1(JPLAN,JE,JANGLE)=0.
|
||||
IF(IDICHR.GT.0) THEN
|
||||
SUMR_2(JPLAN,JE,JANGLE)=0.
|
||||
SUMF_2(JPLAN,JE,JANGLE)=0.
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
C Reading of the data to be angle integrated
|
||||
C
|
||||
DO JE=1,NE
|
||||
C
|
||||
DO JANGLE=1,N_POINTS
|
||||
IF(I_EXT.NE.0) READ(IUI6,2) TH,PH,W(JANGLE)
|
||||
DO JANGLE_A=1,N_POINTS_A
|
||||
IF((I_EXT_A.NE.0).AND.(JANGLE.EQ.1)) THEN
|
||||
READ(IUI9,2) THA,PHA,W_A(JANGLE_A)
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN+2
|
||||
C
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
READ(IUO2,3) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE)
|
||||
&,SR_1,SF_1
|
||||
ELSE
|
||||
READ(IUO2,13) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
|
||||
&),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1
|
||||
ENDIF
|
||||
ELSE
|
||||
IF(SPECTRO.NE.'APC') THEN
|
||||
READ(IUO2,23) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
|
||||
&),SR_1,SF_1,SR_2,SF_2
|
||||
ELSE
|
||||
READ(IUO2,24) JDUM,DTHETA(JANGLE),DPHI(JANGLE),ECIN(JE
|
||||
&),DTHETAA(JANGLE_A),DPHIA(JANGLE_A),SR_1,SF_1,SR_2,SF_2
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
IF(JEL.EQ.1) THEN
|
||||
SUMR_1(JPLAN,JE,JANGLE_A)=SUMR_1(JPLAN,JE,JANGLE_A)+SR_1
|
||||
&*W(JANGLE)
|
||||
SUMF_1(JPLAN,JE,JANGLE_A)=SUMF_1(JPLAN,JE,JANGLE_A)+SF_1
|
||||
&*W(JANGLE)
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
SUMR_1(JPLAN,JE,JANGLE)=SUMR_1(JPLAN,JE,JANGLE)+SR_1*W_A
|
||||
&(JANGLE_A)
|
||||
SUMF_1(JPLAN,JE,JANGLE)=SUMF_1(JPLAN,JE,JANGLE)+SF_1*W_A
|
||||
&(JANGLE_A)
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
SUMR_1(JPLAN,JE,1)=SUMR_1(JPLAN,JE,1)+SR_1*W(JANGLE)*W_A
|
||||
&(JANGLE_A)
|
||||
SUMF_1(JPLAN,JE,1)=SUMF_1(JPLAN,JE,1)+SF_1*W(JANGLE)*W_A
|
||||
&(JANGLE_A)
|
||||
ENDIF
|
||||
IF(IDICHR.GT.0) THEN
|
||||
IF(JEL.EQ.1) THEN
|
||||
SUMR_2(JPLAN,JE,JANGLE_A)=SUMR_2(JPLAN,JE,JANGLE_A)+SR
|
||||
&_2*W(JANGLE)
|
||||
SUMF_2(JPLAN,JE,JANGLE_A)=SUMF_2(JPLAN,JE,JANGLE_A)+SF
|
||||
&_2*W(JANGLE)
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
SUMR_2(JPLAN,JE,JANGLE)=SUMR_2(JPLAN,JE,JANGLE)+SR_2*W
|
||||
&_A(JANGLE_A)
|
||||
SUMF_2(JPLAN,JE,JANGLE)=SUMF_2(JPLAN,JE,JANGLE)+SF_2*W
|
||||
&_A(JANGLE_A)
|
||||
ELSEIF(JEL.EQ.0) THEN
|
||||
SUMR_2(JPLAN,JE,1)=SUMR_2(JPLAN,JE,1)+SR_2*W(JANGLE)*W
|
||||
&_A(JANGLE_A)
|
||||
SUMF_2(JPLAN,JE,1)=SUMF_2(JPLAN,JE,1)+SF_2*W(JANGLE)*W
|
||||
&_A(JANGLE_A)
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
C
|
||||
ENDDO
|
||||
IF(I_EXT_A.NE.0) THEN
|
||||
REWIND IUI9
|
||||
READ(IUI9,1) NDUM
|
||||
READ(IUI9,1) NDUM
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
IF(I_EXT.NE.0) THEN
|
||||
REWIND IUI6
|
||||
READ(IUI6,1) NDUM
|
||||
READ(IUI6,1) NDUM
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
CLOSE(IUI6)
|
||||
CLOSE(IUI9)
|
||||
REWIND IUO2
|
||||
C
|
||||
WRITE(IUO2,16) SPECTRO2,LIKE,SPECTRO,OUTDATA
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,19) ISPIN,IDICHR,I_SO,ISFLIP
|
||||
WRITE(IUO2,18) NE,NPLAN,ISOM
|
||||
ELSEIF(JEL.EQ.1) THEN
|
||||
WRITE(IUO2,20) ISPIN_A,IDICHR_A,I_SO_A,ISFLIP_A,ICHKDIR_A,IPHI_A
|
||||
&,ITHETA_A,IE_A
|
||||
WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
WRITE(IUO2,20) ISPIN,IDICHR,I_SO,ISFLIP,ICHKDIR,IPHI,ITHETA,IE
|
||||
WRITE(IUO2,21) NPHI0,NTHETA0,NE,NPLAN,ISOM
|
||||
ENDIF
|
||||
C
|
||||
DO JE=1,NE
|
||||
DO JANGLE=1,NANGLE
|
||||
IF(SPECTRO.EQ.'APC') THEN
|
||||
IF(JEL.EQ.1) THEN
|
||||
THETA=DTHETAA(JANGLE)
|
||||
PHI=DPHIA(JANGLE)
|
||||
ELSEIF(JEL.EQ.2) THEN
|
||||
THETA=DTHETA(JANGLE)
|
||||
PHI=DPHI(JANGLE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
DO JPLAN=1,NPLAN
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,33) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
|
||||
&MF_1(JPLAN,JE,JANGLE)
|
||||
ELSE
|
||||
WRITE(IUO2,34) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
|
||||
&JANGLE),SUMF_1(JPLAN,JE,JANGLE)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,43) JPLAN,ECIN(JE),SUMR_1(JPLAN,JE,JANGLE),SU
|
||||
&MF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPLAN,JE,JANG
|
||||
&LE)
|
||||
ELSE
|
||||
WRITE(IUO2,44) JPLAN,THETA,PHI,ECIN(JE),SUMR_1(JPLAN,JE,
|
||||
&JANGLE),SUMF_1(JPLAN,JE,JANGLE),SUMR_2(JPLAN,JE,JANGLE),SUMF_2(JPL
|
||||
&AN,JE,JANGLE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDDO
|
||||
C
|
||||
IF(IDICHR.EQ.0) THEN
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,33) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+1,JE,JANGLE)
|
||||
WRITE(IUO2,33) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+2,JE,JANGLE)
|
||||
ELSE
|
||||
WRITE(IUO2,34) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+1,JE,JANGLE)
|
||||
WRITE(IUO2,34) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+2,JE,JANGLE)
|
||||
ENDIF
|
||||
ELSE
|
||||
IF((SPECTRO.NE.'APC').OR.(JEL.EQ.0)) THEN
|
||||
WRITE(IUO2,43) JVOL,ECIN(JE),SUMR_1(NPLAN+1,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(NPLAN+1,JE
|
||||
&,JANGLE)
|
||||
WRITE(IUO2,43) JTOT,ECIN(JE),SUMR_1(NPLAN+2,JE,JANGLE),SUM
|
||||
&F_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(NPLAN+2,JE
|
||||
&,JANGLE)
|
||||
ELSE
|
||||
WRITE(IUO2,44) JVOL,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+1,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+1,JE,JANGLE),SUMR_2(NPLAN+1,JE,JANGLE),SUMF_2(
|
||||
&NPLAN+1,JE,JANGLE)
|
||||
WRITE(IUO2,44) JTOT,THETA,PHI,ECIN(JE),SUMR_1(NPLAN+2,JE,J
|
||||
&ANGLE),SUMF_1(NPLAN+2,JE,JANGLE),SUMR_2(NPLAN+2,JE,JANGLE),SUMF_2(
|
||||
&NPLAN+2,JE,JANGLE)
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
ENDDO
|
||||
ENDDO
|
||||
C
|
||||
1 FORMAT(13X,I4)
|
||||
2 FORMAT(15X,F8.3,3X,F8.3,3X,E12.6)
|
||||
3 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
4 FORMAT(//,8X,'<<<<<<<<<< DIMENSION OF THE ARRAYS TOO SMALL ','IN
|
||||
&THE WEIGHT_SUM SUBROUTINE - INCREASE NPM TO ',I3,'>>>>>>>>>>')
|
||||
5 FORMAT(6X,I1,1X,I3,3X,I3)
|
||||
8 FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
|
||||
9 FORMAT(9(2X,I1),2X,I2)
|
||||
13 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
|
||||
&12.6)
|
||||
15 FORMAT(2X,A3,11X,A13)
|
||||
16 FORMAT(2X,A3,A5,1X,A3,2X,A13)
|
||||
18 FORMAT(I4,2X,I3,2X,I1)
|
||||
19 FORMAT(4(2X,I1))
|
||||
20 FORMAT(8(2X,I1))
|
||||
21 FORMAT(I4,2X,I4,2X,I4,2X,I3,2X,I1)
|
||||
23 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
|
||||
&,E12.6)
|
||||
24 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,F6.2,2X,F6.2,2X,E12.6,2X,E
|
||||
&12.6,2X,E12.6,2X,E12.6)
|
||||
33 FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
34 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6)
|
||||
43 FORMAT(2X,I3,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X,E12.6)
|
||||
44 FORMAT(2X,I3,2X,F6.2,2X,F6.2,2X,F8.2,2X,E12.6,2X,E12.6,2X,E12.6,2X
|
||||
&,E12.6)
|
||||
C
|
||||
RETURN
|
||||
C
|
||||
END
|
||||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -16,8 +17,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/tests.py
|
||||
# Last modified: ven. 10 avril 2020 17:33:28
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
import os
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -18,8 +19,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/utils.py
|
||||
# Last modified: ven. 10 avril 2020 15:49:35
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
"""
|
||||
|
|
@ -66,7 +67,7 @@ class ForeignPotential(object):
|
|||
self.phagen_data = {'types': []}
|
||||
|
||||
def write(self, filename, prototypical_atoms):
|
||||
LOGGER.debug(f"Writing Phagen input potential file: {filename}")
|
||||
LOGGER.debug("Writing Phagen input potential file: {}".format(filename))
|
||||
|
||||
def DEPRECATEDappend_atom_potential(atom):
|
||||
Z = atom.number
|
||||
|
|
@ -77,8 +78,8 @@ class ForeignPotential(object):
|
|||
itypes.append(i)
|
||||
# Check now that we have only one type in the list
|
||||
# otherwise we do not know yet how to deal with this.
|
||||
assert len(itypes) > 0, f"Cannot find the data for atom with Z={Z}"
|
||||
assert len(itypes) == 1, f"Too many datasets for atom with Z={Z}"
|
||||
assert len(itypes) > 0, "Cannot find the data for atom with Z={}".format(Z)
|
||||
assert len(itypes) == 1, "Too many datasets for atom with Z={}".format(Z)
|
||||
# So far so good, let's write the block
|
||||
t = self.phagen_data['types'][itypes[0]]
|
||||
s = "{:<7d}{:<10d}{:1.4f}\n".format(
|
||||
|
|
@ -91,7 +92,7 @@ class ForeignPotential(object):
|
|||
def append_atom_potential(atom):
|
||||
line_fmt = "{:+1.8e} " * 4 + "\n"
|
||||
atom_type = atom.get('atom_type')
|
||||
assert atom_type != None, f"Unable get the atom type!"
|
||||
assert atom_type != None, "Unable get the atom type!"
|
||||
for t in self.phagen_data['types']:
|
||||
if t['atom_type'] == atom_type:
|
||||
s = "{:<7d}{:<10d}{:1.4f}\n".format(
|
||||
|
|
@ -134,7 +135,7 @@ class SPRKKRPotential(ForeignPotential):
|
|||
self.potfile = potfile
|
||||
self.load_sprkkr_atom_types()
|
||||
for f in exported_files:
|
||||
LOGGER.info(f"Loading file {f}...")
|
||||
LOGGER.info("Loading file {}...".format(f))
|
||||
# get the IT from the filename
|
||||
m=re.match('SPRKKR-IT_(?P<IT>\d+)-PHAGEN.*', os.path.basename(f))
|
||||
it = int(m.group('IT'))
|
||||
|
|
@ -188,7 +189,7 @@ class SPRKKRPotential(ForeignPotential):
|
|||
return data
|
||||
|
||||
# load info in *.pot file
|
||||
LOGGER.info(f"Loading SPRKKR *.pot file {self.potfile}...")
|
||||
LOGGER.info("Loading SPRKKR *.pot file {}...".format(self.potfile))
|
||||
with open(self.potfile, 'r') as fd:
|
||||
content = fd.read()
|
||||
|
||||
|
|
@ -229,7 +230,7 @@ class SPRKKRPotential(ForeignPotential):
|
|||
IT = occupation['ITOQ']
|
||||
atom = self.atoms[i]
|
||||
atom.set('atom_type', IT)
|
||||
LOGGER.debug(f"Site #{IQ} is type #{IT}, atom {atom}")
|
||||
LOGGER.debug("Site #{} is type #{}, atom {}".format(IQ, IT, atom))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/usr/bin/env python
|
||||
# coding: utf-8
|
||||
#
|
||||
# Copyright © 2016-2020 - Rennes Physics Institute
|
||||
#
|
||||
|
|
@ -16,8 +17,8 @@
|
|||
# along with this msspec. If not, see <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Source file : src/msspec/version.py
|
||||
# Last modified: ven. 10 avril 2020 17:34:38
|
||||
# Committed by : "Sylvain Tricot <sylvain.tricot@univ-rennes1.fr>"
|
||||
# Last modified: Mon, 27 Sep 2021 17:49:48 +0200
|
||||
# Committed by : sylvain tricot <sylvain.tricot@univ-rennes1.fr>
|
||||
|
||||
|
||||
import os
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
PYTHON = python
|
||||
PYMAJ = 3
|
||||
PYMIN = 6
|
||||
PYMIN = 5
|
||||
|
||||
FC = gfortran
|
||||
F2PY = f2py3 --f77exec=$(FC) --f90exec=$(FC)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,83 @@
|
|||
# coding: utf8
|
||||
|
||||
import numpy as np
|
||||
from ase.build import bulk
|
||||
from ase.lattice.tetragonal import SimpleTetragonalFactory
|
||||
from msspec.calculator import MSSPEC, XRaySource
|
||||
from msspec.utils import hemispherical_cluster, get_atom_index
|
||||
import logging
|
||||
|
||||
logging.basicConfig(level=logging.INFO)
|
||||
|
||||
|
||||
do_ped = False
|
||||
|
||||
# Define a Rocksalt Factory class (to tetragonalize the unit cell)
|
||||
class RocksaltFactory(SimpleTetragonalFactory):
|
||||
bravais_basis = [[0, 0, 0], [0.5, 0.5, 0], [0.5, 0, 0.5], [0, 0.5, 0.5],
|
||||
[0, 0, 0.5], [0.5, 0, 0], [0, 0.5, 0], [0.5, 0.5, 0.5]]
|
||||
element_basis = (0, 0, 0, 0, 1, 1, 1, 1)
|
||||
Rocksalt = RocksaltFactory()
|
||||
|
||||
|
||||
a0 = 4.09
|
||||
a_perp = 4.25
|
||||
MgO = Rocksalt(('Mg', 'O'),
|
||||
latticeconstant={'a': a0, 'c/a': a_perp/a0},
|
||||
size=(1,1,1))
|
||||
|
||||
|
||||
for atom in MgO:
|
||||
atom.set('mean_square_vibration', 0.01)
|
||||
atom.set('forward_angle', 20.)
|
||||
if atom.symbol == 'Mg':
|
||||
atom.tag = 1
|
||||
atom.set('mt_radius', 0.63)
|
||||
else:
|
||||
atom.tag = 2
|
||||
atom.set('mt_radius', 1.415)
|
||||
|
||||
|
||||
#cluster = hemispherical_cluster(MgO, emitter_tag=1, emitter_plane=1, planes=4, diameter=4.5*a0)
|
||||
cluster = hemispherical_cluster(MgO, emitter_tag=1, emitter_plane=1, planes=2)
|
||||
cluster.absorber = get_atom_index(cluster, 0, 0, 0)
|
||||
#cluster.edit()
|
||||
#exit()
|
||||
|
||||
if do_ped:
|
||||
calc = MSSPEC(spectroscopy='PED', algorithm='inversion')
|
||||
else:
|
||||
calc = MSSPEC(spectroscopy='AED', algorithm='inversion')
|
||||
calc.set_atoms(cluster)
|
||||
|
||||
calc.muffintin_parameters.ionicity = {'Mg': 0.1, 'O': -0.1}
|
||||
|
||||
calc.tmatrix_parameters.exchange_correlation = 'hedin_lundqvist_complex'
|
||||
calc.tmatrix_parameters.lmax_mode = 'true_ke'
|
||||
#calc.tmatrix_parameters.tl_threshold = 1e-6
|
||||
|
||||
calc.source_parameters.energy = XRaySource.AL_KALPHA
|
||||
calc.source_parameters.theta = -55.
|
||||
calc.source_parameters.phi = 0
|
||||
|
||||
calc.detector_parameters.angular_acceptance = 2.
|
||||
calc.detector_parameters.average_sampling = 'high'
|
||||
|
||||
calc.calculation_parameters.scattering_order = 4
|
||||
calc.calculation_parameters.RA_cutoff = 2
|
||||
calc.calculation_parameters.path_filtering = 'forward_scattering'
|
||||
calc.calculation_parameters.off_cone_events = 1
|
||||
calc.calculation_parameters.vibrational_damping = 'averaged_tl'
|
||||
calc.calculation_parameters.vibration_scaling = 3.
|
||||
|
||||
if do_ped:
|
||||
calc.muffintin_parameters.interstitial_potential = 14
|
||||
data = calc.get_theta_scan(phi=0, theta=np.arange(-5, 60.5, 0.5),
|
||||
level='2p',
|
||||
kinetic_energy=1200)
|
||||
else:
|
||||
data = calc.get_theta_scan(phi=0, theta=np.arange(-5, 60.5, 0.5),
|
||||
edge='KL2L2', multiplet='1D2',
|
||||
kinetic_energy=1200)
|
||||
|
||||
data.save('results.hdf5')
|
||||
Loading…
Reference in New Issue