diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 1290ed98787377eea7d54f12d05b94eff0aeaf2f..cfcb6f5d8518eb3783b84880913e02d4bed7000e 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -60,9 +60,11 @@ compatibility_stage:
- echo "Running make with flang version 16 and clang version 16..."
- make clean && BUILDDIR=$PWD/../build_clang16-flang16 CXX="clang++-16 -stdlib=libstdc++ -I/usr/include/c++/12 -I/usr/include/x86_64-linux-gnu/c++/12" FC=flang-new-16 FCFLAGS=-O3 LDFLAGS="-L/usr/lib/llvm-16/lib -L/usr/lib/gcc/x86_64-linux-gnu/12" make -j
- echo "Running make with Intel ifort and Intel icpx..."
- - make clean && PATH=/opt/intel/oneapi/compiler/latest/bin:$PATH BUILDDIR=$PWD/../build_ifort-icpx CXX=icpx FC=ifort FCFLAGS="-O3 -diag-disable=10448" make -j
+ - make clean && LD_LIBRARY_PATH=/opt/intel/oneapi/compiler/2024.1/lib PATH=/opt/intel/oneapi/compiler/2024.1/bin:$PATH BUILDDIR=$PWD/../build_ifort-icpx CXX=icpx FC=ifort FCFLAGS="-O3 -diag-disable=10448" make -j
- echo "Running make with Intel ifx and Intel icpx..."
- - make clean && LD_LIBRARY_PATH=/opt/intel/oneapi/compiler/latest/lib PATH=/opt/intel/oneapi/compiler/latest/bin:$PATH BUILDDIR=$PWD/../build_ifx-icpx CXX=icpx FC=ifx FCFLAGS=-O3 make -j
+ - make clean && LD_LIBRARY_PATH=/opt/intel/oneapi/compiler/2024.1/lib PATH=/opt/intel/oneapi/compiler/2024.1/bin:$PATH BUILDDIR=$PWD/../build_ifx-icpx CXX=icpx FC=ifx FCFLAGS=-O3 make -j
+ - echo "Running make with default MPI compilers"
+ - make clean && BUILDDIR=$PWD/../build_mpi CXX=mpicxx FC=mpif90 USE_MPI=1 make -j
building_stage:
stage: build
diff --git a/build/README.md b/build/README.md
index ecf636b9aea41b095585926be28304281b58c8e2..554c0d68035e9e089330df47a8493d58edb53a2f 100644
--- a/build/README.md
+++ b/build/README.md
@@ -111,4 +111,3 @@ where the arguments must be valid paths to binary transition matrix files saved
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/containers/docker/Dockerfile b/containers/docker/Dockerfile
index 2f528d227e1881262a3297663a697b13d9ef5ffe..0b45614849d1230f676f436a799e2093a00ad6e4 100644
--- a/containers/docker/Dockerfile
+++ b/containers/docker/Dockerfile
@@ -20,6 +20,8 @@ RUN apt update
RUN DEBIAN_FRONTEND=noninteractive apt -y install intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-compiler-dpcpp-cpp
# install lapacke and its dependencies, both standard and the version with 64 bit integers
RUN DEBIAN_FRONTEND=noninteractive apt -y install liblapacke-dev liblapacke64-dev libopenblas-dev libopenblas-openmp-dev libopenblas64-dev libopenblas64-openmp-dev
+# install MPI stack
+RUN DEBIAN_FRONTEND=noninteractive apt -y install mpi-default-dev mpi-default-bin
# install packages needed to run python scripts for checks
RUN DEBIAN_FRONTEND=noninteractive apt -y install python3 python-is-python3 python3-regex
# install packages needed to run doxygen to create html docs
@@ -53,7 +55,7 @@ FROM debian:bookworm-slim AS np-tmcode-run-minimal
WORKDIR /root
# install the strictly needed runtime libraries needed to run the executables
# and the python check scripts
-RUN DEBIAN_FRONTEND=noninteractive apt update && DEBIAN_FRONTEND=noninteractive apt upgrade && DEBIAN_FRONTEND=noninteractive apt -y install libgfortran5 libgcc-s1 libhdf5-103-1 libstdc++6 libssl3 libcurl4 libsz2 zlib1g libnghttp2-14 libidn2-0 librtmp1 libssh2-1 libpsl5 libgssapi-krb5-2 libldap-2.5-0 libzstd1 libbrotli1 libaec0 libunistring2 libgmp10 libkrb5-3 libk5crypto3 libcom-err2 libkrb5support0 libsasl2-2 libp11-kit0 libtasn1-6 libkeyutils1 libffi8 liblapacke64 libopenblas64-0-openmp python3 python-is-python3 python3-regex hdf5-tools && rm -rf /var/lib/apt/lists/*
+RUN DEBIAN_FRONTEND=noninteractive apt update && DEBIAN_FRONTEND=noninteractive apt upgrade && DEBIAN_FRONTEND=noninteractive apt -y install libgfortran5 libgcc-s1 libhdf5-103-1 libstdc++6 libssl3 libcurl4 libsz2 zlib1g libnghttp2-14 libidn2-0 librtmp1 libssh2-1 libpsl5 libgssapi-krb5-2 libldap-2.5-0 libzstd1 libbrotli1 libaec0 libunistring2 libgmp10 libkrb5-3 libk5crypto3 libcom-err2 libkrb5support0 libsasl2-2 libp11-kit0 libtasn1-6 libkeyutils1 libffi8 liblapacke64 libopenblas64-0-openmp python3 python-is-python3 python3-regex hdf5-tools mpi-default-bin && rm -rf /var/lib/apt/lists/*
COPY --from=np-tmcode-run-dev /root /root
# remove everything which is not needed to run the codes
RUN cd /root/np-tmcode && find build -name "*.o" -exec rm -v \{\} \; && find build -name "*.gcno" -exec rm -v \{\} \; && cd src && rm -rvf cluster libnptm trapping include sphere Makefile make.inc README.md && cd .. && rm -rvf containers && cd doc && rm -rvf src && cd build/latex && rm -rvf *.tex *.out *.sty *.ind *.log *.toc *.ilg *.idx *.aux *.eps Makefile class*.pdf
diff --git a/containers/docker/README.md b/containers/docker/README.md
index 13b5bf1433a0b954b2ed7be883dd7bbe326306a7..d7f8e8f9b6f0681ab3513db167b6b26f136333c1 100644
--- a/containers/docker/README.md
+++ b/containers/docker/README.md
@@ -26,4 +26,3 @@ where `<image name>` is either `np-tmcode` or `np-tmcode-run`. One may also add
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/containers/singularity/README.md b/containers/singularity/README.md
index 086c40dcabefff1f021c6e6cc7de8d3835275b8b..fad127007ba4d2b5d6dbfcb2f093ecab6f8b176c 100644
--- a/containers/singularity/README.md
+++ b/containers/singularity/README.md
@@ -33,4 +33,3 @@ where `<full path to image name>` is the name of the sif image, including full o
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/doc/src/README.md b/doc/src/README.md
index dec0e441bc3a292243cfa574a6cd77ed4bdde426..28f258ffdaae2cafb173ebc798fe974d1618c1bc 100644
--- a/doc/src/README.md
+++ b/doc/src/README.md
@@ -29,4 +29,3 @@ Alternatively, you can use `make` from the project `src` folder (named `np_tmcod
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/src/README.md b/src/README.md
index 4f5e0d446814adda72b98a49a4de105322eb253f..fe3cbeef3f96417a1a708c6006a7923c7b2eb58e 100644
--- a/src/README.md
+++ b/src/README.md
@@ -51,4 +51,3 @@ In all cases, build commands executed through `make` will output the object file
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/src/cluster/cluster.cpp b/src/cluster/cluster.cpp
index faabf2163db9b6902b868877742d5115144ec6d3..1738c588c3734f919ba36652a5b86c064e520c96 100644
--- a/src/cluster/cluster.cpp
+++ b/src/cluster/cluster.cpp
@@ -87,6 +87,10 @@ void cluster(const string& config_file, const string& data_file, const string& o
FILE *timing_file = fopen(timing_name.c_str(), "w");
Logger *time_logger = new Logger(LOG_DEBG, timing_file);
Logger *logger = new Logger(LOG_INFO);
+#ifdef USE_MAGMA
+ logger->log("INFO: Process " + to_string(mpidata->rank) + " initializes MAGMA.\n");
+ magma_init();
+#endif
// the following only happens on MPI process 0
if (mpidata->rank == 0) {
logger->log("INFO: making legacy configuration...", LOG_INFO);
@@ -169,6 +173,8 @@ void cluster(const string& config_file, const string& data_file, const string& o
if (tppoan.is_open()) {
#ifdef USE_LAPACK
logger->log("INFO: using LAPACK calls.\n", LOG_INFO);
+#elif defined USE_MAGMA
+ logger->log("INFO: using MAGMA calls.\n", LOG_INFO);
#else
logger->log("INFO: using fall-back lucin() calls.\n", LOG_INFO);
#endif
@@ -247,7 +253,9 @@ void cluster(const string& config_file, const string& data_file, const string& o
fstream &tppoan_2 = *tppoanp_2;
// make sure all threads align here: I don't want the following loop to accidentally start for thread 0, possibly modifying some variables before they are copied by all other threads
#pragma omp barrier
- if (myompthread==0) logger->log("Syncing OpenMP threads and starting the loop on wavelengths\n");
+ if (myompthread==0) {
+ logger->log("Syncing OpenMP threads and starting the loop on wavelengths\n");
+ }
// ok, now I can actually start the parallel calculations
#pragma omp for
for (jxi488 = cid_2->firstxi; jxi488 <= cid_2->lastxi; jxi488++) {
@@ -268,6 +276,7 @@ void cluster(const string& config_file, const string& data_file, const string& o
logger->log(message);
}
} // closes pragma omp parallel
+
#ifdef _OPENMP
#pragma omp barrier
{
@@ -510,6 +519,10 @@ void cluster(const string& config_file, const string& data_file, const string& o
delete gconf;
}
+#endif
+#ifdef USE_MAGMA
+ logger->log("INFO: Process " + to_string(mpidata->rank) + " finalizes MAGMA.\n");
+ magma_finalize();
#endif
fclose(timing_file);
delete time_logger;
diff --git a/src/cluster/np_cluster.cpp b/src/cluster/np_cluster.cpp
index 175af11f9644e6e5ad4a4f73432d132c831f495b..8b3dab779a1a32b92a1047c0555452af49a6d2a7 100644
--- a/src/cluster/np_cluster.cpp
+++ b/src/cluster/np_cluster.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -42,9 +42,13 @@
#include "../include/Configuration.h"
#endif
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
using namespace std;
-extern void cluster(const string& config_file, const string& data_file, const string& output_path);
+extern void cluster(const string& config_file, const string& data_file, const string& output_path, const mixMPI *mpidata);
/*! \brief Main program entry point.
*
@@ -59,6 +63,14 @@ extern void cluster(const string& config_file, const string& data_file, const st
* \return result: `int` An exit code passed to the OS (0 for succesful execution).
*/
int main(int argc, char **argv) {
+#ifdef MPI_VERSION
+ int ierr = MPI_Init(&argc, &argv);
+ // create and initialise class with essential MPI data
+ mixMPI *mpidata = new mixMPI(MPI_COMM_WORLD);
+#else
+ // create a the class with dummy data if we are not using MPI at all
+ mixMPI *mpidata = new mixMPI();
+#endif
string config_file = "../../test_data/cluster/DEDFB";
string data_file = "../../test_data/cluster/DCLU";
string output_path = ".";
@@ -67,6 +79,10 @@ int main(int argc, char **argv) {
data_file = string(argv[2]);
output_path = string(argv[3]);
}
- cluster(config_file, data_file, output_path);
+ cluster(config_file, data_file, output_path, mpidata);
+#ifdef MPI_VERSION
+ MPI_Finalize();
+#endif
+ delete mpidata;
return 0;
}
diff --git a/src/include/Commons.h b/src/include/Commons.h
index c627b441e2b576ec0fcb22e3f350cfaf042b4ac0..7e4d2520719a82fbebcee2198797bb11ad335562 100644
--- a/src/include/Commons.h
+++ b/src/include/Commons.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -32,6 +32,12 @@
#ifndef INCLUDE_COMMONS_H_
#define INCLUDE_COMMONS_H_
+#ifdef USE_MPI
+#include <mpi.h>
+#endif
+
+class mixMPI;
+
/*! \brief Representation of the FORTRAN C1 common blocks.
*
* C1 common blocks are used to store vector field expansions and geometric
@@ -123,6 +129,20 @@ public:
*/
C1(const C1& rhs);
+#ifdef MPI_VERSION
+ /*! \brief C1 instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C1(const mixMPI *mpidata);
+
+ /*! \brief send C1 instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
//! \brief C1 instance destroyer.
~C1();
};
@@ -166,6 +186,21 @@ public:
//! \brief C2 instance destroyer.
~C2();
+
+#ifdef MPI_VERSION
+ /*! \brief C2 instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C2(const mixMPI *mpidata);
+
+ /*! \brief send C2 instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
};
/*! \brief Representation of the FORTRAN C3 blocks.
@@ -196,6 +231,21 @@ public:
/*! \brief C3 instance destroyer.
*/
~C3();
+
+#ifdef MPI_VERSION
+ /*! \brief C3 instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C3(const mixMPI *mpidata);
+
+ /*! \brief send C3 instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
};
/*! \brief Representation of the FORTRAN C4 blocks.
@@ -242,6 +292,21 @@ public:
/*! \brief C4 instance destroyer.
*/
~C4();
+
+#ifdef MPI_VERSION
+ /*! \brief C4 instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C4(const mixMPI *mpidata);
+
+ /*! \brief send C4 instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
};
/*! \brief Vectors and matrices that are specific to cluster C1 blocks.
@@ -330,6 +395,21 @@ public:
//! \brief C1_AddOns instance destroyer.
~C1_AddOns();
+
+#ifdef MPI_VERSION
+ /*! \brief C1_AddOns instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C1_AddOns(const mixMPI *mpidata);
+
+ /*! \brief send C1_AddOns instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
};
/*! \brief Representation of the FORTRAN C6 blocks.
@@ -356,6 +436,21 @@ public:
/*! \brief C6 instance destroyer.
*/
~C6();
+
+#ifdef MPI_VERSION
+ /*! \brief C6 instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C6(const mixMPI *mpidata);
+
+ /*! \brief send C6 instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
};
/*! \brief Representation of the FORTRAN C9 blocks.
@@ -397,6 +492,51 @@ public:
/*! \brief C9 instance destroyer.
*/
~C9();
+
+#ifdef MPI_VERSION
+ /*! \brief C9 instance constructor copying all contents off MPI broadcast from MPI process 0
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ C9(const mixMPI *mpidata);
+
+ /*! \brief send C9 instance from MPI process 0 via MPI broadcasts to all other processes
+ *
+ * \param mpidata: `mixMPI *` pointer to MPI data structure.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
+};
+
+/*! \brief structure with essential MPI data.
+ */
+class mixMPI {
+public:
+ //! \brief was MPI initialised?
+ bool mpirunning;
+ //! \brief MPI rank
+ int rank;
+ //! \brief MPI nprocs
+ int nprocs;
+
+ /*! \brief empty mixMPI instance constructor.
+ */
+ mixMPI();
+
+ /*! \brief mixMPI instance constructor from an actual MPI communicator.
+ */
+#ifdef MPI_VERSION
+ mixMPI(MPI_Comm comm);
+#endif
+
+ /*! \brief mixMPI instance constructor copying its contents from a preexisting object.
+ */
+ mixMPI(const mixMPI& rhs);
+
+ /*! \brief mixMPI instance destroyer.
+ */
+ ~mixMPI();
};
/*! \brief A data structure representing the information used for a single scale
@@ -468,12 +608,32 @@ public:
//! \brief Wave number.
double wn;
double xip;
+ int number_of_scales;
+ int xiblock;
+ int firstxi;
+ int lastxi;
- ClusterIterationData(GeometryConfiguration *gconf, ScattererConfiguration *sconf);
-
+ ClusterIterationData(GeometryConfiguration *gconf, ScattererConfiguration *sconf, const mixMPI *mpidata);
+
ClusterIterationData(const ClusterIterationData& rhs);
+#ifdef MPI_VERSION
+ ClusterIterationData(const mixMPI *mpidata);
+
+ /*! \brief Broadcast over MPI the ClusterIterationData instance from MPI process 0 to all others.
+ *
+ * When using MPI, the initial ClusterIterationData instance created by MPI process 0
+ * needs to be replicated on all other processes. This function sends it using
+ * MPI broadcast calls. The MPI broadcast calls in this function must match those
+ * in the constructor using the mixMPI pointer.
+ *
+ * \param mpidata: `mixMPI *` Pointer to the mpi structure used to do the MPI broadcast.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
~ClusterIterationData();
+
};
/*! \brief A data structure representing the angles to be evaluated in the problem.
@@ -575,6 +735,27 @@ public:
* \param rhs: `ScatteringAngles&` Reference to the ScatteringAngles object to be copied.
*/
ScatteringAngles(const ScatteringAngles &rhs);
+
+#ifdef MPI_VERSION
+ /*! \brief ScatteringAngles copy from MPI broadcast.
+ *
+ * \param mpidata: `mixMPI *` Pointer to the mpidata instance used to copy the data.
+ */
+ ScatteringAngles(const mixMPI *mpidata);
+
+ /*! \brief Broadcast over MPI the ScatteringAngles instance from MPI process 0 to all others.
+ *
+ * When using MPI, the initial ScatteringAngles instance created by MPI process 0
+ * needs to be replicated on all other processes. This function sends it using
+ * MPI broadcast calls. The MPI broadcast calls in this function must match those
+ * in the constructor using the mixMPI pointer.
+ *
+ * \param mpidata: `mixMPI *` Pointer to the mpi structure used to do the MPI broadcast.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
};
+
#endif
diff --git a/src/include/Configuration.h b/src/include/Configuration.h
index 5a341c256fb17076df34c2d8032155aed930a659..6ac9417969c84928f7fa51959d3a014b46f07eac 100644
--- a/src/include/Configuration.h
+++ b/src/include/Configuration.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -43,6 +43,8 @@
#ifndef INCLUDE_CONFIGURATION_H_
#define INCLUDE_CONFIGURATION_H_
+class mixMPI;
+
/**
* \brief A class to represent the configuration of the scattering geometry.
*
@@ -212,6 +214,25 @@ public:
*/
GeometryConfiguration(const GeometryConfiguration& rhs);
+#ifdef MPI_VERSION
+ /*! \brief Build a scattering geometry configuration structure copying it via MPI from MPI process 0.
+ *
+ * \param rhs: `mixMPI *` pointer to the mpidata instance to use for the MPI communications.
+ */
+ GeometryConfiguration(const mixMPI *mpidata);
+
+ /*! \brief Broadcast over MPI the GeometryConfiguration instance from MPI process 0 to all others.
+ *
+ * When using MPI, the initial GeometryConfiguration instance created by MPI process 0
+ * needs to be replicated on all other processes. This function sends it using
+ * MPI broadcast calls. The MPI broadcast calls in this function must match those
+ * in the constructor using the mixMPI pointer.
+ *
+ * \param mpidata: `mixMPI *` Pointer to the mpi structure used to do the MPI broadcast.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
/*! \brief Destroy a GeometryConfiguration instance.
*/
~GeometryConfiguration();
@@ -258,6 +279,7 @@ public:
* \return scale: `double` The Z coordinate of the requested sphere.
*/
double get_sph_z(int index) { return _sph_z[index]; }
+
};
/**
@@ -415,6 +437,25 @@ public:
*/
ScattererConfiguration(const ScattererConfiguration& rhs);
+#ifdef MPI_VERSION
+ /*! \brief Build a scatterer configuration structure copying it via MPI from MPI process 0.
+ *
+ * \param rhs: `mixMPI *` pointer to the mpidata instance to use for the MPI communications.
+ */
+ ScattererConfiguration(const mixMPI *mpidata);
+
+ /*! \brief Broadcast over MPI the ScattererConfiguration instance from MPI process 0 to all others.
+ *
+ * When using MPI, the initial ScattererConfiguration instance created by MPI process 0
+ * needs to be replicated on all other processes. This function sends it using
+ * MPI broadcast calls. The MPI broadcast calls in this function must match those
+ * in the constructor using the mixMPI pointer.
+ *
+ * \param mpidata: `mixMPI *` Pointer to the mpi structure used to do the MPI broadcast.
+ */
+ void mpibcast(const mixMPI *mpidata);
+#endif
+
/*! \brief Destroy a scatterer configuration instance.
*/
~ScattererConfiguration();
@@ -574,6 +615,7 @@ public:
* \return result: `bool` True, if the two instances are equal, false otherwise.
*/
bool operator ==(const ScattererConfiguration &other);
+
};
#endif
diff --git a/src/include/TransitionMatrix.h b/src/include/TransitionMatrix.h
index 69feb35df610b0ce53659dec0a93dd57e1d4bb17..b5a093bb745c7f125652cecd2ce5261c26ec6ff4 100644
--- a/src/include/TransitionMatrix.h
+++ b/src/include/TransitionMatrix.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/algebraic.h b/src/include/algebraic.h
index bc53b05fd67fb68d55e7cfe90b7d2b9f03c2b2de..fe06bbaf2d8748673740f5669f0edf7795c48b5b 100644
--- a/src/include/algebraic.h
+++ b/src/include/algebraic.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/clu_subs.h b/src/include/clu_subs.h
index 295f3af088ab395bd8e2599a75703e24af3fce6b..3a94928ff5002170ddfa4447d7df74396c6c6fa8 100644
--- a/src/include/clu_subs.h
+++ b/src/include/clu_subs.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/lapack_calls.h b/src/include/lapack_calls.h
index 62bb4c392a2aba0ad64239bd72cba4fe996b2cd0..0abfd747d43da0a427c65c8ea7ad3376bcef4a0c 100644
--- a/src/include/lapack_calls.h
+++ b/src/include/lapack_calls.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/logging.h b/src/include/logging.h
index 166fc3f3dd1ad783a73129c72750e7142916ce13..31a89025da07520789bdfc1b83ca1da03e78e755 100644
--- a/src/include/logging.h
+++ b/src/include/logging.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/sph_subs.h b/src/include/sph_subs.h
index a5463847a175e9bfd9ef547c5da57fd024604207..4fef0bd5c8933c60ff5b2f9cced0b556899e71dd 100644
--- a/src/include/sph_subs.h
+++ b/src/include/sph_subs.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/tfrfme.h b/src/include/tfrfme.h
index 7dfbe2641f861ebab9a267e9ac2451cc09b2511d..d6ef0cbfde1232ec68184d592efa924649236fec 100644
--- a/src/include/tfrfme.h
+++ b/src/include/tfrfme.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/tra_subs.h b/src/include/tra_subs.h
index 003292d92a954f3542ef35a901fe6bac1c71f9b5..132d0fd8d16a595f54f47ffcf54cbc7b17f73640 100644
--- a/src/include/tra_subs.h
+++ b/src/include/tra_subs.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/include/types.h b/src/include/types.h
index 4bc6705b96697ac28dd1b06fd3c2363dbae85a12..4ed9a11c7f0b8a088ab1e22382eb427fdeb43cd4 100644
--- a/src/include/types.h
+++ b/src/include/types.h
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/Commons.cpp b/src/libnptm/Commons.cpp
index edf339501617b2576e66b34fbc75fdf15a3a0536..f6a1c46a93af496fda1eae00aeb3cbc492427a65 100644
--- a/src/libnptm/Commons.cpp
+++ b/src/libnptm/Commons.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -29,6 +29,10 @@
#include "../include/Commons.h"
#endif
+#ifdef USE_MPI
+#include <mpi.h>
+#endif
+
C1::C1(GeometryConfiguration *gconf, ScattererConfiguration *sconf) {
lm = gconf->l_max;
int li = gconf->li;
@@ -105,22 +109,25 @@ C1::C1(const C1& rhs) {
vec_rmi = new dcomplex[nsph * lm]();
vec_rei = new dcomplex[nsph * lm]();
+ for (long li=0; li<(nsph*lm); li++) {
+ vec_rmi[li] = rhs.vec_rmi[li];
+ vec_rei[li] = rhs.vec_rei[li];
+ }
rmi = new dcomplex*[lm];
rei = new dcomplex*[lm];
for (int ri = 0; ri < lm; ri++) {
rmi[ri] = &(vec_rmi[nsph * ri]);
rei[ri] = &(vec_rei[nsph * ri]);
- /*! Copy the contents from the template */
- for (int rj=0; rj<nsph; rj++) {
- rmi[ri][rj] = rhs.rmi[ri][rj];
- rei[ri][rj] = rhs.rei[ri][rj];
- }
+ /*! The contents were already copied via vec_rmi and vec_rei */
}
vec_w = new dcomplex[4 * nlmmt]();
+ for (long li=0; li<(4*nlmmt); li++) {
+ vec_w[li] = rhs.vec_w[li];
+ }
w = new dcomplex*[nlmmt];
for (int wi = 0; wi < nlmmt; wi++) {
w[wi] = &(vec_w[4 * wi]);
- for (int wj=0; wj<4; wj++) w[wi][wj] = rhs.w[wi][wj];
+ /*! The contents were already copied via vec_w */
}
configurations = rhs.configurations;
vint = new dcomplex[16]();
@@ -178,6 +185,117 @@ C1::C1(const C1& rhs) {
}
}
+#ifdef MPI_VERSION
+C1::C1(const mixMPI *mpidata) {
+ MPI_Bcast(&nlmmt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ vec_rmi = new dcomplex[nsph * lm]();
+ vec_rei = new dcomplex[nsph * lm]();
+ MPI_Bcast(vec_rmi, nsph*lm, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vec_rei, nsph*lm, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ rmi = new dcomplex*[lm];
+ rei = new dcomplex*[lm];
+ for (int ri = 0; ri < lm; ri++) {
+ rmi[ri] = &(vec_rmi[nsph * ri]);
+ rei[ri] = &(vec_rei[nsph * ri]);
+ /*! The contents were copied already via vec_rmi and vec_rei */
+ }
+ vec_w = new dcomplex[4 * nlmmt]();
+ MPI_Bcast(vec_w, 4*nlmmt, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ w = new dcomplex*[nlmmt];
+ for (int wi = 0; wi < nlmmt; wi++) {
+ w[wi] = &(vec_w[4 * wi]);
+ /*! The contents were copied already via vec_w */
+ }
+ MPI_Bcast(&configurations, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ vint = new dcomplex[16]();
+ MPI_Bcast(vint, 16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ vec_vints = new dcomplex[nsph * 16]();
+ MPI_Bcast(vec_vints, nsph*16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ vints = new dcomplex*[nsph];
+ rc = new double*[nsph];
+ nshl = new int[nsph]();
+ MPI_Bcast(nshl, nsph, MPI_INT, 0, MPI_COMM_WORLD);
+ iog = new int[nsph]();
+ MPI_Bcast(iog, nsph, MPI_INT, 0, MPI_COMM_WORLD);
+ for (int vi = 0; vi < nsph; vi++) {
+ vints[vi] = &(vec_vints[16 * vi]);
+ // The contents were copied already via vec_vints
+ }
+ for (int ri=0; ri<configurations; ri++) {
+ rc[ri] = new double[nshl[ri]]();
+ MPI_Bcast(rc[ri], nshl[ri], MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ fsas = new dcomplex[nsph]();
+ sscs = new double[nsph]();
+ sexs = new double[nsph]();
+ sabs = new double[nsph]();
+ sqscs = new double[nsph]();
+ sqexs = new double[nsph]();
+ sqabs = new double[nsph]();
+ gcsv = new double[nsph]();
+ rxx = new double[nsph]();
+ ryy = new double[nsph]();
+ rzz = new double[nsph]();
+ ros = new double[nsph]();
+ MPI_Bcast(fsas, nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sscs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sexs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sabs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sqscs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sqexs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sqabs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gcsv, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(rxx, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ryy, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(rzz, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ros, configurations, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ sas = new dcomplex**[nsph];
+ for (int si = 0; si < nsph; si++) {
+ sas[si] = new dcomplex*[2];
+ for (int sj=0; sj<2; sj++) {
+ sas[si][sj] = new dcomplex[2]();
+ MPI_Bcast(sas[si][sj], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ }
+}
+
+void C1::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&nlmmt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vec_rmi, nsph*lm, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vec_rei, nsph*lm, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vec_w, 4*nlmmt, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&configurations, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vint, 16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vec_vints, nsph*16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(nshl, nsph, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(iog, nsph, MPI_INT, 0, MPI_COMM_WORLD);
+ for (int ri=0; ri<configurations; ri++) {
+ MPI_Bcast(rc[ri], nshl[ri], MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(fsas, nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sscs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sexs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sabs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sqscs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sqexs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sqabs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gcsv, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(rxx, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ryy, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(rzz, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ros, configurations, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int si = 0; si < nsph; si++) {
+ for (int sj=0; sj<2; sj++) {
+ MPI_Bcast(sas[si][sj], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ }
+}
+#endif
+
C1::~C1() {
delete[] vec_rmi;
delete[] vec_rei;
@@ -371,6 +489,122 @@ C1_AddOns::~C1_AddOns() {
delete[] ecsc;
}
+#ifdef MPI_VERSION
+C1_AddOns::C1_AddOns(const mixMPI *mpidata) {
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlemt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&litpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&litpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nv3j, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ int vhsize=(nsph * nsph - 1) * litpo;
+ vh = new dcomplex[vhsize]();
+ MPI_Bcast(vh, vhsize, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ int vj0size=nsph * lmtpo;
+ vj0 = new dcomplex[vj0size]();
+ MPI_Bcast(vj0, vj0size, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ vj = new dcomplex[1](); // QUESTION: is 1 really enough for a general case?
+ MPI_Bcast(vj, 1, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ int vyhjsize=(nsph * nsph - 1) * litpos;
+ vyhj = new dcomplex[vyhjsize]();
+ MPI_Bcast(vyhj, vyhjsize, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ int vyj0size = nsph * lmtpos;
+ vyj0 = new dcomplex[vyj0size]();
+ MPI_Bcast(vyj0, vyj0size, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ am0v = new dcomplex[nlemt * nlemt]();
+ am0m = new dcomplex*[nlemt];
+ MPI_Bcast(am0v, nlemt*nlemt, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ for (int ai = 0; ai < nlemt; ai++) {
+ am0m[ai] = (am0v + nlemt * ai);
+ }
+ vintm = new dcomplex[16]();
+ vintt = new dcomplex[16]();
+ MPI_Bcast(vintm, 16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vintt, 16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ fsac = new dcomplex*[2];
+ sac = new dcomplex*[2];
+ fsacm = new dcomplex*[2];
+ for (int fi = 0; fi < 2; fi++) {
+ fsac[fi] = new dcomplex[2]();
+ sac[fi] = new dcomplex[2]();
+ fsacm[fi] = new dcomplex[2]();
+ MPI_Bcast(fsac[fi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sac[fi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(fsacm[fi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ scscp = new dcomplex[2]();
+ ecscp = new dcomplex[2]();
+ scscpm = new dcomplex[2]();
+ ecscpm = new dcomplex[2]();
+ MPI_Bcast(scscp, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecscp, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(scscpm, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecscpm, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ v3j0 = new double[nv3j]();
+ MPI_Bcast(v3j0, nv3j, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ ind3j = new int*[lmpo];
+ for (int ii = 0; ii < lmpo; ii++) {
+ ind3j[ii] = new int[lm]();
+ MPI_Bcast(ind3j[ii], lm, MPI_INT, 0, MPI_COMM_WORLD);
+ }
+ sscs = new double[nsph]();
+ MPI_Bcast(sscs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ ecscm = new double[2]();
+ scscm = new double[2]();
+ scsc = new double[2]();
+ ecsc = new double[2]();
+ MPI_Bcast(ecscm, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(scscm, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(scsc, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecsc, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+
+void C1_AddOns::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlemt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&litpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&litpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nv3j, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ int vhsize=(nsph * nsph - 1) * litpo;
+ MPI_Bcast(vh, vhsize, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ int vj0size=nsph * lmtpo;
+ MPI_Bcast(vj0, vj0size, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vj, 1, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ int vyhjsize=(nsph * nsph - 1) * litpos;
+ MPI_Bcast(vyhj, vyhjsize, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ int vyj0size = nsph * lmtpos;
+ MPI_Bcast(vyj0, vyj0size, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(am0v, nlemt*nlemt, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vintm, 16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vintt, 16, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ for (int fi = 0; fi < 2; fi++) {
+ MPI_Bcast(fsac[fi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(sac[fi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(fsacm[fi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(scscp, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecscp, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(scscpm, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecscpm, 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(v3j0, nv3j, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int ii = 0; ii < lmpo; ii++) {
+ MPI_Bcast(ind3j[ii], lm, MPI_INT, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(sscs, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecscm, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(scscm, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(scsc, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ecsc, 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+#endif
+
C2::C2(GeometryConfiguration *gconf, ScattererConfiguration *sconf) {
nsph = gconf->number_of_spheres;
int npnt = gconf->npnt;
@@ -414,6 +648,35 @@ C2::~C2() {
delete[] vsz;
}
+#ifdef MPI_VERSION
+C2::C2(const mixMPI *mpidata) {
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nhspo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nl, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ ris = new dcomplex[nhspo]();
+ dlri = new dcomplex[nhspo]();
+ MPI_Bcast(ris, nhspo, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(dlri, nhspo, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ vkt = new dcomplex[nsph]();
+ vsz = new double[nsph]();
+ MPI_Bcast(vkt, nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vsz, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ dc0 = new dcomplex[nl]();
+ MPI_Bcast(dc0, nl, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+}
+
+void C2::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nhspo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nl, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ris, nhspo, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(dlri, nhspo, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vkt, nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(vsz, nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(dc0, nl, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+}
+#endif
+
C3::C3() {
tsas = new dcomplex*[2];
tsas[0] = new dcomplex[2];
@@ -444,6 +707,32 @@ C3::~C3() {
delete[] tsas;
}
+#ifdef MPI_VERSION
+C3::C3(const mixMPI *mpidata) {
+ tsas = new dcomplex*[2];
+ for (int ti=0; ti<2; ti++) {
+ tsas[ti] = new dcomplex[2];
+ MPI_Bcast(tsas[ti], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(&tfsas, 1, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&gcs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&scs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&ecs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&acs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+
+void C3::mpibcast(const mixMPI *mpidata) {
+ for (int ti=0; ti<2; ti++) {
+ MPI_Bcast(tsas[ti], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(&tfsas, 1, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&gcs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&scs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&ecs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&acs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+#endif
+
C4::C4(GeometryConfiguration *gconf) {
li = gconf->li;
le = gconf->le;
@@ -479,6 +768,40 @@ C4::C4(const C4& rhs) {
C4::~C4() {
}
+#ifdef MPI_VERSION
+C4::C4(const mixMPI *mpidata) {
+ MPI_Bcast(&li, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&le, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nv3j, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ // The following is needed to initialize C1_AddOns
+ MPI_Bcast(&litpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&litpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlim, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlem, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+}
+
+void C4::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&li, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&le, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nv3j, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nsph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ // The following is needed to initialize C1_AddOns
+ MPI_Bcast(&litpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&litpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmtpos, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlim, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlem, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&lmpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+}
+#endif
+
C6::C6(int _lmtpo) {
lmtpo = _lmtpo;
rac3j = new double[lmtpo]();
@@ -494,6 +817,19 @@ C6::~C6() {
delete[] rac3j;
}
+#ifdef MPI_VERSION
+C6::C6(const mixMPI *mpidata) {
+ MPI_Bcast(&lmtpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ rac3j = new double[lmtpo]();
+ MPI_Bcast(rac3j, lmtpo, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+
+void C6::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&lmtpo, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(rac3j, lmtpo, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+#endif
+
C9::C9(int ndi, int _nlem, int ndit, int _nlemt) {
gis_size_0 = ndi;
sam_size_0 = ndit;
@@ -542,7 +878,68 @@ C9::~C9() {
delete[] sam;
}
-ClusterIterationData::ClusterIterationData(GeometryConfiguration *gconf, ScattererConfiguration *sconf) {
+#ifdef MPI_VERSION
+C9::C9(const mixMPI *mpidata) {
+ MPI_Bcast(&gis_size_0, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sam_size_0, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlem, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlemt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ gis = new dcomplex*[gis_size_0];
+ gls = new dcomplex*[gis_size_0];
+ for (int gi = 0; gi < gis_size_0; gi++) {
+ gis[gi] = new dcomplex[nlem]();
+ gls[gi] = new dcomplex[nlem]();
+ MPI_Bcast(gis[gi], nlem, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gls[gi], nlem, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ sam = new dcomplex*[sam_size_0];
+ for (int si = 0; si < sam_size_0; si++) {
+ sam[si] = new dcomplex[nlemt]();
+ MPI_Bcast(sam[si], nlemt, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+}
+
+void C9::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&gis_size_0, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sam_size_0, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlem, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&nlemt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ for (int gi = 0; gi < gis_size_0; gi++) {
+ MPI_Bcast(gis[gi], nlem, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gls[gi], nlem, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ for (int si = 0; si < sam_size_0; si++) {
+ MPI_Bcast(sam[si], nlemt, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+}
+#endif
+
+mixMPI::mixMPI() {
+ mpirunning = 0;
+ rank = 0;
+ nprocs = 1;
+}
+
+#ifdef MPI_VERSION
+mixMPI::mixMPI(MPI_Comm comm){
+ mpirunning = 1;
+ int ierr;
+ // we should add some meaningful error checking and management here
+ ierr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+ ierr = MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
+}
+#endif
+
+mixMPI::mixMPI(const mixMPI& rhs) {
+ mpirunning = rhs.mpirunning;
+ rank = rhs.rank;
+ nprocs = rhs.nprocs;
+}
+
+mixMPI::~mixMPI() {
+}
+
+ClusterIterationData::ClusterIterationData(GeometryConfiguration *gconf, ScattererConfiguration *sconf, const mixMPI *mpidata) {
c1 = new C1(gconf, sconf);
c2 = new C2(gconf, sconf);
c3 = new C3();
@@ -636,6 +1033,11 @@ ClusterIterationData::ClusterIterationData(GeometryConfiguration *gconf, Scatter
xip = sconf->xip;
sqsfi = 1.0;
vk = 0.0;
+ number_of_scales = sconf->number_of_scales;
+ xiblock = (int) ceil(((double) (sconf->number_of_scales-1))/((double) mpidata->nprocs));
+ lastxi = ((mpidata->rank+1) * xiblock)+1;
+ firstxi = lastxi-xiblock+1;
+ if (lastxi > sconf->number_of_scales) lastxi = sconf->number_of_scales;
}
ClusterIterationData::ClusterIterationData(const ClusterIterationData& rhs) {
@@ -780,8 +1182,220 @@ ClusterIterationData::ClusterIterationData(const ClusterIterationData& rhs) {
xip = rhs.xip;
sqsfi = rhs.sqsfi;
vk = rhs.vk;
+ firstxi = rhs.firstxi;
+ lastxi = rhs.lastxi;
}
+#ifdef MPI_VERSION
+ClusterIterationData::ClusterIterationData(const mixMPI *mpidata) {
+ c1 = new C1(mpidata);
+ c2 = new C2(mpidata);
+ c3 = new C3(mpidata);
+ c4 = new C4(mpidata);
+ c1ao = new C1_AddOns(mpidata);
+ c6 = new C6(mpidata);
+ const int ndi = c4->nsph * c4->nlim;
+ const np_int ndit = 2 * ndi;
+ c9 = new C9(mpidata);
+ gaps = new double[c4->nsph]();
+ MPI_Bcast(gaps, c4->nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ tqev = new double[3]();
+ tqsv = new double[3]();
+ MPI_Bcast(tqev, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqsv, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ tqse = new double*[2];
+ tqspe = new dcomplex*[2];
+ tqss = new double*[2];
+ tqsps = new dcomplex*[2];
+ tqce = new double*[2];
+ tqcpe = new dcomplex*[2];
+ tqcs = new double*[2];
+ tqcps = new dcomplex*[2];
+ for (int ti = 0; ti < 2; ti++) {
+ tqse[ti] = new double[c4->nsph]();
+ tqspe[ti] = new dcomplex[c4->nsph]();
+ tqss[ti] = new double[c4->nsph]();
+ tqsps[ti] = new dcomplex[c4->nsph]();
+ MPI_Bcast(tqse[ti], c4->nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqspe[ti], c4->nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqss[ti], c4->nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqsps[ti], c4->nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ tqce[ti] = new double[3]();
+ tqcpe[ti] = new dcomplex[3]();
+ tqcs[ti] = new double[3]();
+ tqcps[ti] = new dcomplex[3]();
+ MPI_Bcast(tqce[ti], 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqcpe[ti], 3, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqcs[ti], 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqcps[ti], 3, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ gapv = new double[3]();
+ gapp = new dcomplex*[3];
+ gappm = new dcomplex*[3];
+ gap = new double*[3];
+ gapm = new double*[3];
+ MPI_Bcast(gapv, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int gi = 0; gi < 3; gi++) {
+ gapp[gi] = new dcomplex[2]();
+ gappm[gi] = new dcomplex[2]();
+ gap[gi] = new double[2]();
+ gapm[gi] = new double[2]();
+ MPI_Bcast(gapp[gi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gappm[gi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gap[gi], 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gapm[gi], 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ u = new double[3]();
+ us = new double[3]();
+ un = new double[3]();
+ uns = new double[3]();
+ up = new double[3]();
+ ups = new double[3]();
+ unmp = new double[3]();
+ unsmp = new double[3]();
+ upmp = new double[3]();
+ upsmp = new double[3]();
+ duk = new double[3]();
+ MPI_Bcast(u, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(us, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(un, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(uns, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(up, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ups, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(unmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(unsmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(upmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(upsmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(duk, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ argi = new double[1]();
+ args = new double[1]();
+ MPI_Bcast(argi, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(args, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ cextlr = new double*[4];
+ cext = new double*[4];
+ cmullr = new double*[4];;
+ cmul = new double*[4];
+ for (int ci = 0; ci < 4; ci++) {
+ cextlr[ci] = new double[4]();
+ cext[ci] = new double[4]();
+ cmullr[ci] = new double[4]();
+ cmul[ci] = new double[4]();
+ MPI_Bcast(cextlr[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(cext[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(cmullr[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(cmul[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ zpv = new double***[c4->lm];
+ for (int zi = 0; zi < c4->lm; zi++) {
+ zpv[zi] = new double**[3];
+ for (int zj = 0; zj < 3; zj++) {
+ zpv[zi][zj] = new double*[2];
+ for (int zk = 0; zk < 2; zk++) {
+ zpv[zi][zj][zk] = new double[2]();
+ MPI_Bcast(zpv[zi][zj][zk], 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ }
+ }
+ am_vector = new dcomplex[ndit * ndit]();
+ am = new dcomplex*[ndit];
+ for (np_int ai = 0; ai < ndit; ai++) {
+ am[ai] = (am_vector + ai * ndit);
+ MPI_Bcast(am[ai], ndit, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(&arg, 1, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&scan, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&cfmp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sfmp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&cfsp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sfsp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&qsfi, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&wn, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&xip, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sqsfi, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&vk, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&xiblock, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&number_of_scales, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ lastxi = ((mpidata->rank+1) * xiblock)+1;
+ firstxi = lastxi-xiblock+1;
+ if (lastxi > number_of_scales) lastxi = number_of_scales;
+}
+
+void ClusterIterationData::mpibcast(const mixMPI *mpidata) {
+ c1->mpibcast(mpidata);
+ c2->mpibcast(mpidata);
+ c3->mpibcast(mpidata);
+ c4->mpibcast(mpidata);
+ c1ao->mpibcast(mpidata);
+ c6->mpibcast(mpidata);
+ const int ndi = c4->nsph * c4->nlim;
+ const np_int ndit = 2 * ndi;
+ c9->mpibcast(mpidata);
+ MPI_Bcast(gaps, c4->nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqev, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqsv, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int ti = 0; ti < 2; ti++) {
+ MPI_Bcast(tqse[ti], c4->nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqspe[ti], c4->nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqss[ti], c4->nsph, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqsps[ti], c4->nsph, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqce[ti], 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqcpe[ti], 3, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqcs[ti], 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(tqcps[ti], 3, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(gapv, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int gi = 0; gi < 3; gi++) {
+ MPI_Bcast(gapp[gi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gappm[gi], 2, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gap[gi], 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(gapm[gi], 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(u, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(us, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(un, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(uns, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(up, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(ups, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(unmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(unsmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(upmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(upsmp, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(duk, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(argi, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(args, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int ci = 0; ci < 4; ci++) {
+ MPI_Bcast(cextlr[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(cext[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(cmullr[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(cmul[ci], 4, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ for (int zi = 0; zi < c4->lm; zi++) {
+ for (int zj = 0; zj < 3; zj++) {
+ for (int zk = 0; zk < 2; zk++) {
+ MPI_Bcast(zpv[zi][zj][zk], 2, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ }
+ }
+ }
+ // since MPI expects an int argument for the number of elements to transfer in one go, transfer am one row at a time
+ for (int ai = 0; ai < ndit; ai++) {
+ MPI_Bcast(am[ai], ndit, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ MPI_Bcast(&arg, 1, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&scan, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&cfmp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sfmp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&cfsp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sfsp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&qsfi, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&wn, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&xip, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&sqsfi, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&vk, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&xiblock, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&number_of_scales, 1, MPI_INT, 0, MPI_COMM_WORLD);
+}
+#endif
+
ClusterIterationData::~ClusterIterationData() {
const int nsph = c4->nsph;
delete[] am_vector;
@@ -925,3 +1539,51 @@ ScatteringAngles::ScatteringAngles(const ScatteringAngles &rhs) {
_nks = rhs._nks;
_nkks = rhs._nkks;
}
+
+#ifdef MPI_VERSION
+ScatteringAngles::ScatteringAngles(const mixMPI *mpidata) {
+ MPI_Bcast(&_th, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thlst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_ths, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thsstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thslst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_ph, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phlst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phsstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phslst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nth, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nths, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nphs, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thsca, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nk, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nks, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nkks, 1, MPI_INT, 0, MPI_COMM_WORLD);
+}
+
+void ScatteringAngles::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&_th, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thlst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_ths, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thsstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thslst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_ph, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phlst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phs, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phsstp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_phslst, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nth, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nph, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nths, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nphs, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_thsca, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nk, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nks, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_nkks, 1, MPI_INT, 0, MPI_COMM_WORLD);
+}
+#endif
diff --git a/src/libnptm/Configuration.cpp b/src/libnptm/Configuration.cpp
index b07ca284e2e261e39cb36581d04fd27cad36334a..3aaa1bb425cd31b01583dccaf50a196d0cc544fb 100644
--- a/src/libnptm/Configuration.cpp
+++ b/src/libnptm/Configuration.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -25,6 +25,12 @@
#include <hdf5.h>
#include <regex>
#include <string>
+#include <string.h>
+#ifdef USE_MPI
+#ifndef MPI_VERSION
+#include <mpi.h>
+#endif
+#endif
#ifndef INCLUDE_TYPES_H_
#include "../include/types.h"
@@ -46,6 +52,10 @@
#include "../include/Configuration.h"
#endif
+#ifndef INCLUDE_COMMONS_H
+#include "../include/Commons.h"
+#endif
+
#ifndef INCLUDE_FILE_IO_H_
#include "../include/file_io.h"
#endif
@@ -61,7 +71,7 @@ GeometryConfiguration::GeometryConfiguration(
double in_ph_start, double in_ph_step, double in_ph_end,
double sc_ph_start, double sc_ph_step, double sc_ph_end,
int jwtm
-) {
+ ) {
_number_of_spheres = nsph;
_l_max = lm;
_in_pol = in_pol;
@@ -125,6 +135,73 @@ GeometryConfiguration::GeometryConfiguration(const GeometryConfiguration& rhs)
}
}
+#ifdef MPI_VERSION
+GeometryConfiguration::GeometryConfiguration(const mixMPI *mpidata) {
+ MPI_Bcast(&_number_of_spheres, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_l_max, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_pol, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_npnt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_npntts, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_isam, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_li, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_le, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ // I have to jump through some hoops because the size of np_int is not fixed a priori
+ char *byte_mxndm = (char *) &_mxndm;
+ MPI_Bcast(byte_mxndm, sizeof(np_int), MPI_BYTE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_iavm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_theta_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_theta_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_theta_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_phi_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_phi_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_phi_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_theta_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_theta_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_theta_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_phi_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_phi_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_phi_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_jwtm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ _sph_x = new double[_number_of_spheres]();
+ _sph_y = new double[_number_of_spheres]();
+ _sph_z = new double[_number_of_spheres]();
+ MPI_Bcast(_sph_x, _number_of_spheres, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_sph_y, _number_of_spheres, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_sph_z, _number_of_spheres, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+
+void GeometryConfiguration::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&_number_of_spheres, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_l_max, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_pol, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_npnt, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_npntts, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_isam, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_li, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_le, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ // I have to jump through some hoops because the size of np_int is not fixed a priori
+ char *byte_mxndm = (char *) &_mxndm;
+ MPI_Bcast(byte_mxndm, sizeof(np_int), MPI_BYTE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_iavm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_theta_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_theta_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_theta_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_phi_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_phi_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_in_phi_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_theta_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_theta_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_theta_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_phi_start, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_phi_step, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_sc_phi_end, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_jwtm, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_sph_x, _number_of_spheres, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_sph_y, _number_of_spheres, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_sph_z, _number_of_spheres, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+}
+#endif
+
GeometryConfiguration::~GeometryConfiguration() {
delete[] _sph_x;
delete[] _sph_y;
@@ -242,7 +319,7 @@ GeometryConfiguration* GeometryConfiguration::from_legacy(const std::string& fil
in_ph_start, in_ph_step, in_ph_end,
sc_ph_start, sc_ph_step, sc_ph_end,
fjwtm
- );
+ );
delete[] file_lines;
return conf;
}
@@ -263,7 +340,7 @@ ScattererConfiguration::ScattererConfiguration(
double ex,
double w,
double x
-) {
+ ) {
_number_of_spheres = nsph;
_configurations = configs;
_number_of_scales = nxi;
@@ -294,7 +371,7 @@ ScattererConfiguration::ScattererConfiguration(
}
}
}
-
+
ScattererConfiguration::ScattererConfiguration(const ScattererConfiguration& rhs)
{
_number_of_spheres = rhs._number_of_spheres;
@@ -330,6 +407,77 @@ ScattererConfiguration::ScattererConfiguration(const ScattererConfiguration& rhs
}
}
+#ifdef MPI_VERSION
+ScattererConfiguration::ScattererConfiguration(const mixMPI *mpidata)
+{
+ MPI_Bcast(&_number_of_spheres, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_configurations, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_number_of_scales, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ int itemp;
+ MPI_Bcast(&itemp, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ char *ctemp = new char[itemp];
+ MPI_Bcast(ctemp, itemp, MPI_CHAR, 0, MPI_COMM_WORLD);
+ _reference_variable_name = ctemp;
+ delete[] ctemp;
+ MPI_Bcast(&_idfc, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ itemp = sizeof(bool);
+ char *ptemp = (char *) &_use_external_sphere;
+ MPI_Bcast(ptemp, itemp, MPI_CHAR, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_exdc, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_wp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_xip, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ _iog_vec = new int[_number_of_spheres]();
+ MPI_Bcast(_iog_vec, _number_of_spheres, MPI_INT, 0, MPI_COMM_WORLD);
+ _radii_of_spheres = new double[_number_of_spheres]();
+ MPI_Bcast(_radii_of_spheres, _configurations, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ _nshl_vec = new int[_configurations]();
+ MPI_Bcast(_nshl_vec, _configurations, MPI_INT, 0, MPI_COMM_WORLD);
+ _rcf = new double*[_configurations];
+ _scale_vec = new double[_number_of_scales]();
+ _dc0_matrix = new dcomplex**[_configurations];
+ MPI_Bcast(_scale_vec, _number_of_scales, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ int dim3 = (_idfc == 0) ? _number_of_scales : 1;
+ for (int si = 0; si < _configurations; si++) {
+ _rcf[si] = new double[_nshl_vec[si]]();
+ MPI_Bcast(_rcf[si], _nshl_vec[si], MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ _dc0_matrix[si] = new dcomplex*[_number_of_spheres];
+ for (int sj = 0; sj < _number_of_spheres; sj++) {
+ _dc0_matrix[si][sj] = new dcomplex[dim3]();
+ MPI_Bcast(_dc0_matrix[si][sj], dim3, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ }
+}
+
+void ScattererConfiguration::mpibcast(const mixMPI *mpidata) {
+ MPI_Bcast(&_number_of_spheres, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_configurations, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_number_of_scales, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ int itemp = _reference_variable_name.length()+1;
+ MPI_Bcast(&itemp, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ char *ctemp = strdup(_reference_variable_name.c_str());
+ MPI_Bcast(ctemp, itemp, MPI_CHAR, 0, MPI_COMM_WORLD);
+ delete[] ctemp;
+ MPI_Bcast(&_idfc, 1, MPI_INT, 0, MPI_COMM_WORLD);
+ itemp = sizeof(bool);
+ char *ptemp = (char *) &_use_external_sphere;
+ MPI_Bcast(ptemp, itemp, MPI_CHAR, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_exdc, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_wp, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(&_xip, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_iog_vec, _number_of_spheres, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_radii_of_spheres, _configurations, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_nshl_vec, _configurations, MPI_INT, 0, MPI_COMM_WORLD);
+ MPI_Bcast(_scale_vec, _number_of_scales, MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ int dim3 = (_idfc == 0) ? _number_of_scales : 1;
+ for (int si = 0; si < _configurations; si++) {
+ MPI_Bcast(_rcf[si], _nshl_vec[si], MPI_DOUBLE, 0, MPI_COMM_WORLD);
+ for (int sj = 0; sj < _number_of_spheres; sj++) {
+ MPI_Bcast(_dc0_matrix[si][sj], dim3, MPI_C_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD);
+ }
+ }
+}
+#endif
+
ScattererConfiguration::~ScattererConfiguration() {
for (int i = 0; i < _configurations; i++) {
for (int j = 0; j < _number_of_spheres; j++) {
@@ -618,7 +766,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(const std::string& de
fexdc,
fwp,
fxip
- );
+ );
delete[] file_lines;
delete[] variable_vector;
return config;
@@ -676,7 +824,7 @@ ScattererConfiguration* ScattererConfiguration::from_hdf5(const std::string& fil
str_name = "XIVEC";
str_type = "FLOAT64_(" + to_string(nxi) + ")";
status = hdf_file->read(str_name, str_type, xi_vec);
-
+
int dim3 = (_idfc == 0) ? nxi : 1;
int element_size = 2 * dim3 * nsph * configuration_count;
double *elements = new double[element_size]();
@@ -715,7 +863,7 @@ ScattererConfiguration* ScattererConfiguration::from_hdf5(const std::string& fil
_exdc,
_wp,
_xip
- );
+ );
}
return conf;
@@ -804,12 +952,12 @@ ScattererConfiguration* ScattererConfiguration::from_legacy(const std::string& f
_exdc,
_wp,
_xip
- );
+ );
return conf;
}
/*
-double ScattererConfiguration::get_param(const std::string& param_name) {
+ double ScattererConfiguration::get_param(const std::string& param_name) {
double value;
if (param_name.compare("number_of_spheres") == 0) value = (double)number_of_spheres;
else if (param_name.compare("nsph") == 0) value = (double)number_of_spheres;
@@ -821,11 +969,11 @@ double ScattererConfiguration::get_param(const std::string& param_name) {
else if (param_name.compare("wp") == 0) value = wp;
else if (param_name.compare("xip") == 0) value = xip;
else {
- string message = "unrecognized parameter \"" + param_name + "\"";
- throw UnrecognizedParameterException(message);
+ string message = "unrecognized parameter \"" + param_name + "\"";
+ throw UnrecognizedParameterException(message);
}
return value;
-}
+ }
*/
void ScattererConfiguration::print() {
@@ -973,7 +1121,7 @@ void ScattererConfiguration::write_hdf5(const std::string& file_name) {
for (int ri = 0; ri < rec_num; ri++)
hdf_file->write(rec_names[ri], rec_types[ri], rec_pointers[ri]);
hdf_file->close();
-
+
// Clean memory
delete rec_name_list;
delete rec_type_list;
@@ -1070,7 +1218,7 @@ void ScattererConfiguration::write_formatted(const std::string& file_name) {
wl_vec[i],
pu_vec[i],
ev_vec[i]
- );
+ );
}
break;
case 1:
@@ -1090,7 +1238,7 @@ void ScattererConfiguration::write_formatted(const std::string& file_name) {
pu_vec[i],
ev_vec[i],
xi_vec[i]
- );
+ );
}
break;
case 2:
@@ -1110,7 +1258,7 @@ void ScattererConfiguration::write_formatted(const std::string& file_name) {
pu_vec[i],
ev_vec[i],
xi_vec[i]
- );
+ );
}
break;
case 3:
@@ -1130,7 +1278,7 @@ void ScattererConfiguration::write_formatted(const std::string& file_name) {
wl_vec[i],
ev_vec[i],
xi_vec[i]
- );
+ );
}
break;
case 4:
@@ -1150,7 +1298,7 @@ void ScattererConfiguration::write_formatted(const std::string& file_name) {
wl_vec[i],
pu_vec[i],
xi_vec[i]
- );
+ );
}
break;
default:
@@ -1269,3 +1417,4 @@ bool ScattererConfiguration::operator ==(const ScattererConfiguration &other) {
} // ri loop
return true;
}
+
diff --git a/src/libnptm/TransitionMatrix.cpp b/src/libnptm/TransitionMatrix.cpp
index 1c665bc21e3f64ce4c6d41aa465a517383bfc751..12d0671dcb4defd0db86f1bdf5314d35be4d57b9 100644
--- a/src/libnptm/TransitionMatrix.cpp
+++ b/src/libnptm/TransitionMatrix.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/algebraic.cpp b/src/libnptm/algebraic.cpp
index b73442c3bb3031b634742ec0db2e4d4860158270..53b7dec9d6904e01de8c600c725e0ea3c90475ba 100644
--- a/src/libnptm/algebraic.cpp
+++ b/src/libnptm/algebraic.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/clu_subs.cpp b/src/libnptm/clu_subs.cpp
index ac6fc233d892ff393de70d47df3e3660a3dc65fa..5a7e3db5c1b79121277e112d3e3a25feb0fd7d52 100644
--- a/src/libnptm/clu_subs.cpp
+++ b/src/libnptm/clu_subs.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/lapack_calls.cpp b/src/libnptm/lapack_calls.cpp
index 0e101d502c03b1fe8cfd80b8345fddb30105ec5f..a9e39cd549eabe9cb8c18ab85a89743b758bc867 100644
--- a/src/libnptm/lapack_calls.cpp
+++ b/src/libnptm/lapack_calls.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/logging.cpp b/src/libnptm/logging.cpp
index cc6bf41c2f73e8c0860e805a3148ac2f0b96d399..2f7526e58f6da76787b3bf4a0d4789597f428d21 100644
--- a/src/libnptm/logging.cpp
+++ b/src/libnptm/logging.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -39,56 +39,44 @@ Logger::~Logger() {
}
void Logger::err(const std::string& message) {
-#pragma omp critical
- {
- fprintf(err_output, "%s", message.c_str());
- fflush(err_output);
- }
+ fprintf(err_output, "%s", message.c_str());
+ fflush(err_output);
}
void Logger::flush(int level) {
-#pragma omp critical
- {
- string summary = "\"" + *last_message + "\" issued " + to_string(repetitions);
- if (repetitions == 1) summary += " time.\n";
- else summary += " times.\n";
- if (level == LOG_ERRO) err(summary);
- else {
- if (level >= log_threshold) {
- fprintf(log_output, "%s", summary.c_str());
- fflush(log_output);
- }
+ string summary = "\"" + *last_message + "\" issued " + to_string(repetitions);
+ if (repetitions == 1) summary += " time.\n";
+ else summary += " times.\n";
+ if (level == LOG_ERRO) err(summary);
+ else {
+ if (level >= log_threshold) {
+ fprintf(log_output, "%s", summary.c_str());
+ fflush(log_output);
}
- delete last_message;
- last_message = new string("");
- repetitions = 0;
}
+ delete last_message;
+ last_message = new string("");
+ repetitions = 0;
}
void Logger::log(const std::string& message, int level) {
if (level == LOG_ERRO) err(message);
else {
if (level >= log_threshold) {
-#pragma omp critical
- {
- fprintf(log_output, "%s", message.c_str());
- fflush(log_output);
- }
+ fprintf(log_output, "%s", message.c_str());
+ fflush(log_output);
}
}
}
void Logger::push(const std::string& message) {
-#pragma omp critical
- {
- if (repetitions > 0) {
- if (message.compare(*last_message) != 0) {
- flush(LOG_DEBG);
- }
+ if (repetitions > 0) {
+ if (message.compare(*last_message) != 0) {
+ flush(LOG_DEBG);
}
- log(message, LOG_DEBG);
- delete last_message;
- last_message = new string(message);
- repetitions++;
}
+ log(message, LOG_DEBG);
+ delete last_message;
+ last_message = new string(message);
+ repetitions++;
}
diff --git a/src/libnptm/sph_subs.cpp b/src/libnptm/sph_subs.cpp
index 3d25f8c8a89ba02d29b992752b3694b1331d8e1e..208f4bd3d4013c5a6ee44f811ab94164912be4d4 100644
--- a/src/libnptm/sph_subs.cpp
+++ b/src/libnptm/sph_subs.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/tfrfme.cpp b/src/libnptm/tfrfme.cpp
index 52ef1b15f9af2fb82677a53cc3f1ad195f66a150..b0216522c549b4418caa1391c5f845b4953ec34b 100644
--- a/src/libnptm/tfrfme.cpp
+++ b/src/libnptm/tfrfme.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/tra_subs.cpp b/src/libnptm/tra_subs.cpp
index 1252fb2fdb5473d65402fc855594aceeb63280f2..b952d467f68ffec75bbaaddbfa2df6a4ad2bd8db 100644
--- a/src/libnptm/tra_subs.cpp
+++ b/src/libnptm/tra_subs.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/libnptm/types.cpp b/src/libnptm/types.cpp
index 0b8c6d2dc33f383ea1e509e439cd090eb69250bd..2f17bc9627125eae563ffea7131f381ed5b80083 100644
--- a/src/libnptm/types.cpp
+++ b/src/libnptm/types.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/make.inc b/src/make.inc
index 60089ea8a2f0284515c3f5aa8072f50a9225e98a..d7c5dd4df07e646dc584081f6e0a029f7d3b69fb 100644
--- a/src/make.inc
+++ b/src/make.inc
@@ -30,8 +30,16 @@ endif
# CXX defines the default C++ compiler to use. If undefined, GNU Make tries to use g++
ifndef CXX
+ifdef USE_MPI
+override CXX=mpicxx
+else
override CXX=g++
endif
+endif
+
+ifdef USE_MPI
+override MPI_CXXFLAGS+=-DUSE_MPI
+endif
# HDF5_INCLUDE defines the default path to the HDF5 include files to use
ifndef HDF5_INCLUDE
@@ -79,7 +87,7 @@ endif
# CXXFLAGS defines the default compilation options for the C++ compiler
ifndef CXXFLAGS
-override CXXFLAGS=-O3 -ggdb -pg -coverage -I$(HDF5_INCLUDE)
+override CXXFLAGS=-O3 -ggdb -pg -coverage -I$(HDF5_INCLUDE) $(MPI_CXXFLAGS)
ifdef USE_OPENMP
override CXXFLAGS+= -fopenmp
# closes USE_OPENMP
diff --git a/src/scripts/README.md b/src/scripts/README.md
index 487d9db031e41e8c83676eab40f6ba9ebae0ac86..de3fead8ccbe0ec983758d66a2742f14cc3625a3 100644
--- a/src/scripts/README.md
+++ b/src/scripts/README.md
@@ -50,4 +50,3 @@ where `LOG_FILE` must be the name of a file containing the output that would nor
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/src/sphere/np_sphere.cpp b/src/sphere/np_sphere.cpp
index aa38fdc115fae157de2f9fe180ebeb0672fa03e0..506931cce1a6411ed233b55b19777080682ffa49 100644
--- a/src/sphere/np_sphere.cpp
+++ b/src/sphere/np_sphere.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/sphere/sphere.cpp b/src/sphere/sphere.cpp
index 1b2b53648fb3d82c8f546d3abbe7c706be718265..c7f6b11f4bc0bb8691517fbcec75f763d46e0c07 100644
--- a/src/sphere/sphere.cpp
+++ b/src/sphere/sphere.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/testing/test_TEDF.cpp b/src/testing/test_TEDF.cpp
index 84127329be980768bea7cf02b2a19610fc573015..11ba3f55182380b867b4359c181feb15ca65dd6c 100644
--- a/src/testing/test_TEDF.cpp
+++ b/src/testing/test_TEDF.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/testing/test_TTMS.cpp b/src/testing/test_TTMS.cpp
index a5d443eaefccf61bec2a33027ef725c4d3054e5f..1ed1615d9c069bdfaedca56647425cfda5da20f6 100644
--- a/src/testing/test_TTMS.cpp
+++ b/src/testing/test_TTMS.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/trapping/cfrfme.cpp b/src/trapping/cfrfme.cpp
index 546cab2fbacecfe399adecffd331fa1efba9463f..d67d464dbce342fdaa0e8e22d0ee8a92b4a9f888 100644
--- a/src/trapping/cfrfme.cpp
+++ b/src/trapping/cfrfme.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/src/trapping/clffft.cpp b/src/trapping/clffft.cpp
index ceea3bd8c3363fa6044861eb5d14d78d6d0a1bc0..0fe64aec2adf821c4d01520b7fd72b662ee0ae8a 100644
--- a/src/trapping/clffft.cpp
+++ b/src/trapping/clffft.cpp
@@ -1,4 +1,4 @@
-/* Copyright 2004 INAF - Osservatorio Astronomico di Cagliari
+/* Copyright 2024 INAF - Osservatorio Astronomico di Cagliari
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
diff --git a/test_data/README.md b/test_data/README.md
index 7545f04f5ecd28dd3165c2c1a88b59f2255b371c..5926500edd6b7edbbbc4c666a4ad6abb769cddb8 100644
--- a/test_data/README.md
+++ b/test_data/README.md
@@ -75,4 +75,3 @@ were the different lines have the following roles:
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
diff --git a/test_data/cluster/case_3/DCLU b/test_data/cluster/case_3/DCLU
new file mode 100644
index 0000000000000000000000000000000000000000..8bafb28ffae074f8fdd84d7b2fa8f4e5e838255a
--- /dev/null
+++ b/test_data/cluster/case_3/DCLU
@@ -0,0 +1,9 @@
+ 4 12 12 9200 0 149 300 0 0
+ 0.0000000D+00 0.0000000D+00 0.0000000D+00
+ -8.6999381D-09 -2.1432655D-08 2.1878060D-07
+ -1.1123930D-07 1.0519369D-07 1.7163947D-07
+ -6.8351972D-08 -1.5505574D-08 -2.3997413D-07
+ 0.00D01 1.00D01 5.00D01 0.00D00 1.00D01 5.00D01
+ 0.00D01 1.00D01 5.00D01 0.00D00 1.00D01 5.00D01
+ 1
+ 0
diff --git a/test_data/cluster/case_3/DEDFB b/test_data/cluster/case_3/DEDFB
new file mode 100644
index 0000000000000000000000000000000000000000..97e9d70bf3fdb02de33eb822430931022e280438
--- /dev/null
+++ b/test_data/cluster/case_3/DEDFB
@@ -0,0 +1,2016 @@
+ 4 0
+ 1.7689D00 3.0D8 1.000000D00 0 401 0 3
+ 400.0000000D-09
+ 401.0000000D-09
+ 402.0000000D-09
+ 403.0000000D-09
+ 404.0000000D-09
+ 405.0000000D-09
+ 406.0000000D-09
+ 407.0000000D-09
+ 408.0000000D-09
+ 409.0000000D-09
+ 410.0000000D-09
+ 411.0000000D-09
+ 412.0000000D-09
+ 413.0000000D-09
+ 414.0000000D-09
+ 415.0000000D-09
+ 416.0000000D-09
+ 417.0000000D-09
+ 418.0000000D-09
+ 419.0000000D-09
+ 420.0000000D-09
+ 421.0000000D-09
+ 422.0000000D-09
+ 423.0000000D-09
+ 424.0000000D-09
+ 425.0000000D-09
+ 426.0000000D-09
+ 427.0000000D-09
+ 428.0000000D-09
+ 429.0000000D-09
+ 430.0000000D-09
+ 431.0000000D-09
+ 432.0000000D-09
+ 433.0000000D-09
+ 434.0000000D-09
+ 435.0000000D-09
+ 436.0000000D-09
+ 437.0000000D-09
+ 438.0000000D-09
+ 439.0000000D-09
+ 440.0000000D-09
+ 441.0000000D-09
+ 442.0000000D-09
+ 443.0000000D-09
+ 444.0000000D-09
+ 445.0000000D-09
+ 446.0000000D-09
+ 447.0000000D-09
+ 448.0000000D-09
+ 449.0000000D-09
+ 450.0000000D-09
+ 451.0000000D-09
+ 452.0000000D-09
+ 453.0000000D-09
+ 454.0000000D-09
+ 455.0000000D-09
+ 456.0000000D-09
+ 457.0000000D-09
+ 458.0000000D-09
+ 459.0000000D-09
+ 460.0000000D-09
+ 461.0000000D-09
+ 462.0000000D-09
+ 463.0000000D-09
+ 464.0000000D-09
+ 465.0000000D-09
+ 466.0000000D-09
+ 467.0000000D-09
+ 468.0000000D-09
+ 469.0000000D-09
+ 470.0000000D-09
+ 471.0000000D-09
+ 472.0000000D-09
+ 473.0000000D-09
+ 474.0000000D-09
+ 475.0000000D-09
+ 476.0000000D-09
+ 477.0000000D-09
+ 478.0000000D-09
+ 479.0000000D-09
+ 480.0000000D-09
+ 481.0000000D-09
+ 482.0000000D-09
+ 483.0000000D-09
+ 484.0000000D-09
+ 485.0000000D-09
+ 486.0000000D-09
+ 487.0000000D-09
+ 488.0000000D-09
+ 489.0000000D-09
+ 490.0000000D-09
+ 491.0000000D-09
+ 492.0000000D-09
+ 493.0000000D-09
+ 494.0000000D-09
+ 495.0000000D-09
+ 496.0000000D-09
+ 497.0000000D-09
+ 498.0000000D-09
+ 499.0000000D-09
+ 500.0000000D-09
+ 501.0000000D-09
+ 502.0000000D-09
+ 503.0000000D-09
+ 504.0000000D-09
+ 505.0000000D-09
+ 506.0000000D-09
+ 507.0000000D-09
+ 508.0000000D-09
+ 509.0000000D-09
+ 510.0000000D-09
+ 511.0000000D-09
+ 512.0000000D-09
+ 513.0000000D-09
+ 514.0000000D-09
+ 515.0000000D-09
+ 516.0000000D-09
+ 517.0000000D-09
+ 518.0000000D-09
+ 519.0000000D-09
+ 520.0000000D-09
+ 521.0000000D-09
+ 522.0000000D-09
+ 523.0000000D-09
+ 524.0000000D-09
+ 525.0000000D-09
+ 526.0000000D-09
+ 527.0000000D-09
+ 528.0000000D-09
+ 529.0000000D-09
+ 530.0000000D-09
+ 531.0000000D-09
+ 532.0000000D-09
+ 533.0000000D-09
+ 534.0000000D-09
+ 535.0000000D-09
+ 536.0000000D-09
+ 537.0000000D-09
+ 538.0000000D-09
+ 539.0000000D-09
+ 540.0000000D-09
+ 541.0000000D-09
+ 542.0000000D-09
+ 543.0000000D-09
+ 544.0000000D-09
+ 545.0000000D-09
+ 546.0000000D-09
+ 547.0000000D-09
+ 548.0000000D-09
+ 549.0000000D-09
+ 550.0000000D-09
+ 551.0000000D-09
+ 552.0000000D-09
+ 553.0000000D-09
+ 554.0000000D-09
+ 555.0000000D-09
+ 556.0000000D-09
+ 557.0000000D-09
+ 558.0000000D-09
+ 559.0000000D-09
+ 560.0000000D-09
+ 561.0000000D-09
+ 562.0000000D-09
+ 563.0000000D-09
+ 564.0000000D-09
+ 565.0000000D-09
+ 566.0000000D-09
+ 567.0000000D-09
+ 568.0000000D-09
+ 569.0000000D-09
+ 570.0000000D-09
+ 571.0000000D-09
+ 572.0000000D-09
+ 573.0000000D-09
+ 574.0000000D-09
+ 575.0000000D-09
+ 576.0000000D-09
+ 577.0000000D-09
+ 578.0000000D-09
+ 579.0000000D-09
+ 580.0000000D-09
+ 581.0000000D-09
+ 582.0000000D-09
+ 583.0000000D-09
+ 584.0000000D-09
+ 585.0000000D-09
+ 586.0000000D-09
+ 587.0000000D-09
+ 588.0000000D-09
+ 589.0000000D-09
+ 590.0000000D-09
+ 591.0000000D-09
+ 592.0000000D-09
+ 593.0000000D-09
+ 594.0000000D-09
+ 595.0000000D-09
+ 596.0000000D-09
+ 597.0000000D-09
+ 598.0000000D-09
+ 599.0000000D-09
+ 600.0000000D-09
+ 601.0000000D-09
+ 602.0000000D-09
+ 603.0000000D-09
+ 604.0000000D-09
+ 605.0000000D-09
+ 606.0000000D-09
+ 607.0000000D-09
+ 608.0000000D-09
+ 609.0000000D-09
+ 610.0000000D-09
+ 611.0000000D-09
+ 612.0000000D-09
+ 613.0000000D-09
+ 614.0000000D-09
+ 615.0000000D-09
+ 616.0000000D-09
+ 617.0000000D-09
+ 618.0000000D-09
+ 619.0000000D-09
+ 620.0000000D-09
+ 621.0000000D-09
+ 622.0000000D-09
+ 623.0000000D-09
+ 624.0000000D-09
+ 625.0000000D-09
+ 626.0000000D-09
+ 627.0000000D-09
+ 628.0000000D-09
+ 629.0000000D-09
+ 630.0000000D-09
+ 631.0000000D-09
+ 632.0000000D-09
+ 633.0000000D-09
+ 634.0000000D-09
+ 635.0000000D-09
+ 636.0000000D-09
+ 637.0000000D-09
+ 638.0000000D-09
+ 639.0000000D-09
+ 640.0000000D-09
+ 641.0000000D-09
+ 642.0000000D-09
+ 643.0000000D-09
+ 644.0000000D-09
+ 645.0000000D-09
+ 646.0000000D-09
+ 647.0000000D-09
+ 648.0000000D-09
+ 649.0000000D-09
+ 650.0000000D-09
+ 651.0000000D-09
+ 652.0000000D-09
+ 653.0000000D-09
+ 654.0000000D-09
+ 655.0000000D-09
+ 656.0000000D-09
+ 657.0000000D-09
+ 658.0000000D-09
+ 659.0000000D-09
+ 660.0000000D-09
+ 661.0000000D-09
+ 662.0000000D-09
+ 663.0000000D-09
+ 664.0000000D-09
+ 665.0000000D-09
+ 666.0000000D-09
+ 667.0000000D-09
+ 668.0000000D-09
+ 669.0000000D-09
+ 670.0000000D-09
+ 671.0000000D-09
+ 672.0000000D-09
+ 673.0000000D-09
+ 674.0000000D-09
+ 675.0000000D-09
+ 676.0000000D-09
+ 677.0000000D-09
+ 678.0000000D-09
+ 679.0000000D-09
+ 680.0000000D-09
+ 681.0000000D-09
+ 682.0000000D-09
+ 683.0000000D-09
+ 684.0000000D-09
+ 685.0000000D-09
+ 686.0000000D-09
+ 687.0000000D-09
+ 688.0000000D-09
+ 689.0000000D-09
+ 690.0000000D-09
+ 691.0000000D-09
+ 692.0000000D-09
+ 693.0000000D-09
+ 694.0000000D-09
+ 695.0000000D-09
+ 696.0000000D-09
+ 697.0000000D-09
+ 698.0000000D-09
+ 699.0000000D-09
+ 700.0000000D-09
+ 701.0000000D-09
+ 702.0000000D-09
+ 703.0000000D-09
+ 704.0000000D-09
+ 705.0000000D-09
+ 706.0000000D-09
+ 707.0000000D-09
+ 708.0000000D-09
+ 709.0000000D-09
+ 710.0000000D-09
+ 711.0000000D-09
+ 712.0000000D-09
+ 713.0000000D-09
+ 714.0000000D-09
+ 715.0000000D-09
+ 716.0000000D-09
+ 717.0000000D-09
+ 718.0000000D-09
+ 719.0000000D-09
+ 720.0000000D-09
+ 721.0000000D-09
+ 722.0000000D-09
+ 723.0000000D-09
+ 724.0000000D-09
+ 725.0000000D-09
+ 726.0000000D-09
+ 727.0000000D-09
+ 728.0000000D-09
+ 729.0000000D-09
+ 730.0000000D-09
+ 731.0000000D-09
+ 732.0000000D-09
+ 733.0000000D-09
+ 734.0000000D-09
+ 735.0000000D-09
+ 736.0000000D-09
+ 737.0000000D-09
+ 738.0000000D-09
+ 739.0000000D-09
+ 740.0000000D-09
+ 741.0000000D-09
+ 742.0000000D-09
+ 743.0000000D-09
+ 744.0000000D-09
+ 745.0000000D-09
+ 746.0000000D-09
+ 747.0000000D-09
+ 748.0000000D-09
+ 749.0000000D-09
+ 750.0000000D-09
+ 751.0000000D-09
+ 752.0000000D-09
+ 753.0000000D-09
+ 754.0000000D-09
+ 755.0000000D-09
+ 756.0000000D-09
+ 757.0000000D-09
+ 758.0000000D-09
+ 759.0000000D-09
+ 760.0000000D-09
+ 761.0000000D-09
+ 762.0000000D-09
+ 763.0000000D-09
+ 764.0000000D-09
+ 765.0000000D-09
+ 766.0000000D-09
+ 767.0000000D-09
+ 768.0000000D-09
+ 769.0000000D-09
+ 770.0000000D-09
+ 771.0000000D-09
+ 772.0000000D-09
+ 773.0000000D-09
+ 774.0000000D-09
+ 775.0000000D-09
+ 776.0000000D-09
+ 777.0000000D-09
+ 778.0000000D-09
+ 779.0000000D-09
+ 780.0000000D-09
+ 781.0000000D-09
+ 782.0000000D-09
+ 783.0000000D-09
+ 784.0000000D-09
+ 785.0000000D-09
+ 786.0000000D-09
+ 787.0000000D-09
+ 788.0000000D-09
+ 789.0000000D-09
+ 790.0000000D-09
+ 791.0000000D-09
+ 792.0000000D-09
+ 793.0000000D-09
+ 794.0000000D-09
+ 795.0000000D-09
+ 796.0000000D-09
+ 797.0000000D-09
+ 798.0000000D-09
+ 799.0000000D-09
+ 800.0000000D-09
+ 1 2 3 4
+ 1 200.000000D-09
+ 1.000000D00
+ 1 20.000000D-09
+ 1.000000D00
+ 1 30.000000D-09
+ 1.000000D00
+ 1 50.000000D-09
+ 1.000000D00
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6597000e+00 , 5.7409000e+00 )
+ ( -1.6597000e+00 , 5.7409000e+00 )
+ ( -1.6597000e+00 , 5.7409000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6636000e+00 , 5.7410000e+00 )
+ ( -1.6636000e+00 , 5.7410000e+00 )
+ ( -1.6636000e+00 , 5.7410000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6675000e+00 , 5.7407000e+00 )
+ ( -1.6675000e+00 , 5.7407000e+00 )
+ ( -1.6675000e+00 , 5.7407000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6712000e+00 , 5.7401000e+00 )
+ ( -1.6712000e+00 , 5.7401000e+00 )
+ ( -1.6712000e+00 , 5.7401000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6749000e+00 , 5.7391000e+00 )
+ ( -1.6749000e+00 , 5.7391000e+00 )
+ ( -1.6749000e+00 , 5.7391000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6785000e+00 , 5.7379000e+00 )
+ ( -1.6785000e+00 , 5.7379000e+00 )
+ ( -1.6785000e+00 , 5.7379000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6820000e+00 , 5.7362000e+00 )
+ ( -1.6820000e+00 , 5.7362000e+00 )
+ ( -1.6820000e+00 , 5.7362000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6853000e+00 , 5.7343000e+00 )
+ ( -1.6853000e+00 , 5.7343000e+00 )
+ ( -1.6853000e+00 , 5.7343000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6885000e+00 , 5.7322000e+00 )
+ ( -1.6885000e+00 , 5.7322000e+00 )
+ ( -1.6885000e+00 , 5.7322000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6915000e+00 , 5.7298000e+00 )
+ ( -1.6915000e+00 , 5.7298000e+00 )
+ ( -1.6915000e+00 , 5.7298000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6943000e+00 , 5.7272000e+00 )
+ ( -1.6943000e+00 , 5.7272000e+00 )
+ ( -1.6943000e+00 , 5.7272000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6970000e+00 , 5.7244000e+00 )
+ ( -1.6970000e+00 , 5.7244000e+00 )
+ ( -1.6970000e+00 , 5.7244000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6994000e+00 , 5.7214000e+00 )
+ ( -1.6994000e+00 , 5.7214000e+00 )
+ ( -1.6994000e+00 , 5.7214000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7016000e+00 , 5.7183000e+00 )
+ ( -1.7016000e+00 , 5.7183000e+00 )
+ ( -1.7016000e+00 , 5.7183000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7021000e+00 , 5.7170000e+00 )
+ ( -1.7021000e+00 , 5.7170000e+00 )
+ ( -1.7021000e+00 , 5.7170000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7018000e+00 , 5.7161000e+00 )
+ ( -1.7018000e+00 , 5.7161000e+00 )
+ ( -1.7018000e+00 , 5.7161000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7013000e+00 , 5.7150000e+00 )
+ ( -1.7013000e+00 , 5.7150000e+00 )
+ ( -1.7013000e+00 , 5.7150000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7007000e+00 , 5.7137000e+00 )
+ ( -1.7007000e+00 , 5.7137000e+00 )
+ ( -1.7007000e+00 , 5.7137000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6999000e+00 , 5.7120000e+00 )
+ ( -1.6999000e+00 , 5.7120000e+00 )
+ ( -1.6999000e+00 , 5.7120000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6992000e+00 , 5.7200000e+00 )
+ ( -1.6992000e+00 , 5.7200000e+00 )
+ ( -1.6992000e+00 , 5.7200000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6983000e+00 , 5.7075000e+00 )
+ ( -1.6983000e+00 , 5.7075000e+00 )
+ ( -1.6983000e+00 , 5.7075000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6974000e+00 , 5.7047000e+00 )
+ ( -1.6974000e+00 , 5.7047000e+00 )
+ ( -1.6974000e+00 , 5.7047000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6965000e+00 , 5.7013000e+00 )
+ ( -1.6965000e+00 , 5.7013000e+00 )
+ ( -1.6965000e+00 , 5.7013000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6957000e+00 , 5.6974000e+00 )
+ ( -1.6957000e+00 , 5.6974000e+00 )
+ ( -1.6957000e+00 , 5.6974000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6948000e+00 , 5.6930000e+00 )
+ ( -1.6948000e+00 , 5.6930000e+00 )
+ ( -1.6948000e+00 , 5.6930000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6941000e+00 , 5.6881000e+00 )
+ ( -1.6941000e+00 , 5.6881000e+00 )
+ ( -1.6941000e+00 , 5.6881000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6934000e+00 , 5.6825000e+00 )
+ ( -1.6934000e+00 , 5.6825000e+00 )
+ ( -1.6934000e+00 , 5.6825000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6929000e+00 , 5.6763000e+00 )
+ ( -1.6929000e+00 , 5.6763000e+00 )
+ ( -1.6929000e+00 , 5.6763000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6925000e+00 , 5.6694000e+00 )
+ ( -1.6925000e+00 , 5.6694000e+00 )
+ ( -1.6925000e+00 , 5.6694000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6922000e+00 , 5.6619000e+00 )
+ ( -1.6922000e+00 , 5.6619000e+00 )
+ ( -1.6922000e+00 , 5.6619000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6922000e+00 , 5.6536000e+00 )
+ ( -1.6922000e+00 , 5.6536000e+00 )
+ ( -1.6922000e+00 , 5.6536000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6938000e+00 , 5.6428000e+00 )
+ ( -1.6938000e+00 , 5.6428000e+00 )
+ ( -1.6938000e+00 , 5.6428000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6973000e+00 , 5.6294000e+00 )
+ ( -1.6973000e+00 , 5.6294000e+00 )
+ ( -1.6973000e+00 , 5.6294000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7009000e+00 , 5.6154000e+00 )
+ ( -1.7009000e+00 , 5.6154000e+00 )
+ ( -1.7009000e+00 , 5.6154000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7046000e+00 , 5.6006000e+00 )
+ ( -1.7046000e+00 , 5.6006000e+00 )
+ ( -1.7046000e+00 , 5.6006000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7084000e+00 , 5.5853000e+00 )
+ ( -1.7084000e+00 , 5.5853000e+00 )
+ ( -1.7084000e+00 , 5.5853000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7123000e+00 , 5.5693000e+00 )
+ ( -1.7123000e+00 , 5.5693000e+00 )
+ ( -1.7123000e+00 , 5.5693000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7162000e+00 , 5.5528000e+00 )
+ ( -1.7162000e+00 , 5.5528000e+00 )
+ ( -1.7162000e+00 , 5.5528000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7201000e+00 , 5.5357000e+00 )
+ ( -1.7201000e+00 , 5.5357000e+00 )
+ ( -1.7201000e+00 , 5.5357000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7240000e+00 , 5.5181000e+00 )
+ ( -1.7240000e+00 , 5.5181000e+00 )
+ ( -1.7240000e+00 , 5.5181000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7279000e+00 , 5.5001000e+00 )
+ ( -1.7279000e+00 , 5.5001000e+00 )
+ ( -1.7279000e+00 , 5.5001000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7316000e+00 , 5.4817000e+00 )
+ ( -1.7316000e+00 , 5.4817000e+00 )
+ ( -1.7316000e+00 , 5.4817000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7353000e+00 , 5.4628000e+00 )
+ ( -1.7353000e+00 , 5.4628000e+00 )
+ ( -1.7353000e+00 , 5.4628000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7388000e+00 , 5.4435000e+00 )
+ ( -1.7388000e+00 , 5.4435000e+00 )
+ ( -1.7388000e+00 , 5.4435000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7421000e+00 , 5.4239000e+00 )
+ ( -1.7421000e+00 , 5.4239000e+00 )
+ ( -1.7421000e+00 , 5.4239000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7453000e+00 , 5.4040000e+00 )
+ ( -1.7453000e+00 , 5.4040000e+00 )
+ ( -1.7453000e+00 , 5.4040000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7482000e+00 , 5.3838000e+00 )
+ ( -1.7482000e+00 , 5.3838000e+00 )
+ ( -1.7482000e+00 , 5.3838000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7509000e+00 , 5.3634000e+00 )
+ ( -1.7509000e+00 , 5.3634000e+00 )
+ ( -1.7509000e+00 , 5.3634000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7534000e+00 , 5.3427000e+00 )
+ ( -1.7534000e+00 , 5.3427000e+00 )
+ ( -1.7534000e+00 , 5.3427000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7557000e+00 , 5.3218000e+00 )
+ ( -1.7557000e+00 , 5.3218000e+00 )
+ ( -1.7557000e+00 , 5.3218000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7578000e+00 , 5.3007000e+00 )
+ ( -1.7578000e+00 , 5.3007000e+00 )
+ ( -1.7578000e+00 , 5.3007000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7580000e+00 , 5.2802000e+00 )
+ ( -1.7580000e+00 , 5.2802000e+00 )
+ ( -1.7580000e+00 , 5.2802000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7512000e+00 , 5.2637000e+00 )
+ ( -1.7512000e+00 , 5.2637000e+00 )
+ ( -1.7512000e+00 , 5.2637000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7442000e+00 , 5.2469000e+00 )
+ ( -1.7442000e+00 , 5.2469000e+00 )
+ ( -1.7442000e+00 , 5.2469000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7374000e+00 , 5.2299000e+00 )
+ ( -1.7374000e+00 , 5.2299000e+00 )
+ ( -1.7374000e+00 , 5.2299000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7306000e+00 , 5.2124000e+00 )
+ ( -1.7306000e+00 , 5.2124000e+00 )
+ ( -1.7306000e+00 , 5.2124000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7240000e+00 , 5.1946000e+00 )
+ ( -1.7240000e+00 , 5.1946000e+00 )
+ ( -1.7240000e+00 , 5.1946000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7177000e+00 , 5.1764000e+00 )
+ ( -1.7177000e+00 , 5.1764000e+00 )
+ ( -1.7177000e+00 , 5.1764000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7119000e+00 , 5.1576000e+00 )
+ ( -1.7119000e+00 , 5.1576000e+00 )
+ ( -1.7119000e+00 , 5.1576000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7063000e+00 , 5.1384000e+00 )
+ ( -1.7063000e+00 , 5.1384000e+00 )
+ ( -1.7063000e+00 , 5.1384000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7013000e+00 , 5.1186000e+00 )
+ ( -1.7013000e+00 , 5.1186000e+00 )
+ ( -1.7013000e+00 , 5.1186000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6970000e+00 , 5.0983000e+00 )
+ ( -1.6970000e+00 , 5.0983000e+00 )
+ ( -1.6970000e+00 , 5.0983000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6933000e+00 , 5.0773000e+00 )
+ ( -1.6933000e+00 , 5.0773000e+00 )
+ ( -1.6933000e+00 , 5.0773000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6903000e+00 , 5.0557000e+00 )
+ ( -1.6903000e+00 , 5.0557000e+00 )
+ ( -1.6903000e+00 , 5.0557000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6881000e+00 , 5.0335000e+00 )
+ ( -1.6881000e+00 , 5.0335000e+00 )
+ ( -1.6881000e+00 , 5.0335000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6868000e+00 , 5.0105000e+00 )
+ ( -1.6868000e+00 , 5.0105000e+00 )
+ ( -1.6868000e+00 , 5.0105000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6864000e+00 , 4.9868000e+00 )
+ ( -1.6864000e+00 , 4.9868000e+00 )
+ ( -1.6864000e+00 , 4.9868000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6870000e+00 , 4.9623000e+00 )
+ ( -1.6870000e+00 , 4.9623000e+00 )
+ ( -1.6870000e+00 , 4.9623000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6887000e+00 , 4.9371000e+00 )
+ ( -1.6887000e+00 , 4.9371000e+00 )
+ ( -1.6887000e+00 , 4.9371000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6914000e+00 , 4.9110000e+00 )
+ ( -1.6914000e+00 , 4.9110000e+00 )
+ ( -1.6914000e+00 , 4.9110000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6952000e+00 , 4.8841000e+00 )
+ ( -1.6952000e+00 , 4.8841000e+00 )
+ ( -1.6952000e+00 , 4.8841000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7002000e+00 , 4.8564000e+00 )
+ ( -1.7002000e+00 , 4.8564000e+00 )
+ ( -1.7002000e+00 , 4.8564000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7064000e+00 , 4.8232000e+00 )
+ ( -1.7064000e+00 , 4.8232000e+00 )
+ ( -1.7064000e+00 , 4.8232000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7137000e+00 , 4.7859000e+00 )
+ ( -1.7137000e+00 , 4.7859000e+00 )
+ ( -1.7137000e+00 , 4.7859000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7223000e+00 , 4.7478000e+00 )
+ ( -1.7223000e+00 , 4.7478000e+00 )
+ ( -1.7223000e+00 , 4.7478000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7321000e+00 , 4.7090000e+00 )
+ ( -1.7321000e+00 , 4.7090000e+00 )
+ ( -1.7321000e+00 , 4.7090000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7433000e+00 , 4.6696000e+00 )
+ ( -1.7433000e+00 , 4.6696000e+00 )
+ ( -1.7433000e+00 , 4.6696000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7559000e+00 , 4.6295000e+00 )
+ ( -1.7559000e+00 , 4.6295000e+00 )
+ ( -1.7559000e+00 , 4.6295000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7698000e+00 , 4.5889000e+00 )
+ ( -1.7698000e+00 , 4.5889000e+00 )
+ ( -1.7698000e+00 , 4.5889000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7852000e+00 , 4.5470000e+00 )
+ ( -1.7852000e+00 , 4.5470000e+00 )
+ ( -1.7852000e+00 , 4.5470000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8020000e+00 , 4.5065000e+00 )
+ ( -1.8020000e+00 , 4.5065000e+00 )
+ ( -1.8020000e+00 , 4.5065000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8203000e+00 , 4.4646000e+00 )
+ ( -1.8203000e+00 , 4.4646000e+00 )
+ ( -1.8203000e+00 , 4.4646000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8400000e+00 , 4.4224000e+00 )
+ ( -1.8400000e+00 , 4.4224000e+00 )
+ ( -1.8400000e+00 , 4.4224000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8613000e+00 , 4.3799000e+00 )
+ ( -1.8613000e+00 , 4.3799000e+00 )
+ ( -1.8613000e+00 , 4.3799000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8840000e+00 , 4.3372000e+00 )
+ ( -1.8840000e+00 , 4.3372000e+00 )
+ ( -1.8840000e+00 , 4.3372000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9083000e+00 , 4.2941000e+00 )
+ ( -1.9083000e+00 , 4.2941000e+00 )
+ ( -1.9083000e+00 , 4.2941000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9341000e+00 , 4.2509000e+00 )
+ ( -1.9341000e+00 , 4.2509000e+00 )
+ ( -1.9341000e+00 , 4.2509000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9615000e+00 , 4.2074000e+00 )
+ ( -1.9615000e+00 , 4.2074000e+00 )
+ ( -1.9615000e+00 , 4.2074000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9905000e+00 , 4.1638000e+00 )
+ ( -1.9905000e+00 , 4.1638000e+00 )
+ ( -1.9905000e+00 , 4.1638000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0211000e+00 , 4.1200000e+00 )
+ ( -2.0211000e+00 , 4.1200000e+00 )
+ ( -2.0211000e+00 , 4.1200000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0533000e+00 , 4.0761000e+00 )
+ ( -2.0533000e+00 , 4.0761000e+00 )
+ ( -2.0533000e+00 , 4.0761000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0871000e+00 , 4.0320000e+00 )
+ ( -2.0871000e+00 , 4.0320000e+00 )
+ ( -2.0871000e+00 , 4.0320000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1225000e+00 , 3.9878000e+00 )
+ ( -2.1225000e+00 , 3.9878000e+00 )
+ ( -2.1225000e+00 , 3.9878000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1596000e+00 , 3.9435000e+00 )
+ ( -2.1596000e+00 , 3.9435000e+00 )
+ ( -2.1596000e+00 , 3.9435000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1984000e+00 , 3.8990000e+00 )
+ ( -2.1984000e+00 , 3.8990000e+00 )
+ ( -2.1984000e+00 , 3.8990000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2387000e+00 , 3.8545000e+00 )
+ ( -2.2387000e+00 , 3.8545000e+00 )
+ ( -2.2387000e+00 , 3.8545000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2820000e+00 , 3.8094000e+00 )
+ ( -2.2820000e+00 , 3.8094000e+00 )
+ ( -2.2820000e+00 , 3.8094000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3405000e+00 , 3.7591000e+00 )
+ ( -2.3405000e+00 , 3.7591000e+00 )
+ ( -2.3405000e+00 , 3.7591000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.4004000e+00 , 3.7086000e+00 )
+ ( -2.4004000e+00 , 3.7086000e+00 )
+ ( -2.4004000e+00 , 3.7086000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.4614000e+00 , 3.6578000e+00 )
+ ( -2.4614000e+00 , 3.6578000e+00 )
+ ( -2.4614000e+00 , 3.6578000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.5235000e+00 , 3.6069000e+00 )
+ ( -2.5235000e+00 , 3.6069000e+00 )
+ ( -2.5235000e+00 , 3.6069000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.5866000e+00 , 3.5558000e+00 )
+ ( -2.5866000e+00 , 3.5558000e+00 )
+ ( -2.5866000e+00 , 3.5558000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.6506000e+00 , 3.5047000e+00 )
+ ( -2.6506000e+00 , 3.5047000e+00 )
+ ( -2.6506000e+00 , 3.5047000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.7154000e+00 , 3.4534000e+00 )
+ ( -2.7154000e+00 , 3.4534000e+00 )
+ ( -2.7154000e+00 , 3.4534000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.7820000e+00 , 3.4022000e+00 )
+ ( -2.7820000e+00 , 3.4022000e+00 )
+ ( -2.7820000e+00 , 3.4022000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.8471000e+00 , 3.3509000e+00 )
+ ( -2.8471000e+00 , 3.3509000e+00 )
+ ( -2.8471000e+00 , 3.3509000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.9137000e+00 , 3.2998000e+00 )
+ ( -2.9137000e+00 , 3.2998000e+00 )
+ ( -2.9137000e+00 , 3.2998000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.9811000e+00 , 3.2487000e+00 )
+ ( -2.9811000e+00 , 3.2487000e+00 )
+ ( -2.9811000e+00 , 3.2487000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.0488000e+00 , 3.1978000e+00 )
+ ( -3.0488000e+00 , 3.1978000e+00 )
+ ( -3.0488000e+00 , 3.1978000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.1169000e+00 , 3.1472000e+00 )
+ ( -3.1169000e+00 , 3.1472000e+00 )
+ ( -3.1169000e+00 , 3.1472000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.1854000e+00 , 3.0968000e+00 )
+ ( -3.1854000e+00 , 3.0968000e+00 )
+ ( -3.1854000e+00 , 3.0968000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.2541000e+00 , 3.0467000e+00 )
+ ( -3.2541000e+00 , 3.0467000e+00 )
+ ( -3.2541000e+00 , 3.0467000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.3231000e+00 , 2.9971000e+00 )
+ ( -3.3231000e+00 , 2.9971000e+00 )
+ ( -3.3231000e+00 , 2.9971000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.3923000e+00 , 2.9478000e+00 )
+ ( -3.3923000e+00 , 2.9478000e+00 )
+ ( -3.3923000e+00 , 2.9478000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.4617000e+00 , 2.8991000e+00 )
+ ( -3.4617000e+00 , 2.8991000e+00 )
+ ( -3.4617000e+00 , 2.8991000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.5313000e+00 , 2.8510000e+00 )
+ ( -3.5313000e+00 , 2.8510000e+00 )
+ ( -3.5313000e+00 , 2.8510000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.6009000e+00 , 2.8035000e+00 )
+ ( -3.6009000e+00 , 2.8035000e+00 )
+ ( -3.6009000e+00 , 2.8035000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.6707000e+00 , 2.7566000e+00 )
+ ( -3.6707000e+00 , 2.7566000e+00 )
+ ( -3.6707000e+00 , 2.7566000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.7405000e+00 , 2.7106000e+00 )
+ ( -3.7405000e+00 , 2.7106000e+00 )
+ ( -3.7405000e+00 , 2.7106000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.8104000e+00 , 2.6654000e+00 )
+ ( -3.8104000e+00 , 2.6654000e+00 )
+ ( -3.8104000e+00 , 2.6654000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.8803000e+00 , 2.6212000e+00 )
+ ( -3.8803000e+00 , 2.6212000e+00 )
+ ( -3.8803000e+00 , 2.6212000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -3.9500000e+00 , 2.5788000e+00 )
+ ( -3.9500000e+00 , 2.5788000e+00 )
+ ( -3.9500000e+00 , 2.5788000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.0157000e+00 , 2.5511000e+00 )
+ ( -4.0157000e+00 , 2.5511000e+00 )
+ ( -4.0157000e+00 , 2.5511000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.0815000e+00 , 2.5246000e+00 )
+ ( -4.0815000e+00 , 2.5246000e+00 )
+ ( -4.0815000e+00 , 2.5246000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.1476000e+00 , 2.4992000e+00 )
+ ( -4.1476000e+00 , 2.4992000e+00 )
+ ( -4.1476000e+00 , 2.4992000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.2139000e+00 , 2.4749000e+00 )
+ ( -4.2139000e+00 , 2.4749000e+00 )
+ ( -4.2139000e+00 , 2.4749000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.2804000e+00 , 2.4516000e+00 )
+ ( -4.2804000e+00 , 2.4516000e+00 )
+ ( -4.2804000e+00 , 2.4516000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.3472000e+00 , 2.4292000e+00 )
+ ( -4.3472000e+00 , 2.4292000e+00 )
+ ( -4.3472000e+00 , 2.4292000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.4142000e+00 , 2.4078000e+00 )
+ ( -4.4142000e+00 , 2.4078000e+00 )
+ ( -4.4142000e+00 , 2.4078000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.4814000e+00 , 2.3873000e+00 )
+ ( -4.4814000e+00 , 2.3873000e+00 )
+ ( -4.4814000e+00 , 2.3873000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.5489000e+00 , 2.3676000e+00 )
+ ( -4.5489000e+00 , 2.3676000e+00 )
+ ( -4.5489000e+00 , 2.3676000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.6167000e+00 , 2.3487000e+00 )
+ ( -4.6167000e+00 , 2.3487000e+00 )
+ ( -4.6167000e+00 , 2.3487000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.6847000e+00 , 2.3307000e+00 )
+ ( -4.6847000e+00 , 2.3307000e+00 )
+ ( -4.6847000e+00 , 2.3307000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.7529000e+00 , 2.3133000e+00 )
+ ( -4.7529000e+00 , 2.3133000e+00 )
+ ( -4.7529000e+00 , 2.3133000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.8214000e+00 , 2.2967000e+00 )
+ ( -4.8214000e+00 , 2.2967000e+00 )
+ ( -4.8214000e+00 , 2.2967000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.8901000e+00 , 2.2807000e+00 )
+ ( -4.8901000e+00 , 2.2807000e+00 )
+ ( -4.8901000e+00 , 2.2807000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -4.9590000e+00 , 2.2653000e+00 )
+ ( -4.9590000e+00 , 2.2653000e+00 )
+ ( -4.9590000e+00 , 2.2653000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.0281000e+00 , 2.2506000e+00 )
+ ( -5.0281000e+00 , 2.2506000e+00 )
+ ( -5.0281000e+00 , 2.2506000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.0974000e+00 , 2.2364000e+00 )
+ ( -5.0974000e+00 , 2.2364000e+00 )
+ ( -5.0974000e+00 , 2.2364000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.1670000e+00 , 2.2227000e+00 )
+ ( -5.1670000e+00 , 2.2227000e+00 )
+ ( -5.1670000e+00 , 2.2227000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.2367000e+00 , 2.2095000e+00 )
+ ( -5.2367000e+00 , 2.2095000e+00 )
+ ( -5.2367000e+00 , 2.2095000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.3066000e+00 , 2.1968000e+00 )
+ ( -5.3066000e+00 , 2.1968000e+00 )
+ ( -5.3066000e+00 , 2.1968000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.3767000e+00 , 2.1845000e+00 )
+ ( -5.3767000e+00 , 2.1845000e+00 )
+ ( -5.3767000e+00 , 2.1845000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.4469000e+00 , 2.1726000e+00 )
+ ( -5.4469000e+00 , 2.1726000e+00 )
+ ( -5.4469000e+00 , 2.1726000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.5172000e+00 , 2.1609000e+00 )
+ ( -5.5172000e+00 , 2.1609000e+00 )
+ ( -5.5172000e+00 , 2.1609000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.5876000e+00 , 2.1497000e+00 )
+ ( -5.5876000e+00 , 2.1497000e+00 )
+ ( -5.5876000e+00 , 2.1497000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.6582000e+00 , 2.1388000e+00 )
+ ( -5.6582000e+00 , 2.1388000e+00 )
+ ( -5.6582000e+00 , 2.1388000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.7288000e+00 , 2.1280000e+00 )
+ ( -5.7288000e+00 , 2.1280000e+00 )
+ ( -5.7288000e+00 , 2.1280000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.7995000e+00 , 2.1175000e+00 )
+ ( -5.7995000e+00 , 2.1175000e+00 )
+ ( -5.7995000e+00 , 2.1175000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.8688000e+00 , 2.1050000e+00 )
+ ( -5.8688000e+00 , 2.1050000e+00 )
+ ( -5.8688000e+00 , 2.1050000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -5.9359000e+00 , 2.0892000e+00 )
+ ( -5.9359000e+00 , 2.0892000e+00 )
+ ( -5.9359000e+00 , 2.0892000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.0030000e+00 , 2.0736000e+00 )
+ ( -6.0030000e+00 , 2.0736000e+00 )
+ ( -6.0030000e+00 , 2.0736000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.0700000e+00 , 2.0581000e+00 )
+ ( -6.0700000e+00 , 2.0581000e+00 )
+ ( -6.0700000e+00 , 2.0581000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.1370000e+00 , 2.0428000e+00 )
+ ( -6.1370000e+00 , 2.0428000e+00 )
+ ( -6.1370000e+00 , 2.0428000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.2041000e+00 , 2.0276000e+00 )
+ ( -6.2041000e+00 , 2.0276000e+00 )
+ ( -6.2041000e+00 , 2.0276000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.2711000e+00 , 2.0125000e+00 )
+ ( -6.2711000e+00 , 2.0125000e+00 )
+ ( -6.2711000e+00 , 2.0125000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.3382000e+00 , 1.9975000e+00 )
+ ( -6.3382000e+00 , 1.9975000e+00 )
+ ( -6.3382000e+00 , 1.9975000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.4052000e+00 , 1.9827000e+00 )
+ ( -6.4052000e+00 , 1.9827000e+00 )
+ ( -6.4052000e+00 , 1.9827000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.4723000e+00 , 1.9681000e+00 )
+ ( -6.4723000e+00 , 1.9681000e+00 )
+ ( -6.4723000e+00 , 1.9681000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.5395000e+00 , 1.9535000e+00 )
+ ( -6.5395000e+00 , 1.9535000e+00 )
+ ( -6.5395000e+00 , 1.9535000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.6067000e+00 , 1.9391000e+00 )
+ ( -6.6067000e+00 , 1.9391000e+00 )
+ ( -6.6067000e+00 , 1.9391000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.6739000e+00 , 1.9249000e+00 )
+ ( -6.6739000e+00 , 1.9249000e+00 )
+ ( -6.6739000e+00 , 1.9249000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.7412000e+00 , 1.9108000e+00 )
+ ( -6.7412000e+00 , 1.9108000e+00 )
+ ( -6.7412000e+00 , 1.9108000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.8085000e+00 , 1.8969000e+00 )
+ ( -6.8085000e+00 , 1.8969000e+00 )
+ ( -6.8085000e+00 , 1.8969000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.8759000e+00 , 1.8831000e+00 )
+ ( -6.8759000e+00 , 1.8831000e+00 )
+ ( -6.8759000e+00 , 1.8831000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -6.9434000e+00 , 1.8695000e+00 )
+ ( -6.9434000e+00 , 1.8695000e+00 )
+ ( -6.9434000e+00 , 1.8695000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.0109000e+00 , 1.8560000e+00 )
+ ( -7.0109000e+00 , 1.8560000e+00 )
+ ( -7.0109000e+00 , 1.8560000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.0786000e+00 , 1.8427000e+00 )
+ ( -7.0786000e+00 , 1.8427000e+00 )
+ ( -7.0786000e+00 , 1.8427000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.1463000e+00 , 1.8295000e+00 )
+ ( -7.1463000e+00 , 1.8295000e+00 )
+ ( -7.1463000e+00 , 1.8295000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.2141000e+00 , 1.8165000e+00 )
+ ( -7.2141000e+00 , 1.8165000e+00 )
+ ( -7.2141000e+00 , 1.8165000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.2820000e+00 , 1.8036000e+00 )
+ ( -7.2820000e+00 , 1.8036000e+00 )
+ ( -7.2820000e+00 , 1.8036000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.3501000e+00 , 1.7909000e+00 )
+ ( -7.3501000e+00 , 1.7909000e+00 )
+ ( -7.3501000e+00 , 1.7909000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.4182000e+00 , 1.7783000e+00 )
+ ( -7.4182000e+00 , 1.7783000e+00 )
+ ( -7.4182000e+00 , 1.7783000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.4864000e+00 , 1.7659000e+00 )
+ ( -7.4864000e+00 , 1.7659000e+00 )
+ ( -7.4864000e+00 , 1.7659000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.5548000e+00 , 1.7537000e+00 )
+ ( -7.5548000e+00 , 1.7537000e+00 )
+ ( -7.5548000e+00 , 1.7537000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.6233000e+00 , 1.7416000e+00 )
+ ( -7.6233000e+00 , 1.7416000e+00 )
+ ( -7.6233000e+00 , 1.7416000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.6919000e+00 , 1.7297000e+00 )
+ ( -7.6919000e+00 , 1.7297000e+00 )
+ ( -7.6919000e+00 , 1.7297000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.7607000e+00 , 1.7179000e+00 )
+ ( -7.7607000e+00 , 1.7179000e+00 )
+ ( -7.7607000e+00 , 1.7179000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.8296000e+00 , 1.7063000e+00 )
+ ( -7.8296000e+00 , 1.7063000e+00 )
+ ( -7.8296000e+00 , 1.7063000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.8987000e+00 , 1.6949000e+00 )
+ ( -7.8987000e+00 , 1.6949000e+00 )
+ ( -7.8987000e+00 , 1.6949000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -7.9679000e+00 , 1.6836000e+00 )
+ ( -7.9679000e+00 , 1.6836000e+00 )
+ ( -7.9679000e+00 , 1.6836000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.0372000e+00 , 1.6724000e+00 )
+ ( -8.0372000e+00 , 1.6724000e+00 )
+ ( -8.0372000e+00 , 1.6724000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.1068000e+00 , 1.6615000e+00 )
+ ( -8.1068000e+00 , 1.6615000e+00 )
+ ( -8.1068000e+00 , 1.6615000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.1785000e+00 , 1.6514000e+00 )
+ ( -8.1785000e+00 , 1.6514000e+00 )
+ ( -8.1785000e+00 , 1.6514000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.2506000e+00 , 1.6416000e+00 )
+ ( -8.2506000e+00 , 1.6416000e+00 )
+ ( -8.2506000e+00 , 1.6416000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.3228000e+00 , 1.6319000e+00 )
+ ( -8.3228000e+00 , 1.6319000e+00 )
+ ( -8.3228000e+00 , 1.6319000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.3952000e+00 , 1.6224000e+00 )
+ ( -8.3952000e+00 , 1.6224000e+00 )
+ ( -8.3952000e+00 , 1.6224000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.4677000e+00 , 1.6130000e+00 )
+ ( -8.4677000e+00 , 1.6130000e+00 )
+ ( -8.4677000e+00 , 1.6130000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.5404000e+00 , 1.6037000e+00 )
+ ( -8.5404000e+00 , 1.6037000e+00 )
+ ( -8.5404000e+00 , 1.6037000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.6131000e+00 , 1.5946000e+00 )
+ ( -8.6131000e+00 , 1.5946000e+00 )
+ ( -8.6131000e+00 , 1.5946000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.6860000e+00 , 1.5856000e+00 )
+ ( -8.6860000e+00 , 1.5856000e+00 )
+ ( -8.6860000e+00 , 1.5856000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.7591000e+00 , 1.5767000e+00 )
+ ( -8.7591000e+00 , 1.5767000e+00 )
+ ( -8.7591000e+00 , 1.5767000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.8322000e+00 , 1.5679000e+00 )
+ ( -8.8322000e+00 , 1.5679000e+00 )
+ ( -8.8322000e+00 , 1.5679000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.9054000e+00 , 1.5592000e+00 )
+ ( -8.9054000e+00 , 1.5592000e+00 )
+ ( -8.9054000e+00 , 1.5592000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -8.9787000e+00 , 1.5506000e+00 )
+ ( -8.9787000e+00 , 1.5506000e+00 )
+ ( -8.9787000e+00 , 1.5506000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.0521000e+00 , 1.5421000e+00 )
+ ( -9.0521000e+00 , 1.5421000e+00 )
+ ( -9.0521000e+00 , 1.5421000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.1256000e+00 , 1.5337000e+00 )
+ ( -9.1256000e+00 , 1.5337000e+00 )
+ ( -9.1256000e+00 , 1.5337000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.1991000e+00 , 1.5254000e+00 )
+ ( -9.1991000e+00 , 1.5254000e+00 )
+ ( -9.1991000e+00 , 1.5254000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.2727000e+00 , 1.5173000e+00 )
+ ( -9.2727000e+00 , 1.5173000e+00 )
+ ( -9.2727000e+00 , 1.5173000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.3464000e+00 , 1.5091000e+00 )
+ ( -9.3464000e+00 , 1.5091000e+00 )
+ ( -9.3464000e+00 , 1.5091000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.4201000e+00 , 1.5011000e+00 )
+ ( -9.4201000e+00 , 1.5011000e+00 )
+ ( -9.4201000e+00 , 1.5011000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.4939000e+00 , 1.4931000e+00 )
+ ( -9.4939000e+00 , 1.4931000e+00 )
+ ( -9.4939000e+00 , 1.4931000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.5677000e+00 , 1.4853000e+00 )
+ ( -9.5677000e+00 , 1.4853000e+00 )
+ ( -9.5677000e+00 , 1.4853000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.6415000e+00 , 1.4774000e+00 )
+ ( -9.6415000e+00 , 1.4774000e+00 )
+ ( -9.6415000e+00 , 1.4774000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.7153000e+00 , 1.4697000e+00 )
+ ( -9.7153000e+00 , 1.4697000e+00 )
+ ( -9.7153000e+00 , 1.4697000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.7892000e+00 , 1.4620000e+00 )
+ ( -9.7892000e+00 , 1.4620000e+00 )
+ ( -9.7892000e+00 , 1.4620000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.8630000e+00 , 1.4544000e+00 )
+ ( -9.8630000e+00 , 1.4544000e+00 )
+ ( -9.8630000e+00 , 1.4544000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -9.9369000e+00 , 1.4466000e+00 )
+ ( -9.9369000e+00 , 1.4466000e+00 )
+ ( -9.9369000e+00 , 1.4466000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0010700e+01 , 1.4392000e+00 )
+ ( -1.0010700e+01 , 1.4392000e+00 )
+ ( -1.0010700e+01 , 1.4392000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0084600e+01 , 1.4317000e+00 )
+ ( -1.0084600e+01 , 1.4317000e+00 )
+ ( -1.0084600e+01 , 1.4317000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0158400e+01 , 1.4243000e+00 )
+ ( -1.0158400e+01 , 1.4243000e+00 )
+ ( -1.0158400e+01 , 1.4243000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0232200e+01 , 1.4169000e+00 )
+ ( -1.0232200e+01 , 1.4169000e+00 )
+ ( -1.0232200e+01 , 1.4169000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0305900e+01 , 1.4095000e+00 )
+ ( -1.0305900e+01 , 1.4095000e+00 )
+ ( -1.0305900e+01 , 1.4095000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0379600e+01 , 1.4022000e+00 )
+ ( -1.0379600e+01 , 1.4022000e+00 )
+ ( -1.0379600e+01 , 1.4022000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0453300e+01 , 1.3949000e+00 )
+ ( -1.0453300e+01 , 1.3949000e+00 )
+ ( -1.0453300e+01 , 1.3949000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0526900e+01 , 1.3876000e+00 )
+ ( -1.0526900e+01 , 1.3876000e+00 )
+ ( -1.0526900e+01 , 1.3876000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0600400e+01 , 1.3803000e+00 )
+ ( -1.0600400e+01 , 1.3803000e+00 )
+ ( -1.0600400e+01 , 1.3803000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0673500e+01 , 1.3727000e+00 )
+ ( -1.0673500e+01 , 1.3727000e+00 )
+ ( -1.0673500e+01 , 1.3727000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0744800e+01 , 1.3631000e+00 )
+ ( -1.0744800e+01 , 1.3631000e+00 )
+ ( -1.0744800e+01 , 1.3631000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0815900e+01 , 1.3535000e+00 )
+ ( -1.0815900e+01 , 1.3535000e+00 )
+ ( -1.0815900e+01 , 1.3535000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0886900e+01 , 1.3440000e+00 )
+ ( -1.0886900e+01 , 1.3440000e+00 )
+ ( -1.0886900e+01 , 1.3440000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.0957800e+01 , 1.3345000e+00 )
+ ( -1.0957800e+01 , 1.3345000e+00 )
+ ( -1.0957800e+01 , 1.3345000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1028600e+01 , 1.3250000e+00 )
+ ( -1.1028600e+01 , 1.3250000e+00 )
+ ( -1.1028600e+01 , 1.3250000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1099400e+01 , 1.3155000e+00 )
+ ( -1.1099400e+01 , 1.3155000e+00 )
+ ( -1.1099400e+01 , 1.3155000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1170000e+01 , 1.3061000e+00 )
+ ( -1.1170000e+01 , 1.3061000e+00 )
+ ( -1.1170000e+01 , 1.3061000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1240600e+01 , 1.2967000e+00 )
+ ( -1.1240600e+01 , 1.2967000e+00 )
+ ( -1.1240600e+01 , 1.2967000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1311200e+01 , 1.2873000e+00 )
+ ( -1.1311200e+01 , 1.2873000e+00 )
+ ( -1.1311200e+01 , 1.2873000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1381600e+01 , 1.2780000e+00 )
+ ( -1.1381600e+01 , 1.2780000e+00 )
+ ( -1.1381600e+01 , 1.2780000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1452000e+01 , 1.2688000e+00 )
+ ( -1.1452000e+01 , 1.2688000e+00 )
+ ( -1.1452000e+01 , 1.2688000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1522300e+01 , 1.2596000e+00 )
+ ( -1.1522300e+01 , 1.2596000e+00 )
+ ( -1.1522300e+01 , 1.2596000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1592600e+01 , 1.2505000e+00 )
+ ( -1.1592600e+01 , 1.2505000e+00 )
+ ( -1.1592600e+01 , 1.2505000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1662800e+01 , 1.2415000e+00 )
+ ( -1.1662800e+01 , 1.2415000e+00 )
+ ( -1.1662800e+01 , 1.2415000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1732900e+01 , 1.2325000e+00 )
+ ( -1.1732900e+01 , 1.2325000e+00 )
+ ( -1.1732900e+01 , 1.2325000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1803000e+01 , 1.2236000e+00 )
+ ( -1.1803000e+01 , 1.2236000e+00 )
+ ( -1.1803000e+01 , 1.2236000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1873000e+01 , 1.2148000e+00 )
+ ( -1.1873000e+01 , 1.2148000e+00 )
+ ( -1.1873000e+01 , 1.2148000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.1943000e+01 , 1.2062000e+00 )
+ ( -1.1943000e+01 , 1.2062000e+00 )
+ ( -1.1943000e+01 , 1.2062000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2013000e+01 , 1.1976000e+00 )
+ ( -1.2013000e+01 , 1.1976000e+00 )
+ ( -1.2013000e+01 , 1.1976000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2082900e+01 , 1.1891000e+00 )
+ ( -1.2082900e+01 , 1.1891000e+00 )
+ ( -1.2082900e+01 , 1.1891000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2152700e+01 , 1.1807000e+00 )
+ ( -1.2152700e+01 , 1.1807000e+00 )
+ ( -1.2152700e+01 , 1.1807000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2222500e+01 , 1.1724000e+00 )
+ ( -1.2222500e+01 , 1.1724000e+00 )
+ ( -1.2222500e+01 , 1.1724000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2292300e+01 , 1.1643000e+00 )
+ ( -1.2292300e+01 , 1.1643000e+00 )
+ ( -1.2292300e+01 , 1.1643000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2362000e+01 , 1.1562000e+00 )
+ ( -1.2362000e+01 , 1.1562000e+00 )
+ ( -1.2362000e+01 , 1.1562000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2431700e+01 , 1.1483000e+00 )
+ ( -1.2431700e+01 , 1.1483000e+00 )
+ ( -1.2431700e+01 , 1.1483000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2501400e+01 , 1.1406000e+00 )
+ ( -1.2501400e+01 , 1.1406000e+00 )
+ ( -1.2501400e+01 , 1.1406000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2571000e+01 , 1.1329000e+00 )
+ ( -1.2571000e+01 , 1.1329000e+00 )
+ ( -1.2571000e+01 , 1.1329000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2640800e+01 , 1.1254000e+00 )
+ ( -1.2640800e+01 , 1.1254000e+00 )
+ ( -1.2640800e+01 , 1.1254000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2710300e+01 , 1.1181000e+00 )
+ ( -1.2710300e+01 , 1.1181000e+00 )
+ ( -1.2710300e+01 , 1.1181000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2779800e+01 , 1.1109000e+00 )
+ ( -1.2779800e+01 , 1.1109000e+00 )
+ ( -1.2779800e+01 , 1.1109000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2849400e+01 , 1.1039000e+00 )
+ ( -1.2849400e+01 , 1.1039000e+00 )
+ ( -1.2849400e+01 , 1.1039000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2919000e+01 , 1.0969000e+00 )
+ ( -1.2919000e+01 , 1.0969000e+00 )
+ ( -1.2919000e+01 , 1.0969000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.2988500e+01 , 1.0902000e+00 )
+ ( -1.2988500e+01 , 1.0902000e+00 )
+ ( -1.2988500e+01 , 1.0902000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3058000e+01 , 1.0837000e+00 )
+ ( -1.3058000e+01 , 1.0837000e+00 )
+ ( -1.3058000e+01 , 1.0837000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3127500e+01 , 1.0773000e+00 )
+ ( -1.3127500e+01 , 1.0773000e+00 )
+ ( -1.3127500e+01 , 1.0773000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3197100e+01 , 1.0710000e+00 )
+ ( -1.3197100e+01 , 1.0710000e+00 )
+ ( -1.3197100e+01 , 1.0710000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3266600e+01 , 1.0650000e+00 )
+ ( -1.3266600e+01 , 1.0650000e+00 )
+ ( -1.3266600e+01 , 1.0650000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3336100e+01 , 1.0591000e+00 )
+ ( -1.3336100e+01 , 1.0591000e+00 )
+ ( -1.3336100e+01 , 1.0591000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3405600e+01 , 1.0535000e+00 )
+ ( -1.3405600e+01 , 1.0535000e+00 )
+ ( -1.3405600e+01 , 1.0535000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3475100e+01 , 1.0480000e+00 )
+ ( -1.3475100e+01 , 1.0480000e+00 )
+ ( -1.3475100e+01 , 1.0480000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3544600e+01 , 1.0427000e+00 )
+ ( -1.3544600e+01 , 1.0427000e+00 )
+ ( -1.3544600e+01 , 1.0427000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3614200e+01 , 1.0376000e+00 )
+ ( -1.3614200e+01 , 1.0376000e+00 )
+ ( -1.3614200e+01 , 1.0376000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3683800e+01 , 1.0338000e+00 )
+ ( -1.3683800e+01 , 1.0338000e+00 )
+ ( -1.3683800e+01 , 1.0338000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3753600e+01 , 1.0313000e+00 )
+ ( -1.3753600e+01 , 1.0313000e+00 )
+ ( -1.3753600e+01 , 1.0313000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3823400e+01 , 1.0289000e+00 )
+ ( -1.3823400e+01 , 1.0289000e+00 )
+ ( -1.3823400e+01 , 1.0289000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3893200e+01 , 1.0268000e+00 )
+ ( -1.3893200e+01 , 1.0268000e+00 )
+ ( -1.3893200e+01 , 1.0268000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.3963000e+01 , 1.0248000e+00 )
+ ( -1.3963000e+01 , 1.0248000e+00 )
+ ( -1.3963000e+01 , 1.0248000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4032800e+01 , 1.0230000e+00 )
+ ( -1.4032800e+01 , 1.0230000e+00 )
+ ( -1.4032800e+01 , 1.0230000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4102700e+01 , 1.0215000e+00 )
+ ( -1.4102700e+01 , 1.0215000e+00 )
+ ( -1.4102700e+01 , 1.0215000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4172500e+01 , 1.0200000e+00 )
+ ( -1.4172500e+01 , 1.0200000e+00 )
+ ( -1.4172500e+01 , 1.0200000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4242500e+01 , 1.0188000e+00 )
+ ( -1.4242500e+01 , 1.0188000e+00 )
+ ( -1.4242500e+01 , 1.0188000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4312400e+01 , 1.0177000e+00 )
+ ( -1.4312400e+01 , 1.0177000e+00 )
+ ( -1.4312400e+01 , 1.0177000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4382300e+01 , 1.0168000e+00 )
+ ( -1.4382300e+01 , 1.0168000e+00 )
+ ( -1.4382300e+01 , 1.0168000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4452300e+01 , 1.0161000e+00 )
+ ( -1.4452300e+01 , 1.0161000e+00 )
+ ( -1.4452300e+01 , 1.0161000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4522300e+01 , 1.0155000e+00 )
+ ( -1.4522300e+01 , 1.0155000e+00 )
+ ( -1.4522300e+01 , 1.0155000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4592400e+01 , 1.0151000e+00 )
+ ( -1.4592400e+01 , 1.0151000e+00 )
+ ( -1.4592400e+01 , 1.0151000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4662400e+01 , 1.0148000e+00 )
+ ( -1.4662400e+01 , 1.0148000e+00 )
+ ( -1.4662400e+01 , 1.0148000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4732600e+01 , 1.0147000e+00 )
+ ( -1.4732600e+01 , 1.0147000e+00 )
+ ( -1.4732600e+01 , 1.0147000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4802700e+01 , 1.0148000e+00 )
+ ( -1.4802700e+01 , 1.0148000e+00 )
+ ( -1.4802700e+01 , 1.0148000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4872900e+01 , 1.0150000e+00 )
+ ( -1.4872900e+01 , 1.0150000e+00 )
+ ( -1.4872900e+01 , 1.0150000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.4943100e+01 , 1.0153000e+00 )
+ ( -1.4943100e+01 , 1.0153000e+00 )
+ ( -1.4943100e+01 , 1.0153000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5013300e+01 , 1.0158000e+00 )
+ ( -1.5013300e+01 , 1.0158000e+00 )
+ ( -1.5013300e+01 , 1.0158000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5083600e+01 , 1.0164000e+00 )
+ ( -1.5083600e+01 , 1.0164000e+00 )
+ ( -1.5083600e+01 , 1.0164000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5154000e+01 , 1.0172000e+00 )
+ ( -1.5154000e+01 , 1.0172000e+00 )
+ ( -1.5154000e+01 , 1.0172000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5224300e+01 , 1.0180000e+00 )
+ ( -1.5224300e+01 , 1.0180000e+00 )
+ ( -1.5224300e+01 , 1.0180000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5294800e+01 , 1.0190000e+00 )
+ ( -1.5294800e+01 , 1.0190000e+00 )
+ ( -1.5294800e+01 , 1.0190000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5365200e+01 , 1.0202000e+00 )
+ ( -1.5365200e+01 , 1.0202000e+00 )
+ ( -1.5365200e+01 , 1.0202000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5435700e+01 , 1.0215000e+00 )
+ ( -1.5435700e+01 , 1.0215000e+00 )
+ ( -1.5435700e+01 , 1.0215000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5506300e+01 , 1.0228000e+00 )
+ ( -1.5506300e+01 , 1.0228000e+00 )
+ ( -1.5506300e+01 , 1.0228000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5576900e+01 , 1.0243000e+00 )
+ ( -1.5576900e+01 , 1.0243000e+00 )
+ ( -1.5576900e+01 , 1.0243000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5647500e+01 , 1.0260000e+00 )
+ ( -1.5647500e+01 , 1.0260000e+00 )
+ ( -1.5647500e+01 , 1.0260000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5718200e+01 , 1.0277000e+00 )
+ ( -1.5718200e+01 , 1.0277000e+00 )
+ ( -1.5718200e+01 , 1.0277000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5789000e+01 , 1.0295000e+00 )
+ ( -1.5789000e+01 , 1.0295000e+00 )
+ ( -1.5789000e+01 , 1.0295000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5859700e+01 , 1.0315000e+00 )
+ ( -1.5859700e+01 , 1.0315000e+00 )
+ ( -1.5859700e+01 , 1.0315000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.5930600e+01 , 1.0335000e+00 )
+ ( -1.5930600e+01 , 1.0335000e+00 )
+ ( -1.5930600e+01 , 1.0335000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6001500e+01 , 1.0357000e+00 )
+ ( -1.6001500e+01 , 1.0357000e+00 )
+ ( -1.6001500e+01 , 1.0357000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6072400e+01 , 1.0379000e+00 )
+ ( -1.6072400e+01 , 1.0379000e+00 )
+ ( -1.6072400e+01 , 1.0379000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6143500e+01 , 1.0403000e+00 )
+ ( -1.6143500e+01 , 1.0403000e+00 )
+ ( -1.6143500e+01 , 1.0403000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6214500e+01 , 1.0427000e+00 )
+ ( -1.6214500e+01 , 1.0427000e+00 )
+ ( -1.6214500e+01 , 1.0427000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6285600e+01 , 1.0453000e+00 )
+ ( -1.6285600e+01 , 1.0453000e+00 )
+ ( -1.6285600e+01 , 1.0453000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6356800e+01 , 1.0479000e+00 )
+ ( -1.6356800e+01 , 1.0479000e+00 )
+ ( -1.6356800e+01 , 1.0479000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6428100e+01 , 1.0506000e+00 )
+ ( -1.6428100e+01 , 1.0506000e+00 )
+ ( -1.6428100e+01 , 1.0506000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6499400e+01 , 1.0534000e+00 )
+ ( -1.6499400e+01 , 1.0534000e+00 )
+ ( -1.6499400e+01 , 1.0534000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6570700e+01 , 1.0563000e+00 )
+ ( -1.6570700e+01 , 1.0563000e+00 )
+ ( -1.6570700e+01 , 1.0563000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6642100e+01 , 1.0592000e+00 )
+ ( -1.6642100e+01 , 1.0592000e+00 )
+ ( -1.6642100e+01 , 1.0592000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6713600e+01 , 1.0622000e+00 )
+ ( -1.6713600e+01 , 1.0622000e+00 )
+ ( -1.6713600e+01 , 1.0622000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6785200e+01 , 1.0653000e+00 )
+ ( -1.6785200e+01 , 1.0653000e+00 )
+ ( -1.6785200e+01 , 1.0653000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6856700e+01 , 1.0682000e+00 )
+ ( -1.6856700e+01 , 1.0682000e+00 )
+ ( -1.6856700e+01 , 1.0682000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6928200e+01 , 1.0709000e+00 )
+ ( -1.6928200e+01 , 1.0709000e+00 )
+ ( -1.6928200e+01 , 1.0709000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.6999900e+01 , 1.0736000e+00 )
+ ( -1.6999900e+01 , 1.0736000e+00 )
+ ( -1.6999900e+01 , 1.0736000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7071500e+01 , 1.0764000e+00 )
+ ( -1.7071500e+01 , 1.0764000e+00 )
+ ( -1.7071500e+01 , 1.0764000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7143300e+01 , 1.0793000e+00 )
+ ( -1.7143300e+01 , 1.0793000e+00 )
+ ( -1.7143300e+01 , 1.0793000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7215100e+01 , 1.0822000e+00 )
+ ( -1.7215100e+01 , 1.0822000e+00 )
+ ( -1.7215100e+01 , 1.0822000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7287000e+01 , 1.0852000e+00 )
+ ( -1.7287000e+01 , 1.0852000e+00 )
+ ( -1.7287000e+01 , 1.0852000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7359000e+01 , 1.0882000e+00 )
+ ( -1.7359000e+01 , 1.0882000e+00 )
+ ( -1.7359000e+01 , 1.0882000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7431000e+01 , 1.0914000e+00 )
+ ( -1.7431000e+01 , 1.0914000e+00 )
+ ( -1.7431000e+01 , 1.0914000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7503100e+01 , 1.0945000e+00 )
+ ( -1.7503100e+01 , 1.0945000e+00 )
+ ( -1.7503100e+01 , 1.0945000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7575300e+01 , 1.0978000e+00 )
+ ( -1.7575300e+01 , 1.0978000e+00 )
+ ( -1.7575300e+01 , 1.0978000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7647500e+01 , 1.1011000e+00 )
+ ( -1.7647500e+01 , 1.1011000e+00 )
+ ( -1.7647500e+01 , 1.1011000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7719900e+01 , 1.1044000e+00 )
+ ( -1.7719900e+01 , 1.1044000e+00 )
+ ( -1.7719900e+01 , 1.1044000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7792300e+01 , 1.1078000e+00 )
+ ( -1.7792300e+01 , 1.1078000e+00 )
+ ( -1.7792300e+01 , 1.1078000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7864800e+01 , 1.1113000e+00 )
+ ( -1.7864800e+01 , 1.1113000e+00 )
+ ( -1.7864800e+01 , 1.1113000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.7937300e+01 , 1.1148000e+00 )
+ ( -1.7937300e+01 , 1.1148000e+00 )
+ ( -1.7937300e+01 , 1.1148000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8009900e+01 , 1.1184000e+00 )
+ ( -1.8009900e+01 , 1.1184000e+00 )
+ ( -1.8009900e+01 , 1.1184000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8082700e+01 , 1.1220000e+00 )
+ ( -1.8082700e+01 , 1.1220000e+00 )
+ ( -1.8082700e+01 , 1.1220000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8155500e+01 , 1.1257000e+00 )
+ ( -1.8155500e+01 , 1.1257000e+00 )
+ ( -1.8155500e+01 , 1.1257000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8228400e+01 , 1.1295000e+00 )
+ ( -1.8228400e+01 , 1.1295000e+00 )
+ ( -1.8228400e+01 , 1.1295000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8301400e+01 , 1.1333000e+00 )
+ ( -1.8301400e+01 , 1.1333000e+00 )
+ ( -1.8301400e+01 , 1.1333000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8374500e+01 , 1.1371000e+00 )
+ ( -1.8374500e+01 , 1.1371000e+00 )
+ ( -1.8374500e+01 , 1.1371000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8447600e+01 , 1.1410000e+00 )
+ ( -1.8447600e+01 , 1.1410000e+00 )
+ ( -1.8447600e+01 , 1.1410000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8520700e+01 , 1.1449000e+00 )
+ ( -1.8520700e+01 , 1.1449000e+00 )
+ ( -1.8520700e+01 , 1.1449000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8594200e+01 , 1.1489000e+00 )
+ ( -1.8594200e+01 , 1.1489000e+00 )
+ ( -1.8594200e+01 , 1.1489000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8667600e+01 , 1.1529000e+00 )
+ ( -1.8667600e+01 , 1.1529000e+00 )
+ ( -1.8667600e+01 , 1.1529000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8741100e+01 , 1.1570000e+00 )
+ ( -1.8741100e+01 , 1.1570000e+00 )
+ ( -1.8741100e+01 , 1.1570000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8814700e+01 , 1.1612000e+00 )
+ ( -1.8814700e+01 , 1.1612000e+00 )
+ ( -1.8814700e+01 , 1.1612000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8888400e+01 , 1.1653000e+00 )
+ ( -1.8888400e+01 , 1.1653000e+00 )
+ ( -1.8888400e+01 , 1.1653000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.8962100e+01 , 1.1695000e+00 )
+ ( -1.8962100e+01 , 1.1695000e+00 )
+ ( -1.8962100e+01 , 1.1695000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9036000e+01 , 1.1738000e+00 )
+ ( -1.9036000e+01 , 1.1738000e+00 )
+ ( -1.9036000e+01 , 1.1738000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9110000e+01 , 1.1781000e+00 )
+ ( -1.9110000e+01 , 1.1781000e+00 )
+ ( -1.9110000e+01 , 1.1781000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9184100e+01 , 1.1824000e+00 )
+ ( -1.9184100e+01 , 1.1824000e+00 )
+ ( -1.9184100e+01 , 1.1824000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9258200e+01 , 1.1868000e+00 )
+ ( -1.9258200e+01 , 1.1868000e+00 )
+ ( -1.9258200e+01 , 1.1868000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9332500e+01 , 1.1912000e+00 )
+ ( -1.9332500e+01 , 1.1912000e+00 )
+ ( -1.9332500e+01 , 1.1912000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9406800e+01 , 1.1957000e+00 )
+ ( -1.9406800e+01 , 1.1957000e+00 )
+ ( -1.9406800e+01 , 1.1957000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9481300e+01 , 1.2002000e+00 )
+ ( -1.9481300e+01 , 1.2002000e+00 )
+ ( -1.9481300e+01 , 1.2002000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9555800e+01 , 1.2047000e+00 )
+ ( -1.9555800e+01 , 1.2047000e+00 )
+ ( -1.9555800e+01 , 1.2047000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9630400e+01 , 1.2093000e+00 )
+ ( -1.9630400e+01 , 1.2093000e+00 )
+ ( -1.9630400e+01 , 1.2093000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9705200e+01 , 1.2139000e+00 )
+ ( -1.9705200e+01 , 1.2139000e+00 )
+ ( -1.9705200e+01 , 1.2139000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9780000e+01 , 1.2185000e+00 )
+ ( -1.9780000e+01 , 1.2185000e+00 )
+ ( -1.9780000e+01 , 1.2185000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9855000e+01 , 1.2232000e+00 )
+ ( -1.9855000e+01 , 1.2232000e+00 )
+ ( -1.9855000e+01 , 1.2232000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -1.9930000e+01 , 1.2279000e+00 )
+ ( -1.9930000e+01 , 1.2279000e+00 )
+ ( -1.9930000e+01 , 1.2279000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0005100e+01 , 1.2327000e+00 )
+ ( -2.0005100e+01 , 1.2327000e+00 )
+ ( -2.0005100e+01 , 1.2327000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0080400e+01 , 1.2375000e+00 )
+ ( -2.0080400e+01 , 1.2375000e+00 )
+ ( -2.0080400e+01 , 1.2375000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0155800e+01 , 1.2423000e+00 )
+ ( -2.0155800e+01 , 1.2423000e+00 )
+ ( -2.0155800e+01 , 1.2423000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0231200e+01 , 1.2471000e+00 )
+ ( -2.0231200e+01 , 1.2471000e+00 )
+ ( -2.0231200e+01 , 1.2471000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0306800e+01 , 1.2511000e+00 )
+ ( -2.0306800e+01 , 1.2511000e+00 )
+ ( -2.0306800e+01 , 1.2511000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0382500e+01 , 1.2569000e+00 )
+ ( -2.0382500e+01 , 1.2569000e+00 )
+ ( -2.0382500e+01 , 1.2569000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0458300e+01 , 1.2618000e+00 )
+ ( -2.0458300e+01 , 1.2618000e+00 )
+ ( -2.0458300e+01 , 1.2618000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0534200e+01 , 1.2668000e+00 )
+ ( -2.0534200e+01 , 1.2668000e+00 )
+ ( -2.0534200e+01 , 1.2668000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0610200e+01 , 1.2718000e+00 )
+ ( -2.0610200e+01 , 1.2718000e+00 )
+ ( -2.0610200e+01 , 1.2718000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0686400e+01 , 1.2769000e+00 )
+ ( -2.0686400e+01 , 1.2769000e+00 )
+ ( -2.0686400e+01 , 1.2769000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0762800e+01 , 1.2821000e+00 )
+ ( -2.0762800e+01 , 1.2821000e+00 )
+ ( -2.0762800e+01 , 1.2821000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0839300e+01 , 1.2873000e+00 )
+ ( -2.0839300e+01 , 1.2873000e+00 )
+ ( -2.0839300e+01 , 1.2873000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0915600e+01 , 1.2925000e+00 )
+ ( -2.0915600e+01 , 1.2925000e+00 )
+ ( -2.0915600e+01 , 1.2925000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.0992500e+01 , 1.2977000e+00 )
+ ( -2.0992500e+01 , 1.2977000e+00 )
+ ( -2.0992500e+01 , 1.2977000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1069400e+01 , 1.3030000e+00 )
+ ( -2.1069400e+01 , 1.3030000e+00 )
+ ( -2.1069400e+01 , 1.3030000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1146300e+01 , 1.3083000e+00 )
+ ( -2.1146300e+01 , 1.3083000e+00 )
+ ( -2.1146300e+01 , 1.3083000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1223300e+01 , 1.3136000e+00 )
+ ( -2.1223300e+01 , 1.3136000e+00 )
+ ( -2.1223300e+01 , 1.3136000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1300400e+01 , 1.3189000e+00 )
+ ( -2.1300400e+01 , 1.3189000e+00 )
+ ( -2.1300400e+01 , 1.3189000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1377700e+01 , 1.3243000e+00 )
+ ( -2.1377700e+01 , 1.3243000e+00 )
+ ( -2.1377700e+01 , 1.3243000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1455100e+01 , 1.3296000e+00 )
+ ( -2.1455100e+01 , 1.3296000e+00 )
+ ( -2.1455100e+01 , 1.3296000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1532600e+01 , 1.3350000e+00 )
+ ( -2.1532600e+01 , 1.3350000e+00 )
+ ( -2.1532600e+01 , 1.3350000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1610100e+01 , 1.3404000e+00 )
+ ( -2.1610100e+01 , 1.3404000e+00 )
+ ( -2.1610100e+01 , 1.3404000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1687800e+01 , 1.3458000e+00 )
+ ( -2.1687800e+01 , 1.3458000e+00 )
+ ( -2.1687800e+01 , 1.3458000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1765700e+01 , 1.3513000e+00 )
+ ( -2.1765700e+01 , 1.3513000e+00 )
+ ( -2.1765700e+01 , 1.3513000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1843600e+01 , 1.3567000e+00 )
+ ( -2.1843600e+01 , 1.3567000e+00 )
+ ( -2.1843600e+01 , 1.3567000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1921600e+01 , 1.3622000e+00 )
+ ( -2.1921600e+01 , 1.3622000e+00 )
+ ( -2.1921600e+01 , 1.3622000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.1999800e+01 , 1.3677000e+00 )
+ ( -2.1999800e+01 , 1.3677000e+00 )
+ ( -2.1999800e+01 , 1.3677000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2078100e+01 , 1.3731000e+00 )
+ ( -2.2078100e+01 , 1.3731000e+00 )
+ ( -2.2078100e+01 , 1.3731000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2156400e+01 , 1.3786000e+00 )
+ ( -2.2156400e+01 , 1.3786000e+00 )
+ ( -2.2156400e+01 , 1.3786000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2234900e+01 , 1.3842000e+00 )
+ ( -2.2234900e+01 , 1.3842000e+00 )
+ ( -2.2234900e+01 , 1.3842000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2313600e+01 , 1.3897000e+00 )
+ ( -2.2313600e+01 , 1.3897000e+00 )
+ ( -2.2313600e+01 , 1.3897000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2392300e+01 , 1.3952000e+00 )
+ ( -2.2392300e+01 , 1.3952000e+00 )
+ ( -2.2392300e+01 , 1.3952000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2471100e+01 , 1.4007000e+00 )
+ ( -2.2471100e+01 , 1.4007000e+00 )
+ ( -2.2471100e+01 , 1.4007000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2550100e+01 , 1.4063000e+00 )
+ ( -2.2550100e+01 , 1.4063000e+00 )
+ ( -2.2550100e+01 , 1.4063000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2629200e+01 , 1.4118000e+00 )
+ ( -2.2629200e+01 , 1.4118000e+00 )
+ ( -2.2629200e+01 , 1.4118000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2708300e+01 , 1.4174000e+00 )
+ ( -2.2708300e+01 , 1.4174000e+00 )
+ ( -2.2708300e+01 , 1.4174000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2787600e+01 , 1.4229000e+00 )
+ ( -2.2787600e+01 , 1.4229000e+00 )
+ ( -2.2787600e+01 , 1.4229000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2867100e+01 , 1.4285000e+00 )
+ ( -2.2867100e+01 , 1.4285000e+00 )
+ ( -2.2867100e+01 , 1.4285000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.2946600e+01 , 1.4341000e+00 )
+ ( -2.2946600e+01 , 1.4341000e+00 )
+ ( -2.2946600e+01 , 1.4341000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3026200e+01 , 1.4396000e+00 )
+ ( -2.3026200e+01 , 1.4396000e+00 )
+ ( -2.3026200e+01 , 1.4396000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3106000e+01 , 1.4452000e+00 )
+ ( -2.3106000e+01 , 1.4452000e+00 )
+ ( -2.3106000e+01 , 1.4452000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3185900e+01 , 1.4508000e+00 )
+ ( -2.3185900e+01 , 1.4508000e+00 )
+ ( -2.3185900e+01 , 1.4508000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3265900e+01 , 1.4564000e+00 )
+ ( -2.3265900e+01 , 1.4564000e+00 )
+ ( -2.3265900e+01 , 1.4564000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3346000e+01 , 1.4620000e+00 )
+ ( -2.3346000e+01 , 1.4620000e+00 )
+ ( -2.3346000e+01 , 1.4620000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3426200e+01 , 1.4675000e+00 )
+ ( -2.3426200e+01 , 1.4675000e+00 )
+ ( -2.3426200e+01 , 1.4675000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3506600e+01 , 1.4731000e+00 )
+ ( -2.3506600e+01 , 1.4731000e+00 )
+ ( -2.3506600e+01 , 1.4731000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3587000e+01 , 1.4787000e+00 )
+ ( -2.3587000e+01 , 1.4787000e+00 )
+ ( -2.3587000e+01 , 1.4787000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3667600e+01 , 1.4842000e+00 )
+ ( -2.3667600e+01 , 1.4842000e+00 )
+ ( -2.3667600e+01 , 1.4842000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3748300e+01 , 1.4898000e+00 )
+ ( -2.3748300e+01 , 1.4898000e+00 )
+ ( -2.3748300e+01 , 1.4898000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3829100e+01 , 1.4954000e+00 )
+ ( -2.3829100e+01 , 1.4954000e+00 )
+ ( -2.3829100e+01 , 1.4954000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3910100e+01 , 1.5009000e+00 )
+ ( -2.3910100e+01 , 1.5009000e+00 )
+ ( -2.3910100e+01 , 1.5009000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.3991100e+01 , 1.5065000e+00 )
+ ( -2.3991100e+01 , 1.5065000e+00 )
+ ( -2.3991100e+01 , 1.5065000e+00 )
+ ( 2.2500000e+00 , 0.0000000e+00 )
+ ( -2.4072300e+01 , 1.5120000e+00 )
+ ( -2.4072300e+01 , 1.5120000e+00 )
+ ( -2.4072300e+01 , 1.5120000e+00 )
\ No newline at end of file
diff --git a/test_data/cluster/case_3/clu_s8L23.f b/test_data/cluster/case_3/clu_s8L23.f
new file mode 100644
index 0000000000000000000000000000000000000000..83609769ab5843a7b16e019e41093bd731719e79
--- /dev/null
+++ b/test_data/cluster/case_3/clu_s8L23.f
@@ -0,0 +1,3474 @@
+ PROGRAM CLU
+CCC 111130
+CCC SUPPORTS EXPERIMENTAL DIELECTRIC FUNCTIONS ONLY
+CCC NSPH=8; LI=23, LE=23; NXI=2000
+CCC
+CCC FOR IDFC>=0 ONLY,
+CCC WHEN JXI=JWTM WRITES THE JWTM-TH TRANSITION MATRIX
+CCC
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC COMMON/C1/VH(NCOU*LITPO),VJ0(NSPH*LMTPO),
+CCC 1VYHJ(NCOU*LITPOS),VYJ0(NSPH*LMTPOS),
+CCC 2RMI(LI,NSPH),REI(LI,NSPH),W(NLEMT,4),
+CCC 3AM0M(NLEMT,NLEMT),FSAS(NSPH),SAS(NSPH,2,2),VINTS(NSPH,16),
+CCC 4V3J0(NV3J),SSCS(NSPH),SEXS(NSPH),SABS(NSPH),
+CCC 5SQSCS(NSPH),SQEXS(NSPH),SQABS(NSPH),GCSV(NSPH),
+CCC 6RXX(NSPH),RYY(NSPH),RZZ(NSPH),ROS(NSPH),RC(NSPH,NSHL),
+CCC 7IND3J(LMPO,LM),IOG(NSPH),NSHL(NSPH)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+CCC COMMON/C2/RIS(NHSPO),DLRI(NHSPO),DC0(NSHL-NTL+1),
+CCC 1VKT(NSPH),VSZ(NSPH)
+CCC NHSPO=MAX0(NPNT,NPNTTS)*2-1
+ COMMON/C2/RIS(999),DLRI(999),DC0(5),VKT(8),VSZ(8)
+ COMPLEX*16 RIS,DLRI,DC0,VKT
+ COMMON/C3/TFSAS,TSAS(2,2),GCS,SCS,ECS,ACS
+ COMPLEX*16 TFSAS,TSAS
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+CCC COMMON/C6/RAC3J(LMTPO)
+ COMMON/C6/RAC3J(47)
+CCC COMMON/C9/GIS(NDI,NLEM),GLS(NDI,NLEM),SAM(NDIT,NLEMT)
+ COMMON/C9/GIS(4600,575),GLS(4600,575),SAM(9200,1150)
+ COMPLEX*16 GIS,GLS,SAM
+CCC DIMENSION AM(MXNDM,MXNDM)
+CCC NDIT.LE.MXNDM
+ DIMENSION AM(9200,9200)
+ COMPLEX*16 AM
+CCC DIMENSION RCF(NSPH,NSHL)
+ DIMENSION RCF(8,8),CMULLR(4,4),CMUL(4,4),CEXTLR(4,4),CEXT(4,4),
+ 1U(3),US(3),UN(3),UNS(3),UP(3),UPS(3),
+ 2UNMP(3),UNSMP(3),UPMP(3),UPSMP(3),DUK(3),ARGI(1),ARGS(1)
+CCC DIMENSION ZPV(LM,3,2,2),GAPS(NSPH)
+ DIMENSION ZPV(23,3,2,2),GAPS(8),GAPV(3),
+ 1GAP(3,2),GAPP(3,2),GAPM(3,2),GAPPM(3,2)
+ COMPLEX*16 GAPP,GAPPM
+CCC DIMENSION TQSE(2,NSPH),TQSPE(2,NSPH),TQSS(2,NSPH),TQSPS(2,NSPH)
+ DIMENSION TQSE(2,8),TQSPE(2,8),TQSS(2,8),TQSPS(2,8),
+ 1TQEV(3),TQSV(3),TQCE(2,3),TQCPE(2,3),TQCS(2,3),TQCPS(2,3)
+ COMPLEX*16 TQSPE,TQSPS,TQCPE,TQCPS
+CCC DIMENSION DC0M(NSPH,NSHL-NTL),XIV(NXI)
+ DIMENSION DC0M(8,4),XIV(2000)
+ COMPLEX*16 DC0M
+ COMPLEX*16 ARG,S0,S0M
+ 8010 FORMAT(1H ,16I5)
+ 8015 FORMAT(1H ,
+ 1'READ(IR,*)NSPH,LI,LE,MXNDM,INPOL,NPNT,NPNTTS,IAVM,ISAM')
+ 8050 FORMAT(3(1PD17.8))
+ 8060 FORMAT(1H ,'READ(IR,*)RXX(I),RYY(I),RZZ(I)')
+ 8068 FORMAT(1H ,'READ(IR,*)TH,THSTP,THLST,THS,THSSTP,THSLST')
+ 8069 FORMAT(1H ,'READ(IR,*)PH,PHSTP,PHLST,PHS,PHSSTP,PHSLST')
+ 8170 FORMAT(1H ,7(1PD10.3))
+ 8171 FORMAT(1H ,'READ(IR,*)JWTM')
+ 6000 FORMAT(1H )
+ 6050 FORMAT(1H ,' SIZE=',1PD15.7,', REFRACTIVE INDEX=',2(1PD15.7))
+ 6055 FORMAT(1H ,' SIZE=',1PD15.7)
+ 6060 FORMAT(1H ,' CIRC ',I2)
+ 6061 FORMAT(1H ,' CIRC')
+ 6065 FORMAT(1H ,' LIN ',I2)
+ 6066 FORMAT(1H ,' LIN')
+ 6068 FORMAT(1H ,4X,'SPHERES; LMX=LI')
+ 6069 FORMAT(1H ,4X,'SPHERES; LMX=MIN0(LI,LE)')
+ 6070 FORMAT(1H ,4X,'SPHERE ',I2)
+ 6080 FORMAT(1H ,4X,'CLUSTER')
+ 6100 FORMAT(1H ,'----- SCS ----- ABS ----- EXS ----- ALBEDS --')
+ 6150 FORMAT(1H ,1PD14.7,5(1PD15.7))
+ 6165 FORMAT(1H ,' UN=(',1PD12.5,',',1PD12.5,',',1PD12.5,')')
+ 6166 FORMAT(1H ,' UNI=(',1PD12.5,',',1PD12.5,',',1PD12.5,')')
+ 6167 FORMAT(1H ,' UNS=(',1PD12.5,',',1PD12.5,',',1PD12.5,')')
+ 6200 FORMAT(1H ,'---- SCS/GS -- ABS/GS -- EXS/GS ---')
+ 6240 FORMAT(1H ,1X,'FSAS=',2(1PD15.7))
+ 6242 FORMAT(1H ,1X,'SAS(1,1)=',2(1PD15.7),', SAS(2,1)=',2(1PD15.7))
+ 6243 FORMAT(1H ,1X,'SAS(1,2)=',2(1PD15.7),', SAS(2,2)=',2(1PD15.7))
+ 6250 FORMAT(1H ,1X,'FSAT=',2(1PD15.7))
+ 6252 FORMAT(1H ,1X,'SAT(1,1)=',2(1PD15.7),', SAT(2,1)=',2(1PD15.7))
+ 6253 FORMAT(1H ,1X,'SAT(1,2)=',2(1PD15.7),', SAT(2,2)=',2(1PD15.7))
+ 6300 FORMAT(1H ,' STOP IN LUCIN: MATRIX SINGULAR')
+ 6331 FORMAT(1H ,1X,'MULS')
+ 6332 FORMAT(1H ,1X,'MULC')
+ 6336 FORMAT(1H ,1X,'MULSLR')
+ 6337 FORMAT(1H ,1X,'MULCLR')
+ 6350 FORMAT((1H ,7X,4(1PD15.7)))
+ 6460 FORMAT(1H ,4X,'CLUSTER (ENSEMBLE AVERAGE, MODE',I2,')')
+ 6500 FORMAT(1H ,'----- SCC ----- ABC ----- EXC ----- ALBEDC --')
+ 6550 FORMAT
+ 1(1H ,' AT ',I1,' LCALC=',I3,' TOO SMALL WITH ARG=',2(1PD15.7))
+ 6600 FORMAT(1H ,'--- SCC/TGS - ABC/TGS - EXC/TGS ---')
+ 6650 FORMAT(1H ,' STOP IN HJV')
+ 6700 FORMAT(1H ,'---- SCCRT --- ABCRT --- EXCRT ----')
+ 6710 FORMAT(1H ,' REFR. INDEX OF EXTERNAL MEDIUM=',1PD15.7)
+ 6714 FORMAT(1H ,' VK=',1PD15.7,', XI IS SCALE FACTOR FOR LENGTHS')
+ 6715 FORMAT(1H ,' VK=',1PD15.7,', XI=',1PD15.7)
+ 6716 FORMAT(1H ,' XI=',1PD15.7)
+ 6720 FORMAT(1H ,' TIDG=',1PD10.3,', PIDG=',1PD10.3,
+ 1', TSDG=',1PD10.3,', PSDG=',1PD10.3)
+ 6721 FORMAT(1H ,' CFMP=',1PD15.7,', SFMP=',1PD15.7)
+ 6722 FORMAT(1H ,' CFSP=',1PD15.7,', SFSP=',1PD15.7)
+ 6740 FORMAT(1H ,' SCAND=',1PD10.3)
+ 6750 FORMAT(1H ,' STOP IN DME')
+ 6800 FORMAT(1H ,1X,2('FSAC(',I1,',',I1,')=',2(1PD15.7),3X))
+ 6810 FORMAT(1H ,1X,2(' SAC(',I1,',',I1,')=',2(1PD15.7),3X))
+ 6850 FORMAT(1H ,1X,'RE(FSAC(',I1,',',I1,'))/RE(TFSAS)=',1PD15.7,
+ 1', IM(FSAC(',I1,',',I1,'))/IM(TFSAS)=',1PD15.7)
+ 6930 FORMAT(1H ,1X,'QSCHU=',1PD15.7,', PSCHU=',1PD15.7,
+ 1', S0MAG=',1PD15.7)
+ 6940 FORMAT(1H ,1X,'(RE(FSAC(1,1))-RE(FSAC(2,2)))/RE(FSAC(1,1))=',
+ 11PD15.7)
+ 6945 FORMAT(1H ,1X,'(IM(FSAC(1,1))-IM(FSAC(2,2)))/IM(FSAC(1,1))=',
+ 11PD15.7)
+ 6970 FORMAT(1H ,' COSAV=',1PD15.7,', RAPRS=',1PD15.7)
+ 6971 FORMAT(1H ,' Fx=',1PD15.7,', Fy=',1PD15.7,', Fz=',1PD15.7)
+ 6973 FORMAT(1H ,' Fl=',1PD15.7,', Fr=',1PD15.7,', Fk=',1PD15.7)
+ 6974 FORMAT(1H ,' Fk=',1PD15.7)
+ 6977 FORMAT(1H ,' IPO=',I2,', TQEk=',1PD15.7,', TQSk=',1PD15.7)
+ 6981 FORMAT
+ 1(1H ,' TQEx=',1PD15.7,', TQEy=',1PD15.7,', TQEz=',1PD15.7)
+ 6982 FORMAT
+ 1(1H ,' TQSx=',1PD15.7,', TQSy=',1PD15.7,', TQSz=',1PD15.7)
+ 6983 FORMAT
+ 1(1H ,' TQEl=',1PD15.7,', TQEr=',1PD15.7,', TQEk=',1PD15.7)
+ 6984 FORMAT
+ 1(1H ,' TQSl=',1PD15.7,', TQSr=',1PD15.7,', TQSk=',1PD15.7)
+ 6991 FORMAT('========== JXI =',I3,' ====================')
+ 6992 FORMAT('********** JTH =',I3,', JPH =',I3,
+ 1', JTHS =',I3,', JPHS =',I3,' ********************')
+ IR=5
+ IW=6
+ IT=7
+ ITIN=17
+CCC
+CCC OTHER COMMENTS IN FILE GLOBALCOMS
+CCC
+CCC
+CCC CONSTANTS APPEAR AS (...).X(...)D0, OR (...).X(...)D+X(X),
+CCC OR (...).X(...)D-X(X)
+CCC
+CCC
+CCC MXNDM IS FIRST NUMERICAL DECLARED DIMENSION OF AM;
+CCC NDIT=2*NDI; NDI=NSPH*NLIM
+CCC
+CCC
+CCC VK*ROS(I) IS SIZE PARAMETER in vacuo
+CCC
+CCC
+CCC OUTPUTS (NORMALIZED SCATTERING AMPLITUDE)*(2*PIG/(VK*VK)) IN m**3;
+CCC OUTPUTS FORCE*(c/I0) IN m**2;
+CCC OUTPUTS (EXT_TO_TORQUE) AND (SCA_TO_TORQUE) CONTRIBUTIONS
+CCC *(c/I0)*(VK*EXRI)**3; (TORQUE OUTPUTS)/(EXDC*VK*VK) ARE IN m**2
+CCC
+CCC
+CCC ON A LINEAR BASIS,
+CCC POLARIZATION (1), (1,ni), (ns,1) OR -1 IS PARALLE(l),
+CCC POLARIZATION (2), (2,ni), (ns,2) OR 1 IS PERPENDICULA(r);
+CCC ON A CIRCULAR BASIS,
+CCC POLARIZATION (1), (1,ni), (ns,1) OR -1 IS (R)ight,
+CCC POLARIZATION (2), (2,ni), (ns,2) OR 1 IS (L)eft;
+CCC ns=SCATWAVE POLARIZATION, ni=INCWAVE POLARIZATION
+CCC
+CCC
+CCC NV3J=(LM*LMPO*(LMT+7))/6;
+CCC LM=MAX0(LI,LE)
+CCC
+CCC
+CCC IAVM=0 --> RANDOM AVERAGES FOR AMPLITUDE AND CROSS SECTIONS;
+CCC IAVM=1 --> SAME AS IAVM=0, PLUS RANDOM AVERAGES FOR INTENSITY
+CCC
+CCC
+CCC ISAM<0 --> ARBITRARILY VARYING SCATTERING PLANE,
+CCC AS IT IS UNDEFINED FOR FORWARD OR BACKWARD SCATTERING,
+CCC MERIDIONAL PLANE FOR INCIDENCE ANGLES IS ASSUMED;
+CCC ISAM=0 --> MERIDIONAL PLANES
+CCC (I. E. REFERENCE PLANES ACROSS Z AXIS)
+CCC AS DETERMINED BY INCIDENCE AND OBSERVATION ANGLES;
+CCC ISAM=1 --> SCATTERING PLANE ACROSS THE Z AXIS; SCATTERING
+CCC AS A FUNCTION OF INCIDENCE AND OF OBSERVATION ANGLES;
+CCC NEEDS ONLY TH, PH, THS; THSLST GT 180 IF NECESSARY;
+CCC ISAM>1 --> SCATTERING PLANE ACROSS THE Z AXIS; SCATTERING
+CCC AS A FUNCTION OF INCIDENCE ANGLES
+CCC FOR A FIXED SCATTERING ANGLE THSCA=THS-TH;
+CCC NEEDS ONLY TH, PH, THS
+CCC
+ OPEN(IR,FILE='DCLU',STATUS='OLD')
+ READ(IR,*)NSPH,LI,LE,MXNDM,INPOL,NPNT,NPNTTS,IAVM,ISAM
+ DO 101 I=1,NSPH
+ 101 READ(IR,*)RXX(I),RYY(I),RZZ(I)
+ READ(IR,*)TH,THSTP,THLST,THS,THSSTP,THSLST
+ READ(IR,*)PH,PHSTP,PHLST,PHS,PHSSTP,PHSLST
+ READ(IR,*)JWTM
+ CLOSE(IR)
+ OPEN(IW,FILE='OCLU',STATUS='UNKNOWN')
+ WRITE(IW,8015)
+ WRITE(IW,8010)NSPH,LI,LE,MXNDM,INPOL,NPNT,NPNTTS,IAVM,ISAM
+ WRITE(IW,8060)
+ WRITE(IW,8050)(RXX(I),RYY(I),RZZ(I),I=1,NSPH)
+ WRITE(IW,8068)
+ WRITE(IW,8170)TH,THSTP,THLST,THS,THSSTP,THSLST
+ WRITE(IW,8069)
+ WRITE(IW,8170)PH,PHSTP,PHLST,PHS,PHSSTP,PHSLST
+ WRITE(IW,8171)
+ WRITE(IW,8010)JWTM
+ OPEN(ITIN,FILE='TEDF',FORM='UNFORMATTED',STATUS='OLD')
+ READ(ITIN)NSPHT
+ IF(NSPHT.NE.NSPH)GO TO 497
+ READ(ITIN)(IOG(I),I=1,NSPH)
+ READ(ITIN)EXDC,WP,XIP,IDFC,NXI
+ READ(ITIN)(XIV(I),I=1,NXI)
+ DO 103 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 103
+ READ(ITIN)NSHL(I),ROS(I)
+ NSH=NSHL(I)
+ READ(ITIN)(RCF(I,NS),NS=1,NSH)
+ 103 CONTINUE
+ WRITE(IW,*)' READ(ITIN)NSPHT'
+ WRITE(IW,*)' READ(ITIN)(IOG(I),I=1,NSPH)'
+ WRITE(IW,*)' READ(ITIN)EXDC,WP,XIP,IDFC,NXI'
+ WRITE(IW,*)' READ(ITIN)(XIV(I),I=1,NXI)'
+ WRITE(IW,*)' READ(ITIN)NSHL(I),ROS(I)'
+ WRITE(IW,*)' READ(ITIN)(RCF(I,NS),NS=1,NSH)'
+ WRITE(IW,6000)
+ C0=0.0D0
+ SML=1.0D-3
+ IF(THSTP.EQ.C0)NTH=0
+ IF(THSTP.NE.C0)NTH=IDINT((THLST-TH)/THSTP+SML)
+ NTH=NTH+1
+ IF(PHSTP.EQ.C0)NPH=0
+ IF(PHSTP.NE.C0)NPH=IDINT((PHLST-PH)/PHSTP+SML)
+ NPH=NPH+1
+ IF(ISAM.LE.1)GO TO 110
+ NTHS=1
+ THSCA=THS-TH
+ GO TO 111
+ 110 IF(THSSTP.EQ.C0)NTHS=0
+ IF(THSSTP.NE.C0)NTHS=IDINT((THSLST-THS)/THSSTP+SML)
+ NTHS=NTHS+1
+ IF(ISAM.LT.1)GO TO 112
+ 111 NPHS=1
+ GO TO 113
+ 112 IF(PHSSTP.EQ.C0)NPHS=0
+ IF(PHSSTP.NE.C0)NPHS=IDINT((PHSLST-PHS)/PHSSTP+SML)
+ NPHS=NPHS+1
+ 113 NK=NTH*NPH
+ NKS=NTHS*NPHS
+ NKKS=NK*NKS
+ TH1=TH
+ PH1=PH
+ THS1=THS
+ PHS1=PHS
+ CALL STR(RCF)
+ LM=MAX0(LI,LE)
+ CALL THDPS(LM,ZPV)
+ EXRI=DSQRT(EXDC)
+ WRITE(IW,6710)EXRI
+ OPEN(IT,FILE='TPPOAN',FORM='UNFORMATTED',STATUS='UNKNOWN')
+ WRITE(IT)IAVM,ISAM,INPOL
+ WRITE(IT)NXI,NTH,NPH,NTHS,NPHS
+
+C
+ NLEMT=NLEM+NLEM
+C
+
+ WN=WP/3.0D08
+ SQSFI=1.0D0
+ IF(IDFC.GE.0)GO TO 118
+ VK=XIP*WN
+ WRITE(IW,6714)VK
+ WRITE(IW,6000)
+ 118 DO 488 JXI=1,NXI
+ JAW=1
+ WRITE(IW,6991)JXI
+ XI=XIV(JXI)
+ IF(IDFC.LT.0)GO TO 119
+ VK=XI*WN
+ VKARG=VK
+ WRITE(IW,6715)VK,XI
+ GO TO 120
+ 119 VKARG=XI*VK
+ SQSFI=1.0D0/(XI*XI)
+ WRITE(IW,6716)XI
+ 120 CALL HJV(EXRI,VKARG,JER,LCALC,ARG)
+ IF(JER.EQ.0)GO TO 122
+ WRITE(IW,6650)
+ GO TO 490
+ 122 DO 132 I=1,NSPH
+ IOGI=IOG(I)
+ IF(IOGI.EQ.I)GO TO 125
+ DO 123 L=1,LI
+ RMI(L,I)=RMI(L,IOGI)
+ 123 REI(L,I)=REI(L,IOGI)
+ GO TO 132
+ 125 NSH=NSHL(I)
+ ICI=(NSH+1)/2
+ IF(IDFC.NE.0)GO TO 127
+ READ(ITIN)(DC0(IC),IC=1,ICI)
+ GO TO 130
+ 127 IF(JXI.EQ.1)READ(ITIN)(DC0M(I,IC),IC=1,ICI)
+ DO 128 IC=1,ICI
+ 128 DC0(IC)=DC0M(I,IC)
+ 130 IF(MOD(NSH,2).EQ.0)DC0(ICI+1)=EXDC
+ CALL DME(LI,I,NPNT,NPNTTS,VKARG,EXDC,EXRI,JER,LCALC,ARG)
+ IF(JER.EQ.0)GO TO 132
+ WRITE(IW,6750)
+ GO TO 490
+ 132 CONTINUE
+ CALL CMS(AM)
+ NDIT=2*NSPH*NLIM
+ CALL LUCIN(AM,MXNDM,NDIT,JER)
+ IF(JER.EQ.1)GO TO 495
+ CALL ZTM(AM)
+
+C
+ IF(IDFC.LT.0)GO TO 156
+ IF(JXI.NE.JWTM)GO TO 156
+ IS=1
+ ITS=8
+ OPEN(ITS,FILE='TTMS',FORM='UNFORMATTED',STATUS='UNKNOWN')
+ WRITE(ITS)IS,LM
+ WRITE(ITS)VK,EXRI
+ WRITE(ITS)((AM0M(I,J),J=1,NLEMT),I=1,NLEMT)
+ CLOSE(ITS)
+ 156 CONTINUE
+C
+
+ IF(INPOL.NE.0)GO TO 158
+ WRITE(IW,6066)
+ GO TO 160
+ 158 WRITE(IW,6061)
+ 160 CS0=0.25D0*VK*VK*VK/DACOS(C0)
+ CALL SCR0(VK,EXRI)
+ SQK=VK*VK*EXDC
+ CALL APS(ZPV,LI,NSPH,IOG,RMI,REI,SQK,GAPS)
+ CALL RABAS(INPOL,LI,NSPH,IOG,RMI,REI,TQSE,TQSPE,TQSS,TQSPS)
+ IF(LI.NE.LE)WRITE(IW,6068)
+ DO 170 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 170
+ ALBEDS=SSCS(I)/SEXS(I)
+ SQSCS(I)=SQSCS(I)*SQSFI
+ SQABS(I)=SQABS(I)*SQSFI
+ SQEXS(I)=SQEXS(I)*SQSFI
+ WRITE(IW,6070)I
+ IF(NSHL(I).EQ.1)GO TO 162
+ WRITE(IW,6055)VSZ(I)
+ GO TO 164
+ 162 WRITE(IW,6050)VSZ(I),VKT(I)
+ 164 WRITE(IW,6100)
+ WRITE(IW,6150)SSCS(I),SABS(I),SEXS(I),ALBEDS
+ WRITE(IW,6200)
+ WRITE(IW,6150)SQSCS(I),SQABS(I),SQEXS(I)
+ WRITE(IW,6240)FSAS(I)
+ CSCH=2.0D0*VK*SQSFI/GCSV(I)
+ S0=FSAS(I)*EXRI
+ QSCHU=DIMAG(S0)*CSCH
+ PSCHU=DREAL(S0)*CSCH
+ S0MAG=CDABS(S0)*CS0
+ WRITE(IW,6930)QSCHU,PSCHU,S0MAG
+ RAPR=SEXS(I)-GAPS(I)
+ COSAV=GAPS(I)/SSCS(I)
+ WRITE(IW,6970)COSAV,RAPR
+ WRITE(IW,6977)1,TQSE(1,I),TQSS(1,I)
+ WRITE(IW,6977)2,TQSE(2,I),TQSS(2,I)
+ 170 CONTINUE
+ WRITE(IW,6250)TFSAS
+ CSCH=2.0D0*VK*SQSFI/GCS
+ S0=TFSAS*EXRI
+ QSCHU=DIMAG(S0)*CSCH
+ PSCHU=DREAL(S0)*CSCH
+ S0MAG=CDABS(S0)*CS0
+ WRITE(IW,6930)QSCHU,PSCHU,S0MAG
+ WRITE(IT)VK
+ CALL PCRSM0(VK,EXRI,INPOL)
+ CALL APCRA(ZPV,LE,AM0M,INPOL,SQK,GAPM,GAPPM)
+ TH=TH1
+ DO 486 JTH=1,NTH
+ PH=PH1
+ DO 484 JPH=1,NPH
+ IF((NK.EQ.1).AND.(JXI.GT.1))GO TO 180
+ CALL UPVMP(TH,PH,0,COST,SINT,COSP,SINP,U,UPMP,UNMP)
+ IF(ISAM.LT.0)GO TO 184
+ CALL WMAMP
+ 1(0,COST,SINT,COSP,SINP,INPOL,LE,0,NSPH,ARGI,U,UPMP,UNMP)
+ GO TO 182
+ 180 IF(ISAM.LT.0)GO TO 184
+ 182 CALL APC(ZPV,LE,AM0M,W,SQK,GAP,GAPP)
+ CALL RABA(LE,AM0M,W,TQCE,TQCPE,TQCS,TQCPS)
+ JW=1
+ 184 THSL=THS1
+ DO 482 JTHS=1,NTHS
+ THS=THSL
+ ICSPNV=0
+ IF(ISAM.GT.1)THS=TH+THSCA
+ IF(ISAM.LT.1)GO TO 186
+ PHSPH=C0
+ IF((THS.LT.C0).OR.(THS.GT.180.0D0))PHSPH=180.0D0
+ IF(THS.LT.C0)THS=-THS
+ IF(THS.GT.180.0D0)THS=360.0D0-THS
+ IF(PHSPH.NE.C0)ICSPNV=1
+ 186 PHS=PHS1
+ DO 480 JPHS=1,NPHS
+ IF(ISAM.LT.1)GO TO 188
+ PHS=PH+PHSPH
+ IF(PHS.GE.360.0D0)PHS=PHS-360.0D0
+ 188 IF((NKS.EQ.1).AND.((JXI.GT.1).OR.(JTH.GT.1).OR.(JPH.GT.1)))
+ 1GO TO 190
+ CALL UPVMP(THS,PHS,ICSPNV,COSTS,SINTS,COSPS,SINPS,US,UPSMP,UNSMP)
+ IF(ISAM.GE.0)CALL WMAMP
+ 1(2,COSTS,SINTS,COSPS,SINPS,INPOL,LE,0,NSPH,ARGS,US,UPSMP,UNSMP)
+ 190 IF((NKKS.EQ.1).AND.(JXI.GT.1))GO TO 194
+ CALL UPVSP(U,UPMP,UNMP,US,UPSMP,UNSMP,UP,UN,UPS,UNS,DUK,
+ 1ISQ,IBF,SCAN,CFMP,SFMP,CFSP,SFSP)
+ IF(ISAM.GE.0)GO TO 192
+ CALL WMASP(COST,SINT,COSP,SINP,COSTS,SINTS,COSPS,SINPS,
+ 1U,UP,UN,US,UPS,UNS,ISQ,IBF,INPOL,LE,0,NSPH,ARGI,ARGS)
+ GO TO 194
+ 192 DO 193 I=1,3
+ UP(I)=UPMP(I)
+ UN(I)=UNMP(I)
+ UPS(I)=UPSMP(I)
+ 193 UNS(I)=UNSMP(I)
+ 194 IF(IAVM.EQ.1)CALL CRSM1(VK,EXRI)
+ IF(ISAM.GE.0)GO TO 196
+ CALL APC(ZPV,LE,AM0M,W,SQK,GAP,GAPP)
+ CALL RABA(LE,AM0M,W,TQCE,TQCPE,TQCS,TQCPS)
+ JW=1
+ 196 WRITE(IT)TH,PH,THS,PHS
+ WRITE(IT)SCAN
+ IF(JAW.EQ.0)GO TO 212
+ JAW=0
+ CALL MEXTC(VK,EXRI,FSACM,CEXTLR,CEXT)
+ WRITE(IT)((CEXT(I,J),J=1,4),I=1,4)
+ WRITE(IT)(SCSCM(I),SCSCPM(I),ECSCM(I),ECSCPM(I),I=1,2)
+ WRITE(IT)((GAPM(I,J),GAPPM(I,J),J=1,2),I=1,3)
+ WRITE(IW,6460)IAVM
+ JLR=2
+ DO 210 ILR=1,2
+ IPOL=(-1)**ILR
+ IF(ILR.EQ.2)JLR=1
+ EXTSM=ECSCM(ILR)
+ QEXTM=EXTSM*SQSFI/GCS
+ EXTRM=EXTSM/ECS
+ SCASM=SCSCM(ILR)
+ ALBDM=SCASM/EXTSM
+ QSCAM=SCASM*SQSFI/GCS
+ SCARM=SCASM/SCS
+ ABSSM=EXTSM-SCASM
+ QABSM=ABSSM*SQSFI/GCS
+ IF(DABS(ACS/ECS).GT.1.0D-06)GO TO 202
+ ABSRM=1.0D0
+ GO TO 204
+ 202 ABSRM=ABSSM/ACS
+ 204 S0M=FSACM(ILR,ILR)*EXRI
+ QSCHUM=DIMAG(S0M)*CSCH
+ PSCHUM=DREAL(S0M)*CSCH
+ S0MAGM=CDABS(S0M)*CS0
+ RFINRM=DREAL(FSACM(ILR,ILR))/DREAL(TFSAS)
+ EXTCRM=DIMAG(FSACM(ILR,ILR))/DIMAG(TFSAS)
+ IF(INPOL.NE.0)GO TO 206
+ WRITE(IW,6065)IPOL
+ GO TO 208
+ 206 WRITE(IW,6060)IPOL
+ 208 WRITE(IW,6500)
+ WRITE(IW,6150)SCASM,ABSSM,EXTSM,ALBDM
+ alam=2*3.14159265359/VK
+ if(IPOL.EQ.1)write(22,999)alam,SCASM,ABSSM,EXTSM
+ 999 format(4e15.4)
+ WRITE(IW,6600)
+ WRITE(IW,6150)QSCAM,QABSM,QEXTM
+ WRITE(IW,6700)
+ WRITE(IW,6150)SCARM,ABSRM,EXTRM
+ WRITE(IW,6800)ILR,ILR,FSACM(ILR,ILR),JLR,ILR,FSACM(JLR,ILR)
+ WRITE(IW,6850)ILR,ILR,RFINRM,ILR,ILR,EXTCRM
+ WRITE(IW,6930)QSCHUM,PSCHUM,S0MAGM
+ RAPR=ECSCM(ILR)-GAPM(3,ILR)
+ COSAV=GAPM(3,ILR)/SCSCM(ILR)
+ FZ=RAPR
+ WRITE(IW,6970)COSAV,RAPR
+ WRITE(IW,6974)FZ
+ 210 CONTINUE
+ RMBRIF=(DREAL(FSACM(1,1))-DREAL(FSACM(2,2)))/DREAL(FSACM(1,1))
+ RMDCHR=(DIMAG(FSACM(1,1))-DIMAG(FSACM(2,2)))/DIMAG(FSACM(1,1))
+ WRITE(IW,6940)RMBRIF
+ WRITE(IW,6945)RMDCHR
+ 212 WRITE(IW,6992)JTH,JPH,JTHS,JPHS
+ WRITE(IW,6720)TH,PH,THS,PHS
+ WRITE(IW,6740)SCAN
+ WRITE(IW,6721)CFMP,SFMP
+ WRITE(IW,6722)CFSP,SFSP
+ IF(ISAM.LT.0)GO TO 214
+ WRITE(IW,6166)UN(1),UN(2),UN(3)
+ WRITE(IW,6167)UNS(1),UNS(2),UNS(3)
+ GO TO 220
+ 214 WRITE(IW,6165)UN(1),UN(2),UN(3)
+ 220 IF(INPOL.NE.0)GO TO 222
+ WRITE(IW,6066)
+ GO TO 224
+ 222 WRITE(IW,6061)
+ 224 CALL SCR2(VK,VKARG,EXRI,DUK)
+ IF(LI.NE.LE)WRITE(IW,6069)
+ DO 226 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 226
+ WRITE(IW,6070)I
+ WRITE(IW,6242)SAS(I,1,1),SAS(I,2,1)
+ WRITE(IW,6243)SAS(I,1,2),SAS(I,2,2)
+ DO 225 J=1,16
+ 225 VINT(J)=VINTS(I,J)
+ CALL MMULC(VINT,CMULLR,CMUL)
+ WRITE(IW,6331)
+ WRITE(IW,6350)((CMUL(I1,J),J=1,4),I1=1,4)
+ WRITE(IW,6336)
+ WRITE(IW,6350)((CMULLR(I1,J),J=1,4),I1=1,4)
+ 226 CONTINUE
+ WRITE(IW,6252)TSAS(1,1),TSAS(2,1)
+ WRITE(IW,6253)TSAS(1,2),TSAS(2,2)
+ WRITE(IW,6080)
+ CALL PCROS(VK,EXRI)
+ CALL MEXTC(VK,EXRI,FSAC,CEXTLR,CEXT)
+ CALL MMULC(VINT,CMULLR,CMUL)
+ IF(JW.EQ.0)GO TO 254
+ JW=0
+ WRITE(IT)((CEXT(I,J),J=1,4),I=1,4)
+ WRITE(IT)(SCSC(I),SCSCP(I),ECSC(I),ECSCP(I),I=1,2)
+ WRITE(IT)((GAP(I,J),GAPP(I,J),J=1,2),I=1,3)
+ WRITE(IT)((TQCE(I,J),TQCPE(I,J),J=1,3),I=1,2)
+ WRITE(IT)((TQCS(I,J),TQCPS(I,J),J=1,3),I=1,2)
+ WRITE(IT)(U(I),UP(I),UN(I),I=1,3)
+ 254 WRITE(IT)(VINT(I),I=1,16)
+ WRITE(IT)((CMUL(I,J),J=1,4),I=1,4)
+ JLR=2
+ DO 290 ILR=1,2
+ IPOL=(-1)**ILR
+ IF(ILR.EQ.2)JLR=1
+ EXTSEC=ECSC(ILR)
+ QEXT=EXTSEC*SQSFI/GCS
+ EXTRAT=EXTSEC/ECS
+ SCASEC=SCSC(ILR)
+ ALBEDC=SCASEC/EXTSEC
+ QSCA=SCASEC*SQSFI/GCS
+ SCARAT=SCASEC/SCS
+ ABSSEC=EXTSEC-SCASEC
+ QABS=ABSSEC*SQSFI/GCS
+ IF(DABS(ACS/ECS).GT.1.0D-06)GO TO 260
+ ABSRAT=1.0D0
+ GO TO 262
+ 260 ABSRAT=ABSSEC/ACS
+ 262 S0=FSAC(ILR,ILR)*EXRI
+ QSCHU=DIMAG(S0)*CSCH
+ PSCHU=DREAL(S0)*CSCH
+ S0MAG=CDABS(S0)*CS0
+ REFINR=DREAL(FSAC(ILR,ILR))/DREAL(TFSAS)
+ EXTCOR=DIMAG(FSAC(ILR,ILR))/DIMAG(TFSAS)
+ IF(INPOL.NE.0)GO TO 273
+ WRITE(IW,6065)IPOL
+ GO TO 275
+ 273 WRITE(IW,6060)IPOL
+ 275 WRITE(IW,6500)
+ WRITE(IW,6150)SCASEC,ABSSEC,EXTSEC,ALBEDC
+ if(ILR.EQ.1)write(31,999)alam,SCASEC,ABSSEC,EXTSEC
+ if(ILR.EQ.2)write(32,999)alam,SCASEC,ABSSEC,EXTSEC
+ WRITE(IW,6600)
+ WRITE(IW,6150)QSCA,QABS,QEXT
+ WRITE(IW,6700)
+ WRITE(IW,6150)SCARAT,ABSRAT,EXTRAT
+ WRITE(IW,6800)ILR,ILR,FSAC(ILR,ILR),JLR,ILR,FSAC(JLR,ILR)
+ WRITE(IW,6810)ILR,ILR,SAC(ILR,ILR),JLR,ILR,SAC(JLR,ILR)
+ WRITE(IW,6850)ILR,ILR,REFINR,ILR,ILR,EXTCOR
+ WRITE(IW,6930)QSCHU,PSCHU,S0MAG
+ IF((ISAM.GE.0).AND.((JTHS.GT.1).OR.(JPHS.GT.1)))GO TO 290
+ GAPV(1)=GAP(1,ILR)
+ GAPV(2)=GAP(2,ILR)
+ GAPV(3)=GAP(3,ILR)
+ EXTINS=ECSC(ILR)
+ SCATTS=SCSC(ILR)
+ CALL RFTR
+ 1(U,UP,UN,GAPV,EXTINS,SCATTS,RAPR,COSAV,FP,FN,FK,FX,FY,FZ)
+ WRITE(IW,6970)COSAV,RAPR
+ WRITE(IW,6973)FP,FN,FK
+ WRITE(IW,6971)FX,FY,FZ
+ TQEV(1)=TQCE(ILR,1)
+ TQEV(2)=TQCE(ILR,2)
+ TQEV(3)=TQCE(ILR,3)
+ TQSV(1)=TQCS(ILR,1)
+ TQSV(2)=TQCS(ILR,2)
+ TQSV(3)=TQCS(ILR,3)
+ CALL TQR(U,UP,UN,TQEV,TQSV,TEP,TEN,TEK,TSP,TSN,TSK)
+ WRITE(IW,6983)TEP,TEN,TEK
+ WRITE(IW,6984)TSP,TSN,TSK
+ WRITE(IW,6981)TQCE(ILR,1),TQCE(ILR,2),TQCE(ILR,3)
+ WRITE(IW,6982)TQCS(ILR,1),TQCS(ILR,2),TQCS(ILR,3)
+ 290 CONTINUE
+ RBIRIF=(DREAL(FSAC(1,1))-DREAL(FSAC(2,2)))/DREAL(FSAC(1,1))
+ RDICHR=(DIMAG(FSAC(1,1))-DIMAG(FSAC(2,2)))/DIMAG(FSAC(1,1))
+ WRITE(IW,6940)RBIRIF
+ WRITE(IW,6945)RDICHR
+ WRITE(IW,6332)
+ WRITE(IW,6350)((CMUL(I,J),J=1,4),I=1,4)
+ WRITE(IW,6337)
+ WRITE(IW,6350)((CMULLR(I,J),J=1,4),I=1,4)
+ IF(IAVM.EQ.0)GO TO 420
+ CALL MMULC(VINTM,CMULLR,CMUL)
+ WRITE(IT)(VINTM(I),I=1,16)
+ WRITE(IT)((CMUL(I,J),J=1,4),I=1,4)
+ WRITE(IW,6460)IAVM
+ IF(INPOL.NE.0)GO TO 316
+ WRITE(IW,6066)
+ GO TO 318
+ 316 WRITE(IW,6061)
+ 318 WRITE(IW,6332)
+ WRITE(IW,6350)((CMUL(I,J),J=1,4),I=1,4)
+ WRITE(IW,6337)
+ WRITE(IW,6350)((CMULLR(I,J),J=1,4),I=1,4)
+ 420 CONTINUE
+ 480 IF(ISAM.LT.1)PHS=PHS+PHSSTP
+ 482 IF(ISAM.LE.1)THSL=THSL+THSSTP
+ 484 PH=PH+PHSTP
+ 486 TH=TH+THSTP
+ 488 CONTINUE
+ GO TO 500
+ 490 WRITE(IW,6550)JER,LCALC,ARG
+ GO TO 500
+ 495 WRITE(IW,6300)
+ GO TO 500
+ 497 WRITE(IW,*)' WRONG INPUT TAPE'
+ 500 CONTINUE
+ CLOSE(IW)
+ CLOSE(IT)
+ CLOSE(ITIN)
+ STOP
+ END
+ SUBROUTINE RABAS(INPOL,LI,NSPH,IOG,RMI,REI,TQSE,TQSPE,TQSS,TQSPS)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION IOG(NSPH),RMI(LI,NSPH),REI(LI,NSPH),
+CCC 1TQSE(2,NSPH),TQSPE(2,NSPH),TQSS(2,NSPH),TQSPS(2,NSPH)
+ DIMENSION IOG(8),RMI(23,8),REI(23,8),
+ 1TQSE(2,8),TQSPE(2,8),TQSS(2,8),TQSPS(2,8)
+ COMPLEX*16 RMI,REI,TQSPE,TQSPS
+ COMPLEX*16 CC0,UIM,RM,RE,PCE,PCS
+ C0=0.0D0
+ PIG2=DACOS(C0)*4.0D0
+ CC0=(0.0D0,0.0D0)
+ UIM=(0.0D0,1.0D0)
+ DO 80 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 80
+ TQSE(1,I)=C0
+ TQSE(2,I)=C0
+ TQSPE(1,I)=CC0
+ TQSPE(2,I)=CC0
+ TQSS(1,I)=C0
+ TQSS(2,I)=C0
+ TQSPS(1,I)=CC0
+ TQSPS(2,I)=CC0
+ DO 70 L=1,LI
+ FL=L+L+1
+ RM=1.0D0/RMI(L,I)
+ RMM=DREAL(RM*DCONJG(RM))
+ RE=1.0D0/REI(L,I)
+ REM=DREAL(RE*DCONJG(RE))
+ IF(INPOL.NE.0)GO TO 40
+ PCE=((RM+RE)*UIM)*FL
+ PCS=((RMM+REM)*FL)*UIM
+ TQSPE(1,I)=TQSPE(1,I)-PCE
+ TQSPE(2,I)=TQSPE(2,I)+PCE
+ TQSPS(1,I)=TQSPS(1,I)-PCS
+ TQSPS(2,I)=TQSPS(2,I)+PCS
+ GO TO 70
+ 40 CE=DREAL(RM+RE)*FL
+ CS=(RMM+REM)*FL
+ TQSE(1,I)=TQSE(1,I)-CE
+ TQSE(2,I)=TQSE(2,I)+CE
+ TQSS(1,I)=TQSS(1,I)-CS
+ TQSS(2,I)=TQSS(2,I)+CS
+ 70 CONTINUE
+ IF(INPOL.NE.0)GO TO 75
+ TQSPE(1,I)=TQSPE(1,I)*PIG2
+ TQSPE(2,I)=TQSPE(2,I)*PIG2
+ TQSPS(1,I)=TQSPS(1,I)*PIG2
+ TQSPS(2,I)=TQSPS(2,I)*PIG2
+ GO TO 80
+ 75 TQSE(1,I)=TQSE(1,I)*PIG2
+ TQSE(2,I)=TQSE(2,I)*PIG2
+ TQSS(1,I)=TQSS(1,I)*PIG2
+ TQSS(2,I)=TQSS(2,I)*PIG2
+ 80 CONTINUE
+ RETURN
+ END
+ SUBROUTINE TQR(U,UP,UN,TQEV,TQSV,TEP,TEN,TEK,TSP,TSN,TSK)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION U(3),UP(3),UN(3),TQEV(3),TQSV(3)
+ TEP=UP(1)*TQEV(1)+UP(2)*TQEV(2)+UP(3)*TQEV(3)
+ TEN=UN(1)*TQEV(1)+UN(2)*TQEV(2)+UN(3)*TQEV(3)
+ TEK=U(1)*TQEV(1)+U(2)*TQEV(2)+U(3)*TQEV(3)
+ TSP=UP(1)*TQSV(1)+UP(2)*TQSV(2)+UP(3)*TQSV(3)
+ TSN=UN(1)*TQSV(1)+UN(2)*TQSV(2)+UN(3)*TQSV(3)
+ TSK=U(1)*TQSV(1)+U(2)*TQSV(2)+U(3)*TQSV(3)
+ RETURN
+ END
+ SUBROUTINE RABA(LE,AM0M,W,TQCE,TQCPE,TQCS,TQCPS)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION AM0M(NLEMT,NLEMT),W(NLEMT,4)
+ DIMENSION AM0M(1150,1150),W(1150,4),
+ 1TQCE(2,3),TQCPE(2,3),TQCS(2,3),TQCPS(2,3)
+ COMPLEX*16 AM0M,W,TQCPE,TQCPS
+CCC DIMENSION A(NLEMT,2)
+ DIMENSION A(1150,2),CTQCE(2,3),CTQCS(2,3)
+ COMPLEX*16 A,CTQCE,CTQCS
+ COMPLEX*16 CC0,UIM,ACW,ACWP,ACA,ACAP,C1,C2,C3
+ CC0=(0.0D0,0.0D0)
+ UIM=(0.0D0,1.0D0)
+ SQ2I=1.0D0/DSQRT(2.0D0)
+ NLEM=LE*(LE+2)
+ NLEMT=NLEM+NLEM
+ DO 20 I=1,NLEMT
+ C1=CC0
+ C2=CC0
+ DO 10 J=1,NLEMT
+ C1=C1+AM0M(I,J)*W(J,1)
+ C2=C2+AM0M(I,J)*W(J,2)
+ 10 CONTINUE
+ A(I,1)=C1
+ A(I,2)=C2
+ 20 CONTINUE
+ JPO=2
+ DO 70 IPO=1,2
+ IF(IPO.EQ.2)JPO=1
+ CTQCE(IPO,1)=CC0
+ CTQCE(IPO,2)=CC0
+ CTQCE(IPO,3)=CC0
+ TQCPE(IPO,1)=CC0
+ TQCPE(IPO,2)=CC0
+ TQCPE(IPO,3)=CC0
+ CTQCS(IPO,1)=CC0
+ CTQCS(IPO,2)=CC0
+ CTQCS(IPO,3)=CC0
+ TQCPS(IPO,1)=CC0
+ TQCPS(IPO,2)=CC0
+ TQCPS(IPO,3)=CC0
+ DO 60 L=1,LE
+ LPO=L+1
+ IL=L*LPO
+ LTPO=L+LPO
+ DO 60 IM=1,LTPO
+ M=IM-LPO
+ I=M+IL
+ IE=I+NLEM
+ MMMU=M+1
+ MMMMU=IABS(MMMU)
+ IF(MMMMU.GT.L)GO TO 30
+ IMMU=MMMU+IL
+ IMMUE=IMMU+NLEM
+ RMU=(L+MMMU)*(L-M)
+ RMU=-DSQRT(RMU)*SQ2I
+ ACW=DCONJG(A(I,IPO))*W(IMMU,IPO)+DCONJG(A(IE,IPO))*W(IMMUE,IPO)
+ ACWP=DCONJG(A(I,IPO))*W(IMMU,JPO)+DCONJG(A(IE,IPO))*W(IMMUE,JPO)
+ ACA=DCONJG(A(I,IPO))*A(IMMU,IPO)+DCONJG(A(IE,IPO))*A(IMMUE,IPO)
+ ACAP=DCONJG(A(I,IPO))*A(IMMU,JPO)+DCONJG(A(IE,IPO))*A(IMMUE,JPO)
+ CTQCE(IPO,1)=CTQCE(IPO,1)+ACW*RMU
+ TQCPE(IPO,1)=TQCPE(IPO,1)+ACWP*RMU
+ CTQCS(IPO,1)=CTQCS(IPO,1)+ACA*RMU
+ TQCPS(IPO,1)=TQCPS(IPO,1)+ACAP*RMU
+ 30 RMU=-M
+ ACW=DCONJG(A(I,IPO))*W(I,IPO)+DCONJG(A(IE,IPO))*W(IE,IPO)
+ ACWP=DCONJG(A(I,IPO))*W(I,JPO)+DCONJG(A(IE,IPO))*W(IE,JPO)
+ ACA=DCONJG(A(I,IPO))*A(I,IPO)+DCONJG(A(IE,IPO))*A(IE,IPO)
+ ACAP=DCONJG(A(I,IPO))*A(I,JPO)+DCONJG(A(IE,IPO))*A(IE,JPO)
+ CTQCE(IPO,2)=CTQCE(IPO,2)+ACW*RMU
+ TQCPE(IPO,2)=TQCPE(IPO,2)+ACWP*RMU
+ CTQCS(IPO,2)=CTQCS(IPO,2)+ACA*RMU
+ TQCPS(IPO,2)=TQCPS(IPO,2)+ACAP*RMU
+ MMMU=M-1
+ MMMMU=IABS(MMMU)
+ IF(MMMMU.GT.L)GO TO 50
+ IMMU=MMMU+IL
+ IMMUE=IMMU+NLEM
+ RMU=(L-MMMU)*(L+M)
+ RMU=DSQRT(RMU)*SQ2I
+ ACW=DCONJG(A(I,IPO))*W(IMMU,IPO)+DCONJG(A(IE,IPO))*W(IMMUE,IPO)
+ ACWP=DCONJG(A(I,IPO))*W(IMMU,JPO)+DCONJG(A(IE,IPO))*W(IMMUE,JPO)
+ ACA=DCONJG(A(I,IPO))*A(IMMU,IPO)+DCONJG(A(IE,IPO))*A(IMMUE,IPO)
+ ACAP=DCONJG(A(I,IPO))*A(IMMU,JPO)+DCONJG(A(IE,IPO))*A(IMMUE,JPO)
+ CTQCE(IPO,3)=CTQCE(IPO,3)+ACW*RMU
+ TQCPE(IPO,3)=TQCPE(IPO,3)+ACWP*RMU
+ CTQCS(IPO,3)=CTQCS(IPO,3)+ACA*RMU
+ TQCPS(IPO,3)=TQCPS(IPO,3)+ACAP*RMU
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+ DO 78 IPO=1,2
+ TQCE(IPO,1)=DREAL(CTQCE(IPO,1)-CTQCE(IPO,3))*SQ2I
+ TQCE(IPO,2)=DREAL((CTQCE(IPO,1)+CTQCE(IPO,3))*UIM)*SQ2I
+ TQCE(IPO,3)=DREAL(CTQCE(IPO,2))
+ C1=TQCPE(IPO,1)
+ C2=TQCPE(IPO,2)
+ C3=TQCPE(IPO,3)
+ TQCPE(IPO,1)=(C1-C3)*SQ2I
+ TQCPE(IPO,2)=(C1+C3)*(UIM*SQ2I)
+ TQCPE(IPO,3)=C2
+ TQCS(IPO,1)=-DREAL(CTQCS(IPO,1)-CTQCS(IPO,3))*SQ2I
+ TQCS(IPO,2)=-DREAL((CTQCS(IPO,1)+CTQCS(IPO,3))*UIM)*SQ2I
+ TQCS(IPO,3)=-DREAL(CTQCS(IPO,2))
+ C1=TQCPS(IPO,1)
+ C2=TQCPS(IPO,2)
+ C3=TQCPS(IPO,3)
+ TQCPS(IPO,1)=-(C1-C3)*SQ2I
+ TQCPS(IPO,2)=-(C1+C3)*(UIM*SQ2I)
+ TQCPS(IPO,3)=-C2
+ 78 CONTINUE
+ RETURN
+ END
+ SUBROUTINE RFTR
+ 1(U,UP,UN,GAPV,EXTINS,SCATTS,RAPR,COSAV,FP,FN,FK,FX,FY,FZ)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION U(3),UP(3),UN(3),GAPV(3)
+ FK=U(1)*GAPV(1)+U(2)*GAPV(2)+U(3)*GAPV(3)
+ RAPR=EXTINS-FK
+ COSAV=FK/SCATTS
+ FP=-(UP(1)*GAPV(1)+UP(2)*GAPV(2)+UP(3)*GAPV(3))
+ FN=-(UN(1)*GAPV(1)+UN(2)*GAPV(2)+UN(3)*GAPV(3))
+ FK=RAPR
+ FX=U(1)*EXTINS-GAPV(1)
+ FY=U(2)*EXTINS-GAPV(2)
+ FZ=U(3)*EXTINS-GAPV(3)
+ RETURN
+ END
+ SUBROUTINE MEXTC(VK,EXRI,FSAC,CEXTLR,CEXT)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION FSAC(2,2),CEXTLR(4,4),CEXT(4,4)
+ COMPLEX*16 FSAC
+ FA11R=DREAL(FSAC(1,1))
+ FA11I=DIMAG(FSAC(1,1))
+ FA21R=DREAL(FSAC(2,1))
+ FA21I=DIMAG(FSAC(2,1))
+ FA12R=DREAL(FSAC(1,2))
+ FA12I=DIMAG(FSAC(1,2))
+ FA22R=DREAL(FSAC(2,2))
+ FA22I=DIMAG(FSAC(2,2))
+ CEXTLR(1,1)=FA11I*2.0D0
+ CEXTLR(1,2)=0.0D0
+ CEXTLR(1,3)=-FA12I
+ CEXTLR(1,4)=-FA12R
+ CEXTLR(2,1)=0.0D0
+ CEXTLR(2,2)=FA22I*2.0D0
+ CEXTLR(2,3)=-FA21I
+ CEXTLR(2,4)=FA21R
+ CEXTLR(3,1)=-FA21I*2.0D0
+ CEXTLR(3,2)=-FA12I*2.0D0
+ CEXTLR(3,3)=FA11I+FA22I
+ CEXTLR(3,4)=FA22R-FA11R
+ CEXTLR(4,1)=FA21R*2.0D0
+ CEXTLR(4,2)=-FA12R*2.0D0
+ CEXTLR(4,3)=FA11R-FA22R
+ CEXTLR(4,4)=CEXTLR(3,3)
+ CEXT(1,1)=CEXTLR(4,4)
+ CEXT(2,2)=CEXTLR(4,4)
+ CEXT(3,3)=CEXTLR(4,4)
+ CEXT(3,4)=CEXTLR(3,4)
+ CEXT(4,3)=CEXTLR(4,3)
+ CEXT(4,4)=CEXTLR(4,4)
+ CEXT(1,2)=FA11I-FA22I
+ CEXT(1,3)=-FA12I-FA21I
+ CEXT(1,4)=FA21R-FA12R
+ CEXT(2,1)=CEXT(1,2)
+ CEXT(2,3)=FA21I-FA12I
+ CEXT(4,2)=FA12R+FA21R
+ CEXT(2,4)=-CEXT(4,2)
+ CEXT(3,1)=CEXT(1,3)
+ CEXT(3,2)=-CEXT(2,3)
+ CEXT(4,1)=CEXT(1,4)
+ CKM=VK/EXRI
+ DO 10 I=1,4
+ DO 10 J=1,4
+ CEXTLR(I,J)=CEXTLR(I,J)*CKM
+ 10 CEXT(I,J)=CEXT(I,J)*CKM
+ RETURN
+ END
+ SUBROUTINE MMULC(VINT,CMULLR,CMUL)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION VINT(16),CMULLR(4,4),CMUL(4,4)
+ COMPLEX*16 VINT
+ SM2=DREAL(VINT(1))
+ S24=DREAL(VINT(2))
+ D24=DIMAG(VINT(2))
+ SM4=DREAL(VINT(6))
+ S23=DREAL(VINT(9))
+ D32=DIMAG(VINT(9))
+ S34=DREAL(VINT(10))
+ D34=DIMAG(VINT(10))
+ SM3=DREAL(VINT(11))
+ S31=DREAL(VINT(12))
+ D31=DIMAG(VINT(12))
+ S21=DREAL(VINT(13))
+ D12=DIMAG(VINT(13))
+ S41=DREAL(VINT(14))
+ D14=DIMAG(VINT(14))
+ SM1=DREAL(VINT(16))
+ CMULLR(1,1)=SM2
+ CMULLR(1,2)=SM3
+ CMULLR(1,3)=-S23
+ CMULLR(1,4)=-D32
+ CMULLR(2,1)=SM4
+ CMULLR(2,2)=SM1
+ CMULLR(2,3)=-S41
+ CMULLR(2,4)=-D14
+ CMULLR(3,1)=-S24*2.0D0
+ CMULLR(3,2)=-S31*2.0D0
+ CMULLR(3,3)=S21+S34
+ CMULLR(3,4)=D34+D12
+ CMULLR(4,1)=-D24*2.0D0
+ CMULLR(4,2)=-D31*2.0D0
+ CMULLR(4,3)=D34-D12
+ CMULLR(4,4)=S21-S34
+ CMUL(1,1)=(SM2+SM3+SM4+SM1)*0.5D0
+ CMUL(1,2)=(SM2-SM3+SM4-SM1)*0.5D0
+ CMUL(1,3)=-S23-S41
+ CMUL(1,4)=-D32-D14
+ CMUL(2,1)=(SM2+SM3-SM4-SM1)*0.5D0
+ CMUL(2,2)=(SM2-SM3-SM4+SM1)*0.5D0
+ CMUL(2,3)=-S23+S41
+ CMUL(2,4)=-D32+D14
+ CMUL(3,1)=-S24-S31
+ CMUL(3,2)=-S24+S31
+ CMUL(3,3)=S21+S34
+ CMUL(3,4)=D34+D12
+ CMUL(4,1)=-D24-D31
+ CMUL(4,2)=-D24+D31
+ CMUL(4,3)=D34-D12
+ CMUL(4,4)=S21-S34
+ RETURN
+ END
+ SUBROUTINE SCR0(VK,EXRI)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C3/TFSAS,TSAS(2,2),GCS,SCS,ECS,ACS
+ COMPLEX*16 TFSAS,TSAS
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMPLEX*16 SUM21,RM,RE,CC0,CSAM
+ CC0=(0.0D0,0.0D0)
+ C0=0.0D0
+ EXDC=EXRI*EXRI
+ CCS=4.0D0*DACOS(C0)/(VK*VK)
+ CCCS=CCS/EXDC
+ CSAM=-(CCS/(EXRI*VK))*(0.0D0,0.5D0)
+ SCS=C0
+ ECS=C0
+ ACS=C0
+ TFSAS=CC0
+ DO 14 I=1,NSPH
+ IOGI=IOG(I)
+ IF(IOGI.LT.I)GO TO 12
+ SUMS=C0
+ SUM21=CC0
+ DO 10 L=1,LI
+ FL=L+L+1
+ RM=1.0D0/RMI(L,I)
+ RE=1.0D0/REI(L,I)
+ SUMS=SUMS+DREAL(DCONJG(RM)*RM+DCONJG(RE)*RE)*FL
+ 10 SUM21=SUM21+(RM+RE)*FL
+ SUM21=-SUM21
+ SCASEC=CCCS*SUMS
+ EXTSEC=-CCCS*DREAL(SUM21)
+ ABSSEC=EXTSEC-SCASEC
+ SSCS(I)=SCASEC
+ SEXS(I)=EXTSEC
+ SABS(I)=ABSSEC
+ GCSS=GCSV(I)
+ SQSCS(I)=SCASEC/GCSS
+ SQEXS(I)=EXTSEC/GCSS
+ SQABS(I)=ABSSEC/GCSS
+ FSAS(I)=SUM21*CSAM
+ 12 SCS=SCS+SSCS(IOGI)
+ ECS=ECS+SEXS(IOGI)
+ ACS=ACS+SABS(IOGI)
+ 14 TFSAS=TFSAS+FSAS(IOGI)
+ RETURN
+ END
+ SUBROUTINE SCR2(VK,VKARG,EXRI,DUK)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C3/TFSAS,TSAS(2,2),GCS,SCS,ECS,ACS
+ COMPLEX*16 TFSAS,TSAS
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ DIMENSION DUK(3)
+ COMPLEX*16 S11,S21,S12,S22,RM,RE,CC0,CSAM,CPH,PHAS,CC
+ CC0=(0.0D0,0.0D0)
+ C0=0.0D0
+ CCS=1.0D0/(VK*VK)
+ CSAM=-(CCS/(EXRI*VK))*(0.0D0,0.5D0)
+ PIGFSQ=6.4D+1*DACOS(C0)**2
+ CFSQ=4.0D0/(PIGFSQ*CCS*CCS)
+ CPH=(0.0D0,1.0D0)*(EXRI*VKARG)
+ LS=MIN0(LI,LE)
+ TSAS(1,1)=CC0
+ TSAS(2,1)=CC0
+ TSAS(1,2)=CC0
+ TSAS(2,2)=CC0
+ DO 14 I=1,NSPH
+ IOGI=IOG(I)
+ IF(IOGI.LT.I)GO TO 12
+ K=0
+ S11=CC0
+ S21=CC0
+ S12=CC0
+ S22=CC0
+ DO 10 L=1,LS
+ RM=1.0D0/RMI(L,I)
+ RE=1.0D0/REI(L,I)
+ LTPO=L+L+1
+ DO 10 IM=1,LTPO
+ K=K+1
+ KE=K+NLEM
+ S11=S11-W(K,3)*W(K,1)*RM-W(KE,3)*W(KE,1)*RE
+ S21=S21-W(K,4)*W(K,1)*RM-W(KE,4)*W(KE,1)*RE
+ S12=S12-W(K,3)*W(K,2)*RM-W(KE,3)*W(KE,2)*RE
+ 10 S22=S22-W(K,4)*W(K,2)*RM-W(KE,4)*W(KE,2)*RE
+ SAS(I,1,1)=S11*CSAM
+ SAS(I,2,1)=S21*CSAM
+ SAS(I,1,2)=S12*CSAM
+ SAS(I,2,2)=S22*CSAM
+ 12 PHAS=CDEXP(CPH*(DUK(1)*RXX(I)+DUK(2)*RYY(I)+DUK(3)*RZZ(I)))
+ TSAS(1,1)=TSAS(1,1)+SAS(IOGI,1,1)*PHAS
+ TSAS(2,1)=TSAS(2,1)+SAS(IOGI,2,1)*PHAS
+ TSAS(1,2)=TSAS(1,2)+SAS(IOGI,1,2)*PHAS
+ 14 TSAS(2,2)=TSAS(2,2)+SAS(IOGI,2,2)*PHAS
+ DO 24 I=1,NSPH
+ IOGI=IOG(I)
+ IF(IOGI.LT.I)GO TO 24
+ J=0
+ DO 22 IPO1=1,2
+ DO 22 JPO1=1,2
+ CC=DCONJG(SAS(I,JPO1,IPO1))
+ DO 22 IPO2=1,2
+ DO 22 JPO2=1,2
+ J=J+1
+ 22 VINTS(I,J)=SAS(I,JPO2,IPO2)*CC*CFSQ
+ 24 CONTINUE
+ J=0
+ DO 32 IPO1=1,2
+ DO 32 JPO1=1,2
+ CC=DCONJG(TSAS(JPO1,IPO1))
+ DO 32 IPO2=1,2
+ DO 32 JPO2=1,2
+ J=J+1
+ 32 VINTT(J)=TSAS(JPO2,IPO2)*CC*CFSQ
+ RETURN
+ END
+ SUBROUTINE PCROS(VK,EXRI)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMPLEX*16 SUMP,SUM1,SUM2,SUM3,SUM4,AM,AMP,CC,CSAM,CC0
+ CC0=(0.0D0,0.0D0)
+ C0=0.0D0
+ EXDC=EXRI*EXRI
+ CCS=1.0D0/(VK*VK)
+ CCCS=CCS/EXDC
+ CSAM=-(CCS/(EXRI*VK))*(0.0D0,0.5D0)
+ PIGFSQ=6.4D+1*DACOS(C0)**2
+ CFSQ=4.0D0/(PIGFSQ*CCS*CCS)
+ NLEMT=NLEM+NLEM
+ JPO=2
+ DO 18 IPO=1,2
+ IF(IPO.EQ.2)JPO=1
+ IPOPT=IPO+2
+ JPOPT=JPO+2
+ SUM=C0
+ SUMP=CC0
+ SUM1=CC0
+ SUM2=CC0
+ SUM3=CC0
+ SUM4=CC0
+ DO 12 I=1,NLEMT
+ AM=CC0
+ AMP=CC0
+ DO 10 J=1,NLEMT
+ AM=AM+AM0M(I,J)*W(J,IPO)
+ 10 AMP=AMP+AM0M(I,J)*W(J,JPO)
+ SUM=SUM+DREAL(DCONJG(AM)*AM)
+ SUMP=SUMP+(DCONJG(AMP)*AM)
+ SUM1=SUM1+DCONJG(W(I,IPO))*AM
+ SUM2=SUM2+DCONJG(W(I,JPO))*AM
+ SUM3=SUM3+W(I,IPOPT)*AM
+ 12 SUM4=SUM4+W(I,JPOPT)*AM
+ SCSC(IPO)=CCCS*SUM
+ SCSCP(IPO)=CCCS*SUMP
+ ECSC(IPO)=-CCCS*DREAL(SUM1)
+ ECSCP(IPO)=-CCCS*SUM2
+ FSAC(IPO,IPO)=CSAM*SUM1
+ FSAC(JPO,IPO)=CSAM*SUM2
+ SAC(IPO,IPO)=CSAM*SUM3
+ 18 SAC(JPO,IPO)=CSAM*SUM4
+ I=0
+ DO 22 IPO1=1,2
+ DO 22 JPO1=1,2
+ CC=DCONJG(SAC(JPO1,IPO1))
+ DO 22 IPO2=1,2
+ DO 22 JPO2=1,2
+ I=I+1
+ 22 VINT(I)=SAC(JPO2,IPO2)*CC*CFSQ
+ RETURN
+ END
+ SUBROUTINE PCRSM0(VK,EXRI,INPOL)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMPLEX*16 SUM1,SUM2,SUM3,SUM4,SUMPD,SUMS1,SUMS2,SUMS3,SUMS4,
+ 1CSAM,CC0,UIM
+ CC0=(0.0D0,0.0D0)
+ UIM=(0.0D0,1.0D0)
+ C0=0.0D0
+ EXDC=EXRI*EXRI
+ CCS=4.0D0*DACOS(C0)/(VK*VK)
+ CCCS=CCS/EXDC
+ CSAM=-(CCS/(EXRI*VK))*(0.0D0,0.5D0)
+ SUM2=CC0
+ SUM3=CC0
+ DO 14 I=1,NLEM
+ IE=I+NLEM
+ SUM2=SUM2+(AM0M(I,I)+AM0M(IE,IE))
+ 14 SUM3=SUM3+(AM0M(I,IE)+AM0M(IE,I))
+ SUMPI=C0
+ SUMPD=CC0
+ NLEMT=NLEM+NLEM
+ DO 16 I=1,NLEMT
+ DO 16 J=1,NLEM
+ JE=J+NLEM
+ SUMPI=SUMPI+DREAL
+ 1(DCONJG(AM0M(I,J))*AM0M(I,J)+DCONJG(AM0M(I,JE))*AM0M(I,JE))
+ 16 SUMPD=SUMPD+
+ 1(DCONJG(AM0M(I,J))*AM0M(I,JE)+DCONJG(AM0M(I,JE))*AM0M(I,J))
+ IF(INPOL.NE.0)GO TO 18
+ SUM1=SUM2
+ SUM4=SUM3*UIM
+ SUM3=-SUM4
+ SUMS1=SUMPI
+ SUMS2=SUMPI
+ SUMS3=SUMPD*UIM
+ SUMS4=-SUMS3
+ GO TO 20
+ 18 SUM1=SUM2+SUM3
+ SUM2=SUM2-SUM3
+ SUM3=CC0
+ SUM4=CC0
+ SUMS1=SUMPI-SUMPD
+ SUMS2=SUMPI+SUMPD
+ SUMS3=CC0
+ SUMS4=CC0
+ 20 ECSCM(1)=-CCCS*DREAL(SUM2)
+ ECSCM(2)=-CCCS*DREAL(SUM1)
+ ECSCPM(1)=-CCCS*SUM4
+ ECSCPM(2)=-CCCS*SUM3
+ FSACM(1,1)=CSAM*SUM2
+ FSACM(2,1)=CSAM*SUM4
+ FSACM(2,2)=CSAM*SUM1
+ FSACM(1,2)=CSAM*SUM3
+ SCSCM(1)=CCCS*DREAL(SUMS1)
+ SCSCM(2)=CCCS*DREAL(SUMS2)
+ SCSCPM(1)=CCCS*SUMS3
+ SCSCPM(2)=CCCS*SUMS4
+ RETURN
+ END
+ SUBROUTINE CRSM1(VK,EXRI)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMMON/C6/RAC3J(47)
+CCC DIMENSION SVF(LE4PO,LE4PO,4),SVW(LE4PO,4,4),SVS(LE4PO,4)
+CCC LE4PO=LE*4+1
+ DIMENSION SVF(93,93,4),SVW(93,4,4),SVS(93,4)
+ COMPLEX*16 SVF,SVW,SVS
+ COMPLEX*16 CAM,CC0
+ CC0=(0.0D0,0.0D0)
+ C0=0.0D0
+ EXDC=EXRI*EXRI
+ CCS=1.0D0/(VK*VK)
+ PIGFSQ=6.4D+1*DACOS(C0)**2
+ CINT=CCS/(PIGFSQ*EXDC)
+ LETPO=LE+LE+1
+ DO 20 I=1,16
+ 20 VINTM(I)=CC0
+ DO 40 LPO=1,LETPO
+ L=LPO-1
+ LTPO=LPO+L
+ IMMN=LETPO-L
+ IMMX=LETPO+L
+ DO 22 IMF=IMMN,IMMX
+ DO 22 IMS=IMMN,IMMX
+ DO 22 IPO=1,4
+ 22 SVF(IMF,IMS,IPO)=CC0
+ DO 34 L1=1,LE
+ IL1=L1*(L1+1)
+ DO 34 L2=1,LE
+ IF((L.LT.IABS(L2-L1)).OR.(L.GT.(L2+L1)))GO TO 34
+ IL2=L2*(L2+1)
+ DO 24 IM=IMMN,IMMX
+ DO 24 IPA=1,4
+ SVS(IM,IPA)=CC0
+ DO 24 IPO=1,4
+ 24 SVW(IM,IPA,IPO)=CC0
+ DO 30 IM=IMMN,IMMX
+ M=IM-LETPO
+ CALL R3JMR(L,L1,L2,M)
+ M1MNMO=MAX0(-L1,-L2-M)-1
+ NM1=MIN0(L1,L2-M)-M1MNMO
+ DO 30 IM1=1,NM1
+ M1=-IM1-M1MNMO
+ ISN=1
+ IF(MOD(M1,2).NE.0)ISN=-1
+ CG3J=RAC3J(IM1)*ISN
+CCC CG=(LTPO**(1/2))*CG3J
+ ILM1=IL1+M1
+ ILM2=IL2+M1-M
+ IPA=0
+ DO 30 IPA1=1,2
+ I1=ILM1
+ IF(IPA1.EQ.2)I1=ILM1+NLEM
+ DO 30 IPA2=1,2
+ I2=ILM2
+ IF(IPA2.EQ.2)I2=ILM2+NLEM
+ IPA=IPA+1
+ SVS(IM,IPA)=SVS(IM,IPA)+AM0M(I1,I2)*CG3J
+ IPO=0
+ DO 30 IPO2=1,2
+ DO 30 IPO1=3,4
+ IPO=IPO+1
+ 30 SVW(IM,IPA,IPO)=SVW(IM,IPA,IPO)+W(I1,IPO1)*W(I2,IPO2)*CG3J
+ DO 32 IMF=IMMN,IMMX
+ DO 32 IMS=IMMN,IMMX
+ DO 32 IPO=1,4
+ DO 32 IPA=1,4
+ 32 SVF(IMF,IMS,IPO)=SVF(IMF,IMS,IPO)+SVW(IMF,IPA,IPO)*SVS(IMS,IPA)
+ 34 CONTINUE
+ DO 40 IMF=IMMN,IMMX
+ DO 40 IMS=IMMN,IMMX
+ I=0
+ DO 40 IPO1=1,4
+ CAM=DCONJG(SVF(IMF,IMS,IPO1))
+ DO 40 IPO2=1,4
+ I=I+1
+ 40 VINTM(I)=VINTM(I)+(SVF(IMF,IMS,IPO2)*CAM)*LTPO
+ DO 42 I=1,16
+ 42 VINTM(I)=VINTM(I)*CINT
+ RETURN
+ END
+ SUBROUTINE APS(ZPV,LI,NSPH,IOG,RMI,REI,SQK,GAPS)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION ZPV(LM,3,2,2),IOG(NSPH),
+CCC 1RMI(LI,NSPH),REI(LI,NSPH),GAPS(NSPH)
+ DIMENSION ZPV(23,3,2,2),IOG(8),RMI(23,8),REI(23,8),GAPS(8)
+ COMPLEX*16 RMI,REI
+ COMPLEX*16 CC0,SUMM,SUME,SUEM,SUEE,SUM
+ CC0=(0.0D0,0.0D0)
+ C0=0.0D0
+ PIGH=DACOS(C0)
+ COFS=PIGH*2.0D0/SQK
+ DO 40 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 40
+ SUM=CC0
+ DO 30 L=1,LI
+ LTPO=L+L+1
+ DO 30 ILMP=1,3
+ IF(((L.EQ.1).AND.(ILMP.EQ.1)).OR.((L.EQ.LI).AND.(ILMP.EQ.3)))
+ 1GO TO 30
+ LMPML=ILMP-2
+ LMP=L+LMPML
+ COFL=LTPO*(LMP+LMP+1)
+ COFL=DSQRT(COFL)
+ SUMM=ZPV(L,ILMP,1,1)/(DCONJG(RMI(L,I))*RMI(LMP,I))
+ SUME=ZPV(L,ILMP,1,2)/(DCONJG(RMI(L,I))*REI(LMP,I))
+ SUEM=ZPV(L,ILMP,2,1)/(DCONJG(REI(L,I))*RMI(LMP,I))
+ SUEE=ZPV(L,ILMP,2,2)/(DCONJG(REI(L,I))*REI(LMP,I))
+ SUM=SUM+(CG1(LMPML,0,L,-1)*(SUMM-SUME-SUEM+SUEE)+
+ 1CG1(LMPML,0,L,1)*(SUMM+SUME+SUEM+SUEE))*COFL
+ 30 CONTINUE
+ GAPS(I)=DREAL(SUM)*COFS
+ 40 CONTINUE
+ RETURN
+ END
+ SUBROUTINE APC(ZPV,LE,AM0M,W,SQK,GAPR,GAPP)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION ZPV(LM,3,2,2),AM0M(NLEMT,NLEMT),W(NLEMT,4)
+ DIMENSION ZPV(23,3,2,2),AM0M(1150,1150),W(1150,4),
+ 1GAPR(3,2),GAPP(3,2)
+ COMPLEX*16 AM0M,W,GAPP
+CCC DIMENSION AC(NLEMT,2)
+ DIMENSION AC(1150,2),GAP(3,2)
+ COMPLEX*16 AC,GAP
+ COMPLEX*16 CC0,UIM,UIMMP,
+ 1SUMM,SUME,SUEM,SUEE,SUMMP,SUMEP,SUEMP,SUEEP
+ CC0=(0.0D0,0.0D0)
+ UIM=(0.0D0,1.0D0)
+ COF=1.0D0/SQK
+ CIMU=COF/DSQRT(2.0D0)
+ NLEM=LE*(LE+2)
+ NLEMT=NLEM+NLEM
+ DO 45 J=1,NLEMT
+ AC(J,1)=CC0
+ AC(J,2)=CC0
+ DO 45 I=1,NLEMT
+ AC(J,1)=AC(J,1)+AM0M(J,I)*W(I,1)
+ AC(J,2)=AC(J,2)+AM0M(J,I)*W(I,2)
+ 45 CONTINUE
+ DO 90 IMU=1,3
+ MU=IMU-2
+ GAP(IMU,1)=CC0
+ GAP(IMU,2)=CC0
+ GAPP(IMU,1)=CC0
+ GAPP(IMU,2)=CC0
+ DO 80 L=1,LE
+ LPO=L+1
+ LTPO=LPO+L
+ IMM=L*LPO
+ DO 80 ILMP=1,3
+ IF(((L.EQ.1).AND.(ILMP.EQ.1)).OR.((L.EQ.LE).AND.(ILMP.EQ.3)))
+ 1GO TO 80
+ LMPML=ILMP-2
+ LMP=L+LMPML
+ UIMMP=-LMPML*UIM
+ IMPMMMP=LMP*(LMP+1)
+ DO 70 IM=1,LTPO
+ M=IM-LPO
+ MMP=M-MU
+ IF(IABS(MMP).GT.LMP)GO TO 70
+ I=IMM+M
+ IE=I+NLEM
+ IMP=IMPMMMP+MMP
+ IMPE=IMP+NLEM
+ CGC=CG1(LMPML,MU,L,M)
+ JPO=2
+ DO 60 IPO=1,2
+ IF(IPO.EQ.2)JPO=1
+ SUMM=DCONJG(AC(I,IPO))*AC(IMP,IPO)
+ SUME=DCONJG(AC(I,IPO))*AC(IMPE,IPO)
+ SUEM=DCONJG(AC(IE,IPO))*AC(IMP,IPO)
+ SUEE=DCONJG(AC(IE,IPO))*AC(IMPE,IPO)
+ SUMMP=DCONJG(AC(I,JPO))*AC(IMP,IPO)
+ SUMEP=DCONJG(AC(I,JPO))*AC(IMPE,IPO)
+ SUEMP=DCONJG(AC(IE,JPO))*AC(IMP,IPO)
+ SUEEP=DCONJG(AC(IE,JPO))*AC(IMPE,IPO)
+ IF(LMPML.EQ.0)GO TO 55
+ SUMM=SUMM*UIMMP
+ SUME=SUME*UIMMP
+ SUEM=SUEM*UIMMP
+ SUEE=SUEE*UIMMP
+ SUMMP=SUMMP*UIMMP
+ SUMEP=SUMEP*UIMMP
+ SUEMP=SUEMP*UIMMP
+ SUEEP=SUEEP*UIMMP
+ 55 GAP(IMU,IPO)=GAP(IMU,IPO)+CGC*
+ 1(SUMM*ZPV(L,ILMP,1,1)+SUME*ZPV(L,ILMP,1,2)+
+ 2SUEM*ZPV(L,ILMP,2,1)+SUEE*ZPV(L,ILMP,2,2))
+ GAPP(IMU,IPO)=GAPP(IMU,IPO)+CGC*
+ 1(SUMMP*ZPV(L,ILMP,1,1)+SUMEP*ZPV(L,ILMP,1,2)+
+ 2SUEMP*ZPV(L,ILMP,2,1)+SUEEP*ZPV(L,ILMP,2,2))
+ 60 CONTINUE
+ 70 CONTINUE
+ 80 CONTINUE
+ 90 CONTINUE
+ DO 95 IPO=1,2
+ SUME=GAP(1,IPO)*CIMU
+ SUEE=GAP(2,IPO)*COF
+ SUEM=GAP(3,IPO)*CIMU
+ GAPR(1,IPO)=DREAL(SUME-SUEM)
+ GAPR(2,IPO)=DREAL((SUME+SUEM)*UIM)
+ GAPR(3,IPO)=DREAL(SUEE)
+ SUMEP=GAPP(1,IPO)*CIMU
+ SUEEP=GAPP(2,IPO)*COF
+ SUEMP=GAPP(3,IPO)*CIMU
+ GAPP(1,IPO)=SUMEP-SUEMP
+ GAPP(2,IPO)=(SUMEP+SUEMP)*UIM
+ GAPP(3,IPO)=SUEEP
+ 95 CONTINUE
+ RETURN
+ END
+ SUBROUTINE APCRA(ZPV,LE,AM0M,INPOL,SQK,GAPRM,GAPPM)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION ZPV(LM,3,2,2),AM0M(NLEMT,NLEMT)
+ DIMENSION ZPV(23,3,2,2),AM0M(1150,1150),GAPRM(3,2),GAPPM(3,2)
+ COMPLEX*16 AM0M,GAPPM
+CCC DIMENSION SVW(LE,3,2,2),SVS(LE,3,2,2)
+ DIMENSION SVW(23,3,2,2),SVS(23,3,2,2)
+ COMPLEX*16 SVS
+ COMPLEX*16 CC0,UIM,UIMTL,UIMTLS,FC,
+ 1CA11,CA12,CA21,CA22,A11,A12,A21,A22,SUM1,SUM2
+ CC0=(0.0D0,0.0D0)
+ UIM=(0.0D0,1.0D0)
+ NLEM=LE*(LE+2)
+ DO 28 L=1,LE
+ LPO=L+1
+ LTPO=LPO+L
+ FL=LTPO
+ FL=DSQRT(FL)
+ DO 26 ILMP=1,3
+ IF(((L.EQ.1).AND.(ILMP.EQ.1)).OR.((L.EQ.LE).AND.(ILMP.EQ.3)))
+ 1GO TO 26
+ LMPML=ILMP-2
+ LMP=L+LMPML
+ FLMP=LMP+LMP+1
+ FLMP=DSQRT(FLMP)
+ FLLMP=FLMP/FL
+ CGMMO=FLLMP*CG1(LMPML,0,L,1)
+ CGMPO=FLLMP*CG1(LMPML,0,L,-1)
+ IF(INPOL.NE.0)GO TO 22
+ CGS=CGMPO+CGMMO
+ CGD=CGMPO-CGMMO
+ SVW(L,ILMP,1,1)=CGS
+ SVW(L,ILMP,1,2)=CGD
+ SVW(L,ILMP,2,1)=CGD
+ SVW(L,ILMP,2,2)=CGS
+ GO TO 26
+ 22 SVW(L,ILMP,1,1)=CGMPO
+ SVW(L,ILMP,2,1)=CGMPO
+ SVW(L,ILMP,1,2)=-CGMMO
+ SVW(L,ILMP,2,2)=CGMMO
+ 26 CONTINUE
+ 28 CONTINUE
+ DO 30 L=1,LE
+ DO 30 ILMP=1,3
+ DO 30 IPA=1,2
+ DO 30 IPAMP=1,2
+ SVS(L,ILMP,IPA,IPAMP)=CC0
+ 30 CONTINUE
+ DO 58 L=1,LE
+ LPO=L+1
+ LTPO=L+LPO
+ IMM=L*LPO
+ DO 56 ILMP=1,3
+ IF(((L.EQ.1).AND.(ILMP.EQ.1)).OR.((L.EQ.LE).AND.(ILMP.EQ.3)))
+ 1GO TO 56
+ LMPML=ILMP-2
+ LMP=L+LMPML
+ IMPMM=LMP*(LMP+1)
+ UIMTL=LMPML*UIM
+ IF(LMPML.EQ.0)UIMTL=(1.0D0,0.0D0)
+ DO 54 IM=1,LTPO
+ M=IM-LPO
+ I=IMM+M
+ IE=I+NLEM
+ DO 52 IMU=1,3
+ MU=IMU-2
+ MMP=M-MU
+ IF(IABS(MMP).GT.LMP)GO TO 52
+ IMP=IMPMM+MMP
+ IMPE=IMP+NLEM
+ CGC=CG1(LMPML,-MU,L,-M)
+ DO 48 LS=1,LE
+ LSPO=LS+1
+ LSTPO=LS+LSPO
+ ISMM=LS*LSPO
+ DO 46 ILSMP=1,3
+ IF(((LS.EQ.1).AND.(ILSMP.EQ.1)).OR.((LS.EQ.LE).AND.(ILSMP.EQ.3)))
+ 1GO TO 46
+ LSMPML=ILSMP-2
+ LSMP=LS+LSMPML
+ ISMPMM=LSMP*(LSMP+1)
+ UIMTLS=-LSMPML*UIM
+ IF(LSMPML.EQ.0)UIMTLS=(1.0D0,0.0D0)
+ DO 44 IMS=1,LSTPO
+ MS=IMS-LSPO
+ MSMP=MS-MU
+ IF(IABS(MSMP).GT.LSMP)GO TO 44
+ IS=ISMM+MS
+ ISE=IS+NLEM
+ ISMP=ISMPMM+MSMP
+ ISMPE=ISMP+NLEM
+ CGCS=CG1(LSMPML,MU,LS,MS)
+ FC=(UIMTL*UIMTLS)*(CGC*CGCS)
+ CA11=DCONJG(AM0M(IS,I))
+ CA12=DCONJG(AM0M(IS,IE))
+ CA21=DCONJG(AM0M(ISE,I))
+ CA22=DCONJG(AM0M(ISE,IE))
+ A11=AM0M(ISMP,IMP)
+ A12=AM0M(ISMP,IMPE)
+ A21=AM0M(ISMPE,IMP)
+ A22=AM0M(ISMPE,IMPE)
+ Z11=ZPV(LS,ILSMP,1,1)
+ Z12=ZPV(LS,ILSMP,1,2)
+ Z21=ZPV(LS,ILSMP,2,1)
+ Z22=ZPV(LS,ILSMP,2,2)
+ SVS(L,ILMP,1,1)=SVS(L,ILMP,1,1)+
+ 1(CA11*A11*Z11+CA11*A21*Z12+CA21*A11*Z21+CA21*A21*Z22)*FC
+ SVS(L,ILMP,1,2)=SVS(L,ILMP,1,2)+
+ 1(CA11*A12*Z11+CA11*A22*Z12+CA21*A12*Z21+CA21*A22*Z22)*FC
+ SVS(L,ILMP,2,1)=SVS(L,ILMP,2,1)+
+ 1(CA12*A11*Z11+CA12*A21*Z12+CA22*A11*Z21+CA22*A21*Z22)*FC
+ SVS(L,ILMP,2,2)=SVS(L,ILMP,2,2)+
+ 1(CA12*A12*Z11+CA12*A22*Z12+CA22*A12*Z21+CA22*A22*Z22)*FC
+ 44 CONTINUE
+ 46 CONTINUE
+ 48 CONTINUE
+ 52 CONTINUE
+ 54 CONTINUE
+ 56 CONTINUE
+ 58 CONTINUE
+ SUM1=CC0
+ SUM2=CC0
+ DO 68 L=1,LE
+ LPO=L+1
+ LTPO=L+LPO
+ IMM=L*LPO
+ DO 66 ILMP=1,3
+ IF(((L.EQ.1).AND.(ILMP.EQ.1)).OR.((L.EQ.LE).AND.(ILMP.EQ.3)))
+ 1GO TO 66
+ IF(INPOL.NE.0)GO TO 62
+ SUM1=SUM1+
+ 1SVW(L,ILMP,1,1)*SVS(L,ILMP,1,1)+SVW(L,ILMP,2,1)*SVS(L,ILMP,1,2)+
+ 2SVW(L,ILMP,2,1)*SVS(L,ILMP,2,1)+SVW(L,ILMP,1,1)*SVS(L,ILMP,2,2)
+ SUM2=SUM2+
+ 1SVW(L,ILMP,1,2)*SVS(L,ILMP,1,1)+SVW(L,ILMP,2,2)*SVS(L,ILMP,1,2)+
+ 2SVW(L,ILMP,2,2)*SVS(L,ILMP,2,1)+SVW(L,ILMP,1,2)*SVS(L,ILMP,2,2)
+ GO TO 66
+ 62 SUM1=SUM1+
+ 1SVW(L,ILMP,2,1)*SVS(L,ILMP,1,1)+SVW(L,ILMP,1,1)*SVS(L,ILMP,1,2)+
+ 2SVW(L,ILMP,1,1)*SVS(L,ILMP,2,1)+SVW(L,ILMP,2,1)*SVS(L,ILMP,2,2)
+ SUM2=SUM2+
+ 1SVW(L,ILMP,2,2)*SVS(L,ILMP,1,1)+SVW(L,ILMP,1,2)*SVS(L,ILMP,1,2)+
+ 2SVW(L,ILMP,1,2)*SVS(L,ILMP,2,1)+SVW(L,ILMP,2,2)*SVS(L,ILMP,2,2)
+ 66 CONTINUE
+ 68 CONTINUE
+ C0=0.0D0
+ PIGH=DACOS(C0)
+ COFS=PIGH*2.0D0/SQK
+ GAPRM(1,1)=C0
+ GAPRM(1,2)=C0
+ GAPRM(2,1)=C0
+ GAPRM(2,2)=C0
+ GAPPM(1,1)=CC0
+ GAPPM(1,2)=CC0
+ GAPPM(2,1)=CC0
+ GAPPM(2,2)=CC0
+ IF(INPOL.NE.0)GO TO 72
+ SUM1=SUM1*COFS
+ SUM2=SUM2*COFS
+ GAPRM(3,1)=DREAL(SUM1)
+ GAPRM(3,2)=DREAL(SUM1)
+ GAPPM(3,1)=SUM2*UIM
+ GAPPM(3,2)=-GAPPM(3,1)
+ RETURN
+ 72 COFS=COFS*2.0D0
+ GAPRM(3,1)=DREAL(SUM1)*COFS
+ GAPRM(3,2)=DREAL(SUM2)*COFS
+ GAPPM(3,1)=CC0
+ GAPPM(3,2)=CC0
+ RETURN
+ END
+ SUBROUTINE THDPS(LM,ZPV)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION ZPV(LM,3,2,2)
+ DIMENSION ZPV(23,3,2,2)
+ C0=0.0D0
+ DO 10 L=1,LM
+ DO 10 ILMP=1,3
+ ZPV(L,ILMP,1,1)=C0
+ ZPV(L,ILMP,1,2)=C0
+ ZPV(L,ILMP,2,1)=C0
+ ZPV(L,ILMP,2,2)=C0
+ 10 CONTINUE
+ DO 15 L=1,LM
+ XD=L*(L+1)
+ ZP=-1.0D0/DSQRT(XD)
+ ZPV(L,2,1,2)=ZP
+ ZPV(L,2,2,1)=ZP
+ 15 CONTINUE
+ IF(LM.EQ.1)GO TO 30
+ DO 20 L=2,LM
+ XN=(L-1)*(L+1)
+ XD=L*(L+L+1)
+ ZP=DSQRT(XN/XD)
+ ZPV(L,1,1,1)=ZP
+ ZPV(L,1,2,2)=ZP
+ 20 CONTINUE
+ LMMO=LM-1
+ DO 25 L=1,LMMO
+ XN=L*(L+2)
+ XD=(L+1)*(L+L+1)
+ ZP=-DSQRT(XN/XD)
+ ZPV(L,3,1,1)=ZP
+ ZPV(L,3,2,2)=ZP
+ 25 CONTINUE
+ 30 CONTINUE
+ RETURN
+ END
+ REAL*8 FUNCTION CG1(LMPML,MU,L,M)
+CCC CG1(LMPML,MU,L,M)=CLGO(1,LMP,L;MU,M-MU,M)
+ REAL*8 XD,XN
+ IF(LMPML)30,5,60
+ 5 IF((M.NE.0).OR.(MU.NE.0))GO TO 10
+ CG1=0.0D0
+ RETURN
+ 10 IF(MU.EQ.0)GO TO 20
+ XD=(L+1)*L*2
+ IF(MU.GT.0)GO TO 15
+ XN=(L-M)*(L+M+1)
+ CG1=-DSQRT(XN/XD)
+ RETURN
+ 15 XN=(L+M)*(L-M+1)
+ CG1=DSQRT(XN/XD)
+ RETURN
+ 20 XD=(L+1)*L
+ XN=-M
+ CG1=XN/DSQRT(XD)
+ RETURN
+ 30 XD=(L*2-1)*L*2
+ IF(MU)35,40,45
+ 35 XN=(L-1-M)*(L-M)
+ CG1=DSQRT(XN/XD)
+ RETURN
+ 40 XN=(L-M)*(L+M)*2
+ CG1=DSQRT(XN/XD)
+ RETURN
+ 45 XN=(L-1+M)*(L+M)
+ CG1=DSQRT(XN/XD)
+ RETURN
+ 60 XD=(L*2+3)*(L+1)*2
+ IF(MU)65,70,75
+ 65 XN=(L+1+M)*(L+2+M)
+ CG1=DSQRT(XN/XD)
+ RETURN
+ 70 XN=(L+1-M)*(L+1+M)*2
+ CG1=-DSQRT(XN/XD)
+ RETURN
+ 75 XN=(L+1-M)*(L+2-M)
+ CG1=DSQRT(XN/XD)
+ RETURN
+ END
+ SUBROUTINE UPVMP(THD,PHD,ICSPNV,COST,SINT,COSP,SINP,U,UP,UN)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION U(3),UP(3),UN(3)
+ C0=0.0D0
+ PIGH=DACOS(C0)
+ RDR=PIGH/9.0D+1
+ TH=THD*RDR
+ PH=PHD*RDR
+ COST=DCOS(TH)
+ SINT=DSIN(TH)
+ COSP=DCOS(PH)
+ SINP=DSIN(PH)
+ U(1)=COSP*SINT
+ U(2)=SINP*SINT
+ U(3)=COST
+ UP(1)=COSP*COST
+ UP(2)=SINP*COST
+ UP(3)=-SINT
+ UN(1)=-SINP
+ UN(2)=COSP
+ UN(3)=C0
+ IF(ICSPNV.EQ.0)RETURN
+ UP(1)=-UP(1)
+ UP(2)=-UP(2)
+ UP(3)=-UP(3)
+ UN(1)=-UN(1)
+ UN(2)=-UN(2)
+ RETURN
+ END
+ SUBROUTINE WMAMP
+ 1(IIS,COST,SINT,COSP,SINP,INPOL,LM,IDOT,NSPH,ARG,U,UP,UN)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION YLM(NLMM+2),ARG(NSPEF)
+CCC NSPEF=1 CALLING WITH IDOT=0, NSPEF=NSPH OTHERWISE
+ DIMENSION YLM(2209),U(3),UP(3),UN(3),ARG(1)
+ COMPLEX*16 YLM
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ NLMP=LM*(LM+2)+2
+ YLM(NLMP)=(0.0D0,0.0D0)
+ IF(IDOT.EQ.0)GO TO 65
+ IF(IDOT.EQ.1)GO TO 45
+ DO 40 N=1,NSPH
+ 40 ARG(N)=U(1)*RXX(N)+U(2)*RYY(N)+U(3)*RZZ(N)
+ GO TO 55
+ 45 DO 50 N=1,NSPH
+ 50 ARG(N)=COST*RZZ(N)
+ 55 IF(IIS.NE.2)GO TO 65
+ DO 60 N=1,NSPH
+ 60 ARG(N)=-ARG(N)
+ 65 CALL SPHAR(COST,SINT,COSP,SINP,LM,YLM)
+ CALL PWMA(UP,UN,YLM,INPOL,LM,IIS)
+ RETURN
+ END
+ SUBROUTINE UPVSP(U,UPMP,UNMP,US,UPSMP,UNSMP,UP,UN,UPS,UNS,DUK,
+ 1ISQ,IBF,SCAND,CFMP,SFMP,CFSP,SFSP)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION U(3),UPMP(3),UNMP(3),US(3),UPSMP(3),UNSMP(3),
+ 1UP(3),UN(3),UPS(3),UNS(3),DUK(3)
+ C0=0.0D0
+ RDR=DACOS(C0)/9.0D+1
+ SML=1.0D-6
+ ISQ=0
+ SCAND=U(1)*US(1)+U(2)*US(2)+U(3)*US(3)
+ IF(DABS(SCAND-1.0D0).LT.SML)GO TO 10
+ IF(DABS(SCAND+1.0D0).LT.SML)GO TO 15
+ SCAND=DACOS(SCAND)/RDR
+ DUK(1)=U(1)-US(1)
+ DUK(2)=U(2)-US(2)
+ DUK(3)=U(3)-US(3)
+ IBF=0
+ GO TO 25
+ 10 SCAND=C0
+ DUK(1)=C0
+ DUK(2)=C0
+ DUK(3)=C0
+ IBF=-1
+ ISQ=-1
+ UPS(1)=UPSMP(1)
+ UPS(2)=UPSMP(2)
+ UPS(3)=UPSMP(3)
+ UNS(1)=UNSMP(1)
+ UNS(2)=UNSMP(2)
+ UNS(3)=UNSMP(3)
+ GO TO 20
+ 15 SCAND=180.0D0
+ DUK(1)=U(1)*2.0D0
+ DUK(2)=U(2)*2.0D0
+ DUK(3)=U(3)*2.0D0
+ IBF=1
+ UPS(1)=-UPSMP(1)
+ UPS(2)=-UPSMP(2)
+ UPS(3)=-UPSMP(3)
+ UNS(1)=-UNSMP(1)
+ UNS(2)=-UNSMP(2)
+ UNS(3)=-UNSMP(3)
+ 20 UP(1)=UPMP(1)
+ UP(2)=UPMP(2)
+ UP(3)=UPMP(3)
+ UN(1)=UNMP(1)
+ UN(2)=UNMP(2)
+ UN(3)=UNMP(3)
+ GO TO 85
+ 25 CALL ORUNVE(U,US,UN,-1,SML)
+ UNS(1)=UN(1)
+ UNS(2)=UN(2)
+ UNS(3)=UN(3)
+ CALL ORUNVE(UN,U,UP,1,SML)
+ CALL ORUNVE(UNS,US,UPS,1,SML)
+ 85 CFMP=UPMP(1)*UP(1)+UPMP(2)*UP(2)+UPMP(3)*UP(3)
+ SFMP=UNMP(1)*UP(1)+UNMP(2)*UP(2)+UNMP(3)*UP(3)
+ CFSP=UPS(1)*UPSMP(1)+UPS(2)*UPSMP(2)+UPS(3)*UPSMP(3)
+ SFSP=UNS(1)*UPSMP(1)+UNS(2)*UPSMP(2)+UNS(3)*UPSMP(3)
+ RETURN
+ END
+ SUBROUTINE WMASP(COST,SINT,COSP,SINP,COSTS,SINTS,COSPS,SINPS,
+ 1U,UP,UN,US,UPS,UNS,ISQ,IBF,INPOL,LM,IDOT,NSPH,ARGI,ARGS)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION YLM(NLMM+2),ARGI(NSPEF),ARGS(NSPEF)
+CCC NSPEF=1 CALLING WITH IDOT=0, NSPEF=NSPH OTHERWISE
+ DIMENSION YLM(2209),ARGI(1),ARGS(1),
+ 1U(3),UP(3),UN(3),US(3),UPS(3),UNS(3)
+ COMPLEX*16 YLM
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ NLMP=LM*(LM+2)+2
+ YLM(NLMP)=(0.0D0,0.0D0)
+ IF(IDOT.EQ.0)GO TO 75
+ IF(IDOT.EQ.1)GO TO 50
+ DO 40 N=1,NSPH
+ ARGI(N)=U(1)*RXX(N)+U(2)*RYY(N)+U(3)*RZZ(N)
+ IF(IBF.EQ.0)GO TO 35
+ ARGS(N)=ARGI(N)*IBF
+ GO TO 40
+ 35 ARGS(N)=-(US(1)*RXX(N)+US(2)*RYY(N)+US(3)*RZZ(N))
+ 40 CONTINUE
+ GO TO 75
+ 50 DO 60 N=1,NSPH
+ ARGI(N)=COST*RZZ(N)
+ IF(IBF.EQ.0)GO TO 55
+ ARGS(N)=ARGI(N)*IBF
+ GO TO 60
+ 55 ARGS(N)=-COSTS*RZZ(N)
+ 60 CONTINUE
+ 75 CALL SPHAR(COST,SINT,COSP,SINP,LM,YLM)
+ CALL PWMA(UP,UN,YLM,INPOL,LM,ISQ)
+ IF(IBF.LT.0)RETURN
+ CALL SPHAR(COSTS,SINTS,COSPS,SINPS,LM,YLM)
+ CALL PWMA(UPS,UNS,YLM,INPOL,LM,2)
+ RETURN
+ END
+ SUBROUTINE STR(RCF)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION RCF(NSPH,NSHL),YLM(MAX0(LITPOS,LMTPOS))
+ DIMENSION RCF(8,8),YLM(2209)
+ COMPLEX*16 YLM
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C3/TFSAS,TSAS(2,2),GCS,SCS,ECS,ACS
+ COMPLEX*16 TFSAS,TSAS
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMMON/C6/RAC3J(47)
+ C0=0.0D0
+ PIGH=DACOS(C0)
+ PIG=PIGH*2.0D0
+ GCS=C0
+ DO 18 I=1,NSPH
+ IOGI=IOG(I)
+ IF(IOGI.LT.I)GO TO 18
+ GCSS=PIG*ROS(I)*ROS(I)
+ GCSV(I)=GCSS
+ NSH=NSHL(I)
+ DO 16 J=1,NSH
+ 16 RC(I,J)=RCF(I,J)*ROS(I)
+ 18 GCS=GCS+GCSV(IOGI)
+ LITPO=LI+LI+1
+ LITPOS=LITPO*LITPO
+ LMTPO=LI+LE+1
+ LMTPOS=LMTPO*LMTPO
+ NLIM=LI*(LI+2)
+ NLEM=LE*(LE+2)
+ LM=MAX0(LI,LE)
+ LMPO=LM+1
+ I=0
+ DO 28 L1PO=1,LMPO
+ L1=L1PO-1
+ DO 28 L2=1,LM
+ CALL R3J000(L1,L2)
+ IND3J(L1PO,L2)=I
+ LMNPO=IABS(L2-L1)+1
+ LMXPO=L2+L1+1
+ IL=0
+ DO 28 LPO=LMNPO,LMXPO,2
+ I=I+1
+ IL=IL+1
+ 28 V3J0(I)=RAC3J(IL)
+ NSPHMO=NSPH-1
+ LIT=LI+LI
+ IVY=0
+ DO 40 NF=1,NSPHMO
+ NFPO=NF+1
+ DO 40 NS=NFPO,NSPH
+ RX=RXX(NF)-RXX(NS)
+ RY=RYY(NF)-RYY(NS)
+ RZ=RZZ(NF)-RZZ(NS)
+ CALL POLAR(RX,RY,RZ,RR,CRTH,SRTH,CRPH,SRPH)
+ CALL SPHAR(CRTH,SRTH,CRPH,SRPH,LIT,YLM)
+ DO 38 IV=1,LITPOS
+ 38 VYHJ(IV+IVY)=DCONJG(YLM(IV))
+ 40 IVY=IVY+LITPOS
+ LMT=LI+LE
+ IVY=0
+ DO 50 NF=1,NSPH
+ RX=RXX(NF)
+ RY=RYY(NF)
+ RZ=RZZ(NF)
+ IF(RX.EQ.C0.AND.RY.EQ.C0.AND.RZ.EQ.C0)GO TO 50
+ CALL POLAR(RX,RY,RZ,RR,CRTH,SRTH,CRPH,SRPH)
+ CALL SPHAR(CRTH,SRTH,CRPH,SRPH,LMT,YLM)
+ DO 48 IV=1,LMTPOS
+ 48 VYJ0(IV+IVY)=DCONJG(YLM(IV))
+ 50 IVY=IVY+LMTPOS
+ RETURN
+ END
+ SUBROUTINE HJV(EXRI,VK,JER,LCALC,ARG)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION RFJ(MAX0(LIT,LMT)),RFN(LITPO)
+ DIMENSION RFJ(46),RFN(47)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMPLEX*16 ARG,UIM
+ JER=0
+ C0=0.0D0
+ UIM=(0.0D0,1.0D0)
+ NSPHMO=NSPH-1
+ LIT=LI+LI
+ IVHB=0
+ DO 40 NF=1,NSPHMO
+ NFPO=NF+1
+ DO 40 NS=NFPO,NSPH
+ RX=RXX(NF)-RXX(NS)
+ RY=RYY(NF)-RYY(NS)
+ RZ=RZZ(NF)-RZZ(NS)
+ RR=DSQRT(RX*RX+RY*RY+RZ*RZ)
+ RARG=RR*VK*EXRI
+ ARG=RARG
+ CALL RBF(LIT,RARG,LCALC,RFJ)
+ IF(LCALC.GE.LIT)GO TO 35
+ JER=1
+ RETURN
+ 35 CALL RNF(LIT,RARG,LCALC,RFN)
+ IF(LCALC.GE.LIT)GO TO 37
+ JER=2
+ RETURN
+ 37 DO 38 LPO=1,LITPO
+ 38 VH(LPO+IVHB)=RFJ(LPO)+UIM*RFN(LPO)
+ 40 IVHB=IVHB+LITPO
+ LMT=LI+LE
+ IVHB=0
+ DO 50 NF=1,NSPH
+ RX=RXX(NF)
+ RY=RYY(NF)
+ RZ=RZZ(NF)
+ IF(RX.EQ.C0.AND.RY.EQ.C0.AND.RZ.EQ.C0)GO TO 50
+ RR=DSQRT(RX*RX+RY*RY+RZ*RZ)
+ RARG=RR*VK*EXRI
+ CALL RBF(LMT,RARG,LCALC,RFJ)
+ IF(LCALC.GE.LMT)GO TO 45
+ JER=3
+ ARG=RARG
+ RETURN
+ 45 DO 47 LPO=1,LMTPO
+ 47 VJ0(LPO+IVHB)=RFJ(LPO)
+ 50 IVHB=IVHB+LMTPO
+ RETURN
+ END
+ SUBROUTINE PWMA(UP,UN,YLM,INPOL,LW,ISQ)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION YLM(NLWM+2)
+ DIMENSION YLM(2209),UP(3),UN(3)
+ COMPLEX*16 YLM
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMPLEX*16 CP1,CM1,C1,CP2,CM2,C2,UIM,CL
+ PI4=DACOS(0.0D0)*8.0D0
+ IS=ISQ
+ IF(ISQ.EQ.-1)IS=0
+ ISPO=IS+1
+ ISPT=IS+2
+ NLWM=LW*(LW+2)
+ NLWMT=NLWM+NLWM
+ SQRTWI=1.0D0/DSQRT(2.0D0)
+ UIM=(0.0D0,1.0D0)
+ CM1=.5D0*DCMPLX(UP(1),UP(2))
+ CP1=.5D0*DCMPLX(UP(1),-UP(2))
+ CZ1=UP(3)
+ CM2=.5D0*DCMPLX(UN(1),UN(2))
+ CP2=.5D0*DCMPLX(UN(1),-UN(2))
+ CZ2=UN(3)
+ DO 20 L=1,LW
+ LF=L+1
+ LFTL=LF*L
+ X=LFTL
+ CL=(PI4/DSQRT(X))*UIM**L
+ MV=L+LF
+ M=-LF
+ DO 20 MF=1,MV
+ M=M+1
+ K=LFTL+M
+ X=LFTL-M*(M+1)
+ CP=DSQRT(X)
+ X=LFTL-M*(M-1)
+ CM=DSQRT(X)
+ CZ=M
+ W(K,ISPO)=DCONJG(CP1*CP*YLM(K+2)+CM1*CM*YLM(K)+CZ1*CZ*YLM(K+1))*CL
+ 20 W(K,ISPT)=DCONJG(CP2*CP*YLM(K+2)+CM2*CM*YLM(K)+CZ2*CZ*YLM(K+1))*CL
+ DO 30 K=1,NLWM
+ I=K+NLWM
+ W(I,ISPO)=UIM*W(K,ISPT)
+ 30 W(I,ISPT)=-UIM*W(K,ISPO)
+ IF(INPOL.EQ.0)GO TO 42
+ DO 40 K=1,NLWM
+ I=K+NLWM
+ C1=(W(K,ISPO)+UIM*W(K,ISPT))*SQRTWI
+ C2=(W(K,ISPO)-UIM*W(K,ISPT))*SQRTWI
+ W(K,ISPO)=C2
+ W(I,ISPO)=-C2
+ W(K,ISPT)=C1
+ 40 W(I,ISPT)=C1
+ 42 IF(ISQ.EQ.0)RETURN
+ DO 50 I=1,2
+ IPT=I+2
+ IPIS=I+IS
+ DO 50 K=1,NLWMT
+ 50 W(K,IPT)=DCONJG(W(K,IPIS))
+ RETURN
+ END
+ SUBROUTINE ORUNVE(U1,U2,U3,IORTH,TORTH)
+ IMPLICIT REAL*8(A-H,O-Z)
+ DIMENSION U1(3),U2(3),U3(3)
+ IF(IORTH.GT.0)GO TO 10
+ CP=U1(1)*U2(1)+U1(2)*U2(2)+U1(3)*U2(3)
+ IF((IORTH.LT.0).AND.(DABS(CP).LT.TORTH))GO TO 10
+ FN=1.0D0/DSQRT(1.0D0-CP*CP)
+ U3(1)=(U1(2)*U2(3)-U1(3)*U2(2))*FN
+ U3(2)=(U1(3)*U2(1)-U1(1)*U2(3))*FN
+ U3(3)=(U1(1)*U2(2)-U1(2)*U2(1))*FN
+ RETURN
+ 10 U3(1)=U1(2)*U2(3)-U1(3)*U2(2)
+ U3(2)=U1(3)*U2(1)-U1(1)*U2(3)
+ U3(3)=U1(1)*U2(2)-U1(2)*U2(1)
+ RETURN
+ END
+ SUBROUTINE CMS(AM)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+CCC DIMENSION AM(MXNDM,MXNDM)
+CCC NDIT.LE.MXNDM
+ DIMENSION AM(9200,9200)
+ COMPLEX*16 AM
+ COMPLEX*16 DM,DE,CGH,CGK,GHIT,CC0
+ CC0=(0.0D0,0.0D0)
+ NDI=NSPH*NLIM
+ NBL=0
+ NSPHMO=NSPH-1
+ DO 26 N1=1,NSPHMO
+ IN1=(N1-1)*NLIM
+ N1PO=N1+1
+ DO 26 N2=N1PO,NSPH
+ IN2=(N2-1)*NLIM
+ NBL=NBL+1
+ DO 24 L1=1,LI
+ L1PO=L1+1
+ IL1=L1PO*L1
+ L1TPO=L1PO+L1
+ DO 24 IM1=1,L1TPO
+ M1=IM1-L1PO
+ ILM1=IL1+M1
+ ILM1E=ILM1+NDI
+ I1=IN1+ILM1
+ I1E=IN1+ILM1E
+ J1=IN2+ILM1
+ J1E=IN2+ILM1E
+ DO 24 L2=1,LI
+ L2PO=L2+1
+ IL2=L2PO*L2
+ L2TPO=L2PO+L2
+ ISH=(-1)**(L2+L1)
+ ISK=-ISH
+ DO 24 IM2=1,L2TPO
+ M2=IM2-L2PO
+ ILM2=IL2+M2
+ ILM2E=ILM2+NDI
+ I2=IN2+ILM2
+ I2E=IN2+ILM2E
+ J2=IN1+ILM2
+ J2E=IN1+ILM2E
+ CGH=GHIT(0,0,NBL,L1,M1,L2,M2)
+ CGK=GHIT(0,1,NBL,L1,M1,L2,M2)
+ AM(I1,I2)=CGH
+ AM(I1,I2E)=CGK
+ AM(I1E,I2)=CGK
+ AM(I1E,I2E)=CGH
+ AM(J1,J2)=CGH*ISH
+ AM(J1,J2E)=CGK*ISK
+ AM(J1E,J2)=CGK*ISK
+ AM(J1E,J2E)=CGH*ISH
+ 24 CONTINUE
+ 26 CONTINUE
+ DO 30 N1=1,NSPH
+ IN1=(N1-1)*NLIM
+ DO 30 L1=1,LI
+ DM=RMI(L1,N1)
+ DE=REI(L1,N1)
+ L1PO=L1+1
+ IL1=L1PO*L1
+ L1TPO=L1PO+L1
+ DO 30 IM1=1,L1TPO
+ M1=IM1-L1PO
+ ILM1=IL1+M1
+ I1=IN1+ILM1
+ I1E=I1+NDI
+ DO 28 ILM2=1,NLIM
+ I2=IN1+ILM2
+ I2E=I2+NDI
+ AM(I1,I2)=CC0
+ AM(I1,I2E)=CC0
+ AM(I1E,I2)=CC0
+ 28 AM(I1E,I2E)=CC0
+ AM(I1,I1)=DM
+ 30 AM(I1E,I1E)=DE
+ RETURN
+ END
+ SUBROUTINE ZTM(AM)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMMON/C9/GIS(4600,575),GLS(4600,575),SAM(9200,1150)
+ COMPLEX*16 GIS,GLS,SAM
+CCC DIMENSION AM(MXNDM,MXNDM)
+CCC NDIT.LE.MXNDM
+ DIMENSION AM(9200,9200)
+ COMPLEX*16 AM
+ COMPLEX*16 GIE,GLE,GHIT,A1,A2,A3,A4,
+ 1SUM1,SUM2,SUM3,SUM4,CC0
+ CC0=(0.0D0,0.0D0)
+ NDI=NSPH*NLIM
+ I2=0
+ DO 15 N2=1,NSPH
+ DO 15 L2=1,LI
+ L2TPO=L2+L2+1
+ M2=-L2-1
+ DO 15 IM2=1,L2TPO
+ M2=M2+1
+ I2=I2+1
+ I3=0
+ DO 15 L3=1,LE
+ L3TPO=L3+L3+1
+ M3=-L3-1
+ DO 15 IM3=1,L3TPO
+ M3=M3+1
+ I3=I3+1
+ GIS(I2,I3)=GHIT(2,0,N2,L2,M2,L3,M3)
+ 15 GLS(I2,I3)=GHIT(2,1,N2,L2,M2,L3,M3)
+ DO 25 I1=1,NDI
+ I1E=I1+NDI
+ DO 25 I3=1,NLEM
+ I3E=I3+NLEM
+ SUM1=CC0
+ SUM2=CC0
+ SUM3=CC0
+ SUM4=CC0
+ DO 20 I2=1,NDI
+ I2E=I2+NDI
+ GIE=GIS(I2,I3)
+ GLE=GLS(I2,I3)
+ A1=AM(I1,I2)
+ A2=AM(I1,I2E)
+ A3=AM(I1E,I2)
+ A4=AM(I1E,I2E)
+ SUM1=SUM1+A1*GIE+A2*GLE
+ SUM2=SUM2+A1*GLE+A2*GIE
+ SUM3=SUM3+A3*GIE+A4*GLE
+ 20 SUM4=SUM4+A3*GLE+A4*GIE
+ SAM(I1,I3)=SUM1
+ SAM(I1,I3E)=SUM2
+ SAM(I1E,I3)=SUM3
+ 25 SAM(I1E,I3E)=SUM4
+ DO 35 I1=1,NDI
+ DO 35 I0=1,NLEM
+ GIS(I1,I0)=DCONJG(GIS(I1,I0))
+ 35 GLS(I1,I0)=DCONJG(GLS(I1,I0))
+ NLEMT=NLEM+NLEM
+ DO 45 I0=1,NLEM
+ I0E=I0+NLEM
+ DO 45 I3=1,NLEMT
+ SUM1=CC0
+ SUM2=CC0
+ DO 40 I1=1,NDI
+ I1E=I1+NDI
+ A1=SAM(I1,I3)
+ A2=SAM(I1E,I3)
+ GIE=GIS(I1,I0)
+ GLE=GLS(I1,I0)
+ SUM1=SUM1+A1*GIE+A2*GLE
+ 40 SUM2=SUM2+A1*GLE+A2*GIE
+ AM0M(I0,I3)=-SUM1
+ 45 AM0M(I0E,I3)=-SUM2
+ RETURN
+ END
+ COMPLEX*16 FUNCTION GHIT(IHI,IPAMO,NBL,L1,M1,L2,M2)
+CCC NBL INDIVIDUATES TRANSFER VECTOR GOING FROM N2 TO N1;
+CCC IHI=0 FOR HANKEL, IHI=1 FOR BESSEL, IHI=2 FOR BESSEL FROM ORIGIN;
+CCC DEPENDING ON IHI, IPAMO=0 GIVES H OR I, IPAMO=1 GIVES K OR L
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
+ COMMON/C6/RAC3J(47)
+ COMPLEX*16 CSUM,CC0,UIM,CFUN
+ CC0=(0.0D0,0.0D0)
+ GHIT=CC0
+ IF(IHI.NE.2)GO TO 10
+ C0=0.0D0
+ IF(RXX(NBL).NE.C0.OR.RYY(NBL).NE.C0.OR.RZZ(NBL).NE.C0)GO TO 10
+ IF(IPAMO.NE.0)RETURN
+ IF(L1.EQ.L2.AND.M1.EQ.M2)GHIT=(1.0D0,0.0D0)
+ RETURN
+ 10 L1MP=L1-IPAMO
+ L1PO=L1+1
+ M1MM2=M1-M2
+ M1MM2M=IABS(M1MM2)+1
+ LMINPO=IABS(L2-L1MP)+1
+ LMAXPO=L2+L1MP+1
+ I3J0IN=IND3J(L1MP+1,L2)
+ ILIN=-1
+ IF((M1MM2M.GT.LMINPO).AND.(MOD(M1MM2M-LMINPO,2).NE.0))ILIN=0
+ ISN=1
+ IF(MOD(M1,2).NE.0)ISN=-ISN
+ IF(MOD(LMINPO,2).NE.0)GO TO 12
+ ISN=-ISN
+ IF(L2.GT.L1MP)ISN=-ISN
+ 12 NBLMO=NBL-1
+ IF(IHI.EQ.2)GO TO 50
+ NBHJ=NBLMO*LITPO
+ NBY=NBLMO*LITPOS
+ IF(IHI.EQ.1)GO TO 30
+ DO 24 JM=1,3
+ CSUM=CC0
+ MU=JM-2
+ MUPM1=MU+M1
+ MUPM2=MU+M2
+ IF(MUPM1.LT.-L1MP.OR.MUPM1.GT.L1MP.OR.MUPM2.LT.-L2.OR.MUPM2.GT.L2)
+ 1GO TO 24
+ JSN=-ISN
+ IF(MU.EQ.0)JSN=ISN
+ CR=CGEV(IPAMO,MU,L1,M1)*CGEV(0,MU,L2,M2)
+ I3J0=I3J0IN
+ IF((MUPM1.NE.0).OR.(MUPM2.NE.0))GO TO 16
+ DO 14 LT=LMINPO,LMAXPO,2
+ I3J0=I3J0+1
+ L3=LT-1
+ NY=L3*L3+LT
+ AORS=L3+LT
+ F3J=(V3J0(I3J0)*V3J0(I3J0)*DSQRT(AORS))*JSN
+ CFUN=(VH(NBHJ+LT)*VYHJ(NBY+NY))*F3J
+ CSUM=CSUM+CFUN
+ 14 JSN=-JSN
+ GO TO 22
+ 16 CALL R3JJR(L1MP,L2,-MUPM1,MUPM2)
+ IL=ILIN
+ DO 20 LT=LMINPO,LMAXPO,2
+ I3J0=I3J0+1
+ IF(M1MM2M.GT.LT)GO TO 20
+ IL=IL+2
+ L3=LT-1
+ NY=L3*L3+LT+M1MM2
+ AORS=L3+LT
+ F3J=(RAC3J(IL)*V3J0(I3J0)*DSQRT(AORS))*JSN
+ CFUN=(VH(NBHJ+LT)*VYHJ(NBY+NY))*F3J
+ CSUM=CSUM+CFUN
+ 20 JSN=-JSN
+ 22 CSUM=CSUM*CR
+ GHIT=GHIT+CSUM
+ 24 CONTINUE
+ GO TO 70
+ 30 DO 44 JM=1,3
+ CSUM=CC0
+ MU=JM-2
+ MUPM1=MU+M1
+ MUPM2=MU+M2
+ IF(MUPM1.LT.-L1MP.OR.MUPM1.GT.L1MP.OR.MUPM2.LT.-L2.OR.MUPM2.GT.L2)
+ 1GO TO 44
+ JSN=-ISN
+ IF(MU.EQ.0)JSN=ISN
+ CR=CGEV(IPAMO,MU,L1,M1)*CGEV(0,MU,L2,M2)
+ I3J0=I3J0IN
+ IF((MUPM1.NE.0).OR.(MUPM2.NE.0))GO TO 36
+ DO 34 LT=LMINPO,LMAXPO,2
+ I3J0=I3J0+1
+ L3=LT-1
+ NY=L3*L3+LT
+ AORS=L3+LT
+ F3J=(V3J0(I3J0)*V3J0(I3J0)*DSQRT(AORS))*JSN
+ CFUN=(VJ(NBHJ+LT)*VYHJ(NBY+NY))*F3J
+ CSUM=CSUM+CFUN
+ 34 JSN=-JSN
+ GO TO 42
+ 36 CALL R3JJR(L1MP,L2,-MUPM1,MUPM2)
+ IL=ILIN
+ DO 40 LT=LMINPO,LMAXPO,2
+ I3J0=I3J0+1
+ IF(M1MM2M.GT.LT)GO TO 40
+ IL=IL+2
+ L3=LT-1
+ NY=L3*L3+LT+M1MM2
+ AORS=L3+LT
+ F3J=(RAC3J(IL)*V3J0(I3J0)*DSQRT(AORS))*JSN
+ CFUN=(VJ(NBHJ+LT)*VYHJ(NBY+NY))*F3J
+ CSUM=CSUM+CFUN
+ 40 JSN=-JSN
+ 42 CSUM=CSUM*CR
+ GHIT=GHIT+CSUM
+ 44 CONTINUE
+ GO TO 70
+ 50 NBHJ=NBLMO*LMTPO
+ NBY=NBLMO*LMTPOS
+ DO 64 JM=1,3
+ CSUM=CC0
+ MU=JM-2
+ MUPM1=MU+M1
+ MUPM2=MU+M2
+ IF(MUPM1.LT.-L1MP.OR.MUPM1.GT.L1MP.OR.MUPM2.LT.-L2.OR.MUPM2.GT.L2)
+ 1GO TO 64
+ JSN=-ISN
+ IF(MU.EQ.0)JSN=ISN
+ CR=CGEV(IPAMO,MU,L1,M1)*CGEV(0,MU,L2,M2)
+ I3J0=I3J0IN
+ IF((MUPM1.NE.0).OR.(MUPM2.NE.0))GO TO 56
+ DO 54 LT=LMINPO,LMAXPO,2
+ I3J0=I3J0+1
+ L3=LT-1
+ NY=L3*L3+LT
+ AORS=L3+LT
+ F3J=(V3J0(I3J0)*V3J0(I3J0)*DSQRT(AORS))*JSN
+ CFUN=(VJ0(NBHJ+LT)*VYJ0(NBY+NY))*F3J
+ CSUM=CSUM+CFUN
+ 54 JSN=-JSN
+ GO TO 62
+ 56 CALL R3JJR(L1MP,L2,-MUPM1,MUPM2)
+ IL=ILIN
+ DO 60 LT=LMINPO,LMAXPO,2
+ I3J0=I3J0+1
+ IF(M1MM2M.GT.LT)GO TO 60
+ IL=IL+2
+ L3=LT-1
+ NY=L3*L3+LT+M1MM2
+ AORS=L3+LT
+ F3J=(RAC3J(IL)*V3J0(I3J0)*DSQRT(AORS))*JSN
+ CFUN=(VJ0(NBHJ+LT)*VYJ0(NBY+NY))*F3J
+ CSUM=CSUM+CFUN
+ 60 JSN=-JSN
+ 62 CSUM=CSUM*CR
+ GHIT=GHIT+CSUM
+ 64 CONTINUE
+ 70 PI4=DACOS(0.0D0)*8.0D0
+ IF(IPAMO.EQ.1)GO TO 90
+ CR=PI4*(L1+L1PO)*(L2+L2+1)
+ CR=DSQRT(CR)
+ GHIT=GHIT*CR
+ RETURN
+ 90 UIM=(0.0D0,1.0D0)
+ CR=L1PO
+ CR=(PI4*(L1+L1MP)*(L1+L1PO)*(L2+L2+1))/CR
+ CR=DSQRT(CR)
+ GHIT=GHIT*(CR*UIM)
+ RETURN
+ END
+ REAL*8 FUNCTION CGEV(IPAMO,MU,L,M)
+CCC CGEV(IPAMO,MU,L,M)=CLGO(1,L-IPAMO,L;-MU,MU+M,M)
+ REAL*8 XD,XN
+ IF(IPAMO.NE.0)GO TO 30
+ IF((M.NE.0).OR.(MU.NE.0))GO TO 10
+ CGEV=0.0D0
+ RETURN
+ 10 IF(MU.EQ.0)GO TO 20
+ XD=(L+1)*L*2
+ IF(MU.GT.0)GO TO 15
+ XN=(L+M)*(L-M+1)
+ CGEV=DSQRT(XN/XD)
+ RETURN
+ 15 XN=(L-M)*(L+M+1)
+ CGEV=-DSQRT(XN/XD)
+ RETURN
+ 20 XD=(L+1)*L
+ XN=-M
+ CGEV=XN/DSQRT(XD)
+ RETURN
+ 30 XD=(L*2-1)*L*2
+ IF(MU)35,40,45
+ 35 XN=(L-1+M)*(L+M)
+ GO TO 50
+ 40 XN=(L-M)*(L+M)*2
+ GO TO 50
+ 45 XN=(L-1-M)*(L-M)
+ 50 CGEV=DSQRT(XN/XD)
+ RETURN
+ END
+ SUBROUTINE R3J000(J2,J3)
+CCC 3j(J,J2,J3;0,0,0)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C6/RAC3J(47)
+ ONE=1.0D0
+ JMX=J3+J2
+ IF(JMX.GT.0)GO TO 10
+ RAC3J(1)=ONE
+ RETURN
+ 10 JMN=IABS(J3-J2)
+ NJMO=(JMX-JMN)/2
+ JF=JMX+JMX+1
+ ISN=1
+ IF(MOD(JMN,2).NE.0)ISN=-1
+ IF(NJMO.GT.0)GO TO 15
+ SJ=JF
+ CNR=(ONE/DSQRT(SJ))*ISN
+ RAC3J(1)=CNR
+ RETURN
+ 15 SJR=JF
+ JMXPOS=(JMX+1)*(JMX+1)
+ JMNS=JMN*JMN
+ J1MO=JMX-1
+ J1S=(J1MO+1)*(J1MO+1)
+ CJ=(JMXPOS-J1S)*(J1S-JMNS)
+ CJ=DSQRT(CJ)
+ J1MOS=J1MO*J1MO
+ CJMO=(JMXPOS-J1MOS)*(J1MOS-JMNS)
+ CJMO=DSQRT(CJMO)
+ IF(NJMO.GT.1)GO TO 20
+ RAC3J(1)=-CJ/CJMO
+ SJ=SJR+(RAC3J(1)*RAC3J(1))*(JF-4)
+ CNR=(ONE/DSQRT(SJ))*ISN
+ RAC3J(2)=CNR
+ RAC3J(1)=RAC3J(1)*CNR
+ RETURN
+ 20 NJ=NJMO+1
+ NMAT=(NJ+1)/2
+ RAC3J(NJ)=ONE
+ RAC3J(NJMO)=-CJ/CJMO
+ IF(NMAT.EQ.NJMO)GO TO 50
+ NBR=NJMO-NMAT
+ DO 45 IBR=1,NBR
+ IRR=NJ-IBR
+ JF=JF-4
+ J1MO=J1MO-2
+ J1S=(J1MO+1)*(J1MO+1)
+ CJ=(JMXPOS-J1S)*(J1S-JMNS)
+ CJ=DSQRT(CJ)
+ J1MOS=J1MO*J1MO
+ CJMO=(JMXPOS-J1MOS)*(J1MOS-JMNS)
+ CJMO=DSQRT(CJMO)
+ RAC3J(IRR-1)=RAC3J(IRR)*(-CJ/CJMO)
+ 45 SJR=SJR+(RAC3J(IRR)*RAC3J(IRR))*JF
+ 50 RACMAT=RAC3J(NMAT)
+ SJR=SJR+(RACMAT*RACMAT)*(JF-4)
+ RAC3J(1)=ONE
+ JF=JMN+JMN+1
+ SJL=JF
+ J1PT=JMN+2
+ J1POS=(J1PT-1)*(J1PT-1)
+ CJPO=(JMXPOS-J1POS)*(J1POS-JMNS)
+ CJPO=DSQRT(CJPO)
+ J1PTS=J1PT*J1PT
+ CJPT=(JMXPOS-J1PTS)*(J1PTS-JMNS)
+ CJPT=DSQRT(CJPT)
+ RAC3J(2)=-CJPO/CJPT
+ NMATMO=NMAT-1
+ IF(NMATMO.LT.2)GO TO 75
+ DO 70 IRL=2,NMATMO
+ JF=JF+4
+ J1PT=J1PT+2
+ J1POS=(J1PT-1)*(J1PT-1)
+ CJPO=(JMXPOS-J1POS)*(J1POS-JMNS)
+ CJPO=DSQRT(CJPO)
+ J1PTS=J1PT*J1PT
+ CJPT=(JMXPOS-J1PTS)*(J1PTS-JMNS)
+ CJPT=DSQRT(CJPT)
+ RAC3J(IRL+1)=RAC3J(IRL)*(-CJPO/CJPT)
+ 70 SJL=SJL+(RAC3J(IRL)*RAC3J(IRL))*JF
+ 75 RATRAC=RACMAT/RAC3J(NMAT)
+ RATS=RATRAC*RATRAC
+ SJ=SJR+SJL*RATS
+ RAC3J(NMAT)=RACMAT
+ CNR=(ONE/DSQRT(SJ))*ISN
+ DO 80 IRR=NMAT,NJ
+ 80 RAC3J(IRR)=RAC3J(IRR)*CNR
+ CNL=CNR*RATRAC
+ DO 85 IRL=1,NMATMO
+ 85 RAC3J(IRL)=RAC3J(IRL)*CNL
+ RETURN
+ END
+ SUBROUTINE R3JJR(J2,J3,M2,M3)
+CCC 3j(J,J2,J3;-M2-M3,M2,M3)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C6/RAC3J(47)
+ ONE=1.0D0
+ JMX=J3+J2
+ JDF=J3-J2
+ M1=-M2-M3
+ JMN=MAX0(IABS(JDF),IABS(M1))
+ NJMO=JMX-JMN
+ JF=JMX+JMX+1
+ ISN=1
+ IF(MOD(JDF+M1,2).NE.0)ISN=-1
+ IF(NJMO.GT.0)GO TO 15
+ SJ=JF
+ CNR=(ONE/DSQRT(SJ))*ISN
+ RAC3J(1)=CNR
+ RETURN
+ 15 SJT=ONE
+ SJR=JF
+ JSMPOS=(JMX+1)*(JMX+1)
+ JDFS=JDF*JDF
+ M1S=M1*M1
+ MDF=M3-M2
+ IDJC=M1*(J3*(J3+1)-J2*(J2+1))
+ J1=JMX
+ J1S=J1*J1
+ J1PO=J1+1
+ CCJ=(J1S-JDFS)*(J1S-M1S)
+ CJ=CCJ*(JSMPOS-J1S)
+ CJ=DSQRT(CJ)
+ DJ=JF*(J1*J1PO*MDF+IDJC)
+ IF(NJMO.GT.1)GO TO 20
+ RAC3J(1)=-DJ/(CJ*J1PO)
+ SJ=SJR+(RAC3J(1)*RAC3J(1))*(JF-2)
+ CNR=(ONE/DSQRT(SJ))*ISN
+ RAC3J(2)=CNR
+ RAC3J(1)=RAC3J(1)*CNR
+ RETURN
+ 20 NJ=NJMO+1
+ NMAT=(NJ+1)/2
+ RAC3J(NJ)=ONE
+ RAC3J(NJMO)=-DJ/(CJ*J1PO)
+ IF(NMAT.EQ.NJMO)GO TO 50
+ NBR=NJMO-NMAT
+ DO 45 IBR=1,NBR
+ IRR=NJ-IBR
+ JF=JF-2
+ J1=J1-1
+ J1S=J1*J1
+ J1PO=J1+1
+ CJP=CJ
+ CCJ=(J1S-JDFS)*(J1S-M1S)
+ CJ=CCJ*(JSMPOS-J1S)
+ CJ=DSQRT(CJ)
+ SJT=RAC3J(IRR)*RAC3J(IRR)
+ DJ=JF*(J1*J1PO*MDF+IDJC)
+ RAC3J(IRR-1)=-(RAC3J(IRR)*DJ+RAC3J(IRR+1)*(CJP*J1))/(CJ*J1PO)
+ 45 SJR=SJR+SJT*JF
+ 50 OSJT=SJT
+ SJT=RAC3J(NMAT)*RAC3J(NMAT)
+ IF(SJT.LT.OSJT)GO TO 55
+ SJR=SJR+SJT*(JF-2)
+ GO TO 60
+ 55 NMAT=NMAT+1
+ 60 RACMAT=RAC3J(NMAT)
+ RAC3J(1)=ONE
+ JF=JMN+JMN+1
+ SJL=JF
+ J1=JMN
+ IF(J1.EQ.0)GO TO 62
+ J1PO=J1+1
+ J1POS=J1PO*J1PO
+ CCJP=(J1POS-JDFS)*(J1POS-M1S)
+ CJP=CCJP*(JSMPOS-J1POS)
+ CJP=DSQRT(CJP)
+ DJ=JF*(J1*J1PO*MDF+IDJC)
+ RAC3J(2)=-DJ/(CJP*J1)
+ GO TO 63
+ 62 CJP=JSMPOS-1
+ CJP=DSQRT(CJP)
+ DJ=MDF
+ RAC3J(2)=-DJ/CJP
+ 63 NMATMO=NMAT-1
+ IF(NMATMO.LT.2)GO TO 75
+ DO 70 IRL=2,NMATMO
+ JF=JF+2
+ J1=J1+1
+ J1PO=J1+1
+ J1POS=J1PO*J1PO
+ CJ=CJP
+ CCJP=(J1POS-JDFS)*(J1POS-M1S)
+ CJP=CCJP*(JSMPOS-J1POS)
+ CJP=DSQRT(CJP)
+ SJT=RAC3J(IRL)*RAC3J(IRL)
+ DJ=JF*(J1*J1PO*MDF+IDJC)
+ RAC3J(IRL+1)=-(RAC3J(IRL)*DJ+RAC3J(IRL-1)*(CJ*J1PO))/(CJP*J1)
+ 70 SJL=SJL+SJT*JF
+ 75 RATRAC=RACMAT/RAC3J(NMAT)
+ RATS=RATRAC*RATRAC
+ SJ=SJR+SJL*RATS
+ RAC3J(NMAT)=RACMAT
+ CNR=(ONE/DSQRT(SJ))*ISN
+ DO 80 IRR=NMAT,NJ
+ 80 RAC3J(IRR)=RAC3J(IRR)*CNR
+ CNL=CNR*RATRAC
+ DO 85 IRL=1,NMATMO
+ 85 RAC3J(IRL)=RAC3J(IRL)*CNL
+ RETURN
+ END
+ SUBROUTINE R3JMR(J1,J2,J3,M1)
+CCC 3j(J1,J2,J3;M1,M,-M1-M)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C6/RAC3J(47)
+ ONE=1.0D0
+ MMX=MIN0(J2,J3-M1)
+ MMN=MAX0(-J2,-J3-M1)
+ NMMO=MMX-MMN
+ J1PO=J1+1
+ J1TPO=J1PO+J1
+ ISN=1
+ IF(MOD(J2-J3-M1,2).NE.0)ISN=-1
+ IF(NMMO.GT.0)GO TO 15
+ SJ=J1TPO
+ CNR=(ONE/DSQRT(SJ))*ISN
+ RAC3J(1)=CNR
+ RETURN
+ 15 J1S=J1*J1PO
+ J2PO=J2+1
+ J2S=J2*J2PO
+ J3PO=J3+1
+ J3S=J3*J3PO
+ ID=J1S-J2S-J3S
+ M2=MMX
+ M3=M1+M2
+ CM=(J2PO-M2)*(J2+M2)*(J3PO-M3)*(J3+M3)
+ CM=DSQRT(CM)
+ DM=ID+M2*M3*2
+ IF(NMMO.GT.1)GO TO 20
+ RAC3J(1)=DM/CM
+ SJ=(ONE+RAC3J(1)*RAC3J(1))*J1TPO
+ CNR=(ONE/DSQRT(SJ))*ISN
+ RAC3J(2)=CNR
+ RAC3J(1)=RAC3J(1)*CNR
+ RETURN
+ 20 NM=NMMO+1
+ NMAT=(NM+1)/2
+ RAC3J(NM)=ONE
+ RAC3J(NMMO)=DM/CM
+ SJT=ONE
+ SJR=ONE
+ IF(NMAT.EQ.NMMO)GO TO 50
+ NBR=NMMO-NMAT
+ DO 45 IBR=1,NBR
+ IRR=NM-IBR
+ M2=M2-1
+ M3=M1+M2
+ CMP=CM
+ CM=(J2PO-M2)*(J2+M2)*(J3PO-M3)*(J3+M3)
+ CM=DSQRT(CM)
+ SJT=RAC3J(IRR)*RAC3J(IRR)
+ DM=ID+M2*M3*2
+ RAC3J(IRR-1)=(RAC3J(IRR)*DM-RAC3J(IRR+1)*CMP)/CM
+ 45 SJR=SJR+SJT
+ 50 OSJT=SJT
+ SJT=RAC3J(NMAT)*RAC3J(NMAT)
+ IF(SJT.LT.OSJT)GO TO 55
+ SJR=SJR+SJT
+ GO TO 60
+ 55 NMAT=NMAT+1
+ 60 RACMAT=RAC3J(NMAT)
+ RAC3J(1)=ONE
+ M2=MMN
+ M3=M1+M2
+ CMP=(J2-M2)*(J2PO+M2)*(J3-M3)*(J3PO+M3)
+ CMP=DSQRT(CMP)
+ DM=ID+M2*M3*2
+ RAC3J(2)=DM/CMP
+ SJL=ONE
+ NMATMO=NMAT-1
+ IF(NMATMO.LT.2)GO TO 75
+ DO 70 IRL=2,NMATMO
+ M2=M2+1
+ M3=M1+M2
+ CM=CMP
+ CMP=(J2-M2)*(J2PO+M2)*(J3-M3)*(J3PO+M3)
+ CMP=DSQRT(CMP)
+ SJT=RAC3J(IRL)*RAC3J(IRL)
+ DM=ID+M2*M3*2
+ RAC3J(IRL+1)=(RAC3J(IRL)*DM-RAC3J(IRL-1)*CM)/CMP
+ 70 SJL=SJL+SJT
+ 75 RATRAC=RACMAT/RAC3J(NMAT)
+ RATS=RATRAC*RATRAC
+ SJ=(SJR+SJL*RATS)*J1TPO
+ RAC3J(NMAT)=RACMAT
+ CNR=(ONE/DSQRT(SJ))*ISN
+ DO 80 IRR=NMAT,NM
+ 80 RAC3J(IRR)=RAC3J(IRR)*CNR
+ CNL=CNR*RATRAC
+ DO 85 IRL=1,NMATMO
+ 85 RAC3J(IRL)=RAC3J(IRL)*CNL
+ RETURN
+ END
+ SUBROUTINE DME(LI,I,NPNT,NPNTTS,VK,EXDC,EXRI,JER,LCALC,ARG)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION CFJ(LIPT),RFJ(LIPT),RFN(LIPT),
+CCC 1FBI(LIPT),FB(LIPT),FN(LIPT),
+CCC 2RMF(LI),DRMF(LI),REF(LI),DREF(LI)
+ DIMENSION CFJ(25),RFJ(25),RFN(25),
+ 1FBI(25),FB(25),FN(25),RMF(23),DRMF(23),REF(23),DREF(23)
+ COMPLEX*16 CFJ,FBI,FB,FN,RMF,DRMF,REF,DREF
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C2/RIS(999),DLRI(999),DC0(5),VKT(8),VSZ(8)
+ COMPLEX*16 RIS,DLRI,DC0,VKT
+ COMPLEX*16 DFBI,DFB,DFN,CCNA,CCNB,CCNC,CCND,
+ 1Y1,DY1,Y2,DY2,ARIN,ARG,CRI,UIM
+ JER=0
+ UIM=(0.0D0,1.0D0)
+ NSTP=NPNT-1
+ NSTPTS=NPNTTS-1
+ LIPO=LI+1
+ LIPT=LI+2
+ SZ=VK*ROS(I)
+ VSZ(I)=SZ
+ VKR1=VK*RC(I,1)
+ NSH=NSHL(I)
+ VKT(I)=CDSQRT(DC0(1))
+ ARG=VKR1*VKT(I)
+ ARIN=ARG
+ IF(DIMAG(ARG).EQ.0.0D0)GO TO 26
+ CALL CBF(LIPO,ARG,LCALC,CFJ)
+ IF(LCALC.GE.LIPO)GO TO 22
+ JER=5
+ RETURN
+ 22 DO 24 J=1,LIPT
+ 24 FBI(J)=CFJ(J)
+ GO TO 32
+ 26 RARG=DREAL(ARG)
+ CALL RBF(LIPO,RARG,LCALC,RFJ)
+ IF(LCALC.GE.LIPO)GO TO 28
+ JER=5
+ RETURN
+ 28 DO 30 J=1,LIPT
+ 30 FBI(J)=RFJ(J)
+ 32 AREX=SZ*EXRI
+ ARG=AREX
+ RARG=AREX
+ CALL RBF(LIPO,RARG,LCALC,RFJ)
+ IF(LCALC.GE.LIPO)GO TO 40
+ JER=7
+ RETURN
+ 40 CALL RNF(LIPO,RARG,LCALC,RFN)
+ IF(LCALC.GE.LIPO)GO TO 42
+ JER=8
+ RETURN
+ 42 DO 43 J=1,LIPT
+ FB(J)=RFJ(J)
+ 43 FN(J)=RFN(J)
+ IF(NSH.GT.1)GO TO 65
+ CRI=DC0(1)/EXDC
+ DO 60 L=1,LI
+ LPO=L+1
+ LTPO=LPO+L
+ LPT=LPO+1
+ DFBI=(L*FBI(L)-LPO*FBI(LPT))*ARIN+FBI(LPO)*LTPO
+ DFB=(L*FB(L)-LPO*FB(LPT))*AREX+FB(LPO)*LTPO
+ DFN=(L*FN(L)-LPO*FN(LPT))*AREX+FN(LPO)*LTPO
+ CCNA=FBI(LPO)*DFN
+ CCNB=FN(LPO)*DFBI
+ CCNC=FBI(LPO)*DFB
+ CCND=FB(LPO)*DFBI
+ RMI(L,I)=1.0D0+UIM*(CCNA-CCNB)/(CCNC-CCND)
+ 60 REI(L,I)=1.0D0+UIM*(CRI*CCNA-CCNB)/(CRI*CCNC-CCND)
+ RETURN
+ 65 DO 80 L=1,LI
+ LPO=L+1
+ LTPO=LPO+L
+ LPT=LPO+1
+ DLTPO=LTPO
+cccccccccccccccccccccc
+ Y1=FBI(LPO)
+ DY1=(L*FBI(L)-LPO*FBI(LPT))*VKT(I)/DLTPO
+cccccccccccccccccccccc
+ Y2=Y1
+ DY2=DY1
+ IC=1
+ DO 76 NS=2,NSH
+ NSMO=NS-1
+ VKR=VK*RC(I,NSMO)
+ IF(MOD(NS,2).EQ.0)GO TO 70
+ IC=IC+1
+ STEP=NSTP
+ STEP=VK*(RC(I,NS)-RC(I,NSMO))/STEP
+ ARG=DC0(IC)
+ CALL RKC(NSTP,STEP,ARG,VKR,LPO,Y1,Y2,DY1,DY2)
+ GO TO 76
+ 70 CALL DIEL(NSTPTS,NSMO,I,IC,VK)
+ STEPTS=NSTPTS
+ STEPTS=VK*(RC(I,NS)-RC(I,NSMO))/STEPTS
+ CALL RKT(NSTPTS,STEPTS,VKR,LPO,Y1,Y2,DY1,DY2)
+ 76 CONTINUE
+ RMF(L)=Y1*SZ
+ DRMF(L)=DY1*SZ+Y1
+ REF(L)=Y2*SZ
+ 80 DREF(L)=DY2*SZ+Y2
+ CRI=(1.0D0,0.0D0)
+ IF(MOD(NSH,2).NE.0)CRI=DC0(IC)/EXDC
+ DO 90 L=1,LI
+ LPO=L+1
+ LTPO=LPO+L
+ LPT=LPO+1
+ DFB=(L*FB(L)-LPO*FB(LPT))*AREX+FB(LPO)*LTPO
+ DFN=(L*FN(L)-LPO*FN(LPT))*AREX+FN(LPO)*LTPO
+ CCNA=RMF(L)*DFN
+ CCNB=DRMF(L)*FN(LPO)*SZ*LTPO
+ CCNC=RMF(L)*DFB
+ CCND=DRMF(L)*FB(LPO)*SZ*LTPO
+ RMI(L,I)=1.0D0+UIM*(CCNA-CCNB)/(CCNC-CCND)
+ CCNA=REF(L)*DFN
+ CCNB=DREF(L)*FN(LPO)*SZ*LTPO
+ CCNC=REF(L)*DFB
+ CCND=DREF(L)*FB(LPO)*SZ*LTPO
+ 90 REI(L,I)=1.0D0+UIM*(CRI*CCNA-CCNB)/(CRI*CCNC-CCND)
+ RETURN
+ END
+ SUBROUTINE RKT(NPNTMO,STEP,X,LPO,Y1,Y2,DY1,DY2)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C2/RIS(999),DLRI(999),DC0(5),VKT(8),VSZ(8)
+ COMPLEX*16 RIS,DLRI,DC0,VKT
+ COMPLEX*16 Y1,DY1,Y2,DY2,CY1,CDY1,C11,
+ 1CY23,CDY23,YC2,C12,C13,CY4,CDY4,YY,C14,C21,C22,C23,C24
+ HSTEP=.5D0*STEP
+ CL=LPO*(LPO-1)
+ DO 60 IPNT=1,NPNTMO
+ JPNT=IPNT+IPNT-1
+ CY1=CL/(X*X)-RIS(JPNT)
+ CDY1=-2.0D0/X
+ C11=(CY1*Y1+CDY1*DY1)*STEP
+ XH=X+HSTEP
+ JPNTPO=JPNT+1
+ CY23=CL/(XH*XH)-RIS(JPNTPO)
+ CDY23=-2.0D0/XH
+ YC2=Y1+DY1*HSTEP
+ C12=(CY23*YC2+CDY23*(DY1+.5D0*C11))*STEP
+ C13=(CY23*(YC2+.25D0*C11*STEP)+CDY23*(DY1+.5D0*C12))*STEP
+ XN=X+STEP
+ JPNTPT=JPNT+2
+ CY4=CL/(XN*XN)-RIS(JPNTPT)
+ CDY4=-2.0D0/XN
+ YY=Y1+DY1*STEP
+ C14=(CY4*(YY+.5D0*C12*STEP)+CDY4*(DY1+C13))*STEP
+ Y1=YY+(C11+C12+C13)*STEP/6.0D0
+ DY1=DY1+(.5D0*C11+C12+C13+.5D0*C14)/3.0D0
+ CY1=CY1-CDY1*DLRI(JPNT)
+ CDY1=CDY1+2.0D0*DLRI(JPNT)
+ C21=(CY1*Y2+CDY1*DY2)*STEP
+ CY23=CY23-CDY23*DLRI(JPNTPO)
+ CDY23=CDY23+2.0D0*DLRI(JPNTPO)
+ YC2=Y2+DY2*HSTEP
+ C22=(CY23*YC2+CDY23*(DY2+.5D0*C21))*STEP
+ C23=(CY23*(YC2+.25D0*C21*STEP)+CDY23*(DY2+.5D0*C22))*STEP
+ CY4=CY4-CDY4*DLRI(JPNTPT)
+ CDY4=CDY4+2.0D0*DLRI(JPNTPT)
+ YY=Y2+DY2*STEP
+ C24=(CY4*(YC2+.5D0*C22*STEP)+CDY4*(DY2+C23))*STEP
+ Y2=YY+(C21+C22+C23)*STEP/6.0D0
+ DY2=DY2+(.5D0*C21+C22+C23+.5D0*C24)/3.0D0
+ 60 X=XN
+ RETURN
+ END
+ SUBROUTINE RKC(NPNTMO,STEP,DCC,X,LPO,Y1,Y2,DY1,DY2)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMPLEX*16 Y1,DY1,Y2,DY2,CY1,CDY1,C11,
+ 1CY23,YC2,C12,C13,CY4,YY,C14,C21,C22,C23,C24,DCC
+ HSTEP=.5D0*STEP
+ CL=LPO*(LPO-1)
+ DO 60 IPNT=1,NPNTMO
+ CY1=CL/(X*X)-DCC
+ CDY1=-2.0D0/X
+ C11=(CY1*Y1+CDY1*DY1)*STEP
+ XH=X+HSTEP
+ CY23=CL/(XH*XH)-DCC
+ CDY23=-2.0D0/XH
+ YC2=Y1+DY1*HSTEP
+ C12=(CY23*YC2+CDY23*(DY1+.5D0*C11))*STEP
+ C13=(CY23*(YC2+.25D0*C11*STEP)+CDY23*(DY1+.5D0*C12))*STEP
+ XN=X+STEP
+ CY4=CL/(XN*XN)-DCC
+ CDY4=-2.0D0/XN
+ YY=Y1+DY1*STEP
+ C14=(CY4*(YY+.5D0*C12*STEP)+CDY4*(DY1+C13))*STEP
+ Y1=YY+(C11+C12+C13)*STEP/6.0D0
+ DY1=DY1+(.5D0*C11+C12+C13+.5D0*C14)/3.0D0
+ C21=(CY1*Y2+CDY1*DY2)*STEP
+ YC2=Y2+DY2*HSTEP
+ C22=(CY23*YC2+CDY23*(DY2+.5D0*C21))*STEP
+ C23=(CY23*(YC2+.25D0*C21*STEP)+CDY23*(DY2+.5D0*C22))*STEP
+ YY=Y2+DY2*STEP
+ C24=(CY4*(YC2+.5D0*C22*STEP)+CDY4*(DY2+C23))*STEP
+ Y2=YY+(C21+C22+C23)*STEP/6.0D0
+ DY2=DY2+(.5D0*C21+C22+C23+.5D0*C24)/3.0D0
+ 60 X=XN
+ RETURN
+ END
+ SUBROUTINE DIEL(NPNTMO,NS,I,IC,VK)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C1/VH(1316),VJ0(376),VYHJ(61852),VYJ0(17672),VJ(1),
+ 1RMI(23,8),REI(23,8),W(1150,4),AM0M(1150,1150),
+ 2FSAS(8),SAS(8,2,2),VINTS(8,16),VINTT(16),
+ 3FSAC(2,2),SAC(2,2),FSACM(2,2),
+ 4VINT(16),VINTM(16),SCSCP(2),ECSCP(2),SCSCPM(2),ECSCPM(2),
+ 5V3J0(4876),SCSC(2),ECSC(2),SCSCM(2),ECSCM(2),
+ 6SSCS(8),SEXS(8),SABS(8),SQSCS(8),SQEXS(8),SQABS(8),
+ 7GCSV(8),RXX(8),RYY(8),RZZ(8),ROS(8),RC(8,8),
+ 8IND3J(24,23),IOG(8),NSHL(8)
+ COMPLEX*16 VH,VJ0,VYHJ,VYJ0,VJ,RMI,REI,W,AM0M,FSAS,SAS,
+ 1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
+ COMMON/C2/RIS(999),DLRI(999),DC0(5),VKT(8),VSZ(8)
+ COMPLEX*16 RIS,DLRI,DC0,VKT
+ COMPLEX*16 DEL
+ DIF=RC(I,NS+1)-RC(I,NS)
+ HSTEP=NPNTMO
+ HSTEP=.5D0*DIF/HSTEP
+ RR=RC(I,NS)
+ DEL=DC0(IC+1)-DC0(IC)
+ KPNT=NPNTMO+NPNTMO
+ RIS(KPNT+1)=DC0(IC+1)
+ DLRI(KPNT+1)=(0.0D0,0.0D0)
+ DO 90 NP=1,KPNT
+ FF=(RR-RC(I,NS))/DIF
+ RIS(NP)=DEL*FF*FF*(-2.0D0*FF+3.0D0)+DC0(IC)
+ DLRI(NP)=3.0D0*DEL*FF*(1.0D0-FF)/(DIF*VK*RIS(NP))
+ 90 RR=RR+HSTEP
+ RETURN
+ END
+ SUBROUTINE RBF(N,X,NM,SJ)
+C
+C FROM SPHJ OF LIBRARY specfun
+C
+C =======================================================
+C Purpose: Compute spherical Bessel functions j
+C Input : X --- Argument of j
+C N --- Order of j ( N = 0,1,2,... )
+C Output: SJ(N+1) --- j
+C NM --- Highest order computed
+C Routines called:
+C MSTA1 and MSTA2 for computing the starting
+C point for backward recurrence
+C =======================================================
+C
+ IMPLICIT REAL*8 (A-H,O-Z)
+ DIMENSION SJ(N+1)
+ A0=DABS(X)
+ NM=N
+ IF(A0.LT.1.0D-60)THEN
+ DO K=2,N+1
+ SJ(K)=0.0D0
+ ENDDO
+ SJ(1)=1.0D0
+ RETURN
+ ENDIF
+ SJ(1)=DSIN(X)/X
+ IF(N.EQ.0)RETURN
+ SJ(2)=(SJ(1)-DCOS(X))/X
+ IF(N.EQ.1)RETURN
+ SA=SJ(1)
+ SB=SJ(2)
+ M=MSTA1(A0,200)
+ IF(M.LT.N)THEN
+ NM=M
+ ELSE
+ M=MSTA2(A0,N,15)
+ ENDIF
+ F0=0.0D0
+ F1=1.0D0-100
+ DO K=M,0,-1
+ F=(2.0D0*K+3.0D0)*F1/X-F0
+ IF(K.LE.NM)SJ(K+1)=F
+ F0=F1
+ F1=F
+ ENDDO
+ IF(DABS(SA).GT.DABS(SB))CS=SA/F
+ IF(DABS(SA).LE.DABS(SB))CS=SB/F0
+ DO K=1,NM+1
+ SJ(K)=CS*SJ(K)
+ ENDDO
+ END
+ SUBROUTINE CBF(N,Z,NM,CSJ)
+C
+C FROM CSPHJY OF LIBRARY specfun
+C
+C ==========================================================
+C Purpose: Compute spherical Bessel functions j
+C Input : Z --- Complex argument of j
+C N --- Order of j ( N = 0,1,2,... )
+C Output: CSJ(N+1) --- j
+C NM --- Highest order computed
+C Routines called:
+C MSTA1 and MSTA2 for computing the starting
+C point for backward recurrence
+C ==========================================================
+C
+ IMPLICIT COMPLEX*16 (C,Z)
+ REAL*8 A0
+ DIMENSION CSJ(N+1)
+ A0=CDABS(Z)
+ NM=N
+ IF(A0.LT.1.0D-60)THEN
+ DO K=2,N+1
+ CSJ(K)=0.0D0
+ ENDDO
+ CSJ(1)=(1.0D0,0.0D0)
+ RETURN
+ ENDIF
+ CSJ(1)=CDSIN(Z)/Z
+ IF(N.EQ.0)RETURN
+ CSJ(2)=(CSJ(1)-CDCOS(Z))/Z
+ IF(N.EQ.1)RETURN
+ CSA=CSJ(1)
+ CSB=CSJ(2)
+ M=MSTA1(A0,200)
+ IF(M.LT.N)THEN
+ NM=M
+ ELSE
+ M=MSTA2(A0,N,15)
+ ENDIF
+ CF0=0.0D0
+ CF1=1.0D0-100
+ DO K=M,0,-1
+ CF=(2.0D0*K+3.0D0)*CF1/Z-CF0
+ IF(K.LE.NM)CSJ(K+1)=CF
+ CF0=CF1
+ CF1=CF
+ ENDDO
+ IF(CDABS(CSA).GT.CDABS(CSB))CS=CSA/CF
+ IF(CDABS(CSA).LE.CDABS(CSB))CS=CSB/CF0
+ DO K=1,NM+1
+ CSJ(K)=CS*CSJ(K)
+ ENDDO
+ END
+ INTEGER FUNCTION MSTA1(X,MP)
+C
+C ===================================================
+C Purpose: Determine the starting point for backward
+C recurrence such that the magnitude of all
+C J or j at that point is about 10**(-MP)
+C Input : X --- Abs of argument of J or j
+C MP --- Value of magnitude
+C Output: MSTA1 --- Starting point
+C ===================================================
+C
+ IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ A0=DABS(X)
+ N0=INT(1.1*A0)+1
+ F0=ENVJ(N0,A0)-MP
+ N1=N0+5
+ F1=ENVJ(N1,A0)-MP
+ DO 10 IT=1,20
+ NN=N1-IDINT((N1-N0)/(1.0D0-F0/F1))
+ F=ENVJ(NN,A0)-MP
+ IF(ABS(NN-N1).LT.1)GO TO 20
+ N0=N1
+ F0=F1
+ N1=NN
+ 10 F1=F
+ 20 MSTA1=NN
+ RETURN
+ END
+ INTEGER FUNCTION MSTA2(X,N,MP)
+C
+C ===================================================
+C Purpose: Determine the starting point for backward
+C recurrence such that all J or j
+C have MP significant digits
+C Input : X --- Abs of argument of J or j
+C N --- Order of J or j
+C MP --- Significant digit
+C Output: MSTA2 --- Starting point
+C ===================================================
+C
+ IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ A0=DABS(X)
+ HMP=0.5D0*MP
+ EJN=ENVJ(N,A0)
+ IF(EJN.LE.HMP)THEN
+ OBJ=MP
+C
+ N0=INT(1.1*A0)+1
+C
+ ELSE
+ OBJ=HMP+EJN
+ N0=N
+ ENDIF
+ F0=ENVJ(N0,A0)-OBJ
+ N1=N0+5
+ F1=ENVJ(N1,A0)-OBJ
+ DO 10 IT=1,20
+ NN=N1-IDINT((N1-N0)/(1.0D0-F0/F1))
+ F=ENVJ(NN,A0)-OBJ
+ IF(ABS(NN-N1).LT.1)GO TO 20
+ N0=N1
+ F0=F1
+ N1=NN
+ 10 F1=F
+ 20 MSTA2=NN+10
+ RETURN
+ END
+ REAL*8 FUNCTION ENVJ(N,X)
+ DOUBLE PRECISION X,XN
+C
+ IF(N.EQ.0)THEN
+ XN=1.0D-100
+ ENVJ=0.5D0*DLOG10(6.28D0*XN)-XN*DLOG10(1.36D0*X/XN)
+ ELSE
+C
+ ENVJ=0.5D0*DLOG10(6.28D0*N)-N*DLOG10(1.36D0*X/N)
+C
+ ENDIF
+C
+ RETURN
+ END
+ SUBROUTINE RNF(N,X,NM,SY)
+C
+C FROM SPHJY OF LIBRARY specfun
+C
+C
+C ======================================================
+C Purpose: Compute spherical Bessel functions y
+C Input : X --- Argument of y ( X > 0 )
+C N --- Order of y ( N = 0,1,2,... )
+C Output: SY(N+1) --- y
+C NM --- Highest order computed
+C ======================================================
+C
+ IMPLICIT REAL*8 (A-H,O-Z)
+ DIMENSION SY(N+1)
+ IF(X.LT.1.0D-60)THEN
+ DO K=1,N+1
+ SY(K)=-1.0D+300
+ ENDDO
+ RETURN
+ ENDIF
+ SY(1)=-DCOS(X)/X
+ IF(N.EQ.0)RETURN
+ SY(2)=(SY(1)-DSIN(X))/X
+ IF(N.EQ.1)RETURN
+ F0=SY(1)
+ F1=SY(2)
+ DO K=2,N
+ F=(2.0D0*K-1.0D0)*F1/X-F0
+ SY(K+1)=F
+ IF(DABS(F).GE.1.0D+300)GO TO 20
+ F0=F1
+ F1=F
+ ENDDO
+ RETURN
+ 20 NM=K
+ RETURN
+ END
+ SUBROUTINE POLAR(X,Y,Z,R,CTH,STH,CPH,SPH)
+ IMPLICIT REAL*8(A-H,O-Z)
+ LOGICAL ONX,ONY,ONZ
+ ONE=1.0D0
+ C0=0.0D0
+ ONX=Y.EQ.C0
+ ONY=X.EQ.C0
+ ONZ=ONX.AND.ONY
+ IF(ONZ)GO TO 10
+ IF(ONX)GO TO 15
+ IF(ONY)GO TO 20
+ RHOS=X*X+Y*Y
+ RHO=DSQRT(RHOS)
+ CPH=X/RHO
+ SPH=Y/RHO
+ GO TO 25
+ 10 CPH=ONE
+ SPH=C0
+ GO TO 25
+ 15 RHOS=X*X
+ RHO=DABS(X)
+ CPH=DSIGN(ONE,X)
+ SPH=C0
+ GO TO 25
+ 20 RHOS=Y*Y
+ RHO=DABS(Y)
+ CPH=C0
+ SPH=DSIGN(ONE,Y)
+ 25 IF(Z.NE.C0)GO TO 35
+ IF(ONZ)GO TO 30
+ R=RHO
+ CTH=C0
+ STH=ONE
+ RETURN
+ 30 R=C0
+ CTH=ONE
+ STH=C0
+ RETURN
+ 35 IF(ONZ)GO TO 40
+ R=DSQRT(RHOS+Z*Z)
+ CTH=Z/R
+ STH=RHO/R
+ RETURN
+ 40 R=DABS(Z)
+ CTH=DSIGN(ONE,Z)
+ STH=C0
+ RETURN
+ END
+ SUBROUTINE SPHAR(COSRTH,SINRTH,COSRPH,SINRPH,LL,YLM)
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC DIMENSION SINRMP(LL),COSRMP(LL),PLEGN((LLPO*LL)/2+LLPO),
+CCC 1YLM(LLPO*LLPO)
+CCC LL=MAX0(LIT,LMT)
+ DIMENSION SINRMP(46),COSRMP(46),PLEGN(1128),YLM(2209)
+ COMPLEX*16 YLM
+ PI4=DACOS(0.0D0)*8.0D0
+ PI4IRS=1.0D0/DSQRT(PI4)
+ X=COSRTH
+ Y=DABS(SINRTH)
+ CLLMO=3.0D0
+ CLL=1.5D0
+ YTOL=Y
+ PLEGN(1)=1.0D0
+ PLEGN(2)=X*DSQRT(CLLMO)
+ PLEGN(3)=YTOL*DSQRT(CLL)
+ SINRMP(1)=SINRPH
+ COSRMP(1)=COSRPH
+ IF(LL.LT.2)GO TO 30
+ K=3
+ DO 20 L=2,LL
+ LMO=L-1
+ LTPO=L+L+1
+ LTMO=LTPO-2
+ LTS=LTPO*LTMO
+ CN=LTS
+ DO 10 MPO=1,LMO
+ M=MPO-1
+ MPOPK=MPO+K
+ LS=(L+M)*(L-M)
+ CD=LS
+ CNM=LTPO*(LMO+M)*(L-MPO)
+ CDM=(LTMO-2)*LS
+ 10 PLEGN(MPOPK)=PLEGN(MPOPK-L)*X*DSQRT(CN/CD)-
+ 1PLEGN(MPOPK-LTMO)*DSQRT(CNM/CDM)
+ LPK=L+K
+ CLTPO=LTPO
+ PLEGN(LPK)=PLEGN(K)*X*DSQRT(CLTPO)
+ K=LPK+1
+ CLT=LTPO-1
+ CLL=CLL*(CLTPO/CLT)
+ YTOL=YTOL*Y
+ PLEGN(K)=YTOL*DSQRT(CLL)
+ SINRMP(L)=SINRPH*COSRMP(LMO)+COSRPH*SINRMP(LMO)
+ 20 COSRMP(L)=COSRPH*COSRMP(LMO)-SINRPH*SINRMP(LMO)
+ 30 L=0
+ 40 M=0
+ K=L*(L+1)
+ L0Y=K+1
+ L0P=K/2+1
+ YLM(L0Y)=PI4IRS*PLEGN(L0P)
+ GO TO 45
+ 44 LMP=L0P+M
+ SAVE=PI4IRS*PLEGN(LMP)
+ LMY=L0Y+M
+ YLM(LMY)=SAVE*DCMPLX(COSRMP(M),SINRMP(M))
+ IF(MOD(M,2).NE.0)YLM(LMY)=-YLM(LMY)
+ LMY=L0Y-M
+ YLM(LMY)=SAVE*DCMPLX(COSRMP(M),-SINRMP(M))
+ 45 IF(M.GE.L)GO TO 47
+ M=M+1
+ GO TO 44
+ 47 IF(L.GE.LL) RETURN
+ L=L+1
+ GO TO 40
+ END
+ SUBROUTINE LUCIN(AM,NDDMST,N,IER)
+C
+C NDDMST FIRST DIMENSION OF AM AS DECLARED IN DIMENSION
+C STATEMENT.
+C N NUMBER OF ROWS IN AM.
+C IER IS REPLACED BY 1 FOR SINGULARITY.
+C
+C
+C CALLS COMPLEX INNER PRODUCT FUNCTION CDTP.
+C
+ IMPLICIT REAL*8 (A-H,O-Z)
+CCC DIMENSION AM(NDDMST,NDDMST),V(NDDMST)
+ DIMENSION AM(9200,9200),V(9200)
+ COMPLEX*16 AM
+ COMPLEX*16 CTEMP,CDTP
+ IER=0
+ NMINUS=N-1
+C
+C 1.2 DEAL WITH THE SPECIAL CASE N=1.
+C
+C1200 IF(N.NE.1)GO TO 1300
+C CTEMP=AM(1,1)
+C IF(CTEMP.EQ.(0.0D0,0.0D0))GO TO 5200
+C AM(1,1)=1.0D0/CTEMP
+C RETURN
+C
+C 1.3 SET V(I)=1/R(I)**2, WHERE R(I) IS THE LENGTH OF ROW I.
+C
+C1300 DO 1309 I=1,N
+ DO 1309 I=1,N
+ SUM=0.0D0
+ DO 1319 J=1,N
+ SUM=SUM+DREAL(AM(I,J))**2+DIMAG(AM(I,J))**2
+ 1319 CONTINUE
+ V(I)=1.0D0/SUM
+ 1309 CONTINUE
+C
+C 2. REPLACE AM BY TRIANGULAR MATRICES (L,U) WHERE AM=L*U.
+C REPLACE L(I,I) BY 1/L(I,I), READY FOR SECTION 4.
+C (ROW INTERCHANGES TAKE PLACE, AND THE INDICES OF THE PIVOTAL ROWS
+C ARE PLACED IN V.)
+C
+ DO 2019 K=1,N
+ KPLUS=K+1
+ KMINUS=K-1
+ L=K
+ PSQMAX=0.0D0
+ DO 2029 I=K,N
+ CTEMP=-CDTP(-AM(I,K),AM,I,1,K,KMINUS,NDDMST)
+ AM(I,K)=CTEMP
+ PSQ=V(I)*(DREAL(CTEMP)**2+DIMAG(CTEMP)**2)
+ IF(PSQ.LE.PSQMAX)GO TO 2029
+ PSQMAX=PSQ
+ L=I
+ 2029 CONTINUE
+ IF(L.EQ.K)GO TO 2011
+ DO 2049 J=1,N
+ CTEMP=AM(K,J)
+ AM(K,J)=AM(L,J)
+ AM(L,J)=CTEMP
+ 2049 CONTINUE
+ V(L)=V(K)
+ 2011 V(K)=L
+ IF(PSQMAX.EQ.0.0D0)GO TO 5200
+ CTEMP=1.0D0/AM(K,K)
+ AM(K,K)=CTEMP
+ IF(KPLUS.GT.N)GO TO 2019
+ DO 2059 J=KPLUS,N
+ AM(K,J)=-CTEMP*CDTP(-AM(K,J),AM,K,1,J,KMINUS,NDDMST)
+ 2059 CONTINUE
+ 2019 CONTINUE
+C
+C 4. REPLACE AM BY ITS INVERSE AMINV.
+C
+C
+C 4.1 REPLACE L AND U BY THEIR INVERSES LINV AND UINV.
+C
+ DO 4109 K=1,NMINUS
+ KPLUS=K+1
+ DO 4119 I=KPLUS,N
+ AM(I,K)=-AM(I,I)*CDTP((0.0D0,0.0D0),AM,I,K,K,I-K,
+ 1NDDMST)
+ AM(K,I)=-CDTP(AM(K,I),AM,K,KPLUS,I,I-K-1,NDDMST)
+ 4119 CONTINUE
+ 4109 CONTINUE
+C
+C 4.2 FORM AMINV=UINV*LINV.
+C
+ DO 4209 K=1,N
+ DO 4219 I=1,N
+ IF(I.GE.K)GO TO 4212
+ AM(I,K)=CDTP((0.0D0,0.0D0),AM,I,K,K,N-K+1,NDDMST)
+ GO TO 4219
+ 4212 AM(I,K)=CDTP(AM(I,K),AM,I,I+1,K,N-I,NDDMST)
+ 4219 CONTINUE
+ 4209 CONTINUE
+C
+C 4.3 INTERCHANGE COLUMNS OF AMINV AS SPECIFIED BY V, BUT IN REVERSE
+C ORDER.
+C
+ DO 4309 L=1,N
+ K=N-L+1
+ KCOL=IDINT(V(K))
+ IF(KCOL.EQ.K)GO TO 4309
+ DO 4319 I=1,N
+ CTEMP=AM(I,K)
+ AM(I,K)=AM(I,KCOL)
+ AM(I,KCOL)=CTEMP
+ 4319 CONTINUE
+ 4309 CONTINUE
+ RETURN
+ 5200 IER=1
+ RETURN
+ END
+ COMPLEX*16 FUNCTION CDTP(Z,AV,I,JF,K,NJ,ISTEP)
+CCC DIMENSION AV(NDDMST*NDDMST)
+ DIMENSION AV(84640000)
+ COMPLEX*16 AV,Z
+ CDTP=Z
+ IF(NJ.LE.0) RETURN
+ JL=JF+NJ-1
+ IR=(K-1)*ISTEP
+ DO 3 J=JF,JL
+ 3 CDTP=CDTP+AV((J-1)*ISTEP+I)*AV(J+IR)
+ RETURN
+ END
+CCC
\ No newline at end of file
diff --git a/test_data/cluster/case_3/edfb300.f b/test_data/cluster/case_3/edfb300.f
new file mode 100644
index 0000000000000000000000000000000000000000..07240d9b1e92f264351243cfa10f7039571f74ef
--- /dev/null
+++ b/test_data/cluster/case_3/edfb300.f
@@ -0,0 +1,330 @@
+ PROGRAM EDFB
+CCC 100930,110228
+CCC IES=1 FOR SURROUNDING EXTERNAL SPHERE CENTERED AT ORIGIN;
+CCC HOMOGENEOUS MATERIAL WITHIN THE EXT. SPHERE IS READ IN
+CCC AS THAT OF THE (NSHL+1)-TH LAYER OF THE 1-ST SPHERE:
+CCC RCF(1,NSHL)=1.0D0, RCF(1,NSHL+1)>1.0D0 AND
+CCC ROS(1) IS RADIUS OF SPHERE 1
+CCC
+CCC READ DATA FOR BUILDING VECTOR XIV FROM WITHIN SUB INXI
+CCC
+CCC IDFC>0 WHEN ALL DIEL. FUNCT. OF SPHERES ARE CONSTANTS;
+CCC IDFC=0 WHEN DIEL. FUNCT. OF SPHERES DEPEND ON XI;
+CCC IDFC<0 WHEN DIEL. FUNCT. OF SPHERES ARE AT XIP VALUE ONLY AND
+CCC XI IS SCALE FACTOR FOR DIMENSIONS
+CCC INSN CHOOSES THE VARIABLE THE DIEL. FUNCT. DEPEND ON:
+CCC (INSN=1)=XI;
+CCC (INSN=2)=WN (THE WAVENUMBER, IN m**-1);
+CCC (INSN=3)=WL (THE WAVELENGTH, IN m);
+CCC (INSN=4)=PU (THE ANGULAR FREQUENCY, IN s**-1);
+CCC (INSN=5)=EV (THE PHOTON ENERGY, IN ev);
+CCC INSTPC>0 WHEN IN CASE IDFC>=0
+CCC VARIABLE INCREASES WITH A CONSTANT STEP;
+CCC INSTPC=0 WHEN IN CASE IDFC>=0
+CCC VALUES OF VARIABLE ARE SAVED IN A VECTOR YOU READ BEFORE
+CCC SUPPORTS EXPERIMENTAL DIELECTRIC FUNCTIONS ONLY
+CCC NSPH=300
+ IMPLICIT REAL*8(A-H,O-Z)
+CCC COMMON/C1/DC0(NSHL-NTL+1),DC0M(NSHL-NTL+1,NSPH,NXI),
+CCC 1ROS(NSPH),RCF(NSPH,NSHL+1),IOG(NSPH),NSHL(NSPH)
+ COMMON/C1/DC0(5),DC0M(5,300,2000),
+ 1ROS(300),RCF(300,9),IOG(300),NSHL(300)
+ COMPLEX*16 DC0,DC0M
+CCC COMMON/C3/XIV(NXI),WNS(NXI),WLS(NXI),PUS(NXI),EVS(NXI),
+CCC 1VSS(NXI),VNS(5)
+ COMMON/C3/XIV(2000),WNS(2000),WLS(2000),PUS(2000),EVS(2000),
+ 1VSS(2000),VNS(5)
+ CHARACTER*3 VNS
+ 5010 FORMAT(16I5)
+ 6005 FORMAT(' SPHERE N.',I4)
+ 6009 FORMAT(' NONTRANSITION LAYER N.',I2,', SCALE = ',A3)
+ 6010 FORMAT(I5,1X,1PD12.4,1PD12.4)
+ IR=5
+ IW=6
+ IT=7
+CCC
+CCC SIZE(I)=VK*ROS(I) IS SIZE PARAMETER in vacuo
+CCC
+CCC
+CCC READING OF DIELECTRIC FUNCTIONS DRIVEN BY ICI DEFINED BELOW
+CCC
+ OPEN(IR,FILE='DEDFB',STATUS='OLD')
+ READ(IR,*)NSPH,IES
+ IF(IES.NE.0)IES=1
+ READ(IR,*)EXDC,WP,XIP,IDFC,NXI,INSTPC,INSN
+ OPEN(IW,FILE='OEDFB',STATUS='UNKNOWN')
+ CALL INXI(IR,IW,WP,XIP,IDFC,NXI,INSTPC,INSN)
+ READ(IR,5010)(IOG(I),I=1,NSPH)
+ DO 113 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 113
+ READ(IR,*)NSHL(I),ROS(I)
+ NSH=NSHL(I)
+ IF(I.EQ.1)NSH=NSH+IES
+ DO 112 NS=1,NSH
+ 112 READ(IR,*)RCF(I,NS)
+ 113 CONTINUE
+ OPEN(IT,FILE='TEDF',FORM='UNFORMATTED',STATUS='UNKNOWN')
+ WRITE(IT)NSPH
+ WRITE(IT)(IOG(I),I=1,NSPH)
+ WRITE(IT)EXDC,WP,XIP,IDFC,NXI
+ WRITE(IT)(XIV(I),I=1,NXI)
+ DO 115 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 115
+ WRITE(IT)NSHL(I),ROS(I)
+ NSH=NSHL(I)
+ IF(I.EQ.1)NSH=NSH+IES
+ WRITE(IT)(RCF(I,NS),NS=1,NSH)
+ 115 CONTINUE
+ DO 468 JXI=1,NXI
+ IF((IDFC.NE.0).AND.(JXI.GT.1))GO TO 468
+ DO 162 I=1,NSPH
+ IF(IOG(I).LT.I)GO TO 162
+CCC
+ NSH=NSHL(I)
+ ICI=(NSH+1)/2
+ IF(I.EQ.1)ICI=ICI+IES
+ DO 157 IC=1,ICI
+ READ(IR,*)DC0(IC)
+ 157 DC0M(IC,I,JXI)=DC0(IC)
+CCC
+ WRITE(IT)(DC0(IC),IC=1,ICI)
+ 162 CONTINUE
+ 468 CONTINUE
+ IF(IDFC.EQ.0)GO TO 474
+ WRITE(IW,*)' DIELECTRIC CONSTANTS'
+ DO 473 I=1,NSPH
+ IF(IOG(I).NE.I)GO TO 473
+ ICI=(NSHL(I)+1)/2
+ IF(I.EQ.1)ICI=ICI+IES
+ WRITE(IW,6005)I
+ DO 472 IC=1,ICI
+ WRITE(IW,6010)IC,DC0M(IC,I,1)
+ 472 CONTINUE
+ 473 CONTINUE
+ GO TO 499
+ 474 WRITE(IW,*)' DIELECTRIC FUNCTIONS'
+ DO 478 I=1,NSPH
+ IF(IOG(I).NE.I)GO TO 478
+ ICI=(NSHL(I)+1)/2
+ IF(I.EQ.1)ICI=ICI+IES
+ WRITE(IW,6005)I
+ DO 477 IC=1,ICI
+ WRITE(IW,6009)IC,VNS(INSN)
+ DO 476 JXI=1,NXI
+ WRITE(IW,6010)JXI,DC0M(IC,I,JXI)
+ 476 CONTINUE
+ 477 CONTINUE
+ 478 CONTINUE
+ 499 CLOSE(IR)
+ CLOSE(IW)
+ CLOSE(IT)
+ STOP
+ END
+ SUBROUTINE INXI(IR,IW,WP,XIP,IDFC,NXI,INSTPC,INSN)
+ IMPLICIT REAL*8(A-H,O-Z)
+ COMMON/C3/XIV(2000),WNS(2000),WLS(2000),PUS(2000),EVS(2000),
+ 1VSS(2000),VNS(5)
+ CHARACTER*3 VNS
+ PIGT=DACOS(0.0D0)*4.0D0
+ EVC=6.5821188D-16
+ IF(IDFC.LT.0)GO TO 300
+ IF(INSTPC.EQ.0)GO TO 200
+CCC VLST=V+(NXI-1)*VSTP
+ GO TO(105,125,145,165,185),INSN
+ RETURN
+ 105 READ(IR,*)XI,XISTP
+ DO 110 JXI=1,NXI
+ PU=XI*WP
+ WN=PU/3.0D08
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 110 XI=XI+XISTP
+ WRITE(IW,6601)
+ 6601 FORMAT
+ 1(2X,'JXI',5X,'XIV',10X,'WNS',10X,'WLS',10X,'PUS',10X,'EVS')
+ WRITE(IW,6600)
+ 1(JXI,XIV(JXI),WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),JXI=1,NXI)
+ 6600 FORMAT((I5,5(1PD13.4)))
+ RETURN
+ 125 READ(IR,*)WN,WNSTP
+ DO 130 JXI=1,NXI
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WNS'
+ VSS(JXI)=WN
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 130 WN=WN+WNSTP
+ WRITE(IW,6602)
+ 6602 FORMAT
+ 1(2X,'JXI',5X,'WNS',10X,'WLS',10X,'PUS',10X,'EVS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 145 READ(IR,*)WL,WLSTP
+ DO 150 JXI=1,NXI
+ WN=PIGT/WL
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WLS'
+ VSS(JXI)=WL
+ WLS(JXI)=WL
+ WNS(JXI)=WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 150 WL=WL+WLSTP
+ WRITE(IW,6603)
+ 6603 FORMAT
+ 1(2X,'JXI',5X,'WLS',10X,'WNS',10X,'PUS',10X,'EVS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,WLS(JXI),WNS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 165 READ(IR,*)PU,PUSTP
+ DO 170 JXI=1,NXI
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='PUS'
+ VSS(JXI)=PU
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ EVS(JXI)=PU*EVC
+ 170 PU=PU+PUSTP
+ WRITE(IW,6604)
+ 6604 FORMAT
+ 1(2X,'JXI',5X,'PUS',10X,'WNS',10X,'WLS',10X,'EVS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,PUS(JXI),WNS(JXI),WLS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 185 READ(IR,*)EV,EVSTP
+ DO 190 JXI=1,NXI
+ PU=EV/EVC
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='EVS'
+ VSS(JXI)=EV
+ EVS(JXI)=EV
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 190 EV=EV+EVSTP
+ WRITE(IW,6605)
+ 6605 FORMAT
+ 1(2X,'JXI',5X,'EVS',10X,'WNS',10X,'WLS',10X,'PUS',10X,'XIV')
+ WRITE(IW,6600)
+ 1(JXI,EVS(JXI),WNS(JXI),WLS(JXI),PUS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 200 GO TO(205,225,245,265,285),INSN
+ RETURN
+ 205 DO 210 JXI=1,NXI
+ READ(IR,*)XI
+ PU=XI*WP
+ WN=PU/3.0D08
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 210 CONTINUE
+ WRITE(IW,6601)
+ WRITE(IW,6600)
+ 1(JXI,XIV(JXI),WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),JXI=1,NXI)
+ RETURN
+ 225 DO 230 JXI=1,NXI
+ READ(IR,*)WN
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WNS'
+ VSS(JXI)=WN
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 230 CONTINUE
+ WRITE(IW,6602)
+ WRITE(IW,6600)
+ 1(JXI,WNS(JXI),WLS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 245 DO 250 JXI=1,NXI
+ READ(IR,*)WL
+ WN=PIGT/WL
+ XI=3.0D08*WN/WP
+ PU=XI*WP
+ VNS(INSN)='WLS'
+ VSS(JXI)=WL
+ WLS(JXI)=WL
+ WNS(JXI)=WN
+ XIV(JXI)=XI
+ PUS(JXI)=PU
+ EVS(JXI)=PU*EVC
+ 250 CONTINUE
+ WRITE(IW,6603)
+ WRITE(IW,6600)
+ 1(JXI,WLS(JXI),WNS(JXI),PUS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 265 DO 270 JXI=1,NXI
+ READ(IR,*)PU
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='PUS'
+ VSS(JXI)=PU
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ EVS(JXI)=PU*EVC
+ 270 CONTINUE
+ WRITE(IW,6604)
+ WRITE(IW,6600)
+ 1(JXI,PUS(JXI),WNS(JXI),WLS(JXI),EVS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 285 DO 290 JXI=1,NXI
+ READ(IR,*)EV
+ PU=EV/EVC
+ XI=PU/WP
+ WN=PU/3.0D08
+ VNS(INSN)='EVS'
+ VSS(JXI)=EV
+ EVS(JXI)=EV
+ PUS(JXI)=PU
+ XIV(JXI)=XI
+ WNS(JXI)=WN
+ WLS(JXI)=PIGT/WN
+ 290 CONTINUE
+ WRITE(IW,6605)
+ WRITE(IW,6600)
+ 1(JXI,EVS(JXI),WNS(JXI),WLS(JXI),PUS(JXI),XIV(JXI),JXI=1,NXI)
+ RETURN
+ 300 DO 310 JXI=1,NXI
+ READ(IR,*)XI
+ VNS(INSN)='XIV'
+ VSS(JXI)=XI
+ XIV(JXI)=XI
+ 310 CONTINUE
+ PU=XIP*WP
+ WN=PU/3.0D08
+ WRITE(IW,6611)
+ 6611 FORMAT
+ 1(10X,'XIP',10X,'WN ',10X,'WL ',10X,'PU ',10X,'EV')
+ WRITE(IW,6610)XIP,WN,PIGT/WN,PU,PU*EVC
+ 6610 FORMAT((5X,5(1PD13.4)))
+ WRITE(IW,*)' SCALE FACTORS XI'
+ WRITE(IW,6612)(JXI,XIV(JXI),JXI=1,NXI)
+ 6612 FORMAT(I5,1PD13.4)
+ RETURN
+ END
+CCC
\ No newline at end of file