diff --git a/build/README.md b/build/README.md
index 012238bdef1b63172e20b134ee5e1a7d4310f634..7e92ec8813cc8d01db6af4ce94f5dcf9136b39c8 100644
--- a/build/README.md
+++ b/build/README.md
@@ -62,6 +62,6 @@ The default behaviour of `np_sphere` is to take the same input files as `edfb` a
### trapping
-The execution of trapping programs requires at least one of the previous programs to have produced a complete output set.
+The execution of trapping programs requires at least one of the previous programs to have produced a complete output set. The working assumption is that the `frfme` program is a pre-requisite to `lffft`.
*TODO:* Define a common format for binary I/O operations on the TTMS file.
diff --git a/src/cluster/Makefile b/src/cluster/Makefile
index 694bbc0d816dea1e2d4c4039a8967f0f973bd339..37c271251f2eff079354ab9610d1c6e4adc9fcc8 100644
--- a/src/cluster/Makefile
+++ b/src/cluster/Makefile
@@ -1,40 +1,42 @@
BUILDDIR=../../build/cluster
-FC=gfortran
-FCFLAGS=-std=legacy -O3
-LFLAGS=
-LFLAGS=
-CXX=g++
-CXXFLAGS=-O2 -ggdb -pg -coverage
-CXXLFLAGS=
+
+include ../make.inc
+
all: clu edfb np_cluster
clu: clu.o
- $(FC) $(FCFLAGS) -o $(BUILDDIR)/clu $(BUILDDIR)/clu.o $(LFLAGS)
+ $(FC) $(FCFLAGS) -o $(BUILDDIR)/clu $(BUILDDIR)/clu.o $(LDFLAGS)
edfb: edfb.o
- $(FC) $(FCFLAGS) -o $(BUILDDIR)/edfb $(BUILDDIR)/edfb.o $(LFLAGS)
+ $(FC) $(FCFLAGS) -o $(BUILDDIR)/edfb $(BUILDDIR)/edfb.o $(LDFLAGS)
+
+np_cluster: $(BUILDDIR)/np_cluster.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/file_io.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sph_subs.o $(BUILDDIR)/clu_subs.o $(BUILDDIR)/cluster.o
+ $(CXX) $(CXXFLAGS) -o $(BUILDDIR)/np_cluster $(BUILDDIR)/np_cluster.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/file_io.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sph_subs.o $(BUILDDIR)/clu_subs.o $(BUILDDIR)/cluster.o $(CXXLDFLAGS)
-np_cluster: $(BUILDDIR)/np_cluster.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sphere.o $(BUILDDIR)/cluster.o
- $(CXX) $(CXXFLAGS) $(CXXLFLAGS) -o $(BUILDDIR)/np_cluster $(BUILDDIR)/np_cluster.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sphere.o $(BUILDDIR)/cluster.o
+#$(BUILDDIR)/np_cluster.o:
+# $(CXX) $(CXXFLAGS) -c np_cluster.cpp -o $(BUILDDIR)/np_cluster.o
-$(BUILDDIR)/np_cluster.o:
- $(CXX) $(CXXFLAGS) -c np_cluster.cpp -o $(BUILDDIR)/np_cluster.o
+#$(BUILDDIR)/Commons.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/Commons.cpp -o $(BUILDDIR)/Commons.o
-$(BUILDDIR)/Commons.o:
- $(CXX) $(CXXFLAGS) -c ../libnptm/Commons.cpp -o $(BUILDDIR)/Commons.o
+#$(BUILDDIR)/Configuration.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/Configuration.cpp -o $(BUILDDIR)/Configuration.o
-$(BUILDDIR)/Configuration.o:
- $(CXX) $(CXXFLAGS) -c ../libnptm/Configuration.cpp -o $(BUILDDIR)/Configuration.o
+#$(BUILDDIR)/file_io.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/file_io.cpp -o $(BUILDDIR)/file_io.o
-$(BUILDDIR)/Parsers.o:
- $(CXX) $(CXXFLAGS) -c ../libnptm/Parsers.cpp -o $(BUILDDIR)/Parsers.o
+#$(BUILDDIR)/Parsers.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/Parsers.cpp -o $(BUILDDIR)/Parsers.o
-$(BUILDDIR)/cluster.o:
- $(CXX) $(CXXFLAGS) -c cluster.cpp -o $(BUILDDIR)/cluster.o
+#$(BUILDDIR)/cluster.o:
+# $(CXX) $(CXXFLAGS) -c cluster.cpp -o $(BUILDDIR)/cluster.o
-$(BUILDDIR)/sphere.o:
- $(CXX) $(CXXFLAGS) -c ../sphere/sphere.cpp -o $(BUILDDIR)/sphere.o
+#$(BUILDDIR)/clu_subs.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/clu_subs.cpp -o $(BUILDDIR)/clu_subs.o
+
+#$(BUILDDIR)/sph_subs.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/sph_subs.cpp -o $(BUILDDIR)/sph_subs.o
clean:
rm -f $(BUILDDIR)/*.o
@@ -42,6 +44,3 @@ clean:
wipe:
rm -f $(BUILDDIR)/clu $(BUILDDIR)/edfb $(BUILDDIR)/*.o
-%.o : %.f
- $(FC) $(FCFLAGS) -c -o $(BUILDDIR)/$@ $<
-
diff --git a/src/cluster/cluster.cpp b/src/cluster/cluster.cpp
index ba2c38a4d3d01f47dadc5656ddc230db74729fc4..92646598166084a8288f6343e7d76f94774a19bb 100644
--- a/src/cluster/cluster.cpp
+++ b/src/cluster/cluster.cpp
@@ -1,21 +1,29 @@
+/*! \file cluster.cpp
+ */
#include <cstdio>
+#include <complex>
+#include <exception>
#include <fstream>
#include <string>
-#include <complex>
+
#ifndef INCLUDE_CONFIGURATION_H_
#include "../include/Configuration.h"
#endif
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
+#ifndef INCLUDE_SPH_SUBS_H_
+#include "../include/sph_subs.h"
+#endif
+
#ifndef INCLUDE_CLU_SUBS_H_
#include "../include/clu_subs.h"
#endif
using namespace std;
-/*
- * >>> WARNING: works only for IDFC >= 0, as the original code <<<
- *
- */
-
/*! \brief C++ implementation of CLU
*
* \param config_file: `string` Name of the configuration file.
@@ -34,6 +42,7 @@ void cluster(string config_file, string data_file, string output_path) {
}
sconf->write_formatted(output_path + "/c_OEDFB");
sconf->write_binary(output_path + "/c_TEDF");
+ sconf->write_binary(output_path + "/c_TEDF.hd5", "HDF5");
GeometryConfiguration *gconf = NULL;
try {
gconf = GeometryConfiguration::from_legacy(data_file);
@@ -107,7 +116,7 @@ void cluster(string config_file, string data_file, string output_path) {
}
C2 *c2 = new C2(nsph, max_ici, npnt, npntts);
complex<double> **am = new complex<double>*[mxndm];
- for (int ai = 0; ai < mxndm; ai++) am[ai] = new complex<double>[mxndm];
+ for (int ai = 0; ai < mxndm; ai++) am[ai] = new complex<double>[mxndm]();
const int ndi = c4->nsph * c4->nlim;
C9 *c9 = new C9(ndi, c4->nlem, 2 * ndi, 2 * c4->nlem);
double *gaps = new double[nsph]();
@@ -313,17 +322,9 @@ void cluster(string config_file, string data_file, string output_path) {
}
if (jer != 0) break;
} // i132 loop
- //printf("INFO: initializing matrix...");
cms(am, c1, c1ao, c4, c6);
- //printf(" done.\n");
- //ccsam = summat(am, 960, 960);
- //printf("DEBUG: after CMS CCSAM = (%lE,%lE)\n", ccsam.real(), ccsam.imag());
int ndit = 2 * nsph * c4->nlim;
- //printf("INFO: inverting matrix...");
lucin(am, mxndm, ndit, jer);
- //printf(" done.\n");
- //ccsam = summat(am, 960, 960);
- //printf("DEBUG: after LUCIN CCSAM = (%lE,%lE)\n", ccsam.real(), ccsam.imag());
if (jer != 0) break; // jxi488 loop: goes to memory clean
ztm(am, c1, c1ao, c4, c6, c9);
if (sconf->idfc >= 0) {
diff --git a/src/cluster/np_cluster.cpp b/src/cluster/np_cluster.cpp
index e9a85e79d16d82e359654456a5d0345396c08fa0..0af2b80f8bd8c3514084f30dc77b6fa38c49e909 100644
--- a/src/cluster/np_cluster.cpp
+++ b/src/cluster/np_cluster.cpp
@@ -2,7 +2,9 @@
*/
#include <cstdio>
+#include <complex>
#include <string>
+
#ifndef INCLUDE_CONFIGURATION_H_
#include "../include/Configuration.h"
#endif
diff --git a/src/include/Commons.h b/src/include/Commons.h
index 7a45deafdbc46ab08d11b59443d241d4bd19f22b..6ad2a0110e6eb4ebae592402e9df43e9cb182687 100644
--- a/src/include/Commons.h
+++ b/src/include/Commons.h
@@ -14,10 +14,8 @@
*
*/
-#ifndef INCLUDE_COMMONS_
-#define INCLUDE_COMMONS_
-
-#include <complex>
+#ifndef INCLUDE_COMMONS_H_
+#define INCLUDE_COMMONS_H_
/*! \brief Representation of the FORTRAN C1 common blocks.
*
diff --git a/src/include/Configuration.h b/src/include/Configuration.h
index c23ac6924cf3595fef13f4e72f76c5e85aaddd87..1050a61acaed2d6bf4754df2eeada5fe0ba68a36 100644
--- a/src/include/Configuration.h
+++ b/src/include/Configuration.h
@@ -4,10 +4,6 @@
#ifndef INCLUDE_CONFIGURATION_H_
#define INCLUDE_CONFIGURATION_H_
-#include <complex>
-#include <exception>
-#include <string>
-
/**
* \brief Exception for open file error handlers.
*/
@@ -222,6 +218,51 @@ protected:
//! \brief Flag to control whether to add an external layer.
bool use_external_sphere;
+ /*! \brief Build configuration from a HDF5 binary input file.
+ *
+ * This is the function called by the public method `from_binary()` in case of
+ * HDF5 mode selection. This function creates a configuration structure from
+ * a binary file written according to the HDF5 format standard.
+ *
+ * \param file_name: `string` Name of the binary configuration data file.
+ * \return config: `ScattererConfiguration*` Pointer to object containing the
+ * scatterer configuration data.
+ */
+ static ScattererConfiguration *from_hdf5(std::string file_name);
+
+ /*! \brief Build configuration from legacy binary input file.
+ *
+ * This is the function called by the public method `from_binary()` in case of
+ * legacy mode selection. This function creates a configuration structure from
+ * a binary file written according to the proprietary mode used by the original
+ * FORTRAN code.
+ *
+ * \param file_name: `string` Name of the binary configuration data file.
+ * \return config: `ScattererConfiguration*` Pointer to object containing the
+ * scatterer configuration data.
+ */
+ static ScattererConfiguration *from_legacy(std::string file_name);
+
+ /*! \brief Write the scatterer configuration data to HDF5 binary output.
+ *
+ * This function is invoked by the public method `write_binary()` with the
+ * "HDF5" format mode. It undertakes the task of writing the configuration
+ * information to a binary file using the standard HDF5 format.
+ *
+ * \param file_name: `string` Name of the binary configuration data file.
+ */
+ void write_hdf5(std::string file_name);
+
+ /*! \brief Write the scatterer configuration data to legacy binary output.
+ *
+ * This function is invoked by the public method `write_binary()` with the
+ * "LEGACY" format mode. It undertakes the task of writing the configuration
+ * information to a binary file using a proprietary format, as it was done
+ * originally in the FORTRAN code.
+ *
+ * \param file_name: `string` Name of the binary configuration data file.
+ */
+ void write_legacy(std::string file_name);
public:
/*! \brief Build a scatterer configuration structure.
*
@@ -310,14 +351,13 @@ public:
* be useful to save the configuration data. `ScattererConfiguration.write_binary()`
* performs the operation of saving the configuration in binary format. This function
* can work in legacy mode, to write backward compatible configuration files, as well
- * as by wrapping the data into common scientific formats (NB: this last option still
- * needs to be implemented).
+ * as by wrapping the data into common scientific formats.
*
* \param file_name: `string` Name of the file to be written.
- * \param mode: `string` Binary encoding. Can be one of "LEGACY", ... . Optional
+ * \param mode: `string` Binary encoding. Can be one of ["LEGACY", "HDF5"] . Optional
* (default is "LEGACY").
*/
- void write_binary(std::string file_name, std::string mode = "LEGACY");
+ void write_binary(std::string file_name, std::string mode="LEGACY");
/*! \brief Write the scatterer configuration data to formatted text output.
*
diff --git a/src/include/List.h b/src/include/List.h
index c0f859922f6238be2b193074b1c82b15046e5973..0f9ebeab42e3e2e52d434e854420d061cd0c1d3a 100644
--- a/src/include/List.h
+++ b/src/include/List.h
@@ -4,47 +4,34 @@
#ifndef INCLUDE_LIST_H_
#define INCLUDE_LIST_H_
-#include <exception>
-#include <string>
-
/**
* \brief Exception for out of bounds List requests.
*/
class ListOutOfBoundsException: public std::exception {
protected:
- //! \brief Minimum index defined in the List.
- int min_index;
- //! \brief Maximum index defined in the List.
- int max_index;
- //! \brief List index requested by user.
- int requested_index;
+ //! Description of the problem.
+ std::string message;
public:
- /**
- * \brief Exception instance constructor.
- *
- * \param requested: `int` The index that was requested.
- * \param min: `int` The minimum index allowed by the list.
- * \param max: `int` The maximum index allowed by the list.
- */
- ListOutOfBoundsException(int requested, int min, int max) {
- min_index = min;
- max_index = max;
- requested_index = requested;
- }
- /**
- * \brief Exception message.
- */
- virtual const char* what() const throw() {
- std::string message = "Error: requested index ";
- message += requested_index;
- message += " is out of range [";
- message += min_index;
- message += ", ";
- message += (max_index - 1);
- message += "]";
- return message.c_str();
- }
+ /**
+ * \brief Exception instance constructor.
+ *
+ * \param requested: `int` The index that was requested.
+ * \param min: `int` The minimum index allowed by the list.
+ * \param max: `int` The maximum index allowed by the list.
+ */
+ ListOutOfBoundsException(int requested, int min, int max) {
+ message = "Error: requested index " + std::to_string(requested)
+ + " out of list allowed bounds [" + std::to_string(min) + ", "
+ + std::to_string(max - 1) + "]";
+ }
+
+ /**
+ * \brief Exception message.
+ */
+ virtual const char* what() const throw() {
+ return message.c_str();
+ }
};
/**
@@ -62,7 +49,7 @@ public:
* a contiguous array of type T[SIZE] that can be used for indexed access.
*/
template<class T> class List {
- protected:
+protected:
int size; //!< Size of the List.
struct element {
T value; //!< Value of the list element.
@@ -72,7 +59,7 @@ template<class T> class List {
*first, //!< Pointer to the first element in the List.
*last; //!< Pointer to the last element in the List.
- public:
+public:
/*! \brief List constructor.
*
* Use the constructor `List<T>([int length])` to create a new list with a given
@@ -176,7 +163,7 @@ template<class T> class List {
*/
void set(int index, T value) {
if (index < 0 || index > size - 1) {
- throw ListOutOfBoundsException(index, 0, size - 1);
+ throw ListOutOfBoundsException(index, 0, size - 1);
}
current = last;
for (int i = size - 1; i > index; i--) current = current->p_prev;
diff --git a/src/include/Parsers.h b/src/include/Parsers.h
index a4523de6d03c78d8efe2467e5e37b067ddcbe1e3..94dd68e891b175c7263ca45585625e96122e0bf1 100644
--- a/src/include/Parsers.h
+++ b/src/include/Parsers.h
@@ -1,14 +1,14 @@
/*! \file Parsers.h
*/
-#ifndef INCLUDE_PARSERS_H_
-#define INCLUDE_PARSERS_H_
-
#ifndef FILE_NOT_FOUND_ERROR
//! Error code if a file is not found.
#define FILE_NOT_FOUND_ERROR 21
#endif
+#ifndef INCLUDE_PARSERS_H_
+#define INCLUDE_PARSERS_H_
+
/*! \brief Load a text file as a sequence of strings in memory.
*
* The configuration of the field expansion code in FORTRAN uses
diff --git a/src/include/clu_subs.h b/src/include/clu_subs.h
index 9e13b5267940c34b75059b578a497f93372b9408..9bc2f72a9c50808d78d9f035fac89cf22446f217 100644
--- a/src/include/clu_subs.h
+++ b/src/include/clu_subs.h
@@ -2,62 +2,48 @@
*
* \brief C++ porting of CLU functions and subroutines.
*
- * Remember that FORTRAN passes arguments by reference, so, every time we use
- * a subroutine call, we need to add a referencing layer to the C++ variable.
- * All the functions defined below need to be properly documented and ported
- * to C++.
- *
- * Currently, only basic documenting information about functions and parameter
- * types are given, to avoid doxygen warning messages.
+ * This library includes a collection of functions that are used to solve the
+ * scattering problem in the case of a cluster of spheres. The functions that
+ * were generalized from the case of the single sphere are imported the `sph_subs.h`
+ * library. As it occurs with the single sphere case functions, in most cases, the
+ * results of calculations do not fall back to fundamental data types. They are
+ * rather multi-component structures. In order to manage access to such variety
+ * of return values, most functions are declared as `void` and they operate on
+ * output arguments passed by reference.
*/
-#ifndef INCLUDE_COMMONS_H_
-#include "Commons.h"
-#endif
-
#ifndef INCLUDE_CLU_SUBS_H_
#define INCLUDE_CLU_SUBS_H_
-#include <complex>
+/*! \brief C++ porting of APC
+ *
+ * \param zpv: `double ****`
+ * \param le: `int`
+ * \param am0m: Matrix of complex.
+ * \param w: Matrix of complex.
+ * \param sqk: `double`
+ * \param gapr: `double **`
+ * \param gapp: Matrix of complex.
+ */
+void apc(
+ double ****zpv, int le, std::complex<double> **am0m, std::complex<double> **w,
+ double sqk, double **gapr, std::complex<double> **gapp
+);
-// >>> DECLARATION OF SPH_SUBS <<<
-extern void aps(double ****zpv, int li, int nsph, C1 *c1, double sqk, double *gaps);
-extern std::complex<double> dconjg(std::complex<double> value);
-extern double cg1(int lmpml, int mu, int l, int m);
-extern void dme(
- int li, int i, int npnt, int npntts, double vk, double exdc, double exri,
- C1 *c1, C2 *c2, int &jer, int &lcalc, std::complex<double> &arg
- );
-extern void rabas(
- int inpol, int li, int nsph, C1 *c1, double **tqse, std::complex<double> **tqspe,
- double **tqss, std::complex<double> **tqsps
- );
-extern void rbf(int n, double x, int &nm, double sj[]);
-extern void rnf(int n, double x, int &nm, double sy[]);
-extern void mmulc(std::complex<double> *vint, double **cmullr, double **cmul);
-extern void sphar(double cth, double sth, double cph, double sph, int lm, std::complex<double> *ylm);
-extern void thdps(int lm, double ****zpv);
-extern void upvmp(
- double thd, double phd, int icspnv, double &cost, double &sint,
- double &cosp, double &sinp, double *u, double *up, double *un
- );
-extern void upvsp(
- double *u, double *upmp, double *unmp, double *us, double *upsmp, double *unsmp,
- double *up, double *un, double *ups, double *uns, double *duk, int &isq,
- int &ibf, double &scand, double &cfmp, double &sfmp, double &cfsp, double &sfsp
- );
-extern void wmamp(
- int iis, double cost, double sint, double cosp, double sinp, int inpol,
- int lm, int idot, int nsph, double *arg, double *u, double *up,
- double *un, C1 *c1
- );
-extern void wmasp(
- double cost, double sint, double cosp, double sinp, double costs, double sints,
- double cosps, double sinps, double *u, double *up, double *un, double *us,
- double *ups, double *uns, int isq, int ibf, int inpol, int lm, int idot,
- int nsph, double *argi, double *args, C1 *c1
- );
-// >>> END OF SPH_SUBS DECLARATION <<<
+/*! \brief C++ porting of APCRA
+ *
+ * \param zpv: `double ****`
+ * \param le: `int`
+ * \param am0m: Matrix of complex.
+ * \param inpol: `int` Polarization type.
+ * \param sqk: `double`
+ * \param gaprm: `double **`
+ * \param gappm: Matrix of complex.
+ */
+void apcra(
+ double ****zpv, const int le, std::complex<double> **am0m, int inpol, double sqk,
+ double **gaprm, std::complex<double> **gappm
+);
/*! \brief C++ porting of CDTP
*
@@ -71,20 +57,7 @@ extern void wmasp(
std::complex<double> cdtp(
std::complex<double> z, std::complex<double> **am, int i, int jf,
int k, int nj
- ) {
- /* NOTE: the original FORTRAN code treats the AM matrix as a
- * vector. This is not directly allowed in C++ and it requires
- * accounting for the different dimensions.
- */
- std::complex<double> result = z;
- if (nj > 0) {
- int jl = jf + nj - 1;
- for (int j = jf; j <= jl; j++) {
- result += (am[i - 1][j - 1] * am[j - 1][k - 1]);
- }
- }
- return result;
-}
+);
/*! \brief C++ porting of CGEV
*
@@ -94,270 +67,28 @@ std::complex<double> cdtp(
* \param m: `int`
* \return result: `double`
*/
-double cgev(int ipamo, int mu, int l, int m) {
- double result = 0.0;
- double xd = 0.0, xn = 0.0;
- if (ipamo == 0) {
- if (m != 0 || mu != 0) { // label 10
- if (mu != 0) {
- xd = 2.0 * l * (l + 1);
- if (mu <= 0) {
- xn = 1.0 * (l + m) * (l - m + 1);
- result = sqrt(xn / xd);
- } else { // label 15
- xn = 1.0 * (l - m) * (l + m + 1);
- result = -sqrt(xn / xd);
- }
- } else { // label 20
- xd = 1.0 * (l + 1) * l;
- xn = -1.0 * m;
- result = xn / sqrt(xd);
- }
- }
- } else { // label 30
- xd = 2.0 * l * (l * 2 - 1);
- if (mu < 0) { // label 35
- xn = 1.0 * (l - 1 + m) * (l + m);
- } else if (mu == 0) { // label 40
- xn = 2.0 * (l - m) * (l + m);
- } else { // mu > 0, label 45
- xn = 1.0 * (l - 1 - m) * (l - m);
- }
- result = sqrt(xn / xd);
- }
- return result;
-}
+double cgev(int ipamo, int mu, int l, int m);
-/*! \brief C++ porting of R3JJR
+/*! \brief C++ porting of CMS
*
- * \param j2: `int`
- * \param j3: `int`
- * \param m2: `int`
- * \param m3: `int`
+ * \param am: Matrix of complex.
+ * \param c1: `C1 *`
+ * \param c1ao: `C1_AddOns *`
+ * \param c4: `C4 *`
* \param c6: `C6 *`
*/
-void r3jjr(int j2, int j3, int m2, int m3, C6 *c6) {
- int jmx = j3 + j2;
- int jdf = j3 - j2;
- int m1 = -m2 - m3;
- int abs_jdf = (jdf >= 0) ? jdf : -jdf;
- int abs_m1 = (m1 >= 0) ? m1 : -m1;
- int jmn = (abs_jdf > abs_m1) ? abs_jdf : abs_m1;
- int njmo = jmx - jmn;
- int jf = jmx + jmx + 1;
- int isn = 1;
- if ((jdf + m1) % 2 != 0) isn = -1;
- if (njmo <= 0) {
- double sj = 1.0 * jf;
- double cnr = (1.0 / sqrt(sj)) * isn;
- c6->rac3j[0] = cnr;
- } else { // label 15
- double sjt = 1.0;
- double sjr = 1.0 * jf;
- int jsmpos = (jmx + 1) * (jmx + 1);
- int jdfs = jdf * jdf;
- int m1s = m1 * m1;
- int mdf = m3 - m2;
- int idjc = m1 * (j3 * (j3 + 1) - j2 * (j2 +1));
- int j1 = jmx;
- int j1s = j1 * j1;
- int j1po = j1 + 1;
- double ccj = 1.0 * (j1s - jdfs) * (j1s - m1s);
- double cj = sqrt(ccj * (jsmpos - j1s));
- double dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
- // In old version, CJP was defined here. Did not work.
- // double cjp = 0.0
- if (njmo <= 1) {
- c6->rac3j[0] = -dj / (cj * j1po);
- double sj = sjr + (c6->rac3j[0] * c6->rac3j[0]) * (jf - 2);
- double cnr = (1.0 / sqrt(sj)) * isn;
- c6->rac3j[1] = cnr;
- c6->rac3j[0] *= cnr;
- } else { // label 20
- double cjp = 0.0;
- int nj = njmo + 1;
- int nmat = (nj + 1) / 2;
- c6->rac3j[nj - 1] = 1.0;
- c6->rac3j[njmo - 1] = -dj / (cj * j1po);
- if (nmat != njmo) {
- int nbr = njmo - nmat;
- for (int ibr45 = 1; ibr45 <= nbr; ibr45++) {
- int irr = nj - ibr45;
- jf -= 2;
- j1--;
- j1s = j1 * j1;
- j1po = j1 + 1;
- cjp = cj;
- ccj = 1.0 * (j1s - jdfs) * (j1s - m1s);
- cj = sqrt(ccj * (jsmpos - j1s));
- sjt = c6->rac3j[irr - 1] * c6->rac3j[irr - 1];
- dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
- c6->rac3j[irr - 2] = -(c6->rac3j[irr - 1] * dj
- + c6->rac3j[irr] * cjp * j1) / (cj * j1po);
- sjr += (sjt * jf);
- } // ibr45 loop
- }
- // label 50
- double osjt = sjt;
- sjt = c6->rac3j[nmat - 1] * c6->rac3j[nmat - 1];
- if (sjt >= osjt) {
- sjr += (sjt * (jf - 2));
- } else { // label 55
- nmat++;
- }
- // label 60
- double racmat = c6->rac3j[nmat - 1];
- c6->rac3j[0] = 1.0;
- jf = jmn + jmn + 1;
- double sjl = 1.0 * jf;
- j1 = jmn;
- if (j1 != 0) {
- j1po = j1 + 1;
- int j1pos = j1po * j1po;
- double ccjp = 1.0 * (j1pos - jdfs) * (j1pos - m1s);
- cjp = sqrt(ccjp * (jsmpos - j1pos));
- dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
- c6->rac3j[1] = - dj / (cjp * j1);
- } else { // label 62
- cjp = sqrt(1.0 * (jsmpos - 1));
- dj = 1.0 * mdf;
- c6->rac3j[1] = -dj / cjp;
- }
- // label 63
- int nmatmo = nmat - 1;
- if (nmatmo >= 2) {
- for (int irl70 = 2; irl70 <= nmatmo; irl70++) {
- jf += 2;
- j1++;
- j1po = j1 + 1;
- int j1pos = j1po * j1po;
- cj = cjp;
- double ccjp = 1.0 * (j1pos - jdfs) * (j1pos - m1s);
- cjp = sqrt(ccjp * (jsmpos - j1pos));
- sjt = c6->rac3j[irl70 - 1] * c6->rac3j[irl70 - 1];
- dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
- c6->rac3j[irl70] = -(
- c6->rac3j[irl70 - 1] * dj
- + c6->rac3j[irl70 - 2] * cj * j1po
- ) / (cjp * j1);
- sjl += (sjt * jf);
- }
- }
- // label 75
- double ratrac = racmat / c6->rac3j[nmat - 1];
- double rats = ratrac * ratrac;
- double sj = sjr + sjl * rats;
- c6->rac3j[nmat - 1] = racmat;
- double cnr = (1.0 / sqrt(sj)) * isn;
- for (int irr80 = nmat; irr80 <= nj; irr80++) c6->rac3j[irr80 - 1] *= cnr;
- double cnl = cnr * ratrac;
- for (int irl85 = 1; irl85 <= nmatmo; irl85++) c6->rac3j[irl85 - 1] *= cnl;
- }
- }
-}
+void cms(std::complex<double> **am, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6);
-/*! \brief C++ porting of R3JMR
+/*! \brief C++ porting of CRSM1
*
- * \param j1: `int`
- * \param j2: `int`
- * \param j3: `int`
- * \param m1: `int`
+ * \param vk: `double` Wave number.
+ * \param exri: `double` External medium refractive index.
+ * \param c1: `C1 *`
+ * \param c1ao: `C1_AddOns *`
+ * \param c4: `C4 *`
* \param c6: `C6 *`
*/
-void r3jmr(int j1, int j2, int j3, int m1, C6 *c6) {
- int mmx = (j2 < j3 - m1) ? j2 : j3 - m1;
- int mmn = (-j2 > -(j3 + m1)) ? -j2 : -(j3 + m1);
- int nmmo = mmx - mmn;
- int j1po = j1 + 1;
- int j1tpo = j1po + j1;
- int isn = 1;
- if ((j2 - j3 - m1) % 2 != 0) isn = -1;
- if (nmmo <= 0) {
- double sj = 1.0 * j1tpo;
- double cnr = (1.0 / sqrt(sj)) * isn;
- c6->rac3j[0] = cnr;
- // returns
- } else { // label 15
- int j1s = j1 * j1po;
- int j2po = j2 + 1;
- int j2s = j2 * j2po;
- int j3po = j3 + 1;
- int j3s = j3 * j3po;
- int id = j1s - j2s - j3s;
- int m2 = mmx;
- int m3 = m1 + m2;
- double cm = sqrt(1.0 * (j2po - m2) * (j2 + m2) * (j3po - m3) * (j3 + m3));
- double dm = 1.0 * (id + m2 * m3 * 2);
- if (nmmo <= 1) {
- c6->rac3j[0] = dm / cm;
- double sj = (1.0 + c6->rac3j[0] * c6->rac3j[0]) * j1tpo;
- double cnr = 1.0 / sqrt(sj) * isn;
- c6->rac3j[1] = cnr;
- c6->rac3j[0] *= cnr;
- // returns
- } else { // label 20
- int nm = nmmo + 1;
- int nmat = (nm + 1) / 2;
- c6->rac3j[nm - 1] = 1.0;
- c6->rac3j[nmmo - 1] = dm / cm;
- double sjt = 1.0;
- double sjr = 1.0;
- if (nmat != nmmo) {
- int nbr = nmmo - nmat;
- for (int ibr45 = 1; ibr45 <= nbr; ibr45++) {
- int irr = nm - ibr45;
- m2--;
- m3 = m1 + m2;
- double cmp = cm;
- cm = sqrt(1.0 * (j2po - m2) * (j2 + m2) * (j3po - m3) * (j3 + m3));
- sjt = c6->rac3j[irr - 1] * c6->rac3j[irr - 1];
- dm = 1.0 * (id + m2 * m3 * 2);
- c6->rac3j[irr - 1] *= ((dm - c6->rac3j[irr] * cmp) / cm);
- sjr += sjt;
- } // ibr45 loop
- }
- // label 50
- double osjt = sjt;
- sjt = c6->rac3j[nmat - 1] * c6->rac3j[nmat - 1];
- if (sjt >= osjt) {
- sjr += sjt;
- } else { // label 55
- nmat++;
- }
- // label 60
- double racmat = c6->rac3j[nmat - 1];
- c6->rac3j[0] = 1.0;
- m2 = mmn;
- m3 = m1 + m2;
- double cmp = sqrt(1.0 * (j2 - m2) * (j2po + m2) * (j3 - m3) * (j3po + m3));
- dm = 1.0 * (id + m2 * m3 * 2);
- c6->rac3j[1] = dm / cmp;
- double sjl = 1.0;
- int nmatmo = nmat - 1;
- if (nmatmo > 1) {
- for (int irl70 = 2; irl70 <= nmatmo; irl70++) {
- m2++;
- m3 = m1 + m2;
- cm = cmp;
- cmp = sqrt(1.0 * (j2 - m2) * (j2po + m2) * (j3 - m3) * (j3po + m3));
- sjt = c6->rac3j[irl70 - 1] * c6->rac3j[irl70 - 1];
- dm = 1.0 * (id + m2 * m3 * 2);
- c6->rac3j[irl70] = (c6->rac3j[irl70 - 1] * dm - c6->rac3j[irl70 - 2] * cm) / cmp;
- sjl += sjt;
- }
- }// label 75
- double ratrac = racmat / c6->rac3j[nmat - 1];
- double rats = ratrac * ratrac;
- double sj = (sjr + sjl * rats) * j1tpo;
- c6->rac3j[nmat - 1] = racmat;
- double cnr = 1.0 / sqrt(sj) * isn;
- for (int irr80 = nmat; irr80 <= nm; irr80++) c6->rac3j[irr80 - 1] *= cnr;
- double cnl = cnr * ratrac;
- for (int irl85 = 1; irl85 <= nmatmo; irl85++) c6->rac3j[irl85 - 1] *= cnl;
- // returns
- }
- }
-}
+void crsm1(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6);
/*! \brief C++ porting of GHIT
*
@@ -376,794 +107,7 @@ void r3jmr(int j1, int j2, int j3, int m1, C6 *c6) {
std::complex<double> ghit(
int ihi, int ipamo, int nbl, int l1, int m1, int l2, int m2, C1 *c1,
C1_AddOns *c1ao, C4 *c4, C6 *c6
- ) {
- /* NBL identifies transfer vector going from N2 to N1;
- * IHI=0 for Hankel, IHI=1 for Bessel, IHI=2 for Bessel from origin;
- * depending on IHI, IPAM=0 gives H or I, IPAM= 1 gives K or L. */
- const std::complex<double> cc0(0.0, 0.0);
- const std::complex<double> uim(0.0, 1.0);
- std::complex<double> csum(0.0, 0.0), cfun(0.0, 0.0);
- std::complex<double> result = cc0;
-
- if (ihi == 2) {
- if (c1->rxx[nbl - 1] == 0.0 && c1->ryy[nbl - 1] == 0.0 && c1->rzz[nbl - 1] == 0.0) {
- if (ipamo == 0) {
- if (l1 == l2 && m1 == m2) result = std::complex(1.0, 0.0);
- }
- return result;
- }
- }
- // label 10
- int l1mp = l1 - ipamo;
- int l1po = l1 + 1;
- int m1mm2 = m1 - m2;
- int m1mm2m = (m1mm2 > 0) ? m1mm2 + 1 : 1 - m1mm2;
- int lminpo = (l2 - l1mp > 0) ? l2 - l1mp + 1 : l1mp - l2 + 1;
- int lmaxpo = l2 + l1mp + 1;
- int i3j0in = c1ao->ind3j[l1mp][l2 - 1];
- int ilin = -1;
- if (m1mm2m > lminpo && (m1mm2m - lminpo) % 2 != 0) ilin = 0;
- int isn = 1;
- if (m1 % 2 != 0) isn *= -1;
- if (lminpo % 2 == 0) {
- isn *= -1;
- if (l2 > l1mp) isn *= -1;
- }
- // label 12
- int nblmo = nbl - 1;
- if (ihi != 2) {
- int nbhj = nblmo * c4->litpo;
- int nby = nblmo * c4->litpos;
- if (ihi != 1) {
- for (int jm24 = 1; jm24 <= 3; jm24++) {
- csum = cc0;
- int mu = jm24 - 2;
- int mupm1 = mu + m1;
- int mupm2 = mu + m2;
- if (mupm1 >= -l1mp && mupm1 <= l1mp && mupm2 >= - l2 && mupm2 <= l2) {
- int jsn = -isn;
- if (mu == 0) jsn = isn;
- double cr = cgev(ipamo, mu, l1, m1) * cgev(0, mu, l2, m2);
- int i3j0 = i3j0in;
- if (mupm1 == 0 && mupm2 == 0) {
- int lt14 = lminpo;
- while (lt14 <= lmaxpo) {
- i3j0++;
- int l3 = lt14 - 1;
- int ny = l3 * l3 + lt14;
- double aors = 1.0 * (l3 + lt14);
- double f3j = (c1ao->v3j0[i3j0 - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
- cfun = (c1ao->vh[nbhj + lt14 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
- csum += cfun;
- jsn *= -1;
- lt14 += 2;
- }
- // goes to 22
- } else { // label 16
- r3jjr(l1mp, l2, -mupm1, mupm2, c6);
- int il = ilin;
- int lt20 = lminpo;
- while (lt20 <= lmaxpo) {
- i3j0++;
- if (m1mm2m <= lt20) {
- il += 2;
- int l3 = lt20 - 1;
- int ny = l3 * l3 + lt20 + m1mm2;
- double aors = 1.0 * (l3 + lt20);
- double f3j = (c6->rac3j[il - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
- //printf("DEBUG: VH( %d ) = (%lE, %lE)\n", (nbhj + lt20), c1ao->vh[nbhj + lt20 - 1].real(), c1ao->vh[nbhj + lt20 - 1].imag());
- //printf("DEBUG: VYHJ( %d ) = (%lE, %lE)\n", (nby + ny), c1ao->vyhj[nby + ny - 1].real(), c1ao->vyhj[nby + ny - 1].imag());
- cfun = (c1ao->vh[nbhj + lt20 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
- csum += cfun; // we were here
- }
- // label 20
- jsn *= -1;
- lt20 += 2;
- }
- }
- // label 22
- csum *= cr;
- result += csum;
- }
- // Otherwise there is nothing to add
- } // jm24 loop. Should go to 70
- } else { // label 30, IHI == 1
- for (int jm44 = 1; jm44 <= 3; jm44++) {
- csum = cc0;
- int mu = jm44 - 2;
- int mupm1 = mu + m1;
- int mupm2 = mu + m2;
- if (mupm1 >= -l1mp && mupm1 <= l1mp && mupm2 >= - l2 && mupm2 <= l2) {
- int jsn = - isn;
- if (mu == 0) jsn = isn;
- double cr = cgev(ipamo, mu, l1, m1) * cgev(0, mu, l2, m2);
- int i3j0 = i3j0in;
- if (mupm1 == 0 && mupm2 == 0) {
- int lt34 = lminpo;
- while (lt34 <= lmaxpo) {
- i3j0++;
- int l3 = lt34 - 1;
- int ny = l3 * l3 + lt34;
- double aors = 1.0 * (l3 + lt34);
- double f3j = (c1ao->v3j0[i3j0 - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
- cfun = (c1ao->vh[nbhj + lt34 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
- csum += cfun;
- jsn *= -1;
- lt34 += 2;
- }
- // goes to 42
- } else { // label 36
- r3jjr(l1mp, l2, -mupm1, mupm2, c6);
- int il = ilin;
- int lt40 = lminpo;
- while (lt40 <= lmaxpo) {
- i3j0++;
- if (m1mm2m <= lt40) {
- il += 2;
- int l3 = lt40 - 1;
- int ny = l3 * l3 + lt40 + m1mm2;
- double aors = 1.0 * (l3 + lt40);
- double f3j = (c6->rac3j[il - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
- cfun = (c1ao->vh[nbhj + lt40 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
- csum += cfun;
- }
- // label 40
- jsn *= -1;
- lt40 += 2;
- }
- }
- // label 42
- csum *= cr;
- result += csum;
- }
- // Otherwise there is nothing to add
- } // jm44 loop. Should go to 70
- }
- // goes to 70
- } else { // label 50, IHI == 2
- int nbhj = nblmo * c4->lmtpo;
- int nby = nblmo * c4->lmtpos;
- for (int jm64 = 1; jm64 <= 3; jm64++) {
- csum = cc0;
- int mu = jm64 - 2;
- int mupm1 = mu + m1;
- int mupm2 = mu + m2;
- if (mupm1 >= -l1mp && mupm1 <= l1mp && mupm2 >= - l2 && mupm2 <= l2) {
- int jsn = -isn;
- if (mu == 0) jsn = isn;
- double cr = cgev(ipamo, mu, l1, m1) * cgev(0, mu, l2, m2);
- int i3j0 = i3j0in;
- if (mupm1 == 0 && mupm2 == 0) {
- int lt54 = lminpo;
- while (lt54 <= lmaxpo) {
- i3j0++;
- int l3 = lt54 - 1;
- int ny = l3 * l3 + lt54;
- double aors = 1.0 * (l3 + lt54);
- double f3j = (c1ao->v3j0[i3j0 - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
- cfun = (c1ao->vj0[nbhj + lt54 - 1] * c1ao->vyj0[nby + ny - 1]) * f3j;
- csum += cfun;
- jsn *= -1;
- lt54 += 2;
- }
- // goes to 62
- } else { // label 56
- r3jjr(l1mp, l2, -mupm1, mupm2, c6);
- int il = ilin;
- int lt60 = lminpo;
- while (lt60 <= lmaxpo) {
- i3j0++;
- if (m1mm2m <= lt60) {
- il += 2;
- int l3 = lt60 - 1;
- int ny = l3 * l3 + lt60 + m1mm2;
- double aors = 1.0 * (l3 + lt60);
- double f3j = (c6->rac3j[il - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
- cfun = (c1ao->vj0[nbhj + lt60 - 1] * c1ao->vyj0[nby + ny - 1]) * f3j;
- csum += cfun;
- }
- // label 60
- jsn *= -1;
- lt60 += 2;
- }
- }
- // label 62
- csum *= cr;
- result += csum;
- }
- // Otherwise there is nothing to add
- } // jm64 loop. Should go to 70
- }
- // label 70
- const double four_pi = acos(0.0) * 8.0;
- if (ipamo != 1) {
- double cr = sqrt(four_pi * (l1 + l1po) * (l2 + l2 + 1));
- result *= cr;
- } else {
- double cr = sqrt(four_pi * (l1 + l1mp) * (l1 + l1po) * (l2 + l2 + 1) / l1po);
- result *= (cr * uim);
- }
- return result;
-}
-
-/*! \brief C++ porting of APC
- *
- * \param zpv: `double ****`
- * \param le: `int`
- * \param am0m: Matrix of complex.
- * \param w: Matrix of complex.
- * \param sqk: `double`
- * \param gapr: `double **`
- * \param gapp: Matrix of complex.
- */
-void apc(
- double ****zpv, int le, std::complex<double> **am0m, std::complex<double> **w,
- double sqk, double **gapr, std::complex<double> **gapp
- ) {
- std::complex<double> **ac, **gap;
- const std::complex<double> cc0(0.0, 0.0);
- const std::complex<double> uim(0.0, 1.0);
- std::complex<double> uimmp, summ, sume, suem, suee, summp, sumep;
- std::complex<double> suemp, sueep;
- double cof = 1.0 / sqk;
- double cimu = cof / sqrt(2.0);
- int nlem = le * (le + 2);
- const int nlemt = nlem + nlem;
- ac = new std::complex<double>*[nlemt];
- gap = new std::complex<double>*[3];
- for (int ai = 0; ai < nlemt; ai++) ac[ai] = new std::complex<double>[2]();
- for (int gi = 0; gi < 3; gi++) gap[gi] = new std::complex<double>[2]();
- for (int j45 = 1; j45 <= nlemt; j45++) {
- int j = j45 - 1;
- ac[j][0] = cc0;
- ac[j][1] = cc0;
- for (int i45 = 1; i45 <= nlemt; i45++) {
- int i = i45 - 1;
- ac[j][0] += (am0m[j][i] * w[i][0]);
- ac[j][1] += (am0m[j][i] * w[i][1]);
- } //i45 loop
- } //j45 loop
- for (int imu90 = 1; imu90 <=3; imu90++) {
- int mu = imu90 - 2;
- gap[imu90 - 1][0] = cc0;
- gap[imu90 - 1][1] = cc0;
- gapp[imu90 - 1][0] = cc0;
- gapp[imu90 - 1][1] = cc0;
- for (int l80 =1; l80 <= le; l80++) {
- int lpo = l80 + 1;
- int ltpo = lpo + l80;
- int imm = l80 * lpo;
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- if ((l80 == 1 && ilmp == 1) || (l80 == le && ilmp == 3)) continue; // ilmp loop
- int lmpml = ilmp - 2;
- int lmp = l80 + lmpml;
- uimmp = (-1.0 * lmpml) * uim;
- int impmmmp = lmp * (lmp + 1);
- for (int im70 = 1; im70 <= ltpo; im70++) {
- int m = im70 - lpo;
- int mmp = m - mu;
- int abs_mmp = (mmp > 0) ? mmp : -mmp;
- if (abs_mmp <= lmp) {
- int i = imm + m;
- int ie = i + nlem;
- int imp = impmmmp + mmp;
- int impe = imp + nlem;
- double cgc = cg1(lmpml, mu, l80, m);
- int jpo = 2;
- for (int ipo = 1; ipo <= 2; ipo++) {
- if (ipo == 2) jpo = 1;
- //printf("DEBUG: i=%d, ipo=%d, imp=%d\n", i, ipo, imp);
- //fflush(stdout);
- summ = dconjg(ac[i - 1][ipo - 1]) * ac[imp - 1][ipo - 1];
- sume = dconjg(ac[i - 1][ipo - 1]) * ac[impe - 1][ipo - 1];
- suem = dconjg(ac[ie - 1][ipo - 1]) * ac[imp - 1][ipo - 1];
- suee = dconjg(ac[ie - 1][ipo - 1]) * ac[impe - 1][ipo - 1];
- summp = dconjg(ac[i - 1][jpo - 1]) * ac[imp - 1][ipo - 1];
- sumep = dconjg(ac[i - 1][jpo - 1]) * ac[impe - 1][ipo - 1];
- suemp = dconjg(ac[ie - 1][jpo - 1]) * ac[imp - 1][ipo - 1];
- sueep = dconjg(ac[ie - 1][jpo - 1]) * ac[impe - 1][ipo - 1];
- if (lmpml != 0) {
- summ *= uimmp;
- sume *= uimmp;
- suem *= uimmp;
- suee *= uimmp;
- summp *= uimmp;
- sumep *= uimmp;
- suemp *= uimmp;
- sueep *= uimmp;
- }
- // label 55
- gap[imu90 - 1][ipo - 1] += (
- (
- summ * zpv[l80 - 1][ilmp - 1][0][0]
- + sume * zpv[l80 - 1][ilmp - 1][0][1]
- + suem * zpv[l80 - 1][ilmp - 1][1][0]
- + suee * zpv[l80 - 1][ilmp - 1][1][1]
- ) * cgc
- );
- gapp[imu90 - 1][ipo - 1] += (
- (
- summp * zpv[l80 - 1][ilmp - 1][0][0]
- + sumep * zpv[l80 - 1][ilmp - 1][0][1]
- + suemp * zpv[l80 - 1][ilmp - 1][1][0]
- + sueep * zpv[l80 - 1][ilmp - 1][1][1]
- ) * cgc
- );
- } // ipo loop
- } // ends im70 loop
- } // im70 loop
- } // ilmp loop
- } // l80 loop
- } // imu90 loop
- for (int ipo95 = 1; ipo95 <= 2; ipo95++) {
- sume = gap[0][ipo95 - 1] * cimu;
- suee = gap[1][ipo95 - 1] * cof;
- suem = gap[2][ipo95 - 1] * cimu;
- gapr[0][ipo95 - 1] = (sume - suem).real();
- gapr[1][ipo95 - 1] = ((sume + suem) * uim).real();
- gapr[2][ipo95 - 1] = suee.real();
- sumep = gapp[0][ipo95 - 1] * cimu;
- sueep = gapp[1][ipo95 - 1] * cof;
- suemp = gapp[2][ipo95 - 1] * cimu;
- gapp[0][ipo95 - 1] = sumep - suemp;
- gapp[1][ipo95 - 1] = (sumep + suemp) * uim;
- gapp[2][ipo95 - 1] = sueep;
- } // ipo95 loop
- // Clean memory
- for (int ai = nlemt - 1; ai > -1; ai--) delete[] ac[ai];
- for (int gi = 2; gi > -1; gi--) delete[] gap[gi];
- delete[] ac;
- delete[] gap;
-}
-
-/*! \brief C++ porting of APCRA
- *
- * \param zpv: `double ****`
- * \param le: `int`
- * \param am0m: Matrix of complex.
- * \param inpol: `int` Polarization type.
- * \param sqk: `double`
- * \param gaprm: `double **`
- * \param gappm: Matrix of complex.
- */
-void apcra(
- double ****zpv, const int le, std::complex<double> **am0m, int inpol, double sqk,
- double **gaprm, std::complex<double> **gappm
- ) {
- const std::complex<double> cc0(0.0, 0.0);
- const std::complex<double> uim(0.0, 1.0);
- std::complex<double> uimtl, uimtls, ca11, ca12, ca21, ca22;
- std::complex<double> a11, a12, a21, a22, sum1, sum2, fc;
- double ****svw = new double***[le];
- std::complex<double> ****svs = new std::complex<double>***[le];
- for (int i = 0; i < le; i++) {
- svw[i] = new double**[3];
- svs[i] = new std::complex<double>**[3];
- for (int j = 0; j < 3; j++) {
- svw[i][j] = new double*[2];
- svs[i][j] = new std::complex<double>*[2];
- for (int k = 0; k < 2; k++) {
- svw[i][j][k] = new double[2]();
- svs[i][j][k] = new std::complex<double>[2]();
- }
- }
- }
- int nlem = le * (le + 2);
- for (int l28 = 1; l28 <= le; l28++) {
- int lpo = l28 + 1;
- int ltpo = lpo + l28;
- double fl = sqrt(1.0 * ltpo);
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- if ((l28 == 1 && ilmp == 1) || (l28 == le && ilmp == 3)) continue; // ilmp loop
- int lmpml = ilmp - 2;
- int lmp = l28 + lmpml;
- double flmp = sqrt(1.0 * (lmp + lmp + 1));
- double fllmp = flmp / fl;
- double cgmmo = fllmp * cg1(lmpml, 0, l28, 1);
- double cgmpo = fllmp * cg1(lmpml, 0, l28, -1);
- if (inpol == 0) {
- double cgs = cgmpo + cgmmo;
- double cgd = cgmpo - cgmmo;
- svw[l28 - 1][ilmp - 1][0][0] = cgs;
- svw[l28 - 1][ilmp - 1][0][1] = cgd;
- svw[l28 - 1][ilmp - 1][1][0] = cgd;
- svw[l28 - 1][ilmp - 1][1][1] = cgs;
- } else { // label 22
- svw[l28 - 1][ilmp - 1][0][0] = cgmpo;
- svw[l28 - 1][ilmp - 1][1][0] = cgmpo;
- svw[l28 - 1][ilmp - 1][0][1] = -cgmmo;
- svw[l28 - 1][ilmp - 1][1][1] = cgmmo;
- }
- // label 26
- } // ilmp loop
- } // l28 loop
- for (int l30 = 1; l30 <= le; l30++) { // 0-init: can be omitted
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- for (int ipa = 1; ipa <= 2; ipa++) {
- for (int ipamp = 1; ipamp <= 2; ipamp++) {
- svs[l30 - 1][ilmp - 1][ipa - 1][ipamp - 1] = cc0;
- }
- } // ipa loop
- } // ilmp loop
- } // l30 loop
- for (int l58 = 1; l58 <= le; l58 ++) {
- int lpo = l58 + 1;
- int ltpo = l58 + lpo;
- int imm = l58 * lpo;
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- if ((l58 == 1 && ilmp == 1) || (l58 == le && ilmp == 3)) continue; // ilmp loop
- int lmpml = ilmp - 2;
- int lmp = l58 + lmpml;
- int impmm = lmp * (lmp + 1);
- uimtl = uim * (1.0 * lmpml);
- if (lmpml == 0) uimtl = std::complex<double>(1.0, 0.0);
- for (int im54 = 1; im54 <= ltpo; im54++) {
- int m = im54 - lpo;
- int i = imm + m;
- int ie = i + nlem;
- for (int imu52 = 1; imu52 <= 3; imu52++) {
- int mu = imu52 - 2;
- int mmp = m - mu;
- int abs_mmp = (mmp > 0) ? mmp : -mmp;
- if (abs_mmp <= lmp) {
- int imp = impmm + mmp;
- int impe = imp + nlem;
- double cgc = cg1(lmpml, -mu, l58, -m);
- for (int ls = 1; ls <= le; ls++) {
- int lspo = ls + 1;
- int lstpo = ls + lspo;
- int ismm = ls * lspo;
- for (int ilsmp = 1; ilsmp <= 3; ilsmp++) {
- if ((ls == 1 && ilsmp == 1) || (ls == le && ilsmp == 3)) continue; // ilsmp loop
- int lsmpml = ilsmp - 2;
- int lsmp = ls + lsmpml;
- int ismpmm = lsmp * (lsmp + 1);
- uimtls = -uim * (1.0 * lsmpml);
- if (lsmpml == 0) uimtls = std::complex<double>(1.0, 0.0);
- for (int ims = 1; ims <= lstpo; ims++) {
- int ms = ims - lspo;
- int msmp = ms - mu;
- int abs_msmp = (msmp > 0) ? msmp : -msmp;
- if (abs_msmp <= lsmp) {
- int is = ismm + ms;
- int ise = is + nlem;
- int ismp = ismpmm + msmp;
- int ismpe = ismp + nlem;
- double cgcs = cg1(lsmpml, mu, ls, ms);
- fc = (uimtl * uimtls) * (cgc * cgcs);
- ca11 = dconjg(am0m[is - 1][i - 1]);
- ca12 = dconjg(am0m[is - 1][ie - 1]);
- ca21 = dconjg(am0m[ise - 1][i - 1]);
- ca22 = dconjg(am0m[ise - 1][ie - 1]);
- a11 = am0m[ismp - 1][imp - 1];
- a12 = am0m[ismp - 1][impe - 1];
- a21 = am0m[ismpe - 1][imp - 1];
- a22 = am0m[ismpe - 1][impe - 1];
- double z11 = zpv[ls - 1][ilsmp - 1][0][0];
- double z12 = zpv[ls - 1][ilsmp - 1][0][1];
- double z21 = zpv[ls - 1][ilsmp - 1][1][0];
- double z22 = zpv[ls - 1][ilsmp - 1][1][1];
- svs[l58 - 1][ilmp - 1][0][0] += ((ca11 * a11 * z11
- + ca11 * a21 * z12
- + ca21 * a11 * z21
- + ca21 * a21 * z22) * fc);
- svs[l58 - 1][ilmp - 1][0][1] += ((ca11 * a12 * z11
- + ca11 * a22 * z12
- + ca21 * a12 * z21
- + ca21 * a22 * z22) * fc);
- svs[l58 - 1][ilmp - 1][1][0] += ((ca12 * a11 * z11
- + ca12 * a21 * z12
- + ca22 * a11 * z21
- + ca22 * a21 * z22) * fc);
- svs[l58 - 1][ilmp - 1][1][1] += ((ca12 * a12 * z11
- + ca12 * a22 * z12
- + ca22 * a12 * z21
- + ca22 * a22 * z22) * fc);
- } // ends ims loop
- } // ims loop
- } // ilsmp loop
- } // ls loop
- } // ends imu52 loop
- } // imu52 loop
- } // im54 loop
- } // ilmp loop
- } // l58 loop
- sum1 = cc0;
- sum2 = cc0;
- for (int l68 = 1; l68 <= le; l68++) {
- //int lpo = l68 + 1;
- //int ltpo = l68 + lpo;
- //int imm = l68 * lpo;
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- if ((l68 == 1 && ilmp == 1) || (l68 == le && ilmp == 3)) continue; // ilmp loop
- if (inpol == 0) {
- sum1 += (
- svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][0][0]
- + svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][0][1]
- + svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][1][0]
- + svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][1][1]
- );
- sum2 += (
- svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][0][0]
- + svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][0][1]
- + svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][1][0]
- + svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][1][1]
- );
- } else { // label 62
- sum1 += (
- svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][0][0]
- + svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][0][1]
- + svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][1][0]
- + svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][1][1]
- );
- sum2 += (
- svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][0][0]
- + svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][0][1]
- + svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][1][0]
- + svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][1][1]
- );
- } // label 66, ends ilmp loop
- } // ilmp loop
- } // l68 loop
- const double half_pi = acos(0.0);
- double cofs = half_pi * 2.0 / sqk;
- gaprm[0][0] = 0.0;
- gaprm[0][1] = 0.0;
- gaprm[1][0] = 0.0;
- gaprm[1][1] = 0.0;
- gappm[0][0] = cc0;
- gappm[0][1] = cc0;
- gappm[1][0] = cc0;
- gappm[1][1] = cc0;
- if (inpol == 0) {
- sum1 *= cofs;
- sum2 *= cofs;
- gaprm[2][0] = sum1.real();
- gaprm[2][1] = sum1.real();
- gappm[2][0] = sum2 * uim;
- gappm[2][1] = -gappm[2][0];
- } else { // label 72
- cofs *= 2.0;
- gaprm[2][0] = sum1.real() * cofs;
- gaprm[2][1] = sum2.real() * cofs;
- gappm[2][0] = cc0;
- gappm[2][1] = cc0;
- }
- // Clean memory
- for (int i = le - 1; i > -1; i--) {
- for (int j = 2; j > -1; j--) {
- for (int k = 1; k > -1; k--) {
- delete[] svw[i][j][k];
- delete[] svs[i][j][k];
- }
- delete[] svw[i][j];
- delete[] svs[i][j];
- }
- delete[] svw[i];
- delete[] svs[i];
- }
- delete[] svw;
- delete[] svs;
-}
-
-/*! \brief C++ porting of CMS
- *
- * \param am: Matrix of complex.
- * \param c1: `C1 *`
- * \param c1ao: `C1_AddOns *`
- * \param c4: `C4 *`
- * \param c6: `C6 *`
- */
-void cms(std::complex<double> **am, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6) {
- std::complex<double> dm, de, cgh, cgk;
- const std::complex<double> cc0(0.0, 0.0);
- int ndi = c4->nsph * c4->nlim;
- int nbl = 0;
- int nsphmo = c4->nsph - 1;
- for (int n1 = 1; n1 <= nsphmo; n1++) { // GPU portable?
- int in1 = (n1 - 1) * c4->nlim;
- int n1po = n1 + 1;
- for (int n2 = n1po; n2 <= c4->nsph; n2++) {
- int in2 = (n2 - 1) * c4->nlim;
- nbl++;
- for (int l1 = 1; l1 <= c4->li; l1++) {
- int l1po = l1 + 1;
- int il1 = l1po * l1;
- int l1tpo = l1po + l1;
- for (int im1 = 1; im1 <= l1tpo; im1++) {
- int m1 = im1 - l1po;
- int ilm1 = il1 + m1;
- int ilm1e = ilm1 + ndi;
- int i1 = in1 + ilm1;
- int i1e = in1 + ilm1e;
- int j1 = in2 + ilm1;
- int j1e = in2 + ilm1e;
- for (int l2 = 1; l2 <= c4->li; l2++) {
- int l2po = l2 + 1;
- int il2 = l2po * l2;
- int l2tpo = l2po + l2;
- int ish = ((l2 + l1) % 2 == 0) ? 1 : -1;
- int isk = -ish;
- for (int im2 = 1; im2 <= l2tpo; im2++) {
- int m2 = im2 - l2po;
- int ilm2 = il2 + m2;
- int ilm2e = ilm2 + ndi;
- int i2 = in2 + ilm2;
- int i2e = in2 + ilm2e;
- int j2 = in1 + ilm2;
- int j2e = in1 + ilm2e;
- cgh = ghit(0, 0, nbl, l1, m1, l2, m2, c1, c1ao, c4, c6);
- cgk = ghit(0, 1, nbl, l1, m1, l2, m2, c1, c1ao, c4, c6);
- am[i1 - 1][i2 - 1] = cgh;
- am[i1 - 1][i2e - 1] = cgk;
- am[i1e - 1][i2 - 1] = cgk;
- am[i1e - 1][i2e - 1] = cgh;
- am[j1 - 1][j2 - 1] = cgh * (1.0 * ish);
- am[j1 - 1][j2e - 1] = cgk * (1.0 * isk);
- am[j1e - 1][j2 - 1] = cgk * (1.0 * isk);
- am[j1e - 1][j2e - 1] = cgh * (1.0 * ish);
- }
- }
- } // im1 loop
- } // l1 loop
- } // n2 loop
- } // n1 loop
- for (int n1 = 1; n1 <= c4->nsph; n1++) { // GPU portable?
- int in1 = (n1 - 1) * c4->nlim;
- for (int l1 = 1; l1 <= c4->li; l1++) {
- dm = c1->rmi[l1 - 1][n1 - 1];
- de = c1->rei[l1 - 1][n1 - 1];
- int l1po = l1 + 1;
- int il1 = l1po * l1;
- int l1tpo = l1po + l1;
- for (int im1 = 1; im1 <= l1tpo; im1++) {
- int m1 = im1 - l1po;
- int ilm1 = il1 + m1;
- int i1 = in1 + ilm1;
- int i1e = i1 + ndi;
- for (int ilm2 = 1; ilm2 <= c4->nlim; ilm2++) {
- int i2 = in1 + ilm2;
- int i2e = i2 + ndi;
- am[i1 - 1][i2 - 1] = cc0;
- am[i1 - 1][i2e - 1] = cc0;
- am[i1e - 1][i2 - 1] = cc0;
- am[i1e - 1][i2e - 1] = cc0;
- }
- am[i1 - 1][i1 - 1] = dm;
- am[i1e - 1][i1e - 1] = de;
- } // im1 loop
- } // l1 loop
- } // n1 loop
-}
-
-/*! \brief C++ porting of CRSM1
- *
- * \param vk: `double` Wave number.
- * \param exri: `double` External medium refractive index.
- * \param c1: `C1 *`
- * \param c1ao: `C1_AddOns *`
- * \param c4: `C4 *`
- * \param c6: `C6 *`
- */
-void crsm1(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6) {
- std::complex<double> ***svf, ***svw, **svs;
- const std::complex<double> cc0(0.0, 0.0);
- std::complex<double> cam(0.0, 0.0);
- const int le4po = 4 * c4->le + 1;
- svf = new std::complex<double>**[le4po];
- svw = new std::complex<double>**[le4po];
- svs = new std::complex<double>*[le4po];
- for (int si = 0; si < le4po; si++) {
- svf[si] = new std::complex<double>*[le4po];
- svw[si] = new std::complex<double>*[4];
- svs[si] = new std::complex<double>[4]();
- for (int sj = 0; sj < le4po; sj++) svf[si][sj] = new std::complex<double>[4]();
- for (int sj = 0; sj < 4; sj++) svw[si][sj] = new std::complex<double>[4]();
- }
- double exdc = exri * exri;
- double ccs = 1.0 / (vk * vk);
- const double pi4sq = 64.0 * acos(0.0) * acos(0.0);
- double cint = ccs / (pi4sq * exdc);
- int letpo = c4->le + c4->le + 1;
- for (int i20 = 0; i20 < 16; i20++) c1ao->vintm[i20] = cc0; // 0-init: can be omitted
- for (int lpo40 = 1; lpo40 <= letpo; lpo40++) {
- int l = lpo40 - 1;
- int ltpo = lpo40 + l;
- int immn = letpo - l;
- int immx = letpo + l;
- for (int imf = immn; imf <= immx; imf++) { // 0-init: can be omitted
- for (int ims = immn; ims <= immx; ims++) {
- for (int ipo = 1; ipo <= 4; ipo++) {
- svf[imf - 1][ims - 1][ipo - 1] = cc0;
- } // ipo loop
- } // ims loop
- } // imf loop
- for (int l1 = 1; l1 <= c4->le; l1++) {
- int il1 = l1 * (l1 + 1);
- for (int l2 = 1; l2 <= c4->le; l2++) {
- int abs_l2ml1 = (l2 > l1) ? l2 - l1 : l1 - l2;
- if (l < abs_l2ml1 || l > l2 + l1) continue; // l2 loop
- int il2 = l2 * (l2 + 1);
- for (int im = immn; im >= immx; im++) { // 0-init: can be omitted
- for (int ipa = 1; ipa <= 4; ipa++) {
- svs[im - 1][ipa - 1] = cc0;
- for (int ipo = 1; ipo <= 4; ipo++) {
- svw[im - 1][ipa - 1][ipo - 1] = cc0;
- } // ipo loop
- } // ipa loop
- } // im loop
- for (int im = immn; im <= immx; im++) {
- int m = im - letpo;
- r3jmr(l, l1, l2, m, c6);
- int m1mnmo = (-l1 > -l2 - m) ? -(l1 + 1) : -(l2 + m + 1);
- int nm1 = (l1 < l2 - m) ? (l1 - m1mnmo) : (l2 - m - m1mnmo);
- for (int im1 = 1; im1 <= nm1; im1++) {
- int m1 = -im1 - m1mnmo;
- int isn = 1;
- if (m1 % 2 != 0) isn = -1;
- double cg3j = c6->rac3j[im1 - 1] * isn;
- int ilm1 = il1 + m1;
- int ilm2 = il2 + m1 - m;
- int ipa = 0;
- for (int ipa1 = 1; ipa1 <= 2; ipa1++) {
- int i1 = ilm1;
- if (ipa1 == 2) i1 = ilm1 + c4->nlem;
- for (int ipa2 = 1; ipa2 <= 2; ipa2++) {
- int i2 = ilm2;
- if (ipa2 == 2) i2 = ilm2 + c4->nlem;
- ipa++;
- svs[im - 1][ipa - 1] += (c1ao->am0m[i1 - 1][i2 - 1] * cg3j);
- int ipo = 0;
- for (int ipo2 = 1; ipo2 <= 2; ipo2++) {
- for (int ipo1 = 3; ipo1 <= 4; ipo1++) {
- ipo++;
- svw[im - 1][ipa - 1][ipo - 1] += (c1->w[i1 - 1][ipo1 - 1] * c1->w[i2 - 1][ipo2 - 1] * cg3j);
- } // ipo1 loop
- } // ipo2 loop
- } // ipa2 loop
- } // ipa1 loop
- } // im1 loop
- // label 32 loops
- for (int imf = immn; imf <= immx; imf++) {
- for (int ims = immn; ims <= immx; ims++) {
- for (int ipo = 1; ipo <= 4; ipo++) {
- for (int ipa = 1; ipa <= 4; ipa++) {
- svf[imf - 1][ims - 1][ipo - 1] += (svw[imf - 1][ipa - 1][ipo - 1] * svs[ims - 1][ipa - 1]);
- } // ipa loop
- } // ipo loop
- } // ims loop
- } // imf loop
- // ends loop level 34, which are l2 loop and l1 loop
- } // im loop
- } // l2 loop
- } // l1 loop
- for (int imf = immn; imf <= immx; imf++) {
- for (int ims = immn; ims <= immx; ims++) {
- int i = 0;
- for (int ipo1 = 1; ipo1 <= 4; ipo1++) {
- cam = dconjg(svf[imf - 1][ims - 1][ipo1 - 1]);
- for (int ipo2 = 1; ipo2 <= 4; ipo2++) {
- i++;
- c1ao->vintm[i - 1] += (svf[imf - 1][ims - 1][ipo2 - 1] * cam * (1.0 * ltpo));
- }
- } // ipo1 loop
- } // ims loop
- } // imf loop
- } // lpo40 loop
- for (int i42 = 0; i42 < 16; i42++) c1ao->vintm[i42] *= cint;
-
- // Clean memory
- for (int si = le4po - 1; si > -1; si--) {
- for (int sj = le4po - 1; sj > -1; sj--) delete[] svf[si][sj];
- for (int sj = 3; sj > -1; sj--) delete[] svw[si][sj];
- delete[] svf[si];
- delete[] svw[si];
- delete[] svs[si];
- }
- delete[] svf;
- delete[] svw;
- delete[] svs;
-}
+);
/*! \brief C++ porting of HJV
*
@@ -1179,72 +123,7 @@ void crsm1(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6) {
void hjv(
double exri, double vk, int &jer, int &lcalc, std::complex<double> &arg,
C1 *c1, C1_AddOns *c1ao, C4 *c4
- ) {
- int nsphmo = c4->nsph - 1;
- int lit = c4->li + c4->li;
- int lmt = c4->li + c4->le;
- const int rfj_size = (lit > lmt) ? lit : lmt;
- const int rfn_size = c4->litpo;
- double *rfj, *rfn;
- rfj = new double[rfj_size]();
- rfn = new double[rfn_size]();
- jer = 0;
- int ivhb = 0;
- for (int nf40 = 1; nf40 <= nsphmo; nf40++) { // GPU portable?
- int nfpo = nf40 + 1;
- for (int ns40 = nfpo; ns40 <= c4->nsph; ns40++) {
- double rx = c1->rxx[nf40 - 1] - c1->rxx[ns40 - 1];
- double ry = c1->ryy[nf40 - 1] - c1->ryy[ns40 - 1];
- double rz = c1->rzz[nf40 - 1] - c1->rzz[ns40 - 1];
- double rr = sqrt(rx * rx + ry * ry + rz * rz);
- double rarg = rr * vk * exri;
- arg = std::complex<double>(rarg, 0.0);
- rbf(lit, rarg, lcalc, rfj);
- if (lcalc < lit) {
- jer = 1;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- rnf(lit, rarg, lcalc, rfn);
- if (lcalc < lit) {
- jer = 2;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- for (int lpo38 = 1; lpo38 <= c4->litpo; lpo38++) {
- double rpart = rfj[lpo38 - 1];
- double ipart = rfn[lpo38 - 1];
- c1ao->vh[lpo38 + ivhb - 1] = std::complex<double>(rpart, ipart);
- }
- ivhb += c4->litpo;
- } // ns40 loop
- } // nf40 loop
- ivhb = 0;
- for (int nf50 = 1; nf50 <= c4->nsph; nf50++) {
- double rx = c1->rxx[nf50 - 1];
- double ry = c1->ryy[nf50 - 1];
- double rz = c1->rzz[nf50 - 1];
- if (!(rx == 0.0 && ry == 0.0 && rz == 0.0)) {
- double rr = sqrt(rx * rx + ry * ry + rz * rz);
- double rarg = rr * vk * exri;
- rbf(lmt, rarg, lcalc, rfj);
- if (lcalc < lmt) {
- jer = 3;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- for (int lpo47 = 1; lpo47 <= c4->lmtpo; lpo47++) {
- c1ao->vj0[lpo47 + ivhb - 1] = rfj[lpo47 - 1];
- }
- }
- ivhb += c4->lmtpo;
- } // nf50 loop
- delete[] rfj;
- delete[] rfn;
-}
+);
/*! \brief C++ porting of LUCIN
*
@@ -1253,110 +132,7 @@ void hjv(
* \param n: `int`
* \param ier: `int &`
*/
-void lucin(std::complex<double> **am, const int nddmst, int n, int &ier) {
- /* NDDMST FIRST DIMENSION OF AM AS DECLARED IN DIMENSION
- * STATEMENT.
- * N NUMBER OF ROWS IN AM.
- * IER IS REPLACED BY 1 FOR SINGULARITY.
- */
- double *v = new double[nddmst];
- std::complex<double> ctemp, cfun;
- std::complex<double> cc0 = std::complex<double>(0.0, 0.0);
- ier = 0;
- int nminus = n - 1;
- for (int i = 1; i <= n; i++) {
- double sum = 0.0;
- for (int j = 1; j <= n; j++) {
- sum += (
- am[i - 1][j - 1].real() * am[i - 1][j - 1].real()
- + am[i - 1][j - 1].imag() * am[i - 1][j - 1].imag()
- );
- } // j1319 loop
- v[i - 1] = 1.0 / sum;
- } // i1309 loop
- // 2. REPLACE AM BY TRIANGULAR MATRICES (L,U) WHERE AM=L*U.
- // REPLACE L(I,I) BY 1/L(I,I), READY FOR SECTION 4.
- // (ROW INTERCHANGES TAKE PLACE, AND THE INDICES OF THE PIVOTAL ROWS
- // ARE PLACED IN V.)
- /* >>> THERE APPEARS TO BE A BUG IN THE FOLLOWING LOOP <<< */
- for (int k = 1; k <= n; k++) {
- int kplus = k + 1;
- int kminus = k - 1;
- int l = k;
- double psqmax = 0.0;
- for (int i = k; i <= n; i++) {
- cfun = cdtp(-am[i - 1][k - 1], am, i, 1, k, kminus);
- ctemp = -cfun;
- am[i - 1][k - 1] = ctemp;
- double psq = v[i - 1] * (ctemp.real() * ctemp.real() + ctemp.imag() * ctemp.imag());
- if (psq > psqmax) {
- psqmax = psq;
- l = i;
- }
- } // i2029 loop
- if (l != k) {
- for (int j = 1; j <= n; j++) {
- ctemp = am[k - 1][j - 1];
- am[k - 1][j - 1] = am[l - 1][j - 1];
- am[l - 1][j - 1] = ctemp;
- } // j2049 loop
- v[l - 1] = v[k - 1];
- }
- // label 2011
- v[k - 1] = 1.0 * l;
- if (psqmax == 0.0) {
- ier = 1;
- delete[] v;
- return;
- }
- ctemp = 1.0 / am[k - 1][k - 1];
- am[k - 1][k - 1] = ctemp;
- if (kplus <= n) {
- for (int j = kplus; j <= n; j++) {
- cfun = cdtp(-am[k - 1][j - 1], am, k, 1, j, kminus);
- am[k - 1][j - 1] = -ctemp * cfun;
- } // j2059 loop
- }
- } // k2019 loop
- // 4. REPLACE AM BY ITS INVERSE AMINV.
- // 4.1 REPLACE L AND U BY THEIR INVERSE LINV AND UINV.
- for (int k = 1; k <= nminus; k++) {
- int kplus = k + 1;
- for (int i = kplus; i <= n; i++) {
- cfun = cdtp(cc0, am, i, k, k, i - k);
- am[i - 1][k - 1] = -am[i - 1][i - 1] * cfun;
- cfun = cdtp(am[k - 1][i - 1], am, k, kplus, i, i - k - 1);
- am[k - 1][i - 1] = -cfun;
- } // i4119 loop
- } // k4109 loop
- // 4.2 FORM AMINV=UINV*LINV.
- for (int k = 1; k <= n; k++) {
- for (int i = 1; i <= n; i++) {
- if (i < k) {
- cfun = cdtp(cc0, am, i, k, k, n - k + 1);
- am[i - 1][k -1] = cfun;
- }
- else {
- cfun = cdtp(am[i - 1][k - 1], am, i, i + 1, k, n - i);
- am[i - 1][k - 1] = cfun;
- }
- } // i4119 loop
- } // k4209 loop
- // 4.3 INTERCHANGE COLUMNS OF AMINV AS SPECIFIED BY V, BUT IN REVERSE
- // ORDER.
- for (int l = 1; l <= n; l++) {
- int k = n - l + 1;
- int kcol = (int)(v[k - 1]);
- if (kcol != k) {
- for (int i = 1; i <= n; i++) {
- ctemp = am[i - 1][k - 1];
- am[i - 1][k - 1] = am[i - 1][kcol - 1];
- am[i - 1][kcol - 1] = ctemp;
- } // i4319 loop
- }
- } // l4309 loop
- delete[] v;
-}
+void lucin(std::complex<double> **am, const int nddmst, int n, int &ier);
/*! \brief C++ porting of MEXTC
*
@@ -1366,55 +142,7 @@ void lucin(std::complex<double> **am, const int nddmst, int n, int &ier) {
* \param cextlr: `double **`
* \param cext: `double **`
*/
-void mextc(double vk, double exri, std::complex<double> **fsac, double **cextlr, double **cext) {
- double fa11r = fsac[0][0].real();
- double fa11i = fsac[0][0].imag();
- double fa21r = fsac[1][0].real();
- double fa21i = fsac[1][0].imag();
- double fa12r = fsac[0][1].real();
- double fa12i = fsac[0][1].imag();
- double fa22r = fsac[1][1].real();
- double fa22i = fsac[1][1].imag();
- cextlr[0][0] = fa11i * 2.0;
- cextlr[0][1] = 0.0;
- cextlr[0][2] = -fa12i;
- cextlr[0][3] = -fa12r;
- cextlr[1][0] = 0.0;
- cextlr[1][1] = fa22i * 2.0;
- cextlr[1][2] = -fa21i;
- cextlr[1][3] = fa21r;
- cextlr[2][0] = -fa21i * 2.0;
- cextlr[2][1] = -fa12i * 2.0;
- cextlr[2][2] = fa11i + fa22i;
- cextlr[2][3] = fa22r - fa11r;
- cextlr[3][0] = fa21r * 2.0;
- cextlr[3][1] = -fa12r * 2.0;
- cextlr[3][2] = fa11r - fa22r;
- cextlr[3][3] = cextlr[2][2];
- cext[0][0] = cextlr[3][3];
- cext[1][1] = cextlr[3][3];
- cext[2][2] = cextlr[3][3];
- cext[2][3] = cextlr[2][3];
- cext[3][2] = cextlr[3][2];
- cext[3][3] = cextlr[3][3];
- cext[0][1] = fa11i - fa22i;
- cext[0][2] = -fa12i - fa21i;
- cext[0][3] = fa21r - fa12r;
- cext[1][0] = cext[0][1];
- cext[1][2] = fa21i - fa12i;
- cext[3][1] = fa12r + fa21r;
- cext[1][3] = -cext[3][1];
- cext[2][0] = cext[0][2];
- cext[2][1] = -cext[1][2];
- cext[3][0] = cext[1][3];
- double ckm = vk / exri;
- for (int i10 = 0; i10 < 4; i10++) {
- for (int j10 = 0; j10 < 4; j10++) {
- cextlr[i10][j10] *= ckm;
- cext[i10][j10] *= ckm;
- }
- }
-}
+void mextc(double vk, double exri, std::complex<double> **fsac, double **cextlr, double **cext);
/*! \brief C++ porting of PCROS
*
@@ -1425,64 +153,7 @@ void mextc(double vk, double exri, std::complex<double> **fsac, double **cextlr,
* \param c1ao: `C1_AddOns *`
* \param c4: `C4 *`
*/
-void pcros(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4) {
- const std::complex<double> cc0(0.0, 0.0);
- std::complex<double> sump, sum1, sum2, sum3, sum4, am, amp, cc, csam;
- const double exdc = exri * exri;
- double ccs = 1.0 / (vk * vk);
- double cccs = ccs / exdc;
- csam = -(ccs / (exri * vk)) * std::complex<double>(0.0, 0.5);
- const double pi4sq = 64.0 * acos(0.0) * acos(0.0);
- double cfsq = 4.0 / (pi4sq *ccs * ccs);
- const int nlemt = c4->nlem + c4->nlem;
- int jpo = 2;
- for (int ipo18 = 1; ipo18 <= 2; ipo18++) {
- if (ipo18 == 2) jpo = 1;
- int ipopt = ipo18 + 2;
- int jpopt = jpo + 2;
- double sum = 0.0;
- sump = cc0;
- sum1 = cc0;
- sum2 = cc0;
- sum3 = cc0;
- sum4 = cc0;
- for (int i12 = 1; i12 <= nlemt; i12++) {
- int i = i12 - 1;
- am = cc0;
- amp = cc0;
- for (int j10 = 1; j10 <= nlemt; j10++) {
- int j = j10 - 1;
- am += (c1ao->am0m[i][j] * c1->w[j][ipo18 - 1]);
- amp += (c1ao->am0m[i][j] * c1->w[j][jpo - 1]);
- } // j10 loop
- sum += (dconjg(am) * am).real();
- sump += (dconjg(amp) * am);
- sum1 += (dconjg(c1->w[i][ipo18 - 1]) * am);
- sum2 += (dconjg(c1->w[i][jpo - 1]) * am);
- sum3 += (c1->w[i][ipopt - 1] * am);
- sum4 += (c1->w[i][jpopt - 1] * am);
- } // i12 loop
- c1ao->scsc[ipo18 - 1] = cccs * sum;
- c1ao->scscp[ipo18 - 1] = cccs * sump;
- c1ao->ecsc[ipo18 - 1] = -cccs * sum1.real();
- c1ao->ecscp[ipo18 - 1] = -cccs * sum2;
- c1ao->fsac[ipo18 - 1][ipo18 - 1] = csam * sum1;
- c1ao->fsac[jpo - 1][ipo18 - 1] = csam * sum2;
- c1ao->sac[ipo18 - 1][ipo18 - 1] = csam * sum3;
- c1ao->sac[jpo - 1][ipo18 - 1] = csam * sum4;
- } // ipo18 loop
- int i = 0;
- for (int ipo1 = 1; ipo1 <= 2; ipo1++) {
- for (int jpo1 = 1; jpo1 <= 2; jpo1++) {
- cc = dconjg(c1ao->sac[jpo1 - 1][ipo1 - 1]);
- for (int ipo2 = 1; ipo2 <= 2; ipo2 ++) {
- for (int jpo2 = 1; jpo2 <= 2; jpo2++) {
- c1ao->vint[i++] = c1ao->sac[jpo2 - 1][ipo2 - 1] * cc * cfsq;
- } // jpo2 loop
- } // ipo2 loop
- } // jpo1 loop
- } // ipo1 loop
-}
+void pcros(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4);
/*! \brief C++ porting of PCRSM0
*
@@ -1493,71 +164,7 @@ void pcros(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4) {
* \param c1ao: `C1_AddOns *`
* \param c4: `C4 *`
*/
-void pcrsm0(double vk, double exri, int inpol, C1 *c1, C1_AddOns *c1ao, C4 *c4) {
- const std::complex<double> cc0(0.0, 0.0);
- const std::complex<double> uim(0.0, 1.0);
- std::complex<double> sum1, sum2, sum3, sum4, sumpd;
- std::complex<double> sums1, sums2, sums3, sums4, csam;
- double exdc = exri * exri;
- double ccs = 4.0 * acos(0.0) / (vk * vk);
- double cccs = ccs / exdc;
- csam = -(ccs / (exri * vk)) * std::complex<double>(0.0, 0.5);
- sum2 = cc0;
- sum3 = cc0;
- for (int i14 = 1; i14 <= c4->nlem; i14++) { // GPU portable?
- int ie = i14 + c4->nlem;
- sum2 += (c1ao->am0m[i14 - 1][i14 - 1] + c1ao->am0m[ie - 1][ie - 1]);
- sum3 += (c1ao->am0m[i14 - 1][ie - 1] + c1ao->am0m[ie - 1][i14 - 1]);
- } // i14 loop
- double sumpi = 0.0;
- sumpd = cc0;
- int nlemt = c4->nlem + c4->nlem;
- for (int i16 = 1; i16 <= nlemt; i16++) {
- for (int j16 = 1; j16 <= c4->nlem; j16++) {
- int je = j16 + c4->nlem;
- double rvalue = (
- dconjg(c1ao->am0m[i16 - 1][j16 - 1]) * c1ao->am0m[i16 - 1][j16 - 1]
- + dconjg(c1ao->am0m[i16 - 1][je - 1]) * c1ao->am0m[i16 - 1][je - 1]
- ).real();
- sumpi += rvalue;
- sumpd += (
- dconjg(c1ao->am0m[i16 - 1][j16 - 1]) * c1ao->am0m[i16 - 1][je - 1]
- + dconjg(c1ao->am0m[i16 - 1][je - 1]) * c1ao->am0m[i16 - 1][j16 - 1]
- );
- } // j16 loop
- } // i16 loop
- if (inpol == 0) {
- sum1 = sum2;
- sum4 = sum3 * uim;
- sum3 = -sum4;
- sums1 = sumpi;
- sums2 = sumpi;
- sums3 = sumpd * uim;
- sums4 = -sums3;
- } else { // label 18
- sum1 = sum2 + sum3;
- sum2 = sum2 - sum3;
- sum3 = cc0;
- sum4 = cc0;
- sums1 = sumpi - sumpd;
- sums2 = sumpi + sumpd;
- sums3 = cc0;
- sums4 = cc0;
- }
- // label 20
- c1ao->ecscm[0] = -cccs * sum2.real();
- c1ao->ecscm[1] = -cccs * sum1.real();
- c1ao->ecscpm[0] = -cccs * sum4;
- c1ao->ecscpm[1] = -cccs * sum3;
- c1ao->fsacm[0][0] = csam * sum2;
- c1ao->fsacm[1][0] = csam * sum4;
- c1ao->fsacm[1][1] = csam * sum1;
- c1ao->fsacm[0][1] = csam * sum3;
- c1ao->scscm[0] = cccs * sums1.real();
- c1ao->scscm[1] = cccs * sums2.real();
- c1ao->scscpm[0] = cccs * sums3;
- c1ao->scscpm[1] = cccs * sums4;
-}
+void pcrsm0(double vk, double exri, int inpol, C1 *c1, C1_AddOns *c1ao, C4 *c4);
/*! \brief C++ porting of POLAR
*
@@ -1573,62 +180,7 @@ void pcrsm0(double vk, double exri, int inpol, C1 *c1, C1_AddOns *c1ao, C4 *c4)
void polar(
double x, double y, double z, double &r, double &cth, double &sth,
double &cph, double &sph
- ) {
- bool onx = (y == 0.0);
- bool ony = (x == 0.0);
- bool onz = (onx && ony);
- double rho = 0.0;
- if (!onz) {
- if (!onx) {
- if (!ony) {
- rho = sqrt(x * x + y * y);
- cph = x / rho;
- sph = y / rho;
- // goes to 25
- } else { // label 20
- rho = (y > 0.0) ? y : -y;
- cph = 0.0;
- sph = (y > 0.0) ? 1.0 : -1.0;
- // goes to 25
- }
- } else { // label 15
- rho = (x > 0.0) ? x : -x;
- cph = (x > 0.0) ? 1.0 : -1.0;
- sph = 0.0;
- // goes to 25
- }
- } else { // label 10
- cph = 1.0;
- sph = 0.0;
- // goes to 25
- }
- // label 25
- if (z == 0.0) {
- if (!onz) {
- r = rho;
- cth = 0.0;
- sth = 1.0;
- // returns
- } else { // label 30
- r = 0.0;
- cth = 1.0;
- sth = 0.0;
- // returns
- }
- } else { // label 35
- if (!onz) {
- r = sqrt(rho * rho + z * z);
- cth = z / r;
- sth = rho / r;
- // returns
- } else { // label 40
- r = (z > 0.0) ? z : -z;
- cth = (z > 0.0) ? 1.0 : -1.0;
- sth = 0.0;
- // returns
- }
- }
-}
+);
/*! \brief C++ porting of R3J000
*
@@ -1636,97 +188,27 @@ void polar(
* \param j3: `int`
* \param c6: `C6 *` Pointer to a C6 instance.
*/
-void r3j000(int j2, int j3, C6 *c6) {
- int jmx = j3 + j2;
- if (jmx <= 0) {
- c6->rac3j[0] = 1.0;
- return;
- }
- int jmn = j3 - j2;
- if (jmn < 0) jmn *= -1;
- int njmo = (jmx - jmn) / 2;
- int jf = jmx + jmx + 1;
- int isn = 1;
- if (jmn % 2 != 0) isn = -1;
- if (njmo <= 0) {
- double sj = 1.0 * jf;
- double cnr = (1 / sqrt(sj)) * isn;
- c6->rac3j[0] = cnr;
- return;
- }
- double sjr = 1.0 * jf;
- int jmxpos = (jmx + 1) * (jmx + 1);
- int jmns = jmn * jmn;
- int j1mo = jmx - 1;
- int j1s = (j1mo + 1) * (j1mo + 1);
- double cj = sqrt(1.0 * (jmxpos - j1s) * (j1s - jmns));
- int j1mos = j1mo * j1mo;
- double cjmo = sqrt(1.0 * (jmxpos - j1mos) * (j1mos - jmns));
- if (njmo <= 1) {
- c6->rac3j[0] = -cj / cjmo;
- double sj = sjr + (c6->rac3j[0] * c6->rac3j[0]) * (jf - 4);
- double cnr = (1.0 / sqrt(sj)) * isn;
- c6->rac3j[1] = cnr;
- c6->rac3j[0] *= cnr;
- return;
- }
- int nj = njmo + 1;
- int nmat = (nj + 1) / 2;
- c6->rac3j[nj - 1] = 1.0;
- c6->rac3j[njmo - 1] = -cj / cjmo;
- if (nmat != njmo) {
- int nbr = njmo - nmat;
- for (int ibr45 = 1; ibr45 <= nbr; ibr45++) {
- int irr = nj - ibr45;
- jf -= 4;
- j1mo -= 2;
- j1s = (j1mo + 1) * (j1mo + 1);
- cj = sqrt(1.0 * (jmxpos - j1s) * (j1s - jmns));
- j1mos = j1mo * j1mo;
- cjmo = sqrt(1.0 * (jmxpos - j1mos) * (j1mos - jmns));
- c6->rac3j[irr - 2] = c6->rac3j[irr - 1] * (-cj / cjmo);
- sjr = sjr + (c6->rac3j[irr - 1] * c6->rac3j[irr - 1]) * jf;
- }
- }
- // label 50
- double racmat = c6->rac3j[nmat - 1];
- sjr = sjr + (racmat * racmat) * (jf - 4);
- c6->rac3j[0] = 1.0;
- jf = jmn + jmn + 1;
- double sjl = 1.0 * jf;
- int j1pt = jmn + 2;
- int j1pos = (j1pt - 1) * (j1pt - 1);
- double cjpo = sqrt(1.0 * (jmxpos - j1pos) * (j1pos - jmns));
- int j1pts = j1pt * j1pt;
- double cjpt = sqrt(1.0 * (jmxpos - j1pts) * (j1pts - jmns));
- c6->rac3j[1] = -cjpo / cjpt;
- int nmatmo = nmat - 1;
- if (nmatmo >= 2) {
- for (int irl70 = 2; irl70 <= nmatmo; irl70++) {
- jf += 4;
- j1pt += 2;
- j1pos = (j1pt - 1) * (j1pt - 1);
- cjpo = sqrt(1.0 * (jmxpos - j1pos) * (j1pos - jmns));
- j1pts = j1pt * j1pt;
- cjpt = sqrt(1.0 * (jmxpos - j1pts) * (j1pts - jmns));
- c6->rac3j[irl70] = c6->rac3j[irl70 - 1] * (-cjpo / cjpt);
- sjl = sjl + (c6->rac3j[irl70 - 1] * c6->rac3j[irl70 - 1]) * jf;
- }
- }
- // label 75
- double ratrac = racmat / c6->rac3j[nmat - 1];
- double rats = ratrac * ratrac;
- double sj = sjr + sjl * rats;
- c6->rac3j[nmat - 1] = racmat;
- double cnr = (1.0 / sqrt(sj)) * isn;
- for (int irr80 = nmat; irr80 <= nj; irr80++) {
- c6->rac3j[irr80 - 1] *= cnr;
- }
- double cnl = cnr * ratrac;
- for (int irl85 = 1; irl85 <= nmatmo; irl85++) {
- c6->rac3j[irl85 - 1] *= cnl;
- }
-}
+void r3j000(int j2, int j3, C6 *c6);
+
+/*! \brief C++ porting of R3JJR
+ *
+ * \param j2: `int`
+ * \param j3: `int`
+ * \param m2: `int`
+ * \param m3: `int`
+ * \param c6: `C6 *`
+ */
+void r3jjr(int j2, int j3, int m2, int m3, C6 *c6);
+
+/*! \brief C++ porting of R3JMR
+ *
+ * \param j1: `int`
+ * \param j2: `int`
+ * \param j3: `int`
+ * \param m1: `int`
+ * \param c6: `C6 *`
+ */
+void r3jmr(int j1, int j2, int j3, int m1, C6 *c6);
/*! \brief C++ porting of RABA
*
@@ -1741,133 +223,7 @@ void r3j000(int j2, int j3, C6 *c6) {
void raba(
int le, std::complex<double> **am0m, std::complex<double> **w, double **tqce,
std::complex<double> **tqcpe, double **tqcs, std::complex<double> **tqcps
- ) {
- std::complex<double> **a, **ctqce, **ctqcs;
- std::complex<double> acw, acwp, aca, acap, c1, c2, c3;
- const std::complex<double> cc0(0.0, 0.0);
- const std::complex<double> uim(0.0, 1.0);
- const double sq2i = 1.0 / sqrt(2.0);
- int nlem = le * (le + 2);
- const int nlemt = nlem + nlem;
- a = new std::complex<double>*[nlemt];
- ctqce = new std::complex<double>*[2];
- ctqcs = new std::complex<double>*[2];
- for (int ai = 0; ai < nlemt; ai++) a[ai] = new std::complex<double>[2]();
- for (int ci = 0; ci < 2; ci++) {
- ctqce[ci] = new std::complex<double>[3]();
- ctqcs[ci] = new std::complex<double>[3]();
- }
- for (int i20 = 1; i20 <= nlemt; i20++) {
- int i = i20 - 1;
- c1 = cc0;
- c2 = cc0;
- for (int j10 = 1; j10 <= nlemt; j10++) {
- int j = j10 - 1;
- c1 += (am0m[i][j] * w[j][0]);
- c2 += (am0m[i][j] * w[j][1]);
- } // j10 loop
- a[i][0] = c1;
- a[i][1] = c2;
- } //i20 loop
- int jpo = 2;
- for (int ipo70 = 1; ipo70 <= 2; ipo70++) {
- if (ipo70 == 2) jpo = 1;
- int ipo = ipo70 - 1;
- ctqce[ipo][0] = cc0;
- ctqce[ipo][1] = cc0;
- ctqce[ipo][2] = cc0;
- tqcpe[ipo][0] = cc0;
- tqcpe[ipo][1] = cc0;
- tqcpe[ipo][2] = cc0;
- ctqcs[ipo][0] = cc0;
- ctqcs[ipo][1] = cc0;
- ctqcs[ipo][2] = cc0;
- tqcps[ipo][0] = cc0;
- tqcps[ipo][1] = cc0;
- tqcps[ipo][2] = cc0;
- for (int l60 = 1; l60 <= le; l60 ++) {
- int lpo = l60 + 1;
- int il = l60 * lpo;
- int ltpo = l60 + lpo;
- for (int im60 = 1; im60 <= ltpo; im60++) {
- int m = im60 - lpo;
- int i = m + il;
- int ie = i + nlem;
- int mmmu = m + 1;
- int mmmmu = (mmmu > 0) ? mmmu : -mmmu;
- double rmu = 0.0;
- if (mmmmu <= l60) {
- int immu = mmmu + il;
- int immue = immu + nlem;
- rmu = -sqrt(1.0 * (l60 + mmmu) * (l60 - m)) * sq2i;
- acw = dconjg(a[i - 1][ipo]) * w[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * w[immue - 1][ipo];
- acwp = dconjg(a[i - 1][ipo]) * w[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * w[immue - 1][jpo - 1];
- aca = dconjg(a[i - 1][ipo]) * a[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * a[immue - 1][ipo];
- acap = dconjg(a[i - 1][ipo]) * a[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * a[immue - 1][jpo - 1];
- ctqce[ipo][0] += (acw * rmu);
- tqcpe[ipo][0] += (acwp * rmu);
- ctqcs[ipo][0] += (aca * rmu);
- tqcps[ipo][0] += (acap * rmu);
- }
- // label 30
- rmu = -1.0 * m;
- acw = dconjg(a[i - 1][ipo]) * w[i - 1][ipo] + dconjg(a[ie - 1][ipo]) * w[ie - 1][ipo];
- acwp = dconjg(a[i - 1][ipo]) * w[i - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * w[ie - 1][jpo - 1];
- aca = dconjg(a[i - 1][ipo]) * a[i - 1][ipo] + dconjg(a[ie - 1][ipo]) * a[ie - 1][ipo];
- acap = dconjg(a[i - 1][ipo]) * a[i - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * a[ie - 1][jpo - 1];
- ctqce[ipo][1] += (acw * rmu);
- tqcpe[ipo][1] += (acwp * rmu);
- ctqcs[ipo][1] += (aca * rmu);
- tqcps[ipo][1] += (acap * rmu);
- mmmu = m - 1;
- mmmmu = (mmmu > 0) ? mmmu : -mmmu;
- if (mmmmu <= l60) {
- int immu = mmmu + il;
- int immue = immu + nlem;
- rmu = sqrt(1.0 * (l60 - mmmu) * (l60 + m)) * sq2i;
- acw = dconjg(a[i - 1][ipo]) * w[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * w[immue - 1][ipo];
- acwp = dconjg(a[i - 1][ipo]) * w[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * w[immue - 1][jpo - 1];
- aca = dconjg(a[i - 1][ipo]) * a[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * a[immue - 1][ipo];
- acap = dconjg(a[i - 1][ipo]) * a[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * a[immue - 1][jpo - 1];
- ctqce[ipo][2] += (acw * rmu);
- tqcpe[ipo][2] += (acwp * rmu);
- ctqcs[ipo][2] += (aca * rmu);
- tqcps[ipo][2] += (acap * rmu);
- } // ends im60 loop
- } // im60 loop
- } // l60 loop
- } // ipo70 loop
- for (int ipo78 = 1; ipo78 <= 2; ipo78++) {
- int ipo = ipo78 - 1;
- tqce[ipo][0] = (ctqce[ipo][0] - ctqce[ipo][2]).real() * sq2i;
- tqce[ipo][1] = ((ctqce[ipo][0] + ctqce[ipo][2]) * uim).real() * sq2i;
- tqce[ipo][2] = ctqce[ipo][1].real();
- c1 = tqcpe[ipo][0];
- c2 = tqcpe[ipo][1];
- c3 = tqcpe[ipo][2];
- tqcpe[ipo][0] = (c1 - c3) * sq2i;
- tqcpe[ipo][1] = (c1 + c3) * (uim * sq2i);
- tqcpe[ipo][2] = c2;
- tqcs[ipo][0] = -sq2i * (ctqcs[ipo][0] - ctqcs[ipo][2]).real();
- tqcs[ipo][1] = -sq2i * ((ctqcs[ipo][0] + ctqcs[ipo][2]) * uim).real();
- tqcs[ipo][2] = -1.0 * ctqcs[ipo][1].real();
- c1 = tqcps[ipo][0];
- c2 = tqcps[ipo][1];
- c3 = tqcps[ipo][2];
- tqcps[ipo][0] = -(c1 - c3) * sq2i;
- tqcps[ipo][1] = -(c1 + c3) * (uim * sq2i);
- tqcps[ipo][2] = -c2;
- } // ipo78 loop
- // Clean memory
- for (int ai = 0; ai < nlemt; ai++) delete[] a[ai];
- for (int ci = 0; ci < 2; ci++) {
- delete[] ctqce[ci];
- delete[] ctqcs[ci];
- }
- delete[] a;
- delete[] ctqce;
- delete[] ctqcs;
-}
+);
/*! \brief C++ porting of RFTR
*
@@ -1890,17 +246,7 @@ void rftr(
double *u, double *up, double *un, double *gapv, double extins, double scatts,
double &rapr, double &cosav, double &fp, double &fn, double &fk, double &fx,
double &fy, double &fz
- ) {
- fk = u[0] * gapv[0] + u[1] * gapv[1] + u[2] * gapv[2];
- rapr = extins - fk;
- cosav = fk / scatts;
- fp = -(up[0] * gapv[0] + up[1] * gapv[1] + up[2] * gapv[2]);
- fn = -(un[0] * gapv[0] + un[1] * gapv[1] + un[2] * gapv[2]);
- fk = rapr;
- fx = u[0] * extins - gapv[0];
- fy = u[1] * extins - gapv[1];
- fz = u[2] * extins - gapv[2];
-}
+);
/*! \brief C++ porting of SCR0
*
@@ -1911,51 +257,7 @@ void rftr(
* \param c3: `C3 *` Pointer to a C3 instance.
* \param c4: `C4 *` Pointer to a C4 structure.
*/
-void scr0(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 * c4) {
- const std::complex<double> cc0(0.0, 0.0);
- double exdc = exri * exri;
- double ccs = 4.0 * acos(0.0) / (vk * vk);
- double cccs = ccs / exdc;
- std::complex<double> sum21, rm, re, csam;
- csam = -(ccs / (exri * vk)) * std::complex<double>(0.0, 0.5);
- //double scs = 0.0, ecs = 0.0, acs = 0.0;
- c3->scs = 0.0;
- c3->ecs = 0.0;
- c3->acs = 0.0;
- c3->tfsas = cc0;
- for (int i14 = 1; i14 <= c4->nsph; i14++) {
- int iogi = c1->iog[i14 - 1];
- if (iogi >= i14) {
- double sums = 0.0;
- sum21 = cc0;
- for (int l10 = 1; l10 <= c4->li; l10++) {
- double fl = 1.0 * (l10 + l10 + 1);
- rm = 1.0 / c1->rmi[l10 - 1][i14 - 1];
- re = 1.0 / c1->rei[l10 - 1][i14 - 1];
- double rvalue = (dconjg(rm) * rm + dconjg(re) * re).real() * fl;
- sums += rvalue;
- sum21 += ((rm + re) * fl);
- } // l10 loop
- sum21 *= -1.0;
- double scasec = cccs * sums;
- double extsec = -cccs * sum21.real();
- double abssec = extsec - scasec;
- c1->sscs[i14 - 1] = scasec;
- c1->sexs[i14 - 1] = extsec;
- c1->sabs[i14 - 1] = abssec;
- double gcss = c1->gcsv[i14 - 1];
- c1->sqscs[i14 - 1] = scasec / gcss;
- c1->sqexs[i14 - 1] = extsec / gcss;
- c1->sqabs[i14 - 1] = abssec / gcss;
- c1->fsas[i14 - 1] = sum21 * csam;
- }
- // label 12
- c3->scs += c1->sscs[iogi - 1];
- c3->ecs += c1->sexs[iogi - 1];
- c3->acs += c1->sabs[iogi - 1];
- c3->tfsas += c1->fsas[iogi - 1];
- } // i14 loop
-}
+void scr0(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 * c4);
/*! \brief C++ porting of SCR2
*
@@ -1970,85 +272,8 @@ void scr0(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 * c4) {
*/
void scr2(
double vk, double vkarg, double exri, double *duk, C1 *c1, C1_AddOns *c1ao,
- C3 *c3, C4 *c4) {
- const std::complex<double> cc0(0.0, 0.0);
- const std::complex<double> uim(0.0, 1.0);
- std::complex<double> s11, s21, s12, s22, rm, re, csam, cph, phas, cc;
- double ccs = 1.0 / (vk * vk);
- csam = -(ccs / (exri * vk)) * std::complex<double>(0.0, 0.5);
- const double pi4sq = 64.0 * acos(0.0) * acos(0.0);
- double cfsq = 4.0 / (pi4sq * ccs * ccs);
- cph = uim * exri * vkarg;
- int ls = (c4->li < c4->le) ? c4->li : c4->le;
- c3->tsas[0][0] = cc0;
- c3->tsas[1][0] = cc0;
- c3->tsas[0][1] = cc0;
- c3->tsas[1][1] = cc0;
- for (int i14 = 1; i14 <= c4->nsph; i14++) {
- int i = i14 - 1;
- int iogi = c1->iog[i14 - 1];
- if (iogi >= i14) {
- int k = 0;
- s11 = cc0;
- s21 = cc0;
- s12 = cc0;
- s22 = cc0;
- for (int l10 = 1; l10 <= ls; l10++) {
- int l = l10 - 1;
- rm = 1.0 / c1->rmi[l][i];
- re = 1.0 / c1->rei[l][i];
- int ltpo = l10 + l10 + 1;
- for (int im10 = 1; im10 <= ltpo; im10++) {
- k++;
- int ke = k + c4->nlem;
- s11 -= (c1->w[k - 1][2] * c1->w[k - 1][0] * rm + c1->w[ke - 1][2] * c1->w[ke - 1][0] * re);
- s21 -= (c1->w[k - 1][3] * c1->w[k - 1][0] * rm + c1->w[ke - 1][3] * c1->w[ke - 1][0] * re);
- s12 -= (c1->w[k - 1][2] * c1->w[k - 1][1] * rm + c1->w[ke - 1][2] * c1->w[ke - 1][1] * re);
- s22 -= (c1->w[k - 1][3] * c1->w[k - 1][1] * rm + c1->w[ke - 1][3] * c1->w[ke - 1][1] * re);
- } // im10 loop
- } // l10 loop
- c1->sas[i][0][0] = s11 * csam;
- c1->sas[i][1][0] = s21 * csam;
- c1->sas[i][0][1] = s12 * csam;
- c1->sas[i][1][1] = s22 * csam;
- }
- // label 12
- phas = exp(cph * (duk[0] * c1->rxx[i] + duk[1] * c1->ryy[i] + duk[2] * c1->rzz[i]));
- c3->tsas[0][0] += (c1->sas[iogi - 1][0][0] * phas);
- c3->tsas[1][0] += (c1->sas[iogi - 1][1][0] * phas);
- c3->tsas[0][1] += (c1->sas[iogi - 1][0][1] * phas);
- c3->tsas[1][1] += (c1->sas[iogi - 1][1][1] * phas);
- } // i14 loop
- for (int i24 = 1; i24 <= c4->nsph; i24++) {
- int iogi = c1->iog[i24 - 1];
- if (iogi >= i24) {
- int j = 0;
- for (int ipo1 = 1; ipo1 <=2; ipo1++) {
- for (int jpo1 = 1; jpo1 <= 2; jpo1++) {
- cc = dconjg(c1->sas[i24 - 1][jpo1 - 1][ipo1 - 1]);
- for (int ipo2 = 1; ipo2 <= 2; ipo2++) {
- for (int jpo2 = 1; jpo2 <= 2; jpo2++) {
- j++;
- c1ao->vints[i24 - 1][j - 1] = c1->sas[i24 - 1][jpo2 - 1][ipo2 - 1] * cc * cfsq;
- } // jpo2 loop
- } // ipo2 loop
- } // jpo1 loop
- } // ipo1 loop
- }
- } // i24 loop
- int j = 0;
- for (int ipo1 = 1; ipo1 <=2; ipo1++) {
- for (int jpo1 = 1; jpo1 <= 2; jpo1++) {
- cc = dconjg(c3->tsas[jpo1 - 1][ipo1 - 1]);
- for (int ipo2 = 1; ipo2 <= 2; ipo2++) {
- for (int jpo2 = 1; jpo2 <= 2; jpo2++) {
- j++;
- c1ao->vintt[j - 1] = c3->tsas[jpo2 - 1][ipo2 - 1] * cc * cfsq;
- } // jpo2 loop
- } // ipo2 loop
- } // jpo1 loop
- } // ipo1 loop
-}
+ C3 *c3, C4 *c4
+);
/*! \brief C++ porting of STR
*
@@ -2059,81 +284,7 @@ void scr2(
* \param c4: `C4 *` Pointer to a C4 structure.
* \param c6: `C6 *` Pointer to a C6 instance.
*/
-void str(double **rcf, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 *c4, C6 *c6) {
- std::complex<double> *ylm;
- const double pi = acos(-1.0);
- c3->gcs = 0.0;
- double gcss = 0.0;
- for (int i18 = 1; i18 <= c4->nsph; i18++) {
- int iogi = c1->iog[i18 - 1];
- if (iogi >= i18) {
- gcss = pi * c1->ros[i18 - 1] * c1->ros[i18 - 1];
- c1->gcsv[i18 - 1] = gcss;
- int nsh = c1->nshl[i18 - 1];
- for (int j16 = 1; j16 <= nsh; j16++) {
- c1->rc[i18 - 1][j16 - 1] = rcf[i18 - 1][j16 - 1] * c1->ros[i18 - 1];
- } // j16 loop
- }
- c3->gcs += gcss;
- } // i18 loop
- int ylm_size = (c4->litpos > c4->lmtpos) ? c4->litpos : c4->lmtpos;
- ylm = new std::complex<double>[ylm_size]();
- int i = 0;
- for (int l1po28 = 1; l1po28 <= c4->lmpo; l1po28++) {
- int l1 = l1po28 - 1;
- for (int l2 = 1; l2 <= c4->lm; l2++) {
- r3j000(l1, l2, c6);
- c1ao->ind3j[l1po28 - 1][l2 - 1] = i;
- int lmnpo = (l2 > l1) ? l2 - l1 + 1 : l1 - l2 + 1;
- int lmxpo = l2 + l1 + 1;
- int lpo28 = lmnpo;
- int il = 0;
- while (lpo28 <= lmxpo) {
- i++;
- il++;
- c1ao->v3j0[i - 1] = c6->rac3j[il - 1];
- lpo28 += 2;
- }
- } // l2 loop
- } // l1po28 loop
- int nsphmo = c4->nsph - 1;
- int lit = c4->li + c4->li;
- int ivy = 0;
- for (int nf40 = 1; nf40 <= nsphmo; nf40++) { // GPU portable?
- int nfpo = nf40 + 1;
- for (int ns40 = nfpo; ns40 <= c4->nsph; ns40++) {
- double rx = c1->rxx[nf40 - 1] - c1->rxx[ns40 - 1];
- double ry = c1->ryy[nf40 - 1] - c1->ryy[ns40 - 1];
- double rz = c1->rzz[nf40 - 1] - c1->rzz[ns40 - 1];
- double rr = 0.0;
- double crth = 0.0, srth = 0.0, crph = 0.0, srph = 0.0;
- polar(rx, ry, rz, rr, crth, srth, crph, srph);
- sphar(crth, srth, crph, srph, lit, ylm);
- for (int iv38 = 1; iv38 <= c4->litpos; iv38++) {
- c1ao->vyhj[iv38 + ivy - 1] = dconjg(ylm[iv38 - 1]);
- } // iv38 loop
- ivy += c4->litpos;
- } // ns40 loop
- } // nf40 loop
- int lmt = c4->li + c4->le;
- ivy = 0;
- for (int nf50 = 1; nf50 <= c4->nsph; nf50++) {
- double rx = c1->rxx[nf50 - 1];
- double ry = c1->ryy[nf50 - 1];
- double rz = c1->rzz[nf50 - 1];
- if (rx != 0.0 || ry != 0.0 || rz != 0.0) {
- double rr = 0.0;
- double crth = 0.0, srth = 0.0, crph = 0.0, srph = 0.0;
- polar(rx, ry, rz, rr, crth, srth, crph, srph);
- sphar(crth, srth, crph, srph, lmt, ylm);
- for (int iv48 = 1; iv48 <= c4->lmtpos; iv48++) {
- c1ao->vyj0[iv48 + ivy - 1] = dconjg(ylm[iv48 - 1]);
- } // iv48 loop
- }
- ivy += c4->lmtpos;
- } // nf50 loop
- delete[] ylm;
-}
+void str(double **rcf, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 *c4, C6 *c6);
/*! \brief C++ porting of TQR
*
@@ -2152,14 +303,7 @@ void str(double **rcf, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 *c4, C6 *c6) {
void tqr(
double *u, double *up, double *un, double *tqev, double *tqsv, double &tep,
double &ten, double &tek, double &tsp, double &tsn, double &tsk
- ) {
- tep = up[0] * tqev[0] + up[1] * tqev[1] + up[2] * tqev[2];
- ten = un[0] * tqev[0] + un[1] * tqev[1] + un[2] * tqev[2];
- tek = u[0] * tqev[0] + u[1] * tqev[1] + u[2] * tqev[2];
- tsp = up[0] * tqsv[0] + up[1] * tqsv[1] + up[2] * tqsv[2];
- tsn = un[0] * tqsv[0] + un[1] * tqsv[1] + un[2] * tqsv[2];
- tsk = u[0] * tqsv[0] + u[1] * tqsv[1] + u[2] * tqsv[2];
-}
+);
/*! \brief C++ porting of ZTM
*
@@ -2170,98 +314,6 @@ void tqr(
* \param c6: `C6 *` Pointer to a C6 instance.
* \param c9: `C9 *` Pointer to a C9 instance.
*/
-void ztm(std::complex<double> **am, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6, C9 * c9) {
- std::complex<double> gie, gle, a1, a2, a3, a4, sum1, sum2, sum3, sum4;
- const std::complex<double> cc0(0.0, 0.0);
- int ndi = c4->nsph * c4->nlim;
- int i2 = 0;
- for (int n2 = 1; n2 <= c4->nsph; n2++) { // GPU portable?
- for (int l2 = 1; l2 <= c4->li; l2++) {
- int l2tpo = l2 + l2 + 1;
- int m2 = -l2 - 1;
- for (int im2 = 1; im2 <= l2tpo; im2++) {
- m2++;
- i2++;
- int i3 = 0;
- for (int l3 = 1; l3 <= c4->le; l3++) {
- int l3tpo = l3 + l3 + 1;
- int m3 = -l3 - 1;
- for (int im3 = 1; im3 <= l3tpo; im3++) {
- m3++;
- i3++;
- c9->gis[i2 - 1][i3 - 1] = ghit(2, 0, n2, l2, m2, l3, m3, c1, c1ao, c4, c6);
- c9->gls[i2 - 1][i3 - 1] = ghit(2, 1, n2, l2, m2, l3, m3, c1, c1ao, c4, c6);
- } // im3 loop
- } // l3 loop
- } // im2 loop
- } // l2 loop
- } // n2 loop
- for (int i1 = 1; i1 <= ndi; i1++) { // GPU portable?
- int i1e = i1 + ndi;
- for (int i3 = 1; i3 <= c4->nlem; i3++) {
- int i3e = i3 + c4->nlem;
- sum1 = cc0;
- sum2 = cc0;
- sum3 = cc0;
- sum4 = cc0;
- for (int i2 = 1; i2 <= ndi; i2++) {
- int i2e = i2 + ndi;
- gie = c9->gis[i2 - 1][i3 - 1];
- gle = c9->gls[i2 - 1][i3 - 1];
- a1 = am[i1 - 1][i2 - 1];
- a2 = am[i1 - 1][i2e - 1];
- a3 = am[i1e - 1][i2 - 1];
- a4 = am[i1e - 1][i2e - 1];
- sum1 += (a1 * gie + a2 * gle);
- sum2 += (a1 * gle + a2 * gie);
- sum3 += (a3 * gie + a4 * gle);
- sum4 += (a3 * gle + a4 * gie);
- } // i2 loop
- c9->sam[i1 - 1][i3 - 1] = sum1;
- c9->sam[i1 - 1][i3e - 1] = sum2;
- c9->sam[i1e - 1][i3 - 1] = sum3;
- c9->sam[i1e - 1][i3e - 1] = sum4;
- } // i3 loop
- } // i1 loop
- for (int i1 = 1; i1 <= ndi; i1++) {
- for (int i0 = 1; i0 <= c4->nlem; i0++) {
- c9->gis[i1 - 1][i0 - 1] = dconjg(c9->gis[i1 - 1][i0 - 1]);
- c9->gls[i1 - 1][i0 - 1] = dconjg(c9->gls[i1 - 1][i0 - 1]);
- } // i0 loop
- } // i1 loop
- int nlemt = c4->nlem + c4->nlem;
- for (int i0 = 1; i0 <= c4->nlem; i0++) {
- int i0e = i0 + c4->nlem;
- for (int i3 = 1; i3 <= nlemt; i3++) {
- sum1 = cc0;
- sum2 = cc0;
- for (int i1 = 1; i1 <= ndi; i1 ++) {
- int i1e = i1 + ndi;
- a1 = c9->sam[i1 - 1][i3 - 1];
- a2 = c9->sam[i1e - 1][i3 - 1];
- gie = c9->gis[i1 - 1][i0 - 1];
- gle = c9->gls[i1 - 1][i0 - 1];
- sum1 += (a1 * gie + a2 * gle);
- sum2 += (a1 * gle + a2 * gie);
- } // i1 loop
- c1ao->am0m[i0 - 1][i3 - 1] = -sum1;
- c1ao->am0m[i0e - 1][i3 - 1] = -sum2;
- } // i3 loop
- } // i0 loop
-}
-
-/*! \brief Sum all the elements of a matrix (debug function).
- *
- * \param mat: Matrix of complex.
- * \param rows: `int`
- * \param cols: `int`
- */
-std::complex<double> summat(std::complex<double> **mat, int rows, int cols) {
- std::complex<double> result(0.0, 0.0);
- for (int i = 0; i < rows; i++) {
- for (int j = 0; j < cols; j++) result += mat[i][j];
- }
- return result;
-}
+void ztm(std::complex<double> **am, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6, C9 * c9);
#endif
diff --git a/src/include/file_io.h b/src/include/file_io.h
index 24f2c5f0cff1165afacbea0b5d2ac443fd0f6df7..8c228098e872d5941bb7b9b9f51ca3576ffa9b71 100644
--- a/src/include/file_io.h
+++ b/src/include/file_io.h
@@ -1,43 +1,140 @@
/*! \file file_io.h
*
- * C++ wrapper of FORTRAN I/O operations with files.
+ * \brief Library to handle I/O operations with files.
*/
+#ifndef INCLUDE_FILE_IO_H_
+#define INCLUDE_FILE_IO_H_
-/*! \brief Open a file for subsequent access.
+/*! \class FileSchema
*
- * \param uid: `int*` Pointer to the unit ID to be associated to the file.
- * \param name: `char*` C-string for file name (max. length of 63).
- * \param sta: `char*` C-string for file status (max. length of 7).
- * \param mode: `char*` C-string for access mode (max. length of 11).
- */
-extern "C" void open_file_(int* uid, const char* name, const char* sta, const char* mode);
-/*! \brief Close a previously opened file.
- *
- * \param uid: `int*` Pointer to the unit ID of the file.
- */
-extern "C" void close_file_(int* uid);
-/*! \brief Read an integer value from a file.
- *
- * \param uid: `int*` Pointer to the unit ID of the file.
- * \param value: `int*` Pointer of the variable to be updated.
- */
-extern "C" void read_int_(int* uid, int* value);
-/*! \brief Write a complex value to a file.
+ * \brief File content descriptor.
*
- * \param uid: `int*` Pointer to the unit ID of the file.
- * \param real: `double*` Pointer to the real part of the value.
- * \param imag: `double*` Pointer to the imaginary part of the value.
+ * Accessing binary files requires detailed knowledge of their contents. The `FileSchema`
+ * class is intended to encapsulate this information and use it as a wrapper to control
+ * I/O operations towards different file formats. Any file can be thought of as a sequence
+ * of records, which may further contain arbitrarily complex structures. By describing the
+ * structure of records, it is possible to support virtually any type of format.
*/
-extern "C" void write_complex_(int* uid, double* real, double* imag);
-/*! \brief Write a double precision float value to a file.
+class FileSchema {
+ protected:
+ //! \brief Number of records conained in the file.
+ int num_records;
+ //! \brief Array of record names.
+ std::string *record_names;
+ //! \brief Array of record descriptors.
+ std::string *record_types;
+
+ public:
+ /*! \brief FileSchema instance constructor.
+ *
+ * \param num_rec: `int` Number of records in the file.
+ * \param rec_types: `string *` Description of the records in the file.
+ */
+ FileSchema(int num_rec, std::string *rec_types, std::string *rec_names=NULL);
+
+ /*! \brief FileSchema instance destroyer.
+ */
+ ~FileSchema();
+
+ /*! \brief Get the number of records in file.
+ *
+ * \return num_records: `int` The number of records contained in the file.
+ */
+ int get_record_number() { return num_records; }
+
+ /*! \brief Get a copy of the record types.
+ *
+ * \return rec_types: `string *` A new vector of strings with description of records.
+ */
+ std::string *get_record_names();
+ /*! \brief Get a copy of the record names.
+ *
+ * \return rec_names: `string *` A new vector of strings with record names.
+ */
+ std::string *get_record_types();
+};
+
+/*! \class HDFFile
*
- * \param uid: `int*` Pointer to the unit ID of the file.
- * \param value: `double*` Pointer to the variable to be written.
- */
-extern "C" void write_double_(int* uid, double* value);
-/*! \brief Write an integer value to a file.
+ * \brief HDF5 I/O wrapper class.
*
- * \param uid: `int*` Pointer to the unit ID of the file.
- * \param value: `int*` Pointer to the variable to be written.
+ * This class manages I/O operations toward HDF5 format files.
*/
-extern "C" void write_int_(int* uid, int* value);
+class HDFFile {
+ protected:
+ //! \brief Identifier list.
+ List<hid_t> *id_list;
+ //! \brief Name of the file.
+ std::string file_name;
+ //! \brief Flag for the open file status.
+ bool file_open_flag;
+ //! File identifier handle.
+ hid_t file_id;
+ //! Return status of the last operation.
+ herr_t status;
+
+ public:
+ /*! \brief HDFFile instance constructor.
+ *
+ * \param name: `string` Name of the file.
+ * \param flags: `unsigned int` File access flags (default is `H5F_ACC_EXCL`).
+ * \param fcpl_id: `hid_t` File creation property list identifier (default is `H5P_DEFAULT`).
+ * \param fapl_id: `hid_t` File access property list identifier (default is `H5P_DEFAULT`).
+ */
+ HDFFile(
+ std::string name, unsigned int flags = H5F_ACC_EXCL,
+ hid_t fcpl_id = H5P_DEFAULT, hid_t fapl_id = H5P_DEFAULT
+ );
+
+ /*! \brief HDFFile instance destroyer.
+ */
+ ~HDFFile();
+
+ /*! \brief Close the current file.
+ */
+ herr_t close();
+
+ /*! \brief Create an empty file from a `FileSchema` instance.
+ *
+ * \param schema: `FileSchema &` Reference to `FileSchema` instance.
+ * \param name: `string` Name of the file.
+ * \param flags: `unsigned int` File access flags (default is `H5F_ACC_EXCL`).
+ * \param fcpl_id: `hid_t` File creation property list identifier (default is `H5P_DEFAULT`).
+ * \param fapl_id: `hid_t` File access property list identifier (default is `H5P_DEFAULT`).
+ * \return hdf_file: `HDFFile *` Pointer to a new, open HDF5 file.
+ */
+ static HDFFile* from_schema(
+ FileSchema &schema, std::string name, unsigned int flags = H5F_ACC_EXCL,
+ hid_t fcpl_id = H5P_DEFAULT, hid_t fapl_id = H5P_DEFAULT
+ );
+
+ /*! \brief Get current status.
+ */
+ hid_t get_file_id() { return file_id; }
+
+ /*! \brief Get current status.
+ */
+ herr_t get_status() { return status; }
+
+ /*! \brief Check whether the attached file is currently open.
+ */
+ bool is_open() { return file_open_flag; }
+
+ /*! \brief Write data to attached file.
+ *
+ * \param dataset_name: `string` Name of the dataset to write to.
+ * \param data_type: `string` Memory data type identifier.
+ * \param buffer: `hid_t` Starting address of the memory sector to be written.
+ * \param mem_space_id: `hid_t` Memory data space identifier (defaults to `H5S_ALL`).
+ * \param file_space_id: `hid_t` File space identifier (defaults to `H5S_ALL`).
+ * \param dapl_id: `hid_t` Data access property list identifier (defaults to `H5P_DEFAULT`).
+ * \param dxpl_id: `hid_t` Data transfer property list identifier (defaults to `H5P_DEFAULT`).
+ * \return status: `herr_t` Exit status of the operation.
+ */
+ herr_t write(
+ std::string dataset_name, std::string data_type, const void *buffer,
+ hid_t mem_space_id=H5S_ALL, hid_t file_space_id=H5S_ALL,
+ hid_t dapl_id=H5P_DEFAULT, hid_t dxpl_id=H5P_DEFAULT
+ );
+};
+#endif
diff --git a/src/include/sph_subs.h b/src/include/sph_subs.h
index 21eba3ecdb7ce3d0e2a87bf3c8454a378aeb8e26..8adc50d077947531c3bcbadb1f01b8854de1176f 100644
--- a/src/include/sph_subs.h
+++ b/src/include/sph_subs.h
@@ -2,400 +2,156 @@
*
* \brief C++ porting of SPH functions and subroutines.
*
- * Remember that FORTRAN passes arguments by reference, so, every time we use
- * a subroutine call, we need to add a referencing layer to the C++ variable.
- * All the functions defined below need to be properly documented and ported
- * to C++.
- *
- * Currently, only basic documenting information about functions and parameter
- * types are given, to avoid doxygen warning messages.
+ * This library includes a collection of functions that are used to solve the
+ * scattering problem in the case of a single sphere. Some of these functions
+ * are also generalized to the case of clusters of spheres. In most cases, the
+ * results of calculations do not fall back to fundamental data types. They are
+ * rather multi-component structures. In order to manage access to such variety
+ * of return values, most functions are declared as `void` and they operate on
+ * output arguments passed by reference.
*/
-#ifndef INCLUDE_COMMONS_H_
-#include "Commons.h"
-#endif
-
#ifndef INCLUDE_SPH_SUBS_H_
#define INCLUDE_SPH_SUBS_H_
-#include <complex>
+/*! \brief Compute the asymmetry-corrected scattering cross-section.
+ *
+ * This function computes the product between the geometrical asymmetry parameter and
+ * the scattering cross-section. See Sec. 3.2.1 of Borghese, Denti & Saija (2007).
+ *
+ * \param zpv: `double ****` Geometrical asymmetry parameter coefficients matrix.
+ * \param li: `int` Maximum field expansion order.
+ * \param nsph: `int` Number of spheres.
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
+ * \param sqk: `double`
+ * \param gaps: `double *` Geometrical asymmetry parameter-corrected cross-section.
+ */
+void aps(double ****zpv, int li, int nsph, C1 *c1, double sqk, double *gaps);
-/*! \brief Conjugate of a double precision complex number
+/*! \brief Complex Bessel Function.
*
- * \param z: `std::complex\<double\>` The input complex number.
- * \return result: `std::complex\<double\>` The conjugate of the input number.
+ * This function computes the complex spherical Bessel funtions \f$j\f$. It uses the
+ * auxiliary functions `msta1()` and `msta2()` to determine the starting point for
+ * backward recurrence. This is the `CSPHJ` implementation of the `specfun` library.
+ *
+ * \param n: `int` Order of the function.
+ * \param z: `complex<double>` Argumento of the function.
+ * \param nm: `int &` Highest computed order.
+ * \param csj: Vector of complex. The desired function \f$j\f$.
*/
-std::complex<double> dconjg(std::complex<double> z) {
- double zreal = z.real();
- double zimag = z.imag();
- return std::complex<double>(zreal, -zimag);
-}
+void cbf(int n, std::complex<double> z, int &nm, std::complex<double> csj[]);
-/*! \brief C++ porting of CG1
+/*! \brief Clebsch-Gordan coefficients.
+ *
+ * This function comutes the Clebsch-Gordan coefficients for the irreducible spherical
+ * tensors. See Sec. 1.6.3 and Table 1.1 in Borghese, Denti & Saija (2007).
*
* \param lmpml: `int`
* \param mu: `int`
* \param l: `int`
* \param m: `int`
- * \return result: `double`
+ * \return result: `double` Clebsh-Gordan coefficient.
*/
-double cg1(int lmpml, int mu, int l, int m) {
- double result = 0.0;
- double xd, xn;
- if (lmpml == -1) { // Interpreted as GOTO 30
- xd = 2.0 * l * (2 * l - 1);
- if (mu == -1) {
- xn = 1.0 * (l - 1 - m) * (l - m);
- } else if (mu == 0) {
- xn = 2.0 * (l - m) * (l + m);
- } else if (mu == 1) {
- xn = 1.0 * (l - 1 + m) * (l + m);
- } else {
- throw 111; // Need an exception for unpredicted indices.
- }
- result = sqrt(xn / xd);
- } else if (lmpml == 0) { // Interpreted as GOTO 5
- bool goto10 = (m != 0) || (mu != 0);
- if (!goto10) {
- result = 0.0;
- return result;
- }
- if (mu != 0) {
- xd = 2.0 * l * (l + 1);
- if (mu == -1) {
- xn = 1.0 * (l - m) * (l + m + 1);
- result = -sqrt(xn / xd);
- } else if (mu == 1) { // mu > 0
- xn = 1.0 * (l + m) * (l - m + 1);
- result = sqrt(xn / xd);
- } else {
- throw 111; // Need an exception for unpredicted indices.
- }
- } else { // mu = 0
- xd = 1.0 * l * (l + 1);
- xn = -1.0 * m;
- result = xn / sqrt(xd);
- }
- } else if (lmpml == 1) { // Interpreted as GOTO 60
- xd = 2.0 * (l * 2 + 3) * (l + 1);
- if (mu == -1) {
- xn = 1.0 * (l + 1 + m) * (l + 2 + m);
- result = sqrt(xn / xd);
- } else if (mu == 0) {
- xn = 2.0 * (l + 1 - m) * (l + 1 + m);
- result = -sqrt(xn / xd);
- } else if (mu == 1) {
- xn = 1.0 * (l + 1 - m) * (l + 2 - m);
- result = sqrt(xn / xd);
- } else { // mu was not recognized.
- throw 111; // Need an exception for unpredicted indices.
- }
- } else { // lmpml was not recognized
- throw 111; // Need an exception for unpredicted indices.
- }
- return result;
-}
+double cg1(int lmpml, int mu, int l, int m);
-/*! \brief C++ porting of APS
+/*! \brief Conjugate of a double precision complex number
*
- * \param zpv: `double ****`
- * \param li: `int`
- * \param nsph: `int`
- * \param c1: `C1 *`
- * \param sqk: `double`
- * \param gaps: `double *`
+ * \param z: `complex<double>` The input complex number.
+ * \return result: `complex<double>` The conjugate of the input number.
*/
-void aps(double ****zpv, int li, int nsph, C1 *c1, double sqk, double *gaps) {
- std::complex<double> cc0 = std::complex<double>(0.0, 0.0);
- std::complex<double> summ, sume, suem, suee, sum;
- double half_pi = acos(0.0);
- double cofs = half_pi * 2.0 / sqk;
- for (int i40 = 0; i40 < nsph; i40++) {
- int i = i40 + 1;
- int iogi = c1->iog[i40];
- if (iogi >= i) {
- sum = cc0;
- for (int l30 = 0; l30 < li; l30++) {
- int l = l30 + 1;
- int ltpo = l + l + 1;
- for (int ilmp = 1; ilmp < 4; ilmp++) {
- int ilmp30 = ilmp - 1;
- bool goto30 = (l == 1 && ilmp == 1) || (l == li && ilmp == 3);
- if (!goto30) {
- int lmpml = ilmp - 2;
- int lmp = l + lmpml;
- double cofl = sqrt(1.0 * (ltpo * (lmp + lmp + 1)));
- summ = zpv[l30][ilmp30][0][0] /
- (
- dconjg(c1->rmi[l30][i40]) *
- c1->rmi[lmp - 1][i40]
- );
- sume = zpv[l30][ilmp30][0][1] /
- (
- dconjg(c1->rmi[l30][i40]) *
- c1->rei[lmp - 1][i40]
- );
- suem = zpv[l30][ilmp30][1][0] /
- (
- dconjg(c1->rei[l30][i40]) *
- c1->rmi[lmp - 1][i40]
- );
- suee = zpv[l30][ilmp30][1][1] /
- (
- dconjg(c1->rei[l30][i40]) *
- c1->rei[lmp - 1][i40]
- );
- sum += (cg1(lmpml, 0, l, -1) * (summ - sume - suem + suee) +
- cg1(lmpml, 0, l, 1) * (summ + sume + suem + suee)) * cofl;
- }
- }
- }
- }
- gaps[i40] = sum.real() * cofs;
- }
-}
+std::complex<double> dconjg(std::complex<double> z);
-/*! \brief C++ porting of DIEL
+/*! \brief Comute the continuous variation of the refractive index and of its radial derivative.
+ *
+ * This function implements the continuous variation of the refractive index and of its radial
+ * derivative through the materials that constitute the sphere and its surrounding medium. See
+ * Sec. 5.2 in Borghese, Denti & Saija (2007).
*
* \param npntmo: `int`
* \param ns: `int`
* \param i: `int`
* \param ic: `int`
* \param vk: `double`
- * \param c1: `C1 *`
- * \param c2: `C2 *`
+ * \param c1: `C1 *` Pointer to `C1` data structure.
+ * \param c2: `C2 *` Pointer to `C2` data structure.
*/
-void diel(int npntmo, int ns, int i, int ic, double vk, C1 *c1, C2 *c2) {
- const double dif = c1->rc[i - 1][ns] - c1->rc[i - 1][ns - 1];
- const double half_step = 0.5 * dif / npntmo;
- double rr = c1->rc[i - 1][ns - 1];
- const std::complex<double> delta = c2->dc0[ic] - c2->dc0[ic - 1];
- const int kpnt = npntmo + npntmo;
- c2->ris[kpnt] = c2->dc0[ic];
- c2->dlri[kpnt] = std::complex<double>(0.0, 0.0);
- const int i90 = i - 1;
- const int ns90 = ns - 1;
- const int ic90 = ic - 1;
- for (int np90 = 0; np90 < kpnt; np90++) {
- double ff = (rr - c1->rc[i90][ns90]) / dif;
- c2->ris[np90] = delta * ff * ff * (-2.0 * ff + 3.0) + c2->dc0[ic90];
- c2->dlri[np90] = 3.0 * delta * ff * (1.0 - ff) / (dif * vk * c2->ris[np90]);
- rr += half_step;
- }
-}
+void diel(int npntmo, int ns, int i, int ic, double vk, C1 *c1, C2 *c2);
-/*! \brief C++ porting of ENVJ
+/*! \brief Compute Mie scattering coefficients.
*
- * \param n: `int`
- * \param x: `double`
- * \return result: `double`
+ * This function determines the L-dependent Mie scattering coefficients \f$a_l\f$ and \f$b_l\f$
+ * for the cases of homogeneous spheres, radially non-homogeneous spheres and, in case of sphere
+ * with dielectric function, sustaining longitudinal waves. See Sec. 5.1 in Borghese, Denti
+ * & Saija (2007).
+ *
+ * \param li: `int` Maximum field expansion order.
+ * \param i: `int`
+ * \param npnt: `int`
+ * \param npntts: `int`
+ * \param vk: `double` Wave number in scale units.
+ * \param exdc: `double` External medium dielectric constant.
+ * \param exri: `double` External medium refractive index.
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
+ * \param c2: `C2 *` Pointer to a `C2` data structure.
+ * \param jer: `int &` Reference to integer error code variable.
+ * \param lcalc: `int &` Reference to integer variable recording the maximum expansion order accounted for.
+ * \param arg: `complex<double> &`
*/
-double envj(int n, double x) {
- double result = 0.0;
- double xn;
- if (n == 0) {
- xn = 1.0e-100;
- result = 0.5 * log10(6.28 * xn) - xn * log10(1.36 * x / xn);
- } else {
- result = 0.5 * log10(6.28 * n) - n * log10(1.36 * x / n);
- }
- return result;
-}
+void dme(
+ int li, int i, int npnt, int npntts, double vk, double exdc, double exri,
+ C1 *c1, C2 *c2, int &jer, int &lcalc, std::complex<double> &arg
+);
-/*! \brief C++ porting of MSTA1
+/*! \brief Bessel function calculation control parameters.
*
+ * This function determines the control parameters required to calculate the Bessel
+ * functions up to the desired precision.
+ *
+ * \param n: `int`
* \param x: `double`
- * \param mp: `int`
- * \return result: `int`
+ * \return result: `double`
*/
-int msta1(double x, int mp) {
- int result = 0;
- double a0 = x;
- if (a0 < 0.0) a0 *= -1.0;
- int n0 = (int)(1.1 * a0) + 1;
- double f0 = envj(n0, a0) - mp;
- int n1 = n0 + 5;
- double f1 = envj(n1, a0) - mp;
- for (int it10 = 0; it10 < 20; it10++) {
- int nn = n1 - (int)((n1 - n0) / (1.0 - f0 / f1));
- double f = envj(nn, a0) - mp;
- int test_n = nn - n1;
- if (test_n < 0) test_n *= -1;
- if (test_n < 1) {
- return nn;
- }
- n0 = n1;
- f0 = f1;
- n1 = nn;
- f1 = f;
- result = nn;
- }
- return result;
-}
+double envj(int n, double x);
-/*! \brief C++ porting of MSTA2
+/*! \brief Compute the Mueller Transformation Matrix.
*
- * \param x: `double`
- * \param n: `int`
- * \param mp: `int`
- * \return result: `int`
+ * This function computes the Mueller Transformation Matrix, or Phase Matrix. See
+ * Sec. 2.8.1 of Borghese, Denti & Saija (2007).
+ *
+ * \param vint: Vector of complex.
+ * \param cmullr: `double **`
+ * \param cmul: `double **`
*/
-int msta2(double x, int n, int mp) {
- int result = 0;
- double a0 = x;
- if (a0 < 0) a0 *= -1.0;
- double half_mp = 0.5 * mp;
- double ejn = envj(n, a0);
- double obj;
- int n0;
- if (ejn <= half_mp) {
- obj = 1.0 * mp;
- n0 = (int)(1.1 * a0) + 1;
- } else {
- obj = half_mp + ejn;
- n0 = n;
- }
- double f0 = envj(n0, a0) - obj;
- int n1 = n0 + 5;
- double f1 = envj(n1, a0) - obj;
- for (int it10 = 0; it10 < 20; it10 ++) {
- int nn = n1 - (int)((n1 - n0) / (1.0 - f0 / f1));
- double f = envj(nn, a0) - obj;
- int test_n = nn - n1;
- if (test_n < 0) test_n *= -1;
- if (test_n < 1) return (nn + 10);
- n0 = n1;
- f0 = f1;
- n1 = nn;
- f1 = f;
- result = nn + 10;
- }
- return result;
-}
+void mmulc(std::complex<double> *vint, double **cmullr, double **cmul);
-/*! \brief C++ porting of CBF
+/*! \brief Starting point for Bessel function magnitude.
*
- * This is the Complex Bessel Function.
+ * This function determines the starting point for backward recurrence such that
+ * the magnitude of all \f$J\f$ and \$j\f$ functions is of the order of \f$10^{-mp}\f$.
*
- * \param n: `int`
- * \param z: `complex\<double\>`
- * \param nm: `int &`
- * \param csj: Vector of complex.
+ * \param x: `double` Absolute value of the argumetn to \f$J\f$ or \$j\f$.
+ * \param mp: `int` Requested order of magnitude.
+ * \return result: `int` The necessary starting point.
*/
-void cbf(int n, std::complex<double> z, int &nm, std::complex<double> csj[]) {
- /*
- * FROM CSPHJY OF LIBRARY specfun
- *
- * ==========================================================
- * Purpose: Compute spherical Bessel functions j
- * Input : z --- Complex argument of j
- * n --- Order of j ( n = 0,1,2,... )
- * Output: csj(n+1) --- j
- * nm --- Highest order computed
- * Routines called:
- * msta1 and msta2 for computing the starting
- * point for backward recurrence
- * ==========================================================
- */
- double zz = z.real() * z.real() + z.imag() * z.imag();
- double a0 = sqrt(zz);
- nm = n;
- if (a0 < 1.0e-60) {
- for (int k = 2; k <= n + 1; k++) {
- csj[k - 1] = 0.0;
- }
- csj[0] = std::complex<double>(1.0, 0.0);
- return;
- }
- csj[0] = std::sin(z) / z;
- if (n == 0) {
- return;
- }
- csj[1] = (csj[0] -std::cos(z)) / z;
- if (n == 1) {
- return;
- }
- std::complex<double> csa = csj[0];
- std::complex<double> csb = csj[1];
- int m = msta1(a0, 200);
- if (m < n) nm = m;
- else m = msta2(a0, n, 15);
- std::complex<double> cf0 = 0.0;
- std::complex<double> cf1 = 1.0e-100;
- std::complex<double> cf, cs;
- for (int k = m; k >= 0; k--) {
- cf = (2.0 * k + 3.0) * cf1 / z - cf0;
- if (k <= nm) csj[k] = cf;
- cf0 = cf1;
- cf1 = cf;
- }
- double abs_csa = abs(csa);
- double abs_csb = abs(csb);
- if (abs_csa > abs_csb) cs = csa / cf;
- else cs = csb / cf0;
- for (int k = 0; k <= nm; k++) {
- csj[k] = cs * csj[k];
- }
-}
+int msta1(double x, int mp);
-/*! \brief C++ porting of MMULC
+/*! \brief Starting point for Bessel function precision.
*
- * \param vint: Vector of complex.
- * \param cmullr: `double **`
- * \param cmul: `double **`
+ * This function determines the starting point for backward recurrence such that
+ * all \f$J\f$ and \$j\f$ functions have `mp` significant digits.
+ *
+ * \param x: `double` Absolute value of the argumetn to \f$J\f$ or \$j\f$.
+ * \param n: `int` Order of the function.
+ * \param mp: `int` Requested number of significant digits.
+ * \return result: `int` The necessary starting point.
*/
-void mmulc(std::complex<double> *vint, double **cmullr, double **cmul) {
- double sm2 = vint[0].real();
- double s24 = vint[1].real();
- double d24 = vint[1].imag();
- double sm4 = vint[5].real();
- double s23 = vint[8].real();
- double d32 = vint[8].imag();
- double s34 = vint[9].real();
- double d34 = vint[9].imag();
- double sm3 = vint[10].real();
- double s31 = vint[11].real();
- double d31 = vint[11].imag();
- double s21 = vint[12].real();
- double d12 = vint[12].imag();
- double s41 = vint[13].real();
- double d14 = vint[13].imag();
- double sm1 = vint[15].real();
- cmullr[0][0] = sm2;
- cmullr[0][1] = sm3;
- cmullr[0][2] = -s23;
- cmullr[0][3] = -d32;
- cmullr[1][0] = sm4;
- cmullr[1][1] = sm1;
- cmullr[1][2] = -s41;
- cmullr[1][3] = -d14;
- cmullr[2][0] = -s24 * 2.0;
- cmullr[2][1] = -s31 * 2.0;
- cmullr[2][2] = s21 + s34;
- cmullr[2][3] = d34 + d12;
- cmullr[3][0] = -d24 * 2.0;
- cmullr[3][1] = -d31 * 2.0;
- cmullr[3][2] = d34 - d12;
- cmullr[3][3] = s21 - s34;
- cmul[0][0] = (sm2 + sm3 + sm4 + sm1) * 0.5;
- cmul[0][1] = (sm2 - sm3 + sm4 - sm1) * 0.5;
- cmul[0][2] = -s23 - s41;
- cmul[0][3] = -d32 - d14;
- cmul[1][0] = (sm2 + sm3 - sm4 - sm1) * 0.5;
- cmul[1][1] = (sm2 - sm3 - sm4 + sm1) * 0.5;
- cmul[1][2] = -s23 + s41;
- cmul[1][3] = -d32 + d14;
- cmul[2][0] = -s24 - s31;
- cmul[2][1] = -s24 + s31;
- cmul[2][2] = s21 + s34;
- cmul[2][3] = d34 + d12;
- cmul[3][0] = -d24 - d31;
- cmul[3][1] = -d24 + d31;
- cmul[3][2] = d34 - d12;
- cmul[3][3] = s21 - s34;
-}
+int msta2(double x, int n, int mp);
-/*! \brief C++ porting of ORUNVE
+/*! \brief Compute the amplitude of the orthogonal unit vector.
+ *
+ * This function computes the amplitude of the orthogonal unit vector for a geometry
+ * based either on the scattering plane or on the meridional plane. It is used by `upvsp()`
+ * and `upvmp()`. See Sec. 2.7 in Borghese, Denti & Saija (2007).
*
* \param u1: `double *`
* \param u2: `double *`
@@ -403,655 +159,167 @@ void mmulc(std::complex<double> *vint, double **cmullr, double **cmul) {
* \param iorth: `int`
* \param torth: `double`
*/
-void orunve( double *u1, double *u2, double *u3, int iorth, double torth) {
- if (iorth <= 0) {
- double cp = u1[0] * u2[0] + u1[1] * u2[1] + u1[2] * u2[2];
- double abs_cp = cp;
- if (abs_cp < 0.0) abs_cp *= -1.0;
- if (iorth == 0 || abs_cp >= torth) {
- double fn = 1.0 / sqrt(1.0 - cp * cp);
- u3[0] = (u1[1] * u2[2] - u1[2] * u2[1]) * fn;
- u3[1] = (u1[2] * u2[0] - u1[0] * u2[2]) * fn;
- u3[2] = (u1[0] * u2[1] - u1[1] * u2[0]) * fn;
- return;
- }
- }
- u3[0] = u1[1] * u2[2] - u1[2] * u2[1];
- u3[1] = u1[2] * u2[0] - u1[0] * u2[2];
- u3[2] = u1[0] * u2[1] - u1[1] * u2[0];
-}
+void orunve(double *u1, double *u2, double *u3, int iorth, double torth);
-/*! \brief C++ porting of PWMA
+/*! \brief Compute incident and scattered field amplitudes.
+ *
+ * This function computes the amplitudes of the incident and scattered field on the
+ * basis of the multi-polar expansion. See Sec. 4.1.1 in Borghese, Denti and Saija (2007).
*
* \param up: `double *`
* \param un: `double *`
- * \param ylm: Vector of complex
- * \param inpol: `int`
+ * \param ylm: Vector of complex. Field polar spherical harmonics.
+ * \param inpol: `int` Incident field polarization type (0 - linear; 1 - circular).
* \param lw: `int`
* \param isq: `int`
- * \param c1: `C1 *`
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
*/
void pwma(
- double *up, double *un, std::complex<double> *ylm, int inpol, int lw,
- int isq, C1 *c1
-) {
- const double four_pi = 8.0 * acos(0.0);
- int is = isq;
- if (isq == -1) is = 0;
- int ispo = is + 1;
- int ispt = is + 2;
- int nlwm = lw * (lw + 2);
- int nlwmt = nlwm + nlwm;
- const double sqrtwi = 1.0 / sqrt(2.0);
- const std::complex<double> uim(0.0, 1.0);
- std::complex<double> cm1 = 0.5 * std::complex<double>(up[0], up[1]);
- std::complex<double> cp1 = 0.5 * std::complex<double>(up[0], -up[1]);
- double cz1 = up[2];
- std::complex<double> cm2 = 0.5 * std::complex<double>(un[0], un[1]);
- std::complex<double> cp2 = 0.5 * std::complex<double>(un[0], -un[1]);
- double cz2 = un[2];
- for (int l20 = 0; l20 < lw; l20++) {
- int l = l20 + 1;
- int lf = l + 1;
- int lftl = lf * l;
- double x = 1.0 * lftl;
- std::complex<double> cl = std::complex<double>(four_pi / sqrt(x), 0.0);
- for (int powi = 1; powi <= l; powi++) cl *= uim;
- int mv = l + lf;
- int m = -lf;
- for (int mf20 = 0; mf20 < mv; mf20++) {
- m += 1;
- int k = lftl + m;
- x = 1.0 * (lftl - m * (m + 1));
- double cp = sqrt(x);
- x = 1.0 * (lftl - m * (m - 1));
- double cm = sqrt(x);
- double cz = 1.0 * m;
- c1->w[k - 1][ispo - 1] = dconjg(
- cp1 * cp * ylm[k + 1] +
- cm1 * cm * ylm[k - 1] +
- cz1 * cz * ylm[k]
- ) * cl;
- c1->w[k - 1][ispt - 1] = dconjg(
- cp2 * cp * ylm[k + 1] +
- cm2 * cm * ylm[k - 1] +
- cz2 * cz * ylm[k]
- ) * cl;
- }
- }
- for (int k30 = 0; k30 < nlwm; k30++) {
- int i = k30 + nlwm;
- c1->w[i][ispo - 1] = uim * c1->w[k30][ispt - 1];
- c1->w[i][ispt - 1] = -uim * c1->w[k30][ispo - 1];
- }
- if (inpol != 0) {
- for (int k40 = 0; k40 < nlwm; k40++) {
- int i = k40 + nlwm;
- std::complex<double> cc1 = sqrtwi * (c1->w[k40][ispo - 1] + uim * c1->w[k40][ispt - 1]);
- std::complex<double> cc2 = sqrtwi * (c1->w[k40][ispo - 1] - uim * c1->w[k40][ispt - 1]);
- c1->w[k40][ispo - 1] = cc2;
- c1->w[i][ispo - 1] = -cc2;
- c1->w[k40][ispt - 1] = cc1;
- c1->w[i][ispt - 1] = cc1;
- }
- } else {
- if (isq == 0) {
- return;
- }
- }
- if (isq != 0) {
- for (int i50 = 0; i50 < 2; i50++) {
- int ipt = i50 + 2;
- int ipis = i50 + is;
- for (int k50 = 0; k50 < nlwmt; k50++) {
- c1->w[k50][ipt] = dconjg(c1->w[k50][ipis]);
- }
- }
- }
-}
+ double *up, double *un, std::complex<double> *ylm, int inpol, int lw,
+ int isq, C1 *c1
+);
-/*! \brief C++ porting of RABAS
+/*! \brief Compute radiation torques on particles.
*
* This function computes radiation torque on the particle as a result
* of the difference between the extinction and the scattering contributions.
+ * See Sec. 4.9 in Borghese, Denti & Saija (2007).
*
- * \param inpol: `int`
- * \param li: `int`
- * \param nsph: `int`
- * \param c1: `C1 *`
+ * \param inpol: `int` Incident polarization type (0 - linear; 1 - circular)
+ * \param li: `int` Maximum field expansion order.
+ * \param nsph: `int` Number of spheres.
+ * \param c1: `C1 *` Pointer to `C1` data structure.
* \param tqse: Matrix of complex.
* \param tqspe: Matrix of complex.
* \param tqss: Matrix of complex.
* \param tqsps: Matrix of complex.
*/
void rabas(
- int inpol, int li, int nsph, C1 *c1, double **tqse, std::complex<double> **tqspe,
- double **tqss, std::complex<double> **tqsps
-) {
- std::complex<double> cc0 = std::complex<double>(0.0, 0.0);
- std::complex<double> uim = std::complex<double>(0.0, 1.0);
- double two_pi = 4.0 * acos(0.0);
- for (int i80 = 0; i80 < nsph; i80++) {
- int i = i80 + 1;
- if(c1->iog[i80] >= i) {
- tqse[0][i80] = 0.0;
- tqse[1][i80] = 0.0;
- tqspe[0][i80] = cc0;
- tqspe[1][i80] = cc0;
- tqss[0][i80] = 0.0;
- tqss[1][i80] = 0.0;
- tqsps[0][i80] = cc0;
- tqsps[1][i80] = cc0;
- for (int l70 = 0; l70 < li; l70++) {
- int l = l70 + 1;
- double fl = 1.0 * (l + l + 1);
- std::complex<double> rm = 1.0 / c1->rmi[l70][i80];
- double rmm = (rm * dconjg(rm)).real();
- std::complex<double> re = 1.0 / c1->rei[l70][i80];
- double rem = (re * dconjg(re)).real();
- if (inpol == 0) {
- std::complex<double> pce = ((rm + re) * uim) * fl;
- std::complex<double> pcs = ((rmm + rem) * fl) * uim;
- tqspe[0][i80] -= pce;
- tqspe[1][i80] += pce;
- tqsps[0][i80] -= pcs;
- tqsps[1][i80] += pcs;
- } else {
- double ce = (rm + re).real() * fl;
- double cs = (rmm + rem) * fl;
- tqse[0][i80] -= ce;
- tqse[1][i80] += ce;
- tqss[0][i80] -= cs;
- tqss[1][i80] += cs;
- }
- }
- if (inpol == 0) {
- tqspe[0][i80] *= two_pi;
- tqspe[1][i80] *= two_pi;
- tqsps[0][i80] *= two_pi;
- tqsps[1][i80] *= two_pi;
- } else {
- tqse[0][i80] *= two_pi;
- tqse[1][i80] *= two_pi;
- tqss[0][i80] *= two_pi;
- tqss[1][i80] *= two_pi;
- }
- }
- }
-}
+ int inpol, int li, int nsph, C1 *c1, double **tqse, std::complex<double> **tqspe,
+ double **tqss, std::complex<double> **tqsps
+);
-/*! \brief C++ porting of RBF
+/*! \brief Real Bessel Function.
*
- * This is the Real Bessel Function.
+ * This function computes the real spherical Bessel funtions \f$j\f$. It uses the
+ * auxiliary functions `msta1()` and `msta2()` to determine the starting point for
+ * backward recurrence. This is the `SPHJ` implementation of the `specfun` library.
*
- * \param n: `int`
- * \param x: `double`
- * \param nm: `int &`
- * \param sj: `double[]`
+ * \param n: `int` Order of the function.
+ * \param x: `double` Argument of the function.
+ * \param nm: `int &` Highest computed order.
+ * \param sj: `double[]` The desired function \f$j\f$.
*/
-void rbf(int n, double x, int &nm, double sj[]) {
- /*
- * FROM SPHJ OF LIBRARY specfun
- *
- * ==========================================================
- * Purpose: Compute spherical Bessel functions j
- * Input : x --- Argument of j
- * n --- Order of j ( n = 0,1,2,... )
- * Output: sj(n+1) --- j
- * nm --- Highest order computed
- * Routines called:
- * msta1 and msta2 for computing the starting
- * point for backward recurrence
- * ==========================================================
- */
- double a0 = x;
- if (a0 < 0.0) a0 *= -1.0;
- nm = n;
- if (a0 < 1.0e-60) {
- for (int k = 1; k <= n; k++)
- sj[k] = 0.0;
- sj[0] = 1.0;
- return;
- }
- sj[0] = sin(x) / x;
- if (n == 0) {
- return;
- }
- sj[1] = (sj[0] - cos(x)) / x;
- if (n == 1) {
- return;
- }
- double sa = sj[0];
- double sb = sj[1];
- int m = msta1(a0, 200);
- if (m < n) nm = m;
- else m = msta2(a0, n, 15);
- double f0 = 0.0;
- double f1 = 1.0e-100;
- double f;
- for (int k = m; k >= 0; k--) {
- f = (2.0 * k +3.0) * f1 / x - f0;
- if (k <= nm) sj[k] = f;
- f0 = f1;
- f1 = f;
- }
- double cs;
- double abs_sa = (sa < 0.0) ? -sa : sa;
- double abs_sb = (sb < 0.0) ? -sb : sb;
- if (abs_sa > abs_sb) cs = sa / f;
- else cs = sb / f0;
- for (int k = 0; k <= nm; k++) {
- sj[k] = cs * sj[k];
- }
-}
+void rbf(int n, double x, int &nm, double sj[]);
-/*! \brief C++ porting of RKC
+/*! \brief Soft layer radial function and derivative.
+ *
+ * This function determines the radial function and its derivative for a soft layer
+ * in a radially non homogeneous sphere. See Sec. 5.1 in Borghese, Denti & Saija (2007).
*
* \param npntmo: `int`
* \param step: `double`
- * \param dcc: `complex\<double\>`
+ * \param dcc: `complex<double>`
* \param x: `double &`
* \param lpo: `int`
- * \param y1: `complex\<double\> &`
- * \param y2: `complex\<double\> &`
- * \param dy1: `complex\<double\> &`
- * \param dy2: `complex\<double\> &`
+ * \param y1: `complex<double> &`
+ * \param y2: `complex<double> &`
+ * \param dy1: `complex<double> &`
+ * \param dy2: `complex<double> &`
*/
void rkc(
- int npntmo, double step, std::complex<double> dcc, double &x, int lpo,
- std::complex<double> &y1, std::complex<double> &y2, std::complex<double> &dy1,
- std::complex<double> &dy2
-) {
- std::complex<double> cy1, cdy1, c11, cy23, yc2, c12, c13;
- std::complex<double> cy4, yy, c14, c21, c22, c23, c24;
- double half_step = 0.5 * step;
- double cl = 1.0 * lpo * (lpo - 1);
- for (int ipnt60 = 0; ipnt60 < npntmo; ipnt60++) {
- cy1 = cl / (x * x) - dcc;
- cdy1 = -2.0 / x;
- c11 = (cy1 * y1 + cdy1 * dy1) * step;
- double xh = x + half_step;
- cy23 = cl / (xh * xh) - dcc;
- double cdy23 = -2.0 / xh;
- yc2 = y1 + dy1 * half_step;
- c12 = (cy23 * yc2 + cdy23 * (dy1 + 0.5 * c11)) * step;
- c13 = (cy23 * (yc2 + 0.25 * c11 * step) + cdy23 * (dy1 + 0.5 * c12)) * step;
- double xn = x + step;
- cy4 = cl / (xn * xn) - dcc;
- double cdy4 = -2.0 / xn;
- yy = y1 + dy1 * step;
- c14 = (cy4 * (yy + 0.5 * c12 * step) + cdy4 * (dy1 + c13)) * step;
- y1 = yy + (c11 + c12 + c13) * step / 6.0;
- dy1 += (0.5 * c11 + c12 + c13 + 0.5 * c14) / 3.0;
- c21 = (cy1 * y2 + cdy1 * dy2) * step;
- yc2 = y2 + dy2 * half_step;
- c22 = (cy23 * yc2 + cdy23 * (dy2 + 0.5 * c21)) * step;
- c23 = (cy23 * (yc2 + 0.25 * c21 * step) + cdy23 * (dy2 + 0.5 * c22)) * step;
- yy = y2 + dy2 * step;
- c24 = (cy4 * (yc2 + 0.5 * c22 * step) + cdy4 * (dy2 + c23)) * step;
- y2 = yy + (c21 + c22 + c23) * step / 6.0;
- dy2 += (0.5 * c21 + c22 + c23 + 0.5 * c24) / 3.0;
- x = xn;
- }
-}
+ int npntmo, double step, std::complex<double> dcc, double &x, int lpo,
+ std::complex<double> &y1, std::complex<double> &y2, std::complex<double> &dy1,
+ std::complex<double> &dy2
+);
-/*! \brief C++ porting of RKT
+/*! \brief Transition layer radial function and derivative.
+ *
+ * This function determines the radial function and its derivative for a transition layer
+ * in a radially non homogeneous sphere. See Sec. 5.1 in Borghese, Denti & Saija (2007).
*
* \param npntmo: `int`
* \param step: `double`
* \param x: `double &`
* \param lpo: `int`
- * \param y1: `complex\<double\> &`
- * \param y2: `complex\<double\> &`
- * \param dy1: `complex\<double\> &`
- * \param dy2: `complex\<double\> &`
- * \param c2: `C2 *`
+ * \param y1: `complex<double> &`
+ * \param y2: `complex<double> &`
+ * \param dy1: `complex<double> &`
+ * \param dy2: `complex<double> &`
+ * \param c2: `C2 *` Pointer to a `C2` data structure.
*/
void rkt(
- int npntmo, double step, double &x, int lpo, std::complex<double> &y1,
- std::complex<double> &y2, std::complex<double> &dy1, std::complex<double> &dy2,
- C2 *c2
-) {
- std::complex<double> cy1, cdy1, c11, cy23, cdy23, yc2, c12, c13;
- std::complex<double> cy4, cdy4, yy, c14, c21, c22, c23, c24;
- double half_step = 0.5 * step;
- double cl = 1.0 * lpo * (lpo - 1);
- for (int ipnt60 = 0; ipnt60 < npntmo; ipnt60++) {
- int ipnt = ipnt60 + 1;
- int jpnt = ipnt + ipnt - 1;
- int jpnt60 = jpnt - 1;
- cy1 = cl / (x * x) - c2->ris[jpnt60];
- cdy1 = -2.0 / x;
- c11 = (cy1 * y1 + cdy1 * dy1) * step;
- double xh = x + half_step;
- int jpntpo = jpnt + 1;
- cy23 = cl / (xh * xh) - c2->ris[jpnt];
- cdy23 = -2.0 / xh;
- yc2 = y1 + dy1 * half_step;
- c12 = (cy23 * yc2 + cdy23 * (dy1 + 0.5 * c11)) * step;
- c13= (cy23 * (yc2 + 0.25 * c11 *step) + cdy23 * (dy1 + 0.5 * c12)) * step;
- double xn = x + step;
- //int jpntpt = jpnt + 2;
- cy4 = cl / (xn * xn) - c2->ris[jpntpo];
- cdy4 = -2.0 / xn;
- yy = y1 + dy1 * step;
- c14 = (cy4 * (yy + 0.5 * c12 * step) + cdy4 * (dy1 + c13)) * step;
- y1= yy + (c11 + c12 + c13) * step / 6.0;
- dy1 += (0.5 * c11 + c12 + c13 + 0.5 * c14) /3.0;
- cy1 -= cdy1 * c2->dlri[jpnt60];
- cdy1 += 2.0 * c2->dlri[jpnt60];
- c21 = (cy1 * y2 + cdy1 * dy2) * step;
- cy23 -= cdy23 * c2->dlri[jpnt];
- cdy23 += 2.0 * c2->dlri[jpnt];
- yc2 = y2 + dy2 * half_step;
- c22 = (cy23 * yc2 + cdy23 * (dy2 + 0.5 * c21)) * step;
- c23 = (cy23 * (yc2 + 0.25 * c21 * step) + cdy23 * (dy2 + 0.5 * c22)) * step;
- cy4 -= cdy4 * c2->dlri[jpntpo];
- cdy4 += 2.0 * c2->dlri[jpntpo];
- yy = y2 + dy2 * step;
- c24 = (cy4 * (yc2 + 0.5 * c22 * step) + cdy4 * (dy2 + c23)) * step;
- y2 = yy + (c21 + c22 + c23) * step / 6.0;
- dy2 += (0.5 * c21 + c22 + c23 + 0.5 * c24) / 3.0;
- x = xn;
- }
-}
+ int npntmo, double step, double &x, int lpo, std::complex<double> &y1,
+ std::complex<double> &y2, std::complex<double> &dy1, std::complex<double> &dy2,
+ C2 *c2
+);
-/*! \brief C++ porting of RNF
+/*! \brief Spherical Bessel functions.
*
- * This is a real spherical Bessel function.
+ * This function computes the spherical Bessel functions \f$y\$. It adopts the `SPHJY`
+ * implementation of the `specfun` library.
*
- * \param n: `int`
- * \param x: `double`
- * \param nm: `int &`
- * \param sy: `double[]`
+ * \param n: `int` Order of the function (from 0 up).
+ * \param x: `double` Argumento of the function (\f$x > 0\f$).
+ * \param nm: `int &` Highest computed order.
+ * \param sy: `double[]` The desired function \f$y\f$.
*/
-void rnf(int n, double x, int &nm, double sy[]) {
- /*
- * FROM SPHJY OF LIBRARY specfun
- *
- * ==========================================================
- * Purpose: Compute spherical Bessel functions y
- * Input : x --- Argument of y ( x > 0 )
- * n --- Order of y ( n = 0,1,2,... )
- * Output: sy(n+1) --- y
- * nm --- Highest order computed
- * ==========================================================
- */
- if (x < 1.0e-60) {
- for (int k = 0; k <= n; k++)
- sy[k] = -1.0e300;
- return;
- }
- sy[0] = -1.0 * cos(x) / x;
- if (n == 0) {
- return;
- }
- sy[1] = (sy[0] - sin(x)) / x;
- if (n == 1) {
- return;
- }
- double f0 = sy[0];
- double f1 = sy[1];
- double f;
- for (int k = 2; k <= n; k++) {
- f = (2.0 * k - 1.0) * f1 / x - f0;
- sy[k] = f;
- double abs_f = f;
- if (abs_f < 0.0) abs_f *= -1.0;
- if (abs_f >= 1.0e300) {
- nm = k;
- break;
- }
- f0 = f1;
- f1 = f;
- nm = k;
- }
- return;
-}
+void rnf(int n, double x, int &nm, double sy[]);
-/*! \brief C++ porting of SSCR0
+/*! \brief Spherical harmonics for given direction.
*
- * \param tfsas: `complex<double> &`
- * \param nsph: `int`
- * \param lm: `int`
- * \param vk: `double`
- * \param exri: `double`
- * \param c1: `C1 *`
+ * This function computes the field spherical harmonics for a given direction. See Sec.
+ * 1.5.2 in Borghese, Denti & Saija (2007).
+ *
+ * \param cosrth: `double` Cosine of direction's elevation.
+ * \param sinrth: `double` Sine of direction's elevation.
+ * \param cosrph: `double` Cosine of direction's azimuth.
+ * \param sinrph: `double` Sine of direction's azimuth.
+ * \param ll: `int` L value expansion order.
+ * \param ylm: Vector of complex. The requested spherical harmonics.
*/
-void sscr0(std::complex<double> &tfsas, int nsph, int lm, double vk, double exri, C1 *c1) {
- std::complex<double> sum21, rm, re, csam;
- const std::complex<double> cc0 = std::complex<double>(0.0, 0.0);
- const double exdc = exri * exri;
- double ccs = 4.0 * acos(0.0) / (vk * vk);
- double cccs = ccs / exdc;
- csam = -(ccs / (exri * vk)) * std::complex<double>(0.0, 0.5);
- tfsas = cc0;
- for (int i12 = 0; i12 < nsph; i12++) {
- int i = i12 + 1;
- int iogi = c1->iog[i12];
- if (iogi >= i) {
- double sums = 0.0;
- std::complex<double> sum21 = cc0;
- for (int l10 = 0; l10 < lm; l10++) {
- int l = l10 + 1;
- double fl = 1.0 + l + l;
- rm = 1.0 / c1->rmi[l10][i12];
- re = 1.0 / c1->rei[l10][i12];
- std::complex<double> rm_cnjg = dconjg(rm);
- std::complex<double> re_cnjg = dconjg(re);
- sums += (rm_cnjg * rm + re_cnjg * re).real() * fl;
- sum21 += (rm + re) * fl;
- }
- sum21 *= -1.0;
- double scasec = cccs * sums;
- double extsec = -cccs * sum21.real();
- double abssec = extsec - scasec;
- c1->sscs[i12] = scasec;
- c1->sexs[i12] = extsec;
- c1->sabs[i12] = abssec;
- double gcss = c1->gcsv[i12];
- c1->sqscs[i12] = scasec / gcss;
- c1->sqexs[i12] = extsec / gcss;
- c1->sqabs[i12] = abssec / gcss;
- c1->fsas[i12] = sum21 * csam;
- }
- tfsas += c1->fsas[iogi - 1];
- }
-}
+void sphar(
+ double cosrth, double sinrth, double cosrph, double sinrph,
+ int ll, std::complex<double> *ylm
+);
-/*! \brief C++ porting of SSCR2
+/*! \brief Compute scattering, absorption and extinction cross-sections.
*
- * \param nsph: `int`
- * \param lm: `int`
- * \param vk: `double`
- * \param exri: `double`
- * \param c1: `C1 *`
+ * This function computes the scattering, absorption and extinction cross-sections in terms
+ * of Forward Scattering Amplitudes. See Sec. 4.2.1 in Borghese, Denti & Saija (2007).
+ *
+ * \param tfsas: `complex<double> &`
+ * \param nsph: `int` Number of spheres.
+ * \param lm: `int` Maximum field expansion order.
+ * \param vk: `double` Wave number in scale units.
+ * \param exri: `double` External medium refractive index.
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
*/
-void sscr2(int nsph, int lm, double vk, double exri, C1 *c1) {
- std::complex<double> s11, s21, s12, s22, rm, re, csam, cc;
- const std::complex<double> cc0(0.0, 0.0);
- double ccs = 1.0 / (vk * vk);
- csam = -(ccs / (exri * vk)) * std::complex<double>(0.0, 0.5);
- const double pigfsq = 64.0 * acos(0.0) * acos(0.0);
- double cfsq = 4.0 / (pigfsq * ccs * ccs);
- int nlmm = lm * (lm + 2);
- for (int i14 = 0; i14 < nsph; i14++) {
- int i = i14 + 1;
- int iogi = c1->iog[i14];
- if (iogi >= i) {
- int k = 0;
- s11 = cc0;
- s21 = cc0;
- s12 = cc0;
- s22 = cc0;
- for (int l10 = 0; l10 < lm; l10++) {
- int l = l10 + 1;
- rm = 1.0 / c1->rmi[l10][i14];
- re = 1.0 / c1->rei[l10][i14];
- int ltpo = l + l + 1;
- for (int im10 = 0; im10 < ltpo; im10++) {
- k += 1;
- int ke = k + nlmm;
- s11 = s11 - c1->w[k - 1][2] * c1->w[k - 1][0] * rm - c1->w[ke - 1][2] * c1->w[ke - 1][0] * re;
- s21 = s21 - c1->w[k - 1][3] * c1->w[k - 1][0] * rm - c1->w[ke - 1][3] * c1->w[ke - 1][0] * re;
- s12 = s12 - c1->w[k - 1][2] * c1->w[k - 1][1] * rm - c1->w[ke - 1][2] * c1->w[ke - 1][1] * re;
- s22 = s22 - c1->w[k - 1][3] * c1->w[k - 1][1] * rm - c1->w[ke - 1][3] * c1->w[ke - 1][1] * re;
- }
- }
- c1->sas[i14][0][0] = s11 * csam;
- c1->sas[i14][1][0] = s21 * csam;
- c1->sas[i14][0][1] = s12 * csam;
- c1->sas[i14][1][1] = s22 * csam;
- }
- } // loop i14
- for (int i24 = 0; i24 < nsph; i24++) {
- int i = i24 + 1;
- int iogi = c1->iog[i24];
- if (iogi >= i) {
- int j = 0;
- for (int ipo1 = 0; ipo1 < 2; ipo1++) {
- for (int jpo1 = 0; jpo1 < 2; jpo1++) {
- std::complex<double> cc = dconjg(c1->sas[i24][jpo1][ipo1]);
- for (int ipo2 = 0; ipo2 < 2; ipo2++) {
- for (int jpo2 = 0; jpo2 < 2; jpo2++) {
- c1->vints[i24][j++] = c1->sas[i24][jpo2][ipo2] * cc * cfsq;
- }
- }
- }
- }
- }
- }
-}
+void sscr0(std::complex<double> &tfsas, int nsph, int lm, double vk, double exri, C1 *c1);
-/*! \brief C++ porting of SPHAR
+/*! \brief C++ Compute the scattering amplitude and the scattered field intensity.
*
- * \param cosrth: `double`
- * \param sinrth: `double`
- * \param cosrph: `double`
- * \param sinrph: `double`
- * \param ll: `int`
- * \param ylm: Vector of complex.
+ * The role of this function is to compute the scattering amplitude and the intensity of
+ * the scattered field. See Sec. 4.2 in Borghese, Denti & Saija (2007).
+ *
+ * \param nsph: `int` Number of spheres.
+ * \param lm: `int` Maximum field expansion order.
+ * \param vk: `double` Wave number in scale units.
+ * \param exri: `double` External medium refractive index.
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
*/
-void sphar(
- double cosrth, double sinrth, double cosrph, double sinrph,
- int ll, std::complex<double> *ylm
-) {
- const int rmp_size = ll;
- const int plegn_size = (ll + 1) * ll / 2 + ll + 1;
- double sinrmp[rmp_size], cosrmp[rmp_size], plegn[plegn_size];
- double four_pi = 8.0 * acos(0.0);
- double pi4irs = 1.0 / sqrt(four_pi);
- double x = cosrth;
- double y = sinrth;
- if (y < 0.0) y *= -1.0;
- double cllmo = 3.0;
- double cll = 1.5;
- double ytol = y;
- plegn[0] = 1.0;
- plegn[1] = x * sqrt(cllmo);
- plegn[2] = ytol * sqrt(cll);
- sinrmp[0] = sinrph;
- cosrmp[0] = cosrph;
- if (ll >= 2) {
- int k = 3;
- for (int l20 = 2; l20 <= ll; l20++) {
- int lmo = l20 - 1;
- int ltpo = l20 + l20 + 1;
- int ltmo = ltpo - 2;
- int lts = ltpo * ltmo;
- double cn = 1.0 * lts;
- for (int mpo10 = 1; mpo10 <= lmo; mpo10++) {
- int m = mpo10 - 1;
- int mpopk = mpo10 + k;
- int ls = (l20 + m) * (l20 - m);
- double cd = 1.0 * ls;
- double cnm = 1.0 * ltpo * (lmo + m) * (l20 - mpo10);
- double cdm = 1.0 * ls * (ltmo - 2);
- plegn[mpopk - 1] = plegn[mpopk - l20 - 1] * x * sqrt(cn / cd) -
- plegn[mpopk - ltmo - 1] * sqrt(cnm / cdm);
- }
- int lpk = l20 + k;
- double cltpo = 1.0 * ltpo;
- plegn[lpk - 1] = plegn[k - 1] * x * sqrt(cltpo);
- k = lpk + 1;
- double clt = 1.0 * (ltpo - 1);
- cll *= (cltpo / clt);
- ytol *= y;
- plegn[k - 1] = ytol * sqrt(cll);
- sinrmp[l20 - 1] = sinrph * cosrmp[lmo - 1] + cosrph * sinrmp[lmo - 1];
- cosrmp[l20 - 1] = cosrph * cosrmp[lmo - 1] - sinrph * sinrmp[lmo - 1];
- } // end l20 loop
- }
- // label 30
- int l = 0;
- int m, k, l0y, l0p, lmy, lmp;
- double save;
-label40:
- m = 0;
- k = l * (l + 1);
- l0y = k + 1;
- l0p = k / 2 + 1;
- ylm[l0y - 1] = pi4irs * plegn[l0p - 1];
- goto label45;
-label44:
- lmp = l0p + m;
- save = pi4irs * plegn[lmp - 1];
- lmy = l0y + m;
- ylm[lmy - 1] = save * std::complex<double>(cosrmp[m - 1], sinrmp[m - 1]);
- if (m % 2 != 0) ylm[lmy - 1] *= -1.0;
- lmy = l0y - m;
- ylm[lmy - 1] = save * std::complex<double>(cosrmp[m - 1], -sinrmp[m - 1]);
-label45:
- if (m >= l) goto label47;
- m += 1;
- goto label44;
-label47:
- if (l >= ll) return;
- l += 1;
- goto label40;
-}
+void sscr2(int nsph, int lm, double vk, double exri, C1 *c1);
-/*! \brief C++ porting of THDPS
+/*! \brief Determine the geometrical asymmetry parameter coefficients.
*
- * \param lm: `int`
- * \param zpv: `double ****`
+ * This function computes the coefficients that enter the definition of the geometrical
+ * asymmetry parameter based on the L-value of the field expansion order. See Sec. 3.2.1
+ * in Borghese, Denti & Saija (2007).
+ *
+ * \param lm: `int` Maximum field expansion order.
+ * \param zpv: `double ****` Matrix of geometrical asymmetry parameter coefficients.
*/
-void thdps(int lm, double ****zpv) {
- //for (int l10 = 0; l10 < lm; l10++) { // 0-init, can be omitted
- // for (int ilmp = 0; ilmp < 3; ilmp++) {
- // zpv[l10][ilmp][0][0] = 0.0;
- // zpv[l10][ilmp][0][1] = 0.0;
- // zpv[l10][ilmp][1][0] = 0.0;
- // zpv[l10][ilmp][1][1] = 0.0;
- // }
- //}
- for (int l15 = 0; l15 < lm; l15++) {
- int l = l15 + 1;
- double xd = 1.0 * l * (l + 1);
- double zp = -1.0 / sqrt(xd);
- zpv[l15][1][0][1] = zp;
- zpv[l15][1][1][0] = zp;
- }
- if (lm != 1) {
- for (int l20 = 1; l20 < lm; l20++) {
- int l = l20 + 1;
- double xn = 1.0 * (l - 1) * (l + 1);
- double xd = 1.0 * l * (l + l + 1);
- double zp = sqrt(xn / xd);
- zpv[l20][0][0][0] = zp;
- zpv[l20][0][1][1] = zp;
- }
- int lmmo = lm - 1;
- for (int l25 = 0; l25 < lmmo; l25++) {
- int l = l25 + 1;
- double xn = 1.0 * l * (l + 2);
- double xd = (l + 1) * (l + l + 1);
- double zp = -1.0 * sqrt(xn / xd);
- zpv[l25][2][0][0] = zp;
- zpv[l25][2][1][1] = zp;
- }
- }
-}
+void thdps(int lm, double ****zpv);
/*! \brief C++ porting of UPVMP
*
@@ -1067,36 +335,15 @@ void thdps(int lm, double ****zpv) {
* \param un: `double *`
*/
void upvmp(
- double thd, double phd, int icspnv, double &cost, double &sint,
- double &cosp, double &sinp, double *u, double *up, double *un
-) {
- double half_pi = acos(0.0);
- double rdr = half_pi / 90.0;
- double th = thd * rdr;
- double ph = phd * rdr;
- cost = cos(th);
- sint = sin(th);
- cosp = cos(ph);
- sinp = sin(ph);
- u[0] = cosp * sint;
- u[1] = sinp * sint;
- u[2] = cost;
- up[0] = cosp * cost;
- up[1] = sinp * cost;
- up[2] = -sint;
- un[0] = -sinp;
- un[1] = cosp;
- un[2] = 0.0;
- if (icspnv != 0) {
- up[0] *= -1.0;
- up[1] *= -1.0;
- up[2] *= -1.0;
- un[0] *= -1.0;
- un[1] *= -1.0;
- }
-}
+ double thd, double phd, int icspnv, double &cost, double &sint,
+ double &cosp, double &sinp, double *u, double *up, double *un
+);
-/*! \brief C++ porting of UPVSP
+/*! \brief Compute the unitary vector perpendicular to incident and scattering plane.
+ *
+ * This function computes the unitary vector perpendicular to the incident and scattering
+ * plane in a geometry based on the scattering plane. It uses `orunve()`. See Sec. 2.7 in
+ * Borghese, Denti & Saija (2007).
*
* \param u: `double *`
* \param upmp: `double *`
@@ -1111,136 +358,59 @@ void upvmp(
* \param duk: `double *`
* \param isq: `int &`
* \param ibf: `int &`
- * \param scand: `double &`
+ * \param scand: `double &` Scattering angle in degrees.
* \param cfmp: `double &`
* \param sfmp: `double &`
* \param cfsp: `double &`
* \param sfsp: `double &`
*/
void upvsp(
- double *u, double *upmp, double *unmp, double *us, double *upsmp, double *unsmp,
- double *up, double *un, double *ups, double *uns, double *duk, int &isq,
- int &ibf, double &scand, double &cfmp, double &sfmp, double &cfsp, double &sfsp
-) {
- double rdr = acos(0.0) / 90.0;
- double small = 1.0e-6;
- isq = 0;
- scand = u[0] * us[0] + u[1] * us[1] + u[2] * us[2];
- double abs_scand = (scand >= 1.0) ? scand - 1.0 : 1.0 - scand;
- if (abs_scand >= small) {
- abs_scand = scand + 1.0;
- if (abs_scand < 0.0) abs_scand *= -1.0;
- if (abs_scand >= small) {
- scand = acos(scand) / rdr;
- duk[0] = u[0] - us[0];
- duk[1] = u[1] - us[1];
- duk[2] = u[2] - us[2];
- ibf = 0;
- } else { // label 15
- scand = 180.0;
- duk[0] = 2.0 * u[0];
- duk[1] = 2.0 * u[1];
- duk[2] = 2.0 * u[2];
- ibf = 1;
- ups[0] = -upsmp[0];
- ups[1] = -upsmp[1];
- ups[2] = -upsmp[2];
- uns[0] = -unsmp[0];
- uns[1] = -unsmp[1];
- uns[2] = -unsmp[2];
- }
- } else { // label 10
- scand = 0.0;
- duk[0] = 0.0;
- duk[1] = 0.0;
- duk[2] = 0.0;
- ibf = -1;
- isq = -1;
- ups[0] = upsmp[0];
- ups[1] = upsmp[1];
- ups[2] = upsmp[2];
- uns[0] = unsmp[0];
- uns[1] = unsmp[1];
- uns[2] = unsmp[2];
- }
- if (ibf == -1 || ibf == 1) { // label 20
- up[0] = upmp[0];
- up[1] = upmp[1];
- up[2] = upmp[2];
- un[0] = unmp[0];
- un[1] = unmp[1];
- un[2] = unmp[2];
- } else { // label 25
- orunve(u, us, un, -1, small);
- uns[0] = un[0];
- uns[1] = un[1];
- uns[2] = un[2];
- orunve(un, u, up, 1, small);
- orunve(uns, us, ups, 1, small);
- }
- // label 85
- cfmp = upmp[0] * up[0] + upmp[1] * up[1] + upmp[2] * up[2];
- sfmp = unmp[0] * up[0] + unmp[1] * up[1] + unmp[2] * up[2];
- cfsp = ups[0] * upsmp[0] + ups[1] * upsmp[1] + ups[2] * upsmp[2];
- sfsp = uns[0] * upsmp[0] + uns[1] * upsmp[1] + uns[2] * upsmp[2];
-}
+ double *u, double *upmp, double *unmp, double *us, double *upsmp, double *unsmp,
+ double *up, double *un, double *ups, double *uns, double *duk, int &isq,
+ int &ibf, double &scand, double &cfmp, double &sfmp, double &cfsp, double &sfsp
+);
-/*! \brief C++ porting of WMAMP
+/*! \brief Compute meridional plane-referred geometrical asymmetry parameter coefficients.
+ *
+ * This function computes the coeffcients that define the geometrical symmetry parameter
+ * as defined with respect to the meridional plane. It makes use of `sphar()` and `pwma()`.
+ * See Sec. 3.2.1 in Borghese, Denti & Saija (2007).
*
* \param iis: `int`
- * \param cost: `double`
- * \param sint: `double`
- * \param cosp: `double`
- * \param sinp: `double`
- * \param inpol: `int`
- * \param lm: `int`
+ * \param cost: `double` Cosine of the elevation angle.
+ * \param sint: `double` Sine of the elevation angle.
+ * \param cosp: `double` Cosine of the azimuth angle.
+ * \param sinp: `double` Sine of the azimuth angle.
+ * \param inpol: `int` Incident field polarization type (0 - linear; 1 - circular).
+ * \param lm: `int` Maximum field expansion orde.
* \param idot: `int`
- * \param nsph: `int`
+ * \param nsph: `int` Number of spheres.
* \param arg: `double *`
* \param u: `double *`
* \param up: `double *`
* \param un: `double *`
- * \param c1: `C1 *`
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
*/
void wmamp(
- int iis, double cost, double sint, double cosp, double sinp, int inpol,
- int lm, int idot, int nsph, double *arg, double *u, double *up,
- double *un, C1 *c1
-) {
- const int ylm_size = (lm + 1) * (lm + 1) + 1;
- std::complex<double> *ylm = new std::complex<double>[ylm_size];
- const int nlmp = lm * (lm + 2) + 2;
- ylm[nlmp - 1] = std::complex<double>(0.0, 0.0);
- if (idot != 0) {
- if (idot != 1) {
- for (int n40 = 0; n40 < nsph; n40++) {
- arg[n40] = u[0] * c1->rxx[n40] + u[1] * c1->ryy[n40] + u[2] * c1->rzz[n40];
- }
- } else {
- for (int n50 = 0; n50 < nsph; n50++) {
- arg[n50] = c1->rzz[n50];
- }
- }
- if (iis == 2) {
- for (int n60 = 0; n60 < nsph; n60++) arg[n60] *= -1;
- }
- }
- sphar(cost, sint, cosp, sinp, lm, ylm);
- //printf("DEBUG: in WMAMP and calling PWMA with lm = %d and iis = %d\n", lm, iis);
- pwma(up, un, ylm, inpol, lm, iis, c1);
- delete[] ylm;
-}
+ int iis, double cost, double sint, double cosp, double sinp, int inpol,
+ int lm, int idot, int nsph, double *arg, double *u, double *up,
+ double *un, C1 *c1
+);
-/*! \brief C++ porting of WMASP
- *
- * \param cost: `double`
- * \param sint: `double`
- * \param cosp: `double`
- * \param sinp: `double`
- * \param costs: `double`
- * \param sints: `double`
- * \param cosps: `double`
- * \param sinps: `double`
+/*! \brief Compute the scattering plane-referred geometrical asymmetry parameter coefficients.
+ *
+ * This function computes the coefficients that define the geometrical asymmetry parameter based
+ * on the L-value with respect to the scattering plane. It uses `sphar()` and `pwma()`. See Sec.
+ * 3.2.1 in Borghese, Denti and Saija (2007).
+ *
+ * \param cost: `double` Cosine of elevation angle.
+ * \param sint: `double` Sine of elevation angle.
+ * \param cosp: `double` Cosine of azimuth angle.
+ * \param sinp: `double` Sine of azimuth angle.
+ * \param costs: `double` Cosine of scattering elevation angle.
+ * \param sints: `double` Sine of scattering elevation angle.
+ * \param cosps: `double` Cosine of scattering azimuth angle.
+ * \param sinps: `double` Sine of scattering azimuth angle.
* \param u: `double *`
* \param up: `double *`
* \param un: `double *`
@@ -1249,209 +419,19 @@ void wmamp(
* \param uns: `double *`
* \param isq: `int`
* \param ibf: `int`
- * \param inpol: `int`
- * \param lm: `int`
+ * \param inpol: `int` Incident field polarization (0 - linear; 1 -circular).
+ * \param lm: `int` Maximum field expansion order.
* \param idot: `int`
- * \param nsph: `int`
+ * \param nsph: `int` Number opf spheres.
* \param argi: `double *`
* \param args: `double *`
- * \param c1: `C1 *`
+ * \param c1: `C1 *` Pointer to a `C1` data structure.
*/
void wmasp(
- double cost, double sint, double cosp, double sinp, double costs, double sints,
- double cosps, double sinps, double *u, double *up, double *un, double *us,
- double *ups, double *uns, int isq, int ibf, int inpol, int lm, int idot,
- int nsph, double *argi, double *args, C1 *c1
-) {
- const int ylm_size = (lm + 1) * (lm + 1) + 1;
- std::complex<double> *ylm = new std::complex<double>[ylm_size];
- const int nlmp = lm * (lm + 2) + 2;
- ylm[nlmp - 1] = std::complex<double>(0.0, 0.0);
- if (idot != 0) {
- if (idot != 1) {
- for (int n40 = 0; n40 < nsph; n40++) {
- argi[n40] = u[0] * c1->rxx[n40] + u[1] * c1->ryy[n40] + u[2] * c1->rzz[n40];
- if (ibf != 0) {
- args[n40] = argi[n40] * ibf;
- } else {
- args[n40] = -1.0 * (us[0] * c1->rxx[n40] + us[1] * c1->ryy[n40] + us[2] * c1->rzz[n40]);
- }
- }
- } else { // label 50
- for (int n60 = 0; n60 < nsph; n60++) {
- argi[n60] = cost * c1->rzz[n60];
- if (ibf != 0) {
- args[n60] = argi[n60] * ibf;
- } else {
- args[n60] = -costs * c1->rzz[n60];
- }
- }
- }
- }
- sphar(cost, sint, cosp, sinp, lm, ylm);
- //printf("DEBUG: in WMASP and calling PWMA with isq = %d\n", isq);
- pwma(up, un, ylm, inpol, lm, isq, c1);
- if (ibf >= 0) {
- sphar(costs, sints, cosps, sinps, lm, ylm);
- //printf("DEBUG: in WMASP and calling PWMA with isq = 2 and ibf = %d\n", ibf);
- pwma(ups, uns, ylm, inpol, lm, 2, c1);
- }
- delete[] ylm;
-}
-
-/*! \brief C++ porting of DME
- *
- * \param li: `int`
- * \param i: `int`
- * \param npnt: `int`
- * \param npntts: `int`
- * \param vk: `double`
- * \param exdc: `double`
- * \param exri: `double`
- * \param c1: `C1 *`
- * \param c2: `C2 *`
- * \param jer: `int &`
- * \param lcalc: `int &`
- * \param arg: `complex<double> &`.
- */
-void dme(
- int li, int i, int npnt, int npntts, double vk, double exdc, double exri,
- C1 *c1, C2 *c2, int &jer, int &lcalc, std::complex<double> &arg) {
- const int lipo = li + 1;
- const int lipt = li + 2;
- double *rfj = new double[lipt];
- double *rfn = new double[lipt];
- std::complex<double> cfj[lipt], fbi[lipt], fb[lipt], fn[lipt];
- std::complex<double> rmf[li], drmf[li], ref[li], dref[li];
- std::complex<double> dfbi, dfb, dfn, ccna, ccnb, ccnc, ccnd;
- std::complex<double> y1, dy1, y2, dy2, arin, cri, uim;
- jer = 0;
- uim = std::complex<double>(0.0, 1.0);
- int nstp = npnt - 1;
- int nstpts = npntts - 1;
- double sz = vk * c1->ros[i - 1];
- c2->vsz[i - 1] = sz;
- double vkr1 = vk * c1->rc[i - 1][0];
- int nsh = c1->nshl[i - 1];
- c2->vkt[i - 1] = std::sqrt(c2->dc0[0]);
- arg = vkr1 * c2->vkt[i - 1];
- arin = arg;
- bool goto32 = false;
- if (arg.imag() != 0.0) {
- cbf(lipo, arg, lcalc, cfj);
- if (lcalc < lipo) {
- jer = 5;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- for (int j24 = 1; j24 <= lipt; j24++) fbi[j24 - 1] = cfj[j24 - 1];
- goto32 = true;
- }
- if (!goto32) {
- rbf(lipo, arg.real(), lcalc, rfj);
- if (lcalc < lipo) {
- jer = 5;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- for (int j30 = 1; j30 <= lipt; j30++) fbi[j30 - 1] = rfj[j30 - 1];
- }
- double arex = sz * exri;
- arg = arex;
- rbf(lipo, arex, lcalc, rfj);
- if (lcalc < lipo) {
- jer = 7;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- rnf(lipo, arex, lcalc, rfn);
- if (lcalc < lipo) {
- jer = 8;
- delete[] rfj;
- delete[] rfn;
- return;
- }
- for (int j43 = 1; j43 <= lipt; j43++) {
- fb[j43 - 1] = rfj[j43 - 1];
- fn[j43 - 1] = rfn[j43 - 1];
- }
- if (nsh <= 1) {
- cri = c2->dc0[0] / exdc;
- for (int l60 = 1; l60 <= li; l60++) {
- int lpo = l60 + 1;
- int ltpo = lpo + l60;
- int lpt = lpo + 1;
- dfbi = ((1.0 * l60) * fbi[l60 - 1] - (1.0 * lpo) * fbi[lpt - 1]) * arin + fbi[lpo - 1] * (1.0 * ltpo);
- dfb = ((1.0 * l60) * fb[l60 - 1] - (1.0 * lpo) * fb[lpt - 1]) * arex + fb[lpo - 1] * (1.0 * ltpo);
- dfn = ((1.0 * l60) * fn[l60 - 1] - (1.0 * lpo) * fn[lpt - 1]) * arex + fn[lpo - 1] * (1.0 * ltpo);
- ccna = fbi[lpo - 1] * dfn;
- ccnb = fn[lpo - 1] * dfbi;
- ccnc = fbi[lpo - 1] * dfb;
- ccnd = fb[lpo - 1] * dfbi;
- c1->rmi[l60 - 1][i - 1] = 1.0 + uim * (ccna - ccnb) / (ccnc - ccnd);
- c1->rei[l60 - 1][i - 1] = 1.0 + uim * (cri * ccna - ccnb) / (cri * ccnc - ccnd);
- }
- } else { // nsh > 1
- int ic = 1;
- for (int l80 = 1; l80 <= li; l80++) {
- int lpo = l80 + 1;
- int ltpo = lpo + l80;
- int lpt = lpo + 1;
- int dltpo = ltpo;
- y1 = fbi[lpo - 1];
- dy1 = ((1.0 * l80) * fbi[l80 - 1] - (1.0 * lpo) * fbi[lpt - 1]) * c2->vkt[i - 1] / (1.0 * dltpo);
- y2 = y1;
- dy2 = dy1;
- ic = 1;
- for (int ns76 = 2; ns76 <= nsh; ns76++) {
- int nsmo = ns76 - 1;
- double vkr = vk * c1->rc[i - 1][nsmo - 1];
- if (ns76 % 2 != 0) {
- ic += 1;
- double step = 1.0 * nstp;
- step = vk * (c1->rc[i - 1][ns76 - 1] - c1->rc[i - 1][nsmo - 1]) / step;
- arg = c2->dc0[ic - 1];
- rkc(nstp, step, arg, vkr, lpo, y1, y2, dy1, dy2);
- } else {
- diel(nstpts, nsmo, i, ic, vk, c1, c2);
- double stepts = 1.0 * nstpts;
- stepts = vk * (c1->rc[i - 1][ns76 - 1] - c1->rc[i - 1][nsmo - 1]) / stepts;
- rkt(nstpts, stepts, vkr, lpo, y1, y2, dy1, dy2, c2);
- }
- }
- rmf[l80 - 1] = y1 * sz;
- drmf[l80 - 1] = dy1 * sz + y1;
- ref[l80 - 1] = y2 * sz;
- dref[l80 - 1] = dy2 * sz + y2;
- }
- cri = 1.0 + uim * 0.0;
- if (nsh % 2 != 0) cri = c2->dc0[ic - 1] / exdc;
- for (int l90 = 1; l90 <= li; l90++) {
- int lpo = l90 + 1;
- int ltpo = lpo + l90;
- int lpt = lpo + 1;
- dfb = ((1.0 * l90) * fb[l90 - 1] - (1.0 * lpo) * fb[lpt - 1]) * arex + fb[lpo - 1] * (1.0 * ltpo);
- dfn = ((1.0 * l90) * fn[l90 - 1] - (1.0 * lpo) * fn[lpt - 1]) * arex + fn[lpo - 1] * (1.0 * ltpo);
- ccna = rmf[l90 - 1] * dfn;
- ccnb = drmf[l90 - 1] * fn[lpo - 1] * (1.0 * sz * ltpo);
- ccnc = rmf[l90 - 1] * dfb;
- ccnd = drmf[l90 - 1] * fb[lpo -1] * (1.0 * sz * ltpo);
- c1->rmi[l90 - 1][i - 1] = 1.0 + uim *(ccna - ccnb) / (ccnc - ccnd);
- //printf("DEBUG: gone 90, rmi[%d][%d] = (%lE,%lE)\n", l90, i, c1->rmi[l90 - 1][i - 1].real(), c1->rmi[l90 - 1][i - 1].imag());
- ccna = ref[l90 - 1] * dfn;
- ccnb = dref[l90 - 1] * fn[lpo - 1] * (1.0 * sz * ltpo);
- ccnc = ref[l90 - 1] * dfb;
- ccnd = dref[l90 - 1] *fb[lpo - 1] * (1.0 * sz * ltpo);
- c1->rei[l90 - 1][i - 1] = 1.0 + uim * (cri * ccna - ccnb) / (cri * ccnc - ccnd);
- //printf("DEBUG: gone 90, rei[%d][%d] = (%lE,%lE)\n", l90, i, c1->rei[l90 - 1][i - 1].real(), c1->rei[l90 - 1][i - 1].imag());
- }
- } // nsh <= 1 ?
- delete[] rfj;
- delete[] rfn;
- return;
-}
+ double cost, double sint, double cosp, double sinp, double costs, double sints,
+ double cosps, double sinps, double *u, double *up, double *un, double *us,
+ double *ups, double *uns, int isq, int ibf, int inpol, int lm, int idot,
+ int nsph, double *argi, double *args, C1 *c1
+);
#endif /* SRC_INCLUDE_SPH_SUBS_H_ */
diff --git a/src/include/tra_subs.h b/src/include/tra_subs.h
new file mode 100644
index 0000000000000000000000000000000000000000..33d9781bed4c081c8ee34e2e7d322034f6148350
--- /dev/null
+++ b/src/include/tra_subs.h
@@ -0,0 +1,187 @@
+/*! \file tra_subs.h
+ *
+ * \brief C++ porting of TRAPPING functions and subroutines.
+ *
+ * This library includes a collection of functions that are used to solve the
+ * trapping problem. The functions that were generalized from the case of the
+ * single sphere are imported the `sph_subs.h` library. As it occurs with the
+ * single sphere case functions, in most cases, the results of calculations do
+ * not fall back to fundamental data types. They are rather multi-component
+ * structures. In order to manage access to such variety of return values, most
+ * functions are declared as `void` and they operate on output arguments passed
+ * by reference.
+ */
+
+#ifndef INCLUDE_TRA_SUBS_H_
+#define INCLUDE_TRA_SUBS_H_
+#endif
+
+// Structures for TRAPPING
+/*! \brief CIL data structure.
+ *
+ * A structure containing field expansion order configuration.
+ */
+struct CIL {
+ //! Maximum L expansion of the electric field.
+ int le;
+ //! le * (le + 1).
+ int nlem;
+ //! 2 * nlem.
+ int nlemt;
+ //! Maximum field expansion order + 1.
+ int mxmpo;
+ //! 2 * mxmpo - 1.
+ int mxim;
+};
+
+/*! \brief CCR data structure.
+ *
+ * A structure containing geometrical asymmetry parameter normalization coefficients.
+ */
+struct CCR {
+ //! First coefficient.
+ double cof;
+ //! Second coefficient.
+ double cimu;
+};
+//End of TRAPPING structures
+
+/*! C++ porting of CAMP
+ *
+ * \param ac: Vector of complex. QUESTION: definition?
+ * \param am0m: Matrix of complex. QUESTION: definition?
+ * \param ws: Vector of complex. QUESTION: definition?
+ * \param cil: `CIL *` Pointer to a CIL structure.
+ *
+ * This function builds the AC vector using AM0M and WS.
+ */
+void camp(
+ std::complex<double> *ac, std::complex<double> **am0m, std::complex<double> *ws,
+ CIL *cil
+);
+
+/*! C++ porting of CZAMP
+ *
+ * \param ac: Vector of complex. QUESTION: definition?
+ * \param amd: Matrix of complex. QUESTION: definition?
+ * \param indam: `int **`. QUESTION: definition?
+ * \param ws: Vector of complex. QUESTION: definition?
+ * \param cil: `CIL *` Pointer to a CIL structure.
+ *
+ * This function builds the AC vector using AMD, INDAM and WS.
+ */
+void czamp(
+ std::complex<double> *ac, std::complex<double> **amd, int **indam,
+ std::complex<double> *ws, CIL *cil
+);
+
+/*! C++ porting of FFRF
+ *
+ * \param zpv: `double ****`. QUESTION: definition?
+ * \param ac: Vector of complex. QUESTION: definition?
+ * \param ws: Vector of complex. QUESTION: definition?
+ * \param fffe: `double *`. QUESTION: definition?
+ * \param fffs: `double *`. QUESTION: definition?
+ * \param cil: `CIL *` Pointer to a CIL structure.
+ * \param ccr: `CCR *` Pointer to a CCR structure.
+ */
+void ffrf(
+ double ****zpv, std::complex<double> *ac, std::complex<double> *ws, double *fffe,
+ double *fffs, CIL *cil, CCR *ccr
+);
+
+/*! C++ porting of FFRT
+ *
+ * \param ac: Vector of complex. QUESTION: definition?
+ * \param ws: Vector of complex. QUESTION: definition?
+ * \param ffte: `double *`. QUESTION: definition?
+ * \param ffts: `double *`. QUESTION: definition?
+ * \param cil: `CIL *` Pointer to a CIL structure.
+ * \param ccr: `CCR *` Pointer to a CCR structure.
+ */
+void ffrt(
+ std::complex<double> *ac, std::complex<double> *ws, double *ffte, double *ffts,
+ CIL *cil
+);
+
+/*! C++ porting of FRFMER
+ *
+ * \param nkv: `int` QUESTION: definition?
+ * \param vkm: `double` QUESTION: definition?
+ * \param vkv: `double *` QUESTION: definition?
+ * \param vknmx: `double` QUESTION: definition?
+ * \param apfafa: `double` QUESTION: definition?
+ * \param tra: `double` QUESTION: definition?
+ * \param spd: `double` QUESTION: definition?
+ * \param rir: `double` QUESTION: definition?
+ * \param ftcn: `double` QUESTION: definition?
+ * \param le: `int` QUESTION: definition?
+ * \param lmode: `int` QUESTION: definition?
+ * \param pmf: `double` QUESTION: definition?
+ * \param tt1: `fstream &` Handle to first temporary binary file.
+ * \param tt2: `fstream &` Handle to second temporary binary file.
+ */
+void frfmer(
+ int nkv, double vkm, double *vkv, double vknmx, double apfafa, double tra,
+ double spd, double rir, double ftcn, int le, int lmode, double pmf,
+ std::fstream &tt1, std::fstream &tt2
+);
+
+/*! C++ porting of PWMALP
+ *
+ * \param w: Matrix of complex. QUESTION: definition?
+ * \param up: `double *`
+ * \param un: `double *`
+ * \param ylm: Vector of complex
+ * \param lw: `int`
+ */
+void pwmalp(std::complex<double> **w, double *up, double *un, std::complex<double> *ylm, int lw);
+
+/*! C++ porting of SAMP
+ *
+ * \param ac: Vector of complex. QUESTION: definition?
+ * \param tmsm: Vector of complex. QUESTION: definition?
+ * \param tmse: Vector of complex. QUESTION: definition?
+ * \param ws: Vector of complex. QUESTION: definition?
+ * \param cil: `CIL *` Pointer to a CIL structure.
+ *
+ * This function builds the AC vector using TMSM, TMSE and WS.
+ */
+void samp(
+ std::complex<double> *ac, std::complex<double> *tmsm, std::complex<double> *tmse,
+ std::complex<double> *ws, CIL *cil
+);
+
+/*! C++ porting of SAMPOA
+ *
+ * \param ac: Vector of complex. QUESTION: definition?
+ * \param tms: Matrix of complex. QUESTION: definition?
+ * \param ws: Vector of complex. QUESTION: definition?
+ * \param cil: `CIL *` Pointer to a CIL structure.
+ *
+ * This function builds the AC vector using TMS and WS.
+ */
+void sampoa(
+ std::complex<double> *ac, std::complex<double> **tms, std::complex<double> *ws,
+ CIL *cil
+);
+
+/*! C++ porting of WAMFF
+ *
+ * \param wk: Vector of complex. QUESTION: definition?
+ * \param x: `double`
+ * \param y: `double`
+ * \param z: `double`
+ * \param lm: `int`
+ * \param apfafa: `double` QUESTION: definition?
+ * \param tra: `double` QUESTION: definition?
+ * \param spd: `double` QUESTION: definition?
+ * \param rir: `double` QUESTION: definition?
+ * \param ftcn: `double` QUESTION: definition?
+ * \param lmode: `int` QUESTION: definition?
+ * \param pmf: `double` QUESTION: definition?
+ */
+void wamff(
+ std::complex<double> *wk, double x, double y, double z, int lm, double apfafa,
+ double tra, double spd, double rir, double ftcn, int lmode, double pmf
+);
diff --git a/src/libnptm/Commons.cpp b/src/libnptm/Commons.cpp
index 6717bac3a03d13b933ff57bcbe46cfc9ae85fd3a..8031eaad68f3127546b222eb3d0e62bff6f5e0be 100644
--- a/src/libnptm/Commons.cpp
+++ b/src/libnptm/Commons.cpp
@@ -10,6 +10,7 @@
* to the configuration objects. These, on their turn, need to
* expose methods to access the relevant data in read-only mode.
*/
+#include <complex>
#ifndef INCLUDE_COMMONS_H
#include "../include/Commons.h"
diff --git a/src/libnptm/Configuration.cpp b/src/libnptm/Configuration.cpp
index 96d055a11f555c217044cec6802461dd465effd7..5d1c05d898179cca789efc59061ee3600a8a899c 100644
--- a/src/libnptm/Configuration.cpp
+++ b/src/libnptm/Configuration.cpp
@@ -2,13 +2,29 @@
*/
#include <cmath>
+#include <complex>
#include <cstdio>
+#include <exception>
#include <fstream>
#include <regex>
#include <string>
+#include <hdf5.h>
+
+#ifndef INCLUDE_LIST_H_
#include "../include/List.h"
+#endif
+
+#ifndef INCLUDE_PARSERS_H_
#include "../include/Parsers.h"
+#endif
+
+#ifndef INCLUDE_CONFIGURATION_H_
#include "../include/Configuration.h"
+#endif
+
+#ifndef INCLUDE_FILE_IO_H_
+#include "../include/file_io.h"
+#endif
using namespace std;
@@ -109,7 +125,7 @@ GeometryConfiguration* GeometryConfiguration::from_legacy(string file_name) {
} else {
for (int i = 0; i < _nsph; i++) {
str_target = file_lines[last_read_line++];
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
for (int ri = 0; ri < 3; ri++) {
regex_search(str_target, m, re);
str_num = regex_replace(m.str(), regex("D"), "e");
@@ -122,7 +138,7 @@ GeometryConfiguration* GeometryConfiguration::from_legacy(string file_name) {
}
}
double in_th_start, in_th_end, in_th_step, sc_th_start, sc_th_end, sc_th_step;
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
str_target = file_lines[last_read_line++];
for (int ri = 0; ri < 6; ri++) {
regex_search(str_target, m, re);
@@ -193,8 +209,8 @@ ScattererConfiguration::ScattererConfiguration(
radii_of_spheres = ros_vector;
nshl_vec = nshl_vector;
rcf = rcf_vector;
- idfc = dielectric_func_type,
- dc0_matrix = dc_matrix;
+ idfc = dielectric_func_type;
+ dc0_matrix = dc_matrix;
use_external_sphere = is_external;
exdc = ex;
wp = w;
@@ -238,6 +254,24 @@ ScattererConfiguration::~ScattererConfiguration() {
}
ScattererConfiguration* ScattererConfiguration::from_binary(string file_name, string mode) {
+ ScattererConfiguration *conf = NULL;
+ if (mode.compare("LEGACY") == 0) {
+ conf = ScattererConfiguration::from_legacy(file_name);
+ } else if (mode.compare("HDF5") == 0) {
+ conf = ScattererConfiguration::from_hdf5(file_name);
+ } else {
+ string message = "Unknown format mode: \"" + mode + "\"";
+ throw UnrecognizedConfigurationException(message);
+ }
+ return conf;
+}
+
+ScattererConfiguration* ScattererConfiguration::from_hdf5(string file_name) {
+ ScattererConfiguration *conf = NULL;
+ return conf;
+}
+
+ScattererConfiguration* ScattererConfiguration::from_legacy(string file_name) {
int nsph;
int *iog;
double _exdc, _wp, _xip;
@@ -247,80 +281,78 @@ ScattererConfiguration* ScattererConfiguration::from_binary(string file_name, st
double *ros_vector;
double **rcf_vector;
complex<double> ***dc0m;
- if (mode.compare("LEGACY") == 0) { // Legacy mode was chosen.
- int max_ici = 0;
- fstream input;
- input.open(file_name.c_str(), ios::in | ios::binary);
- if (input.is_open()) {
- input.read(reinterpret_cast<char *>(&nsph), sizeof(int));
- iog = new int[nsph]();
- for (int i = 0; i < nsph; i++) {
- input.read(reinterpret_cast<char *>(&(iog[i])), sizeof(int));
+
+ int max_ici = 0;
+ fstream input;
+ input.open(file_name.c_str(), ios::in | ios::binary);
+ if (input.is_open()) {
+ input.read(reinterpret_cast<char *>(&nsph), sizeof(int));
+ iog = new int[nsph]();
+ for (int i = 0; i < nsph; i++) {
+ input.read(reinterpret_cast<char *>(&(iog[i])), sizeof(int));
+ }
+ input.read(reinterpret_cast<char *>(&_exdc), sizeof(double));
+ input.read(reinterpret_cast<char *>(&_wp), sizeof(double));
+ input.read(reinterpret_cast<char *>(&_xip), sizeof(double));
+ input.read(reinterpret_cast<char *>(&_idfc), sizeof(int));
+ input.read(reinterpret_cast<char *>(&nxi), sizeof(int));
+ try {
+ xi_vec = new double[nxi]();
+ } catch (const bad_alloc &ex) {
+ throw UnrecognizedConfigurationException("Wrong parameter set: invalid number of scales " + to_string(nxi));
+ }
+ for (int i = 0; i < nxi; i++) {
+ input.read(reinterpret_cast<char *>(&(xi_vec[i])), sizeof(double));
+ }
+ nshl_vector = new int[nsph]();
+ ros_vector = new double[nsph]();
+ rcf_vector = new double*[nsph];
+ for (int i115 = 1; i115 <= nsph; i115++) {
+ if (iog[i115 - 1] < i115) {
+ rcf_vector[i115 - 1] = new double[1]();
+ continue;
}
- input.read(reinterpret_cast<char *>(&_exdc), sizeof(double));
- input.read(reinterpret_cast<char *>(&_wp), sizeof(double));
- input.read(reinterpret_cast<char *>(&_xip), sizeof(double));
- input.read(reinterpret_cast<char *>(&_idfc), sizeof(int));
- input.read(reinterpret_cast<char *>(&nxi), sizeof(int));
+ input.read(reinterpret_cast<char *>(&(nshl_vector[i115 - 1])), sizeof(int));
+ input.read(reinterpret_cast<char *>(&(ros_vector[i115 - 1])), sizeof(double));
+ int nsh = nshl_vector[i115 - 1];
+ if (max_ici < (nsh + 1) / 2) max_ici = (nsh + 1) / 2;
try {
- xi_vec = new double[nxi]();
+ rcf_vector[i115 - 1] = new double[nsh]();
} catch (const bad_alloc &ex) {
- throw UnrecognizedConfigurationException("Wrong parameter set: invalid number of scales " + nxi);
- }
- for (int i = 0; i < nxi; i++) {
- input.read(reinterpret_cast<char *>(&(xi_vec[i])), sizeof(double));
+ throw UnrecognizedConfigurationException("Wrong parameter set: invalid number of layers " + to_string(nsh));
}
- nshl_vector = new int[nsph]();
- ros_vector = new double[nsph]();
- rcf_vector = new double*[nsph];
- for (int i115 = 1; i115 <= nsph; i115++) {
- if (iog[i115 - 1] < i115) {
- rcf_vector[i115 - 1] = new double[1]();
- continue;
- }
- input.read(reinterpret_cast<char *>(&(nshl_vector[i115 - 1])), sizeof(int));
- input.read(reinterpret_cast<char *>(&(ros_vector[i115 - 1])), sizeof(double));
- int nsh = nshl_vector[i115 - 1];
- if (max_ici < (nsh + 1) / 2) max_ici = (nsh + 1) / 2;
- try {
- rcf_vector[i115 - 1] = new double[nsh]();
- } catch (const bad_alloc &ex) {
- throw UnrecognizedConfigurationException("Wrong parameter set: invalid number of layers " + nsh);
- }
- for (int nsi = 0; nsi < nsh; nsi++) {
- input.read(reinterpret_cast<char *>(&(rcf_vector[i115 - 1][nsi])), sizeof(double));
- }
+ for (int nsi = 0; nsi < nsh; nsi++) {
+ input.read(reinterpret_cast<char *>(&(rcf_vector[i115 - 1][nsi])), sizeof(double));
}
- dc0m = new complex<double>**[max_ici];
- for (int dim1 = 0; dim1 < max_ici; dim1++) {
- dc0m[dim1] = new complex<double>*[nsph];
- for (int dim2 = 0; dim2 < nsph; dim2++) {
- dc0m[dim1][dim2] = new complex<double>[nxi]();
- }
+ }
+ dc0m = new complex<double>**[max_ici];
+ int dim3 = (_idfc == 0) ? nxi : 1;
+ for (int dim1 = 0; dim1 < max_ici; dim1++) {
+ dc0m[dim1] = new complex<double>*[nsph];
+ for (int dim2 = 0; dim2 < nsph; dim2++) {
+ dc0m[dim1][dim2] = new complex<double>[dim3]();
}
- for (int jxi468 = 1; jxi468 <= nxi; jxi468++) {
- if (_idfc != 0 && jxi468 > 1) continue;
- for (int i162 = 1; i162 <= nsph; i162++) {
- if (iog[i162 - 1] < i162) continue;
- int nsh = nshl_vector[i162 - 1];
- int ici = (nsh + 1) / 2; // QUESTION: is integer division really intended here?
- for (int i157 = 0; i157 < ici; i157++) {
- double dc0_real, dc0_img;
- input.read(reinterpret_cast<char *>(&dc0_real), sizeof(double));
- input.read(reinterpret_cast<char *>(&dc0_img), sizeof(double));
- dc0m[i157][i162 - 1][jxi468 - 1] = dc0_real + 1i * dc0_img;
- }
+ }
+ for (int jxi468 = 1; jxi468 <= nxi; jxi468++) {
+ if (_idfc != 0 && jxi468 > 1) continue;
+ for (int i162 = 1; i162 <= nsph; i162++) {
+ if (iog[i162 - 1] < i162) continue;
+ int nsh = nshl_vector[i162 - 1];
+ int ici = (nsh + 1) / 2; // QUESTION: is integer division really intended here?
+ for (int i157 = 0; i157 < ici; i157++) {
+ double dc0_real, dc0_img;
+ input.read(reinterpret_cast<char *>(&dc0_real), sizeof(double));
+ input.read(reinterpret_cast<char *>(&dc0_img), sizeof(double));
+ dc0m[i157][i162 - 1][jxi468 - 1] = dc0_real + 1i * dc0_img;
}
}
- input.close();
- } else { // Opening of the input file did not succeed.
- OpenConfigurationFileException ex(file_name);
- throw ex;
}
- } else { // A different binary format was chosen.
- //TODO: this part is not yet implemented.
- // Functions to write optimized file formats may be invoked here.
+ input.close();
+ } else { // Opening of the input file did not succeed.
+ OpenConfigurationFileException ex(file_name);
+ throw ex;
}
+
ScattererConfiguration *conf = new ScattererConfiguration(
nsph,
xi_vec,
@@ -365,7 +397,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
if (ies != 0) ies = 1;
double _exdc, _wp, _xip;
str_target = file_lines[++last_read_line];
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
for (int ri = 0; ri < 3; ri++) {
regex_search(str_target, m, re);
string str_number = m.str();
@@ -396,7 +428,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
double xi;
List<double> xi_vector;
str_target = file_lines[++last_read_line];
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
regex_search(str_target, m, re);
string str_number = m.str();
str_number = regex_replace(str_number, regex("D"), "e");
@@ -416,7 +448,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
} else { // instpc >= 1: the variable vector is defined in steps
double xi, xi_step;
str_target = file_lines[++last_read_line];
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
regex_search(str_target, m, re);
for (int ri = 0; ri < 2; ri++) {
regex_search(str_target, m, re);
@@ -439,7 +471,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
double vs;
for (int jxi_r = 0; jxi_r < nxi; jxi_r++) {
str_target = file_lines[++last_read_line];
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
regex_search(str_target, m, re);
string str_number = m.str();
str_number = regex_replace(str_number, regex("D"), "e");
@@ -467,7 +499,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
} else { // The variable vector needs to be computed in steps
double vs, vs_step;
str_target = file_lines[++last_read_line];
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
regex_search(str_target, m, re);
for (int ri = 0; ri < 2; ri++) {
regex_search(str_target, m, re);
@@ -501,20 +533,10 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
}
}
}
- //last_read_line++;
int *iog_vector = new int[nsph]();
double *ros_vector = new double[nsph]();
double **rcf_vector = new double*[nsph];
int *nshl_vector = new int[nsph]();
- /*for (int i = 0; i < nsph; i++) {
- string read_format = "";
- for (int j = 0; j < (i % 15); j++) read_format += " %*d";
- read_format += " %d";
- sscanf(file_lines[last_read_line].c_str(), read_format.c_str(), (iog_vector + i));
- if (i > 0 && i % 15 == 0) {
- last_read_line++;
- }
- }*/
int filled_iogs = 0;
re = regex("[0-9]+");
while (filled_iogs < nsph) {
@@ -537,7 +559,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
regex_search(str_target, m, re);
i_val = stoi(m.str());
str_target = m.suffix();
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
regex_search(str_target, m, re);
string str_number = m.str();
str_number = regex_replace(str_number, regex("D"), "e");
@@ -551,8 +573,6 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
rcf_vector[i113 - 1] = new double[nsh]();
for (int ns = 0; ns < nsh; ns++) {
double ns_rcf;
- //int ns_rcf_exp;
- //sscanf(file_lines[++last_read_line].c_str(), " %lf D%d", &ns_rcf, &ns_rcf_exp);
str_target = file_lines[++last_read_line];
regex_search(str_target, m, re);
str_number = m.str();
@@ -563,13 +583,14 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
}
}
complex<double> ***dc0m = new complex<double>**[max_ici];
+ int dim3 = (_idfc == 0) ? nxi : 1;
for (int dim1 = 0; dim1 < max_ici; dim1++) {
dc0m[dim1] = new complex<double>*[nsph];
for (int dim2 = 0; dim2 < nsph; dim2++) {
- dc0m[dim1][dim2] = new complex<double>[nxi]();
+ dc0m[dim1][dim2] = new complex<double>[dim3]();
}
}
- re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?)?[0-9]+");
+ re = regex("-?[0-9]+\\.[0-9]+([eEdD][-+]?[0-9]+)?");
for (int jxi468 = 1; jxi468 <= nxi; jxi468++) {
if (_idfc != 0 && jxi468 > 1) continue;
for (int i162 = 1; i162 <= nsph; i162++) {
@@ -579,8 +600,6 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
if (i162 == 1) ici = ici + ies;
for (int i157 = 0; i157 < ici; i157++) {
double dc0_real, dc0_img;
- //int dc0_real_exp, dc0_img_exp;
- //sscanf(file_lines[++last_read_line].c_str(), " (%lf D%d, %lf D%d)", &dc0_real, &dc0_real_exp, &dc0_img, &dc0_img_exp);
str_target = file_lines[++last_read_line];
regex_search(str_target, m, re);
string str_number = m.str();
@@ -593,7 +612,7 @@ ScattererConfiguration* ScattererConfiguration::from_dedfb(string dedfb_file_nam
str_number = regex_replace(str_number, regex("D"), "e");
str_number = regex_replace(str_number, regex("d"), "e");
dc0_img = stod(str_number);
- dc0m[i157][i162 - 1][jxi468 - 1] = std::complex<double>(dc0_real, dc0_img);
+ dc0m[i157][i162 - 1][jxi468 - 1] = complex<double>(dc0_real, dc0_img);
}
}
}
@@ -666,84 +685,159 @@ void ScattererConfiguration::print() {
}
void ScattererConfiguration::write_binary(string file_name, string mode) {
+ if (mode.compare("LEGACY") == 0) {
+ write_legacy(file_name);
+ } else if (mode.compare("HDF5") == 0) {
+ write_hdf5(file_name);
+ } else {
+ string message = "Unknown format mode: \"" + mode + "\"";
+ throw UnrecognizedConfigurationException(message);
+ }
+}
+
+void ScattererConfiguration::write_hdf5(string file_name) {
const double two_pi = acos(0.0) * 4.0;
const double evc = 6.5821188e-16;
+ int ies = (use_external_sphere)? 1 : 0;
int max_ici = 0;
- bool is_new_vector = false;
- if (mode.compare("LEGACY") == 0) { // Legacy mode was chosen.
- fstream output;
- int ies = (use_external_sphere)? 1 : 0;
- double *xi_vec;
- if (reference_variable_name.compare("XIV") == 0) xi_vec = scale_vec;
- else {
- is_new_vector = true;
- xi_vec = new double[number_of_scales];
- if (reference_variable_name.compare("WNS") == 0) {
- for (int i = 0; i < number_of_scales; i++)
- xi_vec[i] = 3.0e8 * scale_vec[i] / wp;
- } else if (reference_variable_name.compare("WLS") == 0) {
- for (int i = 0; i < number_of_scales; i++) {
- double wn = two_pi / scale_vec[i];
- xi_vec[i] = 3.0e8 * wn / wp;
- }
- } else if (reference_variable_name.compare("PUS") == 0) {
- for (int i = 0; i < number_of_scales; i++)
- xi_vec[i] = scale_vec[i] / wp;
- } else if (reference_variable_name.compare("EVS") == 0) {
- for (int i = 0; i < number_of_scales; i++) {
- double pu = scale_vec[i] / evc;
- xi_vec[i] = pu / wp;
- }
- } else {
- throw UnrecognizedConfigurationException(
- "Wrong parameter set: unrecognized scale type "
- + reference_variable_name
- );
+ List<string> rec_name_list(1);
+ List<string> rec_type_list(1);
+ List<void *> rec_ptr_list(1);
+ string str_type, str_name;
+ rec_name_list.set(0, "NSPH");
+ rec_type_list.set(0, "INT32_(1)");
+ rec_ptr_list.set(0, &number_of_spheres);
+ rec_name_list.append("IOGVEC");
+ str_type = "INT32_(" + to_string(number_of_spheres) + ")";
+ rec_type_list.append(str_type);
+ rec_ptr_list.append(iog_vec);
+ rec_name_list.append("EXDC");
+ rec_type_list.append("FLOAT64_(1)");
+ rec_ptr_list.append(&exdc);
+ rec_name_list.append("WP");
+ rec_type_list.append("FLOAT64_(1)");
+ rec_ptr_list.append(&wp);
+ rec_name_list.append("XIP");
+ rec_type_list.append("FLOAT64_(1)");
+ rec_ptr_list.append(&xip);
+ rec_name_list.append("IDFC");
+ rec_type_list.append("INT32_(1)");
+ rec_ptr_list.append(&idfc);
+ rec_name_list.append("NXI");
+ rec_type_list.append("INT32_(1)");
+ rec_ptr_list.append(&number_of_scales);
+ rec_name_list.append("XIVEC");
+ str_type = "FLOAT64_(" + to_string(number_of_scales) + ")";
+ rec_type_list.append(str_type);
+ rec_ptr_list.append(scale_vec);
+ for (int i115 = 1; i115 <= number_of_spheres; i115++) {
+ if (iog_vec[i115 - 1] < i115) continue;
+ str_name = "NSHL_" + to_string(i115);
+ rec_name_list.append(str_name);
+ rec_type_list.append("INT32_(1)");
+ rec_ptr_list.append(&(nshl_vec[i115 - 1]));
+ str_name = "ROS_" + to_string(i115);
+ rec_name_list.append(str_name);
+ rec_type_list.append("FLOAT64_(1)");
+ rec_ptr_list.append(&(radii_of_spheres[i115 - 1]));
+ int nsh = nshl_vec[i115 - 1];
+ if (i115 == 1) nsh += ies;
+ if (max_ici < (nsh + 1) / 2) max_ici = nsh + 1 / 2;
+ str_name = "RCF_" + to_string(i115);
+ str_type = "FLOAT64_(" + to_string(nsh) + ")";
+ rec_name_list.append(str_name);
+ rec_type_list.append(str_type);
+ rec_ptr_list.append(&(rcf[i115 - 1][0]));
+ }
+
+ int dim3 = (idfc == 0) ? number_of_scales : 1;
+ int dc0m_size = 2 * dim3 * number_of_spheres * max_ici;
+ double *dc0m = new double[dc0m_size];
+ int dc0_index = 0;
+ for (int jxi468 = 1; jxi468 <= number_of_scales; jxi468++) {
+ if (idfc != 0 && jxi468 > 1) continue;
+ for (int i162 = 1; i162 <= number_of_spheres; i162++) {
+ if (iog_vec[i162 - 1] < i162) continue;
+ int nsh = nshl_vec[i162 - 1];
+ int ici = (nsh + 1) / 2;
+ if (i162 == 1) ici = ici + ies;
+ for (int i157 = 0; i157 < ici; i157++) {
+ double dc0_real, dc0_imag;
+ dc0_real = dc0_matrix[i157][i162 - 1][jxi468 - 1].real();
+ dc0_imag = dc0_matrix[i157][i162 - 1][jxi468 - 1].imag();
+ dc0m[dc0_index++] = dc0_real;
+ dc0m[dc0_index++] = dc0_imag;
}
}
- output.open(file_name.c_str(), ios::out | ios::binary);
- output.write(reinterpret_cast<char *>(&number_of_spheres), sizeof(int));
- for (int i = 0; i < number_of_spheres; i++)
- output.write(reinterpret_cast<char *>(&(iog_vec[i])), sizeof(int));
- output.write(reinterpret_cast<char *>(&exdc), sizeof(double));
- output.write(reinterpret_cast<char *>(&wp), sizeof(double));
- output.write(reinterpret_cast<char *>(&xip), sizeof(double));
- output.write(reinterpret_cast<char *>(&idfc), sizeof(int));
- output.write(reinterpret_cast<char *>(&number_of_scales), sizeof(int));
- for (int i = 0; i < number_of_scales; i++)
- output.write(reinterpret_cast<char *>(&(xi_vec[i])), sizeof(double));
- for (int i115 = 1; i115 <= number_of_spheres; i115++) {
- if (iog_vec[i115 - 1] < i115) continue;
- output.write(reinterpret_cast<char *>(&(nshl_vec[i115 - 1])), sizeof(int));
- output.write(reinterpret_cast<char *>(&(radii_of_spheres[i115 - 1])), sizeof(double));
- int nsh = nshl_vec[i115 - 1];
- if (i115 == 1) nsh += ies;
- if (max_ici < (nsh + 1) / 2) max_ici = (nsh + 1) / 2;
- for (int nsi = 0; nsi < nsh; nsi++)
- output.write(reinterpret_cast<char *>(&(rcf[i115 - 1][nsi])), sizeof(double));
- }
- for (int jxi468 = 1; jxi468 <= number_of_scales; jxi468++) {
- if (idfc != 0 && jxi468 > 1) continue;
- for (int i162 = 1; i162 <= number_of_spheres; i162++) {
- if (iog_vec[i162 - 1] < i162) continue;
- int nsh = nshl_vec[i162 - 1];
- int ici = (nsh + 1) / 2; // QUESTION: is integer division really intended here?
- if (i162 == 1) ici = ici + ies;
- for (int i157 = 0; i157 < ici; i157++) {
- double dc0_real, dc0_img;
- dc0_real = dc0_matrix[i157][i162 - 1][jxi468 - 1].real();
- dc0_img = dc0_matrix[i157][i162 - 1][jxi468 - 1].imag();
- // The FORTRAN code writes the complex numbers as a 16-byte long binary stream.
- // Here we assume that the 16 bytes are equally split in 8 bytes to represent the
- // real part and 8 bytes to represent the imaginary one.
- output.write(reinterpret_cast<char *>(&dc0_real), sizeof(double));
- output.write(reinterpret_cast<char *>(&dc0_img), sizeof(double));
- }
+ }
+ str_type = "FLOAT64_(" + to_string(dc0m_size) + ")";
+ rec_name_list.append("DC0M");
+ rec_type_list.append(str_type);
+ rec_ptr_list.append(dc0m);
+
+ string *rec_names = rec_name_list.to_array();
+ string *rec_types = rec_type_list.to_array();
+ void **rec_pointers = rec_ptr_list.to_array();
+ const int rec_num = rec_name_list.length();
+ FileSchema schema(rec_num, rec_types, rec_names);
+ HDFFile *hdf_file = HDFFile::from_schema(schema, "c_TEDF.hd5", H5F_ACC_TRUNC);
+ 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[] dc0m;
+ delete[] rec_names;
+ delete[] rec_types;
+ delete[] rec_pointers;
+ delete hdf_file;
+}
+
+void ScattererConfiguration::write_legacy(string file_name) {
+ const double two_pi = acos(0.0) * 4.0;
+ const double evc = 6.5821188e-16;
+ fstream output;
+ int ies = (use_external_sphere)? 1 : 0;
+ output.open(file_name.c_str(), ios::out | ios::binary);
+ output.write(reinterpret_cast<char *>(&number_of_spheres), sizeof(int));
+ for (int i = 0; i < number_of_spheres; i++)
+ output.write(reinterpret_cast<char *>(&(iog_vec[i])), sizeof(int));
+ output.write(reinterpret_cast<char *>(&exdc), sizeof(double));
+ output.write(reinterpret_cast<char *>(&wp), sizeof(double));
+ output.write(reinterpret_cast<char *>(&xip), sizeof(double));
+ output.write(reinterpret_cast<char *>(&idfc), sizeof(int));
+ output.write(reinterpret_cast<char *>(&number_of_scales), sizeof(int));
+ for (int i = 0; i < number_of_scales; i++)
+ output.write(reinterpret_cast<char *>(&(scale_vec[i])), sizeof(double));
+ for (int i115 = 1; i115 <= number_of_spheres; i115++) {
+ if (iog_vec[i115 - 1] < i115) continue;
+ output.write(reinterpret_cast<char *>(&(nshl_vec[i115 - 1])), sizeof(int));
+ output.write(reinterpret_cast<char *>(&(radii_of_spheres[i115 - 1])), sizeof(double));
+ int nsh = nshl_vec[i115 - 1];
+ if (i115 == 1) nsh += ies;
+ for (int nsi = 0; nsi < nsh; nsi++)
+ output.write(reinterpret_cast<char *>(&(rcf[i115 - 1][nsi])), sizeof(double));
+ }
+ for (int jxi468 = 1; jxi468 <= number_of_scales; jxi468++) {
+ if (idfc != 0 && jxi468 > 1) continue;
+ for (int i162 = 1; i162 <= number_of_spheres; i162++) {
+ if (iog_vec[i162 - 1] < i162) continue;
+ int nsh = nshl_vec[i162 - 1];
+ int ici = (nsh + 1) / 2; // QUESTION: is integer division really intended here?
+ if (i162 == 1) ici = ici + ies;
+ for (int i157 = 0; i157 < ici; i157++) {
+ double dc0_real, dc0_img;
+ dc0_real = dc0_matrix[i157][i162 - 1][jxi468 - 1].real();
+ dc0_img = dc0_matrix[i157][i162 - 1][jxi468 - 1].imag();
+ // The FORTRAN code writes the complex numbers as a 16-byte long binary stream.
+ // Here we assume that the 16 bytes are equally split in 8 bytes to represent the
+ // real part and 8 bytes to represent the imaginary one.
+ output.write(reinterpret_cast<char *>(&dc0_real), sizeof(double));
+ output.write(reinterpret_cast<char *>(&dc0_img), sizeof(double));
}
}
- if (is_new_vector) delete[] xi_vec;
- output.close();
}
+ output.close();
}
void ScattererConfiguration::write_formatted(string file_name) {
@@ -790,10 +884,10 @@ void ScattererConfiguration::write_formatted(string file_name) {
case 1:
fprintf(output, " JXI WNS WLS PUS EVS XIV\n");
for (int i = 0; i < number_of_scales; i++) {
- wn_vec[i] = scale_vec[i];
- wl_vec[i] = two_pi / wn_vec[i];
- xi_vec[i] = 3.0e8 * wn_vec[i] / wp;
+ xi_vec[i] = scale_vec[i];
pu_vec[i] = xi_vec[i] * wp;
+ wn_vec[i] = pu_vec[i] / 3.0e8;
+ wl_vec[i] = two_pi / wn_vec[i];
ev_vec[i] = pu_vec[i] * evc;
fprintf(
output,
@@ -810,10 +904,10 @@ void ScattererConfiguration::write_formatted(string file_name) {
case 2:
fprintf(output, " JXI WLS WNS PUS EVS XIV\n");
for (int i = 0; i < number_of_scales; i++) {
- wl_vec[i] = scale_vec[i];
- wn_vec[i] = two_pi / wl_vec[i];
- xi_vec[i] = 3.0e8 * wn_vec[i] / wp;
+ xi_vec[i] = scale_vec[i];
pu_vec[i] = xi_vec[i] * wp;
+ wn_vec[i] = pu_vec[i] / 3.0e8;
+ wl_vec[i] = two_pi / wn_vec[i];
ev_vec[i] = pu_vec[i] * evc;
fprintf(
output,
@@ -830,8 +924,8 @@ void ScattererConfiguration::write_formatted(string file_name) {
case 3:
fprintf(output, " JXI PUS WNS WLS EVS XIV\n");
for (int i = 0; i < number_of_scales; i++) {
- pu_vec[i] = scale_vec[i];
- xi_vec[i] = pu_vec[i] / wp;
+ xi_vec[i] = scale_vec[i];
+ pu_vec[i] = xi_vec[i] * wp;
wn_vec[i] = pu_vec[i] / 3.0e8;
wl_vec[i] = two_pi / wn_vec[i];
ev_vec[i] = pu_vec[i] * evc;
@@ -850,11 +944,11 @@ void ScattererConfiguration::write_formatted(string file_name) {
case 4:
fprintf(output, " JXI EVS WNS WLS PUS XIV\n");
for (int i = 0; i < number_of_scales; i++) {
- ev_vec[i] = scale_vec[i];
- pu_vec[i] = ev_vec[i] / evc;
- xi_vec[i] = pu_vec[i] / wp;
+ xi_vec[i] = scale_vec[i];
+ pu_vec[i] = xi_vec[i] * wp;
wn_vec[i] = pu_vec[i] / 3.0e8;
wl_vec[i] = two_pi / wn_vec[i];
+ ev_vec[i] = pu_vec[i] * evc;
fprintf(
output,
"%5d%13.4lE%13.4lE%13.4lE%13.4lE%13.4lE\n",
@@ -913,7 +1007,7 @@ void ScattererConfiguration::write_formatted(string file_name) {
for (int jxi476 = 0; jxi476 < number_of_scales; jxi476++) {
double dc0_real = dc0_matrix[ic477 - 1][i478 - 1][jxi476].real();
double dc0_img = dc0_matrix[ic477 - 1][i478 - 1][jxi476].imag();
- fprintf(output, "%5d%12.4lE%12.4lE\n", (jxi476 + 1), dc0_real, dc0_img);
+ fprintf(output, "%5d %12.4lE%12.4lE\n", (jxi476 + 1), dc0_real, dc0_img);
}
}
}
diff --git a/src/libnptm/clu_subs.cpp b/src/libnptm/clu_subs.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..b516e576ce250e6259d33e7b8141c1efb19270dd
--- /dev/null
+++ b/src/libnptm/clu_subs.cpp
@@ -0,0 +1,1982 @@
+/*! \file clu_subs.cpp
+ *
+ * \brief C++ implementation of CLUSTER subroutines.
+ */
+#include <complex>
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
+#ifndef INCLUDE_SPH_SUBS_H_
+#include "../include/sph_subs.h"
+#endif
+
+#ifndef INCLUDE_CLU_SUBS_H_
+#include "../include/clu_subs.h"
+#endif
+
+using namespace std;
+
+void apc(
+ double ****zpv, int le, complex<double> **am0m, complex<double> **w,
+ double sqk, double **gapr, complex<double> **gapp
+) {
+ complex<double> **ac, **gap;
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> uimmp, summ, sume, suem, suee, summp, sumep;
+ complex<double> suemp, sueep;
+ double cof = 1.0 / sqk;
+ double cimu = cof / sqrt(2.0);
+ int nlem = le * (le + 2);
+ const int nlemt = nlem + nlem;
+ ac = new complex<double>*[nlemt];
+ gap = new complex<double>*[3];
+ for (int ai = 0; ai < nlemt; ai++) ac[ai] = new complex<double>[2]();
+ for (int gi = 0; gi < 3; gi++) gap[gi] = new complex<double>[2]();
+ for (int j45 = 1; j45 <= nlemt; j45++) {
+ int j = j45 - 1;
+ ac[j][0] = cc0;
+ ac[j][1] = cc0;
+ for (int i45 = 1; i45 <= nlemt; i45++) {
+ int i = i45 - 1;
+ ac[j][0] += (am0m[j][i] * w[i][0]);
+ ac[j][1] += (am0m[j][i] * w[i][1]);
+ } //i45 loop
+ } //j45 loop
+ for (int imu90 = 1; imu90 <=3; imu90++) {
+ int mu = imu90 - 2;
+ gap[imu90 - 1][0] = cc0;
+ gap[imu90 - 1][1] = cc0;
+ gapp[imu90 - 1][0] = cc0;
+ gapp[imu90 - 1][1] = cc0;
+ for (int l80 =1; l80 <= le; l80++) {
+ int lpo = l80 + 1;
+ int ltpo = lpo + l80;
+ int imm = l80 * lpo;
+ for (int ilmp = 1; ilmp <= 3; ilmp++) {
+ if ((l80 == 1 && ilmp == 1) || (l80 == le && ilmp == 3)) continue; // ilmp loop
+ int lmpml = ilmp - 2;
+ int lmp = l80 + lmpml;
+ uimmp = (-1.0 * lmpml) * uim;
+ int impmmmp = lmp * (lmp + 1);
+ for (int im70 = 1; im70 <= ltpo; im70++) {
+ int m = im70 - lpo;
+ int mmp = m - mu;
+ int abs_mmp = (mmp > 0) ? mmp : -mmp;
+ if (abs_mmp <= lmp) {
+ int i = imm + m;
+ int ie = i + nlem;
+ int imp = impmmmp + mmp;
+ int impe = imp + nlem;
+ double cgc = cg1(lmpml, mu, l80, m);
+ int jpo = 2;
+ for (int ipo = 1; ipo <= 2; ipo++) {
+ if (ipo == 2) jpo = 1;
+ summ = dconjg(ac[i - 1][ipo - 1]) * ac[imp - 1][ipo - 1];
+ sume = dconjg(ac[i - 1][ipo - 1]) * ac[impe - 1][ipo - 1];
+ suem = dconjg(ac[ie - 1][ipo - 1]) * ac[imp - 1][ipo - 1];
+ suee = dconjg(ac[ie - 1][ipo - 1]) * ac[impe - 1][ipo - 1];
+ summp = dconjg(ac[i - 1][jpo - 1]) * ac[imp - 1][ipo - 1];
+ sumep = dconjg(ac[i - 1][jpo - 1]) * ac[impe - 1][ipo - 1];
+ suemp = dconjg(ac[ie - 1][jpo - 1]) * ac[imp - 1][ipo - 1];
+ sueep = dconjg(ac[ie - 1][jpo - 1]) * ac[impe - 1][ipo - 1];
+ if (lmpml != 0) {
+ summ *= uimmp;
+ sume *= uimmp;
+ suem *= uimmp;
+ suee *= uimmp;
+ summp *= uimmp;
+ sumep *= uimmp;
+ suemp *= uimmp;
+ sueep *= uimmp;
+ }
+ // label 55
+ gap[imu90 - 1][ipo - 1] += (
+ (
+ summ * zpv[l80 - 1][ilmp - 1][0][0]
+ + sume * zpv[l80 - 1][ilmp - 1][0][1]
+ + suem * zpv[l80 - 1][ilmp - 1][1][0]
+ + suee * zpv[l80 - 1][ilmp - 1][1][1]
+ ) * cgc
+ );
+ gapp[imu90 - 1][ipo - 1] += (
+ (
+ summp * zpv[l80 - 1][ilmp - 1][0][0]
+ + sumep * zpv[l80 - 1][ilmp - 1][0][1]
+ + suemp * zpv[l80 - 1][ilmp - 1][1][0]
+ + sueep * zpv[l80 - 1][ilmp - 1][1][1]
+ ) * cgc
+ );
+ } // ipo loop
+ } // ends im70 loop
+ } // im70 loop
+ } // ilmp loop
+ } // l80 loop
+ } // imu90 loop
+ for (int ipo95 = 1; ipo95 <= 2; ipo95++) {
+ sume = gap[0][ipo95 - 1] * cimu;
+ suee = gap[1][ipo95 - 1] * cof;
+ suem = gap[2][ipo95 - 1] * cimu;
+ gapr[0][ipo95 - 1] = (sume - suem).real();
+ gapr[1][ipo95 - 1] = ((sume + suem) * uim).real();
+ gapr[2][ipo95 - 1] = suee.real();
+ sumep = gapp[0][ipo95 - 1] * cimu;
+ sueep = gapp[1][ipo95 - 1] * cof;
+ suemp = gapp[2][ipo95 - 1] * cimu;
+ gapp[0][ipo95 - 1] = sumep - suemp;
+ gapp[1][ipo95 - 1] = (sumep + suemp) * uim;
+ gapp[2][ipo95 - 1] = sueep;
+ } // ipo95 loop
+ // Clean memory
+ for (int ai = nlemt - 1; ai > -1; ai--) delete[] ac[ai];
+ for (int gi = 2; gi > -1; gi--) delete[] gap[gi];
+ delete[] ac;
+ delete[] gap;
+}
+
+void apcra(
+ double ****zpv, const int le, complex<double> **am0m, int inpol, double sqk,
+ double **gaprm, complex<double> **gappm
+) {
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> uimtl, uimtls, ca11, ca12, ca21, ca22;
+ complex<double> a11, a12, a21, a22, sum1, sum2, fc;
+ double ****svw = new double***[le];
+ complex<double> ****svs = new complex<double>***[le];
+ for (int i = 0; i < le; i++) {
+ svw[i] = new double**[3];
+ svs[i] = new complex<double>**[3];
+ for (int j = 0; j < 3; j++) {
+ svw[i][j] = new double*[2];
+ svs[i][j] = new complex<double>*[2];
+ for (int k = 0; k < 2; k++) {
+ svw[i][j][k] = new double[2]();
+ svs[i][j][k] = new complex<double>[2]();
+ }
+ }
+ }
+ int nlem = le * (le + 2);
+ for (int l28 = 1; l28 <= le; l28++) {
+ int lpo = l28 + 1;
+ int ltpo = lpo + l28;
+ double fl = sqrt(1.0 * ltpo);
+ for (int ilmp = 1; ilmp <= 3; ilmp++) {
+ if ((l28 == 1 && ilmp == 1) || (l28 == le && ilmp == 3)) continue; // ilmp loop
+ int lmpml = ilmp - 2;
+ int lmp = l28 + lmpml;
+ double flmp = sqrt(1.0 * (lmp + lmp + 1));
+ double fllmp = flmp / fl;
+ double cgmmo = fllmp * cg1(lmpml, 0, l28, 1);
+ double cgmpo = fllmp * cg1(lmpml, 0, l28, -1);
+ if (inpol == 0) {
+ double cgs = cgmpo + cgmmo;
+ double cgd = cgmpo - cgmmo;
+ svw[l28 - 1][ilmp - 1][0][0] = cgs;
+ svw[l28 - 1][ilmp - 1][0][1] = cgd;
+ svw[l28 - 1][ilmp - 1][1][0] = cgd;
+ svw[l28 - 1][ilmp - 1][1][1] = cgs;
+ } else { // label 22
+ svw[l28 - 1][ilmp - 1][0][0] = cgmpo;
+ svw[l28 - 1][ilmp - 1][1][0] = cgmpo;
+ svw[l28 - 1][ilmp - 1][0][1] = -cgmmo;
+ svw[l28 - 1][ilmp - 1][1][1] = cgmmo;
+ }
+ // label 26
+ } // ilmp loop
+ } // l28 loop
+ for (int l30 = 1; l30 <= le; l30++) { // 0-init: can be omitted
+ for (int ilmp = 1; ilmp <= 3; ilmp++) {
+ for (int ipa = 1; ipa <= 2; ipa++) {
+ for (int ipamp = 1; ipamp <= 2; ipamp++) {
+ svs[l30 - 1][ilmp - 1][ipa - 1][ipamp - 1] = cc0;
+ }
+ } // ipa loop
+ } // ilmp loop
+ } // l30 loop
+ for (int l58 = 1; l58 <= le; l58 ++) {
+ int lpo = l58 + 1;
+ int ltpo = l58 + lpo;
+ int imm = l58 * lpo;
+ for (int ilmp = 1; ilmp <= 3; ilmp++) {
+ if ((l58 == 1 && ilmp == 1) || (l58 == le && ilmp == 3)) continue; // ilmp loop
+ int lmpml = ilmp - 2;
+ int lmp = l58 + lmpml;
+ int impmm = lmp * (lmp + 1);
+ uimtl = uim * (1.0 * lmpml);
+ if (lmpml == 0) uimtl = complex<double>(1.0, 0.0);
+ for (int im54 = 1; im54 <= ltpo; im54++) {
+ int m = im54 - lpo;
+ int i = imm + m;
+ int ie = i + nlem;
+ for (int imu52 = 1; imu52 <= 3; imu52++) {
+ int mu = imu52 - 2;
+ int mmp = m - mu;
+ int abs_mmp = (mmp > 0) ? mmp : -mmp;
+ if (abs_mmp <= lmp) {
+ int imp = impmm + mmp;
+ int impe = imp + nlem;
+ double cgc = cg1(lmpml, -mu, l58, -m);
+ for (int ls = 1; ls <= le; ls++) {
+ int lspo = ls + 1;
+ int lstpo = ls + lspo;
+ int ismm = ls * lspo;
+ for (int ilsmp = 1; ilsmp <= 3; ilsmp++) {
+ if ((ls == 1 && ilsmp == 1) || (ls == le && ilsmp == 3)) continue; // ilsmp loop
+ int lsmpml = ilsmp - 2;
+ int lsmp = ls + lsmpml;
+ int ismpmm = lsmp * (lsmp + 1);
+ uimtls = -uim * (1.0 * lsmpml);
+ if (lsmpml == 0) uimtls = complex<double>(1.0, 0.0);
+ for (int ims = 1; ims <= lstpo; ims++) {
+ int ms = ims - lspo;
+ int msmp = ms - mu;
+ int abs_msmp = (msmp > 0) ? msmp : -msmp;
+ if (abs_msmp <= lsmp) {
+ int is = ismm + ms;
+ int ise = is + nlem;
+ int ismp = ismpmm + msmp;
+ int ismpe = ismp + nlem;
+ double cgcs = cg1(lsmpml, mu, ls, ms);
+ fc = (uimtl * uimtls) * (cgc * cgcs);
+ ca11 = dconjg(am0m[is - 1][i - 1]);
+ ca12 = dconjg(am0m[is - 1][ie - 1]);
+ ca21 = dconjg(am0m[ise - 1][i - 1]);
+ ca22 = dconjg(am0m[ise - 1][ie - 1]);
+ a11 = am0m[ismp - 1][imp - 1];
+ a12 = am0m[ismp - 1][impe - 1];
+ a21 = am0m[ismpe - 1][imp - 1];
+ a22 = am0m[ismpe - 1][impe - 1];
+ double z11 = zpv[ls - 1][ilsmp - 1][0][0];
+ double z12 = zpv[ls - 1][ilsmp - 1][0][1];
+ double z21 = zpv[ls - 1][ilsmp - 1][1][0];
+ double z22 = zpv[ls - 1][ilsmp - 1][1][1];
+ svs[l58 - 1][ilmp - 1][0][0] += ((ca11 * a11 * z11
+ + ca11 * a21 * z12
+ + ca21 * a11 * z21
+ + ca21 * a21 * z22) * fc);
+ svs[l58 - 1][ilmp - 1][0][1] += ((ca11 * a12 * z11
+ + ca11 * a22 * z12
+ + ca21 * a12 * z21
+ + ca21 * a22 * z22) * fc);
+ svs[l58 - 1][ilmp - 1][1][0] += ((ca12 * a11 * z11
+ + ca12 * a21 * z12
+ + ca22 * a11 * z21
+ + ca22 * a21 * z22) * fc);
+ svs[l58 - 1][ilmp - 1][1][1] += ((ca12 * a12 * z11
+ + ca12 * a22 * z12
+ + ca22 * a12 * z21
+ + ca22 * a22 * z22) * fc);
+ } // ends ims loop
+ } // ims loop
+ } // ilsmp loop
+ } // ls loop
+ } // ends imu52 loop
+ } // imu52 loop
+ } // im54 loop
+ } // ilmp loop
+ } // l58 loop
+ sum1 = cc0;
+ sum2 = cc0;
+ for (int l68 = 1; l68 <= le; l68++) {
+ //int lpo = l68 + 1;
+ //int ltpo = l68 + lpo;
+ //int imm = l68 * lpo;
+ for (int ilmp = 1; ilmp <= 3; ilmp++) {
+ if ((l68 == 1 && ilmp == 1) || (l68 == le && ilmp == 3)) continue; // ilmp loop
+ if (inpol == 0) {
+ sum1 += (
+ svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][0][0]
+ + svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][0][1]
+ + svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][1][0]
+ + svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][1][1]
+ );
+ sum2 += (
+ svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][0][0]
+ + svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][0][1]
+ + svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][1][0]
+ + svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][1][1]
+ );
+ } else { // label 62
+ sum1 += (
+ svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][0][0]
+ + svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][0][1]
+ + svw[l68 - 1][ilmp - 1][0][0] * svs[l68 - 1][ilmp - 1][1][0]
+ + svw[l68 - 1][ilmp - 1][1][0] * svs[l68 - 1][ilmp - 1][1][1]
+ );
+ sum2 += (
+ svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][0][0]
+ + svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][0][1]
+ + svw[l68 - 1][ilmp - 1][0][1] * svs[l68 - 1][ilmp - 1][1][0]
+ + svw[l68 - 1][ilmp - 1][1][1] * svs[l68 - 1][ilmp - 1][1][1]
+ );
+ } // label 66, ends ilmp loop
+ } // ilmp loop
+ } // l68 loop
+ const double half_pi = acos(0.0);
+ double cofs = half_pi * 2.0 / sqk;
+ gaprm[0][0] = 0.0;
+ gaprm[0][1] = 0.0;
+ gaprm[1][0] = 0.0;
+ gaprm[1][1] = 0.0;
+ gappm[0][0] = cc0;
+ gappm[0][1] = cc0;
+ gappm[1][0] = cc0;
+ gappm[1][1] = cc0;
+ if (inpol == 0) {
+ sum1 *= cofs;
+ sum2 *= cofs;
+ gaprm[2][0] = sum1.real();
+ gaprm[2][1] = sum1.real();
+ gappm[2][0] = sum2 * uim;
+ gappm[2][1] = -gappm[2][0];
+ } else { // label 72
+ cofs *= 2.0;
+ gaprm[2][0] = sum1.real() * cofs;
+ gaprm[2][1] = sum2.real() * cofs;
+ gappm[2][0] = cc0;
+ gappm[2][1] = cc0;
+ }
+
+ // Clean memory
+ for (int i = le - 1; i > -1; i--) {
+ for (int j = 2; j > -1; j--) {
+ for (int k = 1; k > -1; k--) {
+ delete[] svw[i][j][k];
+ delete[] svs[i][j][k];
+ }
+ delete[] svw[i][j];
+ delete[] svs[i][j];
+ }
+ delete[] svw[i];
+ delete[] svs[i];
+ }
+ delete[] svw;
+ delete[] svs;
+}
+
+complex<double> cdtp(
+ complex<double> z, complex<double> **am, int i, int jf,
+ int k, int nj
+) {
+ /* NOTE: the original FORTRAN code treats the AM matrix as a
+ * vector. This is not directly allowed in C++ and it requires
+ * accounting for the different dimensions.
+ */
+ complex<double> result = z;
+ if (nj > 0) {
+ int jl = jf + nj - 1;
+ for (int j = jf; j <= jl; j++) {
+ result += (am[i - 1][j - 1] * am[j - 1][k - 1]);
+ }
+ }
+ return result;
+}
+
+double cgev(int ipamo, int mu, int l, int m) {
+ double result = 0.0;
+ double xd = 0.0, xn = 0.0;
+ if (ipamo == 0) {
+ if (m != 0 || mu != 0) { // label 10
+ if (mu != 0) {
+ xd = 2.0 * l * (l + 1);
+ if (mu <= 0) {
+ xn = 1.0 * (l + m) * (l - m + 1);
+ result = sqrt(xn / xd);
+ } else { // label 15
+ xn = 1.0 * (l - m) * (l + m + 1);
+ result = -sqrt(xn / xd);
+ }
+ } else { // label 20
+ xd = 1.0 * (l + 1) * l;
+ xn = -1.0 * m;
+ result = xn / sqrt(xd);
+ }
+ }
+ } else { // label 30
+ xd = 2.0 * l * (l * 2 - 1);
+ if (mu < 0) { // label 35
+ xn = 1.0 * (l - 1 + m) * (l + m);
+ } else if (mu == 0) { // label 40
+ xn = 2.0 * (l - m) * (l + m);
+ } else { // mu > 0, label 45
+ xn = 1.0 * (l - 1 - m) * (l - m);
+ }
+ result = sqrt(xn / xd);
+ }
+ return result;
+}
+
+void cms(complex<double> **am, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6) {
+ complex<double> dm, de, cgh, cgk;
+ const complex<double> cc0(0.0, 0.0);
+ int ndi = c4->nsph * c4->nlim;
+ int nbl = 0;
+ int nsphmo = c4->nsph - 1;
+ for (int n1 = 1; n1 <= nsphmo; n1++) { // GPU portable?
+ int in1 = (n1 - 1) * c4->nlim;
+ int n1po = n1 + 1;
+ for (int n2 = n1po; n2 <= c4->nsph; n2++) {
+ int in2 = (n2 - 1) * c4->nlim;
+ nbl++;
+ for (int l1 = 1; l1 <= c4->li; l1++) {
+ int l1po = l1 + 1;
+ int il1 = l1po * l1;
+ int l1tpo = l1po + l1;
+ for (int im1 = 1; im1 <= l1tpo; im1++) {
+ int m1 = im1 - l1po;
+ int ilm1 = il1 + m1;
+ int ilm1e = ilm1 + ndi;
+ int i1 = in1 + ilm1;
+ int i1e = in1 + ilm1e;
+ int j1 = in2 + ilm1;
+ int j1e = in2 + ilm1e;
+ for (int l2 = 1; l2 <= c4->li; l2++) {
+ int l2po = l2 + 1;
+ int il2 = l2po * l2;
+ int l2tpo = l2po + l2;
+ int ish = ((l2 + l1) % 2 == 0) ? 1 : -1;
+ int isk = -ish;
+ for (int im2 = 1; im2 <= l2tpo; im2++) {
+ int m2 = im2 - l2po;
+ int ilm2 = il2 + m2;
+ int ilm2e = ilm2 + ndi;
+ int i2 = in2 + ilm2;
+ int i2e = in2 + ilm2e;
+ int j2 = in1 + ilm2;
+ int j2e = in1 + ilm2e;
+ cgh = ghit(0, 0, nbl, l1, m1, l2, m2, c1, c1ao, c4, c6);
+ cgk = ghit(0, 1, nbl, l1, m1, l2, m2, c1, c1ao, c4, c6);
+ am[i1 - 1][i2 - 1] = cgh;
+ am[i1 - 1][i2e - 1] = cgk;
+ am[i1e - 1][i2 - 1] = cgk;
+ am[i1e - 1][i2e - 1] = cgh;
+ am[j1 - 1][j2 - 1] = cgh * (1.0 * ish);
+ am[j1 - 1][j2e - 1] = cgk * (1.0 * isk);
+ am[j1e - 1][j2 - 1] = cgk * (1.0 * isk);
+ am[j1e - 1][j2e - 1] = cgh * (1.0 * ish);
+ }
+ }
+ } // im1 loop
+ } // l1 loop
+ } // n2 loop
+ } // n1 loop
+ for (int n1 = 1; n1 <= c4->nsph; n1++) { // GPU portable?
+ int in1 = (n1 - 1) * c4->nlim;
+ for (int l1 = 1; l1 <= c4->li; l1++) {
+ dm = c1->rmi[l1 - 1][n1 - 1];
+ de = c1->rei[l1 - 1][n1 - 1];
+ int l1po = l1 + 1;
+ int il1 = l1po * l1;
+ int l1tpo = l1po + l1;
+ for (int im1 = 1; im1 <= l1tpo; im1++) {
+ int m1 = im1 - l1po;
+ int ilm1 = il1 + m1;
+ int i1 = in1 + ilm1;
+ int i1e = i1 + ndi;
+ for (int ilm2 = 1; ilm2 <= c4->nlim; ilm2++) {
+ int i2 = in1 + ilm2;
+ int i2e = i2 + ndi;
+ am[i1 - 1][i2 - 1] = cc0;
+ am[i1 - 1][i2e - 1] = cc0;
+ am[i1e - 1][i2 - 1] = cc0;
+ am[i1e - 1][i2e - 1] = cc0;
+ }
+ am[i1 - 1][i1 - 1] = dm;
+ am[i1e - 1][i1e - 1] = de;
+ } // im1 loop
+ } // l1 loop
+ } // n1 loop
+}
+
+void crsm1(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6) {
+ complex<double> ***svf, ***svw, **svs;
+ const complex<double> cc0(0.0, 0.0);
+ complex<double> cam(0.0, 0.0);
+ const int le4po = 4 * c4->le + 1;
+ svf = new complex<double>**[le4po];
+ svw = new complex<double>**[le4po];
+ svs = new complex<double>*[le4po];
+ for (int si = 0; si < le4po; si++) {
+ svf[si] = new complex<double>*[le4po];
+ svw[si] = new complex<double>*[4];
+ svs[si] = new complex<double>[4]();
+ for (int sj = 0; sj < le4po; sj++) svf[si][sj] = new complex<double>[4]();
+ for (int sj = 0; sj < 4; sj++) svw[si][sj] = new complex<double>[4]();
+ }
+ double exdc = exri * exri;
+ double ccs = 1.0 / (vk * vk);
+ const double pi4sq = 64.0 * acos(0.0) * acos(0.0);
+ double cint = ccs / (pi4sq * exdc);
+ int letpo = c4->le + c4->le + 1;
+ for (int i20 = 0; i20 < 16; i20++) c1ao->vintm[i20] = cc0; // 0-init: can be omitted
+ for (int lpo40 = 1; lpo40 <= letpo; lpo40++) {
+ int l = lpo40 - 1;
+ int ltpo = lpo40 + l;
+ int immn = letpo - l;
+ int immx = letpo + l;
+ for (int imf = immn; imf <= immx; imf++) { // 0-init: can be omitted
+ for (int ims = immn; ims <= immx; ims++) {
+ for (int ipo = 1; ipo <= 4; ipo++) {
+ svf[imf - 1][ims - 1][ipo - 1] = cc0;
+ } // ipo loop
+ } // ims loop
+ } // imf loop
+ for (int l1 = 1; l1 <= c4->le; l1++) {
+ int il1 = l1 * (l1 + 1);
+ for (int l2 = 1; l2 <= c4->le; l2++) {
+ int abs_l2ml1 = (l2 > l1) ? l2 - l1 : l1 - l2;
+ if (l < abs_l2ml1 || l > l2 + l1) continue; // l2 loop
+ int il2 = l2 * (l2 + 1);
+ for (int im = immn; im >= immx; im++) { // 0-init: can be omitted
+ for (int ipa = 1; ipa <= 4; ipa++) {
+ svs[im - 1][ipa - 1] = cc0;
+ for (int ipo = 1; ipo <= 4; ipo++) {
+ svw[im - 1][ipa - 1][ipo - 1] = cc0;
+ } // ipo loop
+ } // ipa loop
+ } // im loop
+ for (int im = immn; im <= immx; im++) {
+ int m = im - letpo;
+ r3jmr(l, l1, l2, m, c6);
+ int m1mnmo = (-l1 > -l2 - m) ? -(l1 + 1) : -(l2 + m + 1);
+ int nm1 = (l1 < l2 - m) ? (l1 - m1mnmo) : (l2 - m - m1mnmo);
+ for (int im1 = 1; im1 <= nm1; im1++) {
+ int m1 = -im1 - m1mnmo;
+ int isn = 1;
+ if (m1 % 2 != 0) isn = -1;
+ double cg3j = c6->rac3j[im1 - 1] * isn;
+ int ilm1 = il1 + m1;
+ int ilm2 = il2 + m1 - m;
+ int ipa = 0;
+ for (int ipa1 = 1; ipa1 <= 2; ipa1++) {
+ int i1 = ilm1;
+ if (ipa1 == 2) i1 = ilm1 + c4->nlem;
+ for (int ipa2 = 1; ipa2 <= 2; ipa2++) {
+ int i2 = ilm2;
+ if (ipa2 == 2) i2 = ilm2 + c4->nlem;
+ ipa++;
+ svs[im - 1][ipa - 1] += (c1ao->am0m[i1 - 1][i2 - 1] * cg3j);
+ int ipo = 0;
+ for (int ipo2 = 1; ipo2 <= 2; ipo2++) {
+ for (int ipo1 = 3; ipo1 <= 4; ipo1++) {
+ ipo++;
+ svw[im - 1][ipa - 1][ipo - 1] += (c1->w[i1 - 1][ipo1 - 1] * c1->w[i2 - 1][ipo2 - 1] * cg3j);
+ } // ipo1 loop
+ } // ipo2 loop
+ } // ipa2 loop
+ } // ipa1 loop
+ } // im1 loop
+ // label 32 loops
+ for (int imf = immn; imf <= immx; imf++) {
+ for (int ims = immn; ims <= immx; ims++) {
+ for (int ipo = 1; ipo <= 4; ipo++) {
+ for (int ipa = 1; ipa <= 4; ipa++) {
+ svf[imf - 1][ims - 1][ipo - 1] += (svw[imf - 1][ipa - 1][ipo - 1] * svs[ims - 1][ipa - 1]);
+ } // ipa loop
+ } // ipo loop
+ } // ims loop
+ } // imf loop
+ // ends loop level 34, which are l2 loop and l1 loop
+ } // im loop
+ } // l2 loop
+ } // l1 loop
+ for (int imf = immn; imf <= immx; imf++) {
+ for (int ims = immn; ims <= immx; ims++) {
+ int i = 0;
+ for (int ipo1 = 1; ipo1 <= 4; ipo1++) {
+ cam = dconjg(svf[imf - 1][ims - 1][ipo1 - 1]);
+ for (int ipo2 = 1; ipo2 <= 4; ipo2++) {
+ i++;
+ c1ao->vintm[i - 1] += (svf[imf - 1][ims - 1][ipo2 - 1] * cam * (1.0 * ltpo));
+ }
+ } // ipo1 loop
+ } // ims loop
+ } // imf loop
+ } // lpo40 loop
+ for (int i42 = 0; i42 < 16; i42++) c1ao->vintm[i42] *= cint;
+
+ // Clean memory
+ for (int si = le4po - 1; si > -1; si--) {
+ for (int sj = le4po - 1; sj > -1; sj--) delete[] svf[si][sj];
+ for (int sj = 3; sj > -1; sj--) delete[] svw[si][sj];
+ delete[] svf[si];
+ delete[] svw[si];
+ delete[] svs[si];
+ }
+ delete[] svf;
+ delete[] svw;
+ delete[] svs;
+}
+
+complex<double> ghit(
+ int ihi, int ipamo, int nbl, int l1, int m1, int l2, int m2, C1 *c1,
+ C1_AddOns *c1ao, C4 *c4, C6 *c6
+) {
+ /* NBL identifies transfer vector going from N2 to N1;
+ * IHI=0 for Hankel, IHI=1 for Bessel, IHI=2 for Bessel from origin;
+ * depending on IHI, IPAM=0 gives H or I, IPAM= 1 gives K or L. */
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> csum(0.0, 0.0), cfun(0.0, 0.0);
+ complex<double> result = cc0;
+
+ if (ihi == 2) {
+ if (c1->rxx[nbl - 1] == 0.0 && c1->ryy[nbl - 1] == 0.0 && c1->rzz[nbl - 1] == 0.0) {
+ if (ipamo == 0) {
+ if (l1 == l2 && m1 == m2) result = complex(1.0, 0.0);
+ }
+ return result;
+ }
+ }
+ // label 10
+ int l1mp = l1 - ipamo;
+ int l1po = l1 + 1;
+ int m1mm2 = m1 - m2;
+ int m1mm2m = (m1mm2 > 0) ? m1mm2 + 1 : 1 - m1mm2;
+ int lminpo = (l2 - l1mp > 0) ? l2 - l1mp + 1 : l1mp - l2 + 1;
+ int lmaxpo = l2 + l1mp + 1;
+ int i3j0in = c1ao->ind3j[l1mp][l2 - 1];
+ int ilin = -1;
+ if (m1mm2m > lminpo && (m1mm2m - lminpo) % 2 != 0) ilin = 0;
+ int isn = 1;
+ if (m1 % 2 != 0) isn *= -1;
+ if (lminpo % 2 == 0) {
+ isn *= -1;
+ if (l2 > l1mp) isn *= -1;
+ }
+ // label 12
+ int nblmo = nbl - 1;
+ if (ihi != 2) {
+ int nbhj = nblmo * c4->litpo;
+ int nby = nblmo * c4->litpos;
+ if (ihi != 1) {
+ for (int jm24 = 1; jm24 <= 3; jm24++) {
+ csum = cc0;
+ int mu = jm24 - 2;
+ int mupm1 = mu + m1;
+ int mupm2 = mu + m2;
+ if (mupm1 >= -l1mp && mupm1 <= l1mp && mupm2 >= - l2 && mupm2 <= l2) {
+ int jsn = -isn;
+ if (mu == 0) jsn = isn;
+ double cr = cgev(ipamo, mu, l1, m1) * cgev(0, mu, l2, m2);
+ int i3j0 = i3j0in;
+ if (mupm1 == 0 && mupm2 == 0) {
+ int lt14 = lminpo;
+ while (lt14 <= lmaxpo) {
+ i3j0++;
+ int l3 = lt14 - 1;
+ int ny = l3 * l3 + lt14;
+ double aors = 1.0 * (l3 + lt14);
+ double f3j = (c1ao->v3j0[i3j0 - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
+ cfun = (c1ao->vh[nbhj + lt14 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
+ csum += cfun;
+ jsn *= -1;
+ lt14 += 2;
+ }
+ // goes to 22
+ } else { // label 16
+ r3jjr(l1mp, l2, -mupm1, mupm2, c6);
+ int il = ilin;
+ int lt20 = lminpo;
+ while (lt20 <= lmaxpo) {
+ i3j0++;
+ if (m1mm2m <= lt20) {
+ il += 2;
+ int l3 = lt20 - 1;
+ int ny = l3 * l3 + lt20 + m1mm2;
+ double aors = 1.0 * (l3 + lt20);
+ double f3j = (c6->rac3j[il - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
+ cfun = (c1ao->vh[nbhj + lt20 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
+ csum += cfun;
+ }
+ // label 20
+ jsn *= -1;
+ lt20 += 2;
+ }
+ }
+ // label 22
+ csum *= cr;
+ result += csum;
+ }
+ // Otherwise there is nothing to add
+ } // jm24 loop. Should go to 70
+ } else { // label 30, IHI == 1
+ for (int jm44 = 1; jm44 <= 3; jm44++) {
+ csum = cc0;
+ int mu = jm44 - 2;
+ int mupm1 = mu + m1;
+ int mupm2 = mu + m2;
+ if (mupm1 >= -l1mp && mupm1 <= l1mp && mupm2 >= - l2 && mupm2 <= l2) {
+ int jsn = - isn;
+ if (mu == 0) jsn = isn;
+ double cr = cgev(ipamo, mu, l1, m1) * cgev(0, mu, l2, m2);
+ int i3j0 = i3j0in;
+ if (mupm1 == 0 && mupm2 == 0) {
+ int lt34 = lminpo;
+ while (lt34 <= lmaxpo) {
+ i3j0++;
+ int l3 = lt34 - 1;
+ int ny = l3 * l3 + lt34;
+ double aors = 1.0 * (l3 + lt34);
+ double f3j = (c1ao->v3j0[i3j0 - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
+ cfun = (c1ao->vh[nbhj + lt34 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
+ csum += cfun;
+ jsn *= -1;
+ lt34 += 2;
+ }
+ // goes to 42
+ } else { // label 36
+ r3jjr(l1mp, l2, -mupm1, mupm2, c6);
+ int il = ilin;
+ int lt40 = lminpo;
+ while (lt40 <= lmaxpo) {
+ i3j0++;
+ if (m1mm2m <= lt40) {
+ il += 2;
+ int l3 = lt40 - 1;
+ int ny = l3 * l3 + lt40 + m1mm2;
+ double aors = 1.0 * (l3 + lt40);
+ double f3j = (c6->rac3j[il - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
+ cfun = (c1ao->vh[nbhj + lt40 - 1] * c1ao->vyhj[nby + ny - 1]) * f3j;
+ csum += cfun;
+ }
+ // label 40
+ jsn *= -1;
+ lt40 += 2;
+ }
+ }
+ // label 42
+ csum *= cr;
+ result += csum;
+ }
+ // Otherwise there is nothing to add
+ } // jm44 loop. Should go to 70
+ }
+ // goes to 70
+ } else { // label 50, IHI == 2
+ int nbhj = nblmo * c4->lmtpo;
+ int nby = nblmo * c4->lmtpos;
+ for (int jm64 = 1; jm64 <= 3; jm64++) {
+ csum = cc0;
+ int mu = jm64 - 2;
+ int mupm1 = mu + m1;
+ int mupm2 = mu + m2;
+ if (mupm1 >= -l1mp && mupm1 <= l1mp && mupm2 >= - l2 && mupm2 <= l2) {
+ int jsn = -isn;
+ if (mu == 0) jsn = isn;
+ double cr = cgev(ipamo, mu, l1, m1) * cgev(0, mu, l2, m2);
+ int i3j0 = i3j0in;
+ if (mupm1 == 0 && mupm2 == 0) {
+ int lt54 = lminpo;
+ while (lt54 <= lmaxpo) {
+ i3j0++;
+ int l3 = lt54 - 1;
+ int ny = l3 * l3 + lt54;
+ double aors = 1.0 * (l3 + lt54);
+ double f3j = (c1ao->v3j0[i3j0 - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
+ cfun = (c1ao->vj0[nbhj + lt54 - 1] * c1ao->vyj0[nby + ny - 1]) * f3j;
+ csum += cfun;
+ jsn *= -1;
+ lt54 += 2;
+ }
+ // goes to 62
+ } else { // label 56
+ r3jjr(l1mp, l2, -mupm1, mupm2, c6);
+ int il = ilin;
+ int lt60 = lminpo;
+ while (lt60 <= lmaxpo) {
+ i3j0++;
+ if (m1mm2m <= lt60) {
+ il += 2;
+ int l3 = lt60 - 1;
+ int ny = l3 * l3 + lt60 + m1mm2;
+ double aors = 1.0 * (l3 + lt60);
+ double f3j = (c6->rac3j[il - 1] * c1ao->v3j0[i3j0 - 1] * sqrt(aors)) * jsn;
+ cfun = (c1ao->vj0[nbhj + lt60 - 1] * c1ao->vyj0[nby + ny - 1]) * f3j;
+ csum += cfun;
+ }
+ // label 60
+ jsn *= -1;
+ lt60 += 2;
+ }
+ }
+ // label 62
+ csum *= cr;
+ result += csum;
+ }
+ // Otherwise there is nothing to add
+ } // jm64 loop. Should go to 70
+ }
+ // label 70
+ const double four_pi = acos(0.0) * 8.0;
+ if (ipamo != 1) {
+ double cr = sqrt(four_pi * (l1 + l1po) * (l2 + l2 + 1));
+ result *= cr;
+ } else {
+ double cr = sqrt(four_pi * (l1 + l1mp) * (l1 + l1po) * (l2 + l2 + 1) / l1po);
+ result *= (cr * uim);
+ }
+ return result;
+}
+
+void hjv(
+ double exri, double vk, int &jer, int &lcalc, complex<double> &arg,
+ C1 *c1, C1_AddOns *c1ao, C4 *c4
+) {
+ int nsphmo = c4->nsph - 1;
+ int lit = c4->li + c4->li;
+ int lmt = c4->li + c4->le;
+ const int rfj_size = (lit > lmt) ? lit : lmt;
+ const int rfn_size = c4->litpo;
+ double *rfj, *rfn;
+ rfj = new double[rfj_size]();
+ rfn = new double[rfn_size]();
+ jer = 0;
+ int ivhb = 0;
+ for (int nf40 = 1; nf40 <= nsphmo; nf40++) { // GPU portable?
+ int nfpo = nf40 + 1;
+ for (int ns40 = nfpo; ns40 <= c4->nsph; ns40++) {
+ double rx = c1->rxx[nf40 - 1] - c1->rxx[ns40 - 1];
+ double ry = c1->ryy[nf40 - 1] - c1->ryy[ns40 - 1];
+ double rz = c1->rzz[nf40 - 1] - c1->rzz[ns40 - 1];
+ double rr = sqrt(rx * rx + ry * ry + rz * rz);
+ double rarg = rr * vk * exri;
+ arg = complex<double>(rarg, 0.0);
+ rbf(lit, rarg, lcalc, rfj);
+ if (lcalc < lit) {
+ jer = 1;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ rnf(lit, rarg, lcalc, rfn);
+ if (lcalc < lit) {
+ jer = 2;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ for (int lpo38 = 1; lpo38 <= c4->litpo; lpo38++) {
+ double rpart = rfj[lpo38 - 1];
+ double ipart = rfn[lpo38 - 1];
+ c1ao->vh[lpo38 + ivhb - 1] = complex<double>(rpart, ipart);
+ }
+ ivhb += c4->litpo;
+ } // ns40 loop
+ } // nf40 loop
+ ivhb = 0;
+ for (int nf50 = 1; nf50 <= c4->nsph; nf50++) {
+ double rx = c1->rxx[nf50 - 1];
+ double ry = c1->ryy[nf50 - 1];
+ double rz = c1->rzz[nf50 - 1];
+ if (!(rx == 0.0 && ry == 0.0 && rz == 0.0)) {
+ double rr = sqrt(rx * rx + ry * ry + rz * rz);
+ double rarg = rr * vk * exri;
+ rbf(lmt, rarg, lcalc, rfj);
+ if (lcalc < lmt) {
+ jer = 3;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ for (int lpo47 = 1; lpo47 <= c4->lmtpo; lpo47++) {
+ c1ao->vj0[lpo47 + ivhb - 1] = rfj[lpo47 - 1];
+ }
+ }
+ ivhb += c4->lmtpo;
+ } // nf50 loop
+ delete[] rfj;
+ delete[] rfn;
+}
+
+void lucin(complex<double> **am, const int nddmst, int n, int &ier) {
+ /* NDDMST FIRST DIMENSION OF AM AS DECLARED IN DIMENSION
+ * STATEMENT.
+ * N NUMBER OF ROWS IN AM.
+ * IER IS REPLACED BY 1 FOR SINGULARITY.
+ */
+ double *v = new double[nddmst];
+ complex<double> ctemp, cfun;
+ complex<double> cc0 = complex<double>(0.0, 0.0);
+ ier = 0;
+ int nminus = n - 1;
+ for (int i = 1; i <= n; i++) {
+ double sum = 0.0;
+ for (int j = 1; j <= n; j++) {
+ sum += (
+ am[i - 1][j - 1].real() * am[i - 1][j - 1].real()
+ + am[i - 1][j - 1].imag() * am[i - 1][j - 1].imag()
+ );
+ } // j1319 loop
+ v[i - 1] = 1.0 / sum;
+ } // i1309 loop
+ // 2. REPLACE AM BY TRIANGULAR MATRICES (L,U) WHERE AM=L*U.
+ // REPLACE L(I,I) BY 1/L(I,I), READY FOR SECTION 4.
+ // (ROW INTERCHANGES TAKE PLACE, AND THE INDICES OF THE PIVOTAL ROWS
+ // ARE PLACED IN V.)
+ /* >>> THERE APPEARS TO BE A BUG IN THE FOLLOWING LOOP <<< */
+ for (int k = 1; k <= n; k++) {
+ int kplus = k + 1;
+ int kminus = k - 1;
+ int l = k;
+ double psqmax = 0.0;
+ for (int i = k; i <= n; i++) {
+ cfun = cdtp(-am[i - 1][k - 1], am, i, 1, k, kminus);
+ ctemp = -cfun;
+ am[i - 1][k - 1] = ctemp;
+ double psq = v[i - 1] * (ctemp.real() * ctemp.real() + ctemp.imag() * ctemp.imag());
+ if (psq > psqmax) {
+ psqmax = psq;
+ l = i;
+ }
+ } // i2029 loop
+ if (l != k) {
+ for (int j = 1; j <= n; j++) {
+ ctemp = am[k - 1][j - 1];
+ am[k - 1][j - 1] = am[l - 1][j - 1];
+ am[l - 1][j - 1] = ctemp;
+ } // j2049 loop
+ v[l - 1] = v[k - 1];
+ }
+ // label 2011
+ v[k - 1] = 1.0 * l;
+ if (psqmax == 0.0) {
+ ier = 1;
+ delete[] v;
+ return;
+ }
+ ctemp = 1.0 / am[k - 1][k - 1];
+ am[k - 1][k - 1] = ctemp;
+ if (kplus <= n) {
+ for (int j = kplus; j <= n; j++) {
+ cfun = cdtp(-am[k - 1][j - 1], am, k, 1, j, kminus);
+ am[k - 1][j - 1] = -ctemp * cfun;
+ } // j2059 loop
+ }
+ } // k2019 loop
+ // 4. REPLACE AM BY ITS INVERSE AMINV.
+ // 4.1 REPLACE L AND U BY THEIR INVERSE LINV AND UINV.
+ for (int k = 1; k <= nminus; k++) {
+ int kplus = k + 1;
+ for (int i = kplus; i <= n; i++) {
+ cfun = cdtp(cc0, am, i, k, k, i - k);
+ am[i - 1][k - 1] = -am[i - 1][i - 1] * cfun;
+ cfun = cdtp(am[k - 1][i - 1], am, k, kplus, i, i - k - 1);
+ am[k - 1][i - 1] = -cfun;
+ } // i4119 loop
+ } // k4109 loop
+ // 4.2 FORM AMINV=UINV*LINV.
+ for (int k = 1; k <= n; k++) {
+ for (int i = 1; i <= n; i++) {
+ if (i < k) {
+ cfun = cdtp(cc0, am, i, k, k, n - k + 1);
+ am[i - 1][k -1] = cfun;
+ }
+ else {
+ cfun = cdtp(am[i - 1][k - 1], am, i, i + 1, k, n - i);
+ am[i - 1][k - 1] = cfun;
+ }
+ } // i4119 loop
+ } // k4209 loop
+ // 4.3 INTERCHANGE COLUMNS OF AMINV AS SPECIFIED BY V, BUT IN REVERSE
+ // ORDER.
+ for (int l = 1; l <= n; l++) {
+ int k = n - l + 1;
+ int kcol = (int)(v[k - 1]);
+ if (kcol != k) {
+ for (int i = 1; i <= n; i++) {
+ ctemp = am[i - 1][k - 1];
+ am[i - 1][k - 1] = am[i - 1][kcol - 1];
+ am[i - 1][kcol - 1] = ctemp;
+ } // i4319 loop
+ }
+ } // l4309 loop
+ delete[] v;
+}
+
+void mextc(double vk, double exri, complex<double> **fsac, double **cextlr, double **cext) {
+ double fa11r = fsac[0][0].real();
+ double fa11i = fsac[0][0].imag();
+ double fa21r = fsac[1][0].real();
+ double fa21i = fsac[1][0].imag();
+ double fa12r = fsac[0][1].real();
+ double fa12i = fsac[0][1].imag();
+ double fa22r = fsac[1][1].real();
+ double fa22i = fsac[1][1].imag();
+ cextlr[0][0] = fa11i * 2.0;
+ cextlr[0][1] = 0.0;
+ cextlr[0][2] = -fa12i;
+ cextlr[0][3] = -fa12r;
+ cextlr[1][0] = 0.0;
+ cextlr[1][1] = fa22i * 2.0;
+ cextlr[1][2] = -fa21i;
+ cextlr[1][3] = fa21r;
+ cextlr[2][0] = -fa21i * 2.0;
+ cextlr[2][1] = -fa12i * 2.0;
+ cextlr[2][2] = fa11i + fa22i;
+ cextlr[2][3] = fa22r - fa11r;
+ cextlr[3][0] = fa21r * 2.0;
+ cextlr[3][1] = -fa12r * 2.0;
+ cextlr[3][2] = fa11r - fa22r;
+ cextlr[3][3] = cextlr[2][2];
+ cext[0][0] = cextlr[3][3];
+ cext[1][1] = cextlr[3][3];
+ cext[2][2] = cextlr[3][3];
+ cext[2][3] = cextlr[2][3];
+ cext[3][2] = cextlr[3][2];
+ cext[3][3] = cextlr[3][3];
+ cext[0][1] = fa11i - fa22i;
+ cext[0][2] = -fa12i - fa21i;
+ cext[0][3] = fa21r - fa12r;
+ cext[1][0] = cext[0][1];
+ cext[1][2] = fa21i - fa12i;
+ cext[3][1] = fa12r + fa21r;
+ cext[1][3] = -cext[3][1];
+ cext[2][0] = cext[0][2];
+ cext[2][1] = -cext[1][2];
+ cext[3][0] = cext[1][3];
+ double ckm = vk / exri;
+ for (int i10 = 0; i10 < 4; i10++) {
+ for (int j10 = 0; j10 < 4; j10++) {
+ cextlr[i10][j10] *= ckm;
+ cext[i10][j10] *= ckm;
+ }
+ }
+}
+
+void pcros(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C4 *c4) {
+ const complex<double> cc0(0.0, 0.0);
+ complex<double> sump, sum1, sum2, sum3, sum4, am, amp, cc, csam;
+ const double exdc = exri * exri;
+ double ccs = 1.0 / (vk * vk);
+ double cccs = ccs / exdc;
+ csam = -(ccs / (exri * vk)) * complex<double>(0.0, 0.5);
+ const double pi4sq = 64.0 * acos(0.0) * acos(0.0);
+ double cfsq = 4.0 / (pi4sq *ccs * ccs);
+ const int nlemt = c4->nlem + c4->nlem;
+ int jpo = 2;
+ for (int ipo18 = 1; ipo18 <= 2; ipo18++) {
+ if (ipo18 == 2) jpo = 1;
+ int ipopt = ipo18 + 2;
+ int jpopt = jpo + 2;
+ double sum = 0.0;
+ sump = cc0;
+ sum1 = cc0;
+ sum2 = cc0;
+ sum3 = cc0;
+ sum4 = cc0;
+ for (int i12 = 1; i12 <= nlemt; i12++) {
+ int i = i12 - 1;
+ am = cc0;
+ amp = cc0;
+ for (int j10 = 1; j10 <= nlemt; j10++) {
+ int j = j10 - 1;
+ am += (c1ao->am0m[i][j] * c1->w[j][ipo18 - 1]);
+ amp += (c1ao->am0m[i][j] * c1->w[j][jpo - 1]);
+ } // j10 loop
+ sum += (dconjg(am) * am).real();
+ sump += (dconjg(amp) * am);
+ sum1 += (dconjg(c1->w[i][ipo18 - 1]) * am);
+ sum2 += (dconjg(c1->w[i][jpo - 1]) * am);
+ sum3 += (c1->w[i][ipopt - 1] * am);
+ sum4 += (c1->w[i][jpopt - 1] * am);
+ } // i12 loop
+ c1ao->scsc[ipo18 - 1] = cccs * sum;
+ c1ao->scscp[ipo18 - 1] = cccs * sump;
+ c1ao->ecsc[ipo18 - 1] = -cccs * sum1.real();
+ c1ao->ecscp[ipo18 - 1] = -cccs * sum2;
+ c1ao->fsac[ipo18 - 1][ipo18 - 1] = csam * sum1;
+ c1ao->fsac[jpo - 1][ipo18 - 1] = csam * sum2;
+ c1ao->sac[ipo18 - 1][ipo18 - 1] = csam * sum3;
+ c1ao->sac[jpo - 1][ipo18 - 1] = csam * sum4;
+ } // ipo18 loop
+ int i = 0;
+ for (int ipo1 = 1; ipo1 <= 2; ipo1++) {
+ for (int jpo1 = 1; jpo1 <= 2; jpo1++) {
+ cc = dconjg(c1ao->sac[jpo1 - 1][ipo1 - 1]);
+ for (int ipo2 = 1; ipo2 <= 2; ipo2 ++) {
+ for (int jpo2 = 1; jpo2 <= 2; jpo2++) {
+ c1ao->vint[i++] = c1ao->sac[jpo2 - 1][ipo2 - 1] * cc * cfsq;
+ } // jpo2 loop
+ } // ipo2 loop
+ } // jpo1 loop
+ } // ipo1 loop
+}
+
+void pcrsm0(double vk, double exri, int inpol, C1 *c1, C1_AddOns *c1ao, C4 *c4) {
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> sum1, sum2, sum3, sum4, sumpd;
+ complex<double> sums1, sums2, sums3, sums4, csam;
+ double exdc = exri * exri;
+ double ccs = 4.0 * acos(0.0) / (vk * vk);
+ double cccs = ccs / exdc;
+ csam = -(ccs / (exri * vk)) * complex<double>(0.0, 0.5);
+ sum2 = cc0;
+ sum3 = cc0;
+ for (int i14 = 1; i14 <= c4->nlem; i14++) { // GPU portable?
+ int ie = i14 + c4->nlem;
+ sum2 += (c1ao->am0m[i14 - 1][i14 - 1] + c1ao->am0m[ie - 1][ie - 1]);
+ sum3 += (c1ao->am0m[i14 - 1][ie - 1] + c1ao->am0m[ie - 1][i14 - 1]);
+ } // i14 loop
+ double sumpi = 0.0;
+ sumpd = cc0;
+ int nlemt = c4->nlem + c4->nlem;
+ for (int i16 = 1; i16 <= nlemt; i16++) {
+ for (int j16 = 1; j16 <= c4->nlem; j16++) {
+ int je = j16 + c4->nlem;
+ double rvalue = (
+ dconjg(c1ao->am0m[i16 - 1][j16 - 1]) * c1ao->am0m[i16 - 1][j16 - 1]
+ + dconjg(c1ao->am0m[i16 - 1][je - 1]) * c1ao->am0m[i16 - 1][je - 1]
+ ).real();
+ sumpi += rvalue;
+ sumpd += (
+ dconjg(c1ao->am0m[i16 - 1][j16 - 1]) * c1ao->am0m[i16 - 1][je - 1]
+ + dconjg(c1ao->am0m[i16 - 1][je - 1]) * c1ao->am0m[i16 - 1][j16 - 1]
+ );
+ } // j16 loop
+ } // i16 loop
+ if (inpol == 0) {
+ sum1 = sum2;
+ sum4 = sum3 * uim;
+ sum3 = -sum4;
+ sums1 = sumpi;
+ sums2 = sumpi;
+ sums3 = sumpd * uim;
+ sums4 = -sums3;
+ } else { // label 18
+ sum1 = sum2 + sum3;
+ sum2 = sum2 - sum3;
+ sum3 = cc0;
+ sum4 = cc0;
+ sums1 = sumpi - sumpd;
+ sums2 = sumpi + sumpd;
+ sums3 = cc0;
+ sums4 = cc0;
+ }
+ // label 20
+ c1ao->ecscm[0] = -cccs * sum2.real();
+ c1ao->ecscm[1] = -cccs * sum1.real();
+ c1ao->ecscpm[0] = -cccs * sum4;
+ c1ao->ecscpm[1] = -cccs * sum3;
+ c1ao->fsacm[0][0] = csam * sum2;
+ c1ao->fsacm[1][0] = csam * sum4;
+ c1ao->fsacm[1][1] = csam * sum1;
+ c1ao->fsacm[0][1] = csam * sum3;
+ c1ao->scscm[0] = cccs * sums1.real();
+ c1ao->scscm[1] = cccs * sums2.real();
+ c1ao->scscpm[0] = cccs * sums3;
+ c1ao->scscpm[1] = cccs * sums4;
+}
+
+void polar(
+ double x, double y, double z, double &r, double &cth, double &sth,
+ double &cph, double &sph
+) {
+ bool onx = (y == 0.0);
+ bool ony = (x == 0.0);
+ bool onz = (onx && ony);
+ double rho = 0.0;
+ if (!onz) {
+ if (!onx) {
+ if (!ony) {
+ rho = sqrt(x * x + y * y);
+ cph = x / rho;
+ sph = y / rho;
+ // goes to 25
+ } else { // label 20
+ rho = (y > 0.0) ? y : -y;
+ cph = 0.0;
+ sph = (y > 0.0) ? 1.0 : -1.0;
+ // goes to 25
+ }
+ } else { // label 15
+ rho = (x > 0.0) ? x : -x;
+ cph = (x > 0.0) ? 1.0 : -1.0;
+ sph = 0.0;
+ // goes to 25
+ }
+ } else { // label 10
+ cph = 1.0;
+ sph = 0.0;
+ // goes to 25
+ }
+ // label 25
+ if (z == 0.0) {
+ if (!onz) {
+ r = rho;
+ cth = 0.0;
+ sth = 1.0;
+ // returns
+ } else { // label 30
+ r = 0.0;
+ cth = 1.0;
+ sth = 0.0;
+ // returns
+ }
+ } else { // label 35
+ if (!onz) {
+ r = sqrt(rho * rho + z * z);
+ cth = z / r;
+ sth = rho / r;
+ // returns
+ } else { // label 40
+ r = (z > 0.0) ? z : -z;
+ cth = (z > 0.0) ? 1.0 : -1.0;
+ sth = 0.0;
+ // returns
+ }
+ }
+}
+
+void r3j000(int j2, int j3, C6 *c6) {
+ int jmx = j3 + j2;
+ if (jmx <= 0) {
+ c6->rac3j[0] = 1.0;
+ return;
+ }
+ int jmn = j3 - j2;
+ if (jmn < 0) jmn *= -1;
+ int njmo = (jmx - jmn) / 2;
+ int jf = jmx + jmx + 1;
+ int isn = 1;
+ if (jmn % 2 != 0) isn = -1;
+ if (njmo <= 0) {
+ double sj = 1.0 * jf;
+ double cnr = (1 / sqrt(sj)) * isn;
+ c6->rac3j[0] = cnr;
+ return;
+ }
+ double sjr = 1.0 * jf;
+ int jmxpos = (jmx + 1) * (jmx + 1);
+ int jmns = jmn * jmn;
+ int j1mo = jmx - 1;
+ int j1s = (j1mo + 1) * (j1mo + 1);
+ double cj = sqrt(1.0 * (jmxpos - j1s) * (j1s - jmns));
+ int j1mos = j1mo * j1mo;
+ double cjmo = sqrt(1.0 * (jmxpos - j1mos) * (j1mos - jmns));
+ if (njmo <= 1) {
+ c6->rac3j[0] = -cj / cjmo;
+ double sj = sjr + (c6->rac3j[0] * c6->rac3j[0]) * (jf - 4);
+ double cnr = (1.0 / sqrt(sj)) * isn;
+ c6->rac3j[1] = cnr;
+ c6->rac3j[0] *= cnr;
+ return;
+ }
+ int nj = njmo + 1;
+ int nmat = (nj + 1) / 2;
+ c6->rac3j[nj - 1] = 1.0;
+ c6->rac3j[njmo - 1] = -cj / cjmo;
+ if (nmat != njmo) {
+ int nbr = njmo - nmat;
+ for (int ibr45 = 1; ibr45 <= nbr; ibr45++) {
+ int irr = nj - ibr45;
+ jf -= 4;
+ j1mo -= 2;
+ j1s = (j1mo + 1) * (j1mo + 1);
+ cj = sqrt(1.0 * (jmxpos - j1s) * (j1s - jmns));
+ j1mos = j1mo * j1mo;
+ cjmo = sqrt(1.0 * (jmxpos - j1mos) * (j1mos - jmns));
+ c6->rac3j[irr - 2] = c6->rac3j[irr - 1] * (-cj / cjmo);
+ sjr = sjr + (c6->rac3j[irr - 1] * c6->rac3j[irr - 1]) * jf;
+ }
+ }
+ // label 50
+ double racmat = c6->rac3j[nmat - 1];
+ sjr = sjr + (racmat * racmat) * (jf - 4);
+ c6->rac3j[0] = 1.0;
+ jf = jmn + jmn + 1;
+ double sjl = 1.0 * jf;
+ int j1pt = jmn + 2;
+ int j1pos = (j1pt - 1) * (j1pt - 1);
+ double cjpo = sqrt(1.0 * (jmxpos - j1pos) * (j1pos - jmns));
+ int j1pts = j1pt * j1pt;
+ double cjpt = sqrt(1.0 * (jmxpos - j1pts) * (j1pts - jmns));
+ c6->rac3j[1] = -cjpo / cjpt;
+ int nmatmo = nmat - 1;
+ if (nmatmo >= 2) {
+ for (int irl70 = 2; irl70 <= nmatmo; irl70++) {
+ jf += 4;
+ j1pt += 2;
+ j1pos = (j1pt - 1) * (j1pt - 1);
+ cjpo = sqrt(1.0 * (jmxpos - j1pos) * (j1pos - jmns));
+ j1pts = j1pt * j1pt;
+ cjpt = sqrt(1.0 * (jmxpos - j1pts) * (j1pts - jmns));
+ c6->rac3j[irl70] = c6->rac3j[irl70 - 1] * (-cjpo / cjpt);
+ sjl = sjl + (c6->rac3j[irl70 - 1] * c6->rac3j[irl70 - 1]) * jf;
+ }
+ }
+ // label 75
+ double ratrac = racmat / c6->rac3j[nmat - 1];
+ double rats = ratrac * ratrac;
+ double sj = sjr + sjl * rats;
+ c6->rac3j[nmat - 1] = racmat;
+ double cnr = (1.0 / sqrt(sj)) * isn;
+ for (int irr80 = nmat; irr80 <= nj; irr80++) {
+ c6->rac3j[irr80 - 1] *= cnr;
+ }
+ double cnl = cnr * ratrac;
+ for (int irl85 = 1; irl85 <= nmatmo; irl85++) {
+ c6->rac3j[irl85 - 1] *= cnl;
+ }
+}
+
+void r3jjr(int j2, int j3, int m2, int m3, C6 *c6) {
+ int jmx = j3 + j2;
+ int jdf = j3 - j2;
+ int m1 = -m2 - m3;
+ int abs_jdf = (jdf >= 0) ? jdf : -jdf;
+ int abs_m1 = (m1 >= 0) ? m1 : -m1;
+ int jmn = (abs_jdf > abs_m1) ? abs_jdf : abs_m1;
+ int njmo = jmx - jmn;
+ int jf = jmx + jmx + 1;
+ int isn = 1;
+ if ((jdf + m1) % 2 != 0) isn = -1;
+ if (njmo <= 0) {
+ double sj = 1.0 * jf;
+ double cnr = (1.0 / sqrt(sj)) * isn;
+ c6->rac3j[0] = cnr;
+ } else { // label 15
+ double sjt = 1.0;
+ double sjr = 1.0 * jf;
+ int jsmpos = (jmx + 1) * (jmx + 1);
+ int jdfs = jdf * jdf;
+ int m1s = m1 * m1;
+ int mdf = m3 - m2;
+ int idjc = m1 * (j3 * (j3 + 1) - j2 * (j2 +1));
+ int j1 = jmx;
+ int j1s = j1 * j1;
+ int j1po = j1 + 1;
+ double ccj = 1.0 * (j1s - jdfs) * (j1s - m1s);
+ double cj = sqrt(ccj * (jsmpos - j1s));
+ double dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
+ if (njmo <= 1) {
+ c6->rac3j[0] = -dj / (cj * j1po);
+ double sj = sjr + (c6->rac3j[0] * c6->rac3j[0]) * (jf - 2);
+ double cnr = (1.0 / sqrt(sj)) * isn;
+ c6->rac3j[1] = cnr;
+ c6->rac3j[0] *= cnr;
+ } else { // label 20
+ double cjp = 0.0;
+ int nj = njmo + 1;
+ int nmat = (nj + 1) / 2;
+ c6->rac3j[nj - 1] = 1.0;
+ c6->rac3j[njmo - 1] = -dj / (cj * j1po);
+ if (nmat != njmo) {
+ int nbr = njmo - nmat;
+ for (int ibr45 = 1; ibr45 <= nbr; ibr45++) {
+ int irr = nj - ibr45;
+ jf -= 2;
+ j1--;
+ j1s = j1 * j1;
+ j1po = j1 + 1;
+ cjp = cj;
+ ccj = 1.0 * (j1s - jdfs) * (j1s - m1s);
+ cj = sqrt(ccj * (jsmpos - j1s));
+ sjt = c6->rac3j[irr - 1] * c6->rac3j[irr - 1];
+ dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
+ c6->rac3j[irr - 2] = -(c6->rac3j[irr - 1] * dj
+ + c6->rac3j[irr] * cjp * j1) / (cj * j1po);
+ sjr += (sjt * jf);
+ } // ibr45 loop
+ }
+ // label 50
+ double osjt = sjt;
+ sjt = c6->rac3j[nmat - 1] * c6->rac3j[nmat - 1];
+ if (sjt >= osjt) {
+ sjr += (sjt * (jf - 2));
+ } else { // label 55
+ nmat++;
+ }
+ // label 60
+ double racmat = c6->rac3j[nmat - 1];
+ c6->rac3j[0] = 1.0;
+ jf = jmn + jmn + 1;
+ double sjl = 1.0 * jf;
+ j1 = jmn;
+ if (j1 != 0) {
+ j1po = j1 + 1;
+ int j1pos = j1po * j1po;
+ double ccjp = 1.0 * (j1pos - jdfs) * (j1pos - m1s);
+ cjp = sqrt(ccjp * (jsmpos - j1pos));
+ dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
+ c6->rac3j[1] = - dj / (cjp * j1);
+ } else { // label 62
+ cjp = sqrt(1.0 * (jsmpos - 1));
+ dj = 1.0 * mdf;
+ c6->rac3j[1] = -dj / cjp;
+ }
+ // label 63
+ int nmatmo = nmat - 1;
+ if (nmatmo >= 2) {
+ for (int irl70 = 2; irl70 <= nmatmo; irl70++) {
+ jf += 2;
+ j1++;
+ j1po = j1 + 1;
+ int j1pos = j1po * j1po;
+ cj = cjp;
+ double ccjp = 1.0 * (j1pos - jdfs) * (j1pos - m1s);
+ cjp = sqrt(ccjp * (jsmpos - j1pos));
+ sjt = c6->rac3j[irl70 - 1] * c6->rac3j[irl70 - 1];
+ dj = 1.0 * jf * (j1 * j1po * mdf + idjc);
+ c6->rac3j[irl70] = -(
+ c6->rac3j[irl70 - 1] * dj
+ + c6->rac3j[irl70 - 2] * cj * j1po
+ ) / (cjp * j1);
+ sjl += (sjt * jf);
+ }
+ }
+ // label 75
+ double ratrac = racmat / c6->rac3j[nmat - 1];
+ double rats = ratrac * ratrac;
+ double sj = sjr + sjl * rats;
+ c6->rac3j[nmat - 1] = racmat;
+ double cnr = (1.0 / sqrt(sj)) * isn;
+ for (int irr80 = nmat; irr80 <= nj; irr80++) c6->rac3j[irr80 - 1] *= cnr;
+ double cnl = cnr * ratrac;
+ for (int irl85 = 1; irl85 <= nmatmo; irl85++) c6->rac3j[irl85 - 1] *= cnl;
+ }
+ }
+}
+
+void r3jmr(int j1, int j2, int j3, int m1, C6 *c6) {
+ int mmx = (j2 < j3 - m1) ? j2 : j3 - m1;
+ int mmn = (-j2 > -(j3 + m1)) ? -j2 : -(j3 + m1);
+ int nmmo = mmx - mmn;
+ int j1po = j1 + 1;
+ int j1tpo = j1po + j1;
+ int isn = 1;
+ if ((j2 - j3 - m1) % 2 != 0) isn = -1;
+ if (nmmo <= 0) {
+ double sj = 1.0 * j1tpo;
+ double cnr = (1.0 / sqrt(sj)) * isn;
+ c6->rac3j[0] = cnr;
+ // returns
+ } else { // label 15
+ int j1s = j1 * j1po;
+ int j2po = j2 + 1;
+ int j2s = j2 * j2po;
+ int j3po = j3 + 1;
+ int j3s = j3 * j3po;
+ int id = j1s - j2s - j3s;
+ int m2 = mmx;
+ int m3 = m1 + m2;
+ double cm = sqrt(1.0 * (j2po - m2) * (j2 + m2) * (j3po - m3) * (j3 + m3));
+ double dm = 1.0 * (id + m2 * m3 * 2);
+ if (nmmo <= 1) {
+ c6->rac3j[0] = dm / cm;
+ double sj = (1.0 + c6->rac3j[0] * c6->rac3j[0]) * j1tpo;
+ double cnr = 1.0 / sqrt(sj) * isn;
+ c6->rac3j[1] = cnr;
+ c6->rac3j[0] *= cnr;
+ // returns
+ } else { // label 20
+ int nm = nmmo + 1;
+ int nmat = (nm + 1) / 2;
+ c6->rac3j[nm - 1] = 1.0;
+ c6->rac3j[nmmo - 1] = dm / cm;
+ double sjt = 1.0;
+ double sjr = 1.0;
+ if (nmat != nmmo) {
+ int nbr = nmmo - nmat;
+ for (int ibr45 = 1; ibr45 <= nbr; ibr45++) {
+ int irr = nm - ibr45;
+ m2--;
+ m3 = m1 + m2;
+ double cmp = cm;
+ cm = sqrt(1.0 * (j2po - m2) * (j2 + m2) * (j3po - m3) * (j3 + m3));
+ sjt = c6->rac3j[irr - 1] * c6->rac3j[irr - 1];
+ dm = 1.0 * (id + m2 * m3 * 2);
+ c6->rac3j[irr - 1] *= ((dm - c6->rac3j[irr] * cmp) / cm);
+ sjr += sjt;
+ } // ibr45 loop
+ }
+ // label 50
+ double osjt = sjt;
+ sjt = c6->rac3j[nmat - 1] * c6->rac3j[nmat - 1];
+ if (sjt >= osjt) {
+ sjr += sjt;
+ } else { // label 55
+ nmat++;
+ }
+ // label 60
+ double racmat = c6->rac3j[nmat - 1];
+ c6->rac3j[0] = 1.0;
+ m2 = mmn;
+ m3 = m1 + m2;
+ double cmp = sqrt(1.0 * (j2 - m2) * (j2po + m2) * (j3 - m3) * (j3po + m3));
+ dm = 1.0 * (id + m2 * m3 * 2);
+ c6->rac3j[1] = dm / cmp;
+ double sjl = 1.0;
+ int nmatmo = nmat - 1;
+ if (nmatmo > 1) {
+ for (int irl70 = 2; irl70 <= nmatmo; irl70++) {
+ m2++;
+ m3 = m1 + m2;
+ cm = cmp;
+ cmp = sqrt(1.0 * (j2 - m2) * (j2po + m2) * (j3 - m3) * (j3po + m3));
+ sjt = c6->rac3j[irl70 - 1] * c6->rac3j[irl70 - 1];
+ dm = 1.0 * (id + m2 * m3 * 2);
+ c6->rac3j[irl70] = (c6->rac3j[irl70 - 1] * dm - c6->rac3j[irl70 - 2] * cm) / cmp;
+ sjl += sjt;
+ }
+ } // label 75
+ double ratrac = racmat / c6->rac3j[nmat - 1];
+ double rats = ratrac * ratrac;
+ double sj = (sjr + sjl * rats) * j1tpo;
+ c6->rac3j[nmat - 1] = racmat;
+ double cnr = 1.0 / sqrt(sj) * isn;
+ for (int irr80 = nmat; irr80 <= nm; irr80++) c6->rac3j[irr80 - 1] *= cnr;
+ double cnl = cnr * ratrac;
+ for (int irl85 = 1; irl85 <= nmatmo; irl85++) c6->rac3j[irl85 - 1] *= cnl;
+ // returns
+ }
+ }
+}
+
+void raba(
+ int le, complex<double> **am0m, complex<double> **w, double **tqce,
+ complex<double> **tqcpe, double **tqcs, complex<double> **tqcps
+) {
+ complex<double> **a, **ctqce, **ctqcs;
+ complex<double> acw, acwp, aca, acap, c1, c2, c3;
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ const double sq2i = 1.0 / sqrt(2.0);
+ int nlem = le * (le + 2);
+ const int nlemt = nlem + nlem;
+ a = new complex<double>*[nlemt];
+ ctqce = new complex<double>*[2];
+ ctqcs = new complex<double>*[2];
+ for (int ai = 0; ai < nlemt; ai++) a[ai] = new complex<double>[2]();
+ for (int ci = 0; ci < 2; ci++) {
+ ctqce[ci] = new complex<double>[3]();
+ ctqcs[ci] = new complex<double>[3]();
+ }
+ for (int i20 = 1; i20 <= nlemt; i20++) {
+ int i = i20 - 1;
+ c1 = cc0;
+ c2 = cc0;
+ for (int j10 = 1; j10 <= nlemt; j10++) {
+ int j = j10 - 1;
+ c1 += (am0m[i][j] * w[j][0]);
+ c2 += (am0m[i][j] * w[j][1]);
+ } // j10 loop
+ a[i][0] = c1;
+ a[i][1] = c2;
+ } //i20 loop
+ int jpo = 2;
+ for (int ipo70 = 1; ipo70 <= 2; ipo70++) {
+ if (ipo70 == 2) jpo = 1;
+ int ipo = ipo70 - 1;
+ ctqce[ipo][0] = cc0;
+ ctqce[ipo][1] = cc0;
+ ctqce[ipo][2] = cc0;
+ tqcpe[ipo][0] = cc0;
+ tqcpe[ipo][1] = cc0;
+ tqcpe[ipo][2] = cc0;
+ ctqcs[ipo][0] = cc0;
+ ctqcs[ipo][1] = cc0;
+ ctqcs[ipo][2] = cc0;
+ tqcps[ipo][0] = cc0;
+ tqcps[ipo][1] = cc0;
+ tqcps[ipo][2] = cc0;
+ for (int l60 = 1; l60 <= le; l60 ++) {
+ int lpo = l60 + 1;
+ int il = l60 * lpo;
+ int ltpo = l60 + lpo;
+ for (int im60 = 1; im60 <= ltpo; im60++) {
+ int m = im60 - lpo;
+ int i = m + il;
+ int ie = i + nlem;
+ int mmmu = m + 1;
+ int mmmmu = (mmmu > 0) ? mmmu : -mmmu;
+ double rmu = 0.0;
+ if (mmmmu <= l60) {
+ int immu = mmmu + il;
+ int immue = immu + nlem;
+ rmu = -sqrt(1.0 * (l60 + mmmu) * (l60 - m)) * sq2i;
+ acw = dconjg(a[i - 1][ipo]) * w[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * w[immue - 1][ipo];
+ acwp = dconjg(a[i - 1][ipo]) * w[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * w[immue - 1][jpo - 1];
+ aca = dconjg(a[i - 1][ipo]) * a[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * a[immue - 1][ipo];
+ acap = dconjg(a[i - 1][ipo]) * a[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * a[immue - 1][jpo - 1];
+ ctqce[ipo][0] += (acw * rmu);
+ tqcpe[ipo][0] += (acwp * rmu);
+ ctqcs[ipo][0] += (aca * rmu);
+ tqcps[ipo][0] += (acap * rmu);
+ }
+ // label 30
+ rmu = -1.0 * m;
+ acw = dconjg(a[i - 1][ipo]) * w[i - 1][ipo] + dconjg(a[ie - 1][ipo]) * w[ie - 1][ipo];
+ acwp = dconjg(a[i - 1][ipo]) * w[i - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * w[ie - 1][jpo - 1];
+ aca = dconjg(a[i - 1][ipo]) * a[i - 1][ipo] + dconjg(a[ie - 1][ipo]) * a[ie - 1][ipo];
+ acap = dconjg(a[i - 1][ipo]) * a[i - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * a[ie - 1][jpo - 1];
+ ctqce[ipo][1] += (acw * rmu);
+ tqcpe[ipo][1] += (acwp * rmu);
+ ctqcs[ipo][1] += (aca * rmu);
+ tqcps[ipo][1] += (acap * rmu);
+ mmmu = m - 1;
+ mmmmu = (mmmu > 0) ? mmmu : -mmmu;
+ if (mmmmu <= l60) {
+ int immu = mmmu + il;
+ int immue = immu + nlem;
+ rmu = sqrt(1.0 * (l60 - mmmu) * (l60 + m)) * sq2i;
+ acw = dconjg(a[i - 1][ipo]) * w[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * w[immue - 1][ipo];
+ acwp = dconjg(a[i - 1][ipo]) * w[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * w[immue - 1][jpo - 1];
+ aca = dconjg(a[i - 1][ipo]) * a[immu - 1][ipo] + dconjg(a[ie - 1][ipo]) * a[immue - 1][ipo];
+ acap = dconjg(a[i - 1][ipo]) * a[immu - 1][jpo - 1] + dconjg(a[ie - 1][ipo]) * a[immue - 1][jpo - 1];
+ ctqce[ipo][2] += (acw * rmu);
+ tqcpe[ipo][2] += (acwp * rmu);
+ ctqcs[ipo][2] += (aca * rmu);
+ tqcps[ipo][2] += (acap * rmu);
+ } // ends im60 loop
+ } // im60 loop
+ } // l60 loop
+ } // ipo70 loop
+ for (int ipo78 = 1; ipo78 <= 2; ipo78++) {
+ int ipo = ipo78 - 1;
+ tqce[ipo][0] = (ctqce[ipo][0] - ctqce[ipo][2]).real() * sq2i;
+ tqce[ipo][1] = ((ctqce[ipo][0] + ctqce[ipo][2]) * uim).real() * sq2i;
+ tqce[ipo][2] = ctqce[ipo][1].real();
+ c1 = tqcpe[ipo][0];
+ c2 = tqcpe[ipo][1];
+ c3 = tqcpe[ipo][2];
+ tqcpe[ipo][0] = (c1 - c3) * sq2i;
+ tqcpe[ipo][1] = (c1 + c3) * (uim * sq2i);
+ tqcpe[ipo][2] = c2;
+ tqcs[ipo][0] = -sq2i * (ctqcs[ipo][0] - ctqcs[ipo][2]).real();
+ tqcs[ipo][1] = -sq2i * ((ctqcs[ipo][0] + ctqcs[ipo][2]) * uim).real();
+ tqcs[ipo][2] = -1.0 * ctqcs[ipo][1].real();
+ c1 = tqcps[ipo][0];
+ c2 = tqcps[ipo][1];
+ c3 = tqcps[ipo][2];
+ tqcps[ipo][0] = -(c1 - c3) * sq2i;
+ tqcps[ipo][1] = -(c1 + c3) * (uim * sq2i);
+ tqcps[ipo][2] = -c2;
+ } // ipo78 loop
+ // Clean memory
+ for (int ai = 0; ai < nlemt; ai++) delete[] a[ai];
+ for (int ci = 0; ci < 2; ci++) {
+ delete[] ctqce[ci];
+ delete[] ctqcs[ci];
+ }
+ delete[] a;
+ delete[] ctqce;
+ delete[] ctqcs;
+}
+
+void rftr(
+ double *u, double *up, double *un, double *gapv, double extins, double scatts,
+ double &rapr, double &cosav, double &fp, double &fn, double &fk, double &fx,
+ double &fy, double &fz
+) {
+ fk = u[0] * gapv[0] + u[1] * gapv[1] + u[2] * gapv[2];
+ rapr = extins - fk;
+ cosav = fk / scatts;
+ fp = -(up[0] * gapv[0] + up[1] * gapv[1] + up[2] * gapv[2]);
+ fn = -(un[0] * gapv[0] + un[1] * gapv[1] + un[2] * gapv[2]);
+ fk = rapr;
+ fx = u[0] * extins - gapv[0];
+ fy = u[1] * extins - gapv[1];
+ fz = u[2] * extins - gapv[2];
+}
+
+void scr0(double vk, double exri, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 * c4) {
+ const complex<double> cc0(0.0, 0.0);
+ double exdc = exri * exri;
+ double ccs = 4.0 * acos(0.0) / (vk * vk);
+ double cccs = ccs / exdc;
+ complex<double> sum21, rm, re, csam;
+ csam = -(ccs / (exri * vk)) * complex<double>(0.0, 0.5);
+ //double scs = 0.0, ecs = 0.0, acs = 0.0;
+ c3->scs = 0.0;
+ c3->ecs = 0.0;
+ c3->acs = 0.0;
+ c3->tfsas = cc0;
+ for (int i14 = 1; i14 <= c4->nsph; i14++) {
+ int iogi = c1->iog[i14 - 1];
+ if (iogi >= i14) {
+ double sums = 0.0;
+ sum21 = cc0;
+ for (int l10 = 1; l10 <= c4->li; l10++) {
+ double fl = 1.0 * (l10 + l10 + 1);
+ rm = 1.0 / c1->rmi[l10 - 1][i14 - 1];
+ re = 1.0 / c1->rei[l10 - 1][i14 - 1];
+ double rvalue = (dconjg(rm) * rm + dconjg(re) * re).real() * fl;
+ sums += rvalue;
+ sum21 += ((rm + re) * fl);
+ } // l10 loop
+ sum21 *= -1.0;
+ double scasec = cccs * sums;
+ double extsec = -cccs * sum21.real();
+ double abssec = extsec - scasec;
+ c1->sscs[i14 - 1] = scasec;
+ c1->sexs[i14 - 1] = extsec;
+ c1->sabs[i14 - 1] = abssec;
+ double gcss = c1->gcsv[i14 - 1];
+ c1->sqscs[i14 - 1] = scasec / gcss;
+ c1->sqexs[i14 - 1] = extsec / gcss;
+ c1->sqabs[i14 - 1] = abssec / gcss;
+ c1->fsas[i14 - 1] = sum21 * csam;
+ }
+ // label 12
+ c3->scs += c1->sscs[iogi - 1];
+ c3->ecs += c1->sexs[iogi - 1];
+ c3->acs += c1->sabs[iogi - 1];
+ c3->tfsas += c1->fsas[iogi - 1];
+ } // i14 loop
+}
+
+void scr2(
+ double vk, double vkarg, double exri, double *duk, C1 *c1, C1_AddOns *c1ao,
+ C3 *c3, C4 *c4
+) {
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> s11, s21, s12, s22, rm, re, csam, cph, phas, cc;
+ double ccs = 1.0 / (vk * vk);
+ csam = -(ccs / (exri * vk)) * complex<double>(0.0, 0.5);
+ const double pi4sq = 64.0 * acos(0.0) * acos(0.0);
+ double cfsq = 4.0 / (pi4sq * ccs * ccs);
+ cph = uim * exri * vkarg;
+ int ls = (c4->li < c4->le) ? c4->li : c4->le;
+ c3->tsas[0][0] = cc0;
+ c3->tsas[1][0] = cc0;
+ c3->tsas[0][1] = cc0;
+ c3->tsas[1][1] = cc0;
+ for (int i14 = 1; i14 <= c4->nsph; i14++) {
+ int i = i14 - 1;
+ int iogi = c1->iog[i14 - 1];
+ if (iogi >= i14) {
+ int k = 0;
+ s11 = cc0;
+ s21 = cc0;
+ s12 = cc0;
+ s22 = cc0;
+ for (int l10 = 1; l10 <= ls; l10++) {
+ int l = l10 - 1;
+ rm = 1.0 / c1->rmi[l][i];
+ re = 1.0 / c1->rei[l][i];
+ int ltpo = l10 + l10 + 1;
+ for (int im10 = 1; im10 <= ltpo; im10++) {
+ k++;
+ int ke = k + c4->nlem;
+ s11 -= (c1->w[k - 1][2] * c1->w[k - 1][0] * rm + c1->w[ke - 1][2] * c1->w[ke - 1][0] * re);
+ s21 -= (c1->w[k - 1][3] * c1->w[k - 1][0] * rm + c1->w[ke - 1][3] * c1->w[ke - 1][0] * re);
+ s12 -= (c1->w[k - 1][2] * c1->w[k - 1][1] * rm + c1->w[ke - 1][2] * c1->w[ke - 1][1] * re);
+ s22 -= (c1->w[k - 1][3] * c1->w[k - 1][1] * rm + c1->w[ke - 1][3] * c1->w[ke - 1][1] * re);
+ } // im10 loop
+ } // l10 loop
+ c1->sas[i][0][0] = s11 * csam;
+ c1->sas[i][1][0] = s21 * csam;
+ c1->sas[i][0][1] = s12 * csam;
+ c1->sas[i][1][1] = s22 * csam;
+ }
+ // label 12
+ phas = exp(cph * (duk[0] * c1->rxx[i] + duk[1] * c1->ryy[i] + duk[2] * c1->rzz[i]));
+ c3->tsas[0][0] += (c1->sas[iogi - 1][0][0] * phas);
+ c3->tsas[1][0] += (c1->sas[iogi - 1][1][0] * phas);
+ c3->tsas[0][1] += (c1->sas[iogi - 1][0][1] * phas);
+ c3->tsas[1][1] += (c1->sas[iogi - 1][1][1] * phas);
+ } // i14 loop
+ for (int i24 = 1; i24 <= c4->nsph; i24++) {
+ int iogi = c1->iog[i24 - 1];
+ if (iogi >= i24) {
+ int j = 0;
+ for (int ipo1 = 1; ipo1 <=2; ipo1++) {
+ for (int jpo1 = 1; jpo1 <= 2; jpo1++) {
+ cc = dconjg(c1->sas[i24 - 1][jpo1 - 1][ipo1 - 1]);
+ for (int ipo2 = 1; ipo2 <= 2; ipo2++) {
+ for (int jpo2 = 1; jpo2 <= 2; jpo2++) {
+ j++;
+ c1ao->vints[i24 - 1][j - 1] = c1->sas[i24 - 1][jpo2 - 1][ipo2 - 1] * cc * cfsq;
+ } // jpo2 loop
+ } // ipo2 loop
+ } // jpo1 loop
+ } // ipo1 loop
+ }
+ } // i24 loop
+ int j = 0;
+ for (int ipo1 = 1; ipo1 <=2; ipo1++) {
+ for (int jpo1 = 1; jpo1 <= 2; jpo1++) {
+ cc = dconjg(c3->tsas[jpo1 - 1][ipo1 - 1]);
+ for (int ipo2 = 1; ipo2 <= 2; ipo2++) {
+ for (int jpo2 = 1; jpo2 <= 2; jpo2++) {
+ j++;
+ c1ao->vintt[j - 1] = c3->tsas[jpo2 - 1][ipo2 - 1] * cc * cfsq;
+ } // jpo2 loop
+ } // ipo2 loop
+ } // jpo1 loop
+ } // ipo1 loop
+}
+
+void str(double **rcf, C1 *c1, C1_AddOns *c1ao, C3 *c3, C4 *c4, C6 *c6) {
+ complex<double> *ylm;
+ const double pi = acos(-1.0);
+ c3->gcs = 0.0;
+ double gcss = 0.0;
+ for (int i18 = 1; i18 <= c4->nsph; i18++) {
+ int iogi = c1->iog[i18 - 1];
+ if (iogi >= i18) {
+ gcss = pi * c1->ros[i18 - 1] * c1->ros[i18 - 1];
+ c1->gcsv[i18 - 1] = gcss;
+ int nsh = c1->nshl[i18 - 1];
+ for (int j16 = 1; j16 <= nsh; j16++) {
+ c1->rc[i18 - 1][j16 - 1] = rcf[i18 - 1][j16 - 1] * c1->ros[i18 - 1];
+ } // j16 loop
+ }
+ c3->gcs += gcss;
+ } // i18 loop
+ int ylm_size = (c4->litpos > c4->lmtpos) ? c4->litpos : c4->lmtpos;
+ ylm = new complex<double>[ylm_size]();
+ int i = 0;
+ for (int l1po28 = 1; l1po28 <= c4->lmpo; l1po28++) {
+ int l1 = l1po28 - 1;
+ for (int l2 = 1; l2 <= c4->lm; l2++) {
+ r3j000(l1, l2, c6);
+ c1ao->ind3j[l1po28 - 1][l2 - 1] = i;
+ int lmnpo = (l2 > l1) ? l2 - l1 + 1 : l1 - l2 + 1;
+ int lmxpo = l2 + l1 + 1;
+ int lpo28 = lmnpo;
+ int il = 0;
+ while (lpo28 <= lmxpo) {
+ i++;
+ il++;
+ c1ao->v3j0[i - 1] = c6->rac3j[il - 1];
+ lpo28 += 2;
+ }
+ } // l2 loop
+ } // l1po28 loop
+ int nsphmo = c4->nsph - 1;
+ int lit = c4->li + c4->li;
+ int ivy = 0;
+ for (int nf40 = 1; nf40 <= nsphmo; nf40++) { // GPU portable?
+ int nfpo = nf40 + 1;
+ for (int ns40 = nfpo; ns40 <= c4->nsph; ns40++) {
+ double rx = c1->rxx[nf40 - 1] - c1->rxx[ns40 - 1];
+ double ry = c1->ryy[nf40 - 1] - c1->ryy[ns40 - 1];
+ double rz = c1->rzz[nf40 - 1] - c1->rzz[ns40 - 1];
+ double rr = 0.0;
+ double crth = 0.0, srth = 0.0, crph = 0.0, srph = 0.0;
+ polar(rx, ry, rz, rr, crth, srth, crph, srph);
+ sphar(crth, srth, crph, srph, lit, ylm);
+ for (int iv38 = 1; iv38 <= c4->litpos; iv38++) {
+ c1ao->vyhj[iv38 + ivy - 1] = dconjg(ylm[iv38 - 1]);
+ } // iv38 loop
+ ivy += c4->litpos;
+ } // ns40 loop
+ } // nf40 loop
+ int lmt = c4->li + c4->le;
+ ivy = 0;
+ for (int nf50 = 1; nf50 <= c4->nsph; nf50++) {
+ double rx = c1->rxx[nf50 - 1];
+ double ry = c1->ryy[nf50 - 1];
+ double rz = c1->rzz[nf50 - 1];
+ if (rx != 0.0 || ry != 0.0 || rz != 0.0) {
+ double rr = 0.0;
+ double crth = 0.0, srth = 0.0, crph = 0.0, srph = 0.0;
+ polar(rx, ry, rz, rr, crth, srth, crph, srph);
+ sphar(crth, srth, crph, srph, lmt, ylm);
+ for (int iv48 = 1; iv48 <= c4->lmtpos; iv48++) {
+ c1ao->vyj0[iv48 + ivy - 1] = dconjg(ylm[iv48 - 1]);
+ } // iv48 loop
+ }
+ ivy += c4->lmtpos;
+ } // nf50 loop
+ delete[] ylm;
+}
+
+void tqr(
+ double *u, double *up, double *un, double *tqev, double *tqsv, double &tep,
+ double &ten, double &tek, double &tsp, double &tsn, double &tsk
+) {
+ tep = up[0] * tqev[0] + up[1] * tqev[1] + up[2] * tqev[2];
+ ten = un[0] * tqev[0] + un[1] * tqev[1] + un[2] * tqev[2];
+ tek = u[0] * tqev[0] + u[1] * tqev[1] + u[2] * tqev[2];
+ tsp = up[0] * tqsv[0] + up[1] * tqsv[1] + up[2] * tqsv[2];
+ tsn = un[0] * tqsv[0] + un[1] * tqsv[1] + un[2] * tqsv[2];
+ tsk = u[0] * tqsv[0] + u[1] * tqsv[1] + u[2] * tqsv[2];
+}
+
+void ztm(complex<double> **am, C1 *c1, C1_AddOns *c1ao, C4 *c4, C6 *c6, C9 * c9) {
+ complex<double> gie, gle, a1, a2, a3, a4, sum1, sum2, sum3, sum4;
+ const complex<double> cc0(0.0, 0.0);
+ int ndi = c4->nsph * c4->nlim;
+ int i2 = 0;
+ for (int n2 = 1; n2 <= c4->nsph; n2++) { // GPU portable?
+ for (int l2 = 1; l2 <= c4->li; l2++) {
+ int l2tpo = l2 + l2 + 1;
+ int m2 = -l2 - 1;
+ for (int im2 = 1; im2 <= l2tpo; im2++) {
+ m2++;
+ i2++;
+ int i3 = 0;
+ for (int l3 = 1; l3 <= c4->le; l3++) {
+ int l3tpo = l3 + l3 + 1;
+ int m3 = -l3 - 1;
+ for (int im3 = 1; im3 <= l3tpo; im3++) {
+ m3++;
+ i3++;
+ c9->gis[i2 - 1][i3 - 1] = ghit(2, 0, n2, l2, m2, l3, m3, c1, c1ao, c4, c6);
+ c9->gls[i2 - 1][i3 - 1] = ghit(2, 1, n2, l2, m2, l3, m3, c1, c1ao, c4, c6);
+ } // im3 loop
+ } // l3 loop
+ } // im2 loop
+ } // l2 loop
+ } // n2 loop
+ for (int i1 = 1; i1 <= ndi; i1++) { // GPU portable?
+ int i1e = i1 + ndi;
+ for (int i3 = 1; i3 <= c4->nlem; i3++) {
+ int i3e = i3 + c4->nlem;
+ sum1 = cc0;
+ sum2 = cc0;
+ sum3 = cc0;
+ sum4 = cc0;
+ for (int i2 = 1; i2 <= ndi; i2++) {
+ int i2e = i2 + ndi;
+ gie = c9->gis[i2 - 1][i3 - 1];
+ gle = c9->gls[i2 - 1][i3 - 1];
+ a1 = am[i1 - 1][i2 - 1];
+ a2 = am[i1 - 1][i2e - 1];
+ a3 = am[i1e - 1][i2 - 1];
+ a4 = am[i1e - 1][i2e - 1];
+ sum1 += (a1 * gie + a2 * gle);
+ sum2 += (a1 * gle + a2 * gie);
+ sum3 += (a3 * gie + a4 * gle);
+ sum4 += (a3 * gle + a4 * gie);
+ } // i2 loop
+ c9->sam[i1 - 1][i3 - 1] = sum1;
+ c9->sam[i1 - 1][i3e - 1] = sum2;
+ c9->sam[i1e - 1][i3 - 1] = sum3;
+ c9->sam[i1e - 1][i3e - 1] = sum4;
+ } // i3 loop
+ } // i1 loop
+ for (int i1 = 1; i1 <= ndi; i1++) {
+ for (int i0 = 1; i0 <= c4->nlem; i0++) {
+ c9->gis[i1 - 1][i0 - 1] = dconjg(c9->gis[i1 - 1][i0 - 1]);
+ c9->gls[i1 - 1][i0 - 1] = dconjg(c9->gls[i1 - 1][i0 - 1]);
+ } // i0 loop
+ } // i1 loop
+ int nlemt = c4->nlem + c4->nlem;
+ for (int i0 = 1; i0 <= c4->nlem; i0++) {
+ int i0e = i0 + c4->nlem;
+ for (int i3 = 1; i3 <= nlemt; i3++) {
+ sum1 = cc0;
+ sum2 = cc0;
+ for (int i1 = 1; i1 <= ndi; i1 ++) {
+ int i1e = i1 + ndi;
+ a1 = c9->sam[i1 - 1][i3 - 1];
+ a2 = c9->sam[i1e - 1][i3 - 1];
+ gie = c9->gis[i1 - 1][i0 - 1];
+ gle = c9->gls[i1 - 1][i0 - 1];
+ sum1 += (a1 * gie + a2 * gle);
+ sum2 += (a1 * gle + a2 * gie);
+ } // i1 loop
+ c1ao->am0m[i0 - 1][i3 - 1] = -sum1;
+ c1ao->am0m[i0e - 1][i3 - 1] = -sum2;
+ } // i3 loop
+ } // i0 loop
+}
diff --git a/src/libnptm/file_io.cpp b/src/libnptm/file_io.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..a5df8a6ab6ae42f7d758830dfad5954518991fca
--- /dev/null
+++ b/src/libnptm/file_io.cpp
@@ -0,0 +1,172 @@
+/*! \file file_io.cpp
+ *
+ * \brief Implementation of file I/O operations.
+ */
+#include <stdexcept>
+#include <regex>
+#include <string>
+#include <hdf5.h>
+
+#ifndef INCLUDE_LIST_H_
+#include "../include/List.h"
+#endif
+
+#ifndef INCLUDE_FILE_IO_H_
+#include "../include/file_io.h"
+#endif
+
+using namespace std;
+
+FileSchema::FileSchema(int num_rec, string *rec_types, string *rec_names) {
+ num_records = num_rec;
+ record_types = new string[num_rec];
+ record_names = new string[num_rec];
+ for (int i = 0; i < num_rec; i++) {
+ record_types[i] = rec_types[i];
+ if (rec_names != NULL) record_names[i] = rec_names[i];
+ else record_names[i] = "/dset" + to_string(i);
+ }
+}
+
+FileSchema::~FileSchema() {
+ delete[] record_names;
+ delete[] record_types;
+}
+
+string* FileSchema::get_record_names() {
+ string *rec_names = new string[num_records];
+ for (int i = 0; i < num_records; i++) rec_names[i] = record_names[i];
+ return rec_names;
+}
+
+string* FileSchema::get_record_types() {
+ string *rec_types = new string[num_records];
+ for (int i = 0; i < num_records; i++) rec_types[i] = record_types[i];
+ return rec_types;
+}
+
+HDFFile::HDFFile(string name, unsigned int flags, hid_t fcpl_id, hid_t fapl_id) {
+ file_name = name;
+ file_id = H5Fcreate(name.c_str(), flags, fcpl_id, fapl_id);
+ id_list = new List<hid_t>(1);
+ id_list->set(0, file_id);
+ if (file_id != H5I_INVALID_HID) file_open_flag = true;
+ status = (herr_t)0;
+}
+
+HDFFile::~HDFFile() {
+ if (H5Iis_valid(file_id) > 0) status = H5Fclose(file_id);
+ delete id_list;
+}
+
+herr_t HDFFile::close() {
+ status = H5Fclose(file_id);
+ if (status == 0) file_open_flag = false;
+ return status;
+}
+
+HDFFile* HDFFile::from_schema(
+ FileSchema &schema, string name, unsigned int flags,
+ hid_t fcpl_id, hid_t fapl_id
+) {
+ HDFFile *hdf_file = new HDFFile(name, flags, fcpl_id, fapl_id);
+ hid_t file_id = hdf_file->get_file_id();
+ herr_t status;
+ string *rec_types = schema.get_record_types();
+ string *rec_names = schema.get_record_names();
+ string known_types[] = {"INT32", "FLOAT64"};
+ int rec_num = schema.get_record_number();
+ regex re;
+ smatch m;
+ for (int ri = 0; ri < rec_num; ri++) {
+ int rank = 0;
+ hsize_t *dims, *max_dims;
+ hid_t data_type;
+ string str_target = rec_types[ri];
+ int type_index = 0;
+ bool found_type = false;
+ while (!found_type) {
+ re = regex(known_types[type_index++]);
+ if (regex_search(str_target, m, re)) {
+ found_type = true;
+ str_target = m.suffix().str();
+ if (type_index == 1) data_type = H5Tcopy(H5T_NATIVE_INT);
+ else if (type_index == 2) data_type = H5Tcopy(H5T_NATIVE_DOUBLE);
+ }
+ if (type_index == 2) break;
+ }
+ if (found_type) {
+ re = regex("[0-9]+");
+ string old_target = str_target;
+ while (regex_search(str_target, m, re)) {
+ rank++;
+ str_target = m.suffix().str();
+ }
+ dims = new hsize_t[rank]();
+ max_dims = new hsize_t[rank]();
+ str_target = old_target;
+ for (int ti = 0; ti < rank; ti++) {
+ regex_search(str_target, m, re);
+ hsize_t dim = (hsize_t)stoi(m.str());
+ dims[ti] = dim;
+ max_dims[ti] = dim;
+ str_target = m.suffix().str();
+ }
+ hid_t dataspace_id = H5Screate_simple(rank, dims, max_dims);
+ hid_t dataset_id = H5Dcreate(
+ file_id, rec_names[ri].c_str(), data_type, dataspace_id, H5P_DEFAULT,
+ H5P_DEFAULT, H5P_DEFAULT
+ );
+ status = H5Sclose(dataspace_id);
+ status = H5Dclose(dataset_id);
+ delete[] dims;
+ delete[] max_dims;
+ } else {
+ string message = "unrecognized type \"" + rec_types[ri] + "\"\n";
+ throw runtime_error(message);
+ }
+ }
+
+ delete[] rec_types;
+ delete[] rec_names;
+ return hdf_file;
+}
+
+herr_t HDFFile::write(
+ string dataset_name, string data_type, const void *buffer,
+ hid_t mem_space_id, hid_t file_space_id, hid_t dapl_id,
+ hid_t dxpl_id
+) {
+ string known_types[] = {"INT32", "FLOAT64"};
+ regex re;
+ smatch m;
+ bool found_type = false;
+ int type_index = 0;
+ while (!found_type) {
+ re = regex(known_types[type_index++]);
+ found_type = regex_search(data_type, m, re);
+ if (type_index == 2) break;
+ }
+ if (found_type) {
+ hid_t dataset_id = H5Dopen2(file_id, dataset_name.c_str(), dapl_id);
+ hid_t mem_type_id;
+ switch (type_index) {
+ case 1:
+ mem_type_id = H5T_NATIVE_INT; break;
+ case 2:
+ mem_type_id = H5T_NATIVE_DOUBLE; break;
+ default:
+ throw runtime_error("Unrecognized data type \"" + data_type + "\"");
+ }
+ if (dataset_id != H5I_INVALID_HID) {
+ status = H5Dwrite(dataset_id, mem_type_id, mem_space_id, file_space_id, dxpl_id, buffer);
+ if (status == 0) status = H5Dclose(dataset_id);
+ else status = (herr_t)-2;
+ } else {
+ status = (herr_t)-1;
+ }
+ } else {
+ throw runtime_error("Unrecognized data type \"" + data_type + "\"");
+ }
+ return status;
+}
diff --git a/src/libnptm/sph_subs.cpp b/src/libnptm/sph_subs.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..99aa4d7f25981421648ca34267e322db332c59aa
--- /dev/null
+++ b/src/libnptm/sph_subs.cpp
@@ -0,0 +1,1174 @@
+/*! \file sph_subs.cpp
+ *
+ * \brief C++ implementation of SPHERE subroutines.
+ */
+#include <complex>
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
+#ifndef INCLUDE_SPH_SUBS_H_
+#include "../include/sph_subs.h"
+#endif
+
+using namespace std;
+
+void aps(double ****zpv, int li, int nsph, C1 *c1, double sqk, double *gaps) {
+ complex<double> cc0 = complex<double>(0.0, 0.0);
+ complex<double> summ, sume, suem, suee, sum;
+ double half_pi = acos(0.0);
+ double cofs = half_pi * 2.0 / sqk;
+ for (int i40 = 0; i40 < nsph; i40++) {
+ int i = i40 + 1;
+ int iogi = c1->iog[i40];
+ if (iogi >= i) {
+ sum = cc0;
+ for (int l30 = 0; l30 < li; l30++) {
+ int l = l30 + 1;
+ int ltpo = l + l + 1;
+ for (int ilmp = 1; ilmp < 4; ilmp++) {
+ int ilmp30 = ilmp - 1;
+ bool goto30 = (l == 1 && ilmp == 1) || (l == li && ilmp == 3);
+ if (!goto30) {
+ int lmpml = ilmp - 2;
+ int lmp = l + lmpml;
+ double cofl = sqrt(1.0 * (ltpo * (lmp + lmp + 1)));
+ summ = zpv[l30][ilmp30][0][0] /
+ (
+ dconjg(c1->rmi[l30][i40]) *
+ c1->rmi[lmp - 1][i40]
+ );
+ sume = zpv[l30][ilmp30][0][1] /
+ (
+ dconjg(c1->rmi[l30][i40]) *
+ c1->rei[lmp - 1][i40]
+ );
+ suem = zpv[l30][ilmp30][1][0] /
+ (
+ dconjg(c1->rei[l30][i40]) *
+ c1->rmi[lmp - 1][i40]
+ );
+ suee = zpv[l30][ilmp30][1][1] /
+ (
+ dconjg(c1->rei[l30][i40]) *
+ c1->rei[lmp - 1][i40]
+ );
+ sum += (cg1(lmpml, 0, l, -1) * (summ - sume - suem + suee) +
+ cg1(lmpml, 0, l, 1) * (summ + sume + suem + suee)) * cofl;
+ }
+ }
+ }
+ }
+ gaps[i40] = sum.real() * cofs;
+ }
+}
+
+void cbf(int n, complex<double> z, int &nm, complex<double> csj[]) {
+ /*
+ * FROM CSPHJY OF LIBRARY specfun
+ *
+ * ==========================================================
+ * Purpose: Compute spherical Bessel functions j
+ * Input : z --- Complex argument of j
+ * n --- Order of j ( n = 0,1,2,... )
+ * Output: csj(n+1) --- j
+ * nm --- Highest order computed
+ * Routines called:
+ * msta1 and msta2 for computing the starting
+ * point for backward recurrence
+ * ==========================================================
+ */
+ double zz = z.real() * z.real() + z.imag() * z.imag();
+ double a0 = sqrt(zz);
+ nm = n;
+ if (a0 < 1.0e-60) {
+ for (int k = 2; k <= n + 1; k++) {
+ csj[k - 1] = 0.0;
+ }
+ csj[0] = complex<double>(1.0, 0.0);
+ return;
+ }
+ csj[0] = std::sin(z) / z;
+ if (n == 0) {
+ return;
+ }
+ csj[1] = (csj[0] -std::cos(z)) / z;
+ if (n == 1) {
+ return;
+ }
+ complex<double> csa = csj[0];
+ complex<double> csb = csj[1];
+ int m = msta1(a0, 200);
+ if (m < n) nm = m;
+ else m = msta2(a0, n, 15);
+ complex<double> cf0 = 0.0;
+ complex<double> cf1 = 1.0e-100;
+ complex<double> cf, cs;
+ for (int k = m; k >= 0; k--) {
+ cf = (2.0 * k + 3.0) * cf1 / z - cf0;
+ if (k <= nm) csj[k] = cf;
+ cf0 = cf1;
+ cf1 = cf;
+ }
+ double abs_csa = abs(csa);
+ double abs_csb = abs(csb);
+ if (abs_csa > abs_csb) cs = csa / cf;
+ else cs = csb / cf0;
+ for (int k = 0; k <= nm; k++) {
+ csj[k] = cs * csj[k];
+ }
+}
+
+double cg1(int lmpml, int mu, int l, int m) {
+ double result = 0.0;
+ double xd, xn;
+ if (lmpml == -1) { // Interpreted as GOTO 30
+ xd = 2.0 * l * (2 * l - 1);
+ if (mu == -1) {
+ xn = 1.0 * (l - 1 - m) * (l - m);
+ } else if (mu == 0) {
+ xn = 2.0 * (l - m) * (l + m);
+ } else if (mu == 1) {
+ xn = 1.0 * (l - 1 + m) * (l + m);
+ } else {
+ throw 111; // Need an exception for unpredicted indices.
+ }
+ result = sqrt(xn / xd);
+ } else if (lmpml == 0) { // Interpreted as GOTO 5
+ bool goto10 = (m != 0) || (mu != 0);
+ if (!goto10) {
+ result = 0.0;
+ return result;
+ }
+ if (mu != 0) {
+ xd = 2.0 * l * (l + 1);
+ if (mu == -1) {
+ xn = 1.0 * (l - m) * (l + m + 1);
+ result = -sqrt(xn / xd);
+ } else if (mu == 1) { // mu > 0
+ xn = 1.0 * (l + m) * (l - m + 1);
+ result = sqrt(xn / xd);
+ } else {
+ throw 111; // Need an exception for unpredicted indices.
+ }
+ } else { // mu = 0
+ xd = 1.0 * l * (l + 1);
+ xn = -1.0 * m;
+ result = xn / sqrt(xd);
+ }
+ } else if (lmpml == 1) { // Interpreted as GOTO 60
+ xd = 2.0 * (l * 2 + 3) * (l + 1);
+ if (mu == -1) {
+ xn = 1.0 * (l + 1 + m) * (l + 2 + m);
+ result = sqrt(xn / xd);
+ } else if (mu == 0) {
+ xn = 2.0 * (l + 1 - m) * (l + 1 + m);
+ result = -sqrt(xn / xd);
+ } else if (mu == 1) {
+ xn = 1.0 * (l + 1 - m) * (l + 2 - m);
+ result = sqrt(xn / xd);
+ } else { // mu was not recognized.
+ throw 111; // Need an exception for unpredicted indices.
+ }
+ } else { // lmpml was not recognized
+ throw 111; // Need an exception for unpredicted indices.
+ }
+ return result;
+}
+
+complex<double> dconjg(complex<double> z) {
+ double zreal = z.real();
+ double zimag = z.imag();
+ return complex<double>(zreal, -zimag);
+}
+
+void diel(int npntmo, int ns, int i, int ic, double vk, C1 *c1, C2 *c2) {
+ const double dif = c1->rc[i - 1][ns] - c1->rc[i - 1][ns - 1];
+ const double half_step = 0.5 * dif / npntmo;
+ double rr = c1->rc[i - 1][ns - 1];
+ const complex<double> delta = c2->dc0[ic] - c2->dc0[ic - 1];
+ const int kpnt = npntmo + npntmo;
+ c2->ris[kpnt] = c2->dc0[ic];
+ c2->dlri[kpnt] = complex<double>(0.0, 0.0);
+ const int i90 = i - 1;
+ const int ns90 = ns - 1;
+ const int ic90 = ic - 1;
+ for (int np90 = 0; np90 < kpnt; np90++) {
+ double ff = (rr - c1->rc[i90][ns90]) / dif;
+ c2->ris[np90] = delta * ff * ff * (-2.0 * ff + 3.0) + c2->dc0[ic90];
+ c2->dlri[np90] = 3.0 * delta * ff * (1.0 - ff) / (dif * vk * c2->ris[np90]);
+ rr += half_step;
+ }
+}
+
+void dme(
+ int li, int i, int npnt, int npntts, double vk, double exdc, double exri,
+ C1 *c1, C2 *c2, int &jer, int &lcalc, complex<double> &arg
+) {
+ const int lipo = li + 1;
+ const int lipt = li + 2;
+ double *rfj = new double[lipt];
+ double *rfn = new double[lipt];
+ complex<double> cfj[lipt], fbi[lipt], fb[lipt], fn[lipt];
+ complex<double> rmf[li], drmf[li], ref[li], dref[li];
+ complex<double> dfbi, dfb, dfn, ccna, ccnb, ccnc, ccnd;
+ complex<double> y1, dy1, y2, dy2, arin, cri, uim;
+ jer = 0;
+ uim = complex<double>(0.0, 1.0);
+ int nstp = npnt - 1;
+ int nstpts = npntts - 1;
+ double sz = vk * c1->ros[i - 1];
+ c2->vsz[i - 1] = sz;
+ double vkr1 = vk * c1->rc[i - 1][0];
+ int nsh = c1->nshl[i - 1];
+ c2->vkt[i - 1] = std::sqrt(c2->dc0[0]);
+ arg = vkr1 * c2->vkt[i - 1];
+ arin = arg;
+ bool goto32 = false;
+ if (arg.imag() != 0.0) {
+ cbf(lipo, arg, lcalc, cfj);
+ if (lcalc < lipo) {
+ jer = 5;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ for (int j24 = 1; j24 <= lipt; j24++) fbi[j24 - 1] = cfj[j24 - 1];
+ goto32 = true;
+ }
+ if (!goto32) {
+ rbf(lipo, arg.real(), lcalc, rfj);
+ if (lcalc < lipo) {
+ jer = 5;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ for (int j30 = 1; j30 <= lipt; j30++) fbi[j30 - 1] = rfj[j30 - 1];
+ }
+ double arex = sz * exri;
+ arg = arex;
+ rbf(lipo, arex, lcalc, rfj);
+ if (lcalc < lipo) {
+ jer = 7;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ rnf(lipo, arex, lcalc, rfn);
+ if (lcalc < lipo) {
+ jer = 8;
+ delete[] rfj;
+ delete[] rfn;
+ return;
+ }
+ for (int j43 = 1; j43 <= lipt; j43++) {
+ fb[j43 - 1] = rfj[j43 - 1];
+ fn[j43 - 1] = rfn[j43 - 1];
+ }
+ if (nsh <= 1) {
+ cri = c2->dc0[0] / exdc;
+ for (int l60 = 1; l60 <= li; l60++) {
+ int lpo = l60 + 1;
+ int ltpo = lpo + l60;
+ int lpt = lpo + 1;
+ dfbi = ((1.0 * l60) * fbi[l60 - 1] - (1.0 * lpo) * fbi[lpt - 1]) * arin + fbi[lpo - 1] * (1.0 * ltpo);
+ dfb = ((1.0 * l60) * fb[l60 - 1] - (1.0 * lpo) * fb[lpt - 1]) * arex + fb[lpo - 1] * (1.0 * ltpo);
+ dfn = ((1.0 * l60) * fn[l60 - 1] - (1.0 * lpo) * fn[lpt - 1]) * arex + fn[lpo - 1] * (1.0 * ltpo);
+ ccna = fbi[lpo - 1] * dfn;
+ ccnb = fn[lpo - 1] * dfbi;
+ ccnc = fbi[lpo - 1] * dfb;
+ ccnd = fb[lpo - 1] * dfbi;
+ c1->rmi[l60 - 1][i - 1] = 1.0 + uim * (ccna - ccnb) / (ccnc - ccnd);
+ c1->rei[l60 - 1][i - 1] = 1.0 + uim * (cri * ccna - ccnb) / (cri * ccnc - ccnd);
+ }
+ } else { // nsh > 1
+ int ic = 1;
+ for (int l80 = 1; l80 <= li; l80++) {
+ int lpo = l80 + 1;
+ int ltpo = lpo + l80;
+ int lpt = lpo + 1;
+ int dltpo = ltpo;
+ y1 = fbi[lpo - 1];
+ dy1 = ((1.0 * l80) * fbi[l80 - 1] - (1.0 * lpo) * fbi[lpt - 1]) * c2->vkt[i - 1] / (1.0 * dltpo);
+ y2 = y1;
+ dy2 = dy1;
+ ic = 1;
+ for (int ns76 = 2; ns76 <= nsh; ns76++) {
+ int nsmo = ns76 - 1;
+ double vkr = vk * c1->rc[i - 1][nsmo - 1];
+ if (ns76 % 2 != 0) {
+ ic += 1;
+ double step = 1.0 * nstp;
+ step = vk * (c1->rc[i - 1][ns76 - 1] - c1->rc[i - 1][nsmo - 1]) / step;
+ arg = c2->dc0[ic - 1];
+ rkc(nstp, step, arg, vkr, lpo, y1, y2, dy1, dy2);
+ } else {
+ diel(nstpts, nsmo, i, ic, vk, c1, c2);
+ double stepts = 1.0 * nstpts;
+ stepts = vk * (c1->rc[i - 1][ns76 - 1] - c1->rc[i - 1][nsmo - 1]) / stepts;
+ rkt(nstpts, stepts, vkr, lpo, y1, y2, dy1, dy2, c2);
+ }
+ }
+ rmf[l80 - 1] = y1 * sz;
+ drmf[l80 - 1] = dy1 * sz + y1;
+ ref[l80 - 1] = y2 * sz;
+ dref[l80 - 1] = dy2 * sz + y2;
+ }
+ cri = 1.0 + uim * 0.0;
+ if (nsh % 2 != 0) cri = c2->dc0[ic - 1] / exdc;
+ for (int l90 = 1; l90 <= li; l90++) {
+ int lpo = l90 + 1;
+ int ltpo = lpo + l90;
+ int lpt = lpo + 1;
+ dfb = ((1.0 * l90) * fb[l90 - 1] - (1.0 * lpo) * fb[lpt - 1]) * arex + fb[lpo - 1] * (1.0 * ltpo);
+ dfn = ((1.0 * l90) * fn[l90 - 1] - (1.0 * lpo) * fn[lpt - 1]) * arex + fn[lpo - 1] * (1.0 * ltpo);
+ ccna = rmf[l90 - 1] * dfn;
+ ccnb = drmf[l90 - 1] * fn[lpo - 1] * (1.0 * sz * ltpo);
+ ccnc = rmf[l90 - 1] * dfb;
+ ccnd = drmf[l90 - 1] * fb[lpo -1] * (1.0 * sz * ltpo);
+ c1->rmi[l90 - 1][i - 1] = 1.0 + uim *(ccna - ccnb) / (ccnc - ccnd);
+ ccna = ref[l90 - 1] * dfn;
+ ccnb = dref[l90 - 1] * fn[lpo - 1] * (1.0 * sz * ltpo);
+ ccnc = ref[l90 - 1] * dfb;
+ ccnd = dref[l90 - 1] *fb[lpo - 1] * (1.0 * sz * ltpo);
+ c1->rei[l90 - 1][i - 1] = 1.0 + uim * (cri * ccna - ccnb) / (cri * ccnc - ccnd);
+ }
+ } // nsh <= 1 ?
+ delete[] rfj;
+ delete[] rfn;
+ return;
+}
+
+double envj(int n, double x) {
+ double result = 0.0;
+ double xn;
+ if (n == 0) {
+ xn = 1.0e-100;
+ result = 0.5 * log10(6.28 * xn) - xn * log10(1.36 * x / xn);
+ } else {
+ result = 0.5 * log10(6.28 * n) - n * log10(1.36 * x / n);
+ }
+ return result;
+}
+
+void mmulc(complex<double> *vint, double **cmullr, double **cmul) {
+ double sm2 = vint[0].real();
+ double s24 = vint[1].real();
+ double d24 = vint[1].imag();
+ double sm4 = vint[5].real();
+ double s23 = vint[8].real();
+ double d32 = vint[8].imag();
+ double s34 = vint[9].real();
+ double d34 = vint[9].imag();
+ double sm3 = vint[10].real();
+ double s31 = vint[11].real();
+ double d31 = vint[11].imag();
+ double s21 = vint[12].real();
+ double d12 = vint[12].imag();
+ double s41 = vint[13].real();
+ double d14 = vint[13].imag();
+ double sm1 = vint[15].real();
+ cmullr[0][0] = sm2;
+ cmullr[0][1] = sm3;
+ cmullr[0][2] = -s23;
+ cmullr[0][3] = -d32;
+ cmullr[1][0] = sm4;
+ cmullr[1][1] = sm1;
+ cmullr[1][2] = -s41;
+ cmullr[1][3] = -d14;
+ cmullr[2][0] = -s24 * 2.0;
+ cmullr[2][1] = -s31 * 2.0;
+ cmullr[2][2] = s21 + s34;
+ cmullr[2][3] = d34 + d12;
+ cmullr[3][0] = -d24 * 2.0;
+ cmullr[3][1] = -d31 * 2.0;
+ cmullr[3][2] = d34 - d12;
+ cmullr[3][3] = s21 - s34;
+ cmul[0][0] = (sm2 + sm3 + sm4 + sm1) * 0.5;
+ cmul[0][1] = (sm2 - sm3 + sm4 - sm1) * 0.5;
+ cmul[0][2] = -s23 - s41;
+ cmul[0][3] = -d32 - d14;
+ cmul[1][0] = (sm2 + sm3 - sm4 - sm1) * 0.5;
+ cmul[1][1] = (sm2 - sm3 - sm4 + sm1) * 0.5;
+ cmul[1][2] = -s23 + s41;
+ cmul[1][3] = -d32 + d14;
+ cmul[2][0] = -s24 - s31;
+ cmul[2][1] = -s24 + s31;
+ cmul[2][2] = s21 + s34;
+ cmul[2][3] = d34 + d12;
+ cmul[3][0] = -d24 - d31;
+ cmul[3][1] = -d24 + d31;
+ cmul[3][2] = d34 - d12;
+ cmul[3][3] = s21 - s34;
+}
+
+int msta1(double x, int mp) {
+ int result = 0;
+ double a0 = x;
+ if (a0 < 0.0) a0 *= -1.0;
+ int n0 = (int)(1.1 * a0) + 1;
+ double f0 = envj(n0, a0) - mp;
+ int n1 = n0 + 5;
+ double f1 = envj(n1, a0) - mp;
+ for (int it10 = 0; it10 < 20; it10++) {
+ int nn = n1 - (int)((n1 - n0) / (1.0 - f0 / f1));
+ double f = envj(nn, a0) - mp;
+ int test_n = nn - n1;
+ if (test_n < 0) test_n *= -1;
+ if (test_n < 1) {
+ return nn;
+ }
+ n0 = n1;
+ f0 = f1;
+ n1 = nn;
+ f1 = f;
+ result = nn;
+ }
+ return result;
+}
+
+int msta2(double x, int n, int mp) {
+ int result = 0;
+ double a0 = x;
+ if (a0 < 0) a0 *= -1.0;
+ double half_mp = 0.5 * mp;
+ double ejn = envj(n, a0);
+ double obj;
+ int n0;
+ if (ejn <= half_mp) {
+ obj = 1.0 * mp;
+ n0 = (int)(1.1 * a0) + 1;
+ } else {
+ obj = half_mp + ejn;
+ n0 = n;
+ }
+ double f0 = envj(n0, a0) - obj;
+ int n1 = n0 + 5;
+ double f1 = envj(n1, a0) - obj;
+ for (int it10 = 0; it10 < 20; it10 ++) {
+ int nn = n1 - (int)((n1 - n0) / (1.0 - f0 / f1));
+ double f = envj(nn, a0) - obj;
+ int test_n = nn - n1;
+ if (test_n < 0) test_n *= -1;
+ if (test_n < 1) return (nn + 10);
+ n0 = n1;
+ f0 = f1;
+ n1 = nn;
+ f1 = f;
+ result = nn + 10;
+ }
+ return result;
+}
+
+void orunve( double *u1, double *u2, double *u3, int iorth, double torth) {
+ if (iorth <= 0) {
+ double cp = u1[0] * u2[0] + u1[1] * u2[1] + u1[2] * u2[2];
+ double abs_cp = cp;
+ if (abs_cp < 0.0) abs_cp *= -1.0;
+ if (iorth == 0 || abs_cp >= torth) {
+ double fn = 1.0 / sqrt(1.0 - cp * cp);
+ u3[0] = (u1[1] * u2[2] - u1[2] * u2[1]) * fn;
+ u3[1] = (u1[2] * u2[0] - u1[0] * u2[2]) * fn;
+ u3[2] = (u1[0] * u2[1] - u1[1] * u2[0]) * fn;
+ return;
+ }
+ }
+ u3[0] = u1[1] * u2[2] - u1[2] * u2[1];
+ u3[1] = u1[2] * u2[0] - u1[0] * u2[2];
+ u3[2] = u1[0] * u2[1] - u1[1] * u2[0];
+}
+
+void pwma(
+ double *up, double *un, complex<double> *ylm, int inpol, int lw,
+ int isq, C1 *c1
+) {
+ const double four_pi = 8.0 * acos(0.0);
+ int is = isq;
+ if (isq == -1) is = 0;
+ int ispo = is + 1;
+ int ispt = is + 2;
+ int nlwm = lw * (lw + 2);
+ int nlwmt = nlwm + nlwm;
+ const double sqrtwi = 1.0 / sqrt(2.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> cm1 = 0.5 * complex<double>(up[0], up[1]);
+ complex<double> cp1 = 0.5 * complex<double>(up[0], -up[1]);
+ double cz1 = up[2];
+ complex<double> cm2 = 0.5 * complex<double>(un[0], un[1]);
+ complex<double> cp2 = 0.5 * complex<double>(un[0], -un[1]);
+ double cz2 = un[2];
+ for (int l20 = 0; l20 < lw; l20++) {
+ int l = l20 + 1;
+ int lf = l + 1;
+ int lftl = lf * l;
+ double x = 1.0 * lftl;
+ complex<double> cl = complex<double>(four_pi / sqrt(x), 0.0);
+ for (int powi = 1; powi <= l; powi++) cl *= uim;
+ int mv = l + lf;
+ int m = -lf;
+ for (int mf20 = 0; mf20 < mv; mf20++) {
+ m += 1;
+ int k = lftl + m;
+ x = 1.0 * (lftl - m * (m + 1));
+ double cp = sqrt(x);
+ x = 1.0 * (lftl - m * (m - 1));
+ double cm = sqrt(x);
+ double cz = 1.0 * m;
+ c1->w[k - 1][ispo - 1] = dconjg(
+ cp1 * cp * ylm[k + 1] +
+ cm1 * cm * ylm[k - 1] +
+ cz1 * cz * ylm[k]
+ ) * cl;
+ c1->w[k - 1][ispt - 1] = dconjg(
+ cp2 * cp * ylm[k + 1] +
+ cm2 * cm * ylm[k - 1] +
+ cz2 * cz * ylm[k]
+ ) * cl;
+ }
+ }
+ for (int k30 = 0; k30 < nlwm; k30++) {
+ int i = k30 + nlwm;
+ c1->w[i][ispo - 1] = uim * c1->w[k30][ispt - 1];
+ c1->w[i][ispt - 1] = -uim * c1->w[k30][ispo - 1];
+ }
+ if (inpol != 0) {
+ for (int k40 = 0; k40 < nlwm; k40++) {
+ int i = k40 + nlwm;
+ complex<double> cc1 = sqrtwi * (c1->w[k40][ispo - 1] + uim * c1->w[k40][ispt - 1]);
+ complex<double> cc2 = sqrtwi * (c1->w[k40][ispo - 1] - uim * c1->w[k40][ispt - 1]);
+ c1->w[k40][ispo - 1] = cc2;
+ c1->w[i][ispo - 1] = -cc2;
+ c1->w[k40][ispt - 1] = cc1;
+ c1->w[i][ispt - 1] = cc1;
+ }
+ } else {
+ if (isq == 0) {
+ return;
+ }
+ }
+ if (isq != 0) {
+ for (int i50 = 0; i50 < 2; i50++) {
+ int ipt = i50 + 2;
+ int ipis = i50 + is;
+ for (int k50 = 0; k50 < nlwmt; k50++) {
+ c1->w[k50][ipt] = dconjg(c1->w[k50][ipis]);
+ }
+ }
+ }
+}
+
+void rabas(
+ int inpol, int li, int nsph, C1 *c1, double **tqse, complex<double> **tqspe,
+ double **tqss, complex<double> **tqsps
+) {
+ complex<double> cc0 = complex<double>(0.0, 0.0);
+ complex<double> uim = complex<double>(0.0, 1.0);
+ double two_pi = 4.0 * acos(0.0);
+ for (int i80 = 0; i80 < nsph; i80++) {
+ int i = i80 + 1;
+ if(c1->iog[i80] >= i) {
+ tqse[0][i80] = 0.0;
+ tqse[1][i80] = 0.0;
+ tqspe[0][i80] = cc0;
+ tqspe[1][i80] = cc0;
+ tqss[0][i80] = 0.0;
+ tqss[1][i80] = 0.0;
+ tqsps[0][i80] = cc0;
+ tqsps[1][i80] = cc0;
+ for (int l70 = 0; l70 < li; l70++) {
+ int l = l70 + 1;
+ double fl = 1.0 * (l + l + 1);
+ complex<double> rm = 1.0 / c1->rmi[l70][i80];
+ double rmm = (rm * dconjg(rm)).real();
+ complex<double> re = 1.0 / c1->rei[l70][i80];
+ double rem = (re * dconjg(re)).real();
+ if (inpol == 0) {
+ complex<double> pce = ((rm + re) * uim) * fl;
+ complex<double> pcs = ((rmm + rem) * fl) * uim;
+ tqspe[0][i80] -= pce;
+ tqspe[1][i80] += pce;
+ tqsps[0][i80] -= pcs;
+ tqsps[1][i80] += pcs;
+ } else {
+ double ce = (rm + re).real() * fl;
+ double cs = (rmm + rem) * fl;
+ tqse[0][i80] -= ce;
+ tqse[1][i80] += ce;
+ tqss[0][i80] -= cs;
+ tqss[1][i80] += cs;
+ }
+ }
+ if (inpol == 0) {
+ tqspe[0][i80] *= two_pi;
+ tqspe[1][i80] *= two_pi;
+ tqsps[0][i80] *= two_pi;
+ tqsps[1][i80] *= two_pi;
+ } else {
+ tqse[0][i80] *= two_pi;
+ tqse[1][i80] *= two_pi;
+ tqss[0][i80] *= two_pi;
+ tqss[1][i80] *= two_pi;
+ }
+ }
+ }
+}
+
+void rbf(int n, double x, int &nm, double sj[]) {
+ /*
+ * FROM SPHJ OF LIBRARY specfun
+ *
+ * ==========================================================
+ * Purpose: Compute spherical Bessel functions j
+ * Input : x --- Argument of j
+ * n --- Order of j ( n = 0,1,2,... )
+ * Output: sj(n+1) --- j
+ * nm --- Highest order computed
+ * Routines called:
+ * msta1 and msta2 for computing the starting
+ * point for backward recurrence
+ * ==========================================================
+ */
+ double a0 = x;
+ if (a0 < 0.0) a0 *= -1.0;
+ nm = n;
+ if (a0 < 1.0e-60) {
+ for (int k = 1; k <= n; k++)
+ sj[k] = 0.0;
+ sj[0] = 1.0;
+ return;
+ }
+ sj[0] = sin(x) / x;
+ if (n == 0) {
+ return;
+ }
+ sj[1] = (sj[0] - cos(x)) / x;
+ if (n == 1) {
+ return;
+ }
+ double sa = sj[0];
+ double sb = sj[1];
+ int m = msta1(a0, 200);
+ if (m < n) nm = m;
+ else m = msta2(a0, n, 15);
+ double f0 = 0.0;
+ double f1 = 1.0e-100;
+ double f;
+ for (int k = m; k >= 0; k--) {
+ f = (2.0 * k +3.0) * f1 / x - f0;
+ if (k <= nm) sj[k] = f;
+ f0 = f1;
+ f1 = f;
+ }
+ double cs;
+ double abs_sa = (sa < 0.0) ? -sa : sa;
+ double abs_sb = (sb < 0.0) ? -sb : sb;
+ if (abs_sa > abs_sb) cs = sa / f;
+ else cs = sb / f0;
+ for (int k = 0; k <= nm; k++) {
+ sj[k] = cs * sj[k];
+ }
+}
+
+void rkc(
+ int npntmo, double step, complex<double> dcc, double &x, int lpo,
+ complex<double> &y1, complex<double> &y2, complex<double> &dy1,
+ complex<double> &dy2
+) {
+ complex<double> cy1, cdy1, c11, cy23, yc2, c12, c13;
+ complex<double> cy4, yy, c14, c21, c22, c23, c24;
+ double half_step = 0.5 * step;
+ double cl = 1.0 * lpo * (lpo - 1);
+ for (int ipnt60 = 0; ipnt60 < npntmo; ipnt60++) {
+ cy1 = cl / (x * x) - dcc;
+ cdy1 = -2.0 / x;
+ c11 = (cy1 * y1 + cdy1 * dy1) * step;
+ double xh = x + half_step;
+ cy23 = cl / (xh * xh) - dcc;
+ double cdy23 = -2.0 / xh;
+ yc2 = y1 + dy1 * half_step;
+ c12 = (cy23 * yc2 + cdy23 * (dy1 + 0.5 * c11)) * step;
+ c13 = (cy23 * (yc2 + 0.25 * c11 * step) + cdy23 * (dy1 + 0.5 * c12)) * step;
+ double xn = x + step;
+ cy4 = cl / (xn * xn) - dcc;
+ double cdy4 = -2.0 / xn;
+ yy = y1 + dy1 * step;
+ c14 = (cy4 * (yy + 0.5 * c12 * step) + cdy4 * (dy1 + c13)) * step;
+ y1 = yy + (c11 + c12 + c13) * step / 6.0;
+ dy1 += (0.5 * c11 + c12 + c13 + 0.5 * c14) / 3.0;
+ c21 = (cy1 * y2 + cdy1 * dy2) * step;
+ yc2 = y2 + dy2 * half_step;
+ c22 = (cy23 * yc2 + cdy23 * (dy2 + 0.5 * c21)) * step;
+ c23 = (cy23 * (yc2 + 0.25 * c21 * step) + cdy23 * (dy2 + 0.5 * c22)) * step;
+ yy = y2 + dy2 * step;
+ c24 = (cy4 * (yc2 + 0.5 * c22 * step) + cdy4 * (dy2 + c23)) * step;
+ y2 = yy + (c21 + c22 + c23) * step / 6.0;
+ dy2 += (0.5 * c21 + c22 + c23 + 0.5 * c24) / 3.0;
+ x = xn;
+ }
+}
+
+void rkt(
+ int npntmo, double step, double &x, int lpo, complex<double> &y1,
+ complex<double> &y2, complex<double> &dy1, complex<double> &dy2,
+ C2 *c2
+) {
+ complex<double> cy1, cdy1, c11, cy23, cdy23, yc2, c12, c13;
+ complex<double> cy4, cdy4, yy, c14, c21, c22, c23, c24;
+ double half_step = 0.5 * step;
+ double cl = 1.0 * lpo * (lpo - 1);
+ for (int ipnt60 = 0; ipnt60 < npntmo; ipnt60++) {
+ int ipnt = ipnt60 + 1;
+ int jpnt = ipnt + ipnt - 1;
+ int jpnt60 = jpnt - 1;
+ cy1 = cl / (x * x) - c2->ris[jpnt60];
+ cdy1 = -2.0 / x;
+ c11 = (cy1 * y1 + cdy1 * dy1) * step;
+ double xh = x + half_step;
+ int jpntpo = jpnt + 1;
+ cy23 = cl / (xh * xh) - c2->ris[jpnt];
+ cdy23 = -2.0 / xh;
+ yc2 = y1 + dy1 * half_step;
+ c12 = (cy23 * yc2 + cdy23 * (dy1 + 0.5 * c11)) * step;
+ c13= (cy23 * (yc2 + 0.25 * c11 *step) + cdy23 * (dy1 + 0.5 * c12)) * step;
+ double xn = x + step;
+ //int jpntpt = jpnt + 2;
+ cy4 = cl / (xn * xn) - c2->ris[jpntpo];
+ cdy4 = -2.0 / xn;
+ yy = y1 + dy1 * step;
+ c14 = (cy4 * (yy + 0.5 * c12 * step) + cdy4 * (dy1 + c13)) * step;
+ y1= yy + (c11 + c12 + c13) * step / 6.0;
+ dy1 += (0.5 * c11 + c12 + c13 + 0.5 * c14) /3.0;
+ cy1 -= cdy1 * c2->dlri[jpnt60];
+ cdy1 += 2.0 * c2->dlri[jpnt60];
+ c21 = (cy1 * y2 + cdy1 * dy2) * step;
+ cy23 -= cdy23 * c2->dlri[jpnt];
+ cdy23 += 2.0 * c2->dlri[jpnt];
+ yc2 = y2 + dy2 * half_step;
+ c22 = (cy23 * yc2 + cdy23 * (dy2 + 0.5 * c21)) * step;
+ c23 = (cy23 * (yc2 + 0.25 * c21 * step) + cdy23 * (dy2 + 0.5 * c22)) * step;
+ cy4 -= cdy4 * c2->dlri[jpntpo];
+ cdy4 += 2.0 * c2->dlri[jpntpo];
+ yy = y2 + dy2 * step;
+ c24 = (cy4 * (yc2 + 0.5 * c22 * step) + cdy4 * (dy2 + c23)) * step;
+ y2 = yy + (c21 + c22 + c23) * step / 6.0;
+ dy2 += (0.5 * c21 + c22 + c23 + 0.5 * c24) / 3.0;
+ x = xn;
+ }
+}
+
+void rnf(int n, double x, int &nm, double sy[]) {
+ /*
+ * FROM SPHJY OF LIBRARY specfun
+ *
+ * ==========================================================
+ * Purpose: Compute spherical Bessel functions y
+ * Input : x --- Argument of y ( x > 0 )
+ * n --- Order of y ( n = 0,1,2,... )
+ * Output: sy(n+1) --- y
+ * nm --- Highest order computed
+ * ==========================================================
+ */
+ if (x < 1.0e-60) {
+ for (int k = 0; k <= n; k++)
+ sy[k] = -1.0e300;
+ return;
+ }
+ sy[0] = -1.0 * cos(x) / x;
+ if (n == 0) {
+ return;
+ }
+ sy[1] = (sy[0] - sin(x)) / x;
+ if (n == 1) {
+ return;
+ }
+ double f0 = sy[0];
+ double f1 = sy[1];
+ double f;
+ for (int k = 2; k <= n; k++) {
+ f = (2.0 * k - 1.0) * f1 / x - f0;
+ sy[k] = f;
+ double abs_f = f;
+ if (abs_f < 0.0) abs_f *= -1.0;
+ if (abs_f >= 1.0e300) {
+ nm = k;
+ break;
+ }
+ f0 = f1;
+ f1 = f;
+ nm = k;
+ }
+ return;
+}
+
+void sphar(
+ double cosrth, double sinrth, double cosrph, double sinrph,
+ int ll, complex<double> *ylm
+) {
+ const int rmp_size = ll;
+ const int plegn_size = (ll + 1) * ll / 2 + ll + 1;
+ double sinrmp[rmp_size], cosrmp[rmp_size], plegn[plegn_size];
+ double four_pi = 8.0 * acos(0.0);
+ double pi4irs = 1.0 / sqrt(four_pi);
+ double x = cosrth;
+ double y = sinrth;
+ if (y < 0.0) y *= -1.0;
+ double cllmo = 3.0;
+ double cll = 1.5;
+ double ytol = y;
+ plegn[0] = 1.0;
+ plegn[1] = x * sqrt(cllmo);
+ plegn[2] = ytol * sqrt(cll);
+ sinrmp[0] = sinrph;
+ cosrmp[0] = cosrph;
+ if (ll >= 2) {
+ int k = 3;
+ for (int l20 = 2; l20 <= ll; l20++) {
+ int lmo = l20 - 1;
+ int ltpo = l20 + l20 + 1;
+ int ltmo = ltpo - 2;
+ int lts = ltpo * ltmo;
+ double cn = 1.0 * lts;
+ for (int mpo10 = 1; mpo10 <= lmo; mpo10++) {
+ int m = mpo10 - 1;
+ int mpopk = mpo10 + k;
+ int ls = (l20 + m) * (l20 - m);
+ double cd = 1.0 * ls;
+ double cnm = 1.0 * ltpo * (lmo + m) * (l20 - mpo10);
+ double cdm = 1.0 * ls * (ltmo - 2);
+ plegn[mpopk - 1] = plegn[mpopk - l20 - 1] * x * sqrt(cn / cd) -
+ plegn[mpopk - ltmo - 1] * sqrt(cnm / cdm);
+ }
+ int lpk = l20 + k;
+ double cltpo = 1.0 * ltpo;
+ plegn[lpk - 1] = plegn[k - 1] * x * sqrt(cltpo);
+ k = lpk + 1;
+ double clt = 1.0 * (ltpo - 1);
+ cll *= (cltpo / clt);
+ ytol *= y;
+ plegn[k - 1] = ytol * sqrt(cll);
+ sinrmp[l20 - 1] = sinrph * cosrmp[lmo - 1] + cosrph * sinrmp[lmo - 1];
+ cosrmp[l20 - 1] = cosrph * cosrmp[lmo - 1] - sinrph * sinrmp[lmo - 1];
+ } // end l20 loop
+ }
+ // label 30
+ int l = 0;
+ int m, k, l0y, l0p, lmy, lmp;
+ double save;
+ label40:
+ m = 0;
+ k = l * (l + 1);
+ l0y = k + 1;
+ l0p = k / 2 + 1;
+ ylm[l0y - 1] = pi4irs * plegn[l0p - 1];
+ goto label45;
+ label44:
+ lmp = l0p + m;
+ save = pi4irs * plegn[lmp - 1];
+ lmy = l0y + m;
+ ylm[lmy - 1] = save * complex<double>(cosrmp[m - 1], sinrmp[m - 1]);
+ if (m % 2 != 0) ylm[lmy - 1] *= -1.0;
+ lmy = l0y - m;
+ ylm[lmy - 1] = save * complex<double>(cosrmp[m - 1], -sinrmp[m - 1]);
+ label45:
+ if (m >= l) goto label47;
+ m += 1;
+ goto label44;
+ label47:
+ if (l >= ll) return;
+ l += 1;
+ goto label40;
+}
+
+void sscr0(complex<double> &tfsas, int nsph, int lm, double vk, double exri, C1 *c1) {
+ complex<double> sum21, rm, re, csam;
+ const complex<double> cc0 = complex<double>(0.0, 0.0);
+ const double exdc = exri * exri;
+ double ccs = 4.0 * acos(0.0) / (vk * vk);
+ double cccs = ccs / exdc;
+ csam = -(ccs / (exri * vk)) * complex<double>(0.0, 0.5);
+ tfsas = cc0;
+ for (int i12 = 0; i12 < nsph; i12++) {
+ int i = i12 + 1;
+ int iogi = c1->iog[i12];
+ if (iogi >= i) {
+ double sums = 0.0;
+ complex<double> sum21 = cc0;
+ for (int l10 = 0; l10 < lm; l10++) {
+ int l = l10 + 1;
+ double fl = 1.0 + l + l;
+ rm = 1.0 / c1->rmi[l10][i12];
+ re = 1.0 / c1->rei[l10][i12];
+ complex<double> rm_cnjg = dconjg(rm);
+ complex<double> re_cnjg = dconjg(re);
+ sums += (rm_cnjg * rm + re_cnjg * re).real() * fl;
+ sum21 += (rm + re) * fl;
+ }
+ sum21 *= -1.0;
+ double scasec = cccs * sums;
+ double extsec = -cccs * sum21.real();
+ double abssec = extsec - scasec;
+ c1->sscs[i12] = scasec;
+ c1->sexs[i12] = extsec;
+ c1->sabs[i12] = abssec;
+ double gcss = c1->gcsv[i12];
+ c1->sqscs[i12] = scasec / gcss;
+ c1->sqexs[i12] = extsec / gcss;
+ c1->sqabs[i12] = abssec / gcss;
+ c1->fsas[i12] = sum21 * csam;
+ }
+ tfsas += c1->fsas[iogi - 1];
+ }
+}
+
+void sscr2(int nsph, int lm, double vk, double exri, C1 *c1) {
+ complex<double> s11, s21, s12, s22, rm, re, csam, cc;
+ const complex<double> cc0(0.0, 0.0);
+ double ccs = 1.0 / (vk * vk);
+ csam = -(ccs / (exri * vk)) * complex<double>(0.0, 0.5);
+ const double pigfsq = 64.0 * acos(0.0) * acos(0.0);
+ double cfsq = 4.0 / (pigfsq * ccs * ccs);
+ int nlmm = lm * (lm + 2);
+ for (int i14 = 0; i14 < nsph; i14++) {
+ int i = i14 + 1;
+ int iogi = c1->iog[i14];
+ if (iogi >= i) {
+ int k = 0;
+ s11 = cc0;
+ s21 = cc0;
+ s12 = cc0;
+ s22 = cc0;
+ for (int l10 = 0; l10 < lm; l10++) {
+ int l = l10 + 1;
+ rm = 1.0 / c1->rmi[l10][i14];
+ re = 1.0 / c1->rei[l10][i14];
+ int ltpo = l + l + 1;
+ for (int im10 = 0; im10 < ltpo; im10++) {
+ k += 1;
+ int ke = k + nlmm;
+ s11 = s11 - c1->w[k - 1][2] * c1->w[k - 1][0] * rm - c1->w[ke - 1][2] * c1->w[ke - 1][0] * re;
+ s21 = s21 - c1->w[k - 1][3] * c1->w[k - 1][0] * rm - c1->w[ke - 1][3] * c1->w[ke - 1][0] * re;
+ s12 = s12 - c1->w[k - 1][2] * c1->w[k - 1][1] * rm - c1->w[ke - 1][2] * c1->w[ke - 1][1] * re;
+ s22 = s22 - c1->w[k - 1][3] * c1->w[k - 1][1] * rm - c1->w[ke - 1][3] * c1->w[ke - 1][1] * re;
+ }
+ }
+ c1->sas[i14][0][0] = s11 * csam;
+ c1->sas[i14][1][0] = s21 * csam;
+ c1->sas[i14][0][1] = s12 * csam;
+ c1->sas[i14][1][1] = s22 * csam;
+ }
+ } // loop i14
+ for (int i24 = 0; i24 < nsph; i24++) {
+ int i = i24 + 1;
+ int iogi = c1->iog[i24];
+ if (iogi >= i) {
+ int j = 0;
+ for (int ipo1 = 0; ipo1 < 2; ipo1++) {
+ for (int jpo1 = 0; jpo1 < 2; jpo1++) {
+ complex<double> cc = dconjg(c1->sas[i24][jpo1][ipo1]);
+ for (int ipo2 = 0; ipo2 < 2; ipo2++) {
+ for (int jpo2 = 0; jpo2 < 2; jpo2++) {
+ c1->vints[i24][j++] = c1->sas[i24][jpo2][ipo2] * cc * cfsq;
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+void thdps(int lm, double ****zpv) {
+ for (int l15 = 0; l15 < lm; l15++) {
+ int l = l15 + 1;
+ double xd = 1.0 * l * (l + 1);
+ double zp = -1.0 / sqrt(xd);
+ zpv[l15][1][0][1] = zp;
+ zpv[l15][1][1][0] = zp;
+ }
+ if (lm != 1) {
+ for (int l20 = 1; l20 < lm; l20++) {
+ int l = l20 + 1;
+ double xn = 1.0 * (l - 1) * (l + 1);
+ double xd = 1.0 * l * (l + l + 1);
+ double zp = sqrt(xn / xd);
+ zpv[l20][0][0][0] = zp;
+ zpv[l20][0][1][1] = zp;
+ }
+ int lmmo = lm - 1;
+ for (int l25 = 0; l25 < lmmo; l25++) {
+ int l = l25 + 1;
+ double xn = 1.0 * l * (l + 2);
+ double xd = (l + 1) * (l + l + 1);
+ double zp = -1.0 * sqrt(xn / xd);
+ zpv[l25][2][0][0] = zp;
+ zpv[l25][2][1][1] = zp;
+ }
+ }
+}
+
+void upvmp(
+ double thd, double phd, int icspnv, double &cost, double &sint,
+ double &cosp, double &sinp, double *u, double *up, double *un
+) {
+ double half_pi = acos(0.0);
+ double rdr = half_pi / 90.0;
+ double th = thd * rdr;
+ double ph = phd * rdr;
+ cost = cos(th);
+ sint = sin(th);
+ cosp = cos(ph);
+ sinp = sin(ph);
+ u[0] = cosp * sint;
+ u[1] = sinp * sint;
+ u[2] = cost;
+ up[0] = cosp * cost;
+ up[1] = sinp * cost;
+ up[2] = -sint;
+ un[0] = -sinp;
+ un[1] = cosp;
+ un[2] = 0.0;
+ if (icspnv != 0) {
+ up[0] *= -1.0;
+ up[1] *= -1.0;
+ up[2] *= -1.0;
+ un[0] *= -1.0;
+ un[1] *= -1.0;
+ }
+}
+
+void upvsp(
+ double *u, double *upmp, double *unmp, double *us, double *upsmp, double *unsmp,
+ double *up, double *un, double *ups, double *uns, double *duk, int &isq,
+ int &ibf, double &scand, double &cfmp, double &sfmp, double &cfsp, double &sfsp
+) {
+ double rdr = acos(0.0) / 90.0;
+ double small = 1.0e-6;
+ isq = 0;
+ scand = u[0] * us[0] + u[1] * us[1] + u[2] * us[2];
+ double abs_scand = (scand >= 1.0) ? scand - 1.0 : 1.0 - scand;
+ if (abs_scand >= small) {
+ abs_scand = scand + 1.0;
+ if (abs_scand < 0.0) abs_scand *= -1.0;
+ if (abs_scand >= small) {
+ scand = acos(scand) / rdr;
+ duk[0] = u[0] - us[0];
+ duk[1] = u[1] - us[1];
+ duk[2] = u[2] - us[2];
+ ibf = 0;
+ } else { // label 15
+ scand = 180.0;
+ duk[0] = 2.0 * u[0];
+ duk[1] = 2.0 * u[1];
+ duk[2] = 2.0 * u[2];
+ ibf = 1;
+ ups[0] = -upsmp[0];
+ ups[1] = -upsmp[1];
+ ups[2] = -upsmp[2];
+ uns[0] = -unsmp[0];
+ uns[1] = -unsmp[1];
+ uns[2] = -unsmp[2];
+ }
+ } else { // label 10
+ scand = 0.0;
+ duk[0] = 0.0;
+ duk[1] = 0.0;
+ duk[2] = 0.0;
+ ibf = -1;
+ isq = -1;
+ ups[0] = upsmp[0];
+ ups[1] = upsmp[1];
+ ups[2] = upsmp[2];
+ uns[0] = unsmp[0];
+ uns[1] = unsmp[1];
+ uns[2] = unsmp[2];
+ }
+ if (ibf == -1 || ibf == 1) { // label 20
+ up[0] = upmp[0];
+ up[1] = upmp[1];
+ up[2] = upmp[2];
+ un[0] = unmp[0];
+ un[1] = unmp[1];
+ un[2] = unmp[2];
+ } else { // label 25
+ orunve(u, us, un, -1, small);
+ uns[0] = un[0];
+ uns[1] = un[1];
+ uns[2] = un[2];
+ orunve(un, u, up, 1, small);
+ orunve(uns, us, ups, 1, small);
+ }
+ // label 85
+ cfmp = upmp[0] * up[0] + upmp[1] * up[1] + upmp[2] * up[2];
+ sfmp = unmp[0] * up[0] + unmp[1] * up[1] + unmp[2] * up[2];
+ cfsp = ups[0] * upsmp[0] + ups[1] * upsmp[1] + ups[2] * upsmp[2];
+ sfsp = uns[0] * upsmp[0] + uns[1] * upsmp[1] + uns[2] * upsmp[2];
+}
+
+void wmamp(
+ int iis, double cost, double sint, double cosp, double sinp, int inpol,
+ int lm, int idot, int nsph, double *arg, double *u, double *up,
+ double *un, C1 *c1
+) {
+ const int ylm_size = (lm + 1) * (lm + 1) + 1;
+ complex<double> *ylm = new complex<double>[ylm_size];
+ const int nlmp = lm * (lm + 2) + 2;
+ ylm[nlmp - 1] = complex<double>(0.0, 0.0);
+ if (idot != 0) {
+ if (idot != 1) {
+ for (int n40 = 0; n40 < nsph; n40++) {
+ arg[n40] = u[0] * c1->rxx[n40] + u[1] * c1->ryy[n40] + u[2] * c1->rzz[n40];
+ }
+ } else {
+ for (int n50 = 0; n50 < nsph; n50++) {
+ arg[n50] = c1->rzz[n50];
+ }
+ }
+ if (iis == 2) {
+ for (int n60 = 0; n60 < nsph; n60++) arg[n60] *= -1;
+ }
+ }
+ sphar(cost, sint, cosp, sinp, lm, ylm);
+ pwma(up, un, ylm, inpol, lm, iis, c1);
+ delete[] ylm;
+}
+
+void wmasp(
+ double cost, double sint, double cosp, double sinp, double costs, double sints,
+ double cosps, double sinps, double *u, double *up, double *un, double *us,
+ double *ups, double *uns, int isq, int ibf, int inpol, int lm, int idot,
+ int nsph, double *argi, double *args, C1 *c1
+) {
+ const int ylm_size = (lm + 1) * (lm + 1) + 1;
+ complex<double> *ylm = new complex<double>[ylm_size];
+ const int nlmp = lm * (lm + 2) + 2;
+ ylm[nlmp - 1] = complex<double>(0.0, 0.0);
+ if (idot != 0) {
+ if (idot != 1) {
+ for (int n40 = 0; n40 < nsph; n40++) {
+ argi[n40] = u[0] * c1->rxx[n40] + u[1] * c1->ryy[n40] + u[2] * c1->rzz[n40];
+ if (ibf != 0) {
+ args[n40] = argi[n40] * ibf;
+ } else {
+ args[n40] = -1.0 * (us[0] * c1->rxx[n40] + us[1] * c1->ryy[n40] + us[2] * c1->rzz[n40]);
+ }
+ }
+ } else { // label 50
+ for (int n60 = 0; n60 < nsph; n60++) {
+ argi[n60] = cost * c1->rzz[n60];
+ if (ibf != 0) {
+ args[n60] = argi[n60] * ibf;
+ } else {
+ args[n60] = -costs * c1->rzz[n60];
+ }
+ }
+ }
+ }
+ sphar(cost, sint, cosp, sinp, lm, ylm);
+ pwma(up, un, ylm, inpol, lm, isq, c1);
+ if (ibf >= 0) {
+ sphar(costs, sints, cosps, sinps, lm, ylm);
+ pwma(ups, uns, ylm, inpol, lm, 2, c1);
+ }
+ delete[] ylm;
+}
diff --git a/src/libnptm/tra_subs.cpp b/src/libnptm/tra_subs.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..e9122e7dbd277bf18f3a876b1c833a648855a11e
--- /dev/null
+++ b/src/libnptm/tra_subs.cpp
@@ -0,0 +1,517 @@
+/*! \file tra_subs.cpp
+ *
+ * \brief C++ implementation of TRAPPING subroutines.
+ */
+#include <cmath>
+#include <complex>
+#include <fstream>
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
+#ifndef INCLUDE_SPH_SUBS_H_
+#include "../include/sph_subs.h"
+#endif
+
+#ifndef INCLUDE_TRA_SUBS_H_
+#include "../include/tra_subs.h"
+#endif
+
+using namespace std;
+
+void camp(
+ complex<double> *ac, complex<double> **am0m, complex<double> *ws,
+ CIL *cil
+) {
+ for (int j = 0; j < cil->nlemt; j++) {
+ for (int i = 0; i < cil->nlemt; i++) {
+ ac[j] += (am0m[j][i] * ws[i]);
+ } // i loop
+ } // j loop
+}
+
+void czamp(
+ complex<double> *ac, complex<double> **amd, int **indam,
+ complex<double> *ws, CIL *cil
+) {
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> summ, sume;
+ for (int im20 = 1; im20 <= cil->mxim; im20++) {
+ int m = im20 - cil->mxmpo;
+ int abs_m = (m < 0) ? -m : m;
+ int lmn = (abs_m > 1) ? abs_m : 1;
+ for (int l20 = lmn; l20 <= cil->le; l20++) {
+ int i = m + l20 * (l20 + 1);
+ int ie = i + cil->nlem;
+ summ = cc0;
+ sume = cc0;
+ for (int ls15 = lmn; ls15 <= cil->le; ls15++) {
+ int is = m + ls15 * (ls15 + 15) - 1;
+ int ise = is + cil->nlem;
+ int num = indam[l20 - 1][ls15 - 1] + m - 1;
+ summ += (amd[num][0] * ws[is] + amd[num][1] * ws[ise]);
+ sume += (amd[num][2] * ws[is] + amd[num][3] * ws[ise]);
+ } // ls15 loop
+ ac[i - 1] = summ;
+ ac[ie - 1] = sume;
+ } // l20 loop
+ } // im20 loop
+}
+
+void ffrf(
+ double ****zpv, complex<double> *ac, complex<double> *ws, double *fffe,
+ double *fffs, CIL *cil, CCR *ccr
+) {
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> uimmp, summ, sume, suem, suee;
+ complex<double> *gap = new complex<double>[3]();
+
+ for (int imu50 = 1; imu50 <= 3; imu50++) {
+ int mu = imu50 - 2;
+ gap[imu50 - 1] = cc0;
+ for (int l40 = 1; l40 <= cil->le; l40++) {
+ int lpo = l40 + 1;
+ int ltpo = lpo + l40;
+ int imm = l40 * lpo;
+ for (int ilmp40 = 1; ilmp40 <= 3; ilmp40++) {
+ if ((l40 == 1 && ilmp40 == 1) || (l40 == cil->le && ilmp40 == 3)) continue; // ilmp40 loop
+ int lmpml = ilmp40 - 2;
+ int lmp = l40 + lmpml;
+ uimmp = uim * (-1.0 * lmpml);
+ int impmmmp = lmp * (lmp + 1);
+ for (int im30 = 1; im30 <= ltpo; im30++) {
+ int m = im30 - lpo;
+ int mmp = m - mu;
+ int abs_mmp = (mmp < 0) ? -mmp : mmp;
+ if (abs_mmp <= lmp) {
+ int i = imm + m;
+ int ie = i + cil->nlem;
+ int imp = impmmmp + mmp;
+ int impe = imp + cil->nlem;
+ double cgc = cg1(lmpml, mu, l40, m);
+ summ = dconjg(ws[i - 1]) * ac[imp - 1];
+ sume = dconjg(ws[i - 1]) * ac[impe - 1];
+ suem = dconjg(ws[ie - 1]) * ac[imp - 1];
+ suee = dconjg(ws[ie - 1]) * ac[impe - 1];
+ if (lmpml != 0) {
+ summ *= uimmp;
+ sume *= uimmp;
+ suem *= uimmp;
+ suee *= uimmp;
+ }
+ // label 25
+ gap[imu50 - 1] += (cgc * (
+ summ * zpv[l40 - 1][ilmp40 - 1][0][0] +
+ sume * zpv[l40 - 1][ilmp40 - 1][0][1] +
+ suem * zpv[l40 - 1][ilmp40 - 1][1][0] +
+ suee * zpv[l40 - 1][ilmp40 - 1][1][1]
+ )
+ );
+ }
+ } // im30 loop
+ } // ilmp40
+ } // l40 loop
+ } // imu50 loop
+ sume = -gap[0] * ccr->cimu;
+ suee = -gap[1] * ccr->cof;
+ suem = -gap[2] * ccr->cimu;
+ fffe[0] = (sume - suem).real();
+ fffe[1] = ((sume + suem) * uim).real();
+ fffe[2] = suee.real();
+
+ for (int imu90 = 1; imu90 <= 3; imu90++) {
+ int mu = imu90 - 2;
+ gap[imu90 - 1] = cc0;
+ for (int l80 = 1; l80 <= cil->le; l80++) {
+ int lpo = l80 + 1;
+ int ltpo = lpo + l80;
+ int imm = l80 * lpo;
+ for (int ilmp80 = 1; ilmp80 <= 3; ilmp80++) {
+ if ((l80 == 1 && ilmp80 == 1) || (l80 == cil->le && ilmp80 == 3)) continue; // ilmp80 loop
+ int lmpml = ilmp80 - 2;
+ int lmp = l80 + lmpml;
+ uimmp = uim * (-1.0 * lmpml);
+ int impmmmp = lmp * (lmp + 1);
+ for (int im70 = 1; im70 <= ltpo; im70++) {
+ int m = im70 - lpo;
+ int mmp = m - mu;
+ int abs_mmp = (mmp < 0) ? -mmp : mmp;
+ if (abs_mmp <= lmp) {
+ int i = imm + m;
+ int ie = i + cil->nlem;
+ int imp = impmmmp + mmp;
+ int impe = imp + cil->nlem;
+ double cgc = cg1(lmpml, mu, l80, m);
+ summ = dconjg(ac[i - 1]) * ac[imp - 1];
+ sume = dconjg(ac[i - 1]) * ac[impe - 1];
+ suem = dconjg(ac[ie - 1]) * ac[imp - 1];
+ suee = dconjg(ac[ie - 1]) * ac[impe - 1];
+ if (lmpml != 0) {
+ summ *= uimmp;
+ sume *= uimmp;
+ suem *= uimmp;
+ suee *= uimmp;
+ }
+ // label 65
+ gap[imu90 - 1] += (cgc * (
+ summ * zpv[l80 - 1][ilmp80 - 1][0][0] +
+ sume * zpv[l80 - 1][ilmp80 - 1][0][1] +
+ suem * zpv[l80 - 1][ilmp80 - 1][1][0] +
+ suee * zpv[l80 - 1][ilmp80 - 1][1][1]
+ )
+ );
+ }
+ } // im70 loop
+ } // ilmp80 loop
+ } // l80 loop
+ } // imu90 loop
+ sume = gap[0] * ccr->cimu;
+ suee = gap[1] * ccr->cof;
+ suem = gap[2] * ccr->cimu;
+ fffs[0] = (sume - suem).real();
+ fffs[1] = ((sume + suem) * uim).real();
+ fffs[2] = suee.real();
+ delete[] gap;
+}
+
+void ffrt(
+ complex<double> *ac, complex<double> *ws, double *ffte, double *ffts,
+ CIL *cil
+) {
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ const double sq2i = 1.0 / sqrt(2.0);
+ const complex<double> sq2iti = uim * sq2i;
+ complex<double> aca, acw;
+ complex<double> *ctqce, *ctqcs;
+
+ ctqce = new complex<double>[3]();
+ ctqcs = new complex<double>[3]();
+ for (int l60 = 1; l60 < cil->le; l60++) {
+ int lpo = l60 + 1;
+ int il = l60 * lpo;
+ int ltpo = l60 + lpo;
+ for (int im60 = 1; im60 <= ltpo; im60++) {
+ double rmu;
+ int m = im60 - lpo;
+ int i = m + il;
+ int ie = i + cil->nlem;
+ int mmmu = m + 1;
+ int mmmmu = (mmmu < 0) ? -mmmu: mmmu;
+ if (mmmmu <= l60) {
+ int immu = mmmu + il;
+ int immue = immu + cil->nlem;
+ rmu = -sqrt(1.0 * (l60 + mmmu) * (l60 - m)) * sq2i;
+ acw = dconjg(ac[i - 1]) * ws[immu - 1] + dconjg(ac[ie - 1]) * ws[immue - 1];
+ aca = dconjg(ac[i - 1]) * ac[immu - 1] + dconjg(ac[ie - 1]) * ac[immue - 1];
+ ctqce[0] += (acw * rmu);
+ ctqcs[0] += (aca * rmu);
+ }
+ // label 30
+ rmu = -1.0 * m;
+ acw = dconjg(ac[i - 1]) * ws[i - 1] + dconjg(ac[ie - 1]) * ws[ie - 1];
+ aca = dconjg(ac[i - 1]) * ac[i - 1] + dconjg(ac[ie - 1]) * ac[ie - 1];
+ ctqce[1] += (acw * rmu);
+ ctqcs[1] += (aca * rmu);
+ mmmu = m - 1;
+ mmmmu = (mmmu < 0) ? -mmmu: mmmu;
+ if (mmmmu <= l60) {
+ int immu = mmmu + il;
+ int immue = immu + cil->nlem;
+ rmu = sqrt(1.0 * (l60 - mmmu) * (l60 + m)) * sq2i;
+ acw = dconjg(ac[i - 1]) * ws[immu - 1] + dconjg(ac[ie - 1]) * ws[immue - 1];
+ aca = dconjg(ac[i - 1]) * ac[immu - 1] + dconjg(ac[ie - 1]) * ac[immue - 1];
+ ctqce[2] += (acw * rmu);
+ ctqcs[2] += (aca * rmu);
+ }
+ } // im60 loop
+ } // l60 loop
+ ffte[0] = (ctqce[0] - ctqce[2]).real() * sq2i;
+ ffte[1] = (sq2iti * (ctqce[0] + ctqce[2])).real();
+ ffte[2] = ctqce[1].real();
+ ffts[0] = -sq2i * (ctqcs[0] - ctqcs[2]).real();
+ ffts[1] = -1.0 * (sq2iti * (ctqcs[0] + ctqcs[2])).real();
+ ffts[2] = -1.0 * ctqcs[1].real();
+
+ delete[] ctqce;
+ delete[] ctqcs;
+}
+
+void frfmer(
+ int nkv, double vkm, double *vkv, double vknmx, double apfafa, double tra,
+ double spd, double rir, double ftcn, int le, int lmode, double pmf,
+ std::fstream &tt1, std::fstream &tt2
+) {
+ const int nlemt = le * (le + 2) * 2;
+ const complex<double> cc0(0.0, 0.0);
+ complex<double> *wk = new complex<double>[nlemt]();
+ double sq = vkm * vkm;
+ for (int jy90 = 0; jy90 < nkv; jy90++) {
+ double vky = vkv[jy90];
+ double sqy = vky * vky;
+ for (int jx80 = 0; jx80 < nkv; jx80++) {
+ double vkx = vkv[jx80];
+ double sqx = vkx * vkx;
+ double sqn = sqx + sqy;
+ double vkn = sqrt(sqn);
+ if (vkn <= vknmx) {
+ double vkz = sqrt(sq - sqn);
+ wamff(wk, vkx, vky, vkz, le, apfafa, tra, spd, rir, ftcn, lmode, pmf);
+ for (int j = 0; j < nlemt; j++) {
+ double vreal = wk[j].real();
+ double vimag = wk[j].imag();
+ tt1.write(reinterpret_cast<char *>(&vreal), sizeof(double));
+ tt1.write(reinterpret_cast<char *>(&vimag), sizeof(double));
+ }
+ tt2.write(reinterpret_cast<char *>(&vkz), sizeof(double));
+ } else { // label 50
+ for (int j = 0; j < nlemt; j++) {
+ double vreal = 0.0;
+ double vimag = 0.0;
+ tt1.write(reinterpret_cast<char *>(&vreal), sizeof(double));
+ tt1.write(reinterpret_cast<char *>(&vimag), sizeof(double));
+ }
+ double vkz = 0.0;
+ tt2.write(reinterpret_cast<char *>(&vkz), sizeof(double));
+ }
+ } // jx80 loop
+ } // jy90 loop
+ delete[] wk;
+}
+
+void pwmalp(complex<double> **w, double *up, double *un, complex<double> *ylm, int lw) {
+ complex<double> cp1, cm1, cp2, cm2, cl;
+ const complex<double> uim(0.0, 1.0);
+ const double four_pi = acos(0.0) * 8.0;
+ const int nlwm = lw * (lw + 2);
+ cm1 = 0.5 * complex<double>(up[0], up[1]);
+ cp1 = 0.5 * complex<double>(up[0], -up[1]);
+ double cz1 = up[2];
+ cm2 = 0.5 * complex<double>(un[0], un[1]);
+ cp2 = 0.5 * complex<double>(un[0], -un[1]);
+ double cz2 =un[2];
+ for (int l20 = 1; l20 <= lw; l20++) {
+ int lf = l20 + 1;
+ int lftl = lf * l20;
+ double x = 1.0 * lftl;
+ complex<double> cl = (four_pi / sqrt(x)) * std::pow(uim, 1.0 * l20);
+ int mv = l20 + lf;
+ int m = -lf;
+ for (int mf20 = 1; mf20 <= mv; mf20++) {
+ m++;
+ int k = lftl + m;
+ x = 1.0 * (lftl - m * (m + 1));
+ double cp = sqrt(x);
+ x = 1.0 * (lftl - m * (m - 1));
+ double cm = sqrt(x);
+ double cz = 1.0 * m;
+ w[k - 1][0] = dconjg(cp1 * cp * ylm[k + 1] + cm1 * cm * ylm[k - 1] + cz1 * cz * ylm[k]) * cl;
+ w[k - 1][1] = dconjg(cp2 * cp * ylm[k + 1] + cm2 * cm * ylm[k - 1] + cz2 * cz * ylm[k]) * cl;
+ } // mf20 loop
+ } // l20 loop
+ for (int k30 = 0; k30 < nlwm; k30++) {
+ int i = k30 + nlwm;
+ w[i][0] = uim * w[k30][1];
+ w[i][1] = -uim * w[k30][0];
+ } // k30 loop
+}
+
+void samp(
+ complex<double> *ac, complex<double> *tmsm, complex<double> *tmse,
+ complex<double> *ws, CIL *cil
+) {
+ int i = 0;
+ for (int l20 = 0; l20 < cil->le; l20++) {
+ int l = l20 + 1;
+ int ltpo = l + l + 1;
+ for (int im20 = 0; im20 < ltpo; im20++) {
+ int ie = i + cil->nlem;
+ ac[i] = tmsm[l20] * ws[i];
+ ac[ie] = tmse[l20] * ws[ie];
+ i++;
+ } // im20 loop
+ } // l20 loop
+}
+
+void sampoa(
+ complex<double> *ac, complex<double> **tms, complex<double> *ws,
+ CIL *cil
+) {
+ complex<double> **tm = new complex<double>*[2];
+ tm[0] = new complex<double>[2]();
+ tm[1] = new complex<double>[2]();
+ int i = 0;
+ for (int l20 = 0; l20 < cil->le; l20++) {
+ tm[0][0] = tms[l20][0];
+ tm[0][1] = tms[l20][1];
+ tm[1][1] = tms[l20][2];
+ tm[1][0] = tm[0][1];
+ int l = l20 + 1;
+ int ltpo = l + l + 1;
+ for (int im20 = 0; im20 < ltpo; im20++) {
+ int ie = i + cil->nlem;
+ ac[i] = tm[0][0] * ws[i] + tm[0][1] * ws[ie];
+ ac[ie] = tm[1][0] * ws[i] + tm[1][1] * ws[ie];
+ i++;
+ } // im20 loop
+ } // l20 loop
+ delete[] tm[1];
+ delete[] tm[0];
+ delete[] tm;
+}
+
+void wamff(
+ complex<double> *wk, double x, double y, double z, int lm, double apfafa,
+ double tra, double spd, double rir, double ftcn, int lmode, double pmf
+) {
+ const int nlmm = lm * (lm + 2);
+ const int nlmmt = 2 * nlmm;
+ const int nlmp = nlmm + 2;
+ complex<double> **w, *ylm;
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ complex<double> cfam, cf1, cf2;
+ double rho, cph, sph, cth, sth, r;
+ double ftc1, ftc2;
+ double *up = new double[3];
+ double *un = new double[3];
+ w = new complex<double>*[nlmmt];
+ for (int wi = 0; wi < nlmmt; wi++) w[wi] = new complex<double>[2]();
+ ylm = new complex<double>[nlmp]();
+ bool onx = (y == 0.0);
+ bool ony = (x == 0.0);
+ bool onz = (onx && ony);
+ if (!(onz && onx && ony)) {
+ rho = sqrt(x * x + y * y);
+ cph = x / rho;
+ sph = y / rho;
+ } else {
+ if (onz) { // label 10
+ cph = 1.0;
+ sph = 0.0;
+ } else {
+ if (onx) { // label 12
+ rho = sqrt(x * x);
+ cph = (x < 0.0)? -1.0 : 1.0;
+ sph = 0.0;
+ } else {
+ if (ony) { // label 13
+ rho = sqrt(y * y);
+ cph = 0.0;
+ sph = (y < 0.0)? -1.0: 1.0;
+ }
+ }
+ }
+ }
+ // label 15
+ if (z == 0.0) {
+ if (!onz) {
+ r = rho;
+ cth = 0.0;
+ sth = 1.0;
+ } else { // label 17
+ r = 0.0;
+ cth = 1.0;
+ sth = 0.0;
+ }
+ } else { // label 18
+ if (!onz) {
+ r = sqrt(rho * rho + z * z);
+ cth = z / r;
+ sth = rho / r;
+ } else { // label 20
+ r = sqrt(z * z);
+ cth = (z < 0.0)? -1.0: 1.0;
+ sth = 0.0;
+ }
+ }
+ if (lmode == 0 || sth != 0.0) { // label 25
+ bool skip62 = false;
+ ylm[nlmp - 1] = cc0;
+ sphar(cth, sth, cph, sph, lm, ylm);
+ up[0] = cph * cth;
+ up[1] = sph * cth;
+ up[2] = -sth;
+ un[0] = -sph;
+ un[1] = cph;
+ un[2] = 0.0;
+ // Would call PWMALP(W,UP,UN,YLM,LM)
+ pwmalp(w, up, un, ylm, lm);
+ double apfa = sth * apfafa;
+ if (spd > 0.0) {
+ double sthl = sth * rir;
+ double cthl = sqrt(1.0 - sthl * sthl);
+ double arg = spd * (z - (r / rir) * cthl);
+ cfam = (tra * std::exp(-apfa * apfa) / sqrt(cthl)) * std::exp(uim * arg);
+ if (lmode == 0) { // CHECK: Computed GO TO, not sure what happens with LMODE = 0
+ if (sth == 0.0) { // label 45
+ ftc1 = ftcn;
+ ftc2 = ftcn;
+ // goes to 48
+ }
+ } else if (lmode == 1) { // label 46
+ cfam *= ((cph + uim * sph) * sth * pmf);
+ ftc1 = 2.0 * cthl / (cthl * rir + cth);
+ ftc2 = 2.0 * cthl / (cthl + cth * rir);
+ // follows on to 48
+ } else if (lmode == 2) { // label 50
+ ftc1 = 2.0 * cthl / (cthl * rir + cth);
+ cfam *= (sth * pmf * ftc1);
+ for (int i52 = 0; i52 < nlmmt; i52++) wk[i52] = w[i52][0] * cfam;
+ // returns
+ skip62 = true;
+ } else if (lmode == 3) { // label 53
+ ftc2 = 2.0 * cthl / (cthl + cth * rir);
+ cfam *= (sth * pmf * ftc2);
+ for (int i55 = 0; i55 < nlmmt; i55++) wk[i55] = w[i55][1] * cfam;
+ // returns
+ skip62 = true;
+ }
+ if (lmode == 0 || lmode == 1) { //label 48
+ cf1 = cph * ftc1 * cfam;
+ cf2 = -sph * ftc2 * cfam;
+ // goes to 62
+ skip62 = false;
+ }
+ } else { // label 57
+ double fam = tra * std::exp(-apfa * apfa) / sqrt(cth);
+ if (lmode == 0) {
+ double f1 = cph * fam;
+ double f2 = -sph * fam;
+ for (int i58 = 0; i58 < nlmmt; i58++) wk[i58] = w[i58][0] * f1 + w[i58][1] * f2;
+ // returns
+ skip62 = true;
+ } else if (lmode == 1) { // label 60
+ cfam = (pmf * sth * fam) * (cph * uim * sph);
+ cf1 = cph * cfam;
+ cf2 = -sph * cfam;
+ // follows on to 62
+ skip62 = false;
+ } else if (lmode == 2) { // label 65
+ fam *= (pmf * sth);
+ for (int i67 = 0; i67 < nlmmt; i67++) wk[i67] = w[i67][0] * fam;
+ // returns
+ skip62 = true;
+ } else if (lmode == 3) { // label 68
+ fam *= (pmf * sth);
+ for (int i70 = 0; i70 < nlmmt; i70++) wk[i70] = w[i70][1] * fam;
+ // returns
+ skip62 = true;
+ }
+ }
+ if (!skip62) {
+ if (lmode == 0 || lmode == 1) { // label 62
+ for (int i63 = 0; i63 < nlmmt; i63++) wk[i63] = w[i63][0] * cf1 + w[i63][1] * cf2;
+ }
+ }
+ }
+ // Clean up memory
+ delete[] up;
+ delete[] un;
+ for (int wi = nlmmt - 1; wi > -1; wi--) delete[] w[wi];
+ delete[] w;
+ delete[] ylm;
+}
diff --git a/src/make.inc b/src/make.inc
new file mode 100644
index 0000000000000000000000000000000000000000..ac95b212b05534d9318db6149ea347705b09c73c
--- /dev/null
+++ b/src/make.inc
@@ -0,0 +1,42 @@
+ifndef FC
+override FC=gfortran
+endif
+
+ifndef FCFLAGS
+override FCFLAGS=-std=legacy -O3
+endif
+
+ifndef LDFLAGS
+override LDFLAGS=
+endif
+
+ifndef CXX
+override CXX=g++
+endif
+
+ifndef HDF5_INCLUDE
+override HDF5_INCLUDE=/usr/include/hdf5/serial
+endif
+
+ifndef CXXFLAGS
+override CXXFLAGS=-O3 -ggdb -pg -coverage -I$(HDF5_INCLUDE)
+endif
+
+ifndef CXXLDFLAGS
+ifndef HDF5_LIB
+override HDF5_LIB=/usr/lib/x86_64-linux-gnu/hdf5/serial
+endif
+override CXXLDFLAGS=-L/usr/lib64 -L$(HDF5_LIB) -lhdf5 $(LDFLAGS)
+endif
+
+%.o : %.f
+ $(FC) $(FCFLAGS) -c -o $(BUILDDIR)/$@ $<
+
+%.o : %.cpp
+ $(CXX) $(CXXFLAGS) -c -o $(BUILDDIR)/$@ $<
+
+$(BUILDDIR)/%.o : %.cpp
+ $(CXX) $(CXXFLAGS) -c -o $(BUILDDIR)/$@ $<
+
+$(BUILDDIR)/%.o : ../libnptm/%.cpp
+ $(CXX) $(CXXFLAGS) -c -o $(BUILDDIR)/$@ ../libnptm/$<
diff --git a/src/scripts/pycompare.py b/src/scripts/pycompare.py
index 92420746426358d0c4327991d9126512c45db670..b253da6682e141465dfa56690cf8b08ca97a5071 100755
--- a/src/scripts/pycompare.py
+++ b/src/scripts/pycompare.py
@@ -1,4 +1,4 @@
-#!/bin/python
+#!/bin/python3
## @package pycompare
# \brief Script to perform output consistency tests
@@ -15,6 +15,8 @@
# error-level inconsistencies were found, or 1 otherwise. This can be used by
# subsequent system calls to set up a testing suite checking whether the code
# is able to reproduce legacy results.
+#
+# The script execution requires python3.
import re
@@ -376,6 +378,10 @@ def print_help():
## \brief Add summary information to the HTML log file
#
+# In the case when a HTML log is requested, it is useful to obtain an overview
+# of the detected inconsistencies. This function undertakes the task of adding
+# a summary of the error, warning and noise counts on top of the log.
+#
# \param config: `dict` A dictionary containing the script configuration.
# \param errors: `int` The number of errors detected by the comparison.
# \param warnings: `int` The number of warnings detected by the comparison.
diff --git a/src/sphere/Makefile b/src/sphere/Makefile
index f70b833d290c562539f544462ca51069c53f4a6d..384a85b9ede135f920d78585c0f924495e9d13f9 100644
--- a/src/sphere/Makefile
+++ b/src/sphere/Makefile
@@ -1,36 +1,45 @@
BUILDDIR=../../build/sphere
-FC=gfortran
-FCFLAGS=-std=legacy -O3
-LFLAGS=
-CXX=g++
-CXXFLAGS=-O2 -ggdb -pg -coverage
-CXXLFLAGS=
+
+include ../make.inc
+
+#FC=gfortran
+#FCFLAGS=-std=legacy -O3
+#LFLAGS=
+#CXX=g++
+#CXXFLAGS=-O2 -ggdb -pg -coverage
+#CXXLFLAGS=-L/usr/lib64 -lhdf5_hl -lhdf5
all: edfb sph np_sphere
edfb: edfb.o
- $(FC) $(FCFLAGS) -o $(BUILDDIR)/edfb $(BUILDDIR)/edfb.o $(LFLAGS)
+ $(FC) $(FCFLAGS) -o $(BUILDDIR)/edfb $(BUILDDIR)/edfb.o $(LDFLAGS)
sph: sph.o
- $(FC) $(FCFLAGS) -o $(BUILDDIR)/sph $(BUILDDIR)/sph.o $(LFLAGS)
+ $(FC) $(FCFLAGS) -o $(BUILDDIR)/sph $(BUILDDIR)/sph.o $(LDFLAGS)
+
+np_sphere: $(BUILDDIR)/np_sphere.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/file_io.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sph_subs.o $(BUILDDIR)/sphere.o
+ $(CXX) $(CXXFLAGS) -o $(BUILDDIR)/np_sphere $(BUILDDIR)/np_sphere.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/file_io.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sph_subs.o $(BUILDDIR)/sphere.o $(CXXLDFLAGS)
-np_sphere: $(BUILDDIR)/np_sphere.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sphere.o
- $(CXX) $(CXXFLAGS) $(CXXLFLAGS) -o $(BUILDDIR)/np_sphere $(BUILDDIR)/np_sphere.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/sphere.o
+#$(BUILDDIR)/np_sphere.o:
+# $(CXX) $(CXXFLAGS) -c np_sphere.cpp -o $(BUILDDIR)/np_sphere.o
-$(BUILDDIR)/np_sphere.o:
- $(CXX) $(CXXFLAGS) -c np_sphere.cpp -o $(BUILDDIR)/np_sphere.o
+#$(BUILDDIR)/Commons.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/Commons.cpp -o $(BUILDDIR)/Commons.o
-$(BUILDDIR)/Commons.o:
- $(CXX) $(CXXFLAGS) -c ../libnptm/Commons.cpp -o $(BUILDDIR)/Commons.o
+#$(BUILDDIR)/Configuration.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/Configuration.cpp -o $(BUILDDIR)/Configuration.o
-$(BUILDDIR)/Configuration.o:
- $(CXX) $(CXXFLAGS) -c ../libnptm/Configuration.cpp -o $(BUILDDIR)/Configuration.o
+#$(BUILDDIR)/file_io.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/file_io.cpp -o $(BUILDDIR)/file_io.o
-$(BUILDDIR)/Parsers.o:
- $(CXX) $(CXXFLAGS) -c ../libnptm/Parsers.cpp -o $(BUILDDIR)/Parsers.o
+#$(BUILDDIR)/Parsers.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/Parsers.cpp -o $(BUILDDIR)/Parsers.o
-$(BUILDDIR)/sphere.o:
- $(CXX) $(CXXFLAGS) -c sphere.cpp -o $(BUILDDIR)/sphere.o
+#$(BUILDDIR)/sph_subs.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/sph_subs.cpp -o $(BUILDDIR)/sph_subs.o
+
+#$(BUILDDIR)/sphere.o:
+# $(CXX) $(CXXFLAGS) -c sphere.cpp -o $(BUILDDIR)/sphere.o
clean:
rm -f $(BUILDDIR)/*.o
@@ -38,6 +47,3 @@ clean:
wipe:
rm -f $(BUILDDIR)/edfb $(BUILDDIR)/sph $(BUILDDIR)/*.o
-%.o : %.f
- $(FC) $(FCFLAGS) -c -o $(BUILDDIR)/$@ $<
-
diff --git a/src/sphere/np_sphere.cpp b/src/sphere/np_sphere.cpp
index 9449ace4a2b93bb8ee75f7b5fb1b4e758f436508..1846b36973859d1a175d2ff7f579ed1de064b6fe 100644
--- a/src/sphere/np_sphere.cpp
+++ b/src/sphere/np_sphere.cpp
@@ -1,8 +1,9 @@
/*! \file np_sphere.cpp
*/
-
+#include <complex>
#include <cstdio>
#include <string>
+
#ifndef INCLUDE_CONFIGURATION_H_
#include "../include/Configuration.h"
#endif
diff --git a/src/sphere/sphere.cpp b/src/sphere/sphere.cpp
index 4c4892f9a79528b43ee409313805f30e97a616f7..448002d20c1dde9881768d52e5a63d3436f20688 100644
--- a/src/sphere/sphere.cpp
+++ b/src/sphere/sphere.cpp
@@ -1,10 +1,18 @@
+/*! \file sphere.cpp
+ */
#include <cstdio>
#include <fstream>
#include <string>
#include <complex>
+
#ifndef INCLUDE_CONFIGURATION_H_
#include "../include/Configuration.h"
#endif
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
#ifndef INCLUDE_SPH_SUBS_H_
#include "../include/sph_subs.h"
#endif
@@ -29,8 +37,8 @@ void sphere(string config_file, string data_file, string output_path) {
printf("FILE: %s\n", ex.what());
exit(1);
}
- sconf->write_formatted(output_path + "c_OEDFB");
- sconf->write_binary(output_path + "c_TEDF");
+ sconf->write_formatted(output_path + "/c_OEDFB");
+ sconf->write_binary(output_path + "/c_TEDF");
GeometryConfiguration *gconf = NULL;
try {
gconf = GeometryConfiguration::from_legacy(data_file);
@@ -196,7 +204,7 @@ void sphere(string config_file, string data_file, string output_path) {
double exri = sqrt(sconf->exdc);
fprintf(output, " REFR. INDEX OF EXTERNAL MEDIUM=%15.7lE\n", exri);
fstream tppoan;
- string tppoan_name = output_path + "/c_TPPOAN_sph";
+ string tppoan_name = output_path + "/c_TPPOAN";
tppoan.open(tppoan_name.c_str(), ios::binary|ios::out);
if (tppoan.is_open()) {
int imode = 10;
@@ -278,7 +286,7 @@ void sphere(string config_file, string data_file, string output_path) {
// This is the condition that writes the transition matrix to output.
int is = 1111;
fstream ttms;
- string ttms_name = output_path + "/c_TTMS_sph";
+ string ttms_name = output_path + "/c_TTMS";
ttms.open(ttms_name.c_str(), ios::binary | ios::out);
if (ttms.is_open()) {
ttms.write(reinterpret_cast<char *>(&is), sizeof(int));
diff --git a/src/trapping/Makefile b/src/trapping/Makefile
index bfad43bddcd843a6d71010b2a39c6e36d09e403d..10d5bb8b8e39f0b69326bb1ddfc378d0d076fc75 100644
--- a/src/trapping/Makefile
+++ b/src/trapping/Makefile
@@ -1,15 +1,51 @@
BUILDDIR=../../build/trapping
-FC=gfortran
-FCFLAGS=-std=legacy -O3
-LFLAGS=
-all: frfme lffft
+include ../make.inc
+
+#FC=gfortran
+#FCFLAGS=-std=legacy -O3
+#LFLAGS=
+#CXX=g++
+#CXXFLAGS=-O2 -ggdb -pg -coverage
+#CXXLFLAGS=-L/usr/lib64 -lhdf5_hl -lhdf5
+
+all: frfme lffft np_trapping
frfme: frfme.o
- $(FC) $(FCFLAGS) -o $(BUILDDIR)/frfme $(BUILDDIR)/frfme.o $(LFLAGS)
+ $(FC) $(FCFLAGS) -o $(BUILDDIR)/frfme $(BUILDDIR)/frfme.o $(LDFLAGS)
lffft: lffft.o
- $(FC) $(FCFLAGS) -o $(BUILDDIR)/lffft $(BUILDDIR)/lffft.o $(LFLAGS)
+ $(FC) $(FCFLAGS) -o $(BUILDDIR)/lffft $(BUILDDIR)/lffft.o $(LDFLAGS)
+
+np_trapping: $(BUILDDIR)/np_trapping.o $(BUILDDIR)/cfrfme.o $(BUILDDIR)/clffft.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/file_io.o $(BUILDDIR)/sph_subs.o $(BUILDDIR)/tra_subs.o
+ $(CXX) $(CXXFLAGS) -o $(BUILDDIR)/np_trapping $(BUILDDIR)/np_trapping.o $(BUILDDIR)/cfrfme.o $(BUILDDIR)/clffft.o $(BUILDDIR)/file_io.o $(BUILDDIR)/Parsers.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configuration.o $(BUILDDIR)/sph_subs.o $(BUILDDIR)/tra_subs.o $(CXXLDFLAGS)
+
+#$(BUILDDIR)/np_trapping.o:
+# $(CXX) $(CXXFLAGS) np_trapping.cpp -c -o $(BUILDDIR)/np_trapping.o
+
+#$(BUILDDIR)/cfrfme.o:
+# $(CXX) $(CXXFLAGS) frfme.cpp -c -o $(BUILDDIR)/cfrfme.o
+
+#$(BUILDDIR)/clffft.o:
+# $(CXX) $(CXXFLAGS) lffft.cpp -c -o $(BUILDDIR)/clffft.o
+
+#$(BUILDDIR)/Commons.o:
+# $(CXX) $(CXXFLAGS) ../libnptm/Commons.cpp -c -o $(BUILDDIR)/Commons.o
+
+#$(BUILDDIR)/Configuration.o:
+# $(CXX) $(CXXFLAGS) ../libnptm/Configuration.cpp -c -o $(BUILDDIR)/Configuration.o
+
+#$(BUILDDIR)/file_io.o:
+# $(CXX) $(CXXFLAGS) -c ../libnptm/file_io.cpp -o $(BUILDDIR)/file_io.o
+
+#$(BUILDDIR)/Parsers.o:
+# $(CXX) $(CXXFLAGS) ../libnptm/Parsers.cpp -c -o $(BUILDDIR)/Parsers.o
+
+#$(BUILDDIR)/sph_subs.o:
+# $(CXX) $(CXXFLAGS) ../libnptm/sph_subs.cpp -c -o $(BUILDDIR)/sph_subs.o
+
+#$(BUILDDIR)/tra_subs.o:
+# $(CXX) $(CXXFLAGS) ../libnptm/tra_subs.cpp -c -o $(BUILDDIR)/tra_subs.o
clean:
rm -f $(BUILDDIR)/*.o
@@ -17,6 +53,3 @@ clean:
wipe:
rm -f $(BUILDDIR)/frfme $(BUILDDIR)/lffft $(BUILDDIR)/*.o
-%.o : %.f
- $(FC) $(FCFLAGS) -c -o $(BUILDDIR)/$@ $<
-
diff --git a/src/trapping/cfrfme.cpp b/src/trapping/cfrfme.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..fd7c342083a557c2718ed41c7c3b617593649f75
--- /dev/null
+++ b/src/trapping/cfrfme.cpp
@@ -0,0 +1,462 @@
+/*! \file frfme.cpp
+ */
+#include <complex>
+#include <cstdio>
+#include <fstream>
+#include <regex>
+#include <string>
+
+#ifndef INCLUDE_PARSERS_H_
+#include "../include/Parsers.h"
+#endif
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
+#ifndef INCLUDE_SPH_SUBS_H_
+#include "../include/sph_subs.h"
+#endif
+
+#ifndef INCLUDE_TRA_SUBS_H_
+#include "../include/tra_subs.h"
+#endif
+
+using namespace std;
+
+/*! \brief C++ implementation of FRFME
+ *
+ * \param data_file: `string` Name of the input data file.
+ * \param output_path: `string` Directory to write the output files in.
+ */
+void frfme(string data_file, string output_path) {
+ string tfrfme_name = output_path + "/c_TFRFME";
+ fstream tfrfme;
+ char namef[7];
+ char more;
+ double *xv = NULL, *yv = NULL, *zv = NULL;
+ double *vkv = NULL, **vkzm = NULL;
+ complex<double> *wk = NULL, **w = NULL, **wsum = NULL;
+ const complex<double> cc0(0.0, 0.0);
+ const complex<double> uim(0.0, 1.0);
+ int line_count = 0, last_read_line = 0;
+ regex re = regex("-?[0-9]+");
+ string *file_lines = load_file(data_file, &line_count);
+ smatch m;
+ string str_target = file_lines[last_read_line++];
+ regex_search(str_target, m, re);
+ int jlmf = stoi(m.str());
+ str_target = m.suffix().str();
+ regex_search(str_target, m, re);
+ int jlml = stoi(m.str());
+ int lmode = 0, lm = 0, nks = 0, nkv = 0;
+ double vk = 0.0, exri = 0.0, an = 0.0, ff = 0.0, tra = 0.0;
+ double exdc = 0.0, wp = 0.0, xip = 0.0, xi = 0.0;
+ int idfc = 0, nxi = 0;
+ double apfafa = 0.0, pmf = 0.0, spd = 0.0, rir = 0.0, ftcn = 0.0, fshmx = 0.0;
+ double vxyzmx = 0.0, delxyz = 0.0, vknmx = 0.0, delk = 0.0, delks = 0.0;
+ double frsh = 0.0, exril = 0.0;
+ int nlmmt = 0, nrvc = 0;
+ // Vector size variables
+ int wsum_size;
+ // End of vector size variables
+ if (jlmf != 1) {
+ int nxv, nyv, nzv;
+ tfrfme.open(tfrfme_name, ios::in | ios::binary);
+ if (tfrfme.is_open()) {
+ tfrfme.read(reinterpret_cast<char *>(&lmode), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&lm), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nkv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nxv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nyv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nzv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&vk), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&exri), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&an), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&ff), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&tra), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&spd), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&frsh), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&exril), sizeof(double));
+ vkv = new double[nkv]();
+ xv = new double[nxv]();
+ yv = new double[nyv]();
+ zv = new double[nzv]();
+ for (int xi = 0; xi < nxv; xi++) tfrfme.read(reinterpret_cast<char *>(&(xv[xi])), sizeof(double));
+ for (int yi = 0; yi < nxv; yi++) tfrfme.read(reinterpret_cast<char *>(&(yv[yi])), sizeof(double));
+ for (int zi = 0; zi < nxv; zi++) tfrfme.read(reinterpret_cast<char *>(&(zv[zi])), sizeof(double));
+ fstream temptape2;
+ string tempname2 = output_path + "/c_TEMPTAPE2";
+ temptape2.open(tempname2.c_str(), ios::in | ios::binary);
+ if (temptape2.is_open()) {
+ for (int jx = 0; jx < nkv; jx++) temptape2.read(reinterpret_cast<char *>(&(vkv[jx])), sizeof(double));
+ vkzm = new double*[nkv];
+ for (int vki = 0; vki < nkv; vki++) vkzm[vki] = new double[nkv]();
+ for (int jy10 = 0; jy10 < nkv; jy10++) {
+ for (int jx10 = 0; jx10 < nkv; jx10++) {
+ temptape2.read(reinterpret_cast<char *>(&(vkzm[jx10][jy10])), sizeof(double));
+ } //jx10 loop
+ } // jy10 loop
+ temptape2.read(reinterpret_cast<char *>(&apfafa), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&pmf), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&spd), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&rir), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&ftcn), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&fshmx), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&vxyzmx), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&delxyz), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&vknmx), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&delk), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&delks), sizeof(double));
+ temptape2.read(reinterpret_cast<char *>(&nlmmt), sizeof(int));
+ temptape2.read(reinterpret_cast<char *>(&nrvc), sizeof(int));
+ temptape2.close();
+ } else {
+ printf("ERROR: could not open TEMPTAPE2 file.\n");
+ }
+ for (int ixyz12 = 0; ixyz12 < nrvc; ixyz12++) {
+ for (int j12 = 0; j12 < jlmf - 1; j12++) {
+ double vreal, vimag;
+ tfrfme.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ wsum[j12][ixyz12] = complex<double>(vreal, vimag);
+ } // j12 loop
+ } // ixyz12 loop
+ tfrfme.close();
+ } else {
+ printf("ERROR: could not open TFRFME file.\n");
+ }
+ nks = nkv - 1;
+ } else { // label 16
+ int nksh, nrsh, nxsh, nysh, nzsh;
+ str_target = file_lines[last_read_line++];
+ for (int cli = 0; cli < 7; cli++) {
+ regex_search(str_target, m, re);
+ if (cli == 0) lmode = stoi(m.str());
+ else if (cli == 1) lm = stoi(m.str());
+ else if (cli == 2) nksh = stoi(m.str());
+ else if (cli == 3) nrsh = stoi(m.str());
+ else if (cli == 4) nxsh = stoi(m.str());
+ else if (cli == 5) nysh = stoi(m.str());
+ else if (cli == 6) nzsh = stoi(m.str());
+ str_target = m.suffix().str();
+ }
+ re = regex("-?[0-9]\\.[0-9]+([dDeE][-+]?[0-9]+)?");
+ regex_search(str_target, m, re);
+ double wlenfr = stod(m.str());
+ str_target = file_lines[last_read_line++];
+ for (int cli = 0; cli < 3; cli++) {
+ regex_search(str_target, m, re);
+ if (cli == 0) an = stod(m.str());
+ else if (cli == 1) ff = stod(m.str());
+ else if (cli == 2) tra = stod(m.str());
+ str_target = m.suffix().str();
+ }
+ double spdfr, exdcl;
+ str_target = file_lines[last_read_line++];
+ for (int cli = 0; cli < 3; cli++) {
+ regex_search(str_target, m, re);
+ if (cli == 0) spd = stod(m.str());
+ else if (cli == 1) spdfr = stod(m.str());
+ else if (cli == 2) exdcl = stod(m.str());
+ str_target = m.suffix().str();
+ }
+ str_target = file_lines[last_read_line++];
+ re = regex("[eEmM]");
+ if (regex_search(str_target, m, re)) {
+ more = m.str().at(0);
+ if (more == 'm' || more == 'M') {
+ more = 'M';
+ sprintf(namef, "c_TMDF");
+ }
+ else if (more == 'e' || more == 'E') {
+ more = 'E';
+ sprintf(namef, "c_TEDF");
+ }
+ str_target = m.suffix().str();
+ re = regex("[0-9]+");
+ regex_search(str_target, m, re);
+ int ixi = stoi(m.str());
+ fstream tedf;
+ string tedf_name = output_path + "/" + namef;
+ tedf.open(tedf_name.c_str(), ios::in | ios::binary);
+ if (tedf.is_open()) {
+ int iduml, idum;
+ tedf.read(reinterpret_cast<char *>(&iduml), sizeof(int));
+ for (int i = 0; i < iduml; i++) tedf.read(reinterpret_cast<char *>(&idum), sizeof(int));
+ tedf.read(reinterpret_cast<char *>(&exdc), sizeof(double));
+ tedf.read(reinterpret_cast<char *>(&wp), sizeof(double));
+ tedf.read(reinterpret_cast<char *>(&xip), sizeof(double));
+ tedf.read(reinterpret_cast<char *>(&idfc), sizeof(int));
+ tedf.read(reinterpret_cast<char *>(&nxi), sizeof(int));
+ if (idfc >= 0) {
+ if (ixi <= nxi) {
+ for (int i = 0; i < ixi; i++) tedf.read(reinterpret_cast<char *>(&xi), sizeof(double));
+ } else { // label 96
+ tedf.close();
+ // label 98
+ string output_name = output_path + "/c_OFRFME";
+ FILE *output = fopen(output_name.c_str(), "w");
+ fprintf(output, " WRONG INPUT TAPE\n");
+ fclose(output);
+ }
+ } else { // label 18
+ xi = xip;
+ }
+ // label 20
+ tedf.close();
+ double wn = wp / 3.0e8;
+ vk = xi * wn;
+ exri = sqrt(exdc);
+ frsh = 0.0;
+ exril = 0.0;
+ fshmx = 0.0;
+ apfafa = exri / (an * ff);
+ if (lmode != 0) pmf = 2.0 * apfafa;
+ if (spd > 0.0) {
+ exril = sqrt(exdcl);
+ rir = exri / exril;
+ ftcn = 2.0 / (1.0 + rir);
+ frsh = -spd * spdfr;
+ double sthmx = an / exri;
+ double sthlmx = sthmx * rir;
+ double uy = 1.0;
+ fshmx = spd * (rir * (sqrt(uy - sthmx * sthmx) / sqrt(uy - sthlmx * sthlmx)) - uy);
+ }
+ // label 22
+ nlmmt = lm * (lm + 2) * 2;
+ nks = nksh * 2;
+ nkv = nks + 1;
+ // Array initialization
+ vkv = new double[nkv]();
+ vkzm = new double*[nkv];
+ for (int vi = 0; vi < nkv; vi++) vkzm[vi] = new double[nkv];
+ // End of array initialization
+ double vkm = vk * exri;
+ vknmx = vk * an;
+ delk = vknmx / nksh;
+ delks = delk / vkm;
+ delks = delks * delks;
+ vxyzmx = acos(0.0) * 4.0 / vkm * wlenfr;
+ delxyz = vxyzmx / nrsh;
+ int nxs = nxsh * 2;
+ int nxv = nxs + 1;
+ int nxshpo = nxsh + 1;
+ xv = new double[nxv]();
+ for (int i24 = nxshpo; i24 <= nxs; i24++) {
+ xv[i24] = xv[i24 - 1] + delxyz;
+ xv[nxv - i24 - 1] = -xv[i24];
+ } // i24 loop
+ int nys = nysh * 2;
+ int nyv = nys + 1;
+ int nyshpo = nysh + 1;
+ yv = new double[nyv]();
+ for (int i25 = nyshpo; i25 <= nys; i25++) {
+ yv[i25] = yv[i25 - 1] + delxyz;
+ yv[nyv - i25 - 1] = -yv[i25];
+ } // i25 loop
+ int nzs = nzsh * 2;
+ int nzv = nzs + 1;
+ int nzshpo = nzsh + 1;
+ zv = new double[nzv]();
+ for (int i27 = nzshpo; i27 <= nzs; i27++) {
+ zv[i27] = zv[i27 - 1] + delxyz;
+ zv[nzv - i27 - 1] = -zv[i27];
+ } // i27 loop
+ int nrvc = nxv * nyv * nzv;
+ int nkshpo = nksh + 1;
+ for (int i28 = nkshpo; i28 <= nks; i28++) {
+ vkv[i28] = vkv[i28 - 1] + delk;
+ vkv[nkv - i28 - 1] = -vkv[i28];
+ } // i28 loop
+ tfrfme.open(tfrfme_name.c_str(), ios::out | ios::binary);
+ if (tfrfme.is_open()) {
+ tfrfme.write(reinterpret_cast<char *>(&lmode), sizeof(int));
+ tfrfme.write(reinterpret_cast<char *>(&lm), sizeof(int));
+ tfrfme.write(reinterpret_cast<char *>(&nkv), sizeof(int));
+ tfrfme.write(reinterpret_cast<char *>(&nxv), sizeof(int));
+ tfrfme.write(reinterpret_cast<char *>(&nyv), sizeof(int));
+ tfrfme.write(reinterpret_cast<char *>(&nxv), sizeof(int));
+ tfrfme.write(reinterpret_cast<char *>(&vk), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&exri), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&an), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&ff), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&tra), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&spd), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&frsh), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&exril), sizeof(double));
+ for (int xi = 0; xi < nxv; xi++)
+ tfrfme.write(reinterpret_cast<char *>(&(xv[xi])), sizeof(double));
+ for (int yi = 0; yi < nyv; yi++)
+ tfrfme.write(reinterpret_cast<char *>(&(yv[yi])), sizeof(double));
+ for (int zi = 0; zi < nzv; zi++)
+ tfrfme.write(reinterpret_cast<char *>(&(zv[zi])), sizeof(double));
+ fstream temptape1, temptape2;
+ string temp_name1 = output_path + "/c_TEMPTAPE1";
+ string temp_name2 = output_path + "/c_TEMPTAPE2";
+ temptape1.open(temp_name1.c_str(), ios::out | ios::binary);
+ temptape2.open(temp_name2.c_str(), ios::out | ios::binary);
+ for (int jx = 0; jx < nkv; jx++)
+ temptape2.write(reinterpret_cast<char *>(&(vkv[jx])), sizeof(double));
+ frfmer(nkv, vkm, vkv, vknmx, apfafa, tra, spd, rir, ftcn, lm, lmode, pmf, temptape1, temptape2);
+ temptape1.close();
+ temptape2.write(reinterpret_cast<char *>(&apfafa), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&pmf), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&spd), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&rir), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&ftcn), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&fshmx), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&vxyzmx), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&delxyz), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&vknmx), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&delk), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&delks), sizeof(double));
+ temptape2.write(reinterpret_cast<char *>(&nlmmt), sizeof(int));
+ temptape2.write(reinterpret_cast<char *>(&nrvc), sizeof(int));
+ temptape2.close();
+ temptape2.open("c_TEMPTAPE2", ios::in | ios::binary);
+ for (int jx = 0; jx < nkv; jx++) {
+ double value = 0.0;
+ temptape2.read(reinterpret_cast<char *>(&value), sizeof(double));
+ vkv[jx] = value;
+ }
+ for (int jy40 = 0; jy40 < nkv; jy40++) {
+ for (int jx40 = 0; jx40 < nkv; jx40++) {
+ double value = 0.0;
+ temptape2.read(reinterpret_cast<char *>(&value), sizeof(double));
+ vkzm[jx40][jy40] = value;
+ }
+ } // jy40 loop
+ temptape2.close();
+ if (wsum != NULL) {
+ for (int wsi = wsum_size - 1; wsi > -1; wsi--) delete[] wsum[wsi];
+ delete[] wsum;
+ }
+ wsum = new complex<double>*[nlmmt];
+ for (int j80 = jlmf - 1; j80 < jlml; j80++) {
+ // w matrix
+ if (w != NULL) {
+ for (int wi = nkv - 1; wi > -1; wi--) delete[] w[wi];
+ delete[] w;
+ }
+ w = new complex<double>*[nkv];
+ for (int wi = 0; wi < nkv; wi++) w[wi] = new complex<double>[nkv]();
+ if (wk != NULL) delete[] wk;
+ wk = new complex<double>[nlmmt]();
+ temptape1.open(temp_name1.c_str(), ios::in | ios::binary);
+ for (int jy50 = 0; jy50 < nkv; jy50++) {
+ for (int jx50 = 0; jx50 < nkv; jx50++) {
+ for (int i = 0; i < nlmmt; i++) {
+ double vreal, vimag;
+ temptape1.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ temptape1.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ wk[i] = complex<double>(vreal, vimag);
+ }
+ w[jx50][jy50] = wk[j80];
+ } // jx50
+ } // jy50 loop
+ temptape1.close();
+ int ixyz = 0;
+ wsum[j80] = new complex<double>[nrvc]();
+ for (int iz75 = 0; iz75 < nzv; iz75++) {
+ double z = zv[iz75] + frsh;
+ for (int iy70 = 0; iy70 < nyv; iy70++) {
+ double y = yv[iy70];
+ for (int ix65 = 0; ix65 < nxv; ix65++) {
+ double x = xv[ix65];
+ ixyz++;
+ complex<double> sumy = cc0;
+ for (int jy60 = 0; jy60 < nkv; jy60++) {
+ double vky = vkv[jy60];
+ double vkx = vkv[nkv - 1];
+ double vkzf = vkzm[0][jy60];
+ complex<double> phasf = exp(uim * (-vkx * x + vky * y +vkzf * z));
+ double vkzl = vkzm[nkv - 1][jy60];
+ complex<double> phasl = exp(uim * (vkx * x + vky * y + vkzl * z));
+ complex<double> sumx = 0.5 * (w[0][jy60] * phasf + w[nkv - 1][jy60] * phasl);
+ for (int jx55 = 2; jx55 <= nks; jx55++) {
+ vkx = vkv[jx55 - 1];
+ double vkz = vkzm[jx55 - 1][jy60];
+ complex<double> phas = exp(uim * (vkx * x + vky * y + vkz * z));
+ sumx += (w[jx55 - 1][jy60] * phas);
+ } // jx55 loop
+ if (jy60 == 0 || jy60 == nkv - 1) sumx *= 0.5;
+ sumy += sumx;
+ } // jy60 loop
+ wsum[j80][ixyz - 1] = sumy * delks;
+ } // ix65 loop
+ } // iy70 loop
+ } // iz75 loop
+ } // j80 loop
+ if (jlmf != 1) {
+ tfrfme.open(tfrfme_name, ios::in | ios::out | ios::binary);
+ tfrfme.read(reinterpret_cast<char *>(&lmode), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&lm), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nkv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nxv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nyv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&nzv), sizeof(int));
+ tfrfme.read(reinterpret_cast<char *>(&vk), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&exri), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&an), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&ff), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&tra), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&spd), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&frsh), sizeof(double));
+ tfrfme.read(reinterpret_cast<char *>(&exril), sizeof(double));
+ for (int i = 0; i < nxv; i++) tfrfme.read(reinterpret_cast<char *>(&(xv[i])), sizeof(double));
+ for (int i = 0; i < nyv; i++) tfrfme.read(reinterpret_cast<char *>(&(yv[i])), sizeof(double));
+ for (int i = 0; i < nzv; i++) tfrfme.read(reinterpret_cast<char *>(&(zv[i])), sizeof(double));
+ }
+ // label 88
+ for (int ixyz = 0; ixyz < nrvc; ixyz++) {
+ for (int j = 0; j< jlml; j++) {
+ double vreal = wsum[j][ixyz].real();
+ double vimag = wsum[j][ixyz].imag();
+ tfrfme.write(reinterpret_cast<char *>(&vreal), sizeof(double));
+ tfrfme.write(reinterpret_cast<char *>(&vimag), sizeof(double));
+ } // j loop
+ } // ixyz loop
+ tfrfme.close();
+ string output_name = output_path + "/c_OFRFME";
+ FILE *output = fopen(output_name.c_str(), "w");
+ fprintf(output, " IF JLML < NLMMT, PRESERVE TEMPTAPE1, TEMPTAPE2, AND TFRFRME,\n");
+ fprintf(output, " AND RESTART LM RUN WITH JLMF = JLML+1\n");
+ if (spd > 0.0) fprintf(output, " FSHMX =%15.7lE\n", fshmx);
+ fprintf(output, " FRSH =%15.7lE\n", frsh);
+ fclose(output);
+ } else { // Should never happen.
+ printf("ERROR: could not open TFRFME file for output.\n");
+ }
+ } else {
+ printf("ERROR: could not open TEDF file.\n");
+ }
+ } else { // label 98
+ string output_name = output_path + "/c_OFRFME";
+ FILE *output = fopen(output_name.c_str(), "w");
+ fprintf(output, " WRONG INPUT TAPE\n");
+ fclose(output);
+ }
+ }
+ // label 45
+ if (tfrfme.is_open()) tfrfme.close();
+ delete[] file_lines;
+ if (xv != NULL) delete[] xv;
+ if (yv != NULL) delete[] yv;
+ if (zv != NULL) delete[] zv;
+ if (vkv != NULL) delete[] vkv;
+ if (vkzm != NULL) {
+ for (int vki = nkv - 1; vki > -1; vki--) delete[] vkzm[vki];
+ delete[] vkzm;
+ }
+ if (w != NULL) {
+ for (int wi = nkv - 1; wi > -1; wi--) delete[] w[wi];
+ delete[] w;
+ }
+ if (wsum != NULL) {
+ for (int wsi = wsum_size - 1; wsi > -1; wsi--) delete[] wsum[wsi];
+ delete[] wsum;
+ }
+ if (wk != NULL) delete[] wk;
+ printf("Done.\n");
+}
diff --git a/src/trapping/clffft.cpp b/src/trapping/clffft.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..d841cdb67de24642bfd5ef3ea6e5a45836da9764
--- /dev/null
+++ b/src/trapping/clffft.cpp
@@ -0,0 +1,433 @@
+/*! \file lffft.cpp
+ */
+#include <complex>
+#include <cstdio>
+#include <fstream>
+#include <regex>
+#include <string>
+
+#ifndef INCLUDE_PARSERS_H_
+#include "../include/Parsers.h"
+#endif
+
+#ifndef INCLUDE_COMMONS_H_
+#include "../include/Commons.h"
+#endif
+
+#ifndef INCLUDE_SPH_SUBS_H_
+#include "../include/sph_subs.h"
+#endif
+
+#ifndef INCLUDE_TRA_SUBS_H_
+#include "../include/tra_subs.h"
+#endif
+
+using namespace std;
+
+/*! \brief C++ implementation of LFFFT
+ *
+ * \param data_file: `string` Name of the input data file.
+ * \param output_path: `string` Directory to write the output files in.
+ */
+void lffft(string data_file, string output_path) {
+ const complex<double> uim(0.0, 1.0);
+ const double sq2i = 1.0 / sqrt(2.0);
+ const complex<double> sq2iti = sq2i * uim;
+
+ fstream tlfff, tlfft;
+ double ****zpv = NULL;
+ double *xv = NULL, *yv = NULL, *zv = NULL;
+ complex<double> *ac = NULL, *ws = NULL, *wsl = NULL;
+ complex<double> **am0m = NULL;
+ complex<double> **amd = NULL;
+ int **indam = NULL;
+ complex<double> *tmsm = NULL, *tmse = NULL, **tms = NULL;
+ int jft, jss, jtw;
+ int is, le, nvam = 0;
+ double vks, exris;
+ CIL *cil = new CIL();
+ CCR *ccr = new CCR();
+
+ int num_lines = 0;
+ string *file_lines = load_file(data_file, &num_lines);
+ regex re = regex("-?[0-9]+");
+ smatch m;
+ string str_target = file_lines[0];
+ for (int mi = 0; mi < 3; mi++) {
+ regex_search(str_target, m, re);
+ if (mi == 0) jft = stoi(m.str());
+ else if (mi == 1) jss = stoi(m.str());
+ else if (mi == 2) jtw = stoi(m.str());
+ str_target = m.suffix().str();
+ } // mi loop
+ string ttms_name = output_path + "/c_TTMS";
+ fstream ttms;
+ ttms.open(ttms_name, ios::in | ios::binary);
+ if (ttms.is_open()) {
+ ttms.read(reinterpret_cast<char *>(&is), sizeof(int));
+ ttms.read(reinterpret_cast<char *>(&le), sizeof(int));
+ ttms.read(reinterpret_cast<char *>(&vks), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&exris), sizeof(double));
+ cil->le = le;
+ cil->nlem = le * (le + 2);
+ cil->nlemt = cil->nlem + cil->nlem;
+ if (is >= 2222) { // label 120
+ tms = new complex<double>*[le];
+ for (int ti = 0; ti < le; ti++) tms[ti] = new complex<double>[3]();
+ // QUESTION|WARNING: original code uses LM without defining it. Where does it come from?
+ int lm = le;
+ for (int i = 0; i < lm; i++) {
+ double vreal, vimag;
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ tms[i][0] = complex<double>(vreal, vimag);
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ tms[i][1] = complex<double>(vreal, vimag);
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ tms[i][2] = complex<double>(vreal, vimag);
+ } // i loop
+ } else if (is >= 1111) { // label 125
+ tmsm = new complex<double>[le]();
+ tmse = new complex<double>[le]();
+ for (int i = 0; i < le; i++) {
+ double vreal, vimag;
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ tmsm[i] = complex<double>(vreal, vimag);
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ tmse[i] = complex<double>(vreal, vimag);
+ } // i loop
+ } else if (is >= 0) { // label 135
+ am0m = new complex<double>*[cil->nlemt];
+ for (int ai = 0; ai < cil->nlemt; ai++) am0m[ai] = new complex<double>[cil->nlemt]();
+ for (int i = 0; i < cil->nlemt; i++) {
+ for (int j = 0; j < cil->nlemt; j++) {
+ double vreal, vimag;
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ am0m[i][j] = complex<double>(vreal, vimag);
+ } // j loop
+ } // i loop
+ } else if (is < 0) {
+ nvam = le * le + (le * (le + 1) * (le * 2 + 1)) / 3;
+ amd = new complex<double>*[nvam];
+ for (int ai = 0; ai < nvam; ai++) amd[ai] = new complex<double>[4]();
+ for (int i = 0; i < nvam; i++) {
+ for (int j = 0; j < 4; j++) {
+ double vreal, vimag;
+ ttms.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ ttms.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ amd[i][j] = complex<double>(vreal, vimag);
+ } // j loop
+ } // i loop
+ indam = new int*[le];
+ int vint;
+ for (int ii = 0; ii < le; ii++) indam[ii] = new int[le]();
+ for (int i = 0; i < le; i++) {
+ for (int j = 0; j < le; j++) {
+ ttms.read(reinterpret_cast<char *>(&vint), sizeof(int));
+ indam[i][j] = vint;
+ } // j loop
+ } // i loop
+ ttms.read(reinterpret_cast<char *>(&vint), sizeof(int));
+ cil->mxmpo = vint;
+ cil->mxim = vint * 2 - 1;
+ }
+ // label 150
+ ttms.close();
+ fstream binary_input;
+ string binary_name;
+ if (jss != 1) binary_name = output_path + "/c_TFRFME";
+ else binary_name = output_path + "/c_TWS";
+ binary_input.open(binary_name, ios::in | ios::binary);
+ if (binary_input.is_open()) {
+ int lmode, lm, nkv, nxv, nyv, nzv;
+ double vk, exri, an, ff, tra;
+ double spd, frsh, exril;
+ binary_input.read(reinterpret_cast<char *>(&lmode), sizeof(int));
+ binary_input.read(reinterpret_cast<char *>(&lm), sizeof(int));
+ binary_input.read(reinterpret_cast<char *>(&nkv), sizeof(int));
+ binary_input.read(reinterpret_cast<char *>(&nxv), sizeof(int));
+ binary_input.read(reinterpret_cast<char *>(&nyv), sizeof(int));
+ binary_input.read(reinterpret_cast<char *>(&nzv), sizeof(int));
+ if (lm >= le) {
+ binary_input.read(reinterpret_cast<char *>(&vk), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&exri), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&an), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&ff), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&tra), sizeof(double));
+ if (vk == vks && exri == exris) {
+ binary_input.read(reinterpret_cast<char *>(&spd), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&frsh), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&exril), sizeof(double));
+ xv = new double[nxv];
+ for (int i = 0; i < nxv; i++) binary_input.read(reinterpret_cast<char *>(&(xv[i])), sizeof(double));
+ yv = new double[nyv];
+ for (int i = 0; i < nyv; i++) binary_input.read(reinterpret_cast<char *>(&(yv[i])), sizeof(double));
+ zv = new double[nzv];
+ for (int i = 0; i < nzv; i++) binary_input.read(reinterpret_cast<char *>(&(zv[i])), sizeof(double));
+ bool goto160 = false;
+ if (jft <= 0) {
+ zpv = new double***[le];
+ for (int zi = 0; zi < le; 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]();
+ } // zj loop
+ } // zi loop
+ thdps(le, zpv);
+ double exdc = exri * exri;
+ double sqk = vk * vk * exdc;
+ ccr->cof = 1.0 / sqk;
+ ccr->cimu = ccr->cof / sqrt(2.0);
+ if (jss != 1) {
+ string tlfff_name = output_path + "/c_TLFFF";
+ tlfff.open(tlfff_name.c_str(), ios::out | ios::binary);
+ if (tlfff.is_open()) {
+ tlfff.write(reinterpret_cast<char *>(&lmode), sizeof(int));
+ tlfff.write(reinterpret_cast<char *>(&le), sizeof(int));
+ tlfff.write(reinterpret_cast<char *>(&nkv), sizeof(int));
+ tlfff.write(reinterpret_cast<char *>(&nxv), sizeof(int));
+ tlfff.write(reinterpret_cast<char *>(&nyv), sizeof(int));
+ tlfff.write(reinterpret_cast<char *>(&nzv), sizeof(int));
+ tlfff.write(reinterpret_cast<char *>(&vk), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&exri), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&an), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&ff), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&tra), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&spd), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&frsh), sizeof(double));
+ tlfff.write(reinterpret_cast<char *>(&exril), sizeof(double));
+ for (int i = 0; i < nxv; i++)
+ tlfff.write(reinterpret_cast<char *>(&(xv[i])), sizeof(double));
+ for (int i = 0; i < nyv; i++)
+ tlfff.write(reinterpret_cast<char *>(&(yv[i])), sizeof(double));
+ for (int i = 0; i < nzv; i++)
+ tlfff.write(reinterpret_cast<char *>(&(zv[i])), sizeof(double));
+ if (jft < 0) goto160 = true;
+ } else { // Should never happen.
+ printf("ERROR: could not open TLFFF file.\n");
+ }
+ }
+ }
+ // label 155
+ if (!goto160) {
+ if (jss != 1) {
+ // Would open the ITT file.
+ string tlfft_name = output_path + "/c_TLFFT";
+ tlfft.open(tlfft_name.c_str(), ios::out | ios::binary);
+ if (tlfft.is_open()) {
+ tlfft.write(reinterpret_cast<char *>(&lmode), sizeof(int));
+ tlfft.write(reinterpret_cast<char *>(&le), sizeof(int));
+ tlfft.write(reinterpret_cast<char *>(&nkv), sizeof(int));
+ tlfft.write(reinterpret_cast<char *>(&nxv), sizeof(int));
+ tlfft.write(reinterpret_cast<char *>(&nyv), sizeof(int));
+ tlfft.write(reinterpret_cast<char *>(&nzv), sizeof(int));
+ tlfft.write(reinterpret_cast<char *>(&vk), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&exri), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&an), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&ff), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&tra), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&spd), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&frsh), sizeof(double));
+ tlfft.write(reinterpret_cast<char *>(&exril), sizeof(double));
+ for (int i = 0; i < nxv; i++)
+ tlfft.write(reinterpret_cast<char *>(&(xv[i])), sizeof(double));
+ for (int i = 0; i < nyv; i++)
+ tlfft.write(reinterpret_cast<char *>(&(yv[i])), sizeof(double));
+ for (int i = 0; i < nzv; i++)
+ tlfft.write(reinterpret_cast<char *>(&(zv[i])), sizeof(double));
+ } else { // Should never happen.
+ printf("ERROR: could not open TLFFT file.\n");
+ }
+ }
+ }
+ // label 160
+ const int nlmm = lm * (lm + 2);
+ const int nlmmt = nlmm + nlmm;
+ ws = new complex<double>[nlmmt]();
+ if (lm > le) wsl = new complex<double>[nlmmt]();
+ // FORTRAN writes two output formatted files without opening them
+ // explicitly. It is assumed thay can be opened here.
+ string out66_name = output_path + "/c_out66.txt";
+ string out67_name = output_path + "/c_out67.txt";
+ FILE *output66 = fopen(out66_name.c_str(), "w");
+ FILE *output67 = fopen(out67_name.c_str(), "w");
+ for (int iz475 = 0; iz475 < nzv; iz475++) {
+ for (int iy475 = 0; iy475 < nyv; iy475++) {
+ for (int ix475 = 0; ix475 < nxv; ix475++) {
+ for (int i = 0; i < nlmmt; i++) {
+ double vreal, vimag;
+ binary_input.read(reinterpret_cast<char *>(&vreal), sizeof(double));
+ binary_input.read(reinterpret_cast<char *>(&vimag), sizeof(double));
+ if (lm <= le) {
+ ws[i] = complex<double>(vreal, vimag);
+ } else { // label 170
+ wsl[i] = complex<double>(vreal, vimag);
+ for (int i175 = 0; i175 < cil->nlem; i175++) {
+ int ie = i175 + cil->nlem;
+ int iel = i175 + nlmm;
+ ws[i175] = wsl[i175];
+ ws[ie] = wsl[iel];
+ } // i175 loop
+ }
+ // label 180
+ if (is != 2222) {
+ if (is != 1111) {
+ if (is > 0) { // Goes to 305
+ ac = new complex<double>[cil->nlemt]();
+ camp(ac, am0m, ws, cil);
+ // Goes to 445
+ } else if (is < 0) { // Goes to 405
+ ac = new complex<double>[cil->nlemt]();
+ czamp(ac, amd, indam, ws, cil);
+ // Goes to 445
+ }
+ } else {
+ ac = new complex<double>[cil->nlemt]();
+ samp(ac, tmsm, tmse, ws, cil);
+ // Goes to 445
+ }
+ } else {
+ ac = new complex<double>[cil->nlemt]();
+ sampoa(ac, tms, ws, cil);
+ // Goes to 445
+ }
+ bool goto475 = false;
+ // label 445
+ if (jft <= 0) {
+ double *fffe = new double[3]();
+ double *fffs = new double[3]();
+ ffrf(zpv, ac, ws, fffe, fffs, cil, ccr);
+ if (jss == 1) {
+ // Writes to 66
+ fprintf(
+ output66, " %18.16lE%18.16lE%18.16lE\n",
+ fffe[0], fffs[0], fffe[0] - fffs[0]
+ );
+ fprintf(
+ output66, " %18.16lE%18.16lE%18.16lE\n",
+ fffe[1], fffs[1], fffe[1] - fffs[1]
+ );
+ fprintf(
+ output66, " %18.16lE%18.16lE%18.16lE\n",
+ fffe[2], fffs[2], fffe[2] - fffs[2]
+ );
+ } else { // label 450
+ for (int i = 0; i < 3; i++) {
+ double value = fffe[i] - fffs[i];
+ tlfff.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ if (jtw == 1) {
+ // Writes to 66
+ fprintf(
+ output66, " %5d%4d%4d%15.4lE%15.4lE%15.4lE\n",
+ ix475 + 1, iy475 + 1, iz475 + 1,
+ fffe[0] - fffs[0], fffe[1] - fffs[1], fffe[2] - fffs[2]
+ );
+ }
+ }
+ if (jft < 0) goto475 = true;
+ delete[] fffe;
+ delete[] fffs;
+ }
+ // label 460
+ if (!goto475) {
+ double *ffte = new double[3]();
+ double *ffts = new double[3]();
+ ffrt(ac, ws, ffte, ffts, cil);
+ if (jss == 1) {
+ // Writes to 67
+ fprintf(
+ output67, " %18.16lE%18.16lE%18.16lE\n",
+ ffte[0], ffts[0], ffte[0] - ffts[0]
+ );
+ fprintf(
+ output67, " %18.16lE%18.16lE%18.16lE\n",
+ ffte[1], ffts[1], ffte[1] - ffts[1]
+ );
+ fprintf(
+ output67, " %18.16lE%18.16lE%18.16lE\n",
+ ffte[2], ffts[2], ffte[2] - ffts[2]
+ );
+ } else { // label 470
+ for (int i = 0; i < 3; i++) {
+ double value = ffte[i] - ffts[i];
+ tlfft.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ if (jtw == 1) {
+ // Writes to 67
+ fprintf(
+ output67, " %5d%4d%4d%15.4lE%15.4lE%15.4lE\n",
+ ix475 + 1, iy475 + 1, iz475 + 1,
+ ffte[0] - ffts[0], ffte[1] - ffts[1], ffte[2] - ffts[2]
+ );
+ }
+ }
+ delete[] ffte;
+ delete[] ffts;
+ }
+ } // i loop
+ } // ix475 loop
+ } // iy475 loop
+ } // iz475 loop
+ if (jss != 1) {
+ if (jft <= 0) tlfff.close();
+ if (jft >= 0) tlfft.close();
+ }
+ fclose(output66);
+ fclose(output67);
+ }
+ }
+ binary_input.close();
+ } else {
+ printf("ERROR: could not open binary input file %s.\n", binary_name.c_str());
+ }
+ } else {
+ printf("ERROR: could not open TTMS file.\n");
+ }
+
+ // Clean up memory
+ if (ac != NULL) delete[] ac;
+ if (ws != NULL) delete[] ws;
+ if (xv != NULL) delete[] xv;
+ if (yv != NULL) delete[] yv;
+ if (zv != NULL) delete[] zv;
+ if (wsl != NULL) delete[] wsl;
+ if (tmsm != NULL) delete[] tmsm;
+ if (tmse != NULL) delete[] tmse;
+ if (tms != NULL) {
+ for (int ti = le - 1; ti > -1; ti--) delete[] tms[ti];
+ delete[] tms;
+ }
+ if (am0m != NULL) {
+ for (int ai = cil->nlemt - 1; ai > -1; ai--) delete[] am0m[ai];
+ delete[] am0m;
+ }
+ if (amd != NULL) {
+ for (int ai = nvam - 1; ai > -1; ai--) delete[] amd[ai];
+ delete[] amd;
+ }
+ if (indam != NULL) {
+ for (int ii = le - 1; ii > -1; ii--) delete[] indam[ii];
+ delete[] indam;
+ }
+ if (zpv != NULL) {
+ for (int zi = le - 1; zi > -1; zi--) {
+ for (int zj = 2; zj > -1; zj--) {
+ for (int zk = 1; zk > -1; zk--) delete[] zpv[zi][zj][zk];
+ delete[] zpv[zi][zj];
+ } // zj loop
+ delete[] zpv[zi];
+ } // zi loop
+ delete[] zpv;
+ }
+ delete cil;
+ delete ccr;
+ delete[] file_lines;
+ printf("Done.\n");
+}
diff --git a/src/trapping/lffft.f b/src/trapping/lffft.f
index 521c61e8771fdc0a800e8135bbb558ee8614753a..d89eb792dcceb9f704549050e7378ca5c5cd1619 100644
--- a/src/trapping/lffft.f
+++ b/src/trapping/lffft.f
@@ -41,8 +41,8 @@ CCC DIMENSION TMS(LE,3)
READ(IT)VKS,EXRIS
NLEM=LE*(LE+2)
NLEMT=NLEM+NLEM
- IF(IS.GT.2222)GO TO 120
- IF(IS.GT.1111)GO TO 125
+ IF(IS.GE.2222)GO TO 120
+ IF(IS.GE.1111)GO TO 125
IF(IS.GE.0)GO TO 135
IF(IS.LT.0)GO TO 145
120 CONTINUE
diff --git a/src/trapping/np_trapping.cpp b/src/trapping/np_trapping.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..cb3d9be08dbdbb8d0e374039d6fd7ba90f336b5c
--- /dev/null
+++ b/src/trapping/np_trapping.cpp
@@ -0,0 +1,29 @@
+/*! \file trapping.cpp
+ */
+#include <cstdio>
+#include <string>
+
+using namespace std;
+
+extern void frfme(string data_file, string output_path);
+extern void lffft(string data_file, string output_path);
+
+/* \brief Main program execution body.
+ *
+ * \param argc: `int`
+ * \param argv: `char **`
+ * \return result: `int`
+ */
+int main(int argc, char **argv) {
+ string frfme_data_file = "../../test_data/trapping/DFRFME";
+ string lffft_data_file = "../../test_data/trapping/DLFFFT";
+ string output_path = ".";
+ if (argc == 4) {
+ frfme_data_file = string(argv[1]);
+ lffft_data_file = string(argv[2]);
+ output_path = string(argv[3]);
+ }
+ frfme(frfme_data_file, output_path);
+ lffft(lffft_data_file, output_path);
+ return 0;
+}