diff --git a/build/README.md b/build/README.md
index 0d13383aacd592ba4d48ad5f4fe2062be0143577..52dbdc339884b1be6da0ab48a555b6901ff8e5c2 100644
--- a/build/README.md
+++ b/build/README.md
@@ -12,36 +12,48 @@ This section describes the use of the pre-existing programs, once the binaries h
### cluster
-1. cd to the `build/cluster` folder
-2. run `edfb`
+1. cd to the `build/cluster` folder.
+2. Run `edfb`:
> ./edfb
-3. run `clu`
+3. Run `clu`:
> ./clu
*NOTE:* both `edfb` and `clu` expect an input which is assumed to be in a folder named `../../test_data/cluster/` (i.e. two levels above the current execution path)
-*TODO:* set up a code variable to locate the input data (data file paths should not be hard-coded)
+4. Run `np_cluster`:
+
+ > ./np_cluster
+
+*NOTE:* The C++ version does not need to run a configuration program because all configuration operations are handled by the code at run-time.
+
+5. Check the consistency between the output files (the default output file for the FORTRAN code is named `OCLU`, while the corresponding C++ output has the default name of `c_OCLU`).
### sphere
-1. cd to the `build/sphere` folder
-2. run `edfb`
+1. cd to the `build/sphere` folder.
+2. Run `edfb`:
> ./edfb
-3. run `sph`
+3. Run `sph`:
> ./sph
*NOTE:* both `edfb` and `sph` expect an input which is assumed to be in a folder named `../../test_data/sphere/` (i.e. two levels above the current execution path)
-*TODO:* set up a code variable to locate the input data (data file paths should not be hard-coded)
+4. Run `np_sphere`:
+
+ > ./np_sphere
+
+*NOTE:* The C++ version does not need to run a configuration program because all configuration operations are handled by the code at run-time.
+
+5. Check the consistency between the output files (the default output file for the FORTRAN code is named `OSPH`, while the corresponding C++ output has the default name of `c_OSPH`).
### trapping
The execution of trapping programs requires at least one of the previous programs to have produced a complete output set.
-*TODO:* investigate which conditions allow `clu` or `sph` to write `TTMS` output files.
+*TODO:* Define a common format for binary I/O operations on the TTMS file.
diff --git a/doc/src/config.dox b/doc/src/config.dox
index ee0f8baf7b73857b28611c48a3948ac67c512b16..036f8e1baef51dd78b9d98f2cbfb0c4da0bf273d 100644
--- a/doc/src/config.dox
+++ b/doc/src/config.dox
@@ -986,7 +986,8 @@ INPUT_FILE_ENCODING =
FILE_PATTERNS = *.cpp \
*.f \
*.h \
- *.md
+ *.md \
+ *.py
# The RECURSIVE tag can be used to specify whether or not subdirectories should
# be searched for input files as well.
diff --git a/src/README.md b/src/README.md
index 83c9bcbc7082cbb0bd38dd4c20536ab6b7e5364d..34b34c1df80cde1fb14b0a4d415ebc0985bc640a 100644
--- a/src/README.md
+++ b/src/README.md
@@ -10,24 +10,28 @@ In all cases, build commands executed through `make` will output the object file
## FORTRAN code setup and execution (requires `gfortran` and GNU `make`)
-1. cd to the `src` folder
-2. run `make`
+1. cd to the `src` folder.
+2. Run `make` as:
> make
-3. cd to the `build/sphere` folder
-4. run `sph` following the instructions given in `build\README.md`
+3. cd to the `build/sphere` folder.
+4. Run `sph` following the instructions given in `build\README.md`
+5. cd to the `build/cluster` folder.
+6. Run `clu` following the instructions given in `build\README.md`
## C++ code setup and execution (requires `g++` and GNU `make`)
-1. cd to the `src` folder
-2. run `make np_sphere`
+1. Follow the FORTRAN code setup steps (this builds the C++ version too).
+2. cd to the `build/sphere` folder.
+3. Run `np_sphere`:
- > make np_sphere
+ > ./np_sphere
-3. cd to the `build/sphere` folder
-4. run `np_sphere`
+4. Check the consistency between the text files named `OSPH` and `c_OSPH`
+5. cd to the `build/cluster` folder.
+6. Run `np_cluster`:
- > ./np_sphere
+ > ./np_cluster
-5. check the consistency between the text files named `OSPH` and `c_OSPH`
+7. Check the consistency between the text files named `OCLU` and `c_OCLU`
diff --git a/src/cluster/Makefile b/src/cluster/Makefile
index f884a43e5634e1486ce9178047e45e91373caacf..694bbc0d816dea1e2d4c4039a8967f0f973bd339 100644
--- a/src/cluster/Makefile
+++ b/src/cluster/Makefile
@@ -2,8 +2,12 @@ BUILDDIR=../../build/cluster
FC=gfortran
FCFLAGS=-std=legacy -O3
LFLAGS=
+LFLAGS=
+CXX=g++
+CXXFLAGS=-O2 -ggdb -pg -coverage
+CXXLFLAGS=
-all: clu edfb
+all: clu edfb np_cluster
clu: clu.o
$(FC) $(FCFLAGS) -o $(BUILDDIR)/clu $(BUILDDIR)/clu.o $(LFLAGS)
@@ -11,6 +15,27 @@ clu: clu.o
edfb: edfb.o
$(FC) $(FCFLAGS) -o $(BUILDDIR)/edfb $(BUILDDIR)/edfb.o $(LFLAGS)
+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)/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)/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)/sphere.o:
+ $(CXX) $(CXXFLAGS) -c ../sphere/sphere.cpp -o $(BUILDDIR)/sphere.o
+
clean:
rm -f $(BUILDDIR)/*.o
diff --git a/src/cluster/clu.f b/src/cluster/clu.f
index 1aecb479acc0cbfdf4c94c9973ec70b1639f357d..9c902231789b141c6029ecf2c8cd4dbf1dc88b4d 100644
--- a/src/cluster/clu.f
+++ b/src/cluster/clu.f
@@ -58,7 +58,7 @@ CCC DIMENSION TQSE(2,NSPH),TQSPE(2,NSPH),TQSS(2,NSPH),TQSPS(2,NSPH)
CCC DIMENSION DC0M(NSPH,NSHL-NTL),XIV(NXI)
DIMENSION DC0M(6,4),XIV(200)
COMPLEX*16 DC0M
- COMPLEX*16 ARG,S0,S0M
+ COMPLEX*16 ARG,S0,S0M,CCSAM
8010 FORMAT(1H ,16I5)
8015 FORMAT(1H ,
1'READ(IR,*)NSPH,LI,LE,MXNDM,INPOL,NPNT,NPNTTS,IAVM,ISAM')
@@ -140,9 +140,9 @@ CCC DIMENSION DC0M(NSPH,NSHL-NTL),XIV(NXI)
6991 FORMAT('========== JXI =',I3,' ====================')
6992 FORMAT('********** JTH =',I3,', JPH =',I3,
1', JTHS =',I3,', JPHS =',I3,' ********************')
- IR=5
- IW=6
- IT=7
+ IR=25
+ IW=26
+ IT=27
ITIN=17
CCC
CCC OTHER COMMENTS IN FILE GLOBALCOMS
@@ -293,7 +293,13 @@ C
119 VKARG=XI*VK
SQSFI=1.0D0/(XI*XI)
WRITE(IW,6716)XI
- 120 CALL HJV(EXRI,VKARG,JER,LCALC,ARG)
+ 120 CALL HJV(EXRI,VKARG,JER,LCALC,ARG)
+C DEBUG CODE
+C IF(JXI.NE.1)GOTO 199
+C PRINT *,"DEBUG: witing VJ0"
+C CALL LOGMAT(VJ0)
+C 199 PRINT *,"DEBUG: already wrote VJ0"
+C END DEBUG
IF(JER.EQ.0)GO TO 122
WRITE(IW,6650)
GO TO 490
@@ -314,13 +320,22 @@ C
128 DC0(IC)=DC0M(I,IC)
130 IF(MOD(NSH,2).EQ.0)DC0(ICI+1)=EXDC
CALL DME(LI,I,NPNT,NPNTTS,VKARG,EXDC,EXRI,JER,LCALC,ARG)
+C DO 199 IDL=1,8
+C PRINT *,"DEBUG: RMI(",IDL,",",I,") =",RMI(IDL,I)
+C 199 PRINT *,"DEBUG: REI(",IDL,",",I,") =",REI(IDL,I)
+C PRINT *,"DEBUG: DME - jer =",JER,", lcalc =",LCALC,
+C 1", arg =",ARG
IF(JER.EQ.0)GO TO 132
WRITE(IW,6750)
GO TO 490
- 132 CONTINUE
+ 132 CONTINUE
CALL CMS(AM)
+ CALL SUMMAT(AM,CCSAM)
+ PRINT *,"DEBUG: after CMS CCSAM =",CCSAM
NDIT=2*NSPH*NLIM
CALL LUCIN(AM,MXNDM,NDIT,JER)
+ CALL SUMMAT(AM,CCSAM)
+ PRINT *,"DEBUG: after LUCIN CCSAM =",CCSAM
IF(JER.EQ.1)GO TO 495
CALL ZTM(AM)
@@ -343,6 +358,7 @@ C
158 WRITE(IW,6061)
160 CS0=0.25D0*VK*VK*VK/DACOS(C0)
CALL SCR0(VK,EXRI)
+ PRINT *,"DEBUG: after SCR0 TFSAS =",TFSAS
SQK=VK*VK*EXDC
CALL APS(ZPV,LI,NSPH,IOG,RMI,REI,SQK,GAPS)
CALL RABAS(INPOL,LI,NSPH,IOG,RMI,REI,TQSE,TQSPE,TQSS,TQSPS)
@@ -1605,6 +1621,7 @@ CCC DIMENSION SVW(LE,3,2,2),SVS(LE,3,2,2)
CCC DIMENSION ZPV(LM,3,2,2)
DIMENSION ZPV(8,3,2,2)
C0=0.0D0
+C SZPV=C0
DO 10 L=1,LM
DO 10 ILMP=1,3
ZPV(L,ILMP,1,1)=C0
@@ -1617,6 +1634,7 @@ CCC DIMENSION ZPV(LM,3,2,2)
ZP=-1.0D0/DSQRT(XD)
ZPV(L,2,1,2)=ZP
ZPV(L,2,2,1)=ZP
+C SZPV=SZPV+2.0D0*ZP
15 CONTINUE
IF(LM.EQ.1)GO TO 30
DO 20 L=2,LM
@@ -1625,6 +1643,7 @@ CCC DIMENSION ZPV(LM,3,2,2)
ZP=DSQRT(XN/XD)
ZPV(L,1,1,1)=ZP
ZPV(L,1,2,2)=ZP
+C SZPV=SZPV+2.0D0*ZP
20 CONTINUE
LMMO=LM-1
DO 25 L=1,LMMO
@@ -1633,8 +1652,10 @@ CCC DIMENSION ZPV(LM,3,2,2)
ZP=-DSQRT(XN/XD)
ZPV(L,3,1,1)=ZP
ZPV(L,3,2,2)=ZP
+C SZPV=SZPV+2.0D0*ZP
25 CONTINUE
- 30 CONTINUE
+ 30 CONTINUE
+C PRINT *,"DEBUG: szpv =",SZPV
RETURN
END
REAL*8 FUNCTION CG1(LMPML,MU,L,M)
@@ -1853,7 +1874,7 @@ CCC NSPEF=1 CALLING WITH IDOT=0, NSPEF=NSPH OTHERWISE
IMPLICIT REAL*8(A-H,O-Z)
CCC DIMENSION RCF(NSPH,NSHL),YLM(MAX0(LITPOS,LMTPOS))
DIMENSION RCF(6,8),YLM(289)
- COMPLEX*16 YLM
+ COMPLEX*16 YLM,SVYHJ
COMMON/C1/VH(255),VJ0(102),VYHJ(4335),VYJ0(1734),VJ(1),
1RMI(8,6),REI(8,6),W(160,4),AM0M(160,160),
2FSAS(6),SAS(6,2,2),VINTS(6,16),VINTT(16),
@@ -1902,7 +1923,7 @@ CCC DIMENSION RCF(NSPH,NSHL),YLM(MAX0(LITPOS,LMTPOS))
DO 28 LPO=LMNPO,LMXPO,2
I=I+1
IL=IL+1
- 28 V3J0(I)=RAC3J(IL)
+ 28 V3J0(I)=RAC3J(IL)
NSPHMO=NSPH-1
LIT=LI+LI
IVY=0
@@ -1916,6 +1937,10 @@ CCC DIMENSION RCF(NSPH,NSHL),YLM(MAX0(LITPOS,LMTPOS))
CALL SPHAR(CRTH,SRTH,CRPH,SRPH,LIT,YLM)
DO 38 IV=1,LITPOS
38 VYHJ(IV+IVY)=DCONJG(YLM(IV))
+C SVYHJ=(0.0D0,0.0D0)
+C DO 995 IDI=1,4335
+C 995 SVYHJ=SVYHJ+VYHJ(IDI)
+C PRINT *,"DEBUG: in STR svyhj =",SVYHJ
40 IVY=IVY+LITPOS
LMT=LI+LE
IVY=0
@@ -1928,7 +1953,7 @@ CCC DIMENSION RCF(NSPH,NSHL),YLM(MAX0(LITPOS,LMTPOS))
CALL SPHAR(CRTH,SRTH,CRPH,SRPH,LMT,YLM)
DO 48 IV=1,LMTPOS
48 VYJ0(IV+IVY)=DCONJG(YLM(IV))
- 50 IVY=IVY+LMTPOS
+ 50 IVY=IVY+LMTPOS
RETURN
END
SUBROUTINE HJV(EXRI,VK,JER,LCALC,ARG)
@@ -1990,7 +2015,7 @@ CCC DIMENSION RFJ(MAX0(LIT,LMT)),RFN(LITPO)
RETURN
45 DO 47 LPO=1,LMTPO
47 VJ0(LPO+IVHB)=RFJ(LPO)
- 50 IVHB=IVHB+LMTPO
+ 50 IVHB=IVHB+LMTPO
RETURN
END
SUBROUTINE PWMA(UP,UN,YLM,INPOL,LW,ISQ)
@@ -2078,7 +2103,7 @@ CCC DIMENSION YLM(NLWM+2)
U3(2)=U1(3)*U2(1)-U1(1)*U2(3)
U3(3)=U1(1)*U2(2)-U1(2)*U2(1)
RETURN
- END
+ END
SUBROUTINE CMS(AM)
IMPLICIT REAL*8(A-H,O-Z)
COMMON/C1/VH(255),VJ0(102),VYHJ(4335),VYJ0(1734),VJ(1),
@@ -2098,6 +2123,7 @@ CCC NDIT.LE.MXNDM
DIMENSION AM(960,960)
COMPLEX*16 AM
COMPLEX*16 DM,DE,CGH,CGK,GHIT,CC0
+ COMMON/C6/RAC3J(17)
CC0=(0.0D0,0.0D0)
NDI=NSPH*NLIM
NBL=0
@@ -2185,7 +2211,7 @@ CCC NDIT.LE.MXNDM
1VINTS,VINTT,FSAC,SAC,FSACM,VINT,VINTM,SCSCP,ECSCP,SCSCPM,ECSCPM
COMMON/C4/LITPO,LITPOS,LMTPO,LMTPOS,LI,NLIM,LE,NLEM,NSPH
COMMON/C9/GIS(480,80),GLS(480,80),SAM(960,160)
- COMPLEX*16 GIS,GLS,SAM
+ COMPLEX*16 GIS,GLS,SAM,DBGTST
CCC DIMENSION AM(MXNDM,MXNDM)
CCC NDIT.LE.MXNDM
DIMENSION AM(960,960)
@@ -2210,7 +2236,19 @@ CCC NDIT.LE.MXNDM
M3=M3+1
I3=I3+1
GIS(I2,I3)=GHIT(2,0,N2,L2,M2,L3,M3)
- 15 GLS(I2,I3)=GHIT(2,1,N2,L2,M2,L3,M3)
+ 15 GLS(I2,I3)=GHIT(2,1,N2,L2,M2,L3,M3)
+C DEBUG CODE
+C DBGTST=CC0
+C DO 990 DI=1,NDI
+C DO 990 DJ=1,NLEM
+C 990 DBGTST=DBGTST+GIS(DI,DJ)
+C PRINT *,"DEBUG: in ZTM init sgis =",DBGTST
+C DBGTST=CC0
+C DO 991 DI=1,NDI
+C DO 991 DJ=1,NLEM
+C 991 DBGTST=DBGTST+GLS(DI,DJ)
+C PRINT *,"DEBUG: in ZTM init sgls =",DBGTST
+C END DEBUG
DO 25 I1=1,NDI
I1E=I1+NDI
DO 25 I3=1,NLEM
@@ -2553,7 +2591,7 @@ CCC 3j(J,J2,J3;0,0,0)
80 RAC3J(IRR)=RAC3J(IRR)*CNR
CNL=CNR*RATRAC
DO 85 IRL=1,NMATMO
- 85 RAC3J(IRL)=RAC3J(IRL)*CNL
+ 85 RAC3J(IRL)=RAC3J(IRL)*CNL
RETURN
END
SUBROUTINE R3JJR(J2,J3,M2,M3)
@@ -2663,7 +2701,7 @@ CCC 3j(J,J2,J3;-M2-M3,M2,M3)
80 RAC3J(IRR)=RAC3J(IRR)*CNR
CNL=CNR*RATRAC
DO 85 IRL=1,NMATMO
- 85 RAC3J(IRL)=RAC3J(IRL)*CNL
+ 85 RAC3J(IRL)=RAC3J(IRL)*CNL
RETURN
END
SUBROUTINE R3JMR(J1,J2,J3,M1)
@@ -2888,7 +2926,7 @@ cccccccccccccccccccccc
CCNB=DREF(L)*FN(LPO)*SZ*LTPO
CCNC=REF(L)*DFB
CCND=DREF(L)*FB(LPO)*SZ*LTPO
- 90 REI(L,I)=1.0D0+UIM*(CRI*CCNA-CCNB)/(CRI*CCNC-CCND)
+ 90 REI(L,I)=1.0D0+UIM*(CRI*CCNA-CCNB)/(CRI*CCNC-CCND)
RETURN
END
SUBROUTINE RKT(NPNTMO,STEP,X,LPO,Y1,Y2,DY1,DY2)
@@ -3466,4 +3504,28 @@ CCC DIMENSION AV(NDDMST*NDDMST)
3 CDTP=CDTP+AV((J-1)*ISTEP+I)*AV(J+IR)
RETURN
END
+ SUBROUTINE SUMMAT(AM,RSLT)
+ DIMENSION AM(921600)
+ COMPLEX*16 AM,CC0,RSLT
+ CC0=(0.0D0,0.0D0)
+ RSLT=CC0
+ DO 4 I=1,921600
+ 4 RSLT=RSLT+AM(I)
+ RETURN
+ END
+ SUBROUTINE LOGMAT(AM)
+ DIMENSION AM(960,960)
+ COMPLEX*16 AM
+ IL=36
+ OPEN(IL,FILE="matrix.log",STATUS="UNKNOWN")
+ DO 5 I=1,960
+ DO 6 J=1,960
+ WRITE(IL,9901)I,J,DREAL(AM(I,J))
+ 6 WRITE(IL,9902)I,J,DIMAG(AM(I,J))
+ 5 CONTINUE
+ CLOSE(IL)
+ 9901 FORMAT("R:",1I3,",",1I3,",",1D15.7)
+ 9902 FORMAT("I:",1I3,",",1I3,",",1D15.7)
+ RETURN
+ END
CCC
diff --git a/src/cluster/cluster.cpp b/src/cluster/cluster.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..b685453d6aaf15996a52419508ee5525cfc7a115
--- /dev/null
+++ b/src/cluster/cluster.cpp
@@ -0,0 +1,972 @@
+#include <cstdio>
+#include <fstream>
+#include <string>
+#include <complex>
+#ifndef INCLUDE_CONFIGURATION_H_
+#include "../include/Configuration.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.
+ * \param data_file: `string` Name of the input data file.
+ * \param output_path: `string` Directory to write the output files in.
+ */
+void cluster(string config_file, string data_file, string output_path) {
+ printf("INFO: making legacy configuration...");
+ ScattererConfiguration *sconf = ScattererConfiguration::from_dedfb(config_file);
+ sconf->write_formatted(output_path + "/c_OEDFB_clu");
+ sconf->write_binary(output_path + "/c_TEDF_clu");
+ GeometryConfiguration *gconf = GeometryConfiguration::from_legacy(data_file);
+ printf(" done.\n");
+ if (sconf->number_of_spheres == gconf->number_of_spheres) {
+ // Shortcuts to variables stored in configuration objects
+ int nsph = gconf->number_of_spheres;
+ int mxndm = gconf->mxndm;
+ int inpol = gconf->in_pol;
+ int npnt = gconf->npnt;
+ int npntts = gconf->npntts;
+ int iavm = gconf->iavm;
+ int isam = gconf->meridional_type;
+ int nxi = sconf->number_of_scales;
+ double th = gconf->in_theta_start;
+ double thstp = gconf->in_theta_step;
+ double thlst = gconf->in_theta_end;
+ double ths = gconf->sc_theta_start;
+ double thsstp = gconf->sc_theta_step;
+ double thslst = gconf->sc_theta_end;
+ double ph = gconf->in_phi_start;
+ double phstp = gconf->in_phi_step;
+ double phlst = gconf->in_phi_end;
+ double phs = gconf->sc_phi_start;
+ double phsstp = gconf->sc_phi_step;
+ double phslst = gconf->sc_phi_end;
+ double wp = sconf->wp;
+ // Global variables for CLU
+ int lm = gconf->l_max;
+ if (gconf->li > lm) lm = gconf->li;
+ if (gconf->le > lm) lm = gconf->le;
+ C1 *c1 = new C1(nsph, lm, sconf->nshl_vec, sconf->iog_vec);
+ C3 *c3 = new C3();
+ for (int c1i = 0; c1i < nsph; c1i++) {
+ c1->rxx[c1i] = gconf->sph_x[c1i];
+ c1->ryy[c1i] = gconf->sph_y[c1i];
+ c1->rzz[c1i] = gconf->sph_z[c1i];
+ c1->ros[c1i] = sconf->radii_of_spheres[c1i];
+ }
+ C4 *c4 = new C4;
+ c4->li = gconf->li;
+ c4->le = gconf->le;
+ c4->lm = (c4->li > c4-> le) ? c4->li : c4->le;
+ c4->nv3j = (c4->lm * (c4->lm + 1) * (2 * c4->lm + 7)) / 6;
+ c4->nsph = nsph;
+ // The following is needed to initialize C1_AddOns
+ c4->litpo = c4->li + c4->li + 1;
+ c4->litpos = c4->litpo * c4->litpo;
+ c4->lmtpo = c4->li + c4->le + 1;
+ c4->lmtpos = c4->lmtpo * c4->lmtpo;
+ c4->nlim = c4->li * (c4->li + 2);
+ c4->nlem = c4->le * (c4->le + 2);
+ c4->lmpo = c4->lm + 1;
+ C1_AddOns *c1ao = new C1_AddOns(c4);
+ // End of add-ons initialization
+ C6 *c6 = new C6(c4->lmtpo);
+ FILE *output = fopen((output_path + "/c_OCLU").c_str(), "w");
+ int jer = 0, lcalc = 0;
+ complex<double> arg(0.0, 0.0), ccsam(0.0, 0.0);
+ int max_ici = 0;
+ for (int insh = 0; insh < nsph; insh++) {
+ int nsh = sconf->nshl_vec[insh];
+ int ici = (nsh + 1) / 2;
+ if (ici > max_ici) max_ici = ici;
+ }
+ 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];
+ const int ndi = c4->nsph * c4->nlim;
+ C9 *c9 = new C9(ndi, c4->nlem, 2 * ndi, 2 * c4->nlem);
+ double *gaps = new double[nsph]();
+ double *tqev = new double[3]();
+ double *tqsv = new double[3]();
+ double **tqse, **tqss, **tqce, **tqcs;
+ complex<double> **tqspe, **tqsps, **tqcpe, **tqcps;
+ tqse = new double*[2];
+ tqspe = new complex<double>*[2];
+ tqss = new double*[2];
+ tqsps = new complex<double>*[2];
+ tqce = new double*[2];
+ tqcpe = new complex<double>*[2];
+ tqcs = new double*[2];
+ tqcps = new complex<double>*[2];
+ for (int ti = 0; ti < 2; ti++) {
+ tqse[ti] = new double[nsph]();
+ tqspe[ti] = new complex<double>[nsph]();
+ tqss[ti] = new double[nsph]();
+ tqsps[ti] = new complex<double>[nsph]();
+ tqce[ti] = new double[3]();
+ tqcpe[ti] = new complex<double>[3]();
+ tqcs[ti] = new double[3]();
+ tqcps[ti] = new complex<double>[3]();
+ }
+ double *gapv = new double[3]();
+ complex<double> **gapp, **gappm;
+ double **gap, **gapm;
+ gapp = new complex<double>*[3];
+ gappm = new complex<double>*[3];
+ gap = new double*[3];
+ gapm = new double*[3];
+ for (int gi = 0; gi < 3; gi++) {
+ gapp[gi] = new complex<double>[2]();
+ gappm[gi] = new complex<double>[2]();
+ gap[gi] = new double[2]();
+ gapm[gi] = new double[2]();
+ }
+ double *u = new double[3]();
+ double *us = new double[3]();
+ double *un = new double[3]();
+ double *uns = new double[3]();
+ double *up = new double[3]();
+ double *ups = new double[3]();
+ double *unmp = new double[3]();
+ double *unsmp = new double[3]();
+ double *upmp = new double[3]();
+ double *upsmp = new double[3]();
+ double *argi = new double[1]();
+ double *args = new double[1]();
+ double *duk = new double[3]();
+ double **cextlr, **cext;
+ double **cmullr, **cmul;
+ cextlr = new double*[4];
+ cext = new double*[4];
+ cmullr = new double*[4];;
+ cmul = new double*[4];
+ for (int ci = 0; ci < 4; ci++) {
+ cextlr[ci] = new double[4]();
+ cext[ci] = new double[4]();
+ cmullr[ci] = new double[4]();
+ cmul[ci] = new double[4]();
+ }
+ int isq, ibf;
+ double scan, cfmp, sfmp, cfsp, sfsp;
+ // End of global variables for CLU
+ fprintf(output, " READ(IR,*)NSPH,LI,LE,MXNDM,INPOL,NPNT,NPNTTS,IAVM,ISAM\n");
+ fprintf(output, " %5d%5d%5d%5d%5d%5d%5d%5d%5d\n",
+ nsph, c4->li, c4->le, mxndm, inpol, npnt, npntts, iavm, isam
+ );
+ fprintf(output, " READ(IR,*)RXX(I),RYY(I),RZZ(I)\n");
+ for (int ri = 0; ri < nsph; ri++) fprintf(output, "%17.8lE%17.8lE%17.8lE\n",
+ gconf->sph_x[ri], gconf->sph_y[ri], gconf->sph_z[ri]
+ );
+ fprintf(output, " READ(IR,*)TH,THSTP,THLST,THS,THSSTP,THSLST\n");
+ fprintf(
+ output, " %10.3lE%10.3lE%10.3lE%10.3lE%10.3lE%10.3lE\n",
+ th, thstp, thlst, ths, thsstp, thslst
+ );
+ fprintf(output, " READ(IR,*)PH,PHSTP,PHLST,PHS,PHSSTP,PHSLST\n");
+ fprintf(
+ output, " %10.3lE%10.3lE%10.3lE%10.3lE%10.3lE%10.3lE\n",
+ ph, phstp, phlst, phs, phsstp, phslst
+ );
+ fprintf(output, " READ(IR,*)JWTM\n");
+ fprintf(output, " %5d\n", gconf->jwtm);
+ fprintf(output, " READ(ITIN)NSPHT\n");
+ fprintf(output, " READ(ITIN)(IOG(I),I=1,NSPH)\n");
+ fprintf(output, " READ(ITIN)EXDC,WP,XIP,IDFC,NXI\n");
+ fprintf(output, " READ(ITIN)(XIV(I),I=1,NXI)\n");
+ fprintf(output, " READ(ITIN)NSHL(I),ROS(I)\n");
+ fprintf(output, " READ(ITIN)(RCF(I,NS),NS=1,NSH)\n");
+ fprintf(output, " \n");
+ double small = 1.0e-3;
+ int nth = 0, nph = 0;
+ if (thstp != 0.0) nth = int((thlst - th) / thstp + small);
+ nth++;
+ if (phstp != 0.0) nph = int((phlst - ph) / phstp + small);
+ nph++;
+ int nths = 0, nphs = 0;
+ double thsca = 0.0;
+ if (isam > 1) {
+ nths = 1;
+ thsca = ths - th;
+ } else { // ISAM <= 1
+ if (thsstp == 0.0) nths = 0;
+ else nths = int ((thslst - ths) / thsstp + small);
+ nths++;
+ }
+ if (isam >= 1) {
+ nphs = 1;
+ } else {
+ if (phsstp == 0.0) nphs = 0;
+ else nphs = int((phslst - phs) / phsstp + small);
+ nphs++;
+ }
+ int nk = nth * nph;
+ int nks = nths * nphs;
+ int nkks = nk * nks;
+ double th1 = th, ph1 = ph, ths1 = ths, phs1 = phs;
+ str(sconf->rcf, c1, c1ao, c3, c4, c6);
+ double ****zpv = new double***[c4->lm]; //[gconf->l_max][3][2][2]; // Matrix: dim[LM x 3 x 2 x 2]
+ for (int zi = 0; zi < c4->lm; zi++) {
+ zpv[zi] = new double**[3];
+ for (int zj = 0; zj < 3; zj++) {
+ zpv[zi][zj] = new double*[2];
+ for (int zk = 0; zk < 2; zk++) {
+ zpv[zi][zj][zk] = new double[2]();
+ }
+ }
+ }
+ thdps(c4->lm, zpv);
+ double exri = sqrt(sconf->exdc);
+ double vk = 0.0; // NOTE: Not really sure it should be initialized at 0
+ fprintf(output, " REFR. INDEX OF EXTERNAL MEDIUM=%15.7lE\n", exri);
+ fstream tppoan;
+ string tppoan_name = output_path + "/c_TPPOAN";
+ tppoan.open(tppoan_name.c_str(), ios::out | ios::binary);
+ if (tppoan.is_open()) {
+ tppoan.write(reinterpret_cast<char *>(&iavm), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&isam), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&inpol), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&nxi), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&nth), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&nph), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&nths), sizeof(int));
+ tppoan.write(reinterpret_cast<char *>(&nphs), sizeof(int));
+ double wn = wp / 3.0e8;
+ double sqsfi = 1.0;
+ if (sconf->idfc < 0) {
+ vk = sconf->xip * wn;
+ fprintf(output, " VK=%15.7lE, XI IS SCALE FACTOR FOR LENGTHS\n", vk);
+ fprintf(output, " \n");
+ }
+ for (int jxi488 = 1; jxi488 <= nxi; jxi488++) {
+ printf("INFO: running scale iteration...\n");
+ int jaw = 1;
+ fprintf(output, "========== JXI =%3d ====================\n", jxi488);
+ double xi = sconf->scale_vec[jxi488 - 1];
+ double vkarg = 0.0;
+ if (sconf->idfc >= 0) {
+ vk = xi * wn;
+ vkarg = vk;
+ fprintf(output, " VK=%15.7lE, XI=%15.7lE\n", vk, xi);
+ } else {
+ vkarg = xi * vk;
+ sqsfi = 1.0 / (xi * xi);
+ fprintf(output, " XI=%15.7lE\n", xi);
+ }
+ hjv(exri, vkarg, jer, lcalc, arg, c1, c1ao, c4);
+ if (jer != 0) {
+ fprintf(output, " STOP IN HJV\n");
+ break; // jxi488 loop: goes to memory cleaning and return
+ }
+ for (int i132 = 1; i132 <= nsph; i132++) {
+ int iogi = c1->iog[i132 - 1];
+ if (iogi != i132) {
+ for (int l123 = 1; l123 <= gconf->li; l123++) {
+ c1->rmi[l123 - 1][i132 - 1] = c1->rmi[l123 - 1][iogi - 1];
+ c1->rei[l123 - 1][i132 - 1] = c1->rei[l123 - 1][iogi - 1];
+ } // l123 loop
+ } else {
+ int nsh = sconf->nshl_vec[i132 - 1];
+ int ici = (nsh + 1) / 2;
+ if (sconf->idfc == 0) {
+ for (int ic = 0; ic < ici; ic++)
+ c2->dc0[ic] = sconf->dc0_matrix[ic][i132 - 1][jxi488 - 1];
+ } else {
+ if (jxi488 == 1) {
+ for (int ic = 0; ic < ici; ic++)
+ c2->dc0[ic] = sconf->dc0_matrix[ic][i132 - 1][0];
+ }
+ }
+ if (nsh % 2 == 0) c2->dc0[ici] = sconf->exdc;
+ dme(
+ c4->li, i132, npnt, npntts, vkarg, sconf->exdc, exri,
+ c1, c2, jer, lcalc, arg
+ );
+ if (jer != 0) {
+ fprintf(output, " STOP IN DME\n");
+ break;
+ }
+ }
+ 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) {
+ if (jxi488 == gconf->jwtm) {
+ int is = 1;
+ fstream ttms_file;
+ string ttms_name = output_path + "/c_TTMS";
+ ttms_file.open(ttms_name.c_str(), ios::out | ios::binary);
+ if (ttms_file.is_open()) {
+ ttms_file.write(reinterpret_cast<char *>(&is), sizeof(int));
+ ttms_file.write(reinterpret_cast<char *>(&lm), sizeof(int));
+ ttms_file.write(reinterpret_cast<char *>(&vk), sizeof(double));
+ ttms_file.write(reinterpret_cast<char *>(&exri), sizeof(double));
+ int nlemt = 2 * c4->nlem;
+ for (int ami = 0; ami < nlemt; ami++) {
+ for (int amj = 0; amj < nlemt; amj++) {
+ complex<double> value = c1ao->am0m[ami][amj];
+ double rval = value.real();
+ double ival = value.imag();
+ ttms_file.write(reinterpret_cast<char *>(&rval), sizeof(double));
+ ttms_file.write(reinterpret_cast<char *>(&ival), sizeof(double));
+ }
+ }
+ ttms_file.close();
+ } else { // Could not open TM file. Should never occur.
+ printf("ERROR: failed to open TTMS file.\n");
+ break;
+ }
+ }
+ }
+ // label 156: continue from here
+ if (inpol == 0) {
+ fprintf(output, " LIN\n");
+ } else { // label 158
+ fprintf(output, " CIRC\n");
+ }
+ // label 160
+ double cs0 = 0.25 * vk * vk * vk / acos(0.0);
+ double csch = 0.0, qschu = 0.0, pschu = 0.0, s0mag = 0.0;
+ std::complex<double> s0(0.0, 0.0);
+ scr0(vk, exri, c1, c1ao, c3, c4);
+ //printf("DEBUG: after SCR0 TFSAS = (%lE, %lE)\n", c3->tfsas.real(), c3->tfsas.imag());
+ double sqk = vk * vk * sconf->exdc;
+ aps(zpv, c4->li, nsph, c1, sqk, gaps);
+ rabas(inpol, c4->li, nsph, c1, tqse, tqspe, tqss, tqsps);
+ if (c4->li != c4->le) fprintf(output, " SPHERES; LMX=LI\n");
+ for (int i170 = 1; i170 <= nsph; i170++) {
+ if (c1->iog[i170 - 1] >= i170) {
+ int i = i170 - 1;
+ double albeds = c1->sscs[i] / c1->sexs[i];
+ c1->sqscs[i] *= sqsfi;
+ c1->sqabs[i] *= sqsfi;
+ c1->sqexs[i] *= sqsfi;
+ fprintf(output, " SPHERE %2d\n", i170);
+ if (c1->nshl[i] != 1) {
+ fprintf(output, " SIZE=%15.7lE\n", c2->vsz[i]);
+ } else { // label 162
+ fprintf(output, " SIZE=%15.7lE, REFRACTIVE INDEX=%15.7lE%15.7lE\n", c2->vsz[i], c2->vkt[i].real(), c2->vkt[i].imag());
+ }
+ // label 164
+ fprintf(output, " ----- SCS ----- ABS ----- EXS ----- ALBEDS --\n");
+ fprintf(output, " %14.7lE%15.7lE%15.7lE%15.7lE\n", c1->sscs[i], c1->sabs[i], c1->sexs[i], albeds);
+ fprintf(output, " ---- SCS/GS -- ABS/GS -- EXS/GS ---\n");
+ fprintf(output, " %14.7lE%15.7lE%15.7lE\n", c1->sqscs[i], c1->sqabs[i], c1->sqexs[i]);
+ fprintf(output, " FSAS=%15.7lE%15.7lE\n", c1->fsas[i].real(), c1->fsas[i].imag());
+ csch = 2.0 * vk * sqsfi / c1->gcsv[i];
+ s0 = c1->fsas[i] * exri;
+ qschu = s0.imag() * csch;
+ pschu = s0.real() * csch;
+ s0mag = abs(s0) * cs0;
+ fprintf(output, " QSCHU=%15.7lE, PSCHU=%15.7lE, S0MAG=%15.7lE\n", qschu, pschu, s0mag);
+ double rapr = c1->sexs[i] - gaps[i];
+ double cosav = gaps[i] / c1->sscs[i];
+ fprintf(output, " COSAV=%15.7lE, RAPRS=%15.7lE\n", cosav, rapr);
+ fprintf(output, " IPO= 1, TQEk=%15.7lE, TQSk=%15.7lE\n", tqse[0][i], tqss[0][i]);
+ fprintf(output, " IPO= 2, TQEk=%15.7lE, TQSk=%15.7lE\n", tqse[1][i], tqss[1][i]);
+ }
+ } // i170 loop
+ fprintf(output, " FSAT=%15.7lE%15.7lE\n", c3->tfsas.real(), c3->tfsas.imag());
+ csch = 2.0 * vk * sqsfi / c3->gcs;
+ s0 = c3->tfsas * exri;
+ qschu = s0.imag() * csch;
+ pschu = s0.real() * csch;
+ s0mag = abs(s0) * cs0;
+ fprintf(output, " QSCHU=%15.7lE, PSCHU=%15.7lE, S0MAG=%15.7lE\n", qschu, pschu, s0mag);
+ tppoan.write(reinterpret_cast<char *>(&vk), sizeof(double));
+ pcrsm0(vk, exri, inpol, c1, c1ao, c4);
+ apcra(zpv, c4->le, c1ao->am0m, inpol, sqk, gapm, gappm);
+ th = th1;
+ for (int jth486 = 1; jth486 <= nth; jth486++) { // OpenMP portable?
+ ph = ph1;
+ double cost = 0.0, sint = 0.0, cosp = 0.0, sinp = 0.0;
+ for (int jph484 = 1; jph484 <= nph; jph484++) {
+ int jw = 0;
+ if (nk != 1 || jxi488 <= 1) {
+ upvmp(th, ph, 0, cost, sint, cosp, sinp, u, upmp, unmp);
+ if (isam >= 0) {
+ wmamp(
+ 0, cost, sint, cosp, sinp, inpol, c4->le, 0,
+ nsph, argi, u, upmp, unmp, c1
+ );
+ // label 182
+ apc(zpv, c4->le, c1ao->am0m, c1->w, sqk, gap, gapp);
+ raba(c4->le, c1ao->am0m, c1->w, tqce, tqcpe, tqcs, tqcps);
+ jw = 1;
+ }
+ } else { // label 180, NK == 1 AND JXI488 == 1
+ if (isam >= 0) {
+ // label 182
+ apc(zpv, c4->le, c1ao->am0m, c1->w, sqk, gap, gapp);
+ raba(c4->le, c1ao->am0m, c1->w, tqce, tqcpe, tqcs, tqcps);
+ jw = 1;
+ }
+ }
+ // label 184
+ double thsl = ths1;
+ double phsph = 0.0;
+ for (int jths = 1; jths <= nths; jths++) {
+ ths = thsl;
+ int icspnv = 0;
+ if (isam > 1) ths += thsca;
+ if (isam >= 1) {
+ phsph = 0.0;
+ if (ths < 0.0 || ths > 180.0) phsph = 180.0;
+ if (ths < 0.0) ths *= -1.0;
+ if (ths > 180.0) ths = 360.0 - ths;
+ if (phsph != 0.0) icspnv = 1;
+ }
+ // label 186
+ phs = phs1;
+ for (int jphs = 1; jphs <= nphs; jphs++) {
+ double costs = 0.0, sints = 0.0, cosps = 0.0, sinps = 0.0;
+ if (isam >= 1) {
+ phs = ph + phsph;
+ if (phs > 360.0) phs -= 360.0;
+ }
+ // label 188
+ bool goto190 = (nks == 1 && (jxi488 > 1 || jth486 > 1 || jph484 > 1));
+ if (!goto190) {
+ upvmp(ths, phs, icspnv, costs, sints, cosps, sinps, us, upsmp, unsmp);
+ if (isam >= 0)
+ wmamp(
+ 2, costs, sints, cosps, sinps, inpol, c4->le,
+ 0, nsph, args, us, upsmp, unsmp, c1
+ );
+ }
+ // label 190
+ if (nkks != 1 || jxi488 <= 1) {
+ upvsp(
+ u, upmp, unmp, us, upsmp, unsmp, up, un, ups, uns,
+ duk, isq, ibf, scan, cfmp, sfmp, cfsp, sfsp
+ );
+ if (isam < 0) {
+ wmasp(
+ cost, sint, cosp, sinp, costs, sints, cosps, sinps,
+ u, up, un, us, ups, uns, isq, ibf, inpol, c4->le,
+ 0, nsph, argi, args, c1
+ );
+ } else { // label 192
+ for (int i193 = 0; i193 < 3; i193++) {
+ up[i193] = upmp[i193];
+ un[i193] = unmp[i193];
+ ups[i193] = upsmp[i193];
+ uns[i193] = unsmp[i193];
+ }
+ }
+ }
+ // label 194
+ if (iavm == 1) crsm1(vk, exri, c1, c1ao, c4, c6);
+ if (isam < 0) {
+ apc(zpv, c4->le, c1ao->am0m, c1->w, sqk, gap, gapp);
+ raba(c4->le, c1ao->am0m, c1->w, tqce, tqcpe, tqcs, tqcps);
+ jw = 1;
+ }
+ // label 196
+ tppoan.write(reinterpret_cast<char *>(&th), sizeof(double));
+ tppoan.write(reinterpret_cast<char *>(&ph), sizeof(double));
+ tppoan.write(reinterpret_cast<char *>(&ths), sizeof(double));
+ tppoan.write(reinterpret_cast<char *>(&phs), sizeof(double));
+ tppoan.write(reinterpret_cast<char *>(&scan), sizeof(double));
+ if (jaw != 0) {
+ jaw = 0;
+ mextc(vk, exri, c1ao->fsacm, cextlr, cext);
+ // We now have some implicit loops writing to binary
+ for (int i = 0; i < 4; i++) {
+ for (int j = 0; j < 4; j++) {
+ double value = cext[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ for (int i = 0; i < 3; i++) {
+ double value = c1ao->scscm[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->scscpm[i].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->scscpm[i].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->ecscm[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->ecscpm[i].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->ecscpm[i].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ for (int i = 0; i < 3; i++) {
+ for (int j = 0; j < 2; j++) {
+ double value = gapm[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = gappm[i][j].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = gappm[i][j].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ fprintf(output, " CLUSTER (ENSEMBLE AVERAGE, MODE%2d)\n", iavm);
+ int jlr = 2;
+ for (int ilr210 = 1; ilr210 <= 2; ilr210++) {
+ int ipol = (ilr210 % 2 == 0) ? 1 : -1;
+ if (ilr210 == 2) jlr = 1;
+ double extsm = c1ao->ecscm[ilr210 - 1];
+ double qextm = extsm * sqsfi / c3->gcs;
+ double extrm = extsm / c3->ecs;
+ double scasm = c1ao->scscm[ilr210 - 1];
+ double albdm = scasm / extsm;
+ double qscam = scasm *sqsfi / c3->gcs;
+ double scarm = scasm / c3->scs;
+ double abssm = extsm - scasm;
+ double qabsm = abssm * sqsfi / c3->gcs;
+ double absrm = abssm / c3->acs;
+ double acsecs = c3->acs / c3->ecs;
+ if (acsecs >= -1.0e-6 && acsecs <= 1.0e-6) absrm = 1.0;
+ complex<double> s0m = c1ao->fsacm[ilr210 - 1][ilr210 - 1] * exri;
+ double qschum = s0m.imag() * csch;
+ double pschum = s0m.real() * csch;
+ double s0magm = abs(s0m) * cs0;
+ double rfinrm = c1ao->fsacm[ilr210 - 1][ilr210 - 1].real() / c3->tfsas.real();
+ double extcrm = c1ao->fsacm[ilr210 - 1][ilr210 - 1].imag() / c3->tfsas.imag();
+ if (inpol == 0) {
+ fprintf(output, " LIN %2d\n", ipol);
+ } else { // label 206
+ fprintf(output, " CIRC %2d\n", ipol);
+ }
+ // label 208
+ fprintf(output, " ----- SCC ----- ABC ----- EXC ----- ALBEDC --\n");
+ fprintf(output, " %14.7lE%15.7lE%15.7lE%15.7lE\n", scasm, abssm, extsm, albdm);
+ fprintf(output, " --- SCC/TGS - ABC/TGS - EXC/TGS ---\n");
+ fprintf(output, " %14.7lE%15.7lE%15.7lE\n", qscam, qabsm, qextm);
+ fprintf(output, " ---- SCCRT --- ABCRT --- EXCRT ----\n");
+ fprintf(output, " %14.7lE%15.7lE%15.7lE\n", scarm, absrm, extrm);
+ fprintf(
+ output, " FSAC(%1d,%1d)=%15.7lE%15.7lE FSAC(%1d,%1d)=%15.7lE%15.7lE\n",
+ ilr210, ilr210, c1ao->fsacm[ilr210 - 1][ilr210 - 1].real(),
+ c1ao->fsacm[ilr210 - 1][ilr210 - 1].imag(), jlr, ilr210,
+ c1ao->fsacm[jlr - 1][ilr210 - 1].real(), c1ao->fsacm[jlr - 1][ilr210 - 1].imag()
+ );
+ fprintf(
+ output, " RE(FSAC(%1d,%1d))/RE(TFSAS)=%15.7lE, IM(FSAC(%1d,%1d))/IM(TFSAS)=%15.7lE\n",
+ ilr210, ilr210, rfinrm, ilr210, ilr210, extcrm
+ );
+ fprintf(output, " QSCHU=%15.7lE, PSCHU=%15.7lE, S0MAG=%15.7lE\n", qschum, pschum, s0magm);
+ double rapr = c1ao->ecscm[ilr210 - 1] - gapm[2][ilr210 - 1];
+ double cosav = gapm[2][ilr210 - 1] / c1ao->scscm[ilr210 - 1];
+ double fz = rapr;
+ fprintf(output, " COSAV=%15.7lE, RAPRS=%15.7lE\n", cosav, rapr);
+ fprintf(output, " Fk=%15.7lE\n", fz);
+ } // ilr210 loop
+ double rmbrif = (c1ao->fsacm[0][0].real() - c1ao->fsacm[1][1].real()) / c1ao->fsacm[0][0].real();
+ double rmdchr = (c1ao->fsacm[0][0].imag() - c1ao->fsacm[1][1].imag()) / c1ao->fsacm[0][0].imag();
+ fprintf(output, " (RE(FSAC(1,1))-RE(FSAC(2,2)))/RE(FSAC(1,1))=%15.7lE\n", rmbrif);
+ fprintf(output, " (IM(FSAC(1,1))-IM(FSAC(2,2)))/IM(FSAC(1,1))=%15.7lE\n", rmdchr);
+ }
+ // label 212
+ fprintf(output, "********** JTH =%3d, JPH =%3d, JTHS =%3d, JPHS =%3d ********************\n", jth486, jph484, jths, jphs);
+ fprintf(output, " TIDG=%10.3lE, PIDG=%10.3lE, TSDG=%10.3lE, PSDG=%10.3lE\n", th, ph, ths, phs);
+ fprintf(output, " SCAND=%10.3lE\n", scan);
+ fprintf(output, " CFMP=%15.7lE, SFMP=%15.7lE\n", cfmp, sfmp);
+ fprintf(output, " CFSP=%15.7lE, SFSP=%15.7lE\n", cfsp, sfsp);
+ if (isam >= 0) {
+ fprintf(output, " UNI=(%12.5lE,%12.5lE,%12.5lE)\n", un[0], un[1], un[2]);
+ fprintf(output, " UNS=(%12.5lE,%12.5lE,%12.5lE)\n", uns[0], uns[1], uns[2]);
+ } else { // label 214
+ fprintf(output, " UN=(%12.5lE,%12.5lE,%12.5lE)\n\n", un[0], un[1], un[2]);
+ }
+ // label 220
+ if (inpol == 0) {
+ fprintf(output, " LIN\n");
+ } else { // label 222
+ fprintf(output, " CIRC\n");
+ }
+ // label 224
+ scr2(vk, vkarg, exri, duk, c1, c1ao, c3, c4);
+ if (c4->li != c4->le) fprintf(output, " SPHERES; LMX=MIN0(LI,LE)\n");
+ for (int i226 = 1; i226 <= nsph; i226++) {
+ if (c1->iog[i226 - 1] >= i226) {
+ fprintf(output, " SPHERE %2d\n", i226);
+ fprintf(
+ output, " SAS(1,1)=%15.7lE%15.7lE, SAS(2,1)=%15.7lE%15.7lE\n",
+ c1->sas[i226 - 1][0][0].real(), c1->sas[i226 - 1][0][0].imag(),
+ c1->sas[i226 - 1][1][0].real(), c1->sas[i226 - 1][1][0].imag()
+ );
+ fprintf(
+ output, " SAS(1,2)=%15.7lE%15.7lE, SAS(2,2)=%15.7lE%15.7lE\n",
+ c1->sas[i226 - 1][0][1].real(), c1->sas[i226 - 1][0][1].imag(),
+ c1->sas[i226 - 1][1][1].real(), c1->sas[i226 - 1][1][1].imag()
+ );
+ for (int j225 = 0; j225 < 16; j225++) { // QUESTION: check that 16 is a fixed dimension
+ c1ao->vint[j225] = c1ao->vints[i226 - 1][j225];
+ } // j225 loop
+ mmulc(c1ao->vint, cmullr, cmul);
+ fprintf(output, " MULS\n");
+ for (int i1 = 0; i1 < 4; i1++) {
+ fprintf(
+ output, " %15.7lE%15.7lE%15.7lE%15.7lE\n",
+ cmul[i1][0], cmul[i1][1], cmul[i1][2], cmul[i1][3]
+ );
+ } // i1 loop
+ fprintf(output, " MULSLR\n");
+ for (int i1 = 0; i1 < 4; i1++) {
+ fprintf(
+ output, " %15.7lE%15.7lE%15.7lE%15.7lE\n",
+ cmullr[i1][0], cmullr[i1][1], cmullr[i1][2], cmullr[i1][3]
+ );
+ } // i1 loop
+ }
+ } // i226 loop
+ fprintf(
+ output, " SAT(1,1)=%15.7lE%15.7lE, SAT(2,1)=%15.7lE%15.7lE\n",
+ c3->tsas[0][0].real(), c3->tsas[0][0].imag(),
+ c3->tsas[1][0].real(), c3->tsas[1][0].imag()
+ );
+ fprintf(
+ output, " SAT(1,2)=%15.7lE%15.7lE, SAT(2,2)=%15.7lE%15.7lE\n",
+ c3->tsas[0][1].real(), c3->tsas[0][1].imag(),
+ c3->tsas[1][1].real(), c3->tsas[1][1].imag()
+ );
+ fprintf(output, " CLUSTER\n");
+ pcros(vk, exri, c1, c1ao, c4);
+ mextc(vk, exri, c1ao->fsac, cextlr, cext);
+ mmulc(c1ao->vint, cmullr, cmul);
+ if (jw != 0) {
+ jw = 0;
+ // Some implicit loops writing to binary.
+ for (int i = 0; i < 4; i++) {
+ for (int j = 0; j < 4; j++) {
+ double value = cext[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ for (int i = 0; i < 2; i++) {
+ double value = c1ao->scsc[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->scscp[i].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->scscp[i].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->ecsc[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->ecscp[i].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->ecscp[i].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ for (int i = 0; i < 3; i++) {
+ for (int j = 0; j < 2; j++) {
+ double value = gap[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = gapp[i][j].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = gapp[i][j].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ for (int i = 0; i < 2; i++) {
+ for (int j = 0; j < 3; j++) {
+ double value = tqce[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = tqcpe[i][j].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = tqcpe[i][j].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ for (int i = 0; i < 2; i++) {
+ for (int j = 0; j < 3; j++) {
+ double value = tqcs[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = tqcps[i][j].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = tqcps[i][j].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ for (int i = 0; i < 3; i++) {
+ double value = u[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = up[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = un[i];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ // label 254
+ for (int i = 0; i < 16; i++) {
+ double value = c1ao->vint[i].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->vint[i].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ for (int i = 0; i < 4; i++) {
+ for (int j = 0; j < 4; j++) {
+ double value = cmul[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ int jlr = 2;
+ for (int ilr290 = 1; ilr290 <= 2; ilr290++) {
+ int ipol = (ilr290 % 2 == 0) ? 1 : -1;
+ if (ilr290 == 2) jlr = 1;
+ double extsec = c1ao->ecsc[ilr290 - 1];
+ double qext = extsec * sqsfi / c3->gcs;
+ double extrat = extsec / c3->ecs;
+ double scasec = c1ao->scsc[ilr290 - 1];
+ double albedc = scasec / extsec;
+ double qsca = scasec * sqsfi / c3->gcs;
+ double scarat = scasec / c3->scs;
+ double abssec = extsec - scasec;
+ double qabs = abssec * sqsfi / c3->gcs;
+ double absrat = 1.0;
+ double ratio = c3->acs / c3->ecs;
+ if (ratio < -1.0e-6 || ratio > 1.0e-6) absrat = abssec / c3->acs;
+ s0 = c1ao->fsac[ilr290 - 1][ilr290 - 1] * exri;
+ double qschu = s0.imag() * csch;
+ double pschu = s0.real() * csch;
+ s0mag = abs(s0) * cs0;
+ double refinr = c1ao->fsac[ilr290 - 1][ilr290 - 1].real() / c3->tfsas.real();
+ double extcor = c1ao->fsac[ilr290 - 1][ilr290 - 1].imag() / c3->tfsas.imag();
+ if (inpol == 0) {
+ fprintf(output, " LIN %2d\n", ipol);
+ } else { // label 273
+ fprintf(output, " CIRC %2d\n", ipol);
+ }
+ // label 275
+ fprintf(output, " ----- SCC ----- ABC ----- EXC ----- ALBEDC --\n");
+ fprintf(
+ output, " %14.7lE%15.7lE%15.7lE%15.7lE\n",
+ scasec, abssec, extsec, albedc
+ );
+ fprintf(output, " --- SCC/TGS - ABC/TGS - EXC/TGS ---\n");
+ fprintf(
+ output, " %14.7lE%15.7lE%15.7lE\n",
+ qsca, qabs, qext
+ );
+ fprintf(output, " ---- SCCRT --- ABCRT --- EXCRT ----\n");
+ fprintf(
+ output, " %14.7lE%15.7lE%15.7lE\n",
+ scarat, absrat, extrat
+ );
+ fprintf(
+ output, " FSAC(%1d,%1d)=%15.7lE%15.7lE FSAC(%1d,%1d)=%15.7lE%15.7lE\n",
+ ilr290, ilr290, c1ao->fsac[ilr290 - 1][ilr290 - 1].real(), c1ao->fsac[ilr290 - 1][ilr290 - 1].imag(),
+ jlr, ilr290, c1ao->fsac[jlr - 1][ilr290 - 1].real(), c1ao->fsac[jlr - 1][ilr290 - 1].imag()
+ );
+ fprintf(
+ output, " SAC(%1d,%1d)=%15.7lE%15.7lE SAC(%1d,%1d)=%15.7lE%15.7lE\n",
+ ilr290, ilr290, c1ao->sac[ilr290 - 1][ilr290 - 1].real(), c1ao->sac[ilr290 - 1][ilr290 - 1].imag(),
+ jlr, ilr290, c1ao->sac[jlr - 1][ilr290 - 1].real(), c1ao->sac[jlr - 1][ilr290 - 1].imag()
+ );
+ fprintf(
+ output, " RE(FSAC(%1d,%1d))/RE(TFSAS)=%15.7lE, IM(FSAC(%1d,%1d))/IM(TFSAS)=%15.7lE\n",
+ ilr290, ilr290, refinr, ilr290, ilr290, extcor
+ );
+ fprintf(
+ output, " QSCHU=%15.7lE, PSCHU=%15.7lE, S0MAG=%15.7lE\n",
+ qschu, pschu, s0mag
+ );
+ bool goto190 = isam >= 0 && (jths > 1 || jphs > 1);
+ if (!goto190) {
+ gapv[0] = gap[0][ilr290 - 1];
+ gapv[1] = gap[1][ilr290 - 1];
+ gapv[2] = gap[2][ilr290 - 1];
+ double extins = c1ao->ecsc[ilr290 - 1];
+ double scatts = c1ao->scsc[ilr290 - 1];
+ double rapr, cosav, fp, fn, fk, fx, fy, fz;
+ rftr(u, up, un, gapv, extins, scatts, rapr, cosav, fp, fn, fk, fx, fy, fz);
+ fprintf(output, " COSAV=%15.7lE, RAPRS=%15.7lE\n", cosav, rapr);
+ fprintf(output, " Fl=%15.7lE, Fr=%15.7lE, Fk=%15.7lE\n", fp, fn, fk);
+ fprintf(output, " Fx=%15.7lE, Fy=%15.7lE, Fz=%15.7lE\n", fx, fy, fz);
+ tqev[0] = tqce[ilr290 - 1][0];
+ tqev[1] = tqce[ilr290 - 1][1];
+ tqev[2] = tqce[ilr290 - 1][2];
+ tqsv[0] = tqcs[ilr290 - 1][0];
+ tqsv[1] = tqcs[ilr290 - 1][1];
+ tqsv[2] = tqcs[ilr290 - 1][2];
+ double tep, ten, tek, tsp, tsn, tsk;
+ tqr(u, up, un, tqev, tqsv, tep, ten, tek, tsp, tsn, tsk);
+ fprintf(output, " TQEl=%15.7lE, TQEr=%15.7lE, TQEk=%15.7lE\n", tep, ten, tek);
+ fprintf(output, " TQSl=%15.7lE, TQSr=%15.7lE, TQSk=%15.7lE\n", tsp, tsn, tsk);
+ fprintf(
+ output, " TQEx=%15.7lE, TQEy=%15.7lE, TQEz=%15.7lE\n",
+ tqce[ilr290 - 1][0], tqce[ilr290 - 1][1], tqce[ilr290 - 1][2]
+ );
+ fprintf(
+ output, " TQSx=%15.7lE, TQSy=%15.7lE, TQSz=%15.7lE\n",
+ tqcs[ilr290 - 1][0], tqcs[ilr290 - 1][1], tqcs[ilr290 - 1][2]
+ );
+ }
+ } //ilr290 loop
+ double rbirif = (c1ao->fsac[0][0].real() - c1ao->fsac[1][1].real()) / c1ao->fsac[0][0].real();
+ double rdichr = (c1ao->fsac[0][0].imag() - c1ao->fsac[1][1].imag()) / c1ao->fsac[0][0].imag();
+ fprintf(output, " (RE(FSAC(1,1))-RE(FSAC(2,2)))/RE(FSAC(1,1))=%15.7lE\n", rbirif);
+ fprintf(output, " (IM(FSAC(1,1))-IM(FSAC(2,2)))/IM(FSAC(1,1))=%15.7lE\n", rdichr);
+ fprintf(output, " MULC\n");
+ for (int i = 0; i < 4; i++) {
+ fprintf(
+ output, " %15.7lE%15.7lE%15.7lE%15.7lE\n",
+ cmul[i][0], cmul[i][1], cmul[i][2], cmul[i][3]
+ );
+ }
+ fprintf(output, " MULCLR\n");
+ for (int i = 0; i < 4; i++) {
+ fprintf(
+ output, " %15.7lE%15.7lE%15.7lE%15.7lE\n",
+ cmullr[i][0], cmullr[i][1], cmullr[i][2], cmullr[i][3]
+ );
+ }
+ if (iavm != 0) {
+ mmulc(c1ao->vintm, cmullr, cmul);
+ // Some implicit loops writing to binary.
+ for (int i = 0; i < 16; i++) {
+ double value;
+ value = c1ao->vintm[i].real();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ value = c1ao->vintm[i].imag();
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ for (int i = 0; i < 4; i++) {
+ for (int j = 0; j < 4; j++) {
+ double value = cmul[i][j];
+ tppoan.write(reinterpret_cast<char *>(&value), sizeof(double));
+ }
+ }
+ fprintf(output, " CLUSTER (ENSEMBLE AVERAGE, MODE%2d)\n", iavm);
+ if (inpol == 0) {
+ fprintf(output, " LIN\n");
+ } else { // label 316
+ fprintf(output, " CIRC\n");
+ }
+ // label 318
+ fprintf(output, " MULC\n");
+ for (int i = 0; i < 4; i++) {
+ fprintf(
+ output, " %15.7lE%15.7lE%15.7lE%15.7lE\n",
+ cmul[i][0], cmul[i][1], cmul[i][2], cmul[i][3]
+ );
+ }
+ fprintf(output, " MULCLR\n");
+ for (int i = 0; i < 4; i++) {
+ fprintf(
+ output, " %15.7lE%15.7lE%15.7lE%15.7lE\n",
+ cmullr[i][0], cmullr[i][1], cmullr[i][2], cmullr[i][3]
+ );
+ }
+ }
+ // label 420, continues jphs loop
+ if (isam < 1) phs += phsstp;
+ } // jphs loop, labeled 480
+ if (isam <= 1) thsl += thsstp;
+ } // jths loop, labeled 482
+ ph += phstp;
+ } // jph484 loop
+ th += thstp;
+ } // jth486 loop
+ printf("INFO: done scale.\n");
+ } // jxi488 loop
+ tppoan.close();
+ } else { // In case TPPOAN could not be opened. Should never happen.
+ printf("ERROR: failed to open TPPOAN file.\n");
+ }
+ fclose(output);
+ // Clean memory
+ delete c1;
+ delete c1ao;
+ delete c3;
+ delete c4;
+ delete c6;
+ delete c9;
+ for (int zi = c4->lm - 1; zi > -1; zi--) {
+ for (int zj = 2; zj > -1; zj--) {
+ delete[] zpv[zi][zj][1];
+ delete[] zpv[zi][zj][0];
+ delete[] zpv[zi][zj];
+ }
+ delete[] zpv[zi];
+ }
+ delete[] zpv;
+ for (int ai = mxndm - 1; ai > -1; ai--) delete[] am[ai];
+ delete[] am;
+ delete[] gaps;
+ for (int ti = 1; ti > -1; ti--) {
+ delete[] tqse[ti];
+ delete[] tqss[ti];
+ delete[] tqspe[ti];
+ delete[] tqsps[ti];
+ delete[] tqce[ti];
+ delete[] tqcpe[ti];
+ delete[] tqcs[ti];
+ delete[] tqcps[ti];
+ }
+ delete[] tqse;
+ delete[] tqss;
+ delete[] tqspe;
+ delete[] tqsps;
+ delete[] tqce;
+ delete[] tqcpe;
+ delete[] tqcs;
+ delete[] tqcps;
+ delete[] tqev;
+ delete[] tqsv;
+ for (int gi = 2; gi > -1; gi--) {
+ delete[] gapp[gi];
+ delete[] gappm[gi];
+ delete[] gap[gi];
+ delete[] gapm[gi];
+ }
+ delete[] gapp;
+ delete[] gappm;
+ delete[] gap;
+ delete[] gapm;
+ delete[] gapv;
+ delete[] u;
+ delete[] us;
+ delete[] un;
+ delete[] uns;
+ delete[] up;
+ delete[] ups;
+ delete[] unmp;
+ delete[] unsmp;
+ delete[] upmp;
+ delete[] upsmp;
+ delete[] argi;
+ delete[] args;
+ delete[] duk;
+ for (int ci = 3; ci > -1; ci--) {
+ delete[] cextlr[ci];
+ delete[] cext[ci];
+ delete[] cmullr[ci];
+ delete[] cmul[ci];
+ }
+ delete[] cextlr;
+ delete[] cext;
+ delete[] cmullr;
+ delete[] cmul;
+ } else { // NSPH mismatch between geometry and scatterer configurations.
+ throw UnrecognizedConfigurationException(
+ "Inconsistent geometry and scatterer configurations."
+ );
+ }
+ delete sconf;
+ delete gconf;
+ printf("Finished: output written to %s.\n", (output_path + "/c_OCLU").c_str());
+}
diff --git a/src/cluster/np_cluster.cpp b/src/cluster/np_cluster.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..e9a85e79d16d82e359654456a5d0345396c08fa0
--- /dev/null
+++ b/src/cluster/np_cluster.cpp
@@ -0,0 +1,33 @@
+/*! \file np_sphere.cpp
+ */
+
+#include <cstdio>
+#include <string>
+#ifndef INCLUDE_CONFIGURATION_H_
+#include "../include/Configuration.h"
+#endif
+
+using namespace std;
+
+extern void cluster(string config_file, string data_file, string output_path);
+
+/*! \brief Main program entry point.
+ *
+ * This is the starting point of the execution flow. Here we may choose
+ * how to configure the code, e.g. by loading a legacy configuration file
+ * or some otherwise formatted configuration data set. The code can be
+ * linked to a luncher script or to a GUI oriented application that performs
+ * the configuration and runs the main program.
+ */
+int main(int argc, char **argv) {
+ string config_file = "../../test_data/cluster/DEDFB";
+ string data_file = "../../test_data/cluster/DCLU";
+ string output_path = ".";
+ if (argc == 4) {
+ config_file = string(argv[1]);
+ data_file = string(argv[2]);
+ output_path = string(argv[3]);
+ }
+ cluster(config_file, data_file, output_path);
+ return 0;
+}
diff --git a/src/include/Commons.h b/src/include/Commons.h
index 088dcc74771f967511b579964e8278000db1f3e3..7a45deafdbc46ab08d11b59443d241d4bd19f22b 100644
--- a/src/include/Commons.h
+++ b/src/include/Commons.h
@@ -7,15 +7,15 @@
* the data blocks in the code, therefore implying the necessity to modify
* the code to adapt it to the input and to recompile before running. C++,
* on the contrary, offers the possibility to represent the necessary data
- * structures as classes that can dinamically instantiate the shared information
+ * structures as classes that can dynamically instantiate the shared information
* in the most convenient format for the current configuration. This approach
* adds an abstraction layer that lifts the need to modify and recompile the
* code depending on the input.
*
*/
-#ifndef SRC_INCLUDE_COMMONS_
-#define SRC_INCLUDE_COMMONS_
+#ifndef INCLUDE_COMMONS_
+#define INCLUDE_COMMONS_
#include <complex>
@@ -88,8 +88,10 @@ public:
*
* \param ns: `int` Number of spheres.
* \param l_max: `int` Maximum order of field expansion.
+ * \param nshl: `int *` Array of number of layers in spheres.
+ * \param iog: `int *` Vector of spherical units ID numbers.
*/
- C1(int ns, int l_max);
+ C1(int ns, int l_max, int *nshl, int *iog);
//! \brief C1 instance destroyer.
~C1();
@@ -128,4 +130,191 @@ public:
~C2();
};
+/*! \brief Representation of the FORTRAN C3 blocks.
+ */
+class C3 {
+public:
+ //! \brief QUESTION: definition?
+ std::complex<double> tfsas;
+ //! \brief QUESTION: definition?
+ std::complex<double> **tsas;
+ //! \brief QUESTION: definition?
+ double gcs;
+ //! \brief QUESTION: definition?
+ double scs;
+ //! \brief QUESTION: definition?
+ double ecs;
+ //! \brief QUESTION: definition?
+ double acs;
+
+ /*! \brief C3 instance constructor.
+ */
+ C3();
+
+ /*! \brief C3 instance destroyer.
+ */
+ ~C3();
+};
+
+/*! \brief Representation of the FORTRAN C4 blocks.
+ */
+struct C4 {
+ //! \brief QUESTION: definition?
+ int litpo;
+ //! \brief QUESTION: definition?
+ int litpos;
+ //! \brief Maximum field expansion order plus one. QUESTION: correct?
+ int lmpo;
+ //! \brief Twice maximum field expansion order plus one. QUESTION: correct?
+ int lmtpo;
+ //! \brief Square of `lmtpo`.
+ int lmtpos;
+ //! \brief QUESTION: definition?
+ int li;
+ //! \brief QUESTION: definition?
+ int nlim;
+ //! \brief QUESTION: definition?
+ int le;
+ //! \brief QUESTION: definition?
+ int nlem;
+ //! \brief Maximum field expansion order. QUESTION: correct?
+ int lm;
+ //! \brief Number of spheres.
+ int nsph;
+ //! \brief QUESTION: definition?
+ int nv3j;
+};
+
+/*! \brief Vectors and matrices that are specific to cluster C1 blocks.
+ *
+ */
+class C1_AddOns {
+protected:
+ //! \brief Number of spheres.
+ int nsph;
+ //! \brief QUESTION: definition?
+ int nlemt;
+ //! \brief Maximum expansion order plus one. QUESTION: correct?
+ int lmpo;
+
+ /*! \brief Allocate the necessary common vectors depending on configuration.
+ *
+ * The size of the vectors and matrices defined in various common
+ * blocks, and particularly in C1, depends on many settings of the
+ * problem configuration, such as the number of spheres, the number
+ * of layers the spheres are made of, the field expansion order and
+ * others. This function collects the calculations needed to infer
+ * the necessary amount of memory for these configurable elements,
+ * thus making the class constructor more compact and easier to handle.
+ *
+ * \param c4: `C4 *` Pointer to a C4 structure.
+ */
+ void allocate_vectors(C4 *c4);
+public:
+ //! \brief QUESTION: definition?
+ std::complex<double> *vh;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vj0;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vj;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vyhj;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vyj0;
+ //! \brief QUESTION: definition?
+ std::complex<double> **am0m;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vint;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vintm;
+ //! \brief QUESTION: definition?
+ std::complex<double> **vints;
+ //! \brief QUESTION: definition?
+ std::complex<double> *vintt;
+ //! \brief QUESTION: definition?
+ std::complex<double> **fsac;
+ //! \brief QUESTION: definition?
+ std::complex<double> **sac;
+ //! \brief QUESTION: definition?
+ std::complex<double> **fsacm;
+ //! \brief QUESTION: definition?
+ double *scsc;
+ //! \brief QUESTION: definition?
+ std::complex<double> *scscp;
+ //! \brief QUESTION: definition?
+ double *ecsc;
+ //! \brief QUESTION: definition?
+ double *ecscm;
+ //! \brief QUESTION: definition?
+ double *scscm;
+ //! \brief QUESTION: definition?
+ std::complex<double> *ecscp;
+ //! \brief QUESTION: definition?
+ std::complex<double> *scscpm;
+ //! \brief QUESTION: definition?
+ std::complex<double> *ecscpm;
+ //! \brief QUESTION: definition?
+ double *v3j0;
+ //! \brief QUESTION: definition?
+ double *sscs;
+ //! \brief QUESTION: definition?
+ int **ind3j;
+
+ /*! \brief C1_AddOns instance constructor.
+ *
+ * \param c4: `C4 *` Pointer to a C4 structure.
+ */
+ C1_AddOns(C4 *c4);
+
+ //! \brief C1_AddOns instance destroyer.
+ ~C1_AddOns();
+};
+
+/*! \brief Representation of the FORTRAN C6 blocks.
+ */
+class C6 {
+public:
+ //! \brief QUESTION: definition?
+ double *rac3j;
+
+ /*! \brief C6 instance constructor.
+ *
+ * \param lmtpo: `int` QUESTION: definition?
+ */
+ C6(int lmtpo);
+
+ /*! \brief C6 instance destroyer.
+ */
+ ~C6();
+};
+
+/*! \brief Representation of the FORTRAN C9 blocks.
+ */
+class C9 {
+protected:
+ //! \brief Number of rows in the GIS and GLS matrices
+ int gis_size_0;
+ //! \brief Number of rows in the SAM matrix
+ int sam_size_0;
+public:
+ //! \brief QUESTION: definition?
+ std::complex<double> **gis;
+ //! \brief QUESTION: definition?
+ std::complex<double> **gls;
+ //! \brief QUESTION: definition?
+ std::complex<double> **sam;
+
+ /*! \brief C9 instance constructor.
+ *
+ * \param ndi: `int` QUESTION: definition?
+ * \param nlem: `int` QUESTION: definition?
+ * \param ndit: `int` QUESTION: definition?
+ * \param nlemt: `int` QUESTION: definition?
+ */
+ C9(int ndi, int nlem, int ndit, int nlemt);
+
+ /*! \brief C9 instance destroyer.
+ */
+ ~C9();
+};
#endif
diff --git a/src/include/Configuration.h b/src/include/Configuration.h
index fdc36184be5f58f321b221b8752113d210583349..e784fa38bf0bd7b2f681102f0cbba5bbb7628028 100644
--- a/src/include/Configuration.h
+++ b/src/include/Configuration.h
@@ -64,13 +64,22 @@ public:
* fields and their polarization properties.
*/
class GeometryConfiguration {
- //! Temporary work-around to allow sphere() peeking in.
- friend void sphere();
+ //! Temporary work-around to allow cluster() and sphere() peeking in.
+ friend void cluster(std::string, std::string, std::string);
+ friend void sphere(std::string, std::string, std::string);
protected:
//! \brief Number of spherical components.
int number_of_spheres;
//! \brief Maximum expansion order of angular momentum.
int l_max;
+ //! \brief QUESTION: definition?
+ int li;
+ //! \brief QUESTION: definition?
+ int le;
+ //! \brief QUESTION: definition?
+ int mxndm;
+ //! \brief QUESTION: definition?
+ int iavm;
//! \brief Incident field polarization status (0 - linear, 1 - circular).
int in_pol;
//! \brief Number of transition points. QUESTION: correct?
@@ -124,6 +133,10 @@ public:
* for incident angles, 0 if determined by incidence and observation, =1
* accross z-axis for incidence and observation, >1 across z-axis as a
* function of incidence angles for fixed scattering).
+ * \param li: `int`
+ * \param le: `int`
+ * \param mxndm: `int`
+ * \param iavm: `int`
* \param x: `double*` Vector of spherical components X coordinates.
* \param y: `double*` Vector of spherical components Y coordinates.
* \param z: `double*` Vector of spherical components Z coordinates.
@@ -143,6 +156,7 @@ public:
*/
GeometryConfiguration(
int nsph, int lm, int in_pol, int npnt, int npntts, int meridional_type,
+ int li, int le, int mxndm, int iavm,
double *x, double *y, double *z,
double in_th_start, double in_th_step, double in_th_end,
double sc_th_start, double sc_th_step, double sc_th_end,
@@ -176,8 +190,9 @@ public:
* data to describe the scatterer properties.
*/
class ScattererConfiguration {
- //! Temporary work-around to allow sphere() peeking in.
- friend void sphere();
+ //! Temporary work-around to allow cluster() and sphere() peeking in.
+ friend void cluster(std::string, std::string, std::string);
+ friend void sphere(std::string, std::string, std::string);
protected:
//! \brief Matrix of dielectric parameters with size [NON_TRANS_LAYERS x N_SPHERES x LAYERS].
std::complex<double> ***dc0_matrix;
diff --git a/src/include/clu_subs.h b/src/include/clu_subs.h
new file mode 100644
index 0000000000000000000000000000000000000000..df1d19554c4b948e01fd4dd2b5725a9f98034d2b
--- /dev/null
+++ b/src/include/clu_subs.h
@@ -0,0 +1,2265 @@
+/*! \file clu_subs.h
+ *
+ * \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.
+ */
+
+#ifndef INCLUDE_COMMONS_H_
+#include "Commons.h"
+#endif
+
+#ifndef INCLUDE_CLU_SUBS_H_
+#define INCLUDE_CLU_SUBS_H_
+
+#include <complex>
+
+// >>> 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 CDTP
+ *
+ * \param z: `complex<double>`
+ * \param am: Matrix of complex.
+ * \param i: `int`
+ * \param jf: `int`
+ * \param k: `int`
+ * \param nj: `int`
+ */
+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
+ *
+ * \param ipamo: `int`
+ * \param mu: `int`
+ * \param l: `int`
+ * \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;
+}
+
+/*! \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) {
+ 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;
+ }
+ }
+}
+
+/*! \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) {
+ 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
+ }
+ }
+}
+
+/*! \brief C++ porting of GHIT
+ *
+ * \param ihi: `int`
+ * \param ipamo: `int`
+ * \param nbl: `int`
+ * \param l1: `int`
+ * \param m1: `int`
+ * \param l2: `int`
+ * \param m2: `int`
+ * \param c1: `C1 *`
+ * \param c1ao: `C1_AddOns *`
+ * \param c4: `C4 *`
+ * \param 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
+ 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`
+ * \param exri: `double`
+ * \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
+ *
+ * \param exri: `double`
+ * \param vk: `double`
+ * \param jer: `int &`
+ * \param lcalc: `int &`
+ * \param arg: `complex\<double\> &`
+ * \param c1: `C1 *`
+ * \param c1ao: `C1_AddOns *`
+ * \param c4: `C4 *`
+ */
+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
+ *
+ * \param am: Matrix of complex.
+ * \param nddmst: `const int`
+ * \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;
+}
+
+/*! \brief C++ porting of MEXTC
+ *
+ * \param vk: `double`
+ * \param exri: `double`
+ * \param fsac: Matrix of complex
+ * \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;
+ }
+ }
+}
+
+/*! \brief C++ porting of PCROS
+ *
+ * This function is intended to evaluate the particle cross-section. QUESTIUON: correct?
+ * \param vk: `double`
+ * \param exri: `double`
+ * \param c1: `C1 *`
+ * \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
+}
+
+/*! \brief C++ porting of PCRSM0
+ *
+ * \param vk: `double`
+ * \param exri: `double`
+ * \param inpol: `int`
+ * \param c1: `C1 *`
+ * \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;
+}
+
+/*! \brief C++ porting of POLAR
+ *
+ * \param x: `double`
+ * \param y: `double`
+ * \param z: `double`
+ * \param r: `double &`
+ * \param cth: `double &`
+ * \param sth: `double &`
+ * \param cph: `double &`
+ * \param sph: `double &`
+ */
+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
+ *
+ * \param j2: `int`
+ * \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;
+ }
+}
+
+/*! \brief C++ porting of RABA
+ *
+ * \param le: `int`
+ * \param am0m: Matrix of complex.
+ * \param w: Matrix of complex.
+ * \param tqce: `double **`
+ * \param tqcpe: Matrix of complex.
+ * \param tqcs: `double **`
+ * \param tqcps: Matrix of complex.
+ */
+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
+ *
+ * \param u: `double *`
+ * \param up: `double *`
+ * \param un: `double *`
+ * \param gapv: `double *`
+ * \param extins: `double`
+ * \param scatts: `double`
+ * \param rapr: `double &`
+ * \param cosav: `double &`
+ * \param fp: `double &`
+ * \param fn: `double &`
+ * \param fk: `double &`
+ * \param fx: `double &`
+ * \param fy: `double &`
+ * \param fz: `double &`
+ */
+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
+ *
+ * \param vk: `double` QUESTION: definition?
+ * \param exri: `double` External medium refractive index. QUESTION: correct?
+ * \param c1: `C1 *` Pointer to a C1 instance.
+ * \param c1ao: `C1_AddOns *` Pointer to C1_AddOns instance.
+ * \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
+}
+
+/*! \brief C++ porting of SCR2
+ *
+ * \param vk: `double` QUESTION: definition?
+ * \param vkarg: `double` QUESTION: definition?
+ * \param exri: `double` External medium refractive index
+ * \param duk: `double *` QUESTION: definition?
+ * \param c1: `C1 *` Pointer to a C1 instance.
+ * \param c1ao: `C1_AddOns *` Pointer to C1_AddOns instance.
+ * \param c3: `C3 *` Pointer to a C3 instance.
+ * \param c4: `C4 *` Pointer to a C4 structure.
+ */
+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
+}
+
+/*! \brief C++ porting of STR
+ *
+ * \param rcf: `double **` Matrix of double.
+ * \param c1: `C1 *` Pointer to a C1 instance.
+ * \param c1ao: `C1_AddOns *` Pointer to C1_AddOns instance.
+ * \param c3: `C3 *` Pointer to a C3 instance.
+ * \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;
+ for (int i18 = 1; i18 <= c4->nsph; i18++) {
+ int iogi = c1->iog[i18 - 1];
+ if (iogi >= i18) {
+ double 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;
+}
+
+/*! \brief C++ porting of TQR
+ *
+ * \param u: `double *`
+ * \param up: `double *`
+ * \param un: `double *`
+ * \param tqev: `double *`
+ * \param tqsv: `double *`
+ * \param tep: `double &`
+ * \param ten: `double &`
+ * \param tek: `double &`
+ * \param tsp: `double &`
+ * \param tsn: `double &`
+ * \param tsk: `double &`
+ */
+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
+ *
+ * \param am: Matrix of complex.
+ * \param c1: `C1 *` Pointer to a C1 instance.
+ * \param c1ao: `C1_AddOns *` Pointer to C1_AddOns instance.
+ * \param c4: `C4 *` Pointer to a C4 structure.
+ * \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;
+}
+
+#endif
diff --git a/src/include/sph_subs.h b/src/include/sph_subs.h
index 3c562fb1f586d34b37481c1317daa491f0ed4ca5..dd3470da68ed49ebc8f8fe31d9a4b9ef22f05072 100644
--- a/src/include/sph_subs.h
+++ b/src/include/sph_subs.h
@@ -110,46 +110,48 @@ void aps(double ****zpv, int li, int nsph, C1 *c1, double sqk, double *gaps) {
std::complex<double> summ, sume, suem, suee, sum;
double half_pi = acos(0.0);
double cofs = half_pi * 2.0 / sqk;
- for (int i40 = 1; i40 <= nsph; i40++) {
- int iogi = c1->iog[i40 - 1];
- if (iogi >= i40) {
+ for (int i40 = 0; i40 < nsph; i40++) {
+ int i = i40 + 1;
+ int iogi = c1->iog[i40];
+ if (iogi >= i) {
sum = cc0;
- for (int l30 = 1; l30 <= li; l30++) {
- int ltpo = l30 + l30 + 1;
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- bool goto30 = (l30 == 1 && ilmp == 1) || (l30 == li && ilmp == 3);
+ 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 = l30 + lmpml;
+ int lmp = l + lmpml;
double cofl = sqrt(1.0 * (ltpo * (lmp + lmp + 1)));
- summ = zpv[l30 - 1][ilmp - 1][0][0] /
+ summ = zpv[l30][ilmp30][0][0] /
(
- dconjg(c1->rmi[l30 - 1][i40 - 1]) *
- c1->rmi[lmp - 1][i40 - 1]
+ dconjg(c1->rmi[l30][i40]) *
+ c1->rmi[lmp - 1][i40]
);
- sume = zpv[l30 - 1][ilmp - 1][0][1] /
+ sume = zpv[l30][ilmp30][0][1] /
(
- dconjg(c1->rmi[l30 - 1][i40 - 1]) *
- c1->rei[lmp - 1][i40 - 1]
+ dconjg(c1->rmi[l30][i40]) *
+ c1->rei[lmp - 1][i40]
);
- suem = zpv[l30 - 1][ilmp - 1][1][0] /
+ suem = zpv[l30][ilmp30][1][0] /
(
- dconjg(c1->rei[l30 - 1][i40 - 1]) *
- c1->rmi[lmp - 1][i40 - 1]
+ dconjg(c1->rei[l30][i40]) *
+ c1->rmi[lmp - 1][i40]
);
- suee = zpv[l30 - 1][ilmp - 1][1][1] /
+ suee = zpv[l30][ilmp30][1][1] /
(
- dconjg(c1->rei[l30 - 1][i40 - 1]) *
- c1->rei[lmp - 1][i40 - 1]
+ dconjg(c1->rei[l30][i40]) *
+ c1->rei[lmp - 1][i40]
);
- sum += (cg1(lmpml, 0, l30, -1) * (summ - sume - suem + suee) +
- cg1(lmpml, 0, l30, 1) * (summ + sume + suem + suee)) * cofl;
+ sum += (cg1(lmpml, 0, l, -1) * (summ - sume - suem + suee) +
+ cg1(lmpml, 0, l, 1) * (summ + sume + suem + suee)) * cofl;
}
}
}
}
- gaps[i40 - 1] = sum.real() * cofs;
- printf("DEBUG: gaps[%d] = %lE\n", i40, gaps[i40 - 1]);
+ gaps[i40] = sum.real() * cofs;
}
}
@@ -164,16 +166,19 @@ void aps(double ****zpv, int li, int nsph, C1 *c1, double sqk, double *gaps) {
* \param c2: `C2 *`
*/
void diel(int npntmo, int ns, int i, int ic, double vk, C1 *c1, C2 *c2) {
- double dif = c1->rc[i - 1][ns] - c1->rc[i - 1][ns - 1];
- double half_step = 0.5 * dif / npntmo;
+ 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];
- std::complex<double> delta = c2->dc0[ic] - c2->dc0[ic - 1];
- int kpnt = npntmo + npntmo;
+ 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[i - 1][ns - 1]) / dif;
- c2->ris[np90] = delta * ff * ff * (-2.0 * ff + 3.0) + c2->dc0[ic - 1];
+ 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;
}
@@ -324,8 +329,8 @@ void cbf(int n, std::complex<double> z, int &nm, std::complex<double> csj[]) {
cf0 = cf1;
cf1 = cf;
}
- double abs_csa = sqrt(csa.real() * csa.real() + csa.imag() * csa.imag());
- double abs_csb = sqrt(csb.real() * csb.real() + csb.imag() * csb.imag());
+ 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++) {
@@ -430,33 +435,31 @@ void pwma(
double *up, double *un, std::complex<double> *ylm, int inpol, int lw,
int isq, C1 *c1
) {
- //std::complex<double> cp1, cm1, cc1, cp2, c2, cc2, uim, cl;
- double four_pi = 8.0 * acos(0.0);
+ 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;
- double sqrtwi = 1.0 / sqrt(2.0);
- std::complex<double> uim(0.0, 1.0);
+ 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];
- //printf("DEBUG: in PWMA YLM(2) = (%lE, %lE)\n", ylm[1].real(), ylm[1].imag());
- for (int l20 = 1; l20 <= lw; l20++) {
- //if (ispo == 1) printf("DEBUG: l20 = %d\n", l20);
- int lf = l20 + 1;
- int lftl = lf * l20;
+ 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 <= l20; powi++) cl *= uim;
- int mv = l20 + lf;
+ for (int powi = 1; powi <= l; powi++) cl *= uim;
+ int mv = l + lf;
int m = -lf;
- for (int mf20 = 1; mf20 <= mv; mf20++) {
+ for (int mf20 = 0; mf20 < mv; mf20++) {
m += 1;
int k = lftl + m;
x = 1.0 * (lftl - m * (m + 1));
@@ -469,35 +472,27 @@ void pwma(
cm1 * cm * ylm[k - 1] +
cz1 * cz * ylm[k]
) * cl;
- //if (ispo == 1) printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", k, ispo, c1->w[k - 1][ispo - 1].real(), c1->w[k - 1][ispo - 1].imag());
c1->w[k - 1][ispt - 1] = dconjg(
cp2 * cp * ylm[k + 1] +
cm2 * cm * ylm[k - 1] +
cz2 * cz * ylm[k]
) * cl;
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", k, ispt, c1->w[k - 1][ispt - 1].real(), c1->w[k - 1][ispt - 1].imag());
}
}
- for (int k30 = 1; k30 <= nlwm; k30++) {
+ for (int k30 = 0; k30 < nlwm; k30++) {
int i = k30 + nlwm;
- c1->w[i - 1][ispo - 1] = uim * c1->w[k30 - 1][ispt - 1];
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", i, ispo, c1->w[i - 1][ispo - 1].real(), c1->w[i - 1][ispo - 1].imag());
- c1->w[i - 1][ispt - 1] = -uim * c1->w[k30 - 1][ispo - 1];
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", i, ispt, c1->w[i - 1][ispt - 1].real(), c1->w[i - 1][ispt - 1].imag());
+ 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 = 1; k40 <= nlwm; k40++) {
+ for (int k40 = 0; k40 < nlwm; k40++) {
int i = k40 + nlwm;
- std::complex<double> cc1 = sqrtwi * (c1->w[k40 - 1][ispo - 1] + uim * c1->w[k40 - 1][ispt - 1]);
- std::complex<double> cc2 = sqrtwi * (c1->w[k40 - 1][ispo - 1] - uim * c1->w[k40 - 1][ispt - 1]);
- c1->w[k40 - 1][ispo - 1] = cc2;
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", k40, ispo, c1->w[k40 - 1][ispo - 1].real(), c1->w[k40 - 1][ispo - 1].imag());
- c1->w[i - 1][ispo - 1] = -cc2;
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", i, ispo, c1->w[i - 1][ispo - 1].real(), c1->w[i - 1][ispo - 1].imag());
- c1->w[k40 - 1][ispt - 1] = cc1;
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", k40, ispt, c1->w[k40 - 1][ispt - 1].real(), c1->w[k40 - 1][ispt - 1].imag());
- c1->w[i - 1][ispt - 1] = cc1;
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", i, ispt, c1->w[i - 1][ispt - 1].real(), c1->w[i - 1][ispt - 1].imag());
+ 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) {
@@ -505,16 +500,14 @@ void pwma(
}
}
if (isq != 0) {
- for (int i50 = 1; i50 <= 2; i50++) {
+ for (int i50 = 0; i50 < 2; i50++) {
int ipt = i50 + 2;
int ipis = i50 + is;
- for (int k50 = 1; k50 <= nlwmt; k50++) {
- c1->w[k50 - 1][ipt - 1] = dconjg(c1->w[k50 - 1][ipis - 1]);
- //printf("DEBUG: W( %d , %d) = (%lE,%lE)\n", k50, ipt, c1->w[k50 - 1][ipt - 1].real(), c1->w[k50 - 1][ipt - 1].imag());
+ for (int k50 = 0; k50 < nlwmt; k50++) {
+ c1->w[k50][ipt] = dconjg(c1->w[k50][ipis]);
}
}
}
- //printf("DEBUG: out PWMA W(1,1) = (%lE, %lE)\n", c1->w[0][0].real(), c1->w[0][0].imag());
}
/*! \brief C++ porting of RABAS
@@ -535,56 +528,50 @@ void rabas(
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 = 1; i80 <= nsph; i80++) {
- if(c1->iog[i80 - 1] >= i80) {
- tqse[0][i80 - 1] = 0.0;
- tqse[1][i80 - 1] = 0.0;
- tqspe[0][i80 - 1] = cc0;
- tqspe[1][i80 - 1] = cc0;
- tqss[0][i80 - 1] = 0.0;
- tqss[1][i80 - 1] = 0.0;
- tqsps[0][i80 - 1] = cc0;
- tqsps[1][i80 - 1] = cc0;
- for (int l70 = 1; l70 <= li; l70++) {
- double fl = 1.0 * l70 + l70 + 1;
- std::complex<double> rm = 1.0 / c1->rmi[l70 - 1][i80 - 1];
+ 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 - 1][i80 - 1];
+ 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 - 1] -= pce;
- tqspe[1][i80 - 1] += pce;
- tqsps[0][i80 - 1] -= pcs;
- tqsps[1][i80 - 1] += pcs;
+ 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 - 1] -= ce;
- tqse[1][i80 - 1] += ce;
- tqss[0][i80 - 1] -= cs;
- tqss[1][i80 - 1] += cs;
+ tqse[0][i80] -= ce;
+ tqse[1][i80] += ce;
+ tqss[0][i80] -= cs;
+ tqss[1][i80] += cs;
}
}
if (inpol == 0) {
- tqspe[0][i80 - 1] *= two_pi;
- tqspe[1][i80 - 1] *= two_pi;
- tqsps[0][i80 - 1] *= two_pi;
- tqsps[1][i80 - 1] *= two_pi;
- printf("DEBUG: TQSPE(1, %d ) = ( %lE, %lE)\n", i80, tqspe[0][i80 - 1].real(), tqspe[0][i80 - 1].imag());
- printf("DEBUG: TQSPE(2, %d ) = ( %lE, %lE)\n", i80, tqspe[1][i80 - 1].real(), tqspe[1][i80 - 1].imag());
- printf("DEBUG: TQSPS(1, %d ) = ( %lE, %lE)\n", i80, tqsps[0][i80 - 1].real(), tqsps[0][i80 - 1].imag());
- printf("DEBUG: TQSPS(2, %d ) = ( %lE, %lE)\n", i80, tqsps[1][i80 - 1].real(), tqsps[1][i80 - 1].imag());
+ tqspe[0][i80] *= two_pi;
+ tqspe[1][i80] *= two_pi;
+ tqsps[0][i80] *= two_pi;
+ tqsps[1][i80] *= two_pi;
} else {
- tqse[0][i80 - 1] *= two_pi;
- tqse[1][i80 - 1] *= two_pi;
- tqss[0][i80 - 1] *= two_pi;
- tqss[1][i80 - 1] *= two_pi;
- printf("DEBUG: TQSE(1, %d ) = %lE)\n", i80, tqse[0][i80 - 1]);
- printf("DEBUG: TQSE(2, %d ) = %lE)\n", i80, tqse[1][i80 - 1]);
- printf("DEBUG: TQSS(1, %d ) = %lE)\n", i80, tqss[0][i80 - 1]);
- printf("DEBUG: TQSS(2, %d ) = %lE)\n", i80, tqss[1][i80 - 1]);
+ tqse[0][i80] *= two_pi;
+ tqse[1][i80] *= two_pi;
+ tqss[0][i80] *= two_pi;
+ tqss[1][i80] *= two_pi;
}
}
}
@@ -618,8 +605,8 @@ void rbf(int n, double x, int &nm, double sj[]) {
if (a0 < 0.0) a0 *= -1.0;
nm = n;
if (a0 < 1.0e-60) {
- for (int k = 2; k <= n + 1; k++)
- sj[k - 1] = 0.0;
+ for (int k = 1; k <= n; k++)
+ sj[k] = 0.0;
sj[0] = 1.0;
return;
}
@@ -646,10 +633,8 @@ void rbf(int n, double x, int &nm, double sj[]) {
f1 = f;
}
double cs;
- double abs_sa = sa;
- if (abs_sa < 0.0) abs_sa *= -1.0;
- double abs_sb = sb;
- if (abs_sb < 0.0) abs_sb *= -1.0;
+ 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++) {
@@ -678,7 +663,7 @@ void rkc(
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 = 1; ipnt60 <= npntmo; ipnt60++) {
+ for (int ipnt60 = 0; ipnt60 < npntmo; ipnt60++) {
cy1 = cl / (x * x) - dcc;
cdy1 = -2.0 / x;
c11 = (cy1 * y1 + cdy1 * dy1) * step;
@@ -698,7 +683,7 @@ void rkc(
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;
+ 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;
@@ -728,36 +713,38 @@ void rkt(
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 = 1; ipnt60 <= npntmo; ipnt60++) {
- int jpnt = ipnt60 + ipnt60 - 1;
- cy1 = cl / (x * x) - c2->ris[jpnt - 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[jpntpo - 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[jpntpt - 1];
+ //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[jpnt - 1];
- cdy1 += 2.0 * c2->dlri[jpnt - 1];
+ cy1 -= cdy1 * c2->dlri[jpnt60];
+ cdy1 += 2.0 * c2->dlri[jpnt60];
c21 = (cy1 * y2 + cdy1 * dy2) * step;
- cy23 -= cdy23 * c2->dlri[jpntpo - 1];
- cdy23 += 2.0 * c2->dlri[jpntpo - 1];
+ 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[jpntpt - 1];
- cdy4 += 2.0 * c2->dlri[jpntpt - 1];
+ 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;
@@ -830,23 +817,25 @@ void rnf(int n, double x, int &nm, double sy[]) {
*/
void sscr0(std::complex<double> &tfsas, int nsph, int lm, double vk, double exri, C1 *c1) {
std::complex<double> sum21, rm, re, csam;
- std::complex<double> cc0 = std::complex<double>(0.0, 0.0);
- double exdc = exri * exri;
+ 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 = 1; i12 <= nsph; i12++) {
- int iogi = c1->iog[i12 - 1];
- if (iogi >= i12) {
+ 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 = 1; l10 <= lm; l10++) {
- double fl = 1.0 + l10 + l10;
- rm = 1.0 / c1->rmi[l10 - 1][i12 - 1];
- re = 1.0 / c1->rei[l10 - 1][i12 - 1];
- std::complex<double> rm_cnjg = std::complex<double>(rm.real(), -rm.imag());
- std::complex<double> re_cnjg = std::complex<double>(re.real(), -re.imag());
+ 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;
}
@@ -854,15 +843,14 @@ void sscr0(std::complex<double> &tfsas, int nsph, int lm, double vk, double exri
double scasec = cccs * sums;
double extsec = -cccs * sum21.real();
double abssec = extsec - scasec;
- c1->sscs[i12 - 1] = scasec;
- c1->sexs[i12 - 1] = extsec;
- c1->sabs[i12 - 1] = abssec;
- double gcss = c1-> gcsv[i12 - 1];
- c1->sqscs[i12 - 1] = scasec / gcss;
- c1->sqexs[i12 - 1] = extsec / gcss;
- c1->sqabs[i12 - 1] = abssec / gcss;
- c1->fsas[i12 - 1] = sum21 * csam;
- //printf("DEBUG: FSAS( %d ) = (%lE,%lE)\n", i12, c1->fsas[i12 - 1].real(), c1->fsas[i12 - 1].imag());
+ 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];
}
@@ -878,61 +866,52 @@ void sscr0(std::complex<double> &tfsas, int nsph, int lm, double vk, double exri
*/
void sscr2(int nsph, int lm, double vk, double exri, C1 *c1) {
std::complex<double> s11, s21, s12, s22, rm, re, csam, cc;
- std::complex<double> cc0 = std::complex<double>(0.0, 0.0);
+ 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);
- double pigfsq = 64.0 * acos(0.0) * acos(0.0);
+ const double pigfsq = 64.0 * acos(0.0) * acos(0.0);
double cfsq = 4.0 / (pigfsq * ccs * ccs);
int nlmm = lm * (lm + 2);
- //printf("DEBUG: in SSCR2 W(1,1) = (%lE,%lE)\n", c1->w[0][0].real(), c1->w[0][0].imag());
- for (int i14 = 1; i14 <= nsph; i14++) {
- int iogi = c1->iog[i14 - 1];
- if (iogi >= i14) {
+ 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 = 1; l10 <= lm; l10++) {
- rm = 1.0 / c1->rmi[l10 - 1][i14 - 1];
- re = 1.0 / c1->rei[l10 - 1][i14 - 1];
- //printf("DEBUG: rm = (%lE,%lE)\n", rm.real(), rm.imag());
- //printf("DEBUG: re = (%lE,%lE)\n", re.real(), re.imag());
- int ltpo = l10 + l10 + 1;
- for (int im10 = 1; im10 <= ltpo; im10++) {
+ 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;
- //printf("DEBUG: W( %d, 3) = (%lE,%lE)\n", k, c1->w[k - 1][2].real(), c1->w[k - 1][2].imag());
- //printf("DEBUG: W( %d, 1) = (%lE,%lE)\n", k, c1->w[k - 1][0].real(), c1->w[k - 1][0].imag());
- //printf("DEBUG: W( %d, 3) = (%lE,%lE)\n", ke, c1->w[ke - 1][2].real(), c1->w[ke - 1][2].imag());
- //printf("DEBUG: W( %d, 1) = (%lE,%lE)\n", ke, c1->w[ke - 1][0].real(), c1->w[ke - 1][0].imag());
s11 = s11 - c1->w[k - 1][2] * c1->w[k - 1][0] * rm - c1->w[ke - 1][2] * c1->w[ke - 1][0] * re;
- //printf("DEBUG: W( %d, 4) = (%lE,%lE)\n", k, c1->w[k - 1][3].real(), c1->w[k - 1][3].imag());
- //printf("DEBUG: W( %d, 4) = (%lE,%lE)\n", ke, c1->w[ke - 1][3].real(), c1->w[ke - 1][3].imag());
s21 = s21 - c1->w[k - 1][3] * c1->w[k - 1][0] * rm - c1->w[ke - 1][3] * c1->w[ke - 1][0] * re;
- //printf("DEBUG: W( %d, 2) = (%lE,%lE)\n", k, c1->w[k - 1][1].real(), c1->w[k - 1][1].imag());
- //printf("DEBUG: W( %d, 2) = (%lE,%lE)\n", ke, c1->w[ke - 1][1].real(), c1->w[ke - 1][1].imag());
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 - 1][0][0] = s11 * csam;
- c1->sas[i14 - 1][1][0] = s21 * csam;
- c1->sas[i14 - 1][0][1] = s12 * csam;
- c1->sas[i14 - 1][1][1] = s22 * csam;
+ 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 = 1; i24 <= nsph; i24++) {
- int iogi = c1->iog[i24 - 1];
- if (iogi >= i24) {
+ 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 - 1][jpo1][ipo1]);
+ std::complex<double> cc = dconjg(c1->sas[i24][jpo1][ipo1]);
for (int ipo2 = 0; ipo2 < 2; ipo2++) {
for (int jpo2 = 0; jpo2 < 2; jpo2++) {
- j += 1;
- c1->vints[i24 - 1][j - 1] = c1->sas[i24 - 1][jpo2][ipo2] * cc * cfsq;
+ c1->vints[i24][j++] = c1->sas[i24][jpo2][ipo2] * cc * cfsq;
}
}
}
@@ -954,23 +933,20 @@ void sphar(
double cosrth, double sinrth, double cosrph, double sinrph,
int ll, std::complex<double> *ylm
) {
- double sinrmp[40], cosrmp[40], plegn[861];
+ 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;
- //printf("DEBUG: X = %lE\n", x);
if (y < 0.0) y *= -1.0;
- //printf("DEBUG: Y = %lE\n", y);
double cllmo = 3.0;
double cll = 1.5;
double ytol = y;
plegn[0] = 1.0;
- //printf("DEBUG: PLEGN( %d ) = %lE\n", 1, plegn[0]);
plegn[1] = x * sqrt(cllmo);
- //printf("DEBUG: PLEGN( %d ) = %lE\n", 2, plegn[1]);
plegn[2] = ytol * sqrt(cll);
- //printf("DEBUG: PLEGN( %d ) = %lE\n", 3, plegn[2]);
sinrmp[0] = sinrph;
cosrmp[0] = cosrph;
if (ll >= 2) {
@@ -990,18 +966,15 @@ void sphar(
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);
- //printf("DEBUG: PLEGN( %d ) = %lE\n", mpopk, plegn[mpopk - 1]);
}
int lpk = l20 + k;
double cltpo = 1.0 * ltpo;
plegn[lpk - 1] = plegn[k - 1] * x * sqrt(cltpo);
- //printf("DEBUG: PLEGN( %d ) = %lE\n", lpk, plegn[lpk - 1]);
k = lpk + 1;
double clt = 1.0 * (ltpo - 1);
cll *= (cltpo / clt);
ytol *= y;
plegn[k - 1] = ytol * sqrt(cll);
- //printf("DEBUG: PLEGN( %d ) = %lE\n", k, plegn[k - 1]);
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
@@ -1016,7 +989,6 @@ label40:
l0y = k + 1;
l0p = k / 2 + 1;
ylm[l0y - 1] = pi4irs * plegn[l0p - 1];
- //printf("DEBUG: YLM( %d ) = (%lE,%lE)\n", l0y, ylm[l0y - 1].real(), ylm[l0y - 1].imag());
goto label45;
label44:
lmp = l0p + m;
@@ -1024,10 +996,8 @@ label44:
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;
- //printf("DEBUG: YLM( %d ) = (%lE,%lE)\n", lmy, ylm[lmy - 1].real(), ylm[lmy - 1].imag());
lmy = l0y - m;
ylm[lmy - 1] = save * std::complex<double>(cosrmp[m - 1], -sinrmp[m - 1]);
- //printf("DEBUG: YLM( %d ) = (%lE,%lE)\n", lmy, ylm[lmy - 1].real(), ylm[lmy - 1].imag());
label45:
if (m >= l) goto label47;
m += 1;
@@ -1044,37 +1014,38 @@ label47:
* \param zpv: `double ****`
*/
void thdps(int lm, double ****zpv) {
- // WARNING: unclear nested loop in THDPS
- // The optimized interpretation was adopted here.
- for (int l10 = 1; l10 <= lm; l10++) {
- for (int ilmp = 1; ilmp <= 3; ilmp++) {
- zpv[l10 - 1][ilmp - 1][0][0] = 0.0;
- zpv[l10 - 1][ilmp - 1][0][1] = 0.0;
- zpv[l10 - 1][ilmp - 1][1][0] = 0.0;
- zpv[l10 - 1][ilmp - 1][1][1] = 0.0;
- }
- }
- for (int l15 = 1; l15 <= lm; l15++) {
- double xd = 1.0 * l15 * (l15 + 1);
+ //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][1][0][1] = zp;
- zpv[l15 - 1][1][1][0] = zp;
+ zpv[l15][1][0][1] = zp;
+ zpv[l15][1][1][0] = zp;
}
if (lm != 1) {
- for (int l20 = 2; l20 <= lm; l20++) {
- double xn = 1.0 * (l20 - 1) * (l20 + 1);
- double xd = 1.0 * l20 * (l20 + l20 + 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 - 1][0][0][0] = zp;
- zpv[l20 - 1][0][1][1] = zp;
+ zpv[l20][0][0][0] = zp;
+ zpv[l20][0][1][1] = zp;
}
int lmmo = lm - 1;
- for (int l25 = 1; l25 <= lmmo; l25++) {
- double xn = 1.0 * l25 * (l25 + 2);
- double xd = (l25 + 1) * (l25 + l25 + 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 - 1][2][0][0] = zp;
- zpv[l25 - 1][2][1][1] = zp;
+ zpv[l25][2][0][0] = zp;
+ zpv[l25][2][1][1] = zp;
}
}
}
@@ -1104,10 +1075,6 @@ void upvmp(
sint = sin(th);
cosp = cos(ph);
sinp = sin(ph);
- //printf("DEBUG: cost = %lE\n", cost);
- //printf("DEBUG: sint = %lE\n", sint);
- //printf("DEBUG: cosp = %lE\n", cosp);
- //printf("DEBUG: sinp = %lE\n", sinp);
u[0] = cosp * sint;
u[1] = sinp * sint;
u[2] = cost;
@@ -1156,8 +1123,7 @@ void upvsp(
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;
- if (abs_scand < 0.0) abs_scand *= -1.0;
+ 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;
@@ -1167,8 +1133,7 @@ void upvsp(
duk[1] = u[1] - us[1];
duk[2] = u[2] - us[2];
ibf = 0;
- } else {
- // label 15
+ } else { // label 15
scand = 180.0;
duk[0] = 2.0 * u[0];
duk[1] = 2.0 * u[1];
@@ -1181,8 +1146,7 @@ void upvsp(
uns[1] = -unsmp[1];
uns[2] = -unsmp[2];
}
- } else {
- // label 10
+ } else { // label 10
scand = 0.0;
duk[0] = 0.0;
duk[1] = 0.0;
@@ -1240,8 +1204,9 @@ void wmamp(
int lm, int idot, int nsph, double *arg, double *u, double *up,
double *un, C1 *c1
) {
- std::complex<double> *ylm = new std::complex<double>[1682];
- int nlmp = lm * (lm + 2) + 2;
+ 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) {
@@ -1295,26 +1260,27 @@ void wmasp(
double *ups, double *uns, int isq, int ibf, int inpol, int lm, int idot,
int nsph, double *argi, double *args, C1 *c1
) {
- std::complex<double> *ylm = new std::complex<double>[1682];
- int nlmp = lm * (lm + 2) + 2;
+ 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 = 1; n40 <= nsph; n40++) {
- argi[n40 - 1] = u[0] * c1->rxx[n40 - 1] + u[1] * c1->ryy[n40 - 1] + u[2] * c1->rzz[n40 - 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 - 1] = argi[n40 - 1] * ibf;
+ args[n40] = argi[n40] * ibf;
} else {
- args[n40 - 1] = -1.0 * (us[0] * c1->rxx[n40 - 1] + us[1] * c1->ryy[n40 - 1] + us[2] * c1->rzz[n40 - 1]);
+ 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 = 1; n60 <= nsph; n60++) {
- argi[n60 - 1] = cost * c1->rzz[n60 - 1];
+ for (int n60 = 0; n60 < nsph; n60++) {
+ argi[n60] = cost * c1->rzz[n60];
if (ibf != 0) {
- args[n60 - 1] = argi[n60 - 1] * ibf;
+ args[n60] = argi[n60] * ibf;
} else {
- args[n60 - 1] = -costs * c1->rzz[n60 - 1];
+ args[n60] = -costs * c1->rzz[n60];
}
}
}
@@ -1330,7 +1296,6 @@ void wmasp(
delete[] ylm;
}
-
/*! \brief C++ porting of DME
*
* \param li: `int`
@@ -1349,18 +1314,18 @@ void wmasp(
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) {
- double *rfj = new double[42];
- double *rfn = new double[42];
- std::complex<double> cfj[42], fbi[42], fb[42], fn[42];
- std::complex<double> rmf[40], drmf[40], ref[40], dref[40];
+ 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;
- int lipo = li + 1;
- int lipt = li + 2;
double sz = vk * c1->ros[i - 1];
c2->vsz[i - 1] = sz;
double vkr1 = vk * c1->rc[i - 1][0];
@@ -1408,9 +1373,7 @@ void dme(
}
for (int j43 = 1; j43 <= lipt; j43++) {
fb[j43 - 1] = rfj[j43 - 1];
- //printf("DEBUG: fb[%d] = (%lE,%lE)\n", j43, fb[j43 - 1].real(), fb[j43 - 1].imag());
fn[j43 - 1] = rfn[j43 - 1];
- //printf("DEBUG: fn[%d] = (%lE,%lE)\n", j43, fn[j43 - 1].real(), fn[j43 - 1].imag());
}
if (nsh <= 1) {
cri = c2->dc0[0] / exdc;
diff --git a/src/libnptm/Commons.cpp b/src/libnptm/Commons.cpp
index 809337ea7adb2475af3d0325d3cbd1b139c025d6..6717bac3a03d13b933ff57bcbe46cfc9ae85fd3a 100644
--- a/src/libnptm/Commons.cpp
+++ b/src/libnptm/Commons.cpp
@@ -1,12 +1,23 @@
/*! \file Commons.cpp
*
+ * DEVELOPMENT NOTE:
+ * The construction of common blocks requires some information
+ * that is stored in configuration objects and is needed to compute
+ * the allocation size of vectors and matrices. Currently, this
+ * information is passed as arguments to the constructors of the
+ * common blocks. A simpler and more logical way to operate is
+ * to design the constructors to take as arguments only pointers
+ * to the configuration objects. These, on their turn, need to
+ * expose methods to access the relevant data in read-only mode.
*/
+#ifndef INCLUDE_COMMONS_H
#include "../include/Commons.h"
+#endif
using namespace std;
-C1::C1(int ns, int l_max) {
+C1::C1(int ns, int l_max, int *_nshl, int *_iog) {
nlmmt = 2 * (l_max * (l_max + 2));
nsph = ns;
lm = l_max;
@@ -14,52 +25,58 @@ C1::C1(int ns, int l_max) {
rmi = new complex<double>*[lm];
rei = new complex<double>*[lm];
for (int ri = 0; ri < lm; ri++) {
- rmi[ri] = new complex<double>[nsph];
- rei[ri] = new complex<double>[nsph];
+ rmi[ri] = new complex<double>[nsph]();
+ rei[ri] = new complex<double>[nsph]();
}
w = new complex<double>*[nlmmt];
- for (int wi = 0; wi < nlmmt; wi++) w[wi] = new complex<double>[4];
+ for (int wi = 0; wi < nlmmt; wi++) w[wi] = new complex<double>[4]();
vints = new complex<double>*[nsph];
rc = new double*[nsph];
+ nshl = new int[nsph]();
+ iog = new int[nsph]();
for (int vi = 0; vi < nsph; vi++) {
- rc[vi] = new double[lm];
- vints[vi] = new complex<double>[16];
+ rc[vi] = new double[_nshl[vi]]();
+ vints[vi] = new complex<double>[16]();
+ nshl[vi] = _nshl[vi];
+ iog[vi] = _iog[vi];
}
- fsas = new complex<double>[nsph];
- sscs = new double[nsph];
- sexs = new double[nsph];
- sabs = new double[nsph];
- sqscs = new double[nsph];
- sqexs = new double[nsph];
- sqabs = new double[nsph];
- gcsv = new double[nsph];;
- rxx = new double[nsph];
- ryy = new double[nsph];
- rzz = new double[nsph];
- ros = new double[nsph];
- iog = new int[nsph];
- nshl = new int[nsph];
+ fsas = new complex<double>[nsph]();
+ sscs = new double[nsph]();
+ sexs = new double[nsph]();
+ sabs = new double[nsph]();
+ sqscs = new double[nsph]();
+ sqexs = new double[nsph]();
+ sqabs = new double[nsph]();
+ gcsv = new double[nsph]();
+ rxx = new double[nsph]();
+ ryy = new double[nsph]();
+ rzz = new double[nsph]();
+ ros = new double[nsph]();
sas = new complex<double>**[nsph];
for (int si = 0; si < nsph; si++) {
sas[si] = new complex<double>*[2];
- sas[si][0] = new complex<double>[2];
- sas[si][1] = new complex<double>[2];
+ sas[si][0] = new complex<double>[2]();
+ sas[si][1] = new complex<double>[2]();
}
}
C1::~C1() {
delete[] rmi;
delete[] rei;
- for (int wi = 1; wi <= nlmmt; wi++) delete[] w[wi];
- for (int vi = 1; vi <= nsph; vi++) {
- delete[] rc[nsph - vi];
- delete[] vints[nsph - vi];
+ for (int wi = nlmmt - 1; wi > -1; wi--) delete[] w[wi];
+ for (int vi = nsph - 1; vi > - 1; vi--) {
+ delete[] rc[vi];
+ delete[] vints[vi];
}
- for (int si = 1; si <= nsph; si++) {
- delete[] sas[nsph - si][1];
- delete[] sas[nsph - si][0];
+ delete[] rc;
+ delete[] vints;
+ for (int si = nsph - 1; si > -1; si--) {
+ delete[] sas[si][1];
+ delete[] sas[si][0];
+ delete[] sas[si];
}
+ delete[] sas;
delete[] fsas;
delete[] sscs;
delete[] sexs;
@@ -76,15 +93,104 @@ C1::~C1() {
delete[] nshl;
}
+C1_AddOns::C1_AddOns(C4 *c4) {
+ nsph = c4->nsph;
+ lmpo = c4->lmpo;
+ nlemt = 2 * c4->nlem;
+ vh = new complex<double>[(nsph * nsph - 1) * c4->litpo]();
+ vj0 = new complex<double>[nsph * c4->lmtpo]();
+ vj = new complex<double>[1](); // QUESTION: is 1 really enough for a general case?
+ vyhj = new complex<double>[(nsph * nsph - 1) * c4->litpos]();
+ vyj0 = new complex<double>[nsph * c4->lmtpos]();
+ am0m = new complex<double>*[nlemt];
+ for (int ai = 0; ai < nlemt; ai++) {
+ am0m[ai] = new complex<double>[nlemt]();
+ }
+ vint = new complex<double>[16](); // QUESTION: is dimension 16 generally fixed?
+ vintm = new complex<double>[16]();
+ vintt = new complex<double>[16]();
+ vints = new complex<double>*[nsph];
+ for (int vi = 0; vi < nsph; vi++) vints[vi] = new complex<double>[16]();
+ fsac = new complex<double>*[2];
+ sac = new complex<double>*[2];
+ fsacm = new complex<double>*[2];
+ for (int fi = 0; fi < 2; fi++) {
+ fsac[fi] = new complex<double>[2]();
+ sac[fi] = new complex<double>[2]();
+ fsacm[fi] = new complex<double>[2]();
+ }
+ scscp = new complex<double>[2]();
+ ecscp = new complex<double>[2]();
+ scscpm = new complex<double>[2]();
+ ecscpm = new complex<double>[2]();
+ allocate_vectors(c4);
+ sscs = new double[nsph]();
+ ecscm = new double[2]();
+ scscm = new double[2]();
+ scsc = new double[2]();
+ ecsc = new double[2]();
+}
+
+C1_AddOns::~C1_AddOns() {
+ delete[] sscs;
+ delete[] vyj0;
+ delete[] vyhj;
+ for (int ii = lmpo - 1; ii > -1; ii--) delete[] ind3j[ii];
+ delete[] ind3j;
+ delete[] v3j0;
+ delete[] vh;
+ delete[] vj0;
+ for (int ai = nlemt - 1; ai > -1; ai--) {
+ delete[] am0m[ai];
+ }
+ delete am0m;
+ delete[] vint;
+ delete[] vintm;
+ delete[] vintt;
+ for (int vi = nsph - 1; vi > -1; vi--) delete[] vints[vi];
+ delete[] vints;
+ for (int fi = 1; fi > -1; fi--) {
+ delete[] fsac[fi];
+ delete[] sac[fi];
+ delete[] fsacm[fi];
+ }
+ delete[] fsac;
+ delete[] sac;
+ delete[] fsacm;
+ delete[] scscp;
+ delete[] ecscp;
+ delete[] scscpm;
+ delete[] ecscpm;
+ delete[] ecscm;
+ delete[] scscm;
+ delete[] scsc;
+ delete[] ecsc;
+}
+
+void C1_AddOns::allocate_vectors(C4 *c4) {
+ // This calculates the size of v3j0
+ int lm = (c4->li > c4->le) ? c4->li : c4->le;
+ const int nv3j = c4->nv3j;
+ v3j0 = new double[nv3j]();
+ ind3j = new int*[lmpo];
+ for (int ii = 0; ii < lmpo; ii++) ind3j[ii] = new int[c4->lm]();
+ // This calculates the size of vyhj
+ int ivy = (nsph * nsph - 1) * c4->litpos;
+ vyhj = new complex<double>[ivy]();
+ // This calculates the size of vyj0
+ ivy = c4->lmtpos * c4->nsph;
+ vyj0 = new complex<double>[ivy]();
+}
+
C2::C2(int ns, int nl, int npnt, int npntts) {
nsph = ns;
int max_n = (npnt > npntts) ? npnt : npntts;
nhspo = 2 * max_n - 1;
- ris = new complex<double>[nhspo];
- dlri = new complex<double>[nhspo];
- vkt = new complex<double>[nsph];
- dc0 = new complex<double>[nl];
- vsz = new double[nsph];
+ ris = new complex<double>[nhspo]();
+ dlri = new complex<double>[nhspo]();
+ vkt = new complex<double>[nsph]();
+ dc0 = new complex<double>[nl]();
+ vsz = new double[nsph]();
}
C2::~C2() {
@@ -94,3 +200,52 @@ C2::~C2() {
delete[] dc0;
delete[] vsz;
}
+
+C3::C3() {
+ tsas = new complex<double>*[2];
+ tsas[0] = new complex<double>[2];
+ tsas[1] = new complex<double>[2];
+ tfsas = complex<double>(0.0, 0.0);
+ gcs = 0.0;
+ scs = 0.0;
+ ecs = 0.0;
+ acs = 0.0;
+}
+
+C3::~C3() {
+ delete[] tsas[1];
+ delete[] tsas[0];
+ delete[] tsas;
+}
+
+C6::C6(int lmtpo) {
+ rac3j = new double[lmtpo]();
+}
+
+C6::~C6() {
+ delete[] rac3j;
+}
+
+C9::C9(int ndi, int nlem, int ndit, int nlemt) {
+ gis = new complex<double>*[ndi];
+ gls = new complex<double>*[ndi];
+ for (int gi = 0; gi < ndi; gi++) {
+ gis[gi] = new complex<double>[nlem]();
+ gls[gi] = new complex<double>[nlem]();
+ }
+ sam = new complex<double>*[ndit];
+ for (int si = 0; si < ndit; si++) sam[si] = new complex<double>[nlemt]();
+ gis_size_0 = ndi;
+ sam_size_0 = ndit;
+}
+
+C9::~C9() {
+ for (int gi = gis_size_0 - 1; gi > -1; gi--) {
+ delete[] gis[gi];
+ delete[] gls[gi];
+ }
+ delete[] gis;
+ delete[] gls;
+ for (int si = sam_size_0 - 1; si > -1; si--) delete[] sam[si];
+ delete[] sam;
+}
diff --git a/src/libnptm/Configuration.cpp b/src/libnptm/Configuration.cpp
index 6bb02bddd092ed30b02aebf2ef88b0e3f524645a..2e9a81fca5c369e2c5793c1cb30a99e30f13cfa9 100644
--- a/src/libnptm/Configuration.cpp
+++ b/src/libnptm/Configuration.cpp
@@ -12,7 +12,8 @@
using namespace std;
GeometryConfiguration::GeometryConfiguration(
- int nsph, int lm, int _in_pol, int _npnt, int _npntts, int isam,
+ int _nsph, int _lm, int _in_pol, int _npnt, int _npntts, int _isam,
+ int _li, int _le, int _mxndm, int _iavm,
double *x, double *y, double *z,
double in_th_start, double in_th_step, double in_th_end,
double sc_th_start, double sc_th_step, double sc_th_end,
@@ -20,12 +21,16 @@ GeometryConfiguration::GeometryConfiguration(
double sc_ph_start, double sc_ph_step, double sc_ph_end,
int _jwtm
) {
- number_of_spheres = nsph;
- l_max = lm;
+ number_of_spheres = _nsph;
+ l_max = _lm;
in_pol = _in_pol;
npnt = _npnt;
npntts = _npntts;
- meridional_type = isam;
+ meridional_type = _isam;
+ li = _li;
+ le = _le;
+ mxndm = _mxndm;
+ iavm = _iavm;
in_theta_start = in_th_start;
in_theta_step = in_th_step;
in_theta_end = in_th_end;
@@ -59,22 +64,32 @@ GeometryConfiguration* GeometryConfiguration::from_legacy(string file_name) {
} catch (exception &ex) {
throw OpenConfigurationFileException(file_name);
}
- int nsph, lm, _in_pol, _npnt, _npntts, isam;
- sscanf(
- file_lines[last_read_line++].c_str(),
- " %d %d %d %d %d %d",
- &nsph, &lm, &_in_pol, &_npnt, &_npntts, &isam
- );
+ int _nsph = 0, _lm = 0, _in_pol = 0, _npnt = 0, _npntts = 0, _isam = 0;
+ int _li = 0, _le = 0, _mxndm = 0, _iavm = 0;
+ sscanf(file_lines[last_read_line].c_str(), " %d", &_nsph);
+ if (_nsph == 1) {
+ sscanf(
+ file_lines[last_read_line++].c_str(),
+ " %*d %d %d %d %d %d",
+ &_lm, &_in_pol, &_npnt, &_npntts, &_isam
+ );
+ } else {
+ sscanf(
+ file_lines[last_read_line++].c_str(),
+ " %*d %d %d %d %d %d %d %d %d",
+ &_li, &_le, &_mxndm, &_in_pol, &_npnt, &_npntts, &_iavm, &_isam
+ );
+ }
double *x, *y, *z;
- x = new double[nsph];
- y = new double[nsph];
- z = new double[nsph];
- if (nsph == 1) {
+ x = new double[_nsph];
+ y = new double[_nsph];
+ z = new double[_nsph];
+ if (_nsph == 1) {
x[0] = 0.0;
y[0] = 0.0;
z[0] = 0.0;
} else {
- for (int i = 0; i < nsph; i++) {
+ for (int i = 0; i < _nsph; i++) {
double sph_x, sph_y, sph_z;
int sph_x_exp, sph_y_exp, sph_z_exp;
sscanf(
@@ -126,7 +141,8 @@ GeometryConfiguration* GeometryConfiguration::from_legacy(string file_name) {
int _jwtm;
sscanf(file_lines[last_read_line++].c_str(), " %d", &_jwtm);
GeometryConfiguration *conf = new GeometryConfiguration(
- nsph, lm, _in_pol, _npnt, _npntts, isam,
+ _nsph, _lm, _in_pol, _npnt, _npntts, _isam,
+ _li, _le, _mxndm, _iavm,
x, y, z,
in_th_start, in_th_step, in_th_end,
sc_th_start, sc_th_step, sc_th_end,
diff --git a/src/scripts/README.md b/src/scripts/README.md
new file mode 100644
index 0000000000000000000000000000000000000000..b3babd3ee6565b67d29874a8ed52d2cbaf8ef24e
--- /dev/null
+++ b/src/scripts/README.md
@@ -0,0 +1,28 @@
+# Folder instructions
+
+This directory contains scripts and tools to evaluate the code functionality.
+
+## Instructions
+
+The code migration stage can be considered successfully fulfilled with the solution of the single sphere and of the cluster of spheres cases in C++. To test the reliability of the code, the C++ version needs to produce consistent output with respect to the original FORTRAN code. Since the output files are generally too large for manual inspection and they can be affected by different approximations or numeric noise, a series of scripts designed to compare the two versions and to pin-point possible differences is provided in this folder. The scripts are written in *python*, therefore they need an available *python* environment to work.
+
+## Comparing the results of FORTRAN and C++ codes
+
+1. Follow the instructions to build and run the FORTRAN and C++ versions of the code.
+2. Run the `pycompare.py` script providing the following minimal arguments:
+
+ > $PATH_TO_SCRIPT/pycompare.py --ffile=FORTRAN_OUTPUT --cfile=C++_OUTPUT
+
+(The above assumes that `PATH_TO_SCRIPT` is a variable that expands to the path were the script is located). The required output files are called by default `OSPH` and `OCLU` by FORTRAN and `c_OSPH` and `c_OCLU` by C++, depending on whether the sphere or the cluster case was executed.
+
+3. Check the output of the script to verify that it detects 0 errors and finishes in a `SUCCESS` state.
+4. In case of need, add the `--html` argument to produce an *HTML* log showing the possible differences and a classification of their severity.
+5. Issuing:
+
+ > $PATH_TO_SCRIPT/pycompare.py --help
+
+or just:
+
+ > $PATH_TO_SCRIPT/pycompare.py
+
+will print a help screen, giving a brief explanation of all the possible options.
\ No newline at end of file
diff --git a/src/scripts/pycompare.py b/src/scripts/pycompare.py
new file mode 100755
index 0000000000000000000000000000000000000000..04224c0823457747bfd41ae48e546ce67afa5e96
--- /dev/null
+++ b/src/scripts/pycompare.py
@@ -0,0 +1,285 @@
+#!/bin/python
+
+## @package pycompare
+# Script to perform output consistency tests
+#
+# Comparing the numeric output can be rendered hard by the amount of information
+# contained in a typical output file and the necessity to determine whether a
+# difference is actually significant or just caused by numeric noise hitting
+# negligible values. The task of this script is to compare two output files, in
+# the assumption that they were written by the FORTRAN and the C++ versions of
+# the code and to flag all the possible inconsistencies according to various
+# severity levels (namely: NOISE, WARNING, and ERROR).
+
+import re
+
+from math import log10
+from sys import argv
+
+## \cond
+number_reg = re.compile(r'-?[0-9]\.[0-9]+E[-+][0-9]{2,2}')
+## \endcond
+
+## \brief Main execution code
+#
+# `main()` is the function that handles the creation of the script configuration
+# and the execution of the comparison. It returns an integer value corresponding
+# to the number of detected error-level inconsistencies.
+#
+# \returns errors: `int` Number of detected error-level inconsistencies.
+def main():
+ config = parse_arguments()
+ errors, warnings, noisy = (0, 0, 0)
+ if config['help_mode'] or len(argv) == 1:
+ config['help_mode'] = True
+ print_help()
+ else:
+ compare_log = compare_files(config)
+ errors = compare_log['errors']
+ warnings = compare_log['warnings']
+ noisy = compare_log['noisy']
+ print("ERROR COUNT: %d"%errors)
+ print("WARNING COUNT: %d"%warnings)
+ print("NOISE COUNT: %d"%noisy)
+ if (errors > 0):
+ print("FAILURE: {0:s} is not consistent with {1:s}".format(
+ config['c_file_name'], config['fortran_file_name']
+ ))
+ else:
+ if (not config['help_mode']):
+ print("SUCCESS: {0:s} is consistent with {1:s}".format(
+ config['c_file_name'], config['fortran_file_name']
+ ))
+ return errors
+
+## \brief Perform the comparison of two files.
+def compare_files(config):
+ mismatch_count = {
+ 'errors': 0,
+ 'warnings': 0,
+ 'noisy': 0,
+ }
+ fortran_file = open(config['fortran_file_name'], 'r')
+ c_file = open(config['c_file_name'], 'r')
+ l_file = None
+ f_lines = fortran_file.readlines()
+ c_lines = c_file.readlines()
+ fortran_file.close()
+ c_file.close()
+ if (len(f_lines) == len(c_lines)):
+ line_count = len(f_lines)
+ num_len = 1
+ if (line_count > 0):
+ num_len = int(log10(line_count)) + 1
+ if (config['log_html']):
+ l_file = open(config['html_output'], 'w')
+ l_file.write("<!DOCTYPE html>\n")
+ l_file.write("<html xmnls=\"http://www.w3.org/1999/xhtml\">\n")
+ l_file.write(" <header>\n")
+ l_file.write(
+ " <h1>Comparison between {0:s} and {1:s}</h1>\n".format(
+ config['fortran_file_name'], config['c_file_name']
+ )
+ )
+ l_file.write(" </header>\n")
+ l_file.write(" <body>\n")
+ l_file.write(" <div>Numeric noise is marked <span style=\"font-weight: bold; color: rgb(0,255,0)\">"
+ + "GREEN</span>, warnings are marked <span style=\"font-weight: bold; color: rgb(0,0,255)\">"
+ + "BLUE</span> and errors are marked <span style=\"font-weight: bold; color: rgb(255,0,0)\">"
+ + "RED</span>.</div>\n")
+ for li in range(line_count):
+ line_result = compare_lines(f_lines[li], c_lines[li], config, li + 1, num_len, l_file)
+ mismatch_count['errors'] += line_result[0]
+ mismatch_count['warnings'] += line_result[1]
+ mismatch_count['noisy'] += line_result[2]
+ if (mismatch_count['errors'] > 0 and not config['check_all']):
+ print("INFO: mismatch found at line %d"%(li + 1))
+ break
+ if l_file is not None:
+ l_file.write(" </body>\n")
+ l_file.write("</html>\n")
+ l_file.close()
+ else:
+ mismatch_count['errors'] = len(c_lines)
+ print("ERROR: {0:s} and {1:s} have different numbers of lines!".format(
+ config['fortran_file_name'], config['c_file_name']
+ ))
+ return mismatch_count
+
+## \brief Perform the comparison of two file lines.
+def compare_lines(f_line, c_line, config, line_num=0, num_len=1, log_file=None):
+ errors = 0
+ warnings = 0
+ noisy = 0
+ f_line = f_line.replace("D-","E-").replace("D+","E+")
+ if (f_line == c_line):
+ if log_file is not None:
+ num_format = " <div><pre><code>{0:0%dd}"%num_len
+ log_line = (num_format + ": {1:s}</code></pre></div>\n").format(line_num, c_line[:-1])
+ log_file.write(log_line)
+ else:
+ iter_f_values = number_reg.finditer(f_line)
+ iter_c_values = number_reg.finditer(c_line)
+ f_starts, f_ends, f_groups = [], [], []
+ c_starts, c_ends, c_groups = [], [], []
+ for fi in iter_f_values:
+ f_starts.append(fi.start())
+ f_ends.append(fi.end())
+ f_groups.append(fi.group())
+ for ci in iter_c_values:
+ c_starts.append(ci.start())
+ c_ends.append(ci.end())
+ c_groups.append(ci.group())
+ severities = mismatch_severities(f_groups, c_groups, config)
+ if log_file is not None:
+ num_format = " <div><pre><code>{0:0%dd}"%num_len
+ log_line = (num_format + ": ").format(line_num)
+ log_line = log_line + c_line[0:c_starts[0]]
+ for si in range(len(severities) - 1):
+ if (severities[si] == 1): noisy += 1
+ elif (severities[si] == 2): warnings += 1
+ elif (severities[si] == 3): errors += 1
+ if log_file is not None:
+ if (severities[si] == 0):
+ log_line = log_line + c_groups[si] + c_line[c_ends[si]:c_starts[si + 1]]
+ elif (severities[si] == 1):
+ log_line = (
+ log_line + "</code><span style=\"font-weight: bold; color: rgb(0,255,0)\"><code>"
+ + c_groups[si] + "</code></span><code>" + c_line[c_ends[si]:c_starts[si + 1]]
+ )
+ elif (severities[si] == 2):
+ log_line = (
+ log_line + "</code><span style=\"font-weight: bold; color: rgb(0,0,255)\"><code>"
+ + c_groups[si] + "</code></span><code>" + c_line[c_ends[si]:c_starts[si + 1]]
+ )
+ elif (severities[si] == 3):
+ log_line = (
+ log_line + "</code><span style=\"font-weight: bold; color: rgb(255,0,0)\"><code>"
+ + c_groups[si] + "</code></span><code>" + c_line[c_ends[si]:c_starts[si + 1]]
+ )
+ if (severities[-1] == 1): noisy += 1
+ elif (severities[-1] == 2): warnings += 1
+ elif (severities[-1] == 3): errors += 1
+ if log_file is not None:
+ if (severities[-1] == 0):
+ log_line = (
+ log_line + c_groups[-1] + c_line[c_ends[-1]:len(c_line) - 2]
+ )
+ elif (severities[-1] == 1):
+ log_line = (
+ log_line + "</code><span style=\"font-weight: bold; color: rgb(0,255,0)\"><code>"
+ + c_groups[-1] + "</code></span><code>" + c_line[c_ends[-1]:len(c_line) - 2]
+ )
+ elif (severities[-1] == 2):
+ log_line = (
+ log_line + "</code><span style=\"font-weight: bold; color: rgb(0,0,255)\"><code>"
+ + c_groups[-1] + "</code></span><code>" + c_line[c_ends[-1]:len(c_line) - 2]
+ )
+ elif (severities[-1] == 3):
+ log_line = (
+ log_line + "</code><span style=\"font-weight: bold; color: rgb(255,0,0)\"><code>"
+ + c_groups[-1] + "</code></span><code>" + c_line[c_ends[-1]:len(c_line) - 2]
+ )
+ log_file.write(log_line + "</code></pre></div>\n")
+ return (errors, warnings, noisy)
+
+## \brief Determine the severity of a numerical mismatch.
+#
+# The severity scale is currently designed with the following integer codes:
+# 0 - the values are equal
+# 1 - the values are subject to suspect numerical noise (green fonts)
+# 2 - the values are different but below error threshold (blue fonts)
+# 3 - the values differ more than error threshold (red fonts)
+#
+# \param str_f_values: `array(string)` The strings representing the numeric
+# values read from the FORTRAN output file.
+# \param str_c_values: `array(string)` The strings representing the numeric
+# values read from the C++ output file.
+# \param config: `dict` A dictionary containing the configuration options from
+# which to read the warning and the error threshold.
+def mismatch_severities(str_f_values, str_c_values, config):
+ result = [0 for ri in range(len(str_f_values))]
+ for i in range(len(str_f_values)):
+ if (str_f_values[i] != str_c_values[i]):
+ f_values = [float(str_f_values[j]) for j in range(len(str_f_values))]
+ c_values = [float(str_c_values[j]) for j in range(len(str_c_values))]
+ f_log_values = [0.0 for j in range(len(f_values))]
+ c_log_values = [0.0 for j in range(len(c_values))]
+ max_f_log = -1.0e12
+ max_c_log = -1.0e12
+ for j in range(len(f_values)) :
+ if f_values[j] < 0.0: f_values[j] *= -1.0
+ if c_values[j] < 0.0: c_values[j] *= -1.0
+ f_log_values[j] = log10(f_values[j]) if f_values[j] > 0.0 else -999
+ c_log_values[j] = log10(c_values[j]) if c_values[j] > 0.0 else -999
+ if (f_log_values[j] > max_f_log): max_f_log = f_log_values[j]
+ if (c_log_values[j] > max_c_log): max_c_log = f_log_values[j]
+ if (c_log_values[i] < max_c_log - 5.0 and f_log_values[i] < max_f_log - 5.0):
+ result[i] = 1
+ else:
+ difference = c_values[i] - f_values[i]
+ fractional = 1.0
+ if (f_values[i] != 0.0):
+ fractional = difference / f_values[i]
+ if (fractional < 0.0): fractional *= -1.0
+ if (fractional < config['warning_threshold']): result[i] = 2
+ else: result[i] = 3
+ return result
+
+## \brief Parse the command line arguments.
+def parse_arguments():
+ config = {
+ 'fortran_file_name': '',
+ 'c_file_name': '',
+ 'log_html': False,
+ 'html_output': 'pycompare.html',
+ 'warning_threshold': 0.005,
+ 'help_mode': False,
+ 'check_all': True,
+ }
+ for arg in argv[1:]:
+ split_arg = arg.split("=")
+ if (arg.startswith("--ffile")):
+ config['fortran_file_name'] = split_arg[1]
+ elif (arg.startswith("--cfile")):
+ config['c_file_name'] = split_arg[1]
+ elif (arg.startswith("--html")):
+ config['log_html'] = True
+ elif (arg.startswith("--logname")):
+ config['html_output'] = split_arg[1]
+ elif (arg.startswith("--warn")):
+ config['warning_threshold'] = float(split_arg[1])
+ elif (arg.startswith("--help")):
+ config['help_mode'] = True
+ elif (arg.startswith("--quick")):
+ config['check_all'] = False
+ else:
+ raise Exception("Unrecognized argument \'{0:s}\'".format(arg))
+ return config
+
+## \brief Print a command-line help summary.
+def print_help():
+ print(" ")
+ print("*** PYCOMPARE ***")
+ print(" ")
+ print("Compare the output of C++ and FORTRAN codes.")
+ print(" ")
+ print("Usage: \"./pycompare.py OPTIONS\" ")
+ print(" ")
+ print("Valid options are: ")
+ print("--ffile=FORTRAN_OUTPUT File containing the output of the FORTRAN code (mandatory).")
+ print("--cfile=C++_OUTPUT File containing the output of the C++ code (mandatory).")
+ print("--help Print this help and exit.")
+ print("--html Enable logging to HTML file.")
+ print("--logname Name of the HTML log file (default is \"pycompare.html\").")
+ print("--quick Stop on first mismatch (default is to perform a full check).")
+ print("--warn Set a fractional threshold for numeric warning (default=0.005).")
+ print(" ")
+
+
+# ### PROGRAM EXECUTION ###
+## \cond
+res = main()
+## \endcond
+if (res > 0): exit(1)
+exit(0)
diff --git a/src/sphere/Makefile b/src/sphere/Makefile
index c42d9b04f701cfb823a0c443581c96c23207d920..7c616b7ca9368a4e27bfaf3d2b486d08a88dfafb 100644
--- a/src/sphere/Makefile
+++ b/src/sphere/Makefile
@@ -18,7 +18,7 @@ np_sphere: $(BUILDDIR)/np_sphere.o $(BUILDDIR)/Commons.o $(BUILDDIR)/Configurati
$(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
+ $(CXX) $(CXXFLAGS) -c np_sphere.cpp -o $(BUILDDIR)/np_sphere.o
$(BUILDDIR)/Commons.o:
$(CXX) $(CXXFLAGS) -c ../libnptm/Commons.cpp -o $(BUILDDIR)/Commons.o
diff --git a/src/sphere/edfb.cpp b/src/sphere/edfb.cpp
deleted file mode 100644
index 5858e70f6498008286a2b409c53698da4dcf604b..0000000000000000000000000000000000000000
--- a/src/sphere/edfb.cpp
+++ /dev/null
@@ -1,495 +0,0 @@
-/*! \file edfb.cpp
- */
-
-#include <cstdio>
-#include <cmath>
-#include <complex>
-#include <cstring>
-#include <iostream>
-#include <fstream>
-#include "../include/file_io.h"
-#include "../include/List.h"
-
-using namespace std;
-
-/*! \brief Load a text file as a sequence of strings in memory.
- *
- * The configuration of the field expansion code in FORTRAN uses
- * shared memory access and file I/O operations managed by different
- * functions. Although this approach could be theoretically replicated,
- * it is more convenient to handle input and output to distinct files
- * using specific functions. load_file() helps in the task of handling
- * input such as configuration files or text data structures that need
- * to be loaded entirely. The function performs a line-by line scan of
- * the input file and returns an array of strings that can be later
- * parsed and ingested by the concerned code blocks. An optional pointer
- * to integer allows the function to keep track of the number of file
- * lines that were read, if needed.
- *
- * \param file_name: `string` The path of the file to be read.
- * \param count: `int*` Pointer to an integer recording the number of
- * read lines [OPTIONAL, default=NULL].
- * \return array_lines `string*` An array of strings, one for each input
- * file line.
- */
-string *load_file(string file_name, int *count);
-
-/*! \brief C++ implementation of EDFB
- *
- * This code aims at replicating the original work-flow in C++.
- */
-int main(int argc, char **argv) {
- // Common variables set
- complex<double> *dc0, ***dc0m;
- double *ros, **rcf;
- int *iog, *nshl;
- double *xiv, *wns, *wls, *pus, *evs, *vss;
- string vns[5];
-
- int ici;
-
- // Input file reading section
- int num_lines = 0;
- int last_read_line = 0; // Keep track of where the input stream was left
- string *file_lines = load_file("../../test_data/sphere/DEDFB", &num_lines);
-
- // Configuration code
- int nsph, ies;
- sscanf(file_lines[last_read_line].c_str(), " %d %d", &nsph, &ies);
- if (ies != 0) ies = 1;
- double exdc, wp, xip;
- int exdc_exp, wp_exp, xip_exp;
- int idfc, nxi, instpc, insn;
- int nsh;
- sscanf(
- file_lines[++last_read_line].c_str(),
- " %9lf D%d %9lf D%d %8lf D%d %d %d %d %d",
- &exdc, &exdc_exp,
- &wp, &wp_exp,
- &xip, &xip_exp,
- &idfc, &nxi, &instpc, &insn
- );
- exdc *= pow(10.0, exdc_exp);
- wp *= pow(10.0, wp_exp);
- xip *= pow(10.0, xip_exp);
-
- FILE *output = fopen("c_OEDFB", "w");
- // FORTRAN starts subroutine INXI at this point
- const double pigt = acos(0.0) * 4.0;
- const double evc = 6.5821188e-16;
- if (idfc >= 0) {
- // Not walked by default input data
- // This part of the code in not tested
- vss = new double[nxi];
- xiv = new double[nxi];
- pus = new double[nxi];
- evs = new double[nxi];
- wns = new double[nxi];
- wls = new double[nxi];
- if (instpc == 0) { // The variable vector is explicitly defined
- double vs;
- int vs_exp;
- for (int jxi_r = 0; jxi_r < nxi; jxi_r++) {
- sscanf(file_lines[++last_read_line].c_str(), " %lf D%d", &vs, &vs_exp);
- vs *= pow(10.0, vs_exp);
- vss[jxi_r] = vs;
- }
- switch (insn) {
- case 1: //xi vector definition
- vns[insn - 1] = "XIV";
- fprintf(output, " JXI XIV WNS WLS PUS EVS\n");
- for (int jxi210w = 0; jxi210w < nxi; jxi210w++) {
- xiv[jxi210w] = vss[jxi210w];
- pus[jxi210w] = xiv[jxi210w] * wp;
- evs[jxi210w] = pus[jxi210w] * evc;
- wns[jxi210w] = pus[jxi210w] / 3.0e8;
- wls[jxi210w] = pigt / wns[jxi210w];
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi210w + 1),
- xiv[jxi210w],
- wns[jxi210w],
- wls[jxi210w],
- pus[jxi210w],
- evs[jxi210w]
- );
- }
- break;
- case 2: //wave number vector definition
- vns[insn - 1] = "WNS";
- fprintf(output, " JXI WNS WLS PUS EVS XIV\n");
- for (int jxi230w = 0; jxi230w < nxi; jxi230w++) {
- wns[jxi230w] = vss[jxi230w];
- wls[jxi230w] = pigt / wns[jxi230w];
- xiv[jxi230w] = 3.0e8 * wns[jxi230w] / wp;
- pus[jxi230w] = xiv[jxi230w] * wp;
- evs[jxi230w] = pus[jxi230w] * evc;
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi230w + 1),
- wns[jxi230w],
- wls[jxi230w],
- pus[jxi230w],
- evs[jxi230w],
- xiv[jxi230w]
- );
- }
- break;
- case 3: //wavelength vector definition
- vns[insn - 1] = "WLS";
- fprintf(output, " JXI WLS WNS PUS EVS XIV\n");
- for (int jxi250w = 0; jxi250w < nxi; jxi250w++) {
- wls[jxi250w] = vss[jxi250w];
- wns[jxi250w] = pigt / wls[jxi250w];
- xiv[jxi250w] = 3.0e8 * wns[jxi250w] / wp;
- pus[jxi250w] = xiv[jxi250w] * wp;
- evs[jxi250w] = pus[jxi250w] * evc;
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi250w + 1),
- wls[jxi250w],
- wns[jxi250w],
- pus[jxi250w],
- evs[jxi250w],
- xiv[jxi250w]
- );
- }
- break;
- case 4: //pu vector definition
- vns[insn - 1] = "PUS";
- fprintf(output, " JXI PUS WNS WLS EVS XIV\n");
- for (int jxi270w = 0; jxi270w < nxi; jxi270w++) {
- pus[jxi270w] = vss[jxi270w];
- xiv[jxi270w] = pus[jxi270w] / wp;
- wns[jxi270w] = pus[jxi270w] / 3.0e8;
- wls[jxi270w] = pigt / wns[jxi270w];
- evs[jxi270w] = pus[jxi270w] * evc;
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi270w + 1),
- pus[jxi270w],
- wns[jxi270w],
- wls[jxi270w],
- evs[jxi270w],
- xiv[jxi270w]
- );
- }
- break;
- case 5: //eV vector definition
- vns[insn - 1] = "EVS";
- fprintf(output, " JXI EVS WNS WLS PUS XIV\n");
- for (int jxi290w = 0; jxi290w < nxi; jxi290w++) {
- evs[jxi290w] = vss[jxi290w];
- pus[jxi290w] = evs[jxi290w] / evc;
- xiv[jxi290w] = pus[jxi290w] / wp;
- wns[jxi290w] = pus[jxi290w] / 3.0e8;
- wls[jxi290w] = pigt / wns[jxi290w];
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi290w + 1),
- evs[jxi290w],
- wns[jxi290w],
- wls[jxi290w],
- pus[jxi290w],
- xiv[jxi290w]
- );
- }
- break;
- }
- } else { // The variable vector needs to be computed in steps
- double vs, vs_step;
- int vs_exp, vs_step_exp;
- sscanf(file_lines[++last_read_line].c_str(), " %lf D%d %lf D%d", &vs, &vs_exp, &vs_step, &vs_step_exp);
- vs *= pow(10.0, vs_exp);
- vs_step *= pow(10.0, vs_step_exp);
- switch (insn) {
- case 1: //xi vector definition
- vns[insn - 1] = "XIV";
- fprintf(output, " JXI XIV WNS WLS PUS EVS\n");
- for (int jxi110w = 0; jxi110w < nxi; jxi110w++) {
- vss[jxi110w] = vs;
- xiv[jxi110w] = vss[jxi110w];
- pus[jxi110w] = xiv[jxi110w] * wp;
- wns[jxi110w] = pus[jxi110w] / 3.0e8;
- evs[jxi110w] = pus[jxi110w] * evc;
- wls[jxi110w] = pigt / wns[jxi110w];
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi110w + 1),
- xiv[jxi110w],
- wns[jxi110w],
- wls[jxi110w],
- pus[jxi110w],
- evs[jxi110w]
- );
- vs += vs_step;
- }
- break;
- case 2: //wave number vector definition
- vns[insn - 1] = "WNS";
- fprintf(output, " JXI WNS WLS PUS EVS XIV\n");
- for (int jxi130w = 0; jxi130w < nxi; jxi130w++) {
- vss[jxi130w] = vs;
- wns[jxi130w] = vss[jxi130w];
- xiv[jxi130w] = 3.0e8 * wns[jxi130w] / wp;
- pus[jxi130w] = xiv[jxi130w] * wp;
- wls[jxi130w] = pigt / wns[jxi130w];
- evs[jxi130w] = pus[jxi130w] * evc;
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi130w + 1),
- wns[jxi130w],
- wls[jxi130w],
- pus[jxi130w],
- evs[jxi130w],
- xiv[jxi130w]
- );
- vs += vs_step;
- }
- break;
- case 3: //wavelength vector definition
- vns[insn - 1] = "WLS";
- fprintf(output, " JXI WLS WNS PUS EVS XIV\n");
- for (int jxi150w = 0; jxi150w < nxi; jxi150w++) {
- vss[jxi150w] = vs;
- wls[jxi150w] = vss[jxi150w];
- wns[jxi150w] = pigt / wls[jxi150w];
- xiv[jxi150w] = 3.0e8 * wns[jxi150w] / wp;
- pus[jxi150w] = xiv[jxi150w] * wp;
- evs[jxi150w] = pus[jxi150w] * evc;
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi150w + 1),
- wls[jxi150w],
- wns[jxi150w],
- pus[jxi150w],
- evs[jxi150w],
- xiv[jxi150w]
- );
- vs += vs_step;
- }
- break;
- case 4: //pu vector definition
- vns[insn - 1] = "PUS";
- fprintf(output, " JXI PUS WNS WLS EVS XIV\n");
- for (int jxi170w = 0; jxi170w < nxi; jxi170w++) {
- vss[jxi170w] = vs;
- pus[jxi170w] = vss[jxi170w];
- xiv[jxi170w] = pus[jxi170w] / wp;
- wns[jxi170w] = pus[jxi170w] / 3.0e8;
- wls[jxi170w] = pigt / wns[jxi170w];
- evs[jxi170w] = pus[jxi170w] * evc;
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi170w + 1),
- pus[jxi170w],
- wns[jxi170w],
- wls[jxi170w],
- evs[jxi170w],
- xiv[jxi170w]
- );
- vs += vs_step;
- }
- break;
- case 5: //eV vector definition
- vns[insn - 1] = "EVS";
- fprintf(output, " JXI EVS WNS WLS PUS XIV\n");
- for (int jxi190w = 0; jxi190w < nxi; jxi190w++) {
- vss[jxi190w] = vs;
- evs[jxi190w] = vss[jxi190w];
- pus[jxi190w] = evs[jxi190w] / evc;
- xiv[jxi190w] = pus[jxi190w] / wp;
- wns[jxi190w] = pus[jxi190w] / 3.0e8;
- wls[jxi190w] = pigt / wns[jxi190w];
- fprintf(
- output,
- "%5d %13.4lE %13.4lE %13.4lE %13.4lE %13.4lE\n",
- (jxi190w + 1),
- evs[jxi190w],
- wns[jxi190w],
- wls[jxi190w],
- pus[jxi190w],
- xiv[jxi190w]
- );
- vs += vs_step;
- }
- break;
- }
- }
- // End of the untested code section.
- } else {
- if (instpc < 1) {
- // In this case the XI vector is explicitly defined.
- // Test input comes this way.
- double xi, pu, wn;
- int xi_exp;
- vns[insn - 1] = "XIV";
- List<double> xi_vector;
- sscanf(file_lines[++last_read_line].c_str(), " %9lE D%d", &xi, &xi_exp);
- xi *= pow(10.0, xi_exp);
- xi_vector.set(0, xi);
- for (int jxi310 = 1; jxi310 < nxi; jxi310++) {
- sscanf(file_lines[++last_read_line].c_str(), " %9lE D%d", &xi, &xi_exp);
- xi *= pow(10.0, xi_exp);
- xi_vector.append(xi);
- }
- vss = xi_vector.to_array();
- xiv = xi_vector.to_array();
- pu = xip * wp;
- wn = pu / 3.0e8;
- fprintf(output, " XIP WN WL PU EV\n");
- fprintf(output, " %13.4lE", xip);
- fprintf(output, "%13.4lE", wn);
- fprintf(output, "%13.4lE", pigt / wn);
- fprintf(output, "%13.4lE", pu);
- fprintf(output, "%13.4lE\n", pu * evc);
- fprintf(output, " SCALE FACTORS XI\n");
- for (int jxi6612 = 1; jxi6612 <= nxi; jxi6612++)
- fprintf(output, "%5d%13.4lE\n", jxi6612, xiv[jxi6612 - 1]);
- //INXI branch ends here.
- }
- }
- last_read_line++;
- iog = new int[nsph];
- for (int i = 0; i < nsph; i++) {
- string read_format = "";
- for (int j = 0; j < i; j++) read_format += " %*d";
- read_format += " %d";
- sscanf(file_lines[last_read_line].c_str(), read_format.c_str(), (iog + i));
- }
- nshl = new int[nsph];
- ros = new double[nsph];
- rcf = new double*[nsph];
- for (int i113 = 1; i113 <= nsph; i113++) {
- int i_val;
- double ros_val;
- int ros_val_exp;
- if (iog[i113 - 1] < i113) continue;
- sscanf(file_lines[++last_read_line].c_str(), " %d %9lf D%d", &i_val, &ros_val, &ros_val_exp);
- nshl[i113 - 1] = i_val;
- ros[i113 - 1] = ros_val * pow(10.0, ros_val_exp);
- nsh = nshl[i113 -1];
- if (i113 == 1) nsh += ies;
- rcf[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(), " %8lf D%d", &ns_rcf, &ns_rcf_exp);
- rcf[i113 -1][ns] = ns_rcf * pow(10.0, ns_rcf_exp);
- }
- }
- // The FORTRAN code writes an auxiliary file in binary format. This should
- // be avoided or possibly replaced with the use of standard file formats for
- // scientific use (e.g. FITS).
- int uid = 27;
- string bin_file_name = "c_TEDF";
- string status = "UNKNOWN";
- string mode = "UNFORMATTED";
- open_file_(&uid, bin_file_name.c_str(), status.c_str(), mode.c_str());
- write_int_(&uid, &nsph);
- for (int iogi = 0; iogi < nsph; iogi++)
- write_int_(&uid, (iog + iogi));
- write_double_(&uid, &exdc);
- write_double_(&uid, &wp);
- write_double_(&uid, &xip);
- write_int_(&uid, &idfc);
- write_int_(&uid, &nxi);
- for (int xivi = 0; xivi < nxi; xivi++)
- write_double_(&uid, (xiv + xivi));
- for (int i115 = 1; i115 <= nsph; i115++) {
- if (iog[i115 - 1] < i115) continue;
- write_int_(&uid, (nshl + i115 -1));
- write_double_(&uid, (ros + i115 - 1));
- nsh = nshl[i115 - 1];
- if (i115 == 1) nsh += ies;
- for (int ins = 0; ins < nsh; ins++)
- write_double_(&uid, (rcf[i115 - 1] + ins));
- }
- // Remake the dc0m matrix.
- dc0m = new complex<double>**[nsph];
- for (int dim1 = 0; dim1 < nsph; dim1++) {
- dc0m[dim1] = new complex<double>*[nsph];
- for (int dim2 = 0; dim2 < nxi; dim2++) {
- dc0m[dim1][dim2] = new complex<double>[nxi];
- }
- }
- 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;
- nsh = nshl[i162 - 1];
- 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;
- int dc0_real_exp, dc0_img_exp;
- sscanf(file_lines[++last_read_line].c_str(), " (%8lf D%d, %8lf D%d)", &dc0_real, &dc0_real_exp, &dc0_img, &dc0_img_exp);
- dc0_real *= pow(10.0, dc0_real_exp);
- dc0_img *= pow(10.0, dc0_img_exp);
- dc0m[i157][i162 - 1][jxi468 - 1] = dc0_real + 1i * dc0_img;
- // 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.
- write_complex_(&uid, &dc0_real, &dc0_img);
- }
- }
- }
- close_file_(&uid);
- if (idfc != 0) {
- fprintf(output, " DIELECTRIC CONSTANTS\n");
- for (int i473 = 1; i473 <= nsph; i473++) {
- if (iog[i473 - 1] != i473) continue;
- ici = (nshl[i473 - 1] + 1) / 2;
- if (i473 == 1) ici += ies;
- fprintf(output, " SPHERE N. %4d\n", i473);
- for (int ic472 = 0; ic472 < ici; ic472++) {
- double dc0_real = dc0m[ic472][i473 - 1][0].real(), dc0_img = dc0m[ic472][i473 - 1][0].imag();
- fprintf(output, "%5d %12.4lE%12.4lE\n", (ic472 + 1), dc0_real, dc0_img);
- }
- }
- } else {
- fprintf(output, " DIELECTRIC FUNCTIONS\n");
- for (int i478 = 1; i478 <= nsph; i478++) {
- if (iog[i478 - 1] != i478) continue;
- ici = (nshl[i478 - 1] + 1) / 2;
- if (i478 == 1) ici += ies;
- fprintf(output, " SPHERE N. %4d\n", i478);
- for (int ic477 = 1; ic477 <= ici; ic477++) {
- fprintf(output, " NONTRANSITION LAYER N. %2d , SCALE = %3c\n", ic477, vns[insn - 1].c_str());
- for (int jxi476 = 0; jxi476 < nxi; jxi476++) {
- double dc0_real = dc0m[ic477 - 1][i478 - 1][jxi476].real();
- double dc0_img = dc0m[ic477 - 1][i478 - 1][jxi476].imag();
- fprintf(output, "%5d (%12.4lE,%12.4lE)\n", (jxi476 + 1), dc0_real, dc0_img);
- }
- }
- }
- }
- fclose(output);
- return 0;
-}
-
-string *load_file(string file_name, int *count = 0) {
- fstream input_file(file_name.c_str(), ios::in);
- List<string> file_lines = List<string>();
- string line;
- if (input_file.is_open()) {
- getline(input_file, line);
- file_lines.set(0, line);
- while (getline(input_file, line)) {
- file_lines.append(line);
- }
- input_file.close();
- }
- string *array_lines = file_lines.to_array();
- if (count != 0) *count = file_lines.length();
- return array_lines;
-}
diff --git a/src/np_sphere.cpp b/src/sphere/np_sphere.cpp
similarity index 53%
rename from src/np_sphere.cpp
rename to src/sphere/np_sphere.cpp
index ac985ac4e8b292acd06534aad948586a61d39880..9449ace4a2b93bb8ee75f7b5fb1b4e758f436508 100644
--- a/src/np_sphere.cpp
+++ b/src/sphere/np_sphere.cpp
@@ -3,11 +3,13 @@
#include <cstdio>
#include <string>
-#include "include/Configuration.h"
+#ifndef INCLUDE_CONFIGURATION_H_
+#include "../include/Configuration.h"
+#endif
using namespace std;
-extern void sphere();
+extern void sphere(string config_file, string data_file, string output_path);
/*! \brief Main program entry point.
*
@@ -18,6 +20,14 @@ extern void sphere();
* the configuration and runs the main program.
*/
int main(int argc, char **argv) {
- sphere();
+ string config_file = "../../test_data/sphere/DEDFB";
+ string data_file = "../../test_data/sphere/DSPH";
+ string output_path = ".";
+ if (argc == 4) {
+ config_file = string(argv[1]);
+ data_file = string(argv[2]);
+ output_path = string(argv[3]);
+ }
+ sphere(config_file, data_file, output_path);
return 0;
}
diff --git a/src/sphere/sphere.cpp b/src/sphere/sphere.cpp
index 5d92b19255106177f5dc30201704280ecc4a3e90..e5adf0421b10dbbbe737d4da361e834fee6766d6 100644
--- a/src/sphere/sphere.cpp
+++ b/src/sphere/sphere.cpp
@@ -2,28 +2,30 @@
#include <fstream>
#include <string>
#include <complex>
+#ifndef INCLUDE_CONFIGURATION_H_
#include "../include/Configuration.h"
+#endif
+#ifndef INCLUDE_SPH_SUBS_H_
#include "../include/sph_subs.h"
+#endif
using namespace std;
-//! \brief C++ implementation of SPH
-void sphere() {
+/*! \brief C++ implementation of SPH
+ *
+ * \param config_file: `string` Name of the configuration file.
+ * \param data_file: `string` Name of the input data file.
+ * \param output_path: `string` Directory to write the output files in.
+ */
+void sphere(string config_file, string data_file, string output_path) {
complex<double> arg, s0, tfsas;
- complex<double> **tqspe, **tqsps;
- double **tqse, **tqss;
- double *argi, *args, *gaps;
double th, ph;
printf("INFO: making legacy configuration ...\n");
- ScattererConfiguration *conf = ScattererConfiguration::from_dedfb("../../test_data/sphere/DEDFB");
- conf->write_formatted("c_OEDFB");
- conf->write_binary("c_TEDF");
- delete conf;
- printf("INFO: reading binary configuration ...\n");
- ScattererConfiguration *sconf = ScattererConfiguration::from_binary("c_TEDF");
- GeometryConfiguration *gconf = GeometryConfiguration::from_legacy("../../test_data/sphere/DSPH");
+ ScattererConfiguration *sconf = ScattererConfiguration::from_dedfb(config_file);
+ GeometryConfiguration *gconf = GeometryConfiguration::from_legacy(data_file);
if (sconf->number_of_spheres == gconf->number_of_spheres) {
int isq, ibf;
+ double *argi, *args, *gaps;
double cost, sint, cosp, sinp;
double costs, sints, cosps, sinps;
double scan;
@@ -44,28 +46,32 @@ void sphere() {
cmul[i] = new double[4];
cmullr[i] = new double[4];
}
+ complex<double> **tqspe, **tqsps;
+ double **tqse, **tqss;
+ tqse = new double*[2];
+ tqss = new double*[2];
+ tqspe = new std::complex<double>*[2];
+ tqsps = new std::complex<double>*[2];
+ for (int ti = 0; ti < 2; ti++) {
+ tqse[ti] = new double[2]();
+ tqss[ti] = new double[2]();
+ tqspe[ti] = new std::complex<double>[2]();
+ tqsps[ti] = new std::complex<double>[2]();
+ }
double frx = 0.0, fry = 0.0, frz = 0.0;
double cfmp, cfsp, sfmp, sfsp;
complex<double> *vint = new complex<double>[16];
int jw;
int nsph = gconf->number_of_spheres;
- C1 *c1 = new C1(nsph, gconf->l_max);
+ C1 *c1 = new C1(nsph, gconf->l_max, sconf->nshl_vec, sconf->iog_vec);
for (int i = 0; i < nsph; i++) {
- c1->iog[i] = sconf->iog_vec[i];
- c1->nshl[i] = sconf->nshl_vec[i];
c1->ros[i] = sconf->radii_of_spheres[i];
}
- for (int i = 0; i < gconf->l_max; i++) {
- c1->rmi[i][0] = complex<double>(0.0, 0.0);
- c1->rmi[i][1] = complex<double>(0.0, 0.0);
- c1->rei[i][0] = complex<double>(0.0, 0.0);
- c1->rei[i][1] = complex<double>(0.0, 0.0);
- }
C2 *c2 = new C2(nsph, 5, gconf->npnt, gconf->npntts);
argi = new double[1];
args = new double[1];
gaps = new double[2];
- FILE *output = fopen("c_OSPH", "w");
+ FILE *output = fopen((output_path + "/c_OSPH").c_str(), "w");
fprintf(output, " READ(IR,*)NSPH,LM,INPOL,NPNT,NPNTTS,ISAM\n");
fprintf(
output,
@@ -146,17 +152,18 @@ void sphere() {
const double half_pi = acos(0.0);
const double pi = 2.0 * half_pi;
double gcs = 0.0;
- for (int i116 = 1; i116 <= nsph; i116++) {
- int iogi = c1->iog[i116 - 1];
- if (iogi >= i116) {
- double gcss = pi * c1->ros[i116 - 1] * c1->ros[i116 - 1];
- c1->gcsv[i116 - 1] = gcss;
- int nsh = c1->nshl[i116 - 1];
- for (int j115 = 1; j115 <= nsh; j115++) {
- c1->rc[i116 - 1][j115 - 1] = sconf->rcf[i116 - 1][j115 - 1] * c1->ros[i116 - 1];
+ for (int i116 = 0; i116 < nsph; i116++) {
+ int i = i116 + 1;
+ int iogi = c1->iog[i116];
+ if (iogi >= i) {
+ double gcss = pi * c1->ros[i116] * c1->ros[i116];
+ c1->gcsv[i116] = gcss;
+ int nsh = c1->nshl[i116];
+ for (int j115 = 0; j115 < nsh; j115++) {
+ c1->rc[i116][j115] = sconf->rcf[i116][j115] * c1->ros[i116];
}
}
- gcs += c1->gcsv[iogi - 1];
+ gcs += c1->gcsv[iogi];
}
double ****zpv = new double***[gconf->l_max]; //[gconf->l_max][3][2][2]; // Matrix: dim[LM x 3 x 2 x 2]
for (int zi = 0; zi < gconf->l_max; zi++) {
@@ -164,7 +171,7 @@ void sphere() {
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];
+ zpv[zi][zj][zk] = new double[2]();
}
}
}
@@ -172,7 +179,8 @@ void sphere() {
double exri = sqrt(sconf->exdc);
fprintf(output, " REFR. INDEX OF EXTERNAL MEDIUM=%15.7lE\n", exri);
fstream tppoan;
- tppoan.open("c_TPPOAN", ios::binary|ios::out);
+ string tppoan_name = output_path + "/c_TPPOAN_sph";
+ tppoan.open(tppoan_name.c_str(), ios::binary|ios::out);
if (tppoan.is_open()) {
int imode = 10;
tppoan.write(reinterpret_cast<char *>(&imode), sizeof(int));
@@ -197,9 +205,11 @@ void sphere() {
fprintf(output, " VK=%15.7lE, XI IS SCALE FACTOR FOR LENGTHS\n", vk);
fprintf(output, " \n");
}
- for (int jxi488 = 1; jxi488 <= sconf->number_of_scales; jxi488++) {
- fprintf(output, "========== JXI =%3d ====================\n", jxi488);
- double xi = sconf->scale_vec[jxi488 - 1];
+ for (int jxi488 = 0; jxi488 < sconf->number_of_scales; jxi488++) {
+ printf("INFO: running scale iteration...\n");
+ int jxi = jxi488 + 1;
+ fprintf(output, "========== JXI =%3d ====================\n", jxi);
+ double xi = sconf->scale_vec[jxi488];
if (sconf->idfc >= 0) {
vk = xi * wn;
vkarg = vk;
@@ -210,24 +220,25 @@ void sphere() {
fprintf(output, " XI=%15.7lE\n", xi);
}
tppoan.write(reinterpret_cast<char *>(&vk), sizeof(double));
- for (int i132 = 1; i132 <= nsph; i132++) {
- int iogi = sconf->iog_vec[i132 - 1];
- if (iogi != i132) {
- for (int l123 = 1; l123 <= gconf->l_max; l123++) {
- c1->rmi[l123 - 1][i132 - 1] = c1->rmi[l123 - 1][iogi - 1];
- c1->rei[l123 - 1][i132 - 1] = c1->rei[l123 - 1][iogi - 1];
+ for (int i132 = 0; i132 < nsph; i132++) {
+ int i = i132 + 1;
+ int iogi = sconf->iog_vec[i132];
+ if (iogi != i) {
+ for (int l123 = 0; l123 < gconf->l_max; l123++) {
+ c1->rmi[l123][i132] = c1->rmi[l123][iogi - 1];
+ c1->rei[l123][i132] = c1->rei[l123][iogi - 1];
}
continue; // i132
}
- int nsh = sconf->nshl_vec[i132 - 1];
+ int nsh = sconf->nshl_vec[i132];
int ici = (nsh + 1) / 2;
if (sconf->idfc == 0) {
for (int ic = 0; ic < ici; ic++)
- c2->dc0[ic] = sconf->dc0_matrix[ic][i132 - 1][0]; // WARNING: IDFC=0 is not tested!
+ c2->dc0[ic] = sconf->dc0_matrix[ic][i132][0]; // WARNING: IDFC=0 is not tested!
} else { // IDFC != 0
- if (jxi488 == 1) {
+ if (jxi == 1) {
for (int ic = 0; ic < ici; ic++) {
- c2->dc0[ic] = sconf->dc0_matrix[ic][i132 - 1][jxi488 - 1];
+ c2->dc0[ic] = sconf->dc0_matrix[ic][i132][jxi488];
}
}
}
@@ -235,7 +246,7 @@ void sphere() {
int jer = 0;
int lcalc = 0;
dme(
- gconf->l_max, i132, gconf->npnt, gconf->npntts, vkarg,
+ gconf->l_max, i, gconf->npnt, gconf->npntts, vkarg,
sconf->exdc, exri, c1, c2, jer, lcalc, arg
);
if (jer != 0) {
@@ -246,11 +257,12 @@ void sphere() {
return;
}
} // i132
- if (sconf->idfc >= 0 and nsph == 1 and jxi488 == gconf->jwtm) {
+ if (sconf->idfc >= 0 and nsph == 1 and jxi == gconf->jwtm) {
// This is the condition that writes the transition matrix to output.
int is = 1111;
fstream ttms;
- ttms.open("c_TTMS", ios::binary | ios::out);
+ string ttms_name = output_path + "/c_TTMS_sph";
+ ttms.open(ttms_name.c_str(), ios::binary | ios::out);
if (ttms.is_open()) {
ttms.write(reinterpret_cast<char *>(&is), sizeof(int));
ttms.write(reinterpret_cast<char *>(&(gconf->l_max)), sizeof(int));
@@ -267,100 +279,85 @@ void sphere() {
} else { // Failed to open output file. Should never happen.
printf("ERROR: could not open TTMS file.\n");
tppoan.close();
- fclose(output);
}
}
double cs0 = 0.25 * vk * vk * vk / half_pi;
//printf("DEBUG: cs0 = %lE\n", cs0);
sscr0(tfsas, nsph, gconf->l_max, vk, exri, c1);
- printf("DEBUG: TFSAS = (%lE,%lE)\n", tfsas.real(), tfsas.imag());
+ //printf("DEBUG: TFSAS = (%lE,%lE)\n", tfsas.real(), tfsas.imag());
double sqk = vk * vk * sconf->exdc;
aps(zpv, gconf->l_max, nsph, c1, sqk, gaps);
- tqse = new double*[2];
- tqss = new double*[2];
- tqspe = new std::complex<double>*[2];
- tqsps = new std::complex<double>*[2];
- for (int ti = 0; ti < 2; ti++) {
- tqse[ti] = new double[2];
- tqss[ti] = new double[2];
- tqspe[ti] = new std::complex<double>[2];
- tqsps[ti] = new std::complex<double>[2];
- }
rabas(gconf->in_pol, gconf->l_max, nsph, c1, tqse, tqspe, tqss, tqsps);
- for (int i170 = 1; i170 <= nsph; i170++) {
- if (c1->iog[i170 - 1] >= i170) {
- double albeds = c1->sscs[i170 - 1] / c1->sexs[i170 - 1];
- c1->sqscs[i170 - 1] *= sqsfi;
- c1->sqabs[i170 - 1] *= sqsfi;
- c1->sqexs[i170 - 1] *= sqsfi;
- fprintf(output, " SPHERE %2d\n", i170);
- if (c1->nshl[i170 - 1] != 1) {
- fprintf(output, " SIZE=%15.7lE\n", c2->vsz[i170 - 1]);
+ for (int i170 = 0; i170 < nsph; i170++) {
+ int i = i170 + 1;
+ if (c1->iog[i170] >= i) {
+ double albeds = c1->sscs[i170] / c1->sexs[i170];
+ c1->sqscs[i170] *= sqsfi;
+ c1->sqabs[i170] *= sqsfi;
+ c1->sqexs[i170] *= sqsfi;
+ fprintf(output, " SPHERE %2d\n", i);
+ if (c1->nshl[i170] != 1) {
+ fprintf(output, " SIZE=%15.7lE\n", c2->vsz[i170]);
} else {
fprintf(
output,
" SIZE=%15.7lE, REFRACTIVE INDEX=(%15.7lE,%15.7lE)\n",
- c2->vsz[i170 -1],
- c2->vkt[i170 - 1].real(),
- c2->vkt[i170 - 1].imag()
+ c2->vsz[i170],
+ c2->vkt[i170].real(),
+ c2->vkt[i170].imag()
);
}
fprintf(output, " ----- SCS ----- ABS ----- EXS ----- ALBEDS --\n");
fprintf(
output,
" %14.7lE%15.7lE%15.7lE%15.7lE\n",
- c1->sscs[i170 - 1], c1->sabs[i170 - 1],
- c1->sexs[i170 - 1], albeds
+ c1->sscs[i170], c1->sabs[i170],
+ c1->sexs[i170], albeds
);
fprintf(output, " ---- SCS/GS -- ABS/GS -- EXS/GS ---\n");
fprintf(
output,
" %14.7lE%15.7lE%15.7lE\n",
- c1->sqscs[i170 - 1], c1->sqabs[i170 - 1],
- c1->sqexs[i170 - 1]
+ c1->sqscs[i170], c1->sqabs[i170],
+ c1->sqexs[i170]
);
- fprintf(output, " FSAS=%15.7lE%15.7lE\n", c1->fsas[i170 - 1].real(), c1->fsas[i170 - 1].imag());
- double csch = 2.0 * vk * sqsfi / c1->gcsv[i170 -1];
- //printf("DEBUG: csch = %lE\n", csch);
- s0 = c1->fsas[i170 - 1] * exri;
- //printf("DEBUG: s0 = (%lE,%lE)\n", s0.real(), s0.imag());
+ fprintf(output, " FSAS=%15.7lE%15.7lE\n", c1->fsas[i170].real(), c1->fsas[i170].imag());
+ double csch = 2.0 * vk * sqsfi / c1->gcsv[i170];
+ s0 = c1->fsas[i170] * exri;
double qschu = csch * s0.imag();
- //printf("DEBUG: qschu = %lE\n", qschu);
double pschu = csch * s0.real();
- //printf("DEBUG: pschu = %lE\n", pschu);
- double s0mag = cs0 * sqrt((s0.real() + s0.imag()) * (s0.real() - s0.imag()));
- //printf("DEBUG: s0mag = %lE\n", s0mag);
+ double s0mag = cs0 * abs(s0);
fprintf(
output,
" QSCHU=%15.7lE, PSCHU=%15.7lE, S0MAG=%15.7lE\n",
qschu, pschu, s0mag
);
- double rapr = c1->sexs[i170 - 1] - gaps[i170 - 1];
- double cosav = gaps[i170 - 1] / c1->sscs[i170 - 1];
+ double rapr = c1->sexs[i170] - gaps[i170];
+ double cosav = gaps[i170] / c1->sscs[i170];
fprintf(output, " COSAV=%15.7lE, RAPRS=%15.7lE\n", cosav, rapr);
- fprintf(output, " IPO=%2d, TQEk=%15.7lE, TQSk=%15.7lE\n", 1, tqse[0][i170 - 1], tqss[0][i170 - 1]);
- fprintf(output, " IPO=%2d, TQEk=%15.7lE, TQSk=%15.7lE\n", 2, tqse[1][i170 - 1], tqss[1][i170 - 1]);
- tppoan.write(reinterpret_cast<char *>(&(tqse[0][i170 - 1])), sizeof(double));
- tppoan.write(reinterpret_cast<char *>(&(tqss[0][i170 - 1])), sizeof(double));
- double val = tqspe[0][i170 - 1].real();
+ fprintf(output, " IPO=%2d, TQEk=%15.7lE, TQSk=%15.7lE\n", 1, tqse[0][i170], tqss[0][i170]);
+ fprintf(output, " IPO=%2d, TQEk=%15.7lE, TQSk=%15.7lE\n", 2, tqse[1][i170], tqss[1][i170]);
+ tppoan.write(reinterpret_cast<char *>(&(tqse[0][i170])), sizeof(double));
+ tppoan.write(reinterpret_cast<char *>(&(tqss[0][i170])), sizeof(double));
+ double val = tqspe[0][i170].real();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- val = tqspe[0][i170 - 1].imag();
+ val = tqspe[0][i170].imag();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- val = tqsps[0][i170 - 1].real();
+ val = tqsps[0][i170].real();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- val = tqsps[0][i170 - 1].imag();
+ val = tqsps[0][i170].imag();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- tppoan.write(reinterpret_cast<char *>(&(tqse[1][i170 - 1])), sizeof(double));
- tppoan.write(reinterpret_cast<char *>(&(tqss[1][i170 - 1])), sizeof(double));
- val = tqspe[1][i170 - 1].real();
+ tppoan.write(reinterpret_cast<char *>(&(tqse[1][i170])), sizeof(double));
+ tppoan.write(reinterpret_cast<char *>(&(tqss[1][i170])), sizeof(double));
+ val = tqspe[1][i170].real();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- val = tqspe[1][i170 - 1].imag();
+ val = tqspe[1][i170].imag();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- val = tqsps[1][i170 - 1].real();
+ val = tqsps[1][i170].real();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- val = tqsps[1][i170 - 1].imag();
+ val = tqsps[1][i170].imag();
tppoan.write(reinterpret_cast<char *>(&val), sizeof(double));
- } // End if iog[i170 - 1] >= i170
+ } // End if iog[i170] >= i
} // i170 loop
if (nsph != 1) {
fprintf(output, " FSAT=(%15.7lE,%15.7lE)\n", tfsas.real(), tfsas.imag());
@@ -368,7 +365,7 @@ void sphere() {
s0 = tfsas * exri;
double qschu = csch * s0.imag();
double pschu = csch * s0.real();
- double s0mag = cs0 * sqrt((s0.real() + s0.imag()) * (s0.real() - s0.imag()));
+ double s0mag = cs0 * abs(s0);
fprintf(
output,
" QSCHU=%15.7lE, PSCHU=%15.7lE, S0MAG=%15.7lE\n",
@@ -376,10 +373,12 @@ void sphere() {
);
}
th = th1;
- for (int jth486 = 1; jth486 <= nth; jth486++) { // OpenMP parallelizable section
+ for (int jth486 = 0; jth486 < nth; jth486++) { // OpenMP parallelizable section
+ int jth = jth486 + 1;
ph = ph1;
- for (int jph484 = 1; jph484 <= nph; jph484++) {
- bool goto182 = (nk == 1) && (jxi488 > 1);
+ for (int jph484 = 0; jph484 < nph; jph484++) {
+ int jph = jph484 + 1;
+ bool goto182 = (nk == 1) && (jxi > 1);
if (!goto182) {
upvmp(th, ph, 0, cost, sint, cosp, sinp, u, upmp, unmp);
}
@@ -395,7 +394,8 @@ void sphere() {
}
double thsl = ths1;
double phsph = 0.0;
- for (int jths482 = 1; jths482 <= nths; jths482++) {
+ for (int jths482 = 0; jths482 < nths; jths482++) {
+ int jths = jths482 + 1;
double ths = thsl;
int icspnv = 0;
if (gconf->meridional_type > 1) ths = th + thsca;
@@ -407,19 +407,20 @@ void sphere() {
if (phsph != 0.0) icspnv = 1;
}
double phs = phs1;
- for (int jphs480 = 1; jphs480 <= nphs; jphs480++) {
+ for (int jphs480 = 0; jphs480 < nphs; jphs480++) {
+ int jphs = jphs480 + 1;
if (gconf->meridional_type >= 1) {
phs = ph + phsph;
if (phs >= 360.0) phs -= 360.0;
}
- bool goto190 = (nks == 1) && ((jxi488 > 1) || (jth486 > 1) || (jph484 > 1));
+ bool goto190 = (nks == 1) && ((jxi > 1) || (jth > 1) || (jph > 1));
if (!goto190) {
upvmp(ths, phs, icspnv, costs, sints, cosps, sinps, us, upsmp, unsmp);
if (gconf->meridional_type >= 0) {
wmamp(2, costs, sints, cosps, sinps, gconf->in_pol, gconf->l_max, 0, nsph, args, us, upsmp, unsmp, c1);
}
}
- if (nkks != 0 || jxi488 == 1) {
+ if (nkks != 0 || jxi == 1) {
upvsp(u, upmp, unmp, us, upsmp, unsmp, up, un, ups, uns, duk, isq, ibf, scan, cfmp, sfmp, cfsp, sfsp);
if (gconf->meridional_type < 0) {
wmasp(
@@ -428,9 +429,9 @@ void sphere() {
gconf->l_max, 0, nsph, argi, args, c1
);
}
- for (int i193 = 1; i193 <= 3; i193++) {
- un[i193 - 1] = unmp[i193 - 1];
- uns[i193 - 1] = unsmp[i193 - 1];
+ for (int i193 = 0; i193 < 3; i193++) {
+ un[i193] = unmp[i193];
+ uns[i193] = unsmp[i193];
}
}
if (gconf->meridional_type < 0) jw = 1;
@@ -448,7 +449,7 @@ void sphere() {
fprintf(
output,
"********** JTH =%3d, JPH =%3d, JTHS =%3d, JPHS =%3d ********************\n",
- jth486, jph484, jths482, jphs480
+ jth, jph, jths, jphs
);
fprintf(
output,
@@ -465,25 +466,25 @@ void sphere() {
fprintf(output, " UN=(%12.5lE,%12.5lE,%12.5lE)\n", un[0], un[1], un[2]);
}
sscr2(nsph, gconf->l_max, vk, exri, c1);
- for (int ns226 = 1; ns226 <= nsph; ns226++) {
- fprintf(output, " SPHERE %2d\n", ns226);
+ for (int ns226 = 0; ns226 < nsph; ns226++) {
+ int ns = ns226 + 1;
+ fprintf(output, " SPHERE %2d\n", ns);
fprintf(
output, " SAS(1,1)=%15.7lE%15.7lE, SAS(2,1)=%15.7lE%15.7lE\n",
- c1->sas[ns226 - 1][0][0].real(), c1->sas[ns226 - 1][0][0].imag(),
- c1->sas[ns226 - 1][1][0].real(), c1->sas[ns226 - 1][1][0].imag()
+ c1->sas[ns226][0][0].real(), c1->sas[ns226][0][0].imag(),
+ c1->sas[ns226][1][0].real(), c1->sas[ns226][1][0].imag()
);
fprintf(
output, " SAS(1,2)=%15.7lE%15.7lE, SAS(2,2)=%15.7lE%15.7lE\n",
- c1->sas[ns226 - 1][0][1].real(), c1->sas[ns226 - 1][0][1].imag(),
- c1->sas[ns226 - 1][1][1].real(), c1->sas[ns226 - 1][1][1].imag()
+ c1->sas[ns226][0][1].real(), c1->sas[ns226][0][1].imag(),
+ c1->sas[ns226][1][1].real(), c1->sas[ns226][1][1].imag()
);
- if (jths482 == 1 && jphs480 == 1)
+ if (jths == 1 && jphs == 1)
fprintf(
output, " Fx=%15.7lE, Fy=%15.7lE, Fz=%15.7lE\n",
frx, fry, frz
);
- for (int i225 = 0; i225 < 16; i225++)
- vint[i225] = c1->vints[ns226 - 1][i225];
+ for (int i225 = 0; i225 < 16; i225++) vint[i225] = c1->vints[ns226][i225];
mmulc(vint, cmullr, cmul);
fprintf(output, " MULS\n ");
for (int imul = 0; imul < 4; imul++) {
@@ -521,6 +522,7 @@ void sphere() {
} // jph484 loop on elevation
th += gconf->in_theta_step;
} // jth486 loop on azimuth
+ printf("INFO: done scale.\n");
} //jxi488 loop on scales
tppoan.close();
} else { // In case TPPOAN could not be opened. Should never happen.
@@ -529,6 +531,16 @@ void sphere() {
fclose(output);
delete c1;
delete c2;
+ for (int zi = gconf->l_max - 1; zi > -1; zi--) {
+ for (int zj = 0; zj < 3; zj++) {
+ for (int zk = 0; zk < 2; zk++) {
+ delete[] zpv[zi][zj][zk];
+ }
+ delete[] zpv[zi][zj];
+ }
+ delete[] zpv[zi];
+ }
+ delete[] zpv;
delete[] duk;
delete[] u;
delete[] us;
@@ -544,15 +556,28 @@ void sphere() {
delete[] argi;
delete[] args;
delete[] gaps;
- for (int i = 0; i < 4; i++) {
+ for (int i = 3; i > -1; i--) {
delete[] cmul[i];
delete[] cmullr[i];
}
delete[] cmul;
delete[] cmullr;
+ for (int ti = 1; ti > -1; ti--) {
+ delete[] tqse[ti];
+ delete[] tqss[ti];
+ delete[] tqspe[ti];
+ delete[] tqsps[ti];
+ }
+ delete[] tqse;
+ delete[] tqss;
+ delete[] tqspe;
+ delete[] tqsps;
+ printf("Finished: output written to %s.\n", (output_path + "/c_OSPH").c_str());
} else { // NSPH mismatch between geometry and scatterer configurations.
throw UnrecognizedConfigurationException(
"Inconsistent geometry and scatterer configurations."
);
}
+ delete sconf;
+ delete gconf;
}